diff options
| -rw-r--r-- | ANNOUNCE | 161 | ||||
| -rw-r--r-- | ChangeLog | 551 | ||||
| -rw-r--r-- | Init5d9.scm (renamed from Init5d6.scm) | 301 | ||||
| -rw-r--r-- | Link.scm | 1 | ||||
| -rw-r--r-- | Macro.scm | 8 | ||||
| -rw-r--r-- | Makefile | 204 | ||||
| -rw-r--r-- | README | 28 | ||||
| -rw-r--r-- | Xlibscm.html | 3675 | ||||
| -rw-r--r-- | Xlibscm.info | 28 | ||||
| -rw-r--r-- | Xlibscm.texi | 4 | ||||
| -rw-r--r-- | bench.scm | 99 | ||||
| -rwxr-xr-x | build | 64 | ||||
| -rw-r--r-- | build.scm | 481 | ||||
| -rw-r--r-- | byte.c | 285 | ||||
| -rwxr-xr-x | compile.scm | 60 | ||||
| -rw-r--r-- | continue.h | 5 | ||||
| -rw-r--r-- | crs.c | 78 | ||||
| -rw-r--r-- | debian/changelog | 45 | ||||
| -rw-r--r-- | debian/control | 5 | ||||
| -rw-r--r-- | debian/copyright | 4 | ||||
| -rw-r--r-- | debian/doc-base | 7 | ||||
| -rw-r--r-- | debian/postinst | 9 | ||||
| -rwxr-xr-x | debian/rules | 13 | ||||
| -rw-r--r-- | debug.c | 22 | ||||
| -rw-r--r-- | dynl.c | 153 | ||||
| -rw-r--r-- | edline.c | 4 | ||||
| -rw-r--r-- | eval.c | 341 | ||||
| -rw-r--r-- | features.txi | 200 | ||||
| -rw-r--r-- | findexec.c | 8 | ||||
| -rw-r--r-- | gsubr.c | 4 | ||||
| -rw-r--r-- | hobbit.info | 132 | ||||
| -rw-r--r-- | hobbit.scm | 33 | ||||
| -rw-r--r-- | hobbit.texi | 53 | ||||
| -rwxr-xr-x | inc2scm | 22 | ||||
| -rw-r--r-- | ioext.c | 227 | ||||
| -rw-r--r-- | keysymdef.scm | 828 | ||||
| -rw-r--r-- | mkimpcat.scm | 38 | ||||
| -rw-r--r-- | patchlvl.h | 4 | ||||
| -rw-r--r-- | platform.txi | 47 | ||||
| -rw-r--r-- | posix.c | 67 | ||||
| -rw-r--r-- | r4rstest.scm | 67 | ||||
| -rw-r--r-- | ramap.c | 21 | ||||
| -rw-r--r-- | record.c | 25 | ||||
| -rw-r--r-- | repl.c | 551 | ||||
| -rw-r--r-- | requires.scm | 3 | ||||
| -rw-r--r-- | rgx.c | 40 | ||||
| -rw-r--r-- | rope.c | 16 | ||||
| -rw-r--r-- | sc2.c | 64 | ||||
| -rw-r--r-- | scl.c | 223 | ||||
| -rw-r--r-- | scm.1 | 10 | ||||
| -rw-r--r-- | scm.c | 122 | ||||
| -rw-r--r-- | scm.h | 925 | ||||
| -rw-r--r-- | scm.info | 2314 | ||||
| -rw-r--r-- | scm.spec | 18 | ||||
| -rw-r--r-- | scm.texi | 1367 | ||||
| -rw-r--r-- | scm5d6.info | 8382 | ||||
| -rw-r--r-- | scmfig.h | 66 | ||||
| -rw-r--r-- | scmmain.c | 26 | ||||
| -rw-r--r-- | script.c | 41 | ||||
| -rw-r--r-- | socket.c | 64 | ||||
| -rw-r--r-- | subr.c | 294 | ||||
| -rw-r--r-- | sys.c | 126 | ||||
| -rw-r--r-- | time.c | 10 | ||||
| -rw-r--r-- | turtlegr.c | 5 | ||||
| -rw-r--r-- | unif.c | 166 | ||||
| -rw-r--r-- | unix.c | 21 | ||||
| -rw-r--r-- | version.txi | 2 | ||||
| -rw-r--r-- | x.c | 229 | ||||
| -rw-r--r-- | x11.scm | 105 | ||||
| -rwxr-xr-x | xgen.scm | 26 |
70 files changed, 10986 insertions, 12642 deletions
@@ -1,31 +1,94 @@ -This message announces the availability of Scheme release scm5d6. - -New in scm5d6: - -From Aubrey Jaffer: - - + Tanel Tammet's Hobbit compiler is now integrated into the SCM - distribution. - - + hobbit.scm modified for (symbol) GC changes in SCM. Use of - scm_gc_protect() instead of lists of protected objects means code - produced by Hobbit is smaller and more readable. - - + Converted the hobbit documentation to texinfo format. - http://swissnet.ai.mit.edu/~jaffer/hobbit_toc.html - -From George Bronnikov: - - + Ported SCM to the PLAN9 operating-system. - -From Martin Lafaix - - + scm.c (l_raise, l_sleep): - + script.c (dld_find_executable): - + scmmain.c, scmfig.h: Ported to OS/2, IBM VisualAge C++ v3. - -Plus improvements and bug fixes too numerous to include here (see -scm/ChangeLog). +This message announces the availability of Scheme release scm5d9. + +New in scm5d9: + + * ramap.c (array-map): Added. + * byte.c: Added. Improves RANDOM speed by 32%. + * subr.c (scm_logbitp, scm_ash): Prevent wraparound (1>>32==1). + * ioext.c, posix.c (system->line): Defined. + * scl.c (floequal): Fixed so 0/0==0/0. + (eqv, eqp): Use floequal. + * eval.c (init_eval): add_feature("primitive-hygiene"). + * scl.c (eqp): Fixed so (let ((nan 0/0)) (= nan nan)) ==> #t. + (in2ex): Infinite loop on (inexact->exact 0/0) change to err. + * scl.c (iflo2str): Use negated conditional to handle 0/0. + (NaN2str): Removed "#i" prefix. + + * scm.texi (Embedding SCM): Updated libtest example for + init_user_scm indirection (which Radey added 2003-01-24). + * scm.texi (MS-DOS Compatible Scripts): Added sharpbang URL. + * scm.texi (Build Options): Described *.opt option files. + * scm.texi (Automatic C Preprocessor Definitions): Added IA64. + * scm.texi (Line Numbers): Added read-for-load. + (Load Syntax): Distinguished from Read syntax; documented #?line, + #?column, and #?file. + (Data Type Representations): Updated port formats. + + * Makefile (dfiles): Added version.txi platform.txi features.txi. + * Makefile (CFLAGS): Removed "-g". + * Makefile (pg.opt, gdb.opt, dlls.opt): Added. Cleanup options. + * Makefile (continue.o): Was missing scmfig.h and scm.h + dependencies. + * Makefile (uninstallinfo): Created. + (uninstall): Remove libscmdir files. + * Makefile (release): Make pdf(s). + + * Init5d8.scm (slib:eval-load): Use *load-reader*. + * repl.c (scm_read_for_load): Added. + (p_read_numbered, p_read_for_load, p_read): Added locatives. + (lreadr): Pass appropriate read routine to load:sharp; read:sharp. + (flgs): Renamed from nump to reduce interference with INUMP, etc. + * Init5d8.scm (load:sharp, read:sharp): Split read:sharp. + (load:sharp, read:sharp, char:sharp, read:array): Added READ arg. + (char:sharp): Renamed from read:sharp-char. + (read:sharp): Integrated #; into. + * repl.c (scm_read): Renamed from lread(). + (loc_charsharp): Renamed from loc_readsharpc. + (loc_loadsharp): Added to separate LOAD-macros from READ-macros. + (f_read_numbered): Removed unused variable. + (repl, tryload, scm_load_string): Use scm_read_numbered(). + (lreadpr): Dispatch to loc_readsharp or loc_loadsharp depending on + nump. + * Init5d8.scm (make-array): Alias of create-array. + (read:sharp): Feature evaluation now slib:provided? + + * mkimpcat.scm: Added rwb-isam feature. + * mkimpcat.scm (primitive-hygiene): Use feature to conditionalize + macro association. + + * scmfig.h (CDR_DOUBLES, SHORT_INT): Added __ia64 #defines. + + * build.scm (build): processor-family now symbol; i8086 <- 8086. + * build.scm (manifest): Added "byte.c". + * build.scm (compile-c-files): Removed "-O" and "-Wall" options; + use --compiler-options= instead. + * build.scm: Use open-table! and open-table. + * build (print-manifest, make-features-txi): Use open-table. + * build, build.scm: Moved requires to top. + * compile.scm, hobbit.scm: Added REQUIRE-IFs. + * hobbit.texi (SLIB Logical Procedures): Removed "logical:" + aliases. + + * bench.scm (benchmark-prng): Limit to 1000 samples if no bignums. + + * r4rstest.scm (inexact->exact): Added tests. + (exact->inexact): check for both exact and inexact argument. + * r4rstest.scm (6 5 5): Added some kawa chokers: #i, #e. + Added more kawa STRING->NUMBER bait. + * r4rstest.scm (test-string->number): Implementations which don't + allow division by 0 can have fragile string->number. + + From Sam Hocevar + * r4rstest.scm (test-inexact): SECTION 6.2 checks that + (not (eqv? 1 1.0)). + + From Andy Gaynor + * Makefile (Xlibscm.info, hobbit.info): Fixed / separators. + * unif.c (make_sh_array): Bracket with ifndef RECKLESS. + + From Radey Shouman + * eval.c (m_case): Check on clauses for CASE was + confused by line-number annotations. -=-=- @@ -41,28 +104,24 @@ include SCM in other programs. Documentation is online at: http://swissnet.ai.mit.edu/~jaffer/SCM.html SCM source is available from: - http://swissnet.ai.mit.edu/ftpdir/scm/scm5d6.zip - swissnet.ai.mit.edu:/pub/scm/scm5d6.zip - http://swissnet.ai.mit.edu/ftpdir/scm/scm-5d6-1.src.rpm - swissnet.ai.mit.edu:/pub/scm/scm-5d6-1.src.rpm + http://swissnet.ai.mit.edu/ftpdir/scm/scm5d9.zip + swissnet.ai.mit.edu:/pub/scm/scm5d9.zip + http://swissnet.ai.mit.edu/ftpdir/scm/scm-5d9-1.src.rpm + swissnet.ai.mit.edu:/pub/scm/scm-5d9-1.src.rpm Also available as i386 binary RPM: - http://swissnet.ai.mit.edu/ftpdir/scm/scm-5d6-1.i386.rpm - swissnet.ai.mit.edu:/pub/scm/scm-5d6-1.i386.rpm + http://swissnet.ai.mit.edu/ftpdir/scm/scm-5d9-1.i386.rpm + swissnet.ai.mit.edu:/pub/scm/scm-5d9-1.i386.rpm SLIB is a portable Scheme library which SCM uses: - http://swissnet.ai.mit.edu/ftpdir/scm/slib2d4.zip - swissnet.ai.mit.edu:/pub/scm/slib2d4.zip + http://swissnet.ai.mit.edu/ftpdir/scm/slib3a1.zip + swissnet.ai.mit.edu:/pub/scm/slib3a1.zip Also available as RPM: - http://swissnet.ai.mit.edu/ftpdir/scm/slib-2d4-1.noarch.rpm - swissnet.ai.mit.edu:/pub/scm/slib-2d4-1.noarch.rpm + http://swissnet.ai.mit.edu/ftpdir/scm/slib-3a1-1.noarch.rpm + swissnet.ai.mit.edu:/pub/scm/slib-3a1-1.noarch.rpm JACAL is a symbolic math system written in Scheme: - http://swissnet.ai.mit.edu/ftpdir/scm/jacal1b2.zip - swissnet.ai.mit.edu:/pub/scm/jacal1b2.zip - -HOBBIT is a compiler for SCM code: - http://swissnet.ai.mit.edu/ftpdir/scm/hobbit5x.tar.gz - swissnet.ai.mit.edu:/pub/scm/hobbit5x.tar.gz + http://swissnet.ai.mit.edu/ftpdir/scm/jacal1b4.zip + swissnet.ai.mit.edu:/pub/scm/jacal1b4.zip SLIB-PSD is a portable debugger for Scheme (requires emacs editor): http://swissnet.ai.mit.edu/ftpdir/scm/slib-psd1-3.tar.gz @@ -90,13 +149,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/wb1a7.zip - swissnet.ai.mit.edu:/pub/scm/wb1a7.zip - http://swissnet.ai.mit.edu/ftpdir/scm/wb-1a7-1.src.rpm - swissnet.ai.mit.edu:/pub/scm/wb-1a7-1.src.rpm + http://swissnet.ai.mit.edu/ftpdir/scm/wb1b1.zip + swissnet.ai.mit.edu:/pub/scm/wb1b1.zip + http://swissnet.ai.mit.edu/ftpdir/scm/wb-1b1-1.src.rpm + swissnet.ai.mit.edu:/pub/scm/wb-1b1-1.src.rpm Also available as i386 binary RPM: - http://swissnet.ai.mit.edu/ftpdir/scm/wb-1a7-1.i386.rpm - swissnet.ai.mit.edu:/pub/scm/wb-1a7-1.i386.rpm + http://swissnet.ai.mit.edu/ftpdir/scm/wb-1b1-1.i386.rpm + swissnet.ai.mit.edu:/pub/scm/wb-1b1-1.i386.rpm SIMSYNCH is a digital logic simulation system written in SCM. http://swissnet.ai.mit.edu/ftpdir/scm/synch1b0.zip @@ -109,7 +168,7 @@ 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 slib2d4 and scm5d6 above. +Note: SCM.EXE still requires slib3a1 and scm5d9 above. http://swissnet.ai.mit.edu/ftpdir/scm/scm.exe swissnet.ai.mit.edu:/pub/scm/scm.exe @@ -1,3 +1,553 @@ +2003-11-30 Aubrey Jaffer <jaffer@scm.jaffer> + + * patchlvl.h (SCMVERSION): Bumped from 5d8 to 5d9. + +2003-11-13 Aubrey Jaffer <agj@alum.mit.edu> + + * scm.texi (Embedding SCM): Updated libtest example for + init_user_scm indirection (which Radey added 2003-01-24). + +2003-11-08 Aubrey Jaffer <agj@alum.mit.edu> + + * scm.texi (MS-DOS Compatible Scripts): Added sharpbang URL. + +2003-11-05 Aubrey Jaffer <agj@alum.mit.edu> + + * ramap.c (array-map): Added. + +2003-10-30 Aubrey Jaffer <agj@alum.mit.edu> + + * r4rstest.scm (inexact->exact): Added tests. + (exact->inexact): check for both exact and inexact argument. + +2003-10-25 Aubrey Jaffer <agj@alum.mit.edu> + + * build.scm (build): processor-family now symbol; i8086 <- 8086. + + * mkimpcat.scm: Added rwb-isam feature. + +2003-10-23 Aubrey Jaffer <agj@alum.mit.edu> + + * Makefile (dfiles): Added version.txi platform.txi features.txi. + +2003-10-18 Aubrey Jaffer <agj@alum.mit.edu> + + * build.scm (manifest): Added "byte.c". + + * byte.c: Added. Improves RANDOM speed by 32%. + +2003-10-15 <agj@alum.mit.edu> + + * scm.texi (Build Options): Described *.opt option files. + + * Makefile (CFLAGS): Removed "-g". + + * bench.scm (benchmark-prng): Limit to 1000 samples if no bignums. + + * Makefile (pg.opt, gdb.opt, dlls.opt): Added. Cleanup options. + +2003-10-08 Aubrey Jaffer <agj@alum.mit.edu> + + * build.scm (compile-c-files): Removed "-O" and "-Wall" options; + use --compiler-options= instead. + + * subr.c (scm_logbitp, scm_ash): Prevent wraparound (1>>32==1). + +2003-09-25 Sam Hocevar + + * r4rstest.scm (test-inexact): SECTION 6.2 checks that + (not (eqv? 1 1.0)). + +2003-09-23 Aubrey Jaffer <agj@alum.mit.edu> + + * bench.scm (prng): Calls to random:random --> random. + +2003-09-22 Aubrey Jaffer <agj@alum.mit.edu> + + * scmfig.h (CDR_DOUBLES, SHORT_INT): Added __ia64 #defines. + + * scm.texi (Automatic C Preprocessor Definitions): Added IA64. + +2003-09-21 Aubrey Jaffer <agj@alum.mit.edu> + + * ioext.c, posix.c (system->line): Defined. + +2003-09-10 Aubrey Jaffer <agj@alum.mit.edu> + + * Makefile (continue.o): Was missing scmfig.h and scm.h + dependencies. + +2003-08-26 Aubrey Jaffer <agj@alum.mit.edu> + + * build.scm: Use open-table! and open-table. + + * build (print-manifest, make-features-txi): Use open-table. + +2003-08-23 Aubrey Jaffer <agj@alum.mit.edu> + + * r4rstest.scm (6 5 5): Added some kawa chokers: #i, #e. + Added more kawa STRING->NUMBER bait. + +2003-08-17 Aubrey Jaffer <agj@alum.mit.edu> + + * scm.texi (Line Numbers): Added read-for-load. + (Load Syntax): Distinguished from Read syntax; documented #?line, + #?column, and #?file. + (Data Type Representations): Updated port formats. + + * Init5d8.scm (slib:eval-load): Use *load-reader*. + + * repl.c (scm_read_for_load): Added. + (p_read_numbered, p_read_for_load, p_read): Added locatives. + (lreadr): Pass appropriate read routine to load:sharp; read:sharp. + (flgs): Renamed from nump to reduce interference with INUMP, etc. + +2003-08-16 Aubrey Jaffer <agj@alum.mit.edu> + + * Init5d8.scm (load:sharp, read:sharp): Split read:sharp. + (load:sharp, read:sharp, char:sharp, read:array): Added READ arg. + (char:sharp): Renamed from read:sharp-char. + (read:sharp): Integrated #; into. + + * repl.c (scm_read): Renamed from lread(). + (loc_charsharp): Renamed from loc_readsharpc. + (loc_loadsharp): Added to separate LOAD-macros from READ-macros. + (f_read_numbered): Removed unused variable. + (repl, tryload, scm_load_string): Use scm_read_numbered(). + (lreadpr): Dispatch to loc_readsharp or loc_loadsharp depending on + nump. + +2003-08-15 Aubrey Jaffer <agj@alum.mit.edu> + + * scl.c (floequal): Fixed so 0/0==0/0. + (eqv, eqp): Use floequal. + +2003-08-14 Aubrey Jaffer <agj@alum.mit.edu> + + * eval.c (init_eval): add_feature("primitive-hygiene"). + + * mkimpcat.scm (primitive-hygiene): Use feature to conditionalize + macro association. + +2003-08-13 Aubrey Jaffer <agj@alum.mit.edu> + + * scl.c (eqp): Fixed so (let ((nan 0/0)) (= nan nan)) ==> #t. + (in2ex): Infinite loop on (inexact->exact 0/0) change to err. + +2003-07-22 Aubrey Jaffer <agj@alum.mit.edu> + + * Makefile (uninstallinfo): Created. + (uninstall): Remove libscmdir files. + +2003-07-22 Andy Gaynor <silver@silver.reedkin.org> + + * Makefile (Xlibscm.info, hobbit.info): Fixed / separators. + + * unif.c (make_sh_array): Bracket with ifndef RECKLESS. + +2003-07-16 Aubrey Jaffer <agj@alum.mit.edu> + + * Makefile (release): Make pdf(s). + +2003-07-11 Radey Shouman <shouman@comcast.net> + + * eval.c (m_case): Check on clauses for CASE was + confused by line-number annotations. + +2003-07-10 Aubrey Jaffer <agj@alum.mit.edu> + + * hobbit.texi (SLIB Logical Procedures): Removed "logical:" + aliases. + + * compile.scm, hobbit.scm: Added REQUIRE-IFs. + + * build, build.scm: Moved requires to top. + +2003-07-02 Aubrey Jaffer <agj@alum.mit.edu> + + * Init5d8.scm (make-array): Alias of create-array. + (read:sharp): Feature evaluation now slib:provided? + +2003-06-29 Aubrey Jaffer <agj@alum.mit.edu> + + * r4rstest.scm (test-string->number): Implementations which don't + allow division by 0 can have fragile string->number. + +2003-06-24 Aubrey Jaffer <agj@alum.mit.edu> + + * scl.c (iflo2str): Use negated conditional to handle 0/0. + (NaN2str): Removed "#i" prefix. + +2003-06-22 Aubrey Jaffer <jaffer@aubrey.jaffer> + + * patchlvl.h (SCMVERSION): Bumped from 5d7 to 5d8. + + * hobbit.texi (Macro-Expansion and Analysis): Put @code{} around + some confusing words (or or and). + +2003-06-20 Aubrey Jaffer <agj@alum.mit.edu> + + * scm.texi (Array Mapping): Moved after uniform arrays. + + * Init5d7.scm (make-array): Removed legacy procedure. + + * x.c (x_free_color_cells, x_screen_size): Corrected prot numbers. + + * eval.c (scm_profile): Corrected prot numbers. + + * record.c (MAKE_REC_INDS): Corrected prot number. + + * ramap.c (ramapc, array_imap): Corrected prot codes. + (array-fill!) Removed. + + * unif.c (uniform-vector-fill!): Removed. + +2003-06-18 Aubrey Jaffer <agj@alum.mit.edu> + + * Macro.scm (@pprint, @print): display --> write. + +2003-06-17 Aubrey Jaffer <agj@alum.mit.edu> + + * scl.c (istr2flo): 1/0, -1/0, 0/0 are inexact infinities. + (idbl2str): Infinities represented by #i+1/0, #i-1/0, #i0/0. + + * x11.scm: Lots of symbol ID-codes changed in XFree86-4.2.0. + + * keysymdef.scm: Lots of new symbols in XFree86-4.2.0. + +2003-04-04 Radey Shouman <radey@attbi.com> + + * sys.c (prinport): print column and line numbers if available. + +2003-03-12 Radey Shouman <radey@attbi.com> + + * Init5d7.scm (read:sharp-char): Add #\x<hex-number> + #\o<octal-number>, #\d<decimal-number> character read syntax. + + * repl.c (lreadr): Remove #\<octal-number> syntax, + moved to read:sharp-char. + +2003-03-12 Radey Shouman <shouman@attbi.com> + + * rope.c (init_rope): Replace static initializer for scm_protidx + with initialization in init_rope so that RESTART works. + + * sys.c (init_storage): + * eval.c (init_eval): Replace static initializers so that + RESTART works. + +2003-03-11 Radey Shouman <shouman@attbi.com> + + * sys.c (close_port): Return value from port close function so + we can get the exit status of pipes at close time. + (free_storage): Re-initialize some values for RESTART. + +2003-03-06 Aubrey Jaffer <agj@alum.mit.edu> + + * eval.c (for_each): Fixed arity_check message. + +2003-02-22 Aubrey Jaffer <agj@alum.mit.edu> + + * build.scm (compile-dll-c-files, make-dll-archive, make-archive): + Added for gnu-win32. + +2003-02-21 Aubrey Jaffer <agj@alum.mit.edu> + + * build.scm (make-archive, make-dll-archive, compile-dll-c-files): + Added for microsoft-c-nt. + +2003-01-29 Radey Shouman <shouman@attbi.com> + + * repl.c (final_repl): Make sure to reinitialize closure print + information strings when restarting -- this caused segfaults under + windows. + +2003-01-27 Aubrey Jaffer <agj@alum.mit.edu> + + * eval.c, sys.c (s_redefining): Definition moved to "sys.c" from + "eval.c". + +2003-01-24 Radey Shouman <shouman@attbi.com> + + * dynl.c (prinshl, scm_dyn_link, scm_dyn_unlink, scm_dyn_call, + scm_dyn_main_call, init_dynl): + * scm.c (scm_init_extensions): + * scm.h (SCM_EXPORT): + * scmmain.c (main): + + Changes to allow dynamic linking under MS win32.c + +2003-01-11 Aubrey Jaffer <agj@alum.mit.edu> + + * eval.c (ceval_1): Added workaround for GCC-2.3.1 on SPARC bug + reported by Steve VanDevender. + +2003-01-07 Aubrey Jaffer <agj@alum.mit.edu> + + * bench.scm (benchmark-prng): Increased time threshold. + + * eval.c (ceval_1): arg1 now #defined to (struct) t.arg_1. + Consistently nets 3% on pi benchmark. + + * bench.scm (benchmark-pi): Moved threshold; 450.MHz Pentium II + was on edge. + +2003-01-05 Aubrey Jaffer <agj@alum.mit.edu> + + * eval.c (ceval_1): "SCM arg1" replaces unused "union {} t". + +2003-01-02 Aubrey Jaffer <agj@alum.mit.edu> + + * hobbit.texi (Index): Added. + (Compiling And Linking): Documented option-files. + + * compile.scm (compile-file, compile->executable): Use + option-files named for the first argument with ".opt" appended. + + * build.scm (options-file): Made nary parameter. + (build:build): Report option-files used. + + * build (build-from-argv): Don't splice out "-f <options-file>". + +2003-01-02 Steve VanDevender <stevev@hexadecimal.uoregon.edu> + + * build.scm (compile-c-files, compile-dll-c-files) + (make-dll-archive): Added for OSF1 (was ALPHA). + + * socket.c (inet:make-address): Removed duplicate definition. + +2002-12-30 Aubrey Jaffer <agj@alum.mit.edu> + + * scm.h: Removed unused prototypes. + + * scl.c (difference, divide): + * sys.c (init_storage, egc_copy_stack): + * unif.c (dims2ura, bit_position): + * repl.c (everr): Added {} to squelch gcc -Wall. + + * ramap.c (sc2array): Moved prototype from "scm.h". + +2002-12-29 Aubrey Jaffer <agj@alum.mit.edu> + + * Init5d7.scm (logical:ones): Return 0 for 0 argument. + (gray-code->integer): Improved running time from O(b^2) to + O(b*log(b)). + +2002-12-19 Aubrey Jaffer <agj@alum.mit.edu> + + * scm.texi (SCM Options): Clarified descriptions of -, --, and -s. + +2002-12-19 Radey Shouman <shouman@attbi.com> + + * Init5d7.scm (error): Terminate in breakpointing error function + even if REQUIRE fails (and calls ERROR). + +2002-12-18 Radey Shouman <shouman@attbi.com> + + * ioext.c (l_opendir, l_readdir, l_closedir, l_rewinddir): + Added for win32 (tested on XP). + +2002-12-11 Aubrey Jaffer <agj@alum.mit.edu> + + * Makefile (scmlit): #define CAUTIOUS. + + * sys.c (make_subr): Reuse repeated names. + + * eval.c (checked_define): Share warning strings. + + * time.c (your_time): Shortened long warning message. + + * rope.c (scm_gc_protect): Check if argument is already protected. + + * scm.texi (Changing Scm): Added scm_protect_temp() and + scm_gc_protect(). + (Type Conversions): Added num2short(), num2dbl(), and + scm_base_addr(). + +2002-12-09 Aubrey Jaffer <agj@alum.mit.edu> + + * build.scm (array-for-each, record, generalized-c-arguments) + (curses, regex, socket, posix, unix): Changed to compiled-inits. + + * Makefile (udscm4.opt, udscm5.opt, libscm.opt): Added. + (udscm4, udscm5, libscm.a): Take feature options from .opt file. + The *.opt files are never overwritten. + + * posix.c (scm_getlogin): Removed. + + * scm.texi (SCM Session): getlogin moved from Posix Extensions. + + * Init5d7.scm (getlogin): Posix getlogin is useless; always define + getlogin using getenv. + +2002-12-08 Aubrey Jaffer <agj@alum.mit.edu> + + * build (build-from-argv): Fluid-let getopt-- to splice in options + from -f <filename>. + + * build.scm (build): Added -f <filename> option. + + * Makefile (bench): Run both pi and prng benchmarks. + + * bench.scm (time-call): Abstracted timing procedure. + (benchmark-prng): Added. + +2002-12-02 Aubrey Jaffer <agj@alum.mit.edu> + + * Init5d7.scm: + * build (build-from-argv): Global variable *argv* replaces argc, + argv arguments. + (build-from-whole-argv, bi): Straightened. + +2002-11-26 Aubrey Jaffer <jaffer@aubrey.jaffer> + + * patchlvl.h (SCMVERSION): Bumped from 5d6 to 5d7. + +2002-11-26 Aubrey Jaffer <agj@alum.mit.edu> + + * Init5d6.scm (error, warn): Simplified. + +2002-11-25 Aubrey Jaffer <agj@alum.mit.edu> + + * scm.c (init_buf0): ifndef scoping didn't match "{}"s. + + * x.c, unix.c, unif.c, sys.c, subr.c, socket.c, scm.texi, scm.h, + scm.c, scl.c, sc2.c, rope.c, rgx.c, repl.c, record.c, ramap.c, + posix.c, ioext.c, gsubr.c, eval.c, edline.c, dynl.c, debug.c, + crs.c (ASRTER): Renamed from ASSERT; conflict with "windows.h". + + * scm.texi (Compiling and Linking Custom Files): ./build. + +2002-11-25 dai <inukai.d@jeans.ocn.ne.jp> + + * build.scm (compile-c-files freebsd, compile-dll-c-files + freebsd): Fixed for FreeBSD. + + * build: Added -no-init-file to first line. + +2002-11-20 Aubrey Jaffer <agj@alum.mit.edu> + + * Init5d6.scm (browse-url): Added. + +2002-11-17 Aubrey Jaffer <agj@alum.mit.edu> + + * scm.texi (I/O-Extensions): directory feature renamed from + directory-for-each. + + * ioext.c (current-directory, make-directory): Added. + +2002-11-15 Radey Shouman <shouman@attbi.com> + + * sys.c (scm_dynthrow): Fix bug in throwing to continuation + when environment stack segment needed to grow. + (scm_estk_shrink): Make sure the entire chain of non-writable + environment stack segments is appropriately marked. + Thanks to <david@anvil.com> for calling attention to the problem. + +2002-11-11 Aubrey Jaffer <agj@alum.mit.edu> + + * Init5d6.scm (logical:rotate): Added. + +2002-10-30 Radey Shouman <shouman@attbi.com> + + * eval.c (m_body): Fixed error reporting -- was segfaulting. + +2002-10-24 Aubrey Jaffer <agj@alum.mit.edu> + + * unif.c (make_sh_array): scm_arity_check(mapfunc). + +2002-08-20 Radey Shouman <shouman@attbi.com> + + * eval.c (m_do): Splicing BEGIN in the test of a DO removed because + it is buggy. Thanks for bug report from Daniel Skarda <0rfelyus@ucw.cz>. + +2002-07-14 Rainer Urian <rainer.urian@symbolictool.de> + + * sys.c: include <io.h> ifdef POCKETCONSOLE. + + * scmmain.c (scm_find_implpath): Don't scm_try_path ifdef + POCKETCONSOLE. + + * scmfig.h (NOSETBUF): Set ifdef POCKETCONSOLE. + + * scm.texi (Automatic C Preprocessor Definitions): Added + _WIN32_WCE, _M_ARM, _M_ARMT. + + * scm.h (CODE): + * eval.c (I_SYM, I_VAL): + * repl.c (iprin1): Workaround Microsoft CLARM compiler bug. + +2002-06-07 Rainer Urian <rainer.urian@symbolictool.de> + + * scm.c (scmable_signal): + * repl.c (wait_for_input): + * scmmain.c (main): + * scmfig.h: + Fixed console break handling for win32 systems, tested using + Microsoft visual C and the MinGW gcc port. + +2002-06-02 Aubrey Jaffer <agj@alum.mit.edu> + + * scm.texi (Syntax): Added example of SLIB/repl use. + (The Language): Reorganization of most sections. + + * hobbit.texi: Fixed stale email address. + +2002-06-01 Aubrey Jaffer <agj@alum.mit.edu> + + * scm.texi (Unix Scheme Scripts, Unix Shell Scripts): Updated + script mechanics. + (Files and Ports): Moved port-filename, port-line, and port-column + from "Miscellaneous Procedures". + +2002-05-26 Aubrey Jaffer <agj@alum.mit.edu> + + * inc2scm (inc2scm): Replaces go-script; takes args. + + * xgen.scm (xgen.scm): Replaces go-script; takes args. + + * compile.scm (compile.scm): Replaces go-script; takes args. + +2002-05-25 David S. <davids@idiom.com> + + * scmmain.c, scm.c, time.c, repl.c, ioext.c, sys.c, crs.c, + posix.c, socket.c, unix.c, findexec.c: __NetBSD__ support. + + * scm.texi (Automatic C Preprocessor Definitions): Add __NetBSD__ + +2002-05-21 Radey Shouman <shouman@attbi.com> + + * unif.c (shap2ra): Check that upper bound is >= lower bound. + +2002-05-18 Radey Shouman <shouman@attbi.com> + + * unif.c (dim2ura): Fix unsigned vs signed comparison problem that + caused negative sizes to be passed to make_uve. + +2002-04-26 Aubrey Jaffer <agj@alum.mit.edu> + + * scm.texi (SLIB): Load of "require" unneeded. + + * requires.scm (library-vicinity): Removed call of LOAD. + + * Init5d6.scm (set-vicinities!): Fluid-let of LOAD unneeded. + (program-vicinity, pathname->vicinity): Removed to slib. + +2002-04-24 Aubrey Jaffer <agj@alum.mit.edu> + + * scm.texi (Unix Extensions, Posix Extensions): Added @cindexs. + + * scl.c (dbl_mant_dig): Always use variable dbl_mant_dig when + ifdef FLOATS. + +2002-04-23 Aubrey Jaffer <agj@alum.mit.edu> + + * script.c (dld_find_executable): Eliminated unused #defines. + +2002-04-18 Aubrey Jaffer <agj@alum.mit.edu> + + * Makefile, scm.spec (install): Added patchlvl.h. + 2002-04-14 Aubrey Jaffer <jaffer@aubrey.jaffer> * patchlvl.h (SCMVERSION): Bumped from 5d5 to 5d6. @@ -6981,4 +7531,3 @@ Mon Jan 28 12:45:55 1991 Aubrey Jaffer (jaffer at foxkid) * scm.c (err_head, wta): added fflush calls to error routines so that error message come out in proper order. - diff --git a/Init5d6.scm b/Init5d9.scm index a847689..269c99e 100644 --- a/Init5d6.scm +++ b/Init5d9.scm @@ -42,37 +42,9 @@ ;;; Author: Aubrey Jaffer. (define (scheme-implementation-type) 'SCM) -(define (scheme-implementation-version) "5d6") +(define (scheme-implementation-version) "5d9") (define (scheme-implementation-home-page) - "http://swissnet.ai.mit.edu/~jaffer/SCM.html") - -(define vicinity:suffix? - (let ((suffi - (case (software-type) - ((AMIGA) '(#\: #\/)) - ((MACOS THINKC) '(#\:)) - ((MS-DOS WINDOWS ATARIST OS/2) '(#\\ #\/)) - ((NOSVE) '(#\: #\.)) - ((UNIX COHERENT PLAN9) '(#\/)) - ((VMS) '(#\: #\]))))) - (lambda (chr) (memv chr suffi)))) - -(define (pathname->vicinity pathname) - ;;Go up one level if PATHNAME ends in a vicinity suffix. - (let loop ((i (- (string-length pathname) 2))) - (cond ((negative? i) "") - ((vicinity:suffix? (string-ref pathname i)) - (substring pathname 0 (+ i 1))) - (else (loop (- i 1)))))) - -;;; This definition of PROGRAM-VICINITY is equivalent to the one defined -;;; SLIB/require.scm. It is used here to bootstrap -;;; IMPLEMENTATION-VICINITY and possibly LIBRARY-VICINITY. - -(define (program-vicinity) - (if *load-pathname* - (pathname->vicinity *load-pathname*) - (error "not loading but called" 'program-vicinity))) + "http://swissnet.ai.mit.edu/~jaffer/SCM") (define in-vicinity string-append) @@ -116,7 +88,7 @@ (- (char->integer (read-char port)) chr0)))) (else arg))))) -(define (read:array rank port) +(define (read:array rank port read) (define (bomb pc wid) (error (string-append "array syntax? #" (number->string rank) @@ -165,36 +137,11 @@ (else #f)) (read port))) -(define (read:sharp c port) - (define (barf c) (error "unknown # object" c)) - (define (feature? exp) - (cond ((symbol? exp) - (or (memq exp *features*) (eq? exp (software-type)))) - ((and (pair? exp) (list? exp)) - (case (car exp) - ((not) (not (feature? (cadr exp)))) - ((or) (if (null? (cdr exp)) #f - (or (feature? (cadr exp)) - (feature? (cons 'or (cddr exp)))))) - ((and) (if (null? (cdr exp)) #t - (and (feature? (cadr exp)) - (feature? (cons 'and (cddr exp)))))) - (else (error "read:sharp+ invalid expression " exp)))))) +;;; read-macros valid only in LOAD. +(define (load:sharp c port read) (case c ((#\') (read port)) ((#\.) (eval (read port))) - ((#\+) (if (feature? (read port)) - (read port) - (begin (read port) (if #f #f)))) - ((#\-) (if (not (feature? (read port))) - (read port) - (begin (read port) (if #f #f)))) - ((#\a #\A) (read:array 1 port)) - ((#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9) - (let* ((num (read:try-number port c)) - (c (peek-char port))) - (cond ((memv c '(#\a #\A)) (read-char port) (read:array num port)) - (else (error "syntax? #" num c))))) ((#\!) (let skip ((metarg? #f)) (let ((c (read-char port))) (case c @@ -205,21 +152,54 @@ (if #f #f)) (else (skip metarg?)))) (else (if (char? c) (skip metarg?) c)))))) + ;; Make #; convert the rest of the line to a (comment ...) form. + ;; "build.scm" uses this. + ((#\;) (let skip-semi () + (cond ((eqv? #\; (peek-char port)) + (read-char port) + (skip-semi)) + (else (require 'line-i/o) + `(comment ,(read-line port)))))) ((#\?) (case (read port) ((line) (port-line port)) ((column) (port-column port)) ((file) (port-filename port)) (else #f))) - (else (barf c)))) + (else (read:sharp c port read)))) + +;;; read-macros valid for LOAD and READ. +(define (read:sharp c port read) + (case c + ;; Used in "implcat" and "slibcat" + ((#\+) (if (slib:provided? (read port)) + (read port) + (begin (read port) (if #f #f)))) + ;; Used in "implcat" and "slibcat" + ((#\-) (if (slib:provided? (read port)) + (begin (read port) (if #f #f)) + (read port))) + ((#\a #\A) (read:array 1 port read)) + ((#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9) + (let* ((num (read:try-number port c)) + (c (peek-char port))) + (cond ((memv c '(#\a #\A)) (read-char port) (read:array num port read)) + (else (error "syntax? #" num c))))) + (else (error "unknown # object" c)))) ;;; We can assume TOK has at least 2 characters. -(define read:sharp-char - (letrec ((process +(define char:sharp + (letrec ((numeric-1 + (lambda (tok radix) + (numeric (substring tok 1 (string-length tok)) radix))) + (numeric + (lambda (tok radix) + (cond ((string->number tok radix) => integer->char)))) + (compose (lambda (modifier tok) (and (char=? #\- (string-ref tok 1)) (if (= 3 (string-length tok)) (modifier (string-ref tok 2)) - (let ((c (read:sharp-char + (let ((c (char:sharp (substring tok 2 (string-length tok))))) (and c (modifier c))))))) (control @@ -234,9 +214,13 @@ (integer->char (logior 128 (char->integer c))))))) (lambda (tok) (case (string-ref tok 0) - ((#\C #\c) (process control tok)) + ((#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7) (numeric tok 8)) + ((#\O #\o) (numeric-1 tok 8)) + ((#\D #\d) (numeric-1 tok 10)) + ((#\X #\x) (numeric-1 tok 16)) + ((#\C #\c) (compose control tok)) ((#\^) (and (= 2 (string-length tok)) (control (string-ref tok 1)))) - ((#\M #\m) (process meta tok)))))) + ((#\M #\m) (compose meta tok)))))) ;;;; Function used to accumulate comments before a definition. (define comment @@ -249,29 +233,13 @@ (string-append (or comment "") "\n")) (reverse *accumulated-comments*))))) (set! *accumulated-comments* '()) - (if (equal? "" ans) + (if (equal? "" ans) "no-comment" ;#f (substring ans 0 (+ -1 (string-length ans)))))) (else (set! *accumulated-comments* (append (reverse args) *accumulated-comments*))))))) -;;; Make #; convert the rest of the line to a (comment ...) form. -;;; "build.scm" uses this. -;;; requires line-i/o -(define read:sharp - (let ((rdsharp read:sharp)) - (lambda (c port) - (if (eqv? c #\;) - (let skip-semi () - (cond ((eqv? #\; (peek-char port)) - (read-char port) - (skip-semi)) - (else `(comment ,(read-line port))))) - (rdsharp c port))))) - - -(define type 'type) ;for /bin/sh hack. -(define : ':) +(define : ':) ;for /bin/sh hack. (define !#(if #f #f)) ;for scsh hack. ;;;; Here are some Revised^2 Scheme functions: @@ -343,7 +311,7 @@ (define (try-create-file str modes . perms) (if (symbol? modes) (set! modes (symbol->string modes))) (let ((idx (string-index modes #\x))) - (cond ((require:feature->path 'i/o-extensions) + (cond ((slib:in-catalog? 'i/o-extensions) (require 'i/o-extensions) (apply try-create-file str modes perms)) ((not idx) @@ -438,31 +406,37 @@ (if (not status) (escape #f)))))))))))) (apply proc stdout stderr (or status '()))) +(define browse-url + (case (software-type) + ((UNIX COHERENT PLAN9) + (lambda (url) + (define (try cmd end) (zero? (system (string-append cmd url end)))) + (or (try "netscape-remote -remote 'openURL(" ")'") + (try "netscape -remote 'openURL(" ")'") + (try "netscape '" "'&") + (try "netscape '" "'")))) + (else + (lambda (url) + (slib:warn 'define (software-type) 'case 'of 'browse-url 'in + *load-pathname*))))) + (define (warn . args) (define cep (current-error-port)) - (if (defined? print-call-stack) - (print-call-stack cep)) + (if (defined? print-call-stack) (print-call-stack cep)) (perror "WARN") (errno 0) - (display "WARN: " cep) - (if (not (null? args)) - (begin (display (car args) cep) - (for-each (lambda (x) (display #\ cep) (write x cep)) - (cdr args)))) + (display "WARN:" cep) + (for-each (lambda (x) (display #\ cep) (write x cep)) args) (newline cep) (force-output cep)) (define (error . args) (define cep (current-error-port)) - (if (defined? print-call-stack) - (print-call-stack cep)) + (if (defined? print-call-stack) (print-call-stack cep)) (perror "ERROR") (errno 0) - (display "ERROR: " cep) - (if (not (null? args)) - (begin (display (car args) cep) - (for-each (lambda (x) (display #\ cep) (write x cep)) - (cdr args)))) + (display "ERROR:" cep) + (for-each (lambda (x) (display #\ cep) (write x cep)) args) (newline cep) (force-output cep) (abort)) @@ -642,36 +616,28 @@ ((or (negative? cnt) (not ans)) ans))) (else (tryline)))))))))))) -(if (not (defined? getlogin)) -(define (getlogin) (or (getenv "USER") (getenv "LOGNAME")))) +(define (getlogin) (or (getenv "USER") (getenv "LOGNAME"))) ;;; If the environment variable SCHEME_LIBRARY_PATH is undefined, use ;;; (implementation-vicinity) as (library-vicinity). "require.scm", ;;; the first file loaded from (library-vicinity), can redirect it. (define (set-vicinities! init-file) (set! implementation-vicinity - (let ((vic (pathname->vicinity init-file))) + (let ((vic (substring + init-file + 0 + (- (string-length init-file) + (string-length "Init.scm") + (string-length (scheme-implementation-version)))))) (lambda () vic))) - (set! library-vicinity - (let ((library-path (getenv "SCHEME_LIBRARY_PATH"))) - (if library-path - (lambda () library-path) - (lambda () - (let ((olv library-vicinity) - (oload load)) - (dynamic-wind - (lambda () (set! load identity)) - (lambda () - (let ((filename (in-vicinity (implementation-vicinity) - "require.scm"))) - (or (try-load filename) - (try-load (in-vicinity (implementation-vicinity) - "requires.scm")) - (error "Can't load" filename)))) - (lambda () (set! load oload))) - (if (eq? olv library-vicinity) - (error "Can't find library-vicinity")) - (library-vicinity)))))) + (let ((library-path (getenv "SCHEME_LIBRARY_PATH"))) + (if library-path + (set! library-vicinity (lambda () library-path)) + (let ((filename (in-vicinity (implementation-vicinity) "require.scm"))) + (or (try-load filename) + (try-load (in-vicinity (implementation-vicinity) "requires.scm")) + (error "Can't load" filename)) + (if (not library-vicinity) (error "Can't find library-vicinity"))))) (set! home-vicinity (let ((home (getenv "HOME"))) (and (not home) login->home-directory @@ -690,7 +656,7 @@ ;;;; Initialize SLIB (load (in-vicinity (library-vicinity) "require")) -;;; This turns off line-numbering off for SLIB loads. +;;; This enables line-numbering for SLIB loads. (define *slib-load-reader* (and (defined? read-numbered) read-numbered)) ;;; DO NOT MOVE! SLIB:LOAD-SOURCE and SLIB:LOAD must be defined after @@ -698,9 +664,11 @@ (define (slib:load-source file . libs) (fluid-let ((*load-reader* *slib-load-reader*)) (apply scm:load file libs))) -(define (slib:load file . libs) - (fluid-let ((*load-reader* *slib-load-reader*)) - (apply scm:load file libs))) +(define slib:load slib:load-source) + +;;; Legacy grease +(if (not (defined? slib:in-catalog?)) + (define slib:in-catalog? require:feature->path)) ;;; Dynamic link-loading (cond ((or (defined? dyn:link) @@ -710,7 +678,7 @@ (cond ((defined? link:link) (define (slib:load-compiled . args) (cond ((symbol? (car args)) - (require:require (car args)) + (require (car args)) (apply slib:load-compiled (cdr args))) ((apply link:link args)) (else (error "Couldn't link files " args)))) @@ -766,6 +734,15 @@ ;;;; Bit order and lamination +(define (logical:ones deg) + (if (zero? deg) 0 (+ (* 2 (+ -1 (integer-expt 2 (- deg 1)))) 1))) + +(define (rotate k count len) + (set! count (modulo count len)) + (logior (logand (ash k count) (logical:ones len)) + (ash k (- count len)))) +(define logical:rotate rotate) + (define (bit-reverse k n) (do ((m (if (negative? n) (lognot n) n) (ash m -1)) (k (+ -1 k) (+ -1 k)) @@ -814,15 +791,18 @@ (define (gray-code->integer k) (if (negative? k) (error 'gray-code->integer 'negative? k) - (do ((ktmp k (ash ktmp -1)) - (ans 0 (logxor ans ktmp))) - ((zero? ktmp) ans)))) + (let ((kln (integer-length k))) + (do ((d 1 (* d 2)) + (ans (logxor k (ash k -1)) ; == (integer->gray-code k) + (logxor ans (ash ans (* d -2))))) + ((>= (* 2 d) kln) ans))))) (define (grayter k1 k2) (define kl1 (integer-length k1)) (define kl2 (integer-length k2)) - (cond ((eqv? kl1 kl2) (> (gray-code->integer k1) (gray-code->integer k2))) - (else (> kl1 kl2)))) + (if (eqv? kl1 kl2) + (> (gray-code->integer k1) (gray-code->integer k2)) + (> kl1 kl2))) (define (gray-code<? k1 k2) (not (or (eqv? k1 k2) (grayter k1 k2)))) @@ -948,7 +928,7 @@ (lambda (port) (let ((old-load-pathname *load-pathname*)) (set! *load-pathname* <filename>) - (do ((o (read port) (read port))) + (do ((o (*load-reader* port) (*load-reader* port))) ((eof-object? o)) (evl o)) (set! *load-pathname* old-load-pathname))))) @@ -1041,23 +1021,31 @@ (cond ((defined? stack-trace) - ;;#+breakpoint-error;; remove line to enable breakpointing on calls to ERROR -(define (error . args) - (define cep (current-error-port)) - (if (defined? print-call-stack) - (print-call-stack cep)) - (perror "ERROR") - (errno 0) - (display "ERROR: " cep) - (if (not (null? args)) - (begin (display (car args) cep) - (for-each (lambda (x) (display #\ cep) (write x cep)) - (cdr args)))) - (newline cep) - (cond ((stack-trace) (newline cep))) - (display " * Breakpoint established: (continue <val>) to return." cep) - (newline cep) (force-output cep) - (require 'debug) (apply breakpoint args)) +;;#+breakpoint-error;; remove line to enable breakpointing on calls to ERROR +(define error + (letrec ((oerror error) + (nerror + (lambda args + (dynamic-wind + (lambda () (set! error oerror)) + (lambda () + (define cep (current-error-port)) + (if (defined? print-call-stack) + (print-call-stack cep)) + (perror "ERROR") + (errno 0) + (display "ERROR: " cep) + (if (not (null? args)) + (begin (display (car args) cep) + (for-each (lambda (x) (display #\ cep) (write x cep)) + (cdr args)))) + (newline cep) + (cond ((stack-trace) (newline cep))) + (display " * Breakpoint established: (continue <val>) to return." cep) + (newline cep) (force-output cep) + (require 'debug) (apply breakpoint args)) + (lambda () (set! error nerror)))))) + nerror)) (define (user-interrupt . args) (define cep (current-error-port)) @@ -1093,8 +1081,7 @@ (dimensions->uniform-array args (array-prototype prot) (apply array-ref prot (map car (array-shape prot)))))) -(define (make-array initial-value . dimensions) - (apply create-array (vector initial-value) dimensions)) +(define make-array create-array) (define (make-uniform-wrapper prot) (if (string? prot) (set! prot (string->number prot))) (if prot @@ -1193,7 +1180,7 @@ ;;; (else ;;; (define *optind* 1) ;;; (define getopt:opt #f) -;;; (define (getopt argc argv optstring) #f)) +;;; (define (getopt optstring) #f)) (let* ((simple-opts "muvqibs") (arg-opts '("a kbytes" "-version" "-help" @@ -1205,7 +1192,6 @@ (map (lambda (o) (string-append (string (string-ref o 0)) ":")) arg-opts))) - (argc (length *argv*)) (didsomething #f) (moreopts #t) (exe-name (symbol->string (scheme-implementation-type))) @@ -1284,7 +1270,7 @@ ;; --version => print and exit ;; -- => last option - (let loop ((option (getopt-- argc *argv* opts))) + (let loop ((option (getopt-- opts))) (case option ((#\a) (cond ((> *optind* 3) @@ -1374,7 +1360,7 @@ There is no warranty, to the extent permitted by law. (usage "scm: unknown option `--" option "'" #f)))) (cond ((and moreopts (< *optind* (length *argv*))) - (loop (getopt-- argc *argv* opts))) + (loop (getopt-- opts))) ((< *optind* (length *argv*)) ;No more opts (set! *argv* (list-tail *argv* *optind*)) (set! *optind* 1) @@ -1403,7 +1389,6 @@ There is no warranty, to the extent permitted by law. (oquit)))) ;;otherwise, fall into natural SCM repl. ) - (else - (begin (errno 0) - (set! *interactive* #t) - (for-each load (cdr (program-arguments))))))) + (else (errno 0) + (set! *interactive* #t) + (for-each load (cdr (program-arguments)))))) @@ -47,6 +47,7 @@ (cond ((provided? 'shl) ".sl") ((provided? 'sun-dl) ".so") ((provided? 'mac-dl) ".shlb") + ((provided? 'win32-dl) ".dll") (else ".o"))) (define (file->init_name name) (string-append @@ -432,10 +432,10 @@ (define-syntax @print (syntax-rules (quote) ((_ '?arg) - (begin (display '?arg) + (begin (write '?arg) (newline))) ((_ ?arg) - (begin (display '?arg) + (begin (write '?arg) (display " => ") (let ((x ?arg)) (write x) @@ -452,10 +452,10 @@ (define-syntax @pprint (syntax-rules (quote) ((_ '?arg) - (begin (display '?arg) + (begin (write '?arg) (newline))) ((_ ?arg) - (begin (display '?arg) + (begin (write '?arg) (display " => ") (let ((x ?arg)) (pprint x) @@ -43,9 +43,10 @@ SHELL = /bin/sh #CC = gcc -CFLAGS = -g +#CFLAGS = -g #LIBS = -LD = $(CC) -g +#LD = $(CC) -g +LD = $(CC) SCMLIT = ./scmlit SCMEXE = ./scm @@ -59,7 +60,7 @@ intro: @echo @echo "This is the scm$(VERSION) distribution. Read \"scm.info\"" @echo "to learn how to build and install SCM. Or browse" - @echo " http://swissnet.ai.mit.edu/~jaffer/SCM.html" + @echo " http://swissnet.ai.mit.edu/~jaffer/SCM" @echo $(MAKE) scm @@ -85,7 +86,7 @@ IMPLINIT = $(IMPLPATH)Init$(VERSION).scm 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 Iedline.scm continue.c \ - findexec.c script.c debug.c + findexec.c script.c debug.c byte.c ofiles = scm.o time.o repl.o scl.o sys.o eval.o subr.o unif.o rope.o \ continue.o findexec.o script.o debug.o # ramap.o @@ -102,6 +103,7 @@ all: require.scm require.scm: cp -p requires.scm require.scm +# SCMLIT -- try making this first! scmlit: $(ofiles) scmmain.o require.scm Makefile $(LD) -o scmlit $(ofiles) scmmain.o $(LIBS) $(MAKE) checklit @@ -113,7 +115,6 @@ scmflags: echo "/*#define CAUTIOUS*/" >> newflags.h -if (diff newflags.h scmflags.h) then rm newflags.h; \ else mv newflags.h scmflags.h; fi - .c.o: $(CC) -c $(CFLAGS) $< -o $@ scm.o: scm.c scm.h scmfig.h scmflags.h patchlvl.h @@ -128,25 +129,33 @@ sys.o: sys.c scm.h scmfig.h scmflags.h setjump.h time.o: time.c scm.h scmfig.h scmflags.h subr.o: subr.c scm.h scmfig.h scmflags.h rope.o: rope.c scm.h scmfig.h scmflags.h -continue.o: continue.c continue.h setjump.h scmflags.h +continue.o: continue.c continue.h setjump.h scm.h scmfig.h scmflags.h -udscm4: $(cfiles) $(hfiles) build.scm build - $(BUILD) -o udscm4 -s $(IMPLPATH) \ - -Fcautious bignums arrays inexact dump dynamic-linking \ - engineering-notation - rm $(ofiles) scmmain.o +# Simple build with bignums for running JACAL +scm: + $(BUILD) -s $(IMPLPATH) -F cautious bignums arrays # i/o-extensions + $(MAKE) check -udscm5: $(cfiles) $(hfiles) build.scm build Makefile - $(BUILD) -o udscm5 -s $(IMPLPATH) \ - -Fcautious bignums arrays inexact dump dynamic-linking \ - macro engineering-notation #-DNO_SYM_GC +# R4RS interpreter +udscm4.opt: + echo "-F cautious bignums arrays inexact" >> udscm4.opt + echo "-F engineering-notation dump dynamic-linking" >> udscm4.opt +udscm4: $(cfiles) $(hfiles) build.scm build udscm4.opt + $(BUILD) -f udscm4.opt -o udscm4 -s $(IMPLPATH) rm $(ofiles) scmmain.o - myscm4: udscm4 $(ifiles) require.scm -rm slibcat implcat -mv scm scm~ echo "(quit)" | ./udscm4 -no-init-file -o scm +# R5RS interpreter +udscm5.opt: udscm4.opt + cat udscm4.opt >> udscm5.opt + echo "-F macro" >> udscm5.opt +# echo "-DNO_SYM_GC" >> udscm5.opt +udscm5: $(cfiles) $(hfiles) build.scm build Makefile udscm5.opt + $(BUILD) -f udscm5.opt -o udscm5 -s $(IMPLPATH) + rm $(ofiles) scmmain.o myscm5: udscm5 $(ifiles) require.scm -rm slibcat implcat -mv scm scm~ @@ -154,30 +163,60 @@ myscm5: udscm5 $(ifiles) require.scm $(MAKE) check $(MAKE) checkmacro -scm: scmlit - $(BUILD) -s $(IMPLPATH) -Fcautious bignums arrays - $(MAKE) check +# R5RS interpreter for debugging with GDB. +gdb.opt: udscm5.opt + cat udscm5.opt >> gdb.opt + echo "-F debug" >> gdb.opt + echo "--compiler-options=-Wall" >> gdb.opt + echo "--linker-options=-Wall" >> gdb.opt + echo "-D NO_ENV_CACHE" >> gdb.opt +# echo "-DTEST_FARLOC -DTEST_SCM2PTR" >> gdb.opt +udgdbscm: gdb.opt + $(BUILD) -f gdb.opt -o udgdbscm -s $(IMPLPATH) +gdbscm: udgdbscm + echo "(quit)" | ./udgdbscm -no-init-file -r5 -o gdbscm +# R4RS interpreter for profiling +pg.opt: udscm4.opt + cat udscm4.opt >> pg.opt + echo "--compiler-options=-pg" >> pg.opt + echo "--linker-options=-pg" >> pg.opt + echo "-DLACK_SETITIMER" >> pg.opt +udpgscm: pg.opt + $(BUILD) -f pg.opt -o udpgscm -s $(IMPLPATH) +pgscm: udpgscm + echo "(quit)" | ./udpgscm -no-init-file -o pgscm + +# R4RS SCM library +libscm.opt: + echo "-F cautious bignums arrays inexact" >> libscm.opt + echo "-F engineering-notation" >> libscm.opt + echo "-F dynamic-linking" >> libscm.opt mylib: libscm.a -libscm.a: - $(BUILD) -Fcautious bignums arrays inexact \ - dynamic-linking -t lib +libscm.a: libscm.opt + $(BUILD) -t lib -f libscm.opt libtest: libscm.a libtest.c - gcc -o libtest libtest.c libscm.a -ldl -lm -lc + $(LD) -o libtest libtest.c libscm.a -ldl -lm -lc ./libtest -pgscm: - $(BUILD) -s $(IMPLPATH) -Fcautious bignums arrays \ - inexact engineering-notation dump dynamic-linking -o udscm \ - --compiler-options=-pg --linker-options=-pg -DLACK_SETITIMER - echo "(quit)" | ./udscm -no-init-file -o pgscm -mydebug: - $(BUILD) -oudgdbscm -s $(IMPLPATH) \ - -F cautious bignums arrays inexact engineering-notation dump \ - dynamic-linking macro debug \ - --compiler-options=-Wall --linker-options=-Wall \ - -DNO_ENV_CACHE #-DTEST_FARLOC -DTEST_SCM2PTR - echo "(quit)" | ./udgdbscm -no-init-file -r5 -o gdbscm +# DLLs for dynamic linking +dlls.opt: + echo "--compiler-options=-Wall" >> dlls.opt + echo "--linker-options=-Wall" >> dlls.opt +mydlls: dlls.opt + if [ -f /usr/lib/libreadline.so ]; \ + then $(BUILD) -t dll -f dlls.opt -F edit-line; fi + $(BUILD) -t dll -f dlls.opt -F curses + $(BUILD) -t dll -f dlls.opt -c sc2.c rgx.c record.c gsubr.c \ + ioext.c posix.c unix.c socket.c ramap.c byte.c + +myturtle: dlls.opt + $(BUILD) -t dll -f dlls.opt -F turtlegr + +x.so: x.c x.h xevent.h dlls.opt + $(BUILD) -t dll -f dlls.opt -F x + +# Generate x11 include and Scheme files incdir=/usr/include/ x11.scm: inc2scm rm -f x11.scm @@ -190,20 +229,8 @@ xevent.h xevent.scm xatoms.scm: xgen.scm Makefile $(SCMLIT) -l xgen.scm $(incdir)X11/Xlib.h x.h: x.c xevent.h if [ ! -z "$(CPROTO)" ]; then $(CPROTO) x.c > x.h; fi -x.so: x.c x.h xevent.h - $(BUILD) -Fx -t dll --compiler-options=-Wall -mydlls: - if [ -f /usr/lib/libreadline.so ]; \ - then $(BUILD) -Fedit-line -t dll; fi - $(BUILD) -Fcurses -t dll - $(BUILD) -t dll -c sc2.c rgx.c record.c gsubr.c \ - ioext.c posix.c unix.c socket.c ramap.c -myturtle: - $(BUILD) -Fturtlegr -t dll - -implcat: *.so mkimpcat.scm - $(SCMLIT) -lmkimpcat.scm +# Check SCM; SCMLIT function. checklit: $(SCMLIT) -fr4rstest.scm -e'(test-sc4)(test-cont)(test-delay)(gc)' \ -e '(or (null? errs) (quit 1))' @@ -214,6 +241,9 @@ checkmacro: syntest1.scm syntest2.scm r4rstest.scm $(SCMEXE) -rmacro -fsyntest1.scm -fsyntest2.scm \ -fr4rstest.scm -e'(test-sc4)(test-cont)(test-delay)' -fsyntest1 \ -e '(or (null? errs) (quit 1))' + +# Measuare running speed of SCM; SCMLIT. Results are appended to file +# "BenchLog" bench: echo `whoami`@`hostname` testing scm \ `$(SCMEXE) -e'(display *scm-version*)'` >> BenchLog @@ -222,10 +252,13 @@ bench: size scm >> BenchLog uname -a >> BenchLog $(SCMEXE) -lbench.scm - cat bench.log >> BenchLog + -cat prng.log >> BenchLog + echo >> BenchLog + -cat pi.log >> BenchLog echo >> BenchLog echo tail -20 BenchLog + -rm -f pi.log prng.log benchlit: echo `whoami`@`hostname` testing scmlit \ `$(SCMLIT) -e'(display *scm-version*)'` >> BenchLog @@ -234,14 +267,20 @@ benchlit: size scmlit >> BenchLog uname -a >> BenchLog $(SCMLIT) -lbench.scm - cat bench.log >> BenchLog + -cat prng.log >> BenchLog + echo >> BenchLog + -cat pi.log >> BenchLog echo >> BenchLog echo tail -20 BenchLog + -rm -f pi.log prng.log report: $(SCMLIT) -e"(slib:report #t)" $(SCMEXE) -e"(slib:report #t)" +implcat: *.so mkimpcat.scm + $(SCMLIT) -lmkimpcat.scm + htmldir=../public_html/ dvidir=../dvi/ dvi: $(dvidir)scm.dvi $(dvidir)Xlibscm.dvi $(dvidir)hobbit.dvi @@ -265,11 +304,11 @@ $(dvidir)hobbit.dvi: version.txi hobbit.texi $(dvidir)hobbit.fn Makefile $(dvidir)hobbit.fn: cd $(dvidir);export TEXINPUTS=$(srcdir):;tex $(srcdir)hobbit.texi xdvi: $(dvidir)scm.dvi - xdvi -s 6 $(dvidir)scm.dvi + xdvi -s 3 $(dvidir)scm.dvi Xdvi: $(dvidir)Xlibscm.dvi - xdvi -s 6 $(dvidir)Xlibscm.dvi + xdvi -s 3 $(dvidir)Xlibscm.dvi hobdvi: $(dvidir)hobbit.dvi - xdvi -s 6 $(dvidir)hobbit.dvi + xdvi -s 3 $(dvidir)hobbit.dvi pdf: $(htmldir)scm.pdf $(htmldir)Xlibscm.pdf $(htmldir)hobbit.pdf $(htmldir)scm.pdf: version.txi scm.texi platform.txi features.txi\ @@ -292,12 +331,13 @@ hobpdf: $(htmldir)hobbit.pdf PREVDOCS = prevdocs/ html: $(htmldir)scm_toc.html $(htmldir)Xlibscm_toc.html $(htmldir)hobbit_toc.html +TEXI2HTML = /usr/local/bin/texi2html -split -verbose scm_toc.html: version.txi scm.texi platform.txi features.txi - texi2html -split -verbose scm.texi + ${TEXI2HTML} scm.texi Xlibscm_toc.html: version.txi Xlibscm.texi - texi2html -split -verbose Xlibscm.texi + ${TEXI2HTML} Xlibscm.texi hobbit_toc.html: version.txi hobbit.texi - texi2html -split -verbose hobbit.texi + ${TEXI2HTML} hobbit.texi $(htmldir)scm_toc.html: scm_toc.html Makefile -rm -f scm_stoc.html @@ -361,14 +401,14 @@ Xlibscm.info: version.txi Xlibscm.texi makeinfo Xlibscm.texi --no-split -o Xlibscm.info $(infodir)Xlibscm.info: Xlibscm.info cp Xlibscm.info $(infodir)Xlibscm.info - -install-info $(infodir)Xlibscm.info $(infodir)/dir + -install-info $(infodir)Xlibscm.info $(infodir)dir -rm $(infodir)Xlibscm.info*.gz hobbit.info: version.txi hobbit.texi makeinfo hobbit.texi --no-split -o hobbit.info $(infodir)hobbit.info: hobbit.info cp hobbit.info $(infodir)hobbit.info - -install-info $(infodir)hobbit.info $(infodir)/dir + -install-info $(infodir)hobbit.info $(infodir)dir -rm $(infodir)hobbit.info*.gz infoz: installinfoz @@ -392,8 +432,8 @@ install: scm.1 -cp $(ifiles) $(hobfiles) COPYING r4rstest.scm $(libscmdir) test -f $(libscmdir)require.scm || \ cp requires.scm $(libscmdir)require.scm - -cp build build.scm mkimpcat.scm Iedline.scm *.sl *.so $(xafiles)\ - $(libscmdir) + -cp build build.scm mkimpcat.scm Iedline.scm *.sl *.so patchlvl.h\ + $(xafiles) $(libscmdir) installlib: test -d $(includedir) || mkdir $(includedir) @@ -402,14 +442,26 @@ installlib: cp libscm.a $(libdir)libscm.a uninstall: - -rm $(bindir)scm + -rm $(bindir)scm $(bindir)scmlit -rm $(man1dir)scm.1 -rm $(includedir)scm.h $(includedir)scmfig.h $(includedir)scmflags.h -rm $(libdir)libscm.a -# -rm $(libscmdir)Init$(VERSION).scm -# -rm $(libscmdir)Link.scm -# -rm $(libscmdir)Transcen.scm -# -rm $(libscmdir)COPYING + -rm $(libscmdir)Transcen.scm\ + $(libscmdir)Link.scm\ + $(libscmdir)Macro.scm\ + $(libscmdir)Macexp.scm\ + $(libscmdir)Tscript.scm\ + $(libscmdir)compile.scm\ + $(libscmdir)hobbit.scm\ + $(libscmdir)scmhob.scm\ + $(libscmdir)scmhob.h\ + $(libscmdir)COPYING\ + $(libscmdir)r4rstest.scm + -rm $(libscmdir)Init$(VERSION).scm + +uninstallinfo: + -rm $(infodir)scm.info.gz $(infodir)Xlibscm.info.gz\ + $(infodir)hobbit.info.gz scm.doc: scm.1 nroff -man $< | ul -tunknown >$@ @@ -418,7 +470,7 @@ scm.doc: scm.1 ver = $(VERSION) version.txi: patchlvl.h - echo @set SCMVERSION $(VERSION) > version.txi + echo @set SCMVERSION $(ver) > version.txi echo @set SCMDATE `date +"%B %Y"` >> version.txi RM_R = rm -rf @@ -438,7 +490,7 @@ 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 \ scm.info scm.texi Xlibscm.info Xlibscm.texi hobbit.info hobbit.texi \ - ChangeLog + version.txi platform.txi features.txi ChangeLog mfiles = Makefile build.scm build build.bat requires.scm \ .gdbinit mkimpcat.scm disarm.scm scm.spec vfiles = setjump.mar setjump.s @@ -448,6 +500,7 @@ afiles = $(dfiles) $(cfiles) $(hfiles) $(ifiles) $(tfiles) $(mfiles) \ makedev = make -f $(HOME)/makefile.dev CHPAT=$(HOME)/bin/chpat RSYNC=rsync -avessh +UPLOADEE=swissnet_upload dest = $(HOME)/dist/ temp/scm: $(afiles) -$(RM_R) temp @@ -455,13 +508,13 @@ temp/scm: $(afiles) mkdir temp/scm ln $(afiles) temp/scm -release: dist rpm +release: dist pdf # rpm cvs tag -F scm$(VERSION) cp $(srcdir)ANNOUNCE $(htmldir)SCM_ANNOUNCE.txt - $(RSYNC) $(htmldir)SCM.html $(htmldir)SCM_ANNOUNCE.txt nestle.ai.mit.edu:public_html/ + $(RSYNC) $(htmldir)SCM.html $(htmldir)SCM_ANNOUNCE.txt $(UPLOADEE):public_html/ $(RSYNC) $(dest)README $(dest)scm$(VERSION).zip \ $(dest)scm-$(VERSION)-$(RELEASE).src.rpm $(dest)scm-$(VERSION)-$(RELEASE).i386.rpm \ - nestle.ai.mit.edu:dist/ + $(htmldir)hobbit.pdf $(htmldir)Xlibscm.pdf $(UPLOADEE):dist/ # upload $(dest)README $(dest)scm$(VERSION).zip ftp.gnu.org:gnu/jacal/ # $(MAKE) indiana indiana: @@ -478,7 +531,7 @@ postnews: -t "SCM$(VERSION) Released" -d world upzip: $(HOME)/pub/scm.zip - $(RSYNC) $(HOME)/pub/scm.zip nestle.ai.mit.edu:pub/ + $(RSYNC) $(HOME)/pub/scm.zip $(UPLOADEE):pub/ dist: $(dest)scm$(VERSION).zip $(dest)scm$(VERSION).zip: temp/scm @@ -573,9 +626,9 @@ lints: $(cfiles) $(hfiles) SED_TO_STRIP_NM=sed -e '/.*\.o$$/d' -e 's/.* _//' -e 's/.* T //' #old, bad for T [^_] on suns: SED_TO_STRIP_NM=sed -e '/.*\.o$$/d' -e 's/.* _//' # For a System V nm where plain C identifiers have _ prepended: -#SED_TO_STRIP_NM=sed -e '/^_[A-Za-z][A-za-z0-9_]*[ |].*|extern|!d' -e 's/|/ /g' -e 's/^_//' +#SED_TO_STRIP_NM=sed -e '/^_[A-Za-z][A-za-z0-9_]*[ |].*|extern|!d' -e 's/|/ /g' -e 's/^_//' # For a System V nm where plain C identifiers have nothing prepended: -#SED_TO_STRIP_NM=sed -e '/^[A-Za-z][A-za-z0-9_]*[ |].*|extern|!d' -e 's/|/ /g' +#SED_TO_STRIP_NM=sed -e '/^[A-Za-z][A-za-z0-9_]*[ |].*|extern|!d' -e 's/|/ /g' name8: name8s name8s: scmlit @@ -594,8 +647,9 @@ ctags: $(ctagfiles) etags $(ctagfiles) TAGFILES = $(hfiles) $(cfiles) $(ifiles) $(vfiles)\ - version.txi scm.texi Xlibscm.texi hobbit.texi build $(xfiles) $(mfiles) -# # $(ufiles) ChangeLog hobbit.scm + version.txi scm.texi Xlibscm.texi hobbit.texi build $(xfiles) $(mfiles)\ + hobbit.scm +# # $(ufiles) ChangeLog TAGS: $(TAGFILES) etags $(TAGFILES) tags: TAGS @@ -1,9 +1,9 @@ -This directory contains the distribution of scm5d6. Scm conforms to +This directory contains the distribution of scm5d9. 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. - <http://swissnet.ai.mit.edu/~jaffer/SCM.html> + <http://swissnet.ai.mit.edu/~jaffer/SCM> Manifest ======== @@ -24,6 +24,7 @@ Manifest `bench.scm' computes and records performance statistics of pi.scm. `build.bat' invokes build.scm for MS-DOS `build.scm' database for compiling and linking new SCM programs. +`byte.c' strings as bytes. `compile.scm' Hobbit compilation to C. `continue.c' continuations. `continue.h' continuations. @@ -101,22 +102,21 @@ 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: - * swissnet.ai.mit.edu:/pub/scm/slib2d4.tar.gz + * swissnet.ai.mit.edu:/pub/scm/slib3a1.tar.gz - * ftp.gnu.org:/pub/gnu/jacal/slib2d4.tar.gz + * ftp.gnu.org:/pub/gnu/jacal/slib3a1.tar.gz - * ftp.cs.indiana.edu:/pub/scheme-repository/imp/slib2d4.tar.gz + * ftp.cs.indiana.edu:/pub/scheme-repository/imp/slib3a1.tar.gz -Unpack SLIB (`tar xzf slib2d4.tar.gz' or `unzip -ao slib2d4.zip') in an +Unpack SLIB (`tar xzf slib3a1.tar.gz' or `unzip -ao slib3a1.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 `Init5d6.scm' is +(this is the same directory as where the file `Init5d9.scm' is installed). `require.scm' should have the contents: (define (library-vicinity) "/usr/local/lib/slib/") - (load (in-vicinity (library-vicinity) "require")) where the pathname string `/usr/local/lib/slib/' is to be replaced by the pathname into which you installed SLIB. Absolute pathnames are @@ -128,7 +128,6 @@ implementation-vicinity, which is absolute: (define library-vicinity (let ((lv (string-append (implementation-vicinity) "../slib/"))) (lambda () lv))) - (load (in-vicinity (library-vicinity) "require")) Alternatively, you can set the (shell) environment variable `SCHEME_LIBRARY_PATH' to the pathname of the SLIB directory (*note @@ -180,9 +179,6 @@ Editing Scheme Code Gnu Emacs: Editing of Scheme code is supported by emacs. Buffers holding files ending in .scm are automatically put into scheme-mode. - EMACS for MS-DOS and MS-Windows systems is available (free) from: - - <http://simtel.coast.net/SimTel/gnu/demacs.html> 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 @@ -282,17 +278,17 @@ remove <FLAG> in scmfig.h and Do so and recompile files. recompile scm. add <FLAG> in scmfig.h and recompile scm. -ERROR: Init5d6.scm not found. Assign correct IMPLINIT in makefile +ERROR: Init5d9.scm not found. Assign correct IMPLINIT in makefile or scmfig.h. Define environment variable SCM_INIT_PATH to be the full - pathname of Init5d6.scm. + pathname of Init5d9.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 - Init5d6.scm to point to library or + Init5d9.scm to point to library or remove. Make sure the value of (library-vicinity) has a trailing @@ -353,7 +349,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. `Init5d6.scm'). +output files. `Init5d9.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/Xlibscm.html b/Xlibscm.html new file mode 100644 index 0000000..6833e60 --- /dev/null +++ b/Xlibscm.html @@ -0,0 +1,3675 @@ +<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" + "http://www.w3.org/TR/html40/loose.dtd"> +<HTML> +<!-- Created on May, 6 2004 by texi2html 1.66 --> +<!-- +Written by: Lionel Cons <Lionel.Cons@cern.ch> (original author) + Karl Berry <karl@freefriends.org> + Olaf Bachmann <obachman@mathematik.uni-kl.de> + and many others. +Maintained by: Many creative people <dev@texi2html.cvshome.org> +Send bugs and suggestions to <users@texi2html.cvshome.org> + +--> +<HEAD> +<TITLE>Xlibscm</TITLE> + +<META NAME="description" CONTENT="Xlibscm"> +<META NAME="keywords" CONTENT="Xlibscm"> +<META NAME="resource-type" CONTENT="document"> +<META NAME="distribution" CONTENT="global"> +<META NAME="Generator" CONTENT="texi2html 1.66"> + +</HEAD> + +<BODY LANG="en" BGCOLOR="#FFFFFF" TEXT="#000000" LINK="#0000FF" VLINK="#800080" ALINK="#FF0000"> + +<A NAME="SEC_Top"></A> +<TABLE CELLPADDING=1 CELLSPACING=1 BORDER=0> +<TR><TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC_Top">Top</A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC_Contents">Contents</A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[Index]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC_About"> ? </A>]</TD> +</TR></TABLE> +<H1>Xlibscm</H1> + +<P> + +This manual documents the X - SCM Language X Interface. The most recent +information about SCM can be found on SCM's <EM>WWW</EM> home page: +</P> +<P> + +<center> + <A HREF="http://swissnet.ai.mit.edu/~jaffer/SCM">http://swissnet.ai.mit.edu/~jaffer/SCM</A> +</center> +</P> +<P> + +Copyright (C) 1990-1999 Free Software Foundation +</P> +<P> + +Permission is granted to make and distribute verbatim copies of +this manual provided the copyright notice and this permission notice +are preserved on all copies. +</P> +<P> + +Permission is granted to copy and distribute modified versions of this +manual under the conditions for verbatim copying, provided that the entire +resulting derived work is distributed under the terms of a permission +notice identical to this one. +</P> +<P> + +Permission is granted to copy and distribute translations of this manual +into another language, under the above conditions for modified versions, +except that this permission notice may be stated in a translation approved +by the author. +</P> +<P> + +</P> +<TABLE BORDER="0" CELLSPACING="0"> +<TR><TD ALIGN="left" VALIGN="TOP"><A HREF="Xlibscm.html#SEC1">1. Xlibscm</A></TD><TD> </TD><TD ALIGN="left" VALIGN="TOP"></TD></TR> +<TR><TD ALIGN="left" VALIGN="TOP"><A HREF="Xlibscm.html#SEC2">2. Display and Screens</A></TD><TD> </TD><TD ALIGN="left" VALIGN="TOP"></TD></TR> +<TR><TD ALIGN="left" VALIGN="TOP"><A HREF="Xlibscm.html#SEC3">3. Drawables</A></TD><TD> </TD><TD ALIGN="left" VALIGN="TOP"></TD></TR> +<TR><TD ALIGN="left" VALIGN="TOP"><A HREF="Xlibscm.html#SEC7">4. Graphics Context</A></TD><TD> </TD><TD ALIGN="left" VALIGN="TOP"></TD></TR> +<TR><TD ALIGN="left" VALIGN="TOP"><A HREF="Xlibscm.html#SEC9">5. Cursor</A></TD><TD> </TD><TD ALIGN="left" VALIGN="TOP"></TD></TR> +<TR><TD ALIGN="left" VALIGN="TOP"><A HREF="Xlibscm.html#SEC10">6. Colormap</A></TD><TD> </TD><TD ALIGN="left" VALIGN="TOP"></TD></TR> +<TR><TD ALIGN="left" VALIGN="TOP"><A HREF="Xlibscm.html#SEC11">7. Rendering</A></TD><TD> </TD><TD ALIGN="left" VALIGN="TOP"></TD></TR> +<TR><TD ALIGN="left" VALIGN="TOP"><A HREF="Xlibscm.html#SEC14">8. Images</A></TD><TD> </TD><TD ALIGN="left" VALIGN="TOP"></TD></TR> +<TR><TD ALIGN="left" VALIGN="TOP"><A HREF="Xlibscm.html#SEC15">9. Event</A></TD><TD> </TD><TD ALIGN="left" VALIGN="TOP"></TD></TR> +<TR><TD ALIGN="left" VALIGN="TOP"><A HREF="Xlibscm.html#SEC16">Procedure and Macro Index</A></TD><TD> </TD><TD ALIGN="left" VALIGN="TOP"></TD></TR> +</TABLE> +<P> + +<HR SIZE=1> +<A NAME="SEC1"></A> +<TABLE CELLPADDING=1 CELLSPACING=1 BORDER=0> +<TR><TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC_Top"> < </A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC2"> > </A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT"> <TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC_Top"> << </A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC_Top"> Up </A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC2"> >> </A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT"> <TD VALIGN="MIDDLE" ALIGN="LEFT"> <TD VALIGN="MIDDLE" ALIGN="LEFT"> <TD VALIGN="MIDDLE" ALIGN="LEFT"> <TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC_Top">Top</A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC_Contents">Contents</A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[Index]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC_About"> ? </A>]</TD> +</TR></TABLE> +<A NAME="Xlibscm"></A> +<H1> 1. Xlibscm </H1> +<!--docid::SEC1::--> +<P> + +<EM>Xlibscm</EM> is a SCM interface to <EM>X</EM>. +<A NAME="IDX1"></A> +The +<A HREF="http://www.x.org/"> +X Window System +</A> +is a network-transparent window system that was +designed at MIT. +<A HREF="scm_toc.html"> +SCM +</A> +is a portable Scheme implementation written in C. +The interface can be compiled into SCM or, on those platforms supporting +dynamic linking, compiled separately and loaded with <CODE>(require +'Xlib)</CODE>. +<A NAME="IDX2"></A> +</P> +<P> + +Much of this X documentation is dervied from: +</P> +<P> + +<center> + Xlib - C Language X Interface +</center> +<center> + X Consortium Standard +</center> +<center> + X Version 11, Release 6.3 +</center> +</P> +<P> + +The X Window System is a trademark of X Consortium, Inc. +</P> +<P> + +TekHVC is a trademark of Tektronix, Inc. +</P> +<P> + +Copyright (C) 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1994, 1996 X +Consortium +</P> +<P> + +Permission is hereby granted, free of charge, to any person obtaining a +copy of this software and associated documentation files (the +"Software"), to deal in the Software without restriction, including +without limitation the rights to use, copy, modify, merge, publish, +distribute, sublicense, and/or sell copies of the Software, and to +permit persons to whom the Software is furnished to do so, subject to +the following conditions: +</P> +<P> + +The above copyright notice and this permission notice shall be included +in all copies or substantial portions of the Software. +</P> +<P> + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS +OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. +IN NO EVENT SHALL THE X CONSORTIUM BE LIABLE FOR ANY CLAIM, DAMAGES OR +OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, +ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR +OTHER DEALINGS IN THE SOFTWARE. +</P> +<P> + +Except as contained in this notice, the name of the X Consortium shall +not be used in advertising or otherwise to promote the sale, use or +other dealings in this Software without prior written authorization from +the X Consortium. +</P> +<P> + +Copyright (C) 1985, 1986, 1987, 1988, 1989, 1990, 1991 by +Digital Equipment Corporation +</P> +<P> + +Portions Copyright (C) 1990, 1991 by Tektronix, Inc. +</P> +<P> + +Permission to use, copy, modify and distribute this documentation for +any purpose and without fee is hereby granted, provided that the above +copyright notice appears in all copies and that both that copyright +notice and this permission notice appear in all copies, and that the +names of Digital and Tektronix not be used in in advertising or +publicity pertaining to this documentation without specific, written +prior permission. Digital and Tektronix makes no representations about +the suitability of this documentation for any purpose. It is provided +"as is" without express or implied warranty. +</P> +<P> + +<A NAME="Display and Screens"></A> +<HR SIZE="6"> +<A NAME="SEC2"></A> +<TABLE CELLPADDING=1 CELLSPACING=1 BORDER=0> +<TR><TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC1"> < </A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC3"> > </A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT"> <TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC1"> << </A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC_Top"> Up </A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC3"> >> </A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT"> <TD VALIGN="MIDDLE" ALIGN="LEFT"> <TD VALIGN="MIDDLE" ALIGN="LEFT"> <TD VALIGN="MIDDLE" ALIGN="LEFT"> <TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC_Top">Top</A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC_Contents">Contents</A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[Index]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC_About"> ? </A>]</TD> +</TR></TABLE> +<H1> 2. Display and Screens </H1> +<!--docid::SEC2::--> +<P> + +<A NAME="IDX3"></A> +</P> +<DL> +<DT><U>Function:</U> <B>x:open-display</B> <I>display-name</I> +<DD><VAR>display-name</VAR> Specifies the hardware display name, which determines +the display and communications domain to be used. On a POSIX-conformant +system, if the display-name is #f, it defaults to the value of the +<VAR>DISPLAY</VAR> environment variable. +<P> + +The encoding and interpretation of <VAR>display-name</VAR> is +implementation-dependent. On POSIX-conformant systems, the +<VAR>display-name</VAR> or <VAR>DISPLAY</VAR> environment variable can be a string +in the format: +</P> +<P> + +<A NAME="IDX4"></A> +</P> +<DL> +<DT><U>Special Form:</U> <B>hostname:number.screen-number</B> +<DD><P> + +<VAR>hostname</VAR> specifies the name of the host machine on which the +display is physically attached. Follow the <VAR>hostname</VAR> with either a +single colon (:) or a double colon (::). +</P> +<P> + +<VAR>number</VAR> specifies the number of the display server on that host +machine. You may optionally follow this display number with a period +(.). A single CPU can have more than one display. Multiple displays +are usually numbered starting with zero. +</P> +<P> + +<VAR>screen-number</VAR> specifies the screen to be used on that server. +Multiple screens can be controlled by a single X server. The +<VAR>screen-number</VAR> sets an internal variable that can be accessed by +using the x:default-screen procedure. +</P> +</DL> +</DL> +<P> + +<A NAME="IDX5"></A> +</P> +<DL> +<DT><U>Function:</U> <B>x:close</B> <I>display</I> +<DD><VAR>display</VAR> specifies the connection to the X server. +<P> + +The <CODE>x:close</CODE> function closes the connection to the X server for +the <VAR>display</VAR> specified and destroys all windows, resource IDs +(Window, Font, Pixmap, Colormap, Cursor, and GContext), or other +resources that the client has created on this display, unless the +close-down mode of the resource has been changed (see +<CODE>x:set-close-down-mode</CODE>). Therefore, these windows, resource IDs, +and other resources should not be used again or an error will be +generated. Before exiting, you should call <VAR>x:close-display</VAR> or +<VAR>x:flush</VAR> explicitly so that any pending errors are reported. +</P> +</DL> +<P> + +<A NAME="IDX6"></A> +</P> +<DL> +<DT><U>Function:</U> <B>x:protocol-version</B> <I>display</I> +<DD>Returns cons of the major version number (11) of the X protocol +associated with the connected <VAR>display</VAR> and the minor protocol +revision number of the X server. +</DL> +<P> + +<A NAME="IDX7"></A> +</P> +<DL> +<DT><U>Function:</U> <B>x:server-vendor</B> <I>display</I> +<DD>Returns a string that provides some identification of the owner of the X +server implementation. The contents of the string are +implementation-dependent. +</DL> +<P> + +<A NAME="IDX8"></A> +</P> +<DL> +<DT><U>Function:</U> <B>x:vendor-release</B> <I>display</I> +<DD>Returns a number related to a vendor's release of the X server. +</DL> +<P> + +A display consists of one or more <EM>Screen</EM>s. Each screen has a +<EM>root-window</EM>, <EM>default-graphics-context</EM>, and <EM>colormap</EM>. +</P> +<P> + +<A NAME="IDX9"></A> +</P> +<DL> +<DT><U>Function:</U> <B>x:screen-count</B> <I>display</I> +<DD>Returns the number of available screens. +</DL> +<P> + +<A NAME="IDX10"></A> +</P> +<DL> +<DT><U>Function:</U> <B>x:default-screen</B> <I>display</I> +<DD>Returns the default screen number specified by the <CODE>x:open-display</CODE> +function. Use this screen number in applications which will use only a +single screen. +</DL> +<P> + +<A NAME="IDX11"></A> +</P> +<DL> +<DT><U>Function:</U> <B>x:root-window</B> <I>display screen-number</I> +<DD><A NAME="IDX12"></A> +<DT><U>Function:</U> <B>x:root-window</B> <I>display</I> +<DD><VAR>screen-number</VAR>, if givien, specifies the appropriate screen number +on the host server. Otherwise the default-screen for <VAR>display</VAR> is +used. +<P> + +Returns the root window for the specified <VAR>screen-number</VAR>. Use +<CODE>x:root-window</CODE> for functions that need a drawable of a particular +screen or for creating top-level windows. +</P> +<P> + +<A NAME="IDX13"></A> +<DT><U>Function:</U> <B>x:root-window</B> <I>window</I> +<DD>Returns the root window for the specified <VAR>window</VAR>'s screen. +</P> +</DL> +<P> + +<A NAME="IDX14"></A> +</P> +<DL> +<DT><U>Function:</U> <B>x:default-colormap</B> <I>display screen-number</I> +<DD><A NAME="IDX15"></A> +<DT><U>Function:</U> <B>x:default-colormap</B> <I>display</I> +<DD><A NAME="IDX16"></A> +<DT><U>Function:</U> <B>x:default-colormap</B> <I>window</I> +<DD>Returns the default colormap of the specified screen. +</DL> +<P> + +<A NAME="IDX17"></A> +</P> +<DL> +<DT><U>Function:</U> <B>x:default-ccc</B> <I>display screen-number</I> +<DD><A NAME="IDX18"></A> +<DT><U>Function:</U> <B>x:default-ccc</B> <I>display</I> +<DD><A NAME="IDX19"></A> +<DT><U>Function:</U> <B>x:default-ccc</B> <I>window</I> +<DD>Returns the default Color-Conversion-Context (ccc) of the specified +screen. +</DL> +<P> + +<A NAME="IDX20"></A> +</P> +<DL> +<DT><U>Function:</U> <B>x:default-gc</B> <I>display screen-number</I> +<DD><A NAME="IDX21"></A> +<DT><U>Function:</U> <B>x:default-gc</B> <I>display</I> +<DD><A NAME="IDX22"></A> +<DT><U>Function:</U> <B>x:default-gc</B> <I>window</I> +<DD>Returns the default graphics-context of the specified screen. +</DL> +<P> + +<A NAME="IDX23"></A> +</P> +<DL> +<DT><U>Function:</U> <B>x:screen-depths</B> <I>display screen-number</I> +<DD><A NAME="IDX24"></A> +<DT><U>Function:</U> <B>x:screen-depths</B> <I>display</I> +<DD><A NAME="IDX25"></A> +<DT><U>Function:</U> <B>x:screen-depths</B> <I>window</I> +<DD>Returns an array of depths supported by the specified screen. +</DL> +<P> + +The <EM>Visual</EM> type describes possible colormap depths and +arrangements. +</P> +<P> + +<A NAME="IDX26"></A> +</P> +<DL> +<DT><U>Function:</U> <B>x:default-visual</B> <I>display screen-number</I> +<DD><A NAME="IDX27"></A> +<DT><U>Function:</U> <B>x:default-visual</B> <I>display</I> +<DD><A NAME="IDX28"></A> +<DT><U>Function:</U> <B>x:default-visual</B> <I>window</I> +<DD>Returns the default Visual type for the specified screen. +<P> + +<A NAME="IDX29"></A> +<A NAME="IDX30"></A> +</P> +</DL> +<P> + +<A NAME="IDX31"></A> +</P> +<DL> +<DT><U>Function:</U> <B>x:make-visual</B> <I>display depth class</I> +<DD><A NAME="IDX32"></A> +<DT><U>Function:</U> <B>x:make-visual</B> <I>window depth class</I> +<DD><P> + +The integer <VAR>depth</VAR> specifies the number of bits per pixel. +The <VAR>class</VAR> argument specifies one of the possible +visual classes for a screen: +<UL> +<LI>x:Static-Gray +<LI>x:Static-Color +<LI>x:True-Color +<LI>x:Gray-Scale +<LI>x:Pseudo-Color +<LI>x:Direct-Color +</UL> +<P> + +<CODE>X:make-visual</CODE> returns a visual type for the screen specified by +<VAR>display</VAR> or <VAR>window</VAR> if successful; #f if not. +</P> +</DL> +<P> + +<A NAME="IDX33"></A> +</P> +<DL> +<DT><U>Function:</U> <B>x:visual-class</B> <I>visual</I> +<DD><A NAME="IDX34"></A> +<DT><U>Function:</U> <B>x:visual-class</B> <I>screen</I> +<DD><A NAME="IDX35"></A> +<DT><U>Function:</U> <B>x:visual-class</B> <I>display</I> +<DD>Returns the (integer) visual class of its argument. +</DL> +<P> + +<A NAME="IDX36"></A> +</P> +<DL> +<DT><U>Function:</U> <B>x:visual-geometry</B> <I>visual</I> +<DD><A NAME="IDX37"></A> +<DT><U>Function:</U> <B>x:visual-geometry</B> <I>screen</I> +<DD><A NAME="IDX38"></A> +<DT><U>Function:</U> <B>x:visual-geometry</B> <I>display</I> +<DD>Returns a list of the: +<UL> +<LI>red_mask +<LI>green_mask +<LI>blue_mask +<LI>colormap_size +</UL> +</DL> +<P> + +<A NAME="IDX39"></A> +</P> +<DL> +<DT><U>Function:</U> <B>x:screen-cells</B> <I>display screen-number</I> +<DD><A NAME="IDX40"></A> +<DT><U>Function:</U> <B>x:screen-cells</B> <I>display</I> +<DD><A NAME="IDX41"></A> +<DT><U>Function:</U> <B>x:screen-cells</B> <I>window</I> +<DD>Returns the number of entries in the default colormap. +</DL> +<P> + +<A NAME="IDX42"></A> +</P> +<DL> +<DT><U>Function:</U> <B>x:screen-depth</B> <I>display screen-number</I> +<DD>Returns the depth of the root window of the specified screen. +<A NAME="IDX43"></A> +<DT><U>Function:</U> <B>x:screen-depth</B> <I>display</I> +<DD><A NAME="IDX44"></A> +<DT><U>Function:</U> <B>x:screen-depth</B> <I>window</I> +<DD><A NAME="IDX45"></A> +<DT><U>Function:</U> <B>x:screen-depth</B> <I>visual</I> +<DD>Returns the depth of argument. +<P> + +<A NAME="IDX46"></A> +The <EM>depth</EM> of a window or pixmap is the number of bits per pixel it has. +The <EM>depth</EM> of a graphics context is the depth of the drawables it can be +used in conjunction with graphics output. +</P> +</DL> +<P> + +<A NAME="IDX47"></A> +</P> +<DL> +<DT><U>Function:</U> <B>x:screen-size</B> <I>display screen-number</I> +<DD><A NAME="IDX48"></A> +<DT><U>Function:</U> <B>x:screen-size</B> <I>display</I> +<DD><A NAME="IDX49"></A> +<DT><U>Function:</U> <B>x:screen-size</B> <I>window</I> +<DD>Returns a list of integer height and width of the screen in pixels. +</DL> +<P> + +<A NAME="IDX50"></A> +</P> +<DL> +<DT><U>Function:</U> <B>x:screen-dimensions</B> <I>display screen-number</I> +<DD><A NAME="IDX51"></A> +<DT><U>Function:</U> <B>x:screen-dimensions</B> <I>display</I> +<DD><A NAME="IDX52"></A> +<DT><U>Function:</U> <B>x:screen-dimensions</B> <I>window</I> +<DD>Returns a list of integer height and width of the screen in millimeters. +</DL> +<P> + +<A NAME="IDX53"></A> +</P> +<DL> +<DT><U>Function:</U> <B>x:screen-white</B> <I>display screen-number</I> +<DD><A NAME="IDX54"></A> +<DT><U>Function:</U> <B>x:screen-white</B> <I>display</I> +<DD><A NAME="IDX55"></A> +<DT><U>Function:</U> <B>x:screen-white</B> <I>window</I> +<DD>Returns the white pixel value of the specified screen. +</DL> +<P> + +<A NAME="IDX56"></A> +</P> +<DL> +<DT><U>Function:</U> <B>x:screen-black</B> <I>display screen-number</I> +<DD><A NAME="IDX57"></A> +<DT><U>Function:</U> <B>x:screen-black</B> <I>display</I> +<DD><A NAME="IDX58"></A> +<DT><U>Function:</U> <B>x:screen-black</B> <I>window</I> +<DD>Returns the black pixel value of the specified screen. +</DL> +<P> + +<A NAME="Drawables"></A> +<HR SIZE="6"> +<A NAME="SEC3"></A> +<TABLE CELLPADDING=1 CELLSPACING=1 BORDER=0> +<TR><TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC2"> < </A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC4"> > </A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT"> <TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC2"> << </A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC_Top"> Up </A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC7"> >> </A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT"> <TD VALIGN="MIDDLE" ALIGN="LEFT"> <TD VALIGN="MIDDLE" ALIGN="LEFT"> <TD VALIGN="MIDDLE" ALIGN="LEFT"> <TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC_Top">Top</A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC_Contents">Contents</A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[Index]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC_About"> ? </A>]</TD> +</TR></TABLE> +<H1> 3. Drawables </H1> +<!--docid::SEC3::--> +<P> + +<A NAME="IDX59"></A> +<A NAME="IDX60"></A> +A <EM>Drawable</EM> is either a window or pixmap. +</P> +<P> + +<TABLE BORDER="0" CELLSPACING="0"> +<TR><TD ALIGN="left" VALIGN="TOP"><A HREF="Xlibscm.html#SEC4">3.1 Windows and Pixmaps</A></TD><TD> </TD><TD ALIGN="left" VALIGN="TOP"></TD></TR> +<TR><TD ALIGN="left" VALIGN="TOP"><A HREF="Xlibscm.html#SEC5">3.2 Window Attributes</A></TD><TD> </TD><TD ALIGN="left" VALIGN="TOP"></TD></TR> +<TR><TD ALIGN="left" VALIGN="TOP"><A HREF="Xlibscm.html#SEC6">3.3 Window Properties and Visibility</A></TD><TD> </TD><TD ALIGN="left" VALIGN="TOP"></TD></TR> +</TABLE> +<P> + +<A NAME="Windows and Pixmaps"></A> +<HR SIZE="6"> +<A NAME="SEC4"></A> +<TABLE CELLPADDING=1 CELLSPACING=1 BORDER=0> +<TR><TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC3"> < </A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC5"> > </A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT"> <TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC3"> << </A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC3"> Up </A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC7"> >> </A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT"> <TD VALIGN="MIDDLE" ALIGN="LEFT"> <TD VALIGN="MIDDLE" ALIGN="LEFT"> <TD VALIGN="MIDDLE" ALIGN="LEFT"> <TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC_Top">Top</A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC_Contents">Contents</A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[Index]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC_About"> ? </A>]</TD> +</TR></TABLE> +<H2> 3.1 Windows and Pixmaps </H2> +<!--docid::SEC4::--> +<P> + +<A NAME="IDX61"></A> +</P> +<DL> +<DT><U>Function:</U> <B>x:create-window</B> <I>window position size border-width depth class visual field-name value <small>...</small></I> +<DD>Creates and returns an unmapped Input-Output subwindow for a specified +parent <VAR>window</VAR> and causes the X server to generate a CreateNotify +event. The created window is placed on top in the stacking order with +respect to siblings. Any part of the window that extends outside its +parent <VAR>window</VAR> is clipped. The <VAR>border-width</VAR> for an +x:Input-Only window must be zero. +<P> + +The coordinate system has the X axis horizontal and the Y axis vertical +with the origin [0, 0] at the upper-left corner. Coordinates are +integral, in terms of pixels, and coincide with pixel centers. Each +window and pixmap has its own coordinate system. For a window, the +origin is inside the border at the inside, upper-left corner. +</P> +<P> + +<VAR>Class</VAR> can be x:Input-Output, x:Input-Only, or x:Copy-From-Parent. +For class x:Input-Output, the <VAR>visual</VAR> type and <VAR>depth</VAR> must be +a combination supported for the screen. The <VAR>depth</VAR> need not be the +same as the parent, but the parent must not be a window of class +x:Input-Only. For an x:Input-Only window, the <VAR>depth</VAR> must be zero, +and the <VAR>visual</VAR> must be one supported by the screen. +</P> +<P> + +The returned window will have the attributes specified by +<VAR>field-name</VAR>s and <VAR>value</VAR>. +</P> +<P> + +<A NAME="IDX62"></A> +<DT><U>Function:</U> <B>x:create-window</B> <I>window position size border-width border background</I> +<DD>The returned window inherits its depth, class, and visual from its +parent. All other window attributes, except <VAR>background</VAR> and +<VAR>border</VAR>, have their default values. +</P> +</DL> +<P> + +<A NAME="IDX63"></A> +</P> +<DL> +<DT><U>Function:</U> <B>x:create-pixmap</B> <I>drawable size depth</I> +<DD><A NAME="IDX64"></A> +<DT><U>Function:</U> <B>x:create-pixmap</B> <I>display size depth</I> +<DD><P> + +<VAR>size</VAR> is a list, vector, or pair of nonzero integers specifying the width +and height desired in the new pixmap. +</P> +<P> + +<VAR>x:create-pixmap</VAR> returns a new pixmap of the width, height, and +<VAR>depth</VAR> specified. It is valid to pass an x:Input-Only window to the +drawable argument. The <VAR>depth</VAR> argument must be one of the depths +supported by the screen of the specified <VAR>drawable</VAR>. +</P> +</DL> +<P> + +<A NAME="IDX65"></A> +</P> +<DL> +<DT><U>Function:</U> <B>x:close</B> <I>window</I> +<DD>Destroys the specified <VAR>window</VAR> as well as all of its subwindows and +causes the X server to generate a DestroyNotify event for each window. +The window should not be used again. If the window specified by the +<VAR>window</VAR> argument is mapped, it is unmapped automatically. The +ordering of the DestroyNotify events is such that for any given window +being destroyed, DestroyNotify is generated on any inferiors of the +window before being generated on the window itself. The ordering among +siblings and across subhierarchies is not otherwise constrained. If the +<VAR>window</VAR> you specified is a root window, an error is signaled. +Destroying a mapped <VAR>window</VAR> will generate x:Expose events on other +windows that were obscured by the window being destroyed. +</DL> +<P> + +<A NAME="IDX66"></A> +</P> +<DL> +<DT><U>Function:</U> <B>x:close</B> <I>pixmap</I> +<DD>Deletes the association between the <VAR>pixmap</VAR> and its storage. The X +server frees the pixmap storage when there are no references to it. +</DL> +<P> + +<A NAME="IDX67"></A> +</P> +<DL> +<DT><U>Function:</U> <B>x:window-geometry</B> <I>drawable</I> +<DD>Returns a list of: +<P> + +</P> +<DL COMPACT> +<DT>coordinates +<DD><CODE>list</CODE> of x and y coordinates that define the location of the +<VAR>drawable</VAR>. For a window, these coordinates specify the upper-left +outer corner relative to its parent's origin. For pixmaps, these +coordinates are always zero. +<DT>size +<DD><CODE>list</CODE> of the <VAR>drawable</VAR>'s dimensions (width and height). For +a window, these dimensions specify the inside size, not including the +border. +<DT>border-width +<DD>The border width in pixels. If the <VAR>drawable</VAR> is a pixmap, this is +zero. +<DT>depth +<DD>The depth of the <VAR>drawable</VAR> (bits per pixel for the object). +</DL> +</DL> +<P> + +<A NAME="IDX68"></A> +</P> +<DL> +<DT><U>Function:</U> <B>x:window-geometry-set!</B> <I>window field-name value <small>...</small></I> +<DD>Changes the <EM>Configuration</EM> components specified by +<VAR>field-name</VAR>s for the specified <VAR>window</VAR>. +</DL> +<P> + +These are the attributes settable by <CODE>x:window-geometry-set!</CODE>. +That these attributes are encoded by small integers -- just like those +of the next section. Be warned therefore that confusion of attribute +names will likely not signal errors, just cause mysterious behavior. +</P> +<P> + +<A NAME="IDX69"></A> +</P> +<DL> +<DT><U>Attribute:</U> <B>x:CWX</B> +<DD><A NAME="IDX70"></A> +<DT><U>Attribute:</U> <B>x:CWY</B> +<DD><A NAME="IDX71"></A> +<DT><U>Attribute:</U> <B>x:CW-Width</B> +<DD><A NAME="IDX72"></A> +<DT><U>Attribute:</U> <B>x:CW-Height</B> +<DD>The x:CWX and x:CYY members are used to set the window's x and y +coordinates, which are relative to the parent's origin and indicate the +position of the upper-left outer corner of the window. The x:CW-Width +and x:CW-Height members are used to set the inside size of the window, +not including the border, and must be nonzero. Attempts to configure a +root window have no effect. +<P> + +If a window's size actually changes, the window's subwindows move +according to their window gravity. Depending on the window's bit +gravity, the contents of the window also may be moved +</P> +</DL> +<P> + +<A NAME="IDX73"></A> +</P> +<DL> +<DT><U>Attribute:</U> <B>x:CW-Border-Width</B> +<DD>The integer x:CW-Border-Width is used to set the width of the border in +pixels. Note that setting just the border width leaves the outer-left +corner of the window in a fixed position but moves the absolute position +of the window's origin. It is an error to set the border-width +attribute of an InputOnly window nonzero. +</DL> +<P> + +<A NAME="IDX74"></A> +</P> +<DL> +<DT><U>Attribute:</U> <B>x:CW-Sibling</B> +<DD>The sibling member is used to set the sibling window for stacking +operations. +</DL> +<P> + +<A NAME="IDX75"></A> +</P> +<DL> +<DT><U>Attribute:</U> <B>x:CW-Stack-Mode</B> +<DD>The x:CW-Stack-Mode member is used to set how the window is to be +restacked and can be set to x:Above, x:Below, x:Top-If, x:Bottom-If, or +x:Opposite. +</DL> +<P> + +If a sibling and a stack-mode are specified, the window is restacked as +follows: +</P> +<P> + +</P> +<DL COMPACT> +<DT><CODE>x:Above</CODE> +<DD>The window is placed just above the sibling. +<DT><CODE>x:Below</CODE> +<DD>The window is placed just below the sibling. +<DT><CODE>x:Top-If</CODE> +<DD>If the sibling occludes the window, the window is placed at the top of +the stack. +<DT><CODE>x:Bottom-If</CODE> +<DD>If the window occludes the sibling, the window is placed at the bottom +of the stack. +<DT><CODE>x:Opposite</CODE> +<DD>If the sibling occludes the window, the window is placed at the top of +the stack. If the window occludes the sibling, the window is placed at +the bottom of the stack. +</DL> +<P> + +If a stack-mode is specified but no sibling is specified, the window +is restacked as follows: +</P> +<P> + +</P> +<DL COMPACT> +<DT><CODE>x:Above</CODE> +<DD>The window is placed at the top of the stack. +<DT><CODE>x:Below</CODE> +<DD>The window is placed at the bottom of the stack. +<DT><CODE>x:Top-If</CODE> +<DD>If any sibling occludes the window, the window is placed at the top of +the stack. +<DT><CODE>x:Bottom-If</CODE> +<DD>If the window occludes any sibling, the window is placed at the bottom +of the stack. +<DT><CODE>x:Opposite</CODE> +<DD>If any sibling occludes the window, the window is placed at the top of +the stack. If the window occludes any sibling, the window is placed at +the bottom of the stack. +</DL> +<P> + +<A NAME="Window Attributes"></A> +<HR SIZE="6"> +<A NAME="SEC5"></A> +<TABLE CELLPADDING=1 CELLSPACING=1 BORDER=0> +<TR><TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC4"> < </A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC6"> > </A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT"> <TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC3"> << </A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC3"> Up </A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC7"> >> </A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT"> <TD VALIGN="MIDDLE" ALIGN="LEFT"> <TD VALIGN="MIDDLE" ALIGN="LEFT"> <TD VALIGN="MIDDLE" ALIGN="LEFT"> <TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC_Top">Top</A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC_Contents">Contents</A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[Index]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC_About"> ? </A>]</TD> +</TR></TABLE> +<H2> 3.2 Window Attributes </H2> +<!--docid::SEC5::--> +<P> + +<A NAME="IDX76"></A> +</P> +<DL> +<DT><U>Function:</U> <B>x:window-set!</B> <I>window field-name value <small>...</small></I> +<DD>Changes the components specified by <VAR>field-name</VAR>s for the specified +<VAR>window</VAR>. The restrictions are the same as for +<CODE>x:create-window</CODE>. The order in which components are verified and +altered is server dependent. If an error occurs, a subset of the +components may have been altered. +</DL> +<P> + +The <CODE>x:create-window</CODE> and <CODE>x:window-set!</CODE> procedures take five +and one argument (respectively) followed by pairs of arguments, where +the first is one of the property-name symbols (or its top-level value) +listed below; and the second is the value to associate with that +property. +</P> +<P> + +<A NAME="IDX77"></A> +</P> +<DL> +<DT><U>Attribute:</U> <B>x:CW-Back-Pixmap</B> +<DD>Sets the background pixmap of the <VAR>window</VAR> to the specified pixmap. +The background pixmap can immediately be freed if no further explicit +references to it are to be made. If x:Parent-Relative is specified, the +background pixmap of the window's parent is used, or on the root window, +the default background is restored. It is an error to perform this +operation on an x:Input-Only window. If the background is set to #f or +None, the window has no defined background. +</DL> +<P> + +<A NAME="IDX78"></A> +</P> +<DL> +<DT><U>Attribute:</U> <B>x:CW-Back-Pixel</B> +<DD>Sets the background of the <VAR>window</VAR> to the specified pixel value. +Changing the background does not cause the <VAR>window</VAR> contents to be +changed. It is an error to perform this operation on an x:Input-Only +window. +</DL> +<P> + +<A NAME="IDX79"></A> +</P> +<DL> +<DT><U>Attribute:</U> <B>x:CW-Border-Pixmap</B> +<DD>Sets the border pixmap of the <VAR>window</VAR> to the pixmap you specify. +The border pixmap can be freed if no further explicit references to it +are to be made. If you specify x:Copy-From-Parent, a copy of the parent +window's border pixmap is used. It is an error to perform this +operation on an x:Input-Only <VAR>window</VAR>. +</DL> +<P> + +<A NAME="IDX80"></A> +</P> +<DL> +<DT><U>Attribute:</U> <B>x:CW-Border-Pixel</B> +<DD>Sets the border of the <VAR>window</VAR> to the pixel <VAR>value</VAR>. It is an +error to perform this operation on an x:Input-Only window. +</DL> +<P> + +<A NAME="IDX81"></A> +</P> +<DL> +<DT><U>Attribute:</U> <B>x:CW-Bit-Gravity</B> +<DD><A NAME="IDX82"></A> +<DT><U>Attribute:</U> <B>x:CW-Win-Gravity</B> +<DD>The bit gravity of a window defines which region of the window should be +retained when an x:Input-Output window is resized. The default value +for the bit-gravity attribute is x:Forget-Gravity. The window gravity +of a window allows you to define how the x:Input-Output or x:Input-Only +window should be repositioned if its parent is resized. The default +value for the win-gravity attribute is x:North-West-Gravity. +<P> + +If the inside width or height of a window is not changed and if the +window is moved or its border is changed, then the contents of the +window are not lost but move with the window. Changing the inside width +or height of the window causes its contents to be moved or lost +(depending on the bit-gravity of the window) and causes children to be +reconfigured (depending on their win-gravity). For a change of width +and height, the (x, y) pairs are defined: +</P> +<P> + +</P> +<TABLE> +<TR><TD>Gravity Direction</TD> +</TD><TD> Coordinates +</TR> +<TR><TD>x:North-West-Gravity</TD> +</TD><TD> (0, 0) +</TR> +<TR><TD>x:North-Gravity</TD> +</TD><TD> (Width/2, 0) +</TR> +<TR><TD>x:North-East-Gravity</TD> +</TD><TD> (Width, 0) +</TR> +<TR><TD>x:West-Gravity</TD> +</TD><TD> (0, Height/2) +</TR> +<TR><TD>x:Center-Gravity</TD> +</TD><TD> (Width/2, Height/2) +</TR> +<TR><TD>x:East-Gravity</TD> +</TD><TD> (Width, Height/2) +</TR> +<TR><TD>x:South-West-Gravity</TD> +</TD><TD> (0, Height) +</TR> +<TR><TD>x:South-Gravity</TD> +</TD><TD> (Width/2, Height) +</TR> +<TR><TD>x:South-East-Gravity</TD> +</TD><TD> (Width, Height) +</TR></TABLE> +<P> + +When a window with one of these bit-gravity values is resized, the +corresponding pair defines the change in position of each pixel in the +window. When a window with one of these win-gravities has its parent +window resized, the corresponding pair defines the change in position of +the window within the parent. When a window is so repositioned, a +x:Gravity-Notify event is generated (see section 10.10.5). +</P> +<P> + +A bit-gravity of x:Static-Gravity indicates that the contents or origin +should not move relative to the origin of the root window. If the +change in size of the window is coupled with a change in position (x, +y), then for bit-gravity the change in position of each pixel is (-x, +-y), and for win-gravity the change in position of a child when its +parent is so resized is (-x, -y). Note that x:Static-Gravity still only +takes effect when the width or height of the window is changed, not when +the window is moved. +</P> +<P> + +A bit-gravity of x:Forget-Gravity indicates that the window's contents +are always discarded after a size change, even if a backing store or +save under has been requested. The window is tiled with its background +and zero or more x:Expose events are generated. If no background is +defined, the existing screen contents are not altered. Some X servers +may also ignore the specified bit-gravity and always generate x:Expose +events. +</P> +<P> + +The contents and borders of inferiors are not affected by their parent's +bit-gravity. A server is permitted to ignore the specified bit-gravity +and use x:Forget-Gravity instead. +</P> +<P> + +A win-gravity of x:Unmap-Gravity is like x:North-West-Gravity (the +window is not moved), except the child is also unmapped when the parent +is resized, and an x:Unmap-Notify event is generated. +</P> +</DL> +<P> + +<A NAME="IDX83"></A> +</P> +<DL> +<DT><U>Attribute:</U> <B>x:CW-Backing-Store</B> +<DD>Some implementations of the X server may choose to maintain the contents +of x:Input-Output windows. If the X server maintains the contents of a +window, the off-screen saved pixels are known as backing store. The +backing store advises the X server on what to do with the contents of a +window. The backing-store attribute can be set to x:Not-Useful +(default), x:When-Mapped, or x:Always. A backing-store attribute of +x:Not-Useful advises the X server that maintaining contents is +unnecessary, although some X implementations may still choose to +maintain contents and, therefore, not generate x:Expose events. A +backing-store attribute of x:When-Mapped advises the X server that +maintaining contents of obscured regions when the window is mapped would +be beneficial. In this case, the server may generate an x:Expose event +when the window is created. A backing-store attribute of x:Always +advises the X server that maintaining contents even when the window is +unmapped would be beneficial. Even if the window is larger than its +parent, this is a request to the X server to maintain complete contents, +not just the region within the parent window boundaries. While the X +server maintains the window's contents, x:Expose events normally are not +generated, but the X server may stop maintaining contents at any time. +<P> + +When the contents of obscured regions of a window are being maintained, +regions obscured by noninferior windows are included in the destination +of graphics requests (and source, when the window is the source). +However, regions obscured by inferior windows are not included. +</P> +</DL> +<P> + +<A NAME="IDX84"></A> +</P> +<DL> +<DT><U>Attribute:</U> <B>x:CW-Backing-Planes</B> +<DD><A NAME="IDX85"></A> +<DT><U>Attribute:</U> <B>x:CW-Backing-Pixel</B> +<DD>You can set backing planes to indicate (with bits set to 1) which bit +planes of an x:Input-Output window hold dynamic data that must be +preserved in backing store and during save unders. The default value +for the backing-planes attribute is all bits set to 1. You can set +backing pixel to specify what bits to use in planes not covered by +backing planes. The default value for the backing-pixel attribute is +all bits set to 0. The X server is free to save only the specified bit +planes in the backing store or the save under and is free to regenerate +the remaining planes with the specified pixel value. Any extraneous +bits in these values (that is, those bits beyond the specified depth of +the window) may be simply ignored. If you request backing store or save +unders, you should use these members to minimize the amount of +off-screen memory required to store your window. +</DL> +<P> + +<A NAME="IDX86"></A> +</P> +<DL> +<DT><U>Attribute:</U> <B>x:CW-Override-Redirect</B> +<DD>To control window placement or to add decoration, a window manager often +needs to intercept (redirect) any map or configure request. Pop-up +windows, however, often need to be mapped without a window manager +getting in the way. To control whether an x:Input-Output or +x:Input-Only window is to ignore these structure control facilities, use +the override-redirect flag. +<P> + +The override-redirect flag specifies whether map and configure requests +on this window should override a x:Substructure-Redirect-Mask on the +parent. You can set the override-redirect flag to #t or #f (default). +Window managers use this information to avoid tampering with pop-up +windows. +</P> +</DL> +<P> + +<A NAME="IDX87"></A> +</P> +<DL> +<DT><U>Attribute:</U> <B>x:CW-Save-Under</B> +<DD>Some server implementations may preserve contents of x:Input-Output windows +under other x:Input-Output windows. This is not the same as preserving the +contents of a window for you. You may get better visual appeal if +transient windows (for example, pop-up menus) request that the system +preserve the screen contents under them, so the temporarily obscured +applications do not have to repaint. +<P> + +You can set the save-under flag to True or False (default). If +save-under is True, the X server is advised that, when this window is +mapped, saving the contents of windows it obscures would be beneficial. +</P> +</DL> +<P> + +<A NAME="IDX88"></A> +</P> +<DL> +<DT><U>Attribute:</U> <B>x:CW-Event-Mask</B> +<DD>The event mask defines which events the client is interested in for this +x:Input-Output or x:Input-Only window (or, for some event types, +inferiors of this window). The event mask is the bitwise inclusive OR +of zero or more of the valid event mask bits. You can specify that no +maskable events are reported by setting x:No-Event-Mask (default). +<P> + +The following table lists the event mask constants you can pass to the +event-mask argument and the circumstances in which you would want to +specify the event mask: +</P> +<P> + +</P> +<TABLE> +<TR><TD>Event Mask</TD> +</TD><TD> Circumstances +</TR> +<TR><TD>x:No-Event-Mask</TD> +</TD><TD> No events wanted +</TR> +<TR><TD>x:Key-Press-Mask</TD> +</TD><TD> Keyboard down events wanted +</TR> +<TR><TD>x:Key-Release-Mask</TD> +</TD><TD> Keyboard up events wanted +</TR> +<TR><TD>x:Button-Press-Mask</TD> +</TD><TD> Pointer button down events wanted +</TR> +<TR><TD>x:Button-Release-Mask</TD> +</TD><TD> Pointer button up events wanted +</TR> +<TR><TD>x:Enter-Window-Mask</TD> +</TD><TD> Pointer window entry events wanted +</TR> +<TR><TD>x:Leave-Window-Mask</TD> +</TD><TD> Pointer window leave events wanted +</TR> +<TR><TD>x:Pointer-Motion-Mask</TD> +</TD><TD> Pointer motion events wanted +</TR> +<TR><TD>x:Pointer-Motion-Hint-Mask</TD> +</TD><TD> +If x:Pointer-Motion-Hint-Mask is selected in combination with one or +more motion-masks, the X server is free to send only one x:Motion-Notify +event (with the is_hint member of the X:Pointer-Moved-Event structure +set to x:Notify-Hint) to the client for the event window, until either +the key or button state changes, the pointer leaves the event window, or +the client calls X:Query-Pointer or X:Get-Motion-Events. The server +still may send x:Motion-Notify events without is_hint set to +x:Notify-Hint. +</TR> +<TR><TD>x:Button1-Motion-Mask</TD> +</TD><TD> Pointer motion while button 1 down +</TR> +<TR><TD>x:Button2-Motion-Mask</TD> +</TD><TD> Pointer motion while button 2 down +</TR> +<TR><TD>x:Button3-Motion-Mask</TD> +</TD><TD> Pointer motion while button 3 down +</TR> +<TR><TD>x:Button4-Motion-Mask</TD> +</TD><TD> Pointer motion while button 4 down +</TR> +<TR><TD>x:Button5-Motion-Mask</TD> +</TD><TD> Pointer motion while button 5 down +</TR> +<TR><TD>x:Button-Motion-Mask</TD> +</TD><TD> Pointer motion while any button down +</TR> +<TR><TD>x:Keymap-State-Mask</TD> +</TD><TD> Keyboard state wanted at window entry and focus in +</TR> +<TR><TD>x:Exposure-Mask</TD> +</TD><TD> Any exposure wanted +</TR> +<TR><TD>x:Visibility-Change-Mask</TD> +</TD><TD> Any change in visibility wanted +</TR> +<TR><TD>x:Structure-Notify-Mask</TD> +</TD><TD> Any change in window structure wanted +</TR> +<TR><TD>x:Resize-Redirect-Mask</TD> +</TD><TD> Redirect resize of this window +</TR> +<TR><TD>x:Substructure-Notify-Mask</TD> +</TD><TD> Substructure notification wanted +</TR> +<TR><TD>x:Substructure-Redirect-Mask</TD> +</TD><TD> Redirect structure requests on children +</TR> +<TR><TD>x:Focus-Change-Mask</TD> +</TD><TD> Any change in input focus wanted +</TR> +<TR><TD>x:Property-Change-Mask</TD> +</TD><TD> Any change in property wanted +</TR> +<TR><TD>x:Colormap-Change--Mask</TD> +</TD><TD> Any change in colormap wanted +</TR> +<TR><TD>x:Owner-Grab-Button--Mask</TD> +</TD><TD> Automatic grabs should activate with owner_events set to True +</TR></TABLE> +<P> + +</P> +</DL> +<P> + +<A NAME="IDX89"></A> +</P> +<DL> +<DT><U>Attribute:</U> <B>x:CW-Dont-Propagate</B> +<DD>The do-not-propagate-mask attribute defines which events should not be +propagated to ancestor windows when no client has the event type +selected in this x:Input-Output or x:Input-Only window. The +do-not-propagate-mask is the bitwise inclusive OR of zero or more of the +following masks: x:Key-Press, x:Key-Release, x:Button-Press, +x:Button-Release, x:Pointer-Motion, x:Button1Motion, x:Button2Motion, +x:Button3Motion, x:Button4Motion, x:Button5Motion, and x:Button-Motion. +You can specify that all events are propagated by setting +x:No-Event-Mask (default). +</DL> +<P> + +<A NAME="IDX90"></A> +</P> +<DL> +<DT><U>Attribute:</U> <B>x:CW-Colormap</B> +<DD>The colormap attribute specifies which colormap best reflects the true +colors of the x:Input-Output window. The colormap must have the same +visual type as the window. X servers capable of supporting multiple +hardware colormaps can use this information, and window managers can use +it for calls to X:Install-Colormap. You can set the colormap attribute +to a colormap or to x:Copy-From-Parent (default). +<P> + +If you set the colormap to x:Copy-From-Parent, the parent window's +colormap is copied and used by its child. However, the child window +must have the same visual type as the parent. The parent window must +not have a colormap of x:None. The colormap is copied by sharing the +colormap object between the child and parent, not by making a complete +copy of the colormap contents. Subsequent changes to the parent +window's colormap attribute do not affect the child window. +</P> +</DL> +<P> + +<A NAME="IDX91"></A> +</P> +<DL> +<DT><U>Attribute:</U> <B>x:CW-Cursor</B> +<DD>The cursor attribute specifies which cursor is to be used when the +pointer is in the x:Input-Output or x:Input-Only window. You can set +the cursor to a cursor or x:None (default). +<P> + +If you set the cursor to x:None, the parent's cursor is used when the +pointer is in the x:Input-Output or x:Input-Only window, and any change +in the parent's cursor will cause an immediate change in the displayed +cursor. On the root window, the default cursor is restored. +</P> +</DL> +<P> + +<A NAME="IDX92"></A> +</P> +<DL> +<DT><U>Function:</U> <B>x:window-ref</B> <I>window field-name <small>...</small></I> +<DD>Returns a list of the components specified by <VAR>field-name</VAR>s for the +specified <VAR>window</VAR>. Allowable <VAR>field-name</VAR>s are a subset of +those for <CODE>x:window-set!</CODE>: +<P> + +<UL> +<LI>x:CW-Back-Pixel +<LI>x:CW-Bit-Gravity +<LI>x:CW-Win-Gravity +<LI>x:CW-Backing-Store +<LI>x:CW-Backing-Planes +<LI>x:CW-Backing-Pixel +<LI>x:CW-Override-Redirect +<LI>x:CW-Save-Under +<LI>x:CW-Event-Mask +<LI>x:CW-Dont-Propagate +<LI>x:CW-Colormap +</UL> +</DL> +<P> + +<A NAME="Window Properties and Visibility"></A> +<HR SIZE="6"> +<A NAME="SEC6"></A> +<TABLE CELLPADDING=1 CELLSPACING=1 BORDER=0> +<TR><TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC5"> < </A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC7"> > </A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT"> <TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC3"> << </A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC3"> Up </A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC7"> >> </A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT"> <TD VALIGN="MIDDLE" ALIGN="LEFT"> <TD VALIGN="MIDDLE" ALIGN="LEFT"> <TD VALIGN="MIDDLE" ALIGN="LEFT"> <TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC_Top">Top</A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC_Contents">Contents</A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[Index]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC_About"> ? </A>]</TD> +</TR></TABLE> +<H2> 3.3 Window Properties and Visibility </H2> +<!--docid::SEC6::--> +<P> + +<A NAME="IDX93"></A> +</P> +<DL> +<DT><U>Function:</U> <B>x:get-window-property</B> <I>window property</I> +<DD>Returns the (string or list of numbers) value of <VAR>property</VAR> of +<VAR>window</VAR>. +<A NAME="IDX94"></A> +<DT><U>Function:</U> <B>x:get-window-property</B> <I>window property #t</I> +<DD>Removes and returns the (string or list of numbers) value of +<VAR>property</VAR> of <VAR>window</VAR>. +</DL> +<P> + +<A NAME="IDX95"></A> +</P> +<DL> +<DT><U>Function:</U> <B>x:list-properties</B> <I>window</I> +<DD>Returns a list of the properties (strings) defined for <VAR>window</VAR>. +</DL> +<P> + +In X parlance, a window which is hidden even when not obscured by other +windows is <EM>unmapped</EM>; one which +<A NAME="IDX96"></A> +<A NAME="IDX97"></A> +<A NAME="IDX98"></A> +<A NAME="IDX99"></A> +shows is <EM>mapped</EM>. It is an unfortunate name-collision with Scheme, +and is ingrained in the attribute names. +</P> +<P> + +<A NAME="IDX100"></A> +</P> +<DL> +<DT><U>Function:</U> <B>x:map-window</B> <I>window</I> +<DD>Maps the <VAR>window</VAR> and all of its subwindows that have had map +requests. Mapping a window that has an unmapped ancestor does not +display the window but marks it as eligible for display when the +ancestor becomes mapped. Such a window is called unviewable. When all +its ancestors are mapped, the window becomes viewable and will be +visible on the screen if it is not obscured by another window. This +function has no effect if the <VAR>window</VAR> is already mapped. +<P> + +If the override-redirect of the window is False and if some other client +has selected x:Substructure-Redirect-Mask on the parent window, then the X +server generates a MapRequest event, and the <CODE>x:map-window</CODE> +function does not map the <VAR>window</VAR>. Otherwise, the <VAR>window</VAR> is +mapped, and the X server generates a MapNotify event. +</P> +<P> + +If the <VAR>window</VAR> becomes viewable and no earlier contents for it are +remembered, the X server tiles the <VAR>window</VAR> with its background. If +the window's background is undefined, the existing screen contents are +not altered, and the X server generates zero or more x:Expose events. If +backing-store was maintained while the <VAR>window</VAR> was unmapped, no +x:Expose events are generated. If backing-store will now be maintained, a +full-window exposure is always generated. Otherwise, only visible +regions may be reported. Similar tiling and exposure take place for any +newly viewable inferiors. +</P> +<P> + +If the window is an Input-Output window, <CODE>x:map-window</CODE> generates +x:Expose events on each Input-Output window that it causes to be displayed. +If the client maps and paints the window and if the client begins +processing events, the window is painted twice. To avoid this, first +ask for x:Expose events and then map the window, so the client processes +input events as usual. The event list will include x:Expose for each +window that has appeared on the screen. The client's normal response to +an x:Expose event should be to repaint the window. This method usually +leads to simpler programs and to proper interaction with window +managers. +</P> +</DL> +<P> + +<A NAME="IDX101"></A> +</P> +<DL> +<DT><U>Function:</U> <B>x:map-subwindows</B> <I>window</I> +<DD>Maps all subwindows of a specified <VAR>window</VAR> in top-to-bottom +stacking order. The X server generates x:Expose events on each newly +displayed window. This may be much more efficient than mapping many +windows one at a time because the server needs to perform much of the +work only once, for all of the windows, rather than for each window. +</DL> +<P> + +<A NAME="IDX102"></A> +</P> +<DL> +<DT><U>Function:</U> <B>x:unmap-window</B> <I>window</I> +<DD>Unmaps the specified <VAR>window</VAR> and causes the X server to generate an +UnmapNotify event. If the specified <VAR>window</VAR> is already unmapped, +<CODE>x:unmap-window</CODE> has no effect. Normal exposure processing on +formerly obscured windows is performed. Any child window will no longer +be visible until another map call is made on the parent. In other +words, the subwindows are still mapped but are not visible until the +parent is mapped. Unmapping a <VAR>window</VAR> will generate x:Expose events +on windows that were formerly obscured by it. +</DL> +<P> + +<A NAME="IDX103"></A> +</P> +<DL> +<DT><U>Function:</U> <B>x:unmap-subwindows</B> <I>window</I> +<DD>Unmaps all subwindows for the specified <VAR>window</VAR> in bottom-to-top +stacking order. It causes the X server to generate an UnmapNotify event +on each subwindow and x:Expose events on formerly obscured windows. Using +this function is much more efficient than unmapping multiple windows one +at a time because the server needs to perform much of the work only +once, for all of the windows, rather than for each window. +</DL> +<P> + +<A NAME="Graphics Context"></A> +<HR SIZE="6"> +<A NAME="SEC7"></A> +<TABLE CELLPADDING=1 CELLSPACING=1 BORDER=0> +<TR><TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC6"> < </A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC9"> > </A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT"> <TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC3"> << </A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC_Top"> Up </A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC9"> >> </A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT"> <TD VALIGN="MIDDLE" ALIGN="LEFT"> <TD VALIGN="MIDDLE" ALIGN="LEFT"> <TD VALIGN="MIDDLE" ALIGN="LEFT"> <TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC_Top">Top</A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC_Contents">Contents</A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[Index]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC_About"> ? </A>]</TD> +</TR></TABLE> +<H1> 4. Graphics Context </H1> +<!--docid::SEC7::--> +<P> + +Most attributes of graphics operations are stored in <EM>GC</EM>s. These +include line width, line style, plane mask, foreground, background, +tile, stipple, clipping region, end style, join style, and so on. +Graphics operations (for example, drawing lines) use these values to +determine the actual drawing operation. +</P> +<P> + +<A NAME="IDX104"></A> +</P> +<DL> +<DT><U>Function:</U> <B>x:create-gc</B> <I>drawable field-name value <small>...</small></I> +<DD>Creates and returns graphics context. The graphics context can be used +with any destination drawable having the same root and depth as the +specified <VAR>drawable</VAR>. +</DL> +<P> + +<A NAME="IDX105"></A> +</P> +<DL> +<DT><U>Function:</U> <B>x:gc-set!</B> <I>graphics-context field-name value <small>...</small></I> +<DD>Changes the components specified by <VAR>field-name</VAR>s for the specified +<VAR>graphics-context</VAR>. The restrictions are the same as for +<CODE>x:create-gc</CODE>. The order in which components are verified and +altered is server dependent. If an error occurs, a subset of the +components may have been altered. +</DL> +<P> + +<A NAME="IDX106"></A> +</P> +<DL> +<DT><U>Function:</U> <B>x:copy-gc-fields!</B> <I>gcontext-src gcontext-dst field-name <small>...</small></I> +<DD>Copies the components specified by <VAR>field-name</VAR>s from +<VAR>gcontext-src</VAR> to <VAR>gcontext-dst</VAR>. <VAR>Gcontext-src</VAR> and +<VAR>gcontext-dst</VAR> must have the same root and depth. +</DL> +<P> + +<A NAME="IDX107"></A> +</P> +<DL> +<DT><U>Function:</U> <B>x:gc-ref</B> <I>graphics-context field-name <small>...</small></I> +<DD>Returns a list of the components specified by <VAR>field-name</VAR>s <small>...</small> +from the specified <VAR>graphics-context</VAR>. +</DL> +<P> + +<A NAME="SEC8"></A> +<H2> GC Attributes </H2> +<!--docid::SEC8::--> +<P> + +Both <CODE>x:create-gc</CODE> and <CODE>x:change-gc</CODE> take one argument +followed by pairs of arguments, where the first is one of the +property-name symbols (or its top-level value) listed below; and the +second is the value to associate with that property. +</P> +<P> + +<A NAME="IDX108"></A> +</P> +<DL> +<DT><U>Attribute:</U> <B>x:GC-Function</B> +<DD>The function attributes of a GC are used when you update a section of a +drawable (the destination) with bits from somewhere else (the source). +The function in a GC defines how the new destination bits are to be +computed from the source bits and the old destination bits. x:G-Xcopy is +typically the most useful because it will work on a color display, but +special applications may use other functions, particularly in concert +with particular planes of a color display. The 16 functions are: +<P> + +<TABLE><tr><td> </td><td class=display><pre style="font-family: serif"><TT> +x:G-Xclear 0 +x:G-Xand (AND src dst) +x:G-Xand-Reverse (AND src (NOT dst)) +x:G-Xcopy src +x:G-Xand-Inverted (AND (NOT src) dst) +x:G-Xnoop dst +x:G-Xxor (XOR src dst) +x:G-Xor (OR src dst) +x:G-Xnor (AND (NOT src) (NOT dst)) +x:G-Xequiv (XOR (NOT src) dst) +x:G-Xinvert (NOT dst) +x:G-Xor-Reverse (OR src (NOT dst)) +x:G-Xcopy-Inverted (NOT src) +x:G-Xor-Inverted (OR (NOT src) dst) +x:G-Xnand (OR (NOT src) (NOT dst)) +x:G-Xset 1</TT> +</pre></td></tr></table></DL> +<P> + +<A NAME="IDX109"></A> +</P> +<DL> +<DT><U>Attribute:</U> <B>x:GC-Plane-Mask</B> +<DD><P> + +Many graphics operations depend on either pixel values or planes in a +GC. The planes attribute is an integer which specifies which planes of +the destination are to be modified, one bit per plane. A monochrome +display has only one plane and will be the least significant bit of the +integer. As planes are added to the display hardware, they will occupy +more significant bits in the plane mask. +</P> +<P> + +In graphics operations, given a source and destination pixel, the result +is computed bitwise on corresponding bits of the pixels. That is, a +Boolean operation is performed in each bit plane. The plane-mask +restricts the operation to a subset of planes. <CODE>x:All-Planes</CODE> can be +used to refer to all planes of the screen simultaneously. The result is +computed by the following: +</P> +<P> + +<TABLE><tr><td> </td><td class=display><pre style="font-family: serif">(OR (AND (FUNC src dst) plane-mask) (AND dst (NOT plane-mask))) +</pre></td></tr></table><P> + +Range checking is not performed on a plane-mask value. It is simply +truncated to the appropriate number of bits. +</P> +</DL> +<P> + +<A NAME="IDX110"></A> +</P> +<DL> +<DT><U>Attribute:</U> <B>x:GC-Foreground</B> +<DD><A NAME="IDX111"></A> +<DT><U>Attribute:</U> <B>x:GC-Background</B> +<DD>Range checking is not performed on the values for foreground or +background. They are simply truncated to the appropriate number of +bits. +<P> + +Note that foreground and background are not initialized to any values +likely to be useful in a window. +</P> +</DL> +<P> + +<A NAME="IDX112"></A> +</P> +<DL> +<DT><U>Attribute:</U> <B>x:GC-Line-Width</B> +<DD>The line-width is measured in pixels and either can be greater than or +equal to one (wide line) or can be the special value zero (thin line). +<P> + +Thin lines (zero line-width) are one-pixel-wide lines drawn using an +unspecified, device-dependent algorithm. There are only two constraints +on this algorithm. +</P> +<P> + +<UL> +<LI> +If a line is drawn unclipped from [x1,y1] to [x2,y2] and if another line +is drawn unclipped from [x1+dx,y1+dy] to [x2+dx,y2+dy], a point [x,y] is +touched by drawing the first line if and only if the point [x+dx,y+dy] +is touched by drawing the second line. +<P> + +</P> +<LI> +The effective set of points comprising a line cannot be affected by +clipping. That is, a point is touched in a clipped line if and only if +the point lies inside the clipping region and the point would be touched +by the line when drawn unclipped. +</UL> +<P> + +A wide line drawn from [x1,y1] to [x2,y2] always draws the same pixels +as a wide line drawn from [x2,y2] to [x1,y1], not counting cap-style and +join-style. It is recommended that this property be true for thin +lines, but this is not required. A line-width of zero may differ from a +line-width of one in which pixels are drawn. This permits the use of +many manufacturers' line drawing hardware, which may run many times +faster than the more precisely specified wide lines. +</P> +<P> + +In general, drawing a thin line will be faster than drawing a wide line +of width one. However, because of their different drawing algorithms, +thin lines may not mix well aesthetically with wide lines. If it is +desirable to obtain precise and uniform results across all displays, a +client should always use a line-width of one rather than a linewidth of +zero. +</P> +</DL> +<P> + +<A NAME="IDX113"></A> +</P> +<DL> +<DT><U>Attribute:</U> <B>x:GC-Line-Style</B> +<DD>The line-style defines which sections of a line are drawn: +<P> + +</P> +<DL COMPACT> +<DT><TT>x:Line-Solid</TT> +<DD>The full path of the line is drawn. +<DT><TT>x:Line-Double-Dash</TT> +<DD>The full path of the line is drawn, but the even dashes are filled +differently from the odd dashes (see fill-style) with x:Cap-Butt style used +where even and odd dashes meet. +<DT><TT>x:Line-On-Off-Dash</TT> +<DD>Only the even dashes are drawn, and cap-style applies to all internal +ends of the individual dashes, except x:Cap-Not-Last is treated as x:Cap-Butt. +</DL> +</DL> +<P> + +<A NAME="IDX114"></A> +</P> +<DL> +<DT><U>Attribute:</U> <B>x:GC-Cap-Style</B> +<DD><P> + +The cap-style defines how the endpoints of a path are drawn: +</P> +<P> + +</P> +<DL COMPACT> +<DT><TT>x:Cap-Not-Last</TT> +<DD>This is equivalent to x:Cap-Butt except that for a line-width of zero the +final endpoint is not drawn. +<DT><TT>x:Cap-Butt</TT> +<DD>The line is square at the endpoint (perpendicular to the slope of the +line) with no projection beyond. +<DT><TT>x:Cap-Round</TT> +<DD>The line has a circular arc with the diameter equal to the line-width, +centered on the endpoint. (This is equivalent to x:Cap-Butt for line-width +of zero). +<DT><TT>x:Cap-Projecting</TT> +<DD>The line is square at the end, but the path continues beyond the +endpoint for a distance equal to half the line-width. (This is +equivalent to x:Cap-Butt for line-width of zero). +</DL> +</DL> +<P> + +<A NAME="IDX115"></A> +</P> +<DL> +<DT><U>Attribute:</U> <B>x:GC-Join-Style</B> +<DD><P> + +The join-style defines how corners are drawn for wide lines: +</P> +<P> + +</P> +<DL COMPACT> +<DT><TT>x:Join-Miter</TT> +<DD>The outer edges of two lines extend to meet at an angle. However, if +the angle is less than 11 degrees, then a x:Join-Bevel join-style is used +instead. +<DT><TT>x:Join-Round</TT> +<DD>The corner is a circular arc with the diameter equal to the +line-width, centered on the x:Join-point. +<DT><TT>x:Join-Bevel</TT> +<DD>The corner has x:Cap-Butt endpoint styles with the triangular notch filled. +</DL> +</DL> +<P> + +<A NAME="IDX116"></A> +</P> +<DL> +<DT><U>Attribute:</U> <B>x:GC-Fill-Style</B> +<DD><P> + +The fill-style defines the contents of the source for line, text, and +fill requests. For all text and fill requests (for example, +X:Draw-Text, X:Fill-Rectangle, X:Fill-Polygon, and X:Fill-Arc); for line +requests with linestyle x:Line-Solid (for example, X:Draw-Line, +X:Draw-Segments, X:Draw-Rectangle, X:Draw-Arc); and for the even dashes +for line requests with line-style x:Line-On-Off-Dash or +x:Line-Double-Dash, the following apply: +</P> +<P> + +</P> +<DL COMPACT> +<DT><TT>x:Fill-Solid</TT> +<DD>Foreground +<DT><TT>x:Fill-Tiled</TT> +<DD>Tile +<DT><TT>x:Fill-Opaque-Stippled</TT> +<DD>A tile with the same width and height as stipple, but with background +everywhere stipple has a zero and with foreground everywhere stipple has +a one +<DT><TT>x:Fill-Stippled</TT> +<DD>Foreground masked by stipple +</DL> +<P> + +When drawing lines with line-style x:Line-Double-Dash, the odd dashes +are controlled by the fill-style in the following manner: +</P> +<P> + +</P> +<DL COMPACT> +<DT><TT>x:Fill-Solid</TT> +<DD>Background +<DT><TT>x:Fill-Tiled</TT> +<DD>Same as for even dashes +<DT><TT>x:Fill-Opaque-Stippled</TT> +<DD>Same as for even dashes +<DT><TT>x:Fill-Stippled</TT> +<DD>Background masked by stipple +</DL> +</DL> +<P> + +<A NAME="IDX117"></A> +</P> +<DL> +<DT><U>Attribute:</U> <B>x:GC-Fill-Rule</B> +<DD>The fill-rule defines what pixels are inside (drawn) for paths given in +X:Fill-Polygon requests and can be set to x:Even-Odd-Rule or +x:Winding-Rule. +<P> + +</P> +<DL COMPACT> +<DT><TT>x:Even-Odd-Rule</TT> +<DD>A point is inside if an infinite ray with the point as +origin crosses the path an odd number of times. +<DT><TT>x:Winding-Rule</TT> +<DD>A point is inside if an infinite ray with the point as origin crosses an +unequal number of clockwise and counterclockwise directed path segments. +</DL> +<P> + +A clockwise directed path segment is one that crosses the ray from left +to right as observed from the point. A counterclockwise segment is one +that crosses the ray from right to left as observed from the point. The +case where a directed line segment is coincident with the ray is +uninteresting because you can simply choose a different ray that is not +coincident with a segment. +</P> +<P> + +For both x:Even-Odd-Rule and x:Winding-Rule, a point is infinitely +small, and the path is an infinitely thin line. A pixel is inside if +the center point of the pixel is inside and the center point is not on +the boundary. If the center point is on the boundary, the pixel is +inside if and only if the polygon interior is immediately to its right +(x increasing direction). Pixels with centers on a horizontal edge are +a special case and are inside if and only if the polygon interior is +immediately below (y increasing direction). +</P> +</DL> +<P> + +<A NAME="IDX118"></A> +</P> +<DL> +<DT><U>Attribute:</U> <B>x:GC-Tile</B> +<DD><A NAME="IDX119"></A> +<DT><U>Attribute:</U> <B>x:GC-Stipple</B> +<DD>The tile/stipple represents an infinite two-dimensional plane, with the +tile/stipple replicated in all dimensions. +<P> + +The tile pixmap must have the same root and depth as the GC, or an error +results. The stipple pixmap must have depth one and must have the same +root as the GC, or an error results. For stipple operations where the +fill-style is x:Fill-Stippled but not x:Fill-Opaque-Stippled, the +stipple pattern is tiled in a single plane and acts as an additional +clip mask to be ANDed with the clip-mask. Although some sizes may be +faster to use than others, any size pixmap can be used for tiling or +stippling. +</P> +</DL> +<P> + +<A NAME="IDX120"></A> +</P> +<DL> +<DT><U>Attribute:</U> <B>x:GC-Tile-Stip-X-Origin</B> +<DD><A NAME="IDX121"></A> +<DT><U>Attribute:</U> <B>x:GC-Tile-Stip-Y-Origin</B> +<DD>When the tile/stipple plane is superimposed on a drawable for use in a +graphics operation, the upper-left corner of some instance of the +tile/stipple is at the coordinates within the drawable specified by the +tile/stipple origin. The tile/stipple origin is interpreted relative to +the origin of whatever destination drawable is specified in a graphics +request. +</DL> +<P> + +<A NAME="IDX122"></A> +</P> +<DL> +<DT><U>Attribute:</U> <B>x:GC-Font</B> +<DD>The font to be used for drawing text. +</DL> +<P> + +<A NAME="IDX123"></A> +</P> +<DL> +<DT><U>Attribute:</U> <B>x:GC-Subwindow-Mode</B> +<DD>You can set the subwindow-mode to x:Clip-By-Children or +x:Include-Inferiors. +<DL COMPACT> +<DT><TT>x:Clip-By-Children</TT> +<DD>Both source and destination windows are additionally clipped by all +viewable Input-Output children. +<DT><TT>x:Include-Inferiors</TT> +<DD>Neither source nor destination window is clipped by inferiors. This +will result in including subwindow contents in the source and drawing +through subwindow boundaries of the destination. The use of +<CODE>x:Include-Inferiors</CODE> on a window of one depth with mapped +inferiors of differing depth is not illegal, but the semantics are +undefined by the core protocol. +</DL> +</DL> +<P> + +<A NAME="IDX124"></A> +</P> +<DL> +<DT><U>Attribute:</U> <B>x:GC-Graphics-Exposures</B> +<DD>The graphics-exposure flag controls x:Graphics-Expose event generation +for X:Copy-Area and X:Copy-Plane requests (and any similar requests +defined by extensions). +</DL> +<P> + +<A NAME="IDX125"></A> +</P> +<DL> +<DT><U>Attribute:</U> <B>x:GC-Clip-X-Origin</B> +<DD><A NAME="IDX126"></A> +<DT><U>Attribute:</U> <B>x:GC-Clip-Y-Origin</B> +<DD>The clip-mask origin is interpreted relative to the origin of whatever +destination drawable is specified in a graphics request. +</DL> +<P> + +<A NAME="IDX127"></A> +</P> +<DL> +<DT><U>Attribute:</U> <B>x:GC-Clip-Mask</B> +<DD>The clip-mask restricts writes to the destination drawable. If the +clip-mask is set to a pixmap, it must have depth one and have the same +root as the GC, or an error results. If clip-mask is set to +<A NAME="IDX128"></A> +<A NAME="IDX129"></A> +<EM>x:None</EM>, the pixels are always drawn regardless of the clip origin. +The clip-mask also can be set by calling <CODE>X:Set-Region</CODE>. Only +pixels where the clip-mask has a bit set to 1 are drawn. Pixels are not +drawn outside the area covered by the clip-mask or where the clip-mask +has a bit set to 0. The clip-mask affects all graphics requests. The +clip-mask does not clip sources. The clip-mask origin is interpreted +relative to the origin of whatever destination drawable is specified in +a graphics request. +</DL> +<P> + +<A NAME="IDX130"></A> +</P> +<DL> +<DT><U>Attribute:</U> <B>x:GC-Dash-Offset</B> +<DD>Defines the phase of the pattern, specifying how many pixels into the +dash-list the pattern should actually begin in any single graphics +request. Dashing is continuous through path elements combined with a +join-style but is reset to the dash-offset between each sequence of +joined lines. +<P> + +The unit of measure for dashes is the same for the ordinary +coordinate system. Ideally, a dash length is measured along +the slope of the line, but implementations are only required +to match this ideal for horizontal and vertical lines. +Failing the ideal semantics, it is suggested that the length +be measured along the major axis of the line. The major +axis is defined as the x axis for lines drawn at an angle of +between -45 and +45 degrees or between 135 and 225 degrees +from the x axis. For all other lines, the major axis is the +y axis. +</P> +</DL> +<P> + +<A NAME="IDX131"></A> +</P> +<DL> +<DT><U>Attribute:</U> <B>x:GC-Dash-List</B> +<DD>There must be at least one element in the specified <VAR>dash-list</VAR>. +The initial and alternating elements (second, fourth, and so on) of the +<VAR>dash-list</VAR> are the even dashes, and the others are the odd dashes. +Each element specifies a dash length in pixels. All of the elements +must be nonzero. Specifying an odd-length list is equivalent to +specifying the same list concatenated with itself to produce an +even-length list. +</DL> +<P> + +<A NAME="IDX132"></A> +</P> +<DL> +<DT><U>Attribute:</U> <B>x:GC-Arc-Mode</B> +<DD>The arc-mode controls filling in the X:Fill-Arcs function and can be set +to x:Arc-Pie-Slice or x:Arc-Chord. +<DL COMPACT> +<DT><TT>x:Arc-Pie-Slice</TT> +<DD>The arcs are pie-slice filled. +<DT><TT>x:Arc-Chord</TT> +<DD>The arcs are chord filled. +</DL> +</DL> +<P> + +<A NAME="Cursor"></A> +<HR SIZE="6"> +<A NAME="SEC9"></A> +<TABLE CELLPADDING=1 CELLSPACING=1 BORDER=0> +<TR><TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC7"> < </A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC10"> > </A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT"> <TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC7"> << </A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC_Top"> Up </A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC10"> >> </A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT"> <TD VALIGN="MIDDLE" ALIGN="LEFT"> <TD VALIGN="MIDDLE" ALIGN="LEFT"> <TD VALIGN="MIDDLE" ALIGN="LEFT"> <TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC_Top">Top</A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC_Contents">Contents</A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[Index]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC_About"> ? </A>]</TD> +</TR></TABLE> +<H1> 5. Cursor </H1> +<!--docid::SEC9::--> +<P> + +<A NAME="IDX133"></A> +</P> +<DL> +<DT><U>Function:</U> <B>x:create-cursor</B> <I>display shape</I> +<DD>X provides a set of standard cursor shapes in a special font named +<A NAME="IDX134"></A> +<EM>cursor</EM>. Applications are encouraged to use this interface for +their cursors because the font can be customized for the individual +display type. The <VAR>shape</VAR> argument specifies which glyph of the standard +fonts to use. +<P> + +The hotspot comes from the information stored in the cursor font. The +initial colors of a cursor are a black foreground and a white background +(see X:Recolor-Cursor). The names of all cursor shapes are defined with +the prefix XC: in `<TT>x11.scm</TT>'. +</P> +<P> + +<A NAME="IDX135"></A> +<DT><U>Function:</U> <B>x:create-cursor</B> <I>source-font source-char mask-font mask-char fgc bgc</I> +<DD>Creates a cursor from the source and mask bitmaps obtained from the +specified font glyphs. The integer <VAR>source-char</VAR> must be a defined +glyph in <VAR>source-font</VAR>. The integer <VAR>mask-char</VAR> must be a +defined glyph in <VAR>mask-font</VAR>. The origins of the <VAR>source-char</VAR> +and <VAR>mask-char</VAR> glyphs are positioned coincidently and define the +hotspot. The <VAR>source-char</VAR> and <VAR>mask-char</VAR> need not have the +same bounding box metrics, and there is no restriction on the placement +of the hotspot relative to the bounding boxes. +</P> +<P> + +<A NAME="IDX136"></A> +<DT><U>Function:</U> <B>x:create-cursor</B> <I>source-font source-char #f #f fgc bgc</I> +<DD>If <VAR>mask-font</VAR> and <VAR>mask-char</VAR> are #f, all pixels of the source +are displayed. +</P> +<P> + +<A NAME="IDX137"></A> +<DT><U>Function:</U> <B>x:create-cursor</B> <I>source-pixmap mask-pixmap fgc bgc origin</I> +<DD><VAR>mask-pixmap</VAR> must be the same size as the pixmap defined by the +<VAR>source-pixmap</VAR> argument. The foreground and background RGB values +must be specified using <VAR>foreground-color</VAR> and +<VAR>background-color</VAR>, even if the X server only has a x:Static-Gray or +x:Gray-Scale screen. The hotspot must be a point within the +<VAR>source-pixmap</VAR>. +</P> +<P> + +<CODE>X:Create-Cursor</CODE> creates and returns a cursor. The +<VAR>foreground-color</VAR> is used for the pixels set to 1 in the source, +and the <VAR>background-color</VAR> is used for the pixels set to 0. Both +source and mask must have depth one but can have any root. The +<VAR>mask-pixmap</VAR> defines the shape of the cursor. The pixels set to 1 +in <VAR>mask-pixmap</VAR> define which source pixels are displayed, and the +pixels set to 0 define which pixels are ignored. +</P> +<P> + +<A NAME="IDX138"></A> +<DT><U>Function:</U> <B>x:create-cursor</B> <I>source-pixmap #f fgc bgc origin</I> +<DD>If <VAR>mask-pixmap</VAR> is #f, all pixels of the source are displayed. +</P> +</DL> +<P> + +<A NAME="Colormap"></A> +<HR SIZE="6"> +<A NAME="SEC10"></A> +<TABLE CELLPADDING=1 CELLSPACING=1 BORDER=0> +<TR><TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC9"> < </A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC11"> > </A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT"> <TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC9"> << </A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC_Top"> Up </A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC11"> >> </A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT"> <TD VALIGN="MIDDLE" ALIGN="LEFT"> <TD VALIGN="MIDDLE" ALIGN="LEFT"> <TD VALIGN="MIDDLE" ALIGN="LEFT"> <TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC_Top">Top</A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC_Contents">Contents</A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[Index]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC_About"> ? </A>]</TD> +</TR></TABLE> +<H1> 6. Colormap </H1> +<!--docid::SEC10::--> +<P> + +<A NAME="IDX139"></A> +<A NAME="IDX140"></A> +A <EM>colormap</EM> maps pixel values to <EM>RGB</EM> color space values. +</P> +<P> + +<A NAME="IDX141"></A> +</P> +<DL> +<DT><U>Function:</U> <B>x:create-colormap</B> <I>window visual alloc-policy</I> +<DD><VAR>window</VAR> specifies the window on whose screen you want to create a +colormap. <VAR>visual</VAR> specifies a visual type supported on the screen. +<VAR>alloc-policy</VAR> Specifies the colormap entries to be allocated. You +can pass <CODE>X:Alloc-None</CODE> or <CODE>X:Alloc-All</CODE>. +<P> + +The <CODE>X:Create-Colormap</CODE> function creates and returns a colormap of +the specified <VAR>visual</VAR> type for the screen on which <VAR>window</VAR> +resides. Note that <VAR>window</VAR> is used only to determine the screen. +</P> +<P> + +</P> +<DL COMPACT> +<DT>`<SAMP>X:Gray-Scale</SAMP>' +<DD><DT>`<SAMP>X:Pseudo-Color</SAMP>' +<DD><DT>`<SAMP>X:Direct-Color</SAMP>' +<DD>The initial values of the colormap entries are undefined. +<P> + +</P> +<DT>`<SAMP>X:Static-Gray</SAMP>' +<DD><DT>`<SAMP>X:Static-Color</SAMP>' +<DD><DT>`<SAMP>X:True-Color</SAMP>' +<DD>The entries have defined values, but those values are specific to +<VAR>visual</VAR> and are not defined by X. The <VAR>alloc-policy</VAR> must be +`<SAMP>X:Alloc-None</SAMP>'. +<P> + +</DL> +<P> + +For the other visual classes, if <VAR>alloc-policy</VAR> is +`<SAMP>X:Alloc-None</SAMP>', the colormap initially has no allocated entries, +and clients can allocate them. +</P> +<P> + +If <VAR>alloc-policy</VAR> is `<SAMP>X:Alloc-All</SAMP>', the entire colormap is +allocated writable. The initial values of all allocated entries are +undefined. +</P> +<P> + +</P> +<DL COMPACT> +<DT>`<SAMP>X:Gray-Scale</SAMP>' +<DD><DT>`<SAMP>X:Pseudo-Color</SAMP>' +<DD>The effect is as if an <CODE>XAllocColorCells</CODE> call returned all pixel +values from zero to N - 1, where N is the colormap entries value in +<VAR>visual</VAR>. +<P> + +</P> +<DT>`<SAMP>X:Direct-Color</SAMP>' +<DD>The effect is as if an <CODE>XAllocColorPlanes</CODE> call returned a pixel +value of zero and red_mask, green_mask, and blue_mask values containing +the same bits as the corresponding masks in the specified visual. +</DL> +<P> + +</P> +</DL> +<P> + +To create a new colormap when the allocation out of a previously +shared colormap has failed because of resource exhaustion, use: +</P> +<P> + +<A NAME="IDX142"></A> +</P> +<DL> +<DT><U>Function:</U> <B>x:copy-colormap-and-free</B> <I>colormap</I> +<DD><P> + +Creates and returns a colormap of the same visual type and for the same +screen as the specified <VAR>colormap</VAR>. It also moves all of the +client's existing allocation from the specified <VAR>colormap</VAR> to the +new colormap with their color values intact and their read-only or +writable characteristics intact and frees those entries in the specified +colormap. Color values in other entries in the new colormap are +undefined. If the specified colormap was created by the client with +alloc set to `<SAMP>X:Alloc-All</SAMP>', the new colormap is also created with +`<SAMP>X:Alloc-All</SAMP>', all color values for all entries are copied from the +specified <VAR>colormap</VAR>, and then all entries in the specified +<VAR>colormap</VAR> are freed. If the specified <VAR>colormap</VAR> was not +created by the client with `<SAMP>X:Alloc-All</SAMP>', the allocations to be moved +are all those pixels and planes that have been allocated by the client +and that have not been freed since they were allocated. +</P> +<P> + +</P> +</DL> +<P> + +A <EM>colormap</EM> maps pixel values to elements of the <EM>RGB</EM> +datatype. An <VAR>RGB</VAR> is a list or vector of 3 integers, describing +the red, green, and blue intensities respectively. The integers are in +the range 0 - 65535. +</P> +<P> + +<A NAME="IDX143"></A> +</P> +<DL> +<DT><U>Function:</U> <B>x:alloc-colormap-cells</B> <I>colormap ncolors nplanes</I> +<DD><A NAME="IDX144"></A> +<DT><U>Function:</U> <B>x:alloc-colormap-cells</B> <I>colormap ncolors nplanes contiguous?</I> +<DD><P> + +The <CODE>X:Alloc-Color-Cells</CODE> function allocates read/write color +cells. The number of colors, <VAR>ncolors</VAR> must be positive and the +number of planes, <VAR>nplanes</VAR> nonnegative. If <VAR>ncolors</VAR> and +nplanes are requested, then <VAR>ncolors</VAR> pixels and nplane plane masks +are returned. No mask will have any bits set to 1 in common with any +other mask or with any of the pixels. By ORing together each pixel with +zero or more masks, <VAR>ncolors</VAR> * 2^<VAR>nplanes</VAR> distinct pixels can +be produced. All of these are allocated writable by the request. +</P> +<P> + +</P> +<DL COMPACT> +<DT>`<SAMP>x:Gray-Scale</SAMP>' +<DD><DT>`<SAMP>x:Pseudo-Color</SAMP>' +<DD>Each mask has exactly one bit set to 1. If <VAR>contiguous?</VAR> is +non-false and if all masks are ORed together, a single contiguous set of +bits set to 1 is formed. +<DT>`<SAMP>x:Direct-Color</SAMP>' +<DD>Each mask has exactly three bits set to 1. If <VAR>contiguous?</VAR> is +non-false and if all masks are ORed together, three contiguous sets of +bits set to 1 (one within each pixel subfield) is formed. +</DL> +<P> + +The RGB values of the allocated entries are undefined. +<CODE>X:Alloc-Color-Cells</CODE> returns a list of two uniform arrays if it +succeeded or #f if it failed. The first array has the pixels allocated +and the second has the plane-masks. +</P> +<P> + +<A NAME="IDX145"></A> +<DT><U>Function:</U> <B>x:alloc-colormap-cells</B> <I>colormap ncolors rgb</I> +<DD><A NAME="IDX146"></A> +<DT><U>Function:</U> <B>x:alloc-colormap-cells</B> <I>colormap ncolors rgb contiguous?</I> +<DD></P> +<P> + +The specified <VAR>ncolors</VAR> must be positive; and <VAR>rgb</VAR> a list or +vector of 3 nonnegative integers. If <VAR>ncolors</VAR> colors, <VAR>nreds</VAR> +reds, <VAR>ngreens</VAR> greens, and <VAR>nblues</VAR> blues are requested, +<VAR>ncolors</VAR> pixels are returned; and the masks have <VAR>nreds</VAR>, +<VAR>ngreens</VAR>, and <VAR>nblues</VAR> bits set to 1, respectively. If +<VAR>contiguous?</VAR> is non-false, each mask will have a contiguous set of +bits set to 1. No mask will have any bits set to 1 in common with any +other mask or with any of the pixels. +</P> +<P> + +Each mask will lie within the corresponding pixel subfield. By ORing +together subsets of masks with each pixel value, <VAR>ncolors</VAR> * +2(<VAR>nreds</VAR>+<VAR>ngreens</VAR>+<VAR>nblues</VAR>) distinct pixel values can be +produced. All of these are allocated by the request. However, in the +colormap, there are only <VAR>ncolors</VAR> * 2^<VAR>nreds</VAR> independent red +entries, <VAR>ncolors</VAR> * 2^<VAR>ngreens</VAR> independent green entries, and +<VAR>ncolors</VAR> * 2^<VAR>nblues</VAR> independent blue entries. +</P> +<P> + +<CODE>X:Alloc-Color-Cells</CODE> returns a list if it succeeded or #f if it +failed. The first element of the list has an array of the pixels +allocated. The second, third, and fourth elements are the red, green, +and blue plane-masks. +</P> +</DL> +<P> + +<A NAME="IDX147"></A> +</P> +<DL> +<DT><U>Function:</U> <B>x:free-colormap-cells</B> <I>colormap pixels planes</I> +<DD><A NAME="IDX148"></A> +<DT><U>Function:</U> <B>x:free-colormap-cells</B> <I>colormap pixels</I> +<DD><P> + +Frees the cells represented by pixels whose values are in the +<VAR>pixels</VAR> unsigned-integer uniform-vector. The <VAR>planes</VAR> argument +should not have any bits set to 1 in common with any of the pixels. The +set of all pixels is produced by ORing together subsets of the +<VAR>planes</VAR> argument with the pixels. The request frees all of these +pixels that were allocated by the client. Note that freeing an +individual pixel obtained from <CODE>X:Alloc-Colormap-Cells</CODE> with a +planes argument may not actually allow it to be reused until all of its +related pixels are also freed. Similarly, a read-only entry is not +actually freed until it has been freed by all clients, and if a client +allocates the same read-only entry multiple times, it must free the +entry that many times before the entry is actually freed. +</P> +<P> + +All specified pixels that are allocated by the client in the +<VAR>colormap</VAR> are freed, even if one or more pixels produce an error. +It is an error if a specified pixel is not allocated by the client (that +is, is unallocated or is only allocated by another client) or if the +colormap was created with all entries writable (by passing +`<SAMP>x:Alloc-All</SAMP>' to <CODE>X:Create-Colormap</CODE>). If more than one pixel +is in error, the one that gets reported is arbitrary. +</P> +</DL> +<P> + +<A NAME="IDX149"></A> +</P> +<DL> +<DT><U>Function:</U> <B>x:colormap-find-color</B> <I>colormap rgb</I> +<DD><P> + +<VAR>rgb</VAR> is a list or vector of 3 integers, describing the red, green, +and blue intensities respectively; or an integer `<SAMP>#x<I>rrggbb</I></SAMP>', +packing red, green and blue intensities in the range 0 - 255. +</P> +<P> + +<A NAME="IDX150"></A> +<DT><U>Function:</U> <B>x:colormap-find-color</B> <I>colormap color-name</I> +<DD></P> +<P> + +The case-insensitive string <VAR>color_name</VAR> specifies the name of a +color (for example, `<TT>red</TT>') +</P> +<P> + +<CODE>X:Colormap-Find-Color</CODE> allocates a read-only colormap entry +corresponding to the closest RGB value supported by the hardware. +<CODE>X:Colormap-Find-Color</CODE> returns the pixel value of the color +closest to the specified <VAR>RGB</VAR> or <VAR>color_name</VAR> elements +supported by the hardware, if successful; otherwise +<CODE>X:Colormap-Find-Color</CODE> returns #f. +</P> +<P> + +Multiple clients that request the same effective RGB value can +be assigned the same read-only entry, thus allowing entries to be +shared. When the last client deallocates a shared cell, it is +deallocated. +</P> +<P> + +</P> +</DL> +<P> + +<A NAME="IDX151"></A> +</P> +<DL> +<DT><U>Function:</U> <B>x:color-ref</B> <I>colormap pixel</I> +<DD><P> + +Returns a list of 3 integers, describing the red, green, +and blue intensities respectively of the <VAR>colormap</VAR> entry of the +cell indexed by <VAR>pixel</VAR>. +</P> +<P> + +The integer <VAR>pixel</VAR> must be a valid index into <VAR>colormap</VAR>. +</P> +</DL> +<P> + +<A NAME="IDX152"></A> +</P> +<DL> +<DT><U>Function:</U> <B>X:Color-Set!</B> <I>colormap pixel rgb</I> +<DD><P> + +<VAR>rgb</VAR> is a list or vector of 3 integers, describing the red, green, +and blue intensities respectively; or an integer `<SAMP>#x<I>rrggbb</I></SAMP>', +packing red, green and blue intensities in the range 0 - 255. +</P> +<P> + +<A NAME="IDX153"></A> +<DT><U>Function:</U> <B>X:Color-Set!</B> <I>colormap pixel color-name</I> +<DD></P> +<P> + +The case-insensitive string <VAR>color_name</VAR> specifies the name of a +color (for example, `<TT>red</TT>') +</P> +<P> + +The integer <VAR>pixel</VAR> must be a valid index into <VAR>colormap</VAR>. +</P> +<P> + +<CODE>X:Color-Set!</CODE> changes the <VAR>colormap</VAR> entry of the read/write +cell indexed by <VAR>pixel</VAR>. If the <VAR>colormap</VAR> is an installed map +for its screen, the changes are visible immediately. +</P> +<P> + +</P> +</DL> +<P> + +<A NAME="IDX154"></A> +</P> +<DL> +<DT><U>Function:</U> <B>x:install-colormap</B> <I>colormap</I> +<DD><P> + +Installs the specified <VAR>colormap</VAR> for its associated screen. All +windows associated with <VAR>colormap</VAR> immediately display with true +colors. A colormap is associated with a window when the window is +created or its attributes changed. +</P> +<P> + +If the specified colormap is not already an installed colormap, the X +server generates a ColormapNotify event on each window that has that +colormap. +</P> +<P> + +</P> +</DL> +<P> + +<A NAME="IDX155"></A> +</P> +<DL> +<DT><U>Function:</U> <B>x:ccc</B> <I>colormap</I> +<DD>Returns the Color-Conversion-Context of <VAR>colormap</VAR>. +</DL> +<P> + +<A NAME="Rendering"></A> +<HR SIZE="6"> +<A NAME="SEC11"></A> +<TABLE CELLPADDING=1 CELLSPACING=1 BORDER=0> +<TR><TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC10"> < </A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC14"> > </A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT"> <TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC10"> << </A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC_Top"> Up </A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC14"> >> </A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT"> <TD VALIGN="MIDDLE" ALIGN="LEFT"> <TD VALIGN="MIDDLE" ALIGN="LEFT"> <TD VALIGN="MIDDLE" ALIGN="LEFT"> <TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC_Top">Top</A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC_Contents">Contents</A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[Index]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC_About"> ? </A>]</TD> +</TR></TABLE> +<H1> 7. Rendering </H1> +<!--docid::SEC11::--> +<P> + +<A NAME="IDX156"></A> +</P> +<DL> +<DT><U>Function:</U> <B>x:flush</B> <I>display</I> +<DD><A NAME="IDX157"></A> +<DT><U>Function:</U> <B>x:flush</B> <I>window</I> +<DD>Flushes the output buffer. Some client applications need not use this +function because the output buffer is automatically flushed as needed by +calls to X:Pending, X:Next-Event, and X:Window-Event. Events generated +by the server may be enqueued into the library's event queue. +<P> + +<A NAME="IDX158"></A> +<DT><U>Function:</U> <B>x:flush</B> <I>gc</I> +<DD>Forces sending of GC component changes. +</P> +<P> + +Xlib usually defers sending changes to the components of a GC to the +server until a graphics function is actually called with that GC. This +permits batching of component changes into a single server request. In +some circumstances, however, it may be necessary for the client to +explicitly force sending the changes to the server. An example might be +when a protocol extension uses the GC indirectly, in such a way that the +extension interface cannot know what GC will be used. +</P> +</DL> +<P> + +<A NAME="IDX159"></A> +</P> +<DL> +<DT><U>Function:</U> <B>x:clear-area</B> <I>window (x-pos y-pos) (width height) expose?</I> +<DD>Paints a rectangular area in the specified <VAR>window</VAR> according to the +specified dimensions with the <VAR>window</VAR>'s background pixel or pixmap. +The subwindow-mode effectively is `<SAMP>x:Clip-By-Children</SAMP>'. If width +is zero, it is replaced with the current width of the <VAR>window</VAR> minus +x. If height is zero, it is replaced with the current height of the +<VAR>window</VAR> minus y. If the <VAR>window</VAR> has a defined background +tile, the rectangle clipped by any children is filled with this tile. +If the <VAR>window</VAR> has background x:None, the contents of the +<VAR>window</VAR> are not changed. In either case, if <VAR>expose?</VAR> is True, +one or more x:Expose events are generated for regions of the rectangle +that are either visible or are being retained in a backing store. If +you specify a <VAR>window</VAR> whose class is x:Input-Only, an error +results. +</DL> +<P> + +<A NAME="IDX160"></A> +</P> +<DL> +<DT><U>Function:</U> <B>x:fill-rectangle</B> <I>window gcontext position size</I> +<DD><P> + +</P> +</DL> +<P> + +<A NAME="SEC12"></A> +<H2> Draw Strings </H2> +<!--docid::SEC12::--> +<P> + +<A NAME="IDX161"></A> +</P> +<DL> +<DT><U>Function:</U> <B>x:draw-string</B> <I>drawable gc position string</I> +<DD><VAR>Position</VAR> specifies coordinates relative to the origin of +<VAR>drawable</VAR> of the origin of the first character to be drawn. +<P> + +<CODE>x:draw-string</CODE> draws the characters of <VAR>string</VAR>, starting at +<VAR>position</VAR>. +</P> +</DL> +<P> + +<A NAME="IDX162"></A> +</P> +<DL> +<DT><U>Function:</U> <B>x:image-string</B> <I>drawable gc position string</I> +<DD><VAR>Position</VAR> specifies coordinates relative to the origin of +<VAR>drawable</VAR> of the origin of the first character to be drawn. +<P> + +<CODE>x:image-string</CODE> draws the characters <EM>and background</EM> of +<VAR>string</VAR>, starting at <VAR>position</VAR>. +</P> +</DL> +<P> + +<A NAME="SEC13"></A> +<H2> Draw Shapes </H2> +<!--docid::SEC13::--> +<P> + +<A NAME="IDX163"></A> +</P> +<DL> +<DT><U>Function:</U> <B>x:draw-points</B> <I>drawable gc position <small>...</small></I> +<DD><VAR>Position</VAR> <small>...</small> specifies coordinates of the point to be drawn. +<P> + +<A NAME="IDX164"></A> +<DT><U>Function:</U> <B>x:draw-points</B> <I>drawable gc x y <small>...</small></I> +<DD>(<VAR>x</VAR>, <VAR>y</VAR>) <small>...</small> specifies coordinates of the point to be +drawn. +</P> +<P> + +<A NAME="IDX165"></A> +<DT><U>Function:</U> <B>x:draw-points</B> <I>drawable gc point-array</I> +<DD><VAR>point-array</VAR> is a uniform short array of rank 2, whose rightmost +index spans a range of 2. +</P> +<P> + +The <CODE>X:Draw-Points</CODE> procedure uses the foreground pixel and +function components of the <VAR>gc</VAR> to draw points into <VAR>drawable</VAR> +at the positions (relative to the origin of <VAR>drawable</VAR>) specified. +</P> +<P> + +<CODE>X:Draw-Points</CODE> uses these <VAR>gc</VAR> components: function, +planemask, foreground, subwindow-mode, clip-x-origin, clip-y-origin, and +clip-mask. +</P> +</DL> +<P> + +<A NAME="IDX166"></A> +</P> +<DL> +<DT><U>Function:</U> <B>x:draw-segments</B> <I>drawable gc pos1 pos2 <small>...</small></I> +<DD><VAR>Pos1</VAR>, <VAR>pos2</VAR>, <small>...</small> specify coordinates to be connected by +segments. +<P> + +<A NAME="IDX167"></A> +<DT><U>Function:</U> <B>x:draw-segments</B> <I>drawable gc x1 y1 x2 y2 <small>...</small></I> +<DD>(<VAR>x1</VAR>, <VAR>y1</VAR>), (<VAR>x2</VAR>, <VAR>y2</VAR>) <small>...</small> specify coordinates +to be connected by segments. +</P> +<P> + +<A NAME="IDX168"></A> +<DT><U>Function:</U> <B>x:draw-segments</B> <I>drawable gc point-array</I> +<DD><VAR>point-array</VAR> is a uniform short array of rank 2, whose rightmost +index spans a range of 2. +</P> +<P> + +The <CODE>X:Draw-Segments</CODE> procedure uses the components of the +specified <VAR>gc</VAR> to draw multiple unconnected lines between disjoint +adjacent pair of points passed as arguments. It draws the segments in +order and does not perform joining at coincident endpoints. For any +given line, <CODE>X:Draw-Segments</CODE> does not draw a pixel more than once. +If thin (zero line-width) segments intersect, the intersecting pixels +are drawn multiple times. If wide segments intersect, the intersecting +pixels are drawn only once, as though the entire PolyLine protocol +request were a single, filled shape. <CODE>X:Draw-Segments</CODE> treats all +coordinates as relative to the origin of <VAR>drawable</VAR>. +</P> +<P> + +<CODE>X:Draw-Segments</CODE> uses these <VAR>gc</VAR> components: function, +plane-mask, line-width, line-style, cap-style, fill-style, +subwindow-mode, clip-x-origin, clip-y-origin, and clip-mask, join-style. +It also use these <VAR>gc</VAR> mode-dependent components: foreground, +background, tile, stipple, tilestipple-x-origin, tile-stipple-y-origin, +dash-offset, and dash-list. +</P> +</DL> +<P> + +<A NAME="IDX169"></A> +</P> +<DL> +<DT><U>Function:</U> <B>x:draw-lines</B> <I>drawable gc pos1 pos2 <small>...</small></I> +<DD><VAR>Pos1</VAR>, <VAR>pos2</VAR>, <small>...</small> specify coordinates to be connected by +lines. +<P> + +<A NAME="IDX170"></A> +<DT><U>Function:</U> <B>x:draw-lines</B> <I>drawable gc x1 y1 x2 y2 <small>...</small></I> +<DD>(<VAR>x1</VAR>, <VAR>y1</VAR>), (<VAR>x2</VAR>, <VAR>y2</VAR>) <small>...</small> specify coordinates +to be connected by lines. +</P> +<P> + +<A NAME="IDX171"></A> +<DT><U>Function:</U> <B>x:draw-lines</B> <I>drawable gc point-array</I> +<DD><VAR>point-array</VAR> is a uniform short array of rank 2, whose rightmost +index spans a range of 2. +</P> +<P> + +The <CODE>X:Draw-Lines</CODE> procedure uses the components of the specified +<VAR>gc</VAR> to draw lines between each adjacent pair of points passed as +arguments. It draws the lines in order. The lines join correctly at +all intermediate points, and if the first and last points coincide, the +first and last lines also join correctly. For any given line, +<CODE>X:Draw-Lines</CODE> does not draw a pixel more than once. If thin (zero +line-width) lines intersect, the intersecting pixels are drawn multiple +times. If wide lines intersect, the intersecting pixels are drawn only +once, as though the entire PolyLine protocol request were a single, +filled shape. <CODE>X:Draw-Lines</CODE> treats all coordinates as relative to +the origin of <VAR>drawable</VAR>. +</P> +<P> + +<CODE>X:Draw-Lines</CODE> uses these <VAR>gc</VAR> components: function, +plane-mask, line-width, line-style, cap-style, fill-style, +subwindow-mode, clip-x-origin, clip-y-origin, and clip-mask, join-style. +It also use these <VAR>gc</VAR> mode-dependent components: foreground, +background, tile, stipple, tilestipple-x-origin, tile-stipple-y-origin, +dash-offset, and dash-list. +</P> +</DL> +<P> + +<A NAME="IDX172"></A> +</P> +<DL> +<DT><U>Function:</U> <B>x:fill-polygon</B> <I>drawable gc pos1 pos2 <small>...</small></I> +<DD><VAR>Pos1</VAR>, <VAR>pos2</VAR>, <small>...</small> specify coordinates of the border path. +<P> + +<A NAME="IDX173"></A> +<DT><U>Function:</U> <B>x:fill-polygon</B> <I>drawable gc x1 y1 x2 y2 <small>...</small></I> +<DD>(<VAR>x1</VAR>, <VAR>y1</VAR>), (<VAR>x2</VAR>, <VAR>y2</VAR>) <small>...</small> specify coordinates +of the border path. +</P> +<P> + +<A NAME="IDX174"></A> +<DT><U>Function:</U> <B>x:fill-polygon</B> <I>drawable gc point-array</I> +<DD><VAR>point-array</VAR> is a uniform short array of rank 2, whose rightmost +index spans a range of 2. +</P> +<P> + +The path is closed automatically if the last point in the list or +<VAR>point-array</VAR> does not coincide with the first point. +</P> +<P> + +The <CODE>X:Fill-Polygon</CODE> procedure uses the components of the specified +<VAR>gc</VAR> to fill the region closed by the specified path. +<CODE>X:Fill-Polygon</CODE> does not draw a pixel of the region more than +once. <CODE>X:Fill-Polygon</CODE> treats all coordinates as relative to the +origin of <VAR>drawable</VAR>. +</P> +<P> + +<CODE>X:Fill-Polygon</CODE> uses these <VAR>gc</VAR> components: function, +planemask, fill-style, fill-rule, subwindow-mode, clip-x-origin, +clip-y-origin, and clip-mask. It also use these <VAR>gc</VAR> mode-dependent +components: foreground, background, tile, stipple, +tile-stipple-x-origin, and tile-stipple-y-origin. +</P> +</DL> +<P> + +<A NAME="Images"></A> +<HR SIZE="6"> +<A NAME="SEC14"></A> +<TABLE CELLPADDING=1 CELLSPACING=1 BORDER=0> +<TR><TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC11"> < </A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC15"> > </A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT"> <TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC11"> << </A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC_Top"> Up </A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC15"> >> </A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT"> <TD VALIGN="MIDDLE" ALIGN="LEFT"> <TD VALIGN="MIDDLE" ALIGN="LEFT"> <TD VALIGN="MIDDLE" ALIGN="LEFT"> <TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC_Top">Top</A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC_Contents">Contents</A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[Index]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC_About"> ? </A>]</TD> +</TR></TABLE> +<H1> 8. Images </H1> +<!--docid::SEC14::--> +<P> + +<A NAME="IDX175"></A> +</P> +<DL> +<DT><U>Function:</U> <B>x:read-bitmap-file</B> <I>drawable file</I> +<DD><P> + +</P> +</DL> +<P> + +<A NAME="Event"></A> +<HR SIZE="6"> +<A NAME="SEC15"></A> +<TABLE CELLPADDING=1 CELLSPACING=1 BORDER=0> +<TR><TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC14"> < </A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC16"> > </A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT"> <TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC14"> << </A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC_Top"> Up </A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC16"> >> </A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT"> <TD VALIGN="MIDDLE" ALIGN="LEFT"> <TD VALIGN="MIDDLE" ALIGN="LEFT"> <TD VALIGN="MIDDLE" ALIGN="LEFT"> <TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC_Top">Top</A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC_Contents">Contents</A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[Index]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC_About"> ? </A>]</TD> +</TR></TABLE> +<H1> 9. Event </H1> +<!--docid::SEC15::--> +<P> + +These three status routines always return immediately if there are +events already in the queue. +</P> +<P> + +<A NAME="IDX176"></A> +</P> +<DL> +<DT><U>Function:</U> <B>x:q-length</B> <I>display</I> +<DD>Returns the length of the event queue for the connected <VAR>display</VAR>. +Note that there may be more events that have not been read into the +queue yet (see X:Events-Queued). +</DL> +<P> + +<A NAME="IDX177"></A> +</P> +<DL> +<DT><U>Function:</U> <B>x:pending</B> <I>display</I> +<DD>Returns the number of events that have been received from the X server +but have not been removed from the event queue. +</DL> +<P> + +<A NAME="IDX178"></A> +</P> +<DL> +<DT><U>Function:</U> <B>x:events-queued</B> <I>display</I> +<DD>Returns the number of events already in the queue if the number is +nonzero. If there are no events in the queue, <CODE>X:Events-Queued</CODE> +attempts to read more events out of the application's connection without +flushing the output buffer and returns the number read. +</DL> +<P> + +Both of these routines return an object of type <EM>event</EM>. +</P> +<P> + +<A NAME="IDX179"></A> +</P> +<DL> +<DT><U>Function:</U> <B>x:next-event</B> <I>display</I> +<DD>Removes and returns the first event from the event queue. If the event +queue is empty, <CODE>X:Next-Event</CODE> flushes the output buffer and blocks +until an event is received. +</DL> +<P> + +<A NAME="IDX180"></A> +</P> +<DL> +<DT><U>Function:</U> <B>x:peek-event</B> <I>display</I> +<DD>Returns the first event from the event queue, but it does not remove the +event from the queue. If the queue is empty, <CODE>X:Peek-Event</CODE> +flushes the output buffer and blocks until an event is received. +</DL> +<P> + +Each event object has fields dependent on its sub-type. +</P> +<P> + +<A NAME="IDX181"></A> +</P> +<DL> +<DT><U>Function:</U> <B>x:event-ref</B> <I>event field-name</I> +<DD><TABLE> +<TR><TD>window</TD> +</TD><TD> +The window on which <VAR>event</VAR> was generated and is referred to as the +event window. +</TR> +<TR><TD>root</TD> +</TD><TD> +is the event window's root window. +</TR> +<TR><TD>subwindow</TD> +</TD><TD> +If the source window is an inferior of the event window, the +<VAR>subwindow</VAR> is the child of the event window that is the source +window or the child of the event window that is an ancestor of the +source window. Otherwise, `<SAMP>None</SAMP>'. +</TR> +<TR><TD>X-event:type</TD> +</TD><TD> +An integer: <VAR>x:Key-Press</VAR>, <VAR>x:Key-Release</VAR>, +<VAR>x:Button-Press</VAR>, <VAR>x:Button-Release</VAR>, <VAR>x:Motion-Notify</VAR>, +<VAR>x:Enter-Notify</VAR>, <VAR>x:Leave-Notify</VAR>, <VAR>x:Focus-In</VAR>, +<VAR>x:Focus-Out</VAR>, <VAR>x:Keymap-Notify</VAR>, <VAR>x:Expose</VAR>, +<VAR>x:Graphics-Expose</VAR>, <VAR>x:No-Expose</VAR>, <VAR>x:Visibility-Notify</VAR>, +<VAR>x:Create-Notify</VAR>, <VAR>x:Destroy-Notify</VAR>, <VAR>x:Unmap-Notify</VAR>, +<VAR>x:Map-Notify</VAR>, <VAR>x:Map-Request</VAR>, <VAR>x:Reparent-Notify</VAR>, +<VAR>x:Configure-Notify</VAR>, <VAR>x:Configure-Request</VAR>, +<VAR>x:Gravity-Notify</VAR>, <VAR>x:Resize-Request</VAR>, +<VAR>x:Circulate-Notify</VAR>, <VAR>x:Circulate-Request</VAR>, +<VAR>x:Property-Notify</VAR>, <VAR>x:Selection-Clear</VAR>, +<VAR>x:Selection-Request</VAR>, <VAR>x:Selection-Notify</VAR>, +<VAR>x:Colormap-Notify</VAR>, <VAR>x:Client-Message</VAR>, or +<VAR>x:Mapping-Notify</VAR>. +</TR> +<TR><TD>X-event:serial</TD> +</TD><TD> +The serial number of the protocol request that generated the <VAR>event</VAR>. +</TR> +<TR><TD>X-event:send-event</TD> +</TD><TD> +Boolean that indicates whether the event was sent by a different client. +</TR> +<TR><TD>X-event:time</TD> +</TD><TD> +The time when the <VAR>event</VAR> was generated expressed in milliseconds. +</TR> +<TR><TD>X-event:x</TD> +</TR> +<TR><TD>X-event:y</TD> +</TD><TD> +For window entry/exit events the <VAR>x</VAR> and <VAR>y</VAR> members are set to +the coordinates of the pointer position in the event window. This +position is always the pointer's final position, not its initial +position. If the event window is on the same screen as the root window, +<VAR>x</VAR> and <VAR>y</VAR> are the pointer coordinates relative to the event +window's origin. Otherwise, <VAR>x</VAR> and <VAR>y</VAR> are set to zero. + +For expose events The <VAR>x</VAR> and <VAR>y</VAR> members are set to the +coordinates relative to the drawable's origin and indicate the +upper-left corner of the rectangle. + +For configure, create, gravity, and reparent events the <VAR>x</VAR> and +<VAR>y</VAR> members are set to the window's coordinates relative to the +parent window's origin and indicate the position of the upper-left +outside corner of the created window. +</TR> +<TR><TD>X-event:x-root</TD> +</TR> +<TR><TD>X-event:y-root</TD> +</TD><TD> +The pointer's coordinates relative to the root window's origin at the +time of the <VAR>event</VAR>. +</TR> +<TR><TD>X-event:state</TD> +</TD><TD> +For keyboard, pointer and window entry/exit events, the state member is +set to indicate the logical state of the pointer buttons and modifier +keys just prior to the <VAR>event</VAR>, which is the bitwise inclusive OR of +one or more of the button or modifier key masks: <VAR>x:Button1-Mask</VAR>, +<VAR>x:Button2-Mask</VAR>, <VAR>x:Button3-Mask</VAR>, <VAR>x:Button4-Mask</VAR>, +<VAR>x:Button5-Mask</VAR>, <VAR>x:Shift-Mask</VAR>, <VAR>x:Lock-Mask</VAR>, +<VAR>x:Control-Mask</VAR>, <VAR>x:Mod1-Mask</VAR>, <VAR>x:Mod2-Mask</VAR>, +<VAR>x:Mod3-Mask</VAR>, <VAR>x:Mod4-Mask</VAR>, and <VAR>x:Mod5-Mask</VAR>. + +For visibility events, the state of the window's visibility: +<VAR>x:Visibility-Unobscured</VAR>, <VAR>x:Visibility-Partially-Obscured</VAR>, or +<VAR>x:Visibility-Fully-Obscured</VAR>. + +For colormap events, indicates whether the colormap is installed or +uninstalled: x:Colormap-Installed or x:Colormap-Uninstalled. + +For property events, indicates whether the property was changed to a new +value or deleted: x:Property-New-Value or x:Property-Delete. +</TR> +<TR><TD>X-event:keycode</TD> +</TD><TD> +An integer that represents a physical key on the keyboard. +</TR> +<TR><TD>X-event:same-screen</TD> +</TD><TD> +Indicates whether the event window is on the same screen as the root +window. If #t, the event and root windows are on the same screen. If +#f, the event and root windows are not on the same screen. +</TR> +<TR><TD>X-event:button</TD> +</TD><TD> +The pointer button that changed state; can be the <VAR>x:Button1</VAR>, +<VAR>x:Button2</VAR>, <VAR>x:Button3</VAR>, <VAR>x:Button4</VAR>, or <VAR>x:Button5</VAR> +value. +</TR> +<TR><TD>X-event:is-hint</TD> +</TD><TD> +Detail of motion-notify events: <VAR>x:Notify-Normal</VAR> or +<VAR>x:Notify-Hint</VAR>. +</TR> +<TR><TD>X-event:mode</TD> +</TD><TD> +Indicates whether the <VAR>event</VAR> is a normal event, pseudo-motion event +when a grab activates, or a pseudo-motion event when a grab deactivates: +<VAR>x:Notify-Normal</VAR>, <VAR>x:Notify-Grab</VAR>, or <VAR>x:Notify-Ungrab</VAR>. +</TR> +<TR><TD>X-event:detail</TD> +</TD><TD> +Indicates the notification detail: <VAR>x:Notify-Ancestor</VAR>, +<VAR>x:Notify-Virtual</VAR>, <VAR>x:Notify-Inferior</VAR>, +<VAR>x:Notify-Nonlinear</VAR>, or <VAR>x:Notify-Nonlinear-Virtual</VAR>. +</TR> +<TR><TD>X-event:focus</TD> +</TD><TD> +If the event window is the focus window or an inferior of the focus +window, #t; otherwise #f. +</TR> +<TR><TD>X-event:width</TD> +</TR> +<TR><TD>X-event:height</TD> +</TD><TD> +The size (extent) of the rectangle. +</TR> +<TR><TD>X-event:count</TD> +</TD><TD> +For mapping events is the number of keycodes altered. + +For expose events Is the number of Expose or GraphicsExpose events that +are to follow. If count is zero, no more Expose events follow for this +window. However, if count is nonzero, at least that number of Expose +events (and possibly more) follow for this window. Simple applications +that do not want to optimize redisplay by distinguishing between +subareas of its window can just ignore all Expose events with nonzero +counts and perform full redisplays on events with zero counts. +</TR> +<TR><TD>X-event:major-code</TD> +</TD><TD> +The major_code member is set to the graphics request initiated by the +client and can be either X_CopyArea or X_CopyPlane. If it is +X_CopyArea, a call to XCopyArea initiated the request. If it is +X_CopyPlane, a call to XCopyPlane initiated the request. +</TR> +<TR><TD>X-event:minor-code</TD> +</TD><TD> +Not currently used. +</TR> +<TR><TD>X-event:border-width</TD> +</TD><TD> +For configure events, the width of the window's border, in pixels. +</TR> +<TR><TD>X-event:override-redirect</TD> +</TD><TD> +The override-redirect attribute of the window. Window manager clients +normally should ignore this window if it is #t. +</TR> +<TR><TD>X-event:from-configure</TD> +</TD><TD> +True if the event was generated as a result of a resizing of the +window's parent when the window itself had a win-gravity of +x:Unmap-Gravity. +</TR> +<TR><TD>X-event:value-mask</TD> +</TD><TD> +Indicates which components were specified in the ConfigureWindow +protocol request. The corresponding values are reported as given in the +request. The remaining values are filled in from the current geometry +of the window, except in the case of above (sibling) and detail +(stack-mode), which are reported as None and Above, respectively, if +they are not given in the request. +</TR> +<TR><TD>X-event:place</TD> +</TD><TD> +The window's position after the restack occurs and is either +x:Place-On-Top or x:Place-On-Bottom. If it is x:Place-On-Top, the +window is now on top of all siblings. If it is x:Place-On-Bottom, the +window is now below all siblings. +</TR> +<TR><TD>X-event:new</TD> +</TD><TD> +indicate whether the colormap for the specified window was changed or +installed or uninstalled and can be True or False. If it is True, the +colormap was changed. If it is False, the colormap was installed or +uninstalled. +</TR> +<TR><TD>X-event:format</TD> +</TD><TD> +Is 8, 16, or 32 and specifies whether the data should be viewed as a +list of bytes, shorts, or longs +</TR> +<TR><TD>X-event:request</TD> +</TD><TD> +Indicates the kind of mapping change that occurred and can be +<VAR>x:Mapping-Modifier</VAR>, <VAR>x:Mapping-Keyboard</VAR>, or +<VAR>x:Mapping-Pointer</VAR>. If it is <VAR>x:Mapping-Modifier</VAR>, the +modifier mapping was changed. If it is <VAR>x:Mapping-Keyboard</VAR>, the +keyboard mapping was changed. If it is <VAR>x:Mapping-Pointer</VAR>, the +pointer button mapping was changed. +</TR> +<TR><TD>X-event:first-keycode</TD> +</TD><TD> +The X-event:first-keycode is set only if the X-event:request was set to +<VAR>x:Mapping-Keyboard</VAR>. The number in X-event:first-keycode +represents the first number in the range of the altered mapping, and +X-event:count represents the number of keycodes altered. +</TR></TABLE> +</DL> +<P> + +<A NAME="Index"></A> +<HR SIZE="6"> +<A NAME="SEC16"></A> +<TABLE CELLPADDING=1 CELLSPACING=1 BORDER=0> +<TR><TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC15"> < </A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC17"> > </A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT"> <TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC15"> << </A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC_Top"> Up </A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[ >> ]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT"> <TD VALIGN="MIDDLE" ALIGN="LEFT"> <TD VALIGN="MIDDLE" ALIGN="LEFT"> <TD VALIGN="MIDDLE" ALIGN="LEFT"> <TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC_Top">Top</A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC_Contents">Contents</A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[Index]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC_About"> ? </A>]</TD> +</TR></TABLE> +<H1> Procedure and Macro Index </H1> +<!--docid::SEC16::--> +<P> + +This is an alphabetical list of all the procedures and macros in Xlibscm. +</P> +<P> + +</P> +<table><tr><th valign=top>Jump to: </th><td><A HREF="Xlibscm.html#fn_H" style="text-decoration:none"><b>H</b></A> + +<A HREF="Xlibscm.html#fn_X" style="text-decoration:none"><b>X</b></A> + +</td></tr></table><P></P> +<TABLE border=0> +<TR><TD></TD><TH ALIGN=LEFT>Index Entry</TH><TH ALIGN=LEFT> Section</TH></TR> +<TR><TD COLSPAN=3> <HR></TD></TR> +<TR><TH><A NAME="fn_H"></A>H</TH><TD></TD><TD></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX4"><CODE>hostname:number.screen-number</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC2">2. Display and Screens</A></TD></TR> +<TR><TD COLSPAN=3> <HR></TD></TR> +<TR><TH><A NAME="fn_X"></A>X</TH><TD></TD><TD></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX143"><CODE>x:alloc-colormap-cells</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC10">6. Colormap</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX144"><CODE>x:alloc-colormap-cells</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC10">6. Colormap</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX145"><CODE>x:alloc-colormap-cells</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC10">6. Colormap</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX146"><CODE>x:alloc-colormap-cells</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC10">6. Colormap</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX155"><CODE>x:ccc</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC10">6. Colormap</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX159"><CODE>x:clear-area</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC11">7. Rendering</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX5"><CODE>x:close</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC2">2. Display and Screens</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX65"><CODE>x:close</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC4">3.1 Windows and Pixmaps</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX66"><CODE>x:close</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC4">3.1 Windows and Pixmaps</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX151"><CODE>x:color-ref</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC10">6. Colormap</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX152"><CODE>X:Color-Set!</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC10">6. Colormap</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX153"><CODE>X:Color-Set!</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC10">6. Colormap</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX149"><CODE>x:colormap-find-color</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC10">6. Colormap</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX150"><CODE>x:colormap-find-color</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC10">6. Colormap</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX142"><CODE>x:copy-colormap-and-free</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC10">6. Colormap</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX106"><CODE>x:copy-gc-fields!</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC7">4. Graphics Context</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX141"><CODE>x:create-colormap</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC10">6. Colormap</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX133"><CODE>x:create-cursor</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC9">5. Cursor</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX135"><CODE>x:create-cursor</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC9">5. Cursor</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX136"><CODE>x:create-cursor</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC9">5. Cursor</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX137"><CODE>x:create-cursor</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC9">5. Cursor</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX138"><CODE>x:create-cursor</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC9">5. Cursor</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX104"><CODE>x:create-gc</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC7">4. Graphics Context</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX63"><CODE>x:create-pixmap</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC4">3.1 Windows and Pixmaps</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX64"><CODE>x:create-pixmap</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC4">3.1 Windows and Pixmaps</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX61"><CODE>x:create-window</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC4">3.1 Windows and Pixmaps</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX62"><CODE>x:create-window</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC4">3.1 Windows and Pixmaps</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX17"><CODE>x:default-ccc</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC2">2. Display and Screens</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX18"><CODE>x:default-ccc</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC2">2. Display and Screens</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX19"><CODE>x:default-ccc</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC2">2. Display and Screens</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX14"><CODE>x:default-colormap</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC2">2. Display and Screens</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX15"><CODE>x:default-colormap</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC2">2. Display and Screens</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX16"><CODE>x:default-colormap</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC2">2. Display and Screens</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX20"><CODE>x:default-gc</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC2">2. Display and Screens</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX21"><CODE>x:default-gc</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC2">2. Display and Screens</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX22"><CODE>x:default-gc</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC2">2. Display and Screens</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX10"><CODE>x:default-screen</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC2">2. Display and Screens</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX26"><CODE>x:default-visual</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC2">2. Display and Screens</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX27"><CODE>x:default-visual</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC2">2. Display and Screens</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX28"><CODE>x:default-visual</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC2">2. Display and Screens</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX169"><CODE>x:draw-lines</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC13">Draw Shapes</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX170"><CODE>x:draw-lines</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC13">Draw Shapes</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX171"><CODE>x:draw-lines</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC13">Draw Shapes</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX163"><CODE>x:draw-points</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC13">Draw Shapes</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX164"><CODE>x:draw-points</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC13">Draw Shapes</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX165"><CODE>x:draw-points</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC13">Draw Shapes</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX166"><CODE>x:draw-segments</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC13">Draw Shapes</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX167"><CODE>x:draw-segments</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC13">Draw Shapes</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX168"><CODE>x:draw-segments</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC13">Draw Shapes</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX161"><CODE>x:draw-string</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC12">Draw Strings</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX181"><CODE>x:event-ref</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC15">9. Event</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX178"><CODE>x:events-queued</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC15">9. Event</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX172"><CODE>x:fill-polygon</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC13">Draw Shapes</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX173"><CODE>x:fill-polygon</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC13">Draw Shapes</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX174"><CODE>x:fill-polygon</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC13">Draw Shapes</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX160"><CODE>x:fill-rectangle</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC11">7. Rendering</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX156"><CODE>x:flush</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC11">7. Rendering</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX157"><CODE>x:flush</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC11">7. Rendering</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX158"><CODE>x:flush</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC11">7. Rendering</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX147"><CODE>x:free-colormap-cells</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC10">6. Colormap</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX148"><CODE>x:free-colormap-cells</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC10">6. Colormap</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX107"><CODE>x:gc-ref</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC7">4. Graphics Context</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX105"><CODE>x:gc-set!</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC7">4. Graphics Context</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX93"><CODE>x:get-window-property</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC6">3.3 Window Properties and Visibility</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX94"><CODE>x:get-window-property</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC6">3.3 Window Properties and Visibility</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX162"><CODE>x:image-string</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC12">Draw Strings</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX154"><CODE>x:install-colormap</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC10">6. Colormap</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX95"><CODE>x:list-properties</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC6">3.3 Window Properties and Visibility</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX31"><CODE>x:make-visual</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC2">2. Display and Screens</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX32"><CODE>x:make-visual</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC2">2. Display and Screens</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX101"><CODE>x:map-subwindows</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC6">3.3 Window Properties and Visibility</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX100"><CODE>x:map-window</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC6">3.3 Window Properties and Visibility</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX179"><CODE>x:next-event</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC15">9. Event</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX3"><CODE>x:open-display</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC2">2. Display and Screens</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX180"><CODE>x:peek-event</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC15">9. Event</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX177"><CODE>x:pending</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC15">9. Event</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX6"><CODE>x:protocol-version</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC2">2. Display and Screens</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX176"><CODE>x:q-length</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC15">9. Event</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX175"><CODE>x:read-bitmap-file</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC14">8. Images</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX11"><CODE>x:root-window</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC2">2. Display and Screens</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX12"><CODE>x:root-window</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC2">2. Display and Screens</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX13"><CODE>x:root-window</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC2">2. Display and Screens</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX56"><CODE>x:screen-black</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC2">2. Display and Screens</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX57"><CODE>x:screen-black</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC2">2. Display and Screens</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX58"><CODE>x:screen-black</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC2">2. Display and Screens</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX39"><CODE>x:screen-cells</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC2">2. Display and Screens</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX40"><CODE>x:screen-cells</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC2">2. Display and Screens</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX41"><CODE>x:screen-cells</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC2">2. Display and Screens</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX9"><CODE>x:screen-count</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC2">2. Display and Screens</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX42"><CODE>x:screen-depth</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC2">2. Display and Screens</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX43"><CODE>x:screen-depth</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC2">2. Display and Screens</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX44"><CODE>x:screen-depth</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC2">2. Display and Screens</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX45"><CODE>x:screen-depth</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC2">2. Display and Screens</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX23"><CODE>x:screen-depths</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC2">2. Display and Screens</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX24"><CODE>x:screen-depths</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC2">2. Display and Screens</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX25"><CODE>x:screen-depths</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC2">2. Display and Screens</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX50"><CODE>x:screen-dimensions</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC2">2. Display and Screens</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX51"><CODE>x:screen-dimensions</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC2">2. Display and Screens</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX52"><CODE>x:screen-dimensions</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC2">2. Display and Screens</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX47"><CODE>x:screen-size</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC2">2. Display and Screens</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX48"><CODE>x:screen-size</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC2">2. Display and Screens</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX49"><CODE>x:screen-size</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC2">2. Display and Screens</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX53"><CODE>x:screen-white</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC2">2. Display and Screens</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX54"><CODE>x:screen-white</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC2">2. Display and Screens</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX55"><CODE>x:screen-white</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC2">2. Display and Screens</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX7"><CODE>x:server-vendor</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC2">2. Display and Screens</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX103"><CODE>x:unmap-subwindows</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC6">3.3 Window Properties and Visibility</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX102"><CODE>x:unmap-window</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC6">3.3 Window Properties and Visibility</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX8"><CODE>x:vendor-release</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC2">2. Display and Screens</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX33"><CODE>x:visual-class</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC2">2. Display and Screens</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX34"><CODE>x:visual-class</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC2">2. Display and Screens</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX35"><CODE>x:visual-class</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC2">2. Display and Screens</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX36"><CODE>x:visual-geometry</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC2">2. Display and Screens</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX37"><CODE>x:visual-geometry</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC2">2. Display and Screens</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX38"><CODE>x:visual-geometry</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC2">2. Display and Screens</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX67"><CODE>x:window-geometry</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC4">3.1 Windows and Pixmaps</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX68"><CODE>x:window-geometry-set!</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC4">3.1 Windows and Pixmaps</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX92"><CODE>x:window-ref</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC5">3.2 Window Attributes</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX76"><CODE>x:window-set!</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC5">3.2 Window Attributes</A></TD></TR> +<TR><TD COLSPAN=3> <HR></TD></TR> +</TABLE><P></P><table><tr><th valign=top>Jump to: </th><td><A HREF="Xlibscm.html#fn_H" style="text-decoration:none"><b>H</b></A> + +<A HREF="Xlibscm.html#fn_X" style="text-decoration:none"><b>X</b></A> + +</td></tr></table><P> + +<HR SIZE="6"> +<A NAME="SEC17"></A> +<TABLE CELLPADDING=1 CELLSPACING=1 BORDER=0> +<TR><TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC16"> < </A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC18"> > </A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT"> <TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC16"> << </A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC_Top"> Up </A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[ >> ]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT"> <TD VALIGN="MIDDLE" ALIGN="LEFT"> <TD VALIGN="MIDDLE" ALIGN="LEFT"> <TD VALIGN="MIDDLE" ALIGN="LEFT"> <TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC_Top">Top</A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC_Contents">Contents</A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[Index]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC_About"> ? </A>]</TD> +</TR></TABLE> +<H1> Variable Index </H1> +<!--docid::SEC17::--> +<P> + +This is an alphabetical list of all the global variables in Xlibscm. +</P> +<P> + +</P> +<table><tr><th valign=top>Jump to: </th><td><A HREF="Xlibscm.html#vr_X" style="text-decoration:none"><b>X</b></A> + +</td></tr></table><P></P> +<TABLE border=0> +<TR><TD></TD><TH ALIGN=LEFT>Index Entry</TH><TH ALIGN=LEFT> Section</TH></TR> +<TR><TD COLSPAN=3> <HR></TD></TR> +<TR><TH><A NAME="vr_X"></A>X</TH><TD></TD><TD></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX78"><CODE>x:CW-Back-Pixel</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC5">3.2 Window Attributes</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX77"><CODE>x:CW-Back-Pixmap</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC5">3.2 Window Attributes</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX85"><CODE>x:CW-Backing-Pixel</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC5">3.2 Window Attributes</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX84"><CODE>x:CW-Backing-Planes</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC5">3.2 Window Attributes</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX83"><CODE>x:CW-Backing-Store</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC5">3.2 Window Attributes</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX81"><CODE>x:CW-Bit-Gravity</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC5">3.2 Window Attributes</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX80"><CODE>x:CW-Border-Pixel</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC5">3.2 Window Attributes</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX79"><CODE>x:CW-Border-Pixmap</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC5">3.2 Window Attributes</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX73"><CODE>x:CW-Border-Width</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC4">3.1 Windows and Pixmaps</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX90"><CODE>x:CW-Colormap</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC5">3.2 Window Attributes</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX91"><CODE>x:CW-Cursor</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC5">3.2 Window Attributes</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX89"><CODE>x:CW-Dont-Propagate</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC5">3.2 Window Attributes</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX88"><CODE>x:CW-Event-Mask</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC5">3.2 Window Attributes</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX72"><CODE>x:CW-Height</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC4">3.1 Windows and Pixmaps</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX86"><CODE>x:CW-Override-Redirect</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC5">3.2 Window Attributes</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX87"><CODE>x:CW-Save-Under</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC5">3.2 Window Attributes</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX74"><CODE>x:CW-Sibling</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC4">3.1 Windows and Pixmaps</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX75"><CODE>x:CW-Stack-Mode</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC4">3.1 Windows and Pixmaps</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX71"><CODE>x:CW-Width</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC4">3.1 Windows and Pixmaps</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX82"><CODE>x:CW-Win-Gravity</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC5">3.2 Window Attributes</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX69"><CODE>x:CWX</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC4">3.1 Windows and Pixmaps</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX70"><CODE>x:CWY</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC4">3.1 Windows and Pixmaps</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX132"><CODE>x:GC-Arc-Mode</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC8">GC Attributes</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX111"><CODE>x:GC-Background</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC8">GC Attributes</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX114"><CODE>x:GC-Cap-Style</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC8">GC Attributes</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX127"><CODE>x:GC-Clip-Mask</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC8">GC Attributes</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX125"><CODE>x:GC-Clip-X-Origin</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC8">GC Attributes</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX126"><CODE>x:GC-Clip-Y-Origin</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC8">GC Attributes</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX131"><CODE>x:GC-Dash-List</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC8">GC Attributes</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX130"><CODE>x:GC-Dash-Offset</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC8">GC Attributes</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX117"><CODE>x:GC-Fill-Rule</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC8">GC Attributes</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX116"><CODE>x:GC-Fill-Style</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC8">GC Attributes</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX122"><CODE>x:GC-Font</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC8">GC Attributes</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX110"><CODE>x:GC-Foreground</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC8">GC Attributes</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX108"><CODE>x:GC-Function</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC8">GC Attributes</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX124"><CODE>x:GC-Graphics-Exposures</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC8">GC Attributes</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX115"><CODE>x:GC-Join-Style</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC8">GC Attributes</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX113"><CODE>x:GC-Line-Style</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC8">GC Attributes</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX112"><CODE>x:GC-Line-Width</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC8">GC Attributes</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX109"><CODE>x:GC-Plane-Mask</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC8">GC Attributes</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX119"><CODE>x:GC-Stipple</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC8">GC Attributes</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX123"><CODE>x:GC-Subwindow-Mode</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC8">GC Attributes</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX118"><CODE>x:GC-Tile</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC8">GC Attributes</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX120"><CODE>x:GC-Tile-Stip-X-Origin</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC8">GC Attributes</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX121"><CODE>x:GC-Tile-Stip-Y-Origin</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC8">GC Attributes</A></TD></TR> +<TR><TD COLSPAN=3> <HR></TD></TR> +</TABLE><P></P><table><tr><th valign=top>Jump to: </th><td><A HREF="Xlibscm.html#vr_X" style="text-decoration:none"><b>X</b></A> + +</td></tr></table><P> + +This is an alphabetical list of concepts introduced in this manual. +</P> +<P> + +<HR SIZE="6"> +<A NAME="SEC18"></A> +<TABLE CELLPADDING=1 CELLSPACING=1 BORDER=0> +<TR><TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC17"> < </A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[ > ]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT"> <TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC17"> << </A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC_Top"> Up </A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[ >> ]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT"> <TD VALIGN="MIDDLE" ALIGN="LEFT"> <TD VALIGN="MIDDLE" ALIGN="LEFT"> <TD VALIGN="MIDDLE" ALIGN="LEFT"> <TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC_Top">Top</A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC_Contents">Contents</A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[Index]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC_About"> ? </A>]</TD> +</TR></TABLE> +<H1> Concept Index </H1> +<!--docid::SEC18::--> +<table><tr><th valign=top>Jump to: </th><td><A HREF="Xlibscm.html#cp_C" style="text-decoration:none"><b>C</b></A> + +<A HREF="Xlibscm.html#cp_D" style="text-decoration:none"><b>D</b></A> + +<A HREF="Xlibscm.html#cp_M" style="text-decoration:none"><b>M</b></A> + +<A HREF="Xlibscm.html#cp_N" style="text-decoration:none"><b>N</b></A> + +<A HREF="Xlibscm.html#cp_R" style="text-decoration:none"><b>R</b></A> + +<A HREF="Xlibscm.html#cp_U" style="text-decoration:none"><b>U</b></A> + +<A HREF="Xlibscm.html#cp_V" style="text-decoration:none"><b>V</b></A> + +<A HREF="Xlibscm.html#cp_X" style="text-decoration:none"><b>X</b></A> + +</td></tr></table><P></P> +<TABLE border=0> +<TR><TD></TD><TH ALIGN=LEFT>Index Entry</TH><TH ALIGN=LEFT> Section</TH></TR> +<TR><TD COLSPAN=3> <HR></TD></TR> +<TR><TH><A NAME="cp_C"></A>C</TH><TD></TD><TD></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX139">colormap</A></TD><TD valign=top><A HREF="Xlibscm.html#SEC10">6. Colormap</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX134">cursor</A></TD><TD valign=top><A HREF="Xlibscm.html#SEC9">5. Cursor</A></TD></TR> +<TR><TD COLSPAN=3> <HR></TD></TR> +<TR><TH><A NAME="cp_D"></A>D</TH><TD></TD><TD></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX46">depth</A></TD><TD valign=top><A HREF="Xlibscm.html#SEC2">2. Display and Screens</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX60">drawable</A></TD><TD valign=top><A HREF="Xlibscm.html#SEC3">3. Drawables</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX59">Drawable</A></TD><TD valign=top><A HREF="Xlibscm.html#SEC3">3. Drawables</A></TD></TR> +<TR><TD COLSPAN=3> <HR></TD></TR> +<TR><TH><A NAME="cp_M"></A>M</TH><TD></TD><TD></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX96">map</A></TD><TD valign=top><A HREF="Xlibscm.html#SEC6">3.3 Window Properties and Visibility</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX98">mapped</A></TD><TD valign=top><A HREF="Xlibscm.html#SEC6">3.3 Window Properties and Visibility</A></TD></TR> +<TR><TD COLSPAN=3> <HR></TD></TR> +<TR><TH><A NAME="cp_N"></A>N</TH><TD></TD><TD></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX129">none</A></TD><TD valign=top><A HREF="Xlibscm.html#SEC8">GC Attributes</A></TD></TR> +<TR><TD COLSPAN=3> <HR></TD></TR> +<TR><TH><A NAME="cp_R"></A>R</TH><TD></TD><TD></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX140">RGB</A></TD><TD valign=top><A HREF="Xlibscm.html#SEC10">6. Colormap</A></TD></TR> +<TR><TD COLSPAN=3> <HR></TD></TR> +<TR><TH><A NAME="cp_U"></A>U</TH><TD></TD><TD></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX97">unmap</A></TD><TD valign=top><A HREF="Xlibscm.html#SEC6">3.3 Window Properties and Visibility</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX99">unmapped</A></TD><TD valign=top><A HREF="Xlibscm.html#SEC6">3.3 Window Properties and Visibility</A></TD></TR> +<TR><TD COLSPAN=3> <HR></TD></TR> +<TR><TH><A NAME="cp_V"></A>V</TH><TD></TD><TD></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX29">visual</A></TD><TD valign=top><A HREF="Xlibscm.html#SEC2">2. Display and Screens</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX30">Visual</A></TD><TD valign=top><A HREF="Xlibscm.html#SEC2">2. Display and Screens</A></TD></TR> +<TR><TD COLSPAN=3> <HR></TD></TR> +<TR><TH><A NAME="cp_X"></A>X</TH><TD></TD><TD></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX1">X</A></TD><TD valign=top><A HREF="Xlibscm.html#SEC1">1. Xlibscm</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX128">x:None</A></TD><TD valign=top><A HREF="Xlibscm.html#SEC8">GC Attributes</A></TD></TR> +<TR><TD></TD><TD valign=top><A HREF="Xlibscm.html#IDX2"><CODE>Xlib</CODE></A></TD><TD valign=top><A HREF="Xlibscm.html#SEC1">1. Xlibscm</A></TD></TR> +<TR><TD COLSPAN=3> <HR></TD></TR> +</TABLE><P></P><table><tr><th valign=top>Jump to: </th><td><A HREF="Xlibscm.html#cp_C" style="text-decoration:none"><b>C</b></A> + +<A HREF="Xlibscm.html#cp_D" style="text-decoration:none"><b>D</b></A> + +<A HREF="Xlibscm.html#cp_M" style="text-decoration:none"><b>M</b></A> + +<A HREF="Xlibscm.html#cp_N" style="text-decoration:none"><b>N</b></A> + +<A HREF="Xlibscm.html#cp_R" style="text-decoration:none"><b>R</b></A> + +<A HREF="Xlibscm.html#cp_U" style="text-decoration:none"><b>U</b></A> + +<A HREF="Xlibscm.html#cp_V" style="text-decoration:none"><b>V</b></A> + +<A HREF="Xlibscm.html#cp_X" style="text-decoration:none"><b>X</b></A> + +</td></tr></table><P> + +<HR SIZE="6"> +<A NAME="SEC_Contents"></A> +<TABLE CELLPADDING=1 CELLSPACING=1 BORDER=0> +<TR><TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC_Top">Top</A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC_Contents">Contents</A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[Index]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC_About"> ? </A>]</TD> +</TR></TABLE> +<H1>Table of Contents</H1> +<BLOCKQUOTE> +<A NAME="TOC1" HREF="Xlibscm.html#SEC1">1. Xlibscm</A> +<BR> +<A NAME="TOC2" HREF="Xlibscm.html#SEC2">2. Display and Screens</A> +<BR> +<A NAME="TOC3" HREF="Xlibscm.html#SEC3">3. Drawables</A> +<BR> +<BLOCKQUOTE> +<A NAME="TOC4" HREF="Xlibscm.html#SEC4">3.1 Windows and Pixmaps</A> +<BR> +<A NAME="TOC5" HREF="Xlibscm.html#SEC5">3.2 Window Attributes</A> +<BR> +<A NAME="TOC6" HREF="Xlibscm.html#SEC6">3.3 Window Properties and Visibility</A> +<BR> +</BLOCKQUOTE> +<A NAME="TOC7" HREF="Xlibscm.html#SEC7">4. Graphics Context</A> +<BR> +<A NAME="TOC9" HREF="Xlibscm.html#SEC9">5. Cursor</A> +<BR> +<A NAME="TOC10" HREF="Xlibscm.html#SEC10">6. Colormap</A> +<BR> +<A NAME="TOC11" HREF="Xlibscm.html#SEC11">7. Rendering</A> +<BR> +<A NAME="TOC14" HREF="Xlibscm.html#SEC14">8. Images</A> +<BR> +<A NAME="TOC15" HREF="Xlibscm.html#SEC15">9. Event</A> +<BR> +<A NAME="TOC16" HREF="Xlibscm.html#SEC16">Procedure and Macro Index</A> +<BR> +<A NAME="TOC17" HREF="Xlibscm.html#SEC17">Variable Index</A> +<BR> +<A NAME="TOC18" HREF="Xlibscm.html#SEC18">Concept Index</A> +<BR> +</BLOCKQUOTE> +<HR SIZE=1> +<A NAME="SEC_OVERVIEW"></A> +<TABLE CELLPADDING=1 CELLSPACING=1 BORDER=0> +<TR><TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC_Top">Top</A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC_Contents">Contents</A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[Index]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC_About"> ? </A>]</TD> +</TR></TABLE> +<H1>Short Table of Contents</H1> +<BLOCKQUOTE> +<A NAME="TOC1" HREF="Xlibscm.html#SEC1">1. Xlibscm</A> +<BR> +<A NAME="TOC2" HREF="Xlibscm.html#SEC2">2. Display and Screens</A> +<BR> +<A NAME="TOC3" HREF="Xlibscm.html#SEC3">3. Drawables</A> +<BR> +<A NAME="TOC7" HREF="Xlibscm.html#SEC7">4. Graphics Context</A> +<BR> +<A NAME="TOC9" HREF="Xlibscm.html#SEC9">5. Cursor</A> +<BR> +<A NAME="TOC10" HREF="Xlibscm.html#SEC10">6. Colormap</A> +<BR> +<A NAME="TOC11" HREF="Xlibscm.html#SEC11">7. Rendering</A> +<BR> +<A NAME="TOC14" HREF="Xlibscm.html#SEC14">8. Images</A> +<BR> +<A NAME="TOC15" HREF="Xlibscm.html#SEC15">9. Event</A> +<BR> +<A NAME="TOC16" HREF="Xlibscm.html#SEC16">Procedure and Macro Index</A> +<BR> +<A NAME="TOC17" HREF="Xlibscm.html#SEC17">Variable Index</A> +<BR> +<A NAME="TOC18" HREF="Xlibscm.html#SEC18">Concept Index</A> +<BR> + +</BLOCKQUOTE> +<HR SIZE=1> +<A NAME="SEC_About"></A> +<TABLE CELLPADDING=1 CELLSPACING=1 BORDER=0> +<TR><TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC_Top">Top</A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC_Contents">Contents</A>]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[Index]</TD> +<TD VALIGN="MIDDLE" ALIGN="LEFT">[<A HREF="Xlibscm.html#SEC_About"> ? </A>]</TD> +</TR></TABLE> +<H1>About this document</H1> +This document was generated +by +using <A HREF="http://texi2html.cvshome.org"><I>texi2html</I></A> +<P></P> +The buttons in the navigation panels have the following meaning: +<P></P> +<table border = "1"> +<TR> +<TH> Button </TH> +<TH> Name </TH> +<TH> Go to </TH> +<TH> From 1.2.3 go to</TH> +</TR> +<TR> +<TD ALIGN="CENTER"> + [ < ] </TD> +<TD ALIGN="CENTER"> +Back +</TD> +<TD> +previous section in reading order +</TD> +<TD> +1.2.2 +</TD> +</TR> +<TR> +<TD ALIGN="CENTER"> + [ > ] </TD> +<TD ALIGN="CENTER"> +Forward +</TD> +<TD> +next section in reading order +</TD> +<TD> +1.2.4 +</TD> +</TR> +<TR> +<TD ALIGN="CENTER"> + [ << ] </TD> +<TD ALIGN="CENTER"> +FastBack +</TD> +<TD> +beginning of this chapter or previous chapter +</TD> +<TD> +1 +</TD> +</TR> +<TR> +<TD ALIGN="CENTER"> + [ Up ] </TD> +<TD ALIGN="CENTER"> +Up +</TD> +<TD> +up section +</TD> +<TD> +1.2 +</TD> +</TR> +<TR> +<TD ALIGN="CENTER"> + [ >> ] </TD> +<TD ALIGN="CENTER"> +FastForward +</TD> +<TD> +next chapter +</TD> +<TD> +2 +</TD> +</TR> +<TR> +<TD ALIGN="CENTER"> + [Top] </TD> +<TD ALIGN="CENTER"> +Top +</TD> +<TD> +cover (top) of document +</TD> +<TD> + +</TD> +</TR> +<TR> +<TD ALIGN="CENTER"> + [Contents] </TD> +<TD ALIGN="CENTER"> +Contents +</TD> +<TD> +table of contents +</TD> +<TD> + +</TD> +</TR> +<TR> +<TD ALIGN="CENTER"> + [Index] </TD> +<TD ALIGN="CENTER"> +Index +</TD> +<TD> +concept index +</TD> +<TD> + +</TD> +</TR> +<TR> +<TD ALIGN="CENTER"> + [ ? ] </TD> +<TD ALIGN="CENTER"> +About +</TD> +<TD> +this page +</TD> +<TD> + +</TD> +</TR> +</TABLE> + <P> + where the <STRONG> Example </STRONG> assumes that the current position + is at <STRONG> Subsubsection One-Two-Three </STRONG> of a document of + the following structure:</P> + <UL> + <LI> 1. Section One + <UL> + <LI>1.1 Subsection One-One + <UL> + <LI>...</LI> + </UL> + <LI>1.2 Subsection One-Two + <UL> + <LI>1.2.1 Subsubsection One-Two-One</LI> + <LI>1.2.2 Subsubsection One-Two-Two</LI> + <LI>1.2.3 Subsubsection One-Two-Three + <STRONG><== Current Position </STRONG></LI> + <LI>1.2.4 Subsubsection One-Two-Four</LI> + </UL> + </LI> + <LI>1.3 Subsection One-Three + <UL> + <LI>...</LI> + </UL> + </LI> + <LI>1.4 Subsection One-Four</LI> + </UL> + </LI> + </UL> + +<HR SIZE=1> +<BR> +<FONT SIZE="-1"> +This document was generated +by <I>James LewisMoss</I> on <I>May, 6 2004</I> +using <A HREF="http://texi2html.cvshome.org"><I>texi2html</I></A> +</FONT> + +</BODY> +</HTML> diff --git a/Xlibscm.info b/Xlibscm.info index 1052cba..a9d7325 100644 --- a/Xlibscm.info +++ b/Xlibscm.info @@ -12,7 +12,7 @@ File: Xlibscm.info, Node: Top, Next: Xlibscm, Prev: (dir), Up: (dir) This manual documents the X - SCM Language X Interface. The most recent information about SCM can be found on SCM's "WWW" home page: - <http://swissnet.ai.mit.edu/~jaffer/SCM.html> + <http://swissnet.ai.mit.edu/~jaffer/SCM> Copyright (C) 1990-1999 Free Software Foundation @@ -2071,18 +2071,18 @@ Concept Index Tag Table: Node: Top215 -Node: Xlibscm1333 -Node: Display and Screens4123 -Node: Drawables11108 -Node: Windows and Pixmaps11369 -Node: Window Attributes18448 -Node: Window Properties and Visibility34428 -Node: Graphics Context38885 -Node: Cursor54592 -Node: Colormap57095 -Node: Rendering66961 -Node: Images74518 -Node: Event74659 -Node: Index89134 +Node: Xlibscm1330 +Node: Display and Screens4120 +Node: Drawables11105 +Node: Windows and Pixmaps11366 +Node: Window Attributes18445 +Node: Window Properties and Visibility34425 +Node: Graphics Context38882 +Node: Cursor54589 +Node: Colormap57092 +Node: Rendering66958 +Node: Images74515 +Node: Event74656 +Node: Index89131 End Tag Table diff --git a/Xlibscm.texi b/Xlibscm.texi index 1d41a3c..9ecaee1 100644 --- a/Xlibscm.texi +++ b/Xlibscm.texi @@ -54,7 +54,7 @@ by the author. This manual documents the X - SCM Language X Interface. The most recent information about SCM can be found on SCM's @dfn{WWW} home page: -@center @url{http://swissnet.ai.mit.edu/~jaffer/SCM.html} +@center @url{http://swissnet.ai.mit.edu/~jaffer/SCM} Copyright (C) 1990-1999 Free Software Foundation @@ -126,7 +126,7 @@ dynamic linking, compiled separately and loaded with @code{(require @noindent The most recent information about SCM can be found on SCM's @dfn{WWW} home page: -@center @url{http://swissnet.ai.mit.edu/~jaffer/SCM.html} +@center @url{http://swissnet.ai.mit.edu/~jaffer/SCM} @end iftex Much of this X documentation is dervied from: @@ -1,4 +1,4 @@ -;; Copyright (C) 1996, 1997, 2001 Free Software Foundation, Inc. +;; Copyright (C) 1996, 1997, 2001, 2002 Free Software Foundation, Inc. ;; ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by @@ -38,11 +38,17 @@ ;; whether to permit this exception to apply to your modifications. ;; If you do not wish that, delete this exception notice. -;;;; "bench.scm", Scheme benchmark computing digits of pi. +;;;; "bench.scm", Scheme benchmarks: digits of pi and random statistics. ;;; Author: Aubrey Jaffer. -(load (in-vicinity (implementation-vicinity) "pi.scm")) (require 'transcript) +(require-if 'inexact 'root) +(require-if 'inexact 'printf) +(require 'random) +(require 'array) +;;(load (in-vicinity (implementation-vicinity) "prng-v.scm")) + +(load (in-vicinity (implementation-vicinity) "pi.scm")) (define isqrt (cond ((provided? 'inexact) sqrt) (else (require 'root) integer-sqrt))) @@ -51,26 +57,23 @@ (else quotient))) (define around (cond ((provided? 'inexact) - (lambda (x bnd) - (cond ((>= 99999 (abs x) bnd) (inexact->exact (round x))) - ((> (abs x) 99999) (round x)) - (else x)))) - (else (lambda (x bnd) x)))) + (let () + (require 'printf) + (lambda (x prec) (sprintf #f "%.*g" prec x)))) + (else (lambda (x prec) x)))) -(define (time-pi digits) +(define (time-call proc . args) (let ((start-time (get-internal-run-time))) - (pi digits 4) + (apply proc args) (i/ (* 1000 (- (get-internal-run-time) start-time)) internal-time-units-per-second))) -(define (benchmark . arg) - (define file - (cond ((null? arg) "bench.log") - (else (car arg)))) +(define (benchmark-pi . arg) + (define file (if (null? arg) "pi.log" (car arg))) (do ((digits 50 (+ digits digits)) - (t 0 (time-pi (+ digits digits)))) - ((> t 3000) - (do ((tl '() (cons (time-pi digits) tl)) + (t 0 (time-call pi (+ digits digits) 4))) + ((> t 3600) + (do ((tl '() (cons (time-call pi digits 4) tl)) (j 12 (+ -1 j))) ((zero? j) (let* ((avg (i/ (apply + tl) (length tl))) @@ -80,18 +83,68 @@ (length tl))))) (and file (transcript-on file)) (for-each display - (list digits " digits took " (around avg 99) - " +/- " (around dev 3) ".ms")) + (list digits " digits of pi took " (around avg 4) ".ms" + " +/- " (around dev 2) ".ms")) (newline) (let ((scaled-avg (i/ (* (i/ (* avg 1000) digits) 1000) digits)) (scaled-dev (i/ (* (i/ (* dev 1000) digits) 1000) digits))) (for-each display (list " That is about " - (around scaled-avg 99) + (around scaled-avg 4) ".ms/(kB)^2" " +/- " - (around scaled-dev 3) - ".ms/(kB)^2")) + (around scaled-dev 2) ".ms/(kB)^2")) (newline) (and file (transcript-off))) )))))) -(benchmark) + +(define (prng samples modu sta) + (define sra (create-array (Au32) samples)) + (do ((cnt (+ -1 samples) (+ -1 cnt)) + (num (random modu sta) (random modu sta)) + (sum 0 (+ sum num))) + ((negative? cnt) + (set! sum (+ sum num)) + (let ((mean (i/ sum samples))) + (define (square-diff x) (define z (- x mean)) (* z z)) + (do ((cnt (+ -1 samples) (+ -1 cnt)) + (var2 0 (+ (square-diff (array-ref sra cnt)) var2))) + ((negative? cnt) + (for-each display + (list sum " / " samples " = " + mean " +/- " (isqrt (i/ var2 samples)))) + (newline))))) + (array-set! sra num cnt))) + +(define (benchmark-prng . arg) + (define file (if (null? arg) "prng.log" (car arg))) + (define sta + (seed->random-state "http://swissnet.ai.mit.edu/~jaffer/SLIB.html")) + (do ((samples 125 (* 4 samples)) + (t 0 (time-call prng (* 2 samples) 999 sta))) + ((or (> t 1000) (and (not (provided? 'bignum)) (> samples 1000))) + (do ((tl '() (cons (time-call prng samples 999 sta) tl)) + (j 12 (+ -1 j))) + ((zero? j) + (let* ((avg (i/ (apply + tl) (length tl))) + (dev (isqrt (i/ (apply + + (map (lambda (x) (* (- x avg) (- x avg))) + tl)) + (length tl))))) + (and file (transcript-on file)) + (for-each display + (list samples " random samples took " (around avg 4) ".ms" + " +/- " (around dev 2) ".ms")) + (newline) + (let ((scaled-avg (i/ (* avg 1000) samples)) + (scaled-dev (i/ (* dev 1000) samples))) + (for-each display + (list " That is about " + (around scaled-avg 4) ".ms/kB" + " +/- " + (around scaled-dev 2) ".ms/kB")) + (newline) + (and file (transcript-off))))))))) + +(benchmark-prng) +(newline) +(benchmark-pi) @@ -1,24 +1,29 @@ #! /bin/sh -:;exec ./scmlit -f $0 -e"(bi)" build $* +:;exec ./scmlit -no-init-file -f $0 -e"(bi)" build $* -(require (in-vicinity (program-vicinity) "build.scm")) (require 'getopt) (require 'getopt-parameters) +(require-if 'compiling 'posix) +(require-if 'compiling 'fluid-let) +(require-if 'compiling 'read-command) +(require-if 'compiling 'common-list-functions) +(load (in-vicinity (program-vicinity) "build.scm")) +;@ (define (make-features-txi) (call-with-output-file "features.txi" (lambda (port) - ((((build 'open-table) 'features #f) 'for-each-row) + (((open-table build 'features) 'for-each-row-in-order) (lambda (row) (apply (lambda (name spec documentation) (display "@item " port) (display name port) (newline port) (display "@cindex " port) (display name port) (newline port) (display documentation port) (newline port) (newline port)) row)))))) - +;@ (define (print-manifest port) (display "@multitable @columnfractions .22 .78" port) (newline port) - ((((build 'open-table) 'manifest #f) 'for-each-row) + (((open-table build 'manifest) 'for-each-row-in-order) (lambda (row) (apply (lambda (file format category documentation) (display (string-append "@item @code{" file) port) @@ -34,7 +39,7 @@ ((negative? n) (close-port cat)) (newline cat))) (system (string-append "info -f " path " -n '" node "' -o - >> " afile))) - +;@ (define (make-readme) (require 'posix) (let ((pipe (open-output-pipe "makeinfo --no-headers -o README")) @@ -49,7 +54,7 @@ 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. -@center @url{http://swissnet.ai.mit.edu/~jaffer/SCM.html} +@center @url{http://swissnet.ai.mit.edu/~jaffer/SCM} @section Manifest " @@ -66,22 +71,29 @@ NOS/VE, Unicos, VMS, Unix and similar systems. (append-info-node scm-info "Testing" "README"))) (define build:csv (make-command-server build '*commands*)) -(define (build-from-argv argv) - (cond ((string? argv) - (require 'read-command) - (set! argv (call-with-input-string argv read-command)))) - (let () - (define command (string->symbol (list-ref argv *optind*))) - (define argc (length argv)) +(define (build-from-argv) + (define command (string->symbol (list-ref *argv* *optind*))) + (define getopt- getopt--) + (require 'fluid-let) + (fluid-let ((getopt-- + (lambda (optstring) + (let* ((opt (getopt- (string-append optstring "f:-:")))) + (cond ((eqv? #\f opt) + (let () + (require 'read-command) + (require 'common-list-functions) + (set! *argv* (append (butnthcdr *optind* *argv*) + (read-options-file *optarg*) + (nthcdr *optind* *argv*)))))) + opt)))) (cond - ((pair? argv) + ((pair? *argv*) (set! *optind* (+ 1 *optind*)) (build:csv command (lambda (comname comval options positions arities types defaulters checks aliases) - (let* ((params (getopt->parameter-list - argc argv options arities types aliases)) + (let* ((params (getopt->parameter-list options arities types aliases)) (fparams (and params (fill-empty-parameters defaulters params)))) (cond ((not (list? params)) ;;(slib:warn 'build-from-argv 'not-parameters? fparams) @@ -90,16 +102,24 @@ NOS/VE, Unicos, VMS, Unix and similar systems. (slib:warn 'build-from-argv 'check-parameters 'failed) #f) ((not (check-arities (map arity->arity-spec arities) fparams)) - (slib:error 'build-from-argv "arity error" fparams) #f) + (slib:error 'build-from-argv 'bad 'arity fparams) #f) (else (comval fparams)))))))))) - +;@ (define (build-from-whole-argv argv) + (if (string? argv) + (let () + (require 'read-command) + (set! argv (call-with-input-string argv read-command)))) (set! *optind* 0) (set! *optarg* #f) - (build-from-argv argv)) + (set! *argv* argv) + (build-from-argv)) +;;;@ Used when invoked as script +(define (bi) (exit (and (build-from-argv) #t))) +;@ (define b build-from-whole-argv) - +;@ (define (b*) (require 'read-command) (do ((e (read-command) (read-command))) @@ -113,8 +133,6 @@ NOS/VE, Unicos, VMS, Unix and similar systems. (display "build> ") (force-output))) -(define (bi) (if (build-from-argv *argv*) #t (exit #f))) - (cond (*interactive* (display "type (b \"build <command-line>\") to build") (newline) (display "type (b*) to enter build command loop") (newline))) @@ -1,18 +1,36 @@ -;;; "build.scm" Build database and program -*-scheme-*- -;;; Copyright (C) 1994-2002 Aubrey Jaffer. -;;; See the file `COPYING' for terms applying to this program. +;; "build.scm" Build database and program -*-scheme-*- +;; Copyright (C) 1994-2003 Aubrey Jaffer. +;; +;; 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 of the License, or (at +;; your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. (require 'parameters) (require 'databases) (require 'database-commands) +(require 'alist) +(require 'common-list-functions) +(require 'object->string) +(require 'glob) +(require 'batch) +(require-if 'compiling 'posix-time) +;@ (set! OPEN_WRITE "w") ; Because MS-DOS scripts need ^M - +;@ (define build (add-command-tables (create-database #f 'alist-table))) -(require 'glob) -(require 'batch) (batch:initialize! build) -((((build 'open-table) 'batch-dialect #t) 'row:insert) +(((open-table! build 'batch-dialect) 'row:insert) '(default-for-platform 0)) ;;;; This first part is about SCM files and features. @@ -98,6 +116,7 @@ ("ramap.c" c-source optional "array mapping") ("dynl.c" c-source optional "dynamically load object files.") ("sc2.c" c-source linkable "procedures from R2RS and R3RS not in R4RS.") + ("byte.c" c-source linkable "strings as bytes.") ("rgx.c" c-source linkable "string regular expression match.") ("crs.c" c-source linkable "interactive terminal control.") ("split.scm" Scheme test "example use of crs.c. Input, output, and diagnostic output directed to separate windows.") @@ -142,14 +161,14 @@ (documentation string)) ((none () "No features")))) -(for-each (build 'add-domain) - '((optstring #f (lambda (x) (or (not x) (string? x))) string #f) - (filename #f #f string #f) - (features features #f symbol #f) - (build-whats build-whats #f symbol #f))) +(define-domains build + '(optstring #f (lambda (x) (or (not x) (string? x))) string #f) + '(filename #f #f string #f) + '(features features #f symbol #f) + '(build-whats build-whats #f symbol #f)) (define define-build-feature - (let ((defeature (((build 'open-table) 'features #t) 'row:insert))) + (let ((defeature ((open-table! build 'features) 'row:insert))) (lambda args (defeature (append args (list (comment))))))) @@ -222,7 +241,7 @@ #;array-map! and array-for-each (arrays must also be featured). (define-build-feature 'array-for-each - '((c-file "ramap.c") (init "init_ramap"))) + '((c-file "ramap.c") (compiled-init "init_ramap"))) #;Use if you want floating point numbers. (define-build-feature @@ -268,11 +287,16 @@ 'rev2-procedures '((c-file "sc2.c") (init "init_sc2"))) +#;Treating strings as byte-vectors. +(define-build-feature + 'byte + '((c-file "byte.c") (init "init_byte"))) + #;The Record package provides a facility for user to define their own #;record data types. See SLIB for documentation. (define-build-feature 'record - '((define "CCLO") (c-file "record.c") (init "init_record"))) + '((define "CCLO") (c-file "record.c") (compiled-init "init_record"))) #;Use if you want to use compiled closures. (define-build-feature @@ -282,7 +306,7 @@ #;@code{make_gsubr} for arbitrary (< 11) arguments to C functions. (define-build-feature 'generalized-c-arguments - '((c-file "gsubr.c") (init "init_gsubr"))) + '((c-file "gsubr.c") (compiled-init "init_gsubr"))) #;Use if you want the ticks and ticks-interrupt functions. (define-build-feature @@ -315,7 +339,7 @@ #;For the @dfn{curses} screen management package. (define-build-feature 'curses - '((c-file "crs.c") (c-lib curses) (init "init_crs"))) + '((c-file "crs.c") (c-lib curses) (compiled-init "init_crs"))) #;interface to the editline or GNU readline library. (define-build-feature @@ -330,25 +354,25 @@ #;String regular expression matching. (define-build-feature 'regex - '((c-file "rgx.c") (c-lib regex) (init "init_rgx"))) + '((c-file "rgx.c") (c-lib regex) (compiled-init "init_rgx"))) #;BSD @dfn{socket} interface. (define-build-feature 'socket - '((c-lib socket) (c-file "socket.c") (init "init_socket"))) + '((c-lib socket) (c-file "socket.c") (compiled-init "init_socket"))) #;Posix functions available on all @dfn{Unix-like} systems. fork and #;process functions, user and group IDs, file permissions, and #;@dfn{link}. (define-build-feature 'posix - '((c-file "posix.c") (init "init_posix"))) + '((c-file "posix.c") (compiled-init "init_posix"))) #;Those unix features which have not made it into the Posix specs: #;nice, acct, lstat, readlink, symlink, mknod and sync. (define-build-feature 'unix - '((c-file "unix.c") (init "init_unix"))) + '((c-file "unix.c") (compiled-init "init_unix"))) #;Microsoft Windows executable. (define-build-feature @@ -396,15 +420,15 @@ (define-tables build '(processor-family - ((family atom)) + ((family symbol)) ((also-runs processor-family)) ((*unknown* #f) - (8086 #f) + (i8086 #f) (acorn #f) (alpha #f) (cray #f) (hp-risc #f) - (i386 8086) + (i386 i8086) (m68000 #f) (m68030 m68000) (mips #f) @@ -430,7 +454,7 @@ ((*unknown* *unknown* unix cc ) ;ld (acorn-unixlib acorn *unknown* cc ) ;link (aix powerpc aix cc ) ;cc - (alpha alpha osf1 cc ) ;cc + (osf1 alpha unix cc ) ;cc (alpha-elf alpha unix cc ) ;cc (alpha-linux alpha linux gcc ) ;gcc (amiga-aztec m68000 amiga cc ) ;cc @@ -439,8 +463,8 @@ (amiga-sas m68000 amiga lc ) ;link (atari-st-gcc m68000 atari.st gcc ) ;gcc (atari-st-turbo-c m68000 atari.st tcc ) ;tlink - (borland-c 8086 ms-dos bcc ) ;bcc - (cygwin32 i386 unix gcc ) ;gcc + (borland-c i8086 ms-dos bcc ) ;bcc + (gnu-win32 i386 unix gcc ) ;gcc (djgpp i386 ms-dos gcc ) ;gcc (freebsd i386 unix cc ) ;cc (gcc *unknown* unix gcc ) ;gcc @@ -450,10 +474,11 @@ (linux i386 linux gcc ) ;gcc (linux-aout i386 linux gcc ) ;gcc (darwin powerpc unix cc ) ;gcc - (microsoft-c 8086 ms-dos cl ) ;link + (microsoft-c i8086 ms-dos cl ) ;link (microsoft-c-nt i386 ms-dos cl ) ;link - (microsoft-quick-c 8086 ms-dos qcl ) ;qlink - (ms-dos 8086 ms-dos cc ) ;link + (microsoft-quick-c i8086 ms-dos qcl ) ;qlink + (ms-dos i8086 ms-dos cc ) ;link + (netbsd *unknown* unix gcc ) ;gcc (openbsd *unknown* unix gcc ) ;gcc (os/2-cset i386 os/2 icc ) ;link386 (os/2-emx i386 os/2 gcc ) ;gcc @@ -461,7 +486,7 @@ (svr4-gcc-sun-ld sparc sunos gcc ) ;ld (sunos sparc sunos cc ) ;ld (svr4 *unknown* unix cc ) ;ld - (turbo-c 8086 ms-dos tcc ) ;tcc + (turbo-c i8086 ms-dos tcc ) ;tcc (unicos cray unicos cc ) ;cc (unix *unknown* unix cc ) ;cc (vms vax vms cc ) ;link @@ -492,8 +517,9 @@ (mysql *unknown* "-I/usr/include/mysql" "-L/usr/lib/mysql -lmysqlclient" "/usr/lib/mysql/libmysqlclient.a" () ()) - (m cygwin32 "" "" "" () ()) - (c cygwin32 "" "" "" () ()) + (m gnu-win32 "" "" "" () ()) + (c gnu-win32 "" "" "" () ()) + (dlll gnu-win32 "-DSCM_DLL" "" #f () ("posix.c" "unix.c" "socket.c")) (m linux-aout "" "-lm" "/usr/lib/libm.sa" () ()) (c linux-aout "" "-lc" "/usr/lib/libc.sa" () ()) (dlll linux-aout "-DDLD -DDLD_DYNCM" "-ldld" #f () ("findexec.c")) @@ -505,12 +531,11 @@ (m linux "" "-lm" "/lib/libm.so" () ()) (c linux "" "-lc" "/lib/libc.so" () ()) - (regex linux "" "" "" () ()) - (termcap linux "" "-lncurses" "/usr/lib/libncurses.a" () ()) (dlll linux "-DSUN_DL" "-ldl" #f () ()) + (regex linux "" "" "" () ()) (graphics linux "-I/usr/include/X11 -DX11" "-L/usr/X11R6/lib -lX11" "/usr/X11R6/lib/libX11.so" () ()) - (curses linux "" "-lncurses" "/usr/lib/libncurses.so" () ()) + (curses linux "" "-lcurses" "/lib/libncurses.so" () ()) (nostart linux "" "" #f () ()) (dump linux "" "" #f ("unexelf.c" "gmalloc.c") ()) @@ -518,8 +543,12 @@ (m acorn-unixlib "" "" #f () ()) - (nostart alpha "" "-non_shared" #f ("pre-crt0.c") ()) - (dump alpha "" "" #f ("unexalpha.c") ()) + (nostart osf1 "" "" #f ("pre-crt0.c") ()) + (dlll osf1 "-DSUN_DL" "" #f () ()) + (dump osf1 "" "" #f ("unexalpha.c" "gmalloc.c") ()) + (regex osf1 "" "" #f () ()) + (graphics osf1 "-I/usr/include/X11 -DX11" "-lX11" + #f () ()) (m amiga-dice-c "" "-lm" #f () ()) (m amiga-sas "" "lcmieee.lib" #f () ()) @@ -566,13 +595,14 @@ ;;; (nostart djgpp "" "-e __start -nostartfiles -static" #f ("ecrt0.c") ()) ;;; (dump djgpp "" "" #f ("unexelf.c" "gmalloc.c") ()) - (c Microsoft-C "" "" #f () ("findexec.c")) - (m Microsoft-C "" "" #f () ()) - (c Microsoft-C-nt "" "" #f () ("findexec.c")) - (m Microsoft-C-nt "" "" #f () ()) - (debug Microsoft-C-nt "-Zi" "/debug" #f () ()) - (c Microsoft-Quick-C "" "" #f () ("findexec.c")) - (m Microsoft-Quick-C "" "" #f () ()) + (c microsoft-c "" "" #f () ("findexec.c")) + (m microsoft-c "" "" #f () ()) + (c microsoft-c-nt "" "" #f () ("findexec.c")) + (m microsoft-c-nt "" "" #f () ()) + (dlll microsoft-c-nt "-DSCM_DLL -MD" "" #f () ("posix.c" "unix.c" "socket.c")) + (debug microsoft-c-nt "-Zi" "/debug" #f () ()) + (c microsoft-quick-c "" "" #f () ("findexec.c")) + (m microsoft-quick-c "" "" #f () ()) (c turbo-c "" "" #f () ("findexec.c")) (m turbo-c "" "" #f () ()) @@ -592,13 +622,18 @@ (curses darwin "" "" #f () ()) (regex darwin "" "" #f () ()) + (c freebsd "" "-export-dynamic" #f () ()) (m freebsd "" "-lm" #f () ()) (curses freebsd "" "-lncurses" "/usr/lib/libncurses.a" () ()) (regex freebsd "" "-lgnuregex" "" () ()) (editline freebsd "" "-lreadline" "" () ()) - (dlll freebsd "-DSUN_DL" "" "" () ()) + (dlll freebsd "-DSUN_DL" "-export-dynamic" "" () ()) (nostart freebsd "" "-e start -dc -dp -Bstatic -lgnumalloc" #f ("pre-crt0.c") ()) (dump freebsd "" "/usr/lib/crt0.o" "" ("unexsunos4.c") ()) + (curses netbsd "-I/usr/pkg/include" "-lncurses" "-Wl,-rpath -Wl,/usr/pkg/lib -L/usr/pkg/lib" () ()) + (editline netbsd "-I/usr/pkg/include" "-lreadline" "-Wl,-rpath -Wl,/usr/pkg/lib -L/usr/pkg/lib" () ()) + (graphics netbsd "-I/usr/X11R6/include -DX11" "-lX11" "-Wl,-rpath -Wl,/usr/X11R6/lib -L/usr/X11R6/lib" () ()) + (m netbsd "" "-lm" #f () ()) (m openbsd "" "-lm" #f () ()) (curses openbsd "" "-lcurses" "/usr/lib/libcurses.a" () ()) )) @@ -614,7 +649,7 @@ objects)))))) (define define-compile-commands - (let ((defcomms (((build 'open-table) 'compile-commands #t) 'row:insert))) + (let ((defcomms ((open-table! build 'compile-commands) 'row:insert))) (lambda args (defcomms args)))) ;(append args (list (comment))) (defmacro defcommand (name platform procedure) @@ -626,7 +661,7 @@ (apply batch:lines->file parms rsp-name files) (and (batch:try-command parms - "bcc" "-d" "-O" "-Z" "-G" "-w-pro" "-ml" "-c" + "bcc" "-d" "-Z" "-G" "-w-pro" "-ml" "-c" (if (member '(define "FLOATS" #t) (c-defines parms)) "" "-f-") @@ -650,7 +685,7 @@ (lambda (files parms) (and (batch:try-chopped-command parms - "tcc" "-c" "-d" "-O" "-Z" "-G" "-ml" "-c" + "tcc" "-c" "-d" "-Z" "-G" "-ml" "-c" "-Ic:\\turboc\\include" (include-spec "-I" parms) (c-includes parms) @@ -669,7 +704,7 @@ (batch:rename-file parms exe oexe)) oexe)))) -(defcommand compile-c-files Microsoft-C +(defcommand compile-c-files microsoft-c (lambda (files parms) (and (batch:try-chopped-command parms "cl" "-c" "Oxp" "-AH" @@ -678,7 +713,7 @@ (c-flags parms) files) (truncate-up-to (map c->obj files) #\\)))) -(defcommand link-c-program Microsoft-C +(defcommand link-c-program microsoft-c (lambda (oname objects libs parms) (let ((exe (truncate-up-to (obj->exe (car objects)) #\\)) (oexe (string-append oname ".exe"))) @@ -691,7 +726,8 @@ (or (string-ci=? exe oexe) (batch:rename-file parms exe oexe)) oexe)))) -(defcommand compile-c-files Microsoft-C-nt + +(defcommand compile-c-files microsoft-c-nt (lambda (files parms) (and (batch:try-chopped-command parms @@ -703,7 +739,47 @@ (c-flags parms) files) (truncate-up-to (map c->obj files) #\\)))) -(defcommand link-c-program Microsoft-C-nt +(defcommand compile-dll-c-files microsoft-c-nt + (lambda (files parms) + (define platform (car (parameter-list-ref parms 'platform))) + (let ((suppressors (build:c-suppress 'dlll platform))) + (define c-files (remove-if (lambda (file) (member file suppressors)) + files)) + (and (batch:try-chopped-command + parms + "cl" "-c" "-nologo" + (if (memq 'stack-limit (parameter-list-ref parms 'features)) + "-Oityb1" "-Ox") + (include-spec "-I" parms) + (c-includes parms) + (c-flags parms) + c-files) + (let ((results + (map + (lambda (fname) + (and (batch:try-command + parms "link" "/dll" "/nologo" + (string-append "/out:" fname ".dll") + (string-append "/implib:" fname ".lib") + fname + (map (lambda (l) (build:lib-ld-flag l platform)) + (parameter-list-ref parms 'c-lib)) + "scm.lib") + (string-append fname ".dll"))) + (map c-> c-files)))) + (and (apply and? results) results)))))) +(defcommand make-dll-archive microsoft-c-nt + (lambda (oname objects libs parms) objects)) +(defcommand make-archive microsoft-c-nt + (lambda (oname objects libs parms) + (let ((aname (string-append oname ".dll"))) + (and (batch:try-command parms + "link" "/dll" "/nologo" + (string-append "/out:" aname) + (string-append "/implib:" oname ".lib") + libs (map obj-> objects)) + aname)))) +(defcommand link-c-program microsoft-c-nt (lambda (oname objects libs parms) (let ((exe (truncate-up-to (obj->exe (car objects)) #\\)) (oexe (string-append oname ".exe"))) @@ -714,7 +790,7 @@ libs) oexe)))) -(defcommand compile-c-files Microsoft-Quick-C +(defcommand compile-c-files microsoft-quick-c (lambda (files parms) (and (batch:try-chopped-command parms @@ -723,7 +799,7 @@ (c-flags parms) files) (truncate-up-to (map c->obj files) #\\)))) -(defcommand link-c-program Microsoft-Quick-C +(defcommand link-c-program microsoft-quick-c (lambda (oname objects libs parms) (define crf-name (string-append oname ".crf")) (apply batch:lines->file parms @@ -740,7 +816,7 @@ crf-name) (string-append oname ".exe")))) -(defcommand compile-c-files Watcom-9.0 +(defcommand compile-c-files watcom-9.0 (lambda (files parms) (and (batch:try-chopped-command parms @@ -750,7 +826,7 @@ (c-flags parms) files) (truncate-up-to (map c->obj files) #\\)))) -(defcommand link-c-program Watcom-9.0 +(defcommand link-c-program watcom-9.0 (lambda (oname objects libs parms) (let ((exe (truncate-up-to (obj->exe (car objects)) #\\)) (oexe (string-append oname ".exe"))) @@ -798,7 +874,7 @@ (lambda (files parms) (and (batch:try-chopped-command parms - "gcc" "-Wall" "-O2" "-c" + "gcc" "-c" (include-spec "-I" parms) (c-includes parms) (c-flags parms) files) @@ -837,7 +913,7 @@ (defcommand compile-c-files os/2-emx (lambda (files parms) (and (batch:try-chopped-command parms - "gcc" "-O" "-m386" "-c" + "gcc" "-m386" "-c" (include-spec "-I" parms) (c-includes parms) (c-flags parms) @@ -907,7 +983,7 @@ (defcommand compile-c-files linux-aout (lambda (files parms) (and (batch:try-chopped-command parms - "gcc" "-Wall" "-O2" "-c" + "gcc" "-c" (include-spec "-I" parms) (c-includes parms) (c-flags parms) @@ -917,7 +993,7 @@ (lambda (files parms) (and (batch:try-chopped-command parms - "gcc" "-Wall" "-O2" "-c" + "gcc" "-c" (c-includes parms) (c-flags parms) files) @@ -931,7 +1007,7 @@ (lambda (files parms) (and (batch:try-chopped-command parms - "gcc" "-O2" + "gcc" ;;(if (member "-g" (c-includes parms)) "" "-O2") "-c" (c-includes parms) (include-spec "-I" parms) @@ -943,8 +1019,7 @@ (and (batch:try-chopped-command parms - "gcc" "-O2" - "-fpic" "-c" (c-includes parms) + "gcc" "-fpic" "-c" (c-includes parms) (c-flags parms) files) (let* ((platform (car (parameter-list-ref parms 'platform))) @@ -1038,7 +1113,7 @@ (defcommand compile-c-files gcc (lambda (files parms) (and (batch:try-chopped-command parms - "gcc" "-O2" "-c" ; "-Wall" + "gcc" "-c" (include-spec "-I" parms) (c-includes parms) (c-flags parms) @@ -1059,7 +1134,7 @@ (defcommand compile-dll-c-files gcc (lambda (files parms) (and (batch:try-chopped-command parms - "gcc" "-O" "-c" + "gcc" "-c" (c-includes parms) (c-flags parms) files) @@ -1078,16 +1153,56 @@ (car (parameter-list-ref parms 'implvic)) oname ".so.1.0")))) -(defcommand compile-c-files cygwin32 +(defcommand compile-dll-c-files gnu-win32 + (lambda (files parms) + (define platform (car (parameter-list-ref parms 'platform))) + (let ((suppressors (build:c-suppress 'dlll platform))) + (define c-files (remove-if (lambda (file) (member file suppressors)) + files)) + (and (batch:try-chopped-command + parms + "gcc" "-c" + (include-spec "-I" parms) + (c-includes parms) + (c-flags parms) + c-files) + (let ((results + (map + (lambda (fname) + (and (batch:try-command + parms "dllwrap" + "--output-lib" (string-append fname ".lib") + "-dllname" (string-append fname ".dll") + "--output-def" (string-append fname ".def") + (string-append fname ".o") + (map (lambda (l) (build:lib-ld-flag l platform)) + (parameter-list-ref parms 'c-lib)) + "scm.lib") + (string-append fname ".dll"))) + (map c-> c-files)))) + (and (apply and? results) results)))))) +(defcommand make-dll-archive gnu-win32 + (lambda (oname objects libs parms) objects)) +(defcommand make-archive gnu-win32 + (lambda (oname objects libs parms) + (let ((aname (string-append oname ".dll"))) + (and (batch:try-command parms + "dllwrap" + "--output-lib" (string-append oname ".lib") + "-dllname" aname + "--output-def" (string-append oname ".def") + libs objects) + aname)))) +(defcommand compile-c-files gnu-win32 (lambda (files parms) (and (batch:try-chopped-command parms - "gcc" "-Wall" "-O2" "-c" + "gcc" "-c" (include-spec "-I" parms) (c-includes parms) (c-flags parms) files) (truncate-up-to (map c->o files) #\/)))) -(defcommand link-c-program cygwin32 +(defcommand link-c-program gnu-win32 (lambda (oname objects libs parms) (batch:rename-file parms (string-append oname ".exe") @@ -1101,10 +1216,62 @@ (append objects libs))) oname))) +(defcommand compile-c-files osf1 + (lambda (files parms) + (and (batch:try-chopped-command + parms + "cc" "-std1" + ;;(if (member "-g" (c-includes parms)) "" "-O") + "-c" (c-includes parms) + (include-spec "-I" parms) + (c-flags parms) + files) + (truncate-up-to (map c->o files) #\/)))) +(defcommand compile-dll-c-files osf1 + (lambda (files parms) + (and + (batch:try-chopped-command + parms "cc" "-std1" "-c" (c-includes parms) (c-flags parms) files) + (let* ((platform (car (parameter-list-ref parms 'platform))) + (ld-opts + (map (lambda (l) (build:lib-ld-flag l platform)) + (parameter-list-ref parms 'c-lib))) + (results + (map + (lambda (fname) + (and (batch:try-command + parms + "cc" "-shared" "-o" + (string-append fname ".so") + (string-append fname ".o") + ld-opts) + (batch:delete-file + parms (string-append fname ".o")) + (string-append fname ".so"))) + (truncate-up-to (map c-> files) #\/)))) + (and (apply and? results) results))))) +(defcommand make-dll-archive osf1 + (lambda (oname objects libs parms) + (let ((platform (car (parameter-list-ref + parms 'platform)))) + (and (batch:try-command + parms + "cc" "-shared" "-o" + (string-append + (car (parameter-list-ref parms 'implvic)) + oname ".so") + objects + (map (lambda (l) (build:lib-ld-flag l platform)) + (parameter-list-ref parms 'c-lib))) + (batch:rebuild-catalog parms) + (string-append + (car (parameter-list-ref parms 'implvic)) + oname ".so"))))) + (defcommand compile-c-files svr4-gcc-sun-ld (lambda (files parms) (and (batch:try-chopped-command parms - "gcc" "-O2" "-c" ; "-Wall" + "gcc" "-c" (include-spec "-I" parms) (c-includes parms) (c-flags parms) @@ -1127,7 +1294,7 @@ (and (batch:try-chopped-command parms - "gcc" "-O2" + "gcc" "-fpic" "-c" (c-includes parms) (c-flags parms) files) @@ -1153,7 +1320,7 @@ (defcommand compile-c-files svr4 (lambda (files parms) (and (batch:try-chopped-command parms - "cc" "-O" "-DSVR4" "-c" + "cc" "-DSVR4" "-c" (include-spec "-I" parms) (c-includes parms) (c-flags parms) @@ -1163,7 +1330,7 @@ (defcommand compile-c-files aix (lambda (files parms) (and (batch:try-chopped-command parms - "cc" "-O" "-Dunix" "-c" + "cc" "-Dunix" "-c" (include-spec "-I" parms) (c-includes parms) (c-flags parms) @@ -1194,7 +1361,7 @@ (lambda (files parms) (and (batch:try-chopped-command parms - "lc" "-d3" "-M" "-fi" "-O" + "lc" "-d3" "-M" "-fi" (include-spec "-I" parms) (c-includes parms) (c-flags parms) @@ -1241,7 +1408,7 @@ (defcommand compile-c-files amiga-gcc (lambda (files parms) (and (batch:try-chopped-command parms - "gcc" "-Wall" "-O2" "-c" + "gcc" "-c" (include-spec "-I" parms) (c-includes parms) (c-flags parms) @@ -1263,7 +1430,7 @@ (defcommand compile-c-files atari-st-gcc (lambda (files parms) (and (batch:try-chopped-command parms - "gcc" "-v" "-O" "-c" + "gcc" "-v" "-c" (include-spec "-I" parms) (c-includes parms) (c-flags parms) @@ -1374,7 +1541,7 @@ (lambda (files parms) (batch:try-chopped-command parms - "cc" "-O" "-c" + "cc" "-c" (include-spec "-I" parms) (c-includes parms) (c-flags parms) @@ -1401,7 +1568,7 @@ (defcommand compile-dll-c-files *unknown* (lambda (files parms) (and (batch:try-chopped-command parms - "cc" "-O" "-c" + "cc" "-c" (c-includes parms) (c-flags parms) files) @@ -1421,7 +1588,7 @@ (lambda (files parms) (and (batch:try-chopped-command parms - "cc" "-O" "-c" + "cc" "-O3 -pipe " "-c" (c-includes parms) (c-flags parms) files) @@ -1442,27 +1609,33 @@ (lambda (files parms) (and (batch:try-chopped-command parms - "cc" "-O" "-fpic" "-c" - (string-append - "-I" (parameter-list-ref parms 'scm-srcdir)) - (c-includes parms) + "cc" "-O3 -pipe " + "-fPIC" "-c" (c-includes parms) (c-flags parms) files) - (let ((objs (map c->o files))) - (every - (lambda (f) - (and (batch:try-command - parms "ld" "-Bshareable" f) - (batch:try-command - parms "mv" "a.out" f))) - objs) - objs)))) - + (let ((results + (map + (lambda (fname) + (and (batch:try-command + parms + "cc" "-shared" + (cond + ((equal? fname "edline") "-lreadline") + ((equal? fname "x") "-L/usr/X11R6/lib -lSM -lICE -lXext -lX11 -lxpg4") + (else "")) + "-o" + (string-append fname ".so") + (string-append fname ".o")) + (batch:delete-file + parms (string-append fname ".o")) + (string-append fname ".so"))) + (truncate-up-to (map c-> files) #\/)))) + (and (apply and? results) results))))) (defcommand make-dll-archive freebsd (lambda (oname objects libs parms) (and (batch:try-command parms - "ld" "-Bshareable" "-o" + "cc" "-shared" "-o" (string-append (car (parameter-list-ref parms 'implvic)) oname ".so") @@ -1490,11 +1663,66 @@ (append objects libs)) oname))) +(defcommand compile-c-files netbsd + (lambda (files parms) + (and (batch:try-chopped-command + parms + "cc" "-c" + (c-includes parms) + (c-flags parms) + files) + (map c->o files)))) +(defcommand link-c-program netbsd + (lambda (oname objects libs parms) + (batch:rename-file parms + oname (string-append oname "~")) + (and (batch:try-command parms + "cc" "-o" oname + (must-be-first + '("-nostartfiles" + "pre-crt0.o" "crt0.o" + "/usr/lib/crt0.o") + (append libs objects))) + oname))) +(defcommand compile-dll-c-files netbsd + (lambda (files parms) + (and (batch:try-chopped-command + parms + "cc" "-fPIC" "-c" + (string-append + "-I" (parameter-list-ref parms 'scm-srcdir)) + (c-includes parms) + (c-flags parms) + files) + (let ((objs (map c->o files))) + (every + (lambda (f) + (and (batch:try-command + parms "gcc" "-shared" "-fPIC" f) + (batch:try-command + parms "mv" "a.out" f))) + objs) + objs)))) + +(defcommand make-dll-archive netbsd + (lambda (oname objects libs parms) + (and (batch:try-command + parms + "gcc" "-shared" "-fPIC" "-o" + (string-append + (car (parameter-list-ref parms 'implvic)) + oname ".so") + objects) + (batch:rebuild-catalog parms) + (string-append + (car (parameter-list-ref parms 'implvic)) + oname ".so")))) + (defcommand compile-c-files openbsd (lambda (files parms) (and (batch:try-chopped-command parms - "cc" "-O2" "-Wall" "-c" + "cc" "-c" (c-includes parms) (c-flags parms) files) @@ -1515,7 +1743,7 @@ (lambda (files parms) (and (batch:try-chopped-command parms - "cc" "-O2" "-Wall" "-fPIC" "-c" + "cc" "-fPIC" "-c" (string-append "-I" (parameter-list-ref parms 'scm-srcdir)) (c-includes parms) @@ -1545,8 +1773,8 @@ (car (parameter-list-ref parms 'implvic)) oname ".so")))) -(for-each (build 'add-domain) - '((C-libraries C-libraries #f symbol #f))) +(define-domains build + '(C-libraries C-libraries #f symbol #f)) (define-tables build @@ -1570,15 +1798,15 @@ (9 compiled-init nary string #f #f "later initialization calls") (10 features nary features (lambda (pl) '(arrays inexact bignums)) - (lambda (rdb) (((rdb 'open-table) 'features #f) 'get 'spec)) + (lambda (rdb) ((open-table rdb 'features) 'get 'spec)) "features to include") (11 what single build-whats (lambda (pl) '(exe)) (lambda (rdb) - (let* ((bwt ((rdb 'open-table) 'build-whats #f)) + (let* ((bwt (open-table rdb 'build-whats)) (getclass (bwt 'get 'class)) (getspec (bwt 'get 'spec)) - (getfile (((rdb 'open-table) 'manifest #f) 'get* 'file))) + (getfile ((open-table rdb 'manifest) 'get* 'file))) (lambda (what) `((c-file ,@(getfile #f 'c-source (getclass what))) ,@(or (getspec what) '()))))) @@ -1598,6 +1826,10 @@ (18 c-includes nary expression #f #f "library induced defines for C") (19 batch-port nary expression #f #f "port batch file will be written to.") + ;; The options file is read by a fluid-let getopt-- in "build". + ;; This is here so the usage message will include -f <filename>. + (20 options-file nary filename #f #f + "file containing more build options.") )) '(build-pnames ((name string)) @@ -1618,6 +1850,7 @@ ("compiler options" 14) ("linker options" 15) ("scm srcdir" 16) + ("f" 20) )) '(*commands* @@ -1629,7 +1862,7 @@ ((build build-params build-pnames - build:build + build:command "compile and link SCM programs.") (*initialize* no-parameters @@ -1660,22 +1893,18 @@ (else (look '*unknown*))))) (look plat))) -(require 'alist) -(require 'common-list-functions) -(require 'object->string) - -(define (build:build rdb) +(define (build:command rdb) (lambda (parms) (let ((expanders (map (lambda (e) (and e (lambda (s) (e s)))) (map (lambda (f) (if f ((slib:eval f) rdb) f)) - ((((rdb 'open-table) 'build-params #f) + (((open-table rdb 'build-params) 'get* 'expander)))))) (parameter-list-expand expanders parms) (set! parms (fill-empty-parameters (map slib:eval - ((((rdb 'open-table) 'build-params #f) + (((open-table rdb 'build-params) 'get* 'defaulter))) parms)) (parameter-list-expand expanders parms)) @@ -1715,14 +1944,14 @@ (map (lambda (l) (build:lib-cc-flag l platform)) (parameter-list-ref parms 'c-lib))) (what (car (parameter-list-ref parms 'what))) - (c-proc (plan-command ((((rdb 'open-table) 'build-whats #f) + (c-proc (plan-command (((open-table rdb 'build-whats) 'get 'c-proc) what) platform))) (case (car (parameter-list-ref parms 'batch-dialect)) ((default-for-platform) - (let ((os ((((build 'open-table) 'platform #f) + (let ((os (((open-table build 'platform) 'get 'operating-system) platform))) (if (not os) (build:error "OS corresponding to " platform " unknown")) @@ -1738,7 +1967,7 @@ (cons 'operating-system (map platform->os (parameter-list-ref parms 'platform))) parms)) - + (let ((name (parameter-list-ref parms 'who))) (set! name (if (null? name) (current-output-port) (car name))) (batch:call-with-output-script @@ -1750,6 +1979,11 @@ parms (list 'batch-port batch-port)) + (let ((options-file (parameter-list-ref parms 'options-file))) + (and (not (null? options-file)) + (batch:comment + parms + (apply string-join " " "used options from:" options-file)))) (batch:comment parms "================ Write file with C defines") (cond ((not (apply batch:lines->file parms @@ -1782,7 +2016,7 @@ (batch:comment parms "================ Link C object files") (let ((ans ((plan-command - ((((rdb 'open-table) 'build-whats #f) 'get 'o-proc) what) + (((open-table rdb 'build-whats) 'get 'o-proc) what) platform) (car (parameter-list-ref parms 'target-name)) (append o-files (parameter-list-ref parms 'o-file)) @@ -1851,16 +2085,17 @@ (define (logger . args) (define cep (current-error-port)) - (cond ((provided? 'bignum) - (require 'posix-time) - (let ((ct (ctime (current-time)))) - (string-set! ct (+ -1 (string-length ct)) #\:) - (for-each (lambda (x) (display x cep)) - (cons ct (cons #\ args))))) - (else (for-each (lambda (x) (display x cep)) args))) + (for-each (lambda (x) (display #\ cep) (display x cep)) + (cond ((provided? 'bignum) + (require 'posix-time) + (let ((ct (ctime (current-time)))) + (string-set! ct (+ -1 (string-length ct)) #\:) + (cons ct args))) + (else args))) (newline cep)) (define build:qacs #f) +;@ (define (build:serve request-line query-string header) (define query-alist (and query-string (uri:decode-query query-string))) (if (not build:qacs) @@ -1891,7 +2126,7 @@ (define build:initializer (lambda (rdb) - (set! build:c-libraries ((rdb 'open-table) 'c-libraries #f)) + (set! build:c-libraries (open-table rdb 'c-libraries)) (set! build:lib-cc-flag (make-defaulting-platform-lookup (build:c-libraries 'get 'compiler-flags))) @@ -1904,11 +2139,11 @@ (set! build:c-suppress (make-defaulting-platform-lookup (build:c-libraries 'get 'suppress-files))) - (set! platform->os (((rdb 'open-table) 'platform #f) + (set! platform->os ((open-table rdb 'platform) 'get 'operating-system)) (set! plan-command (let ((lookup (make-defaulting-platform-lookup - (((rdb 'open-table) 'compile-commands #f) + ((open-table rdb 'compile-commands) 'get 'procedure)))) (lambda (thing plat) ;;(print 'thing thing 'plat plat) @@ -0,0 +1,285 @@ +/* Copyright (C) 2003 Free Software Foundation, Inc. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2, or (at your option) + * any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this software; see the file COPYING. If not, write to + * the Free Software Foundation, 59 Temple Place, Suite 330, Boston, MA 02111, USA. + * + * As a special exception, the Free Software Foundation gives permission + * for additional uses of the text contained in its release of SCM. + * + * The exception is that, if you link the SCM library with other files + * to produce an executable, this does not by itself cause the + * resulting executable to be covered by the GNU General Public License. + * Your use of that executable is in no way restricted on account of + * linking the SCM library code into it. + * + * This exception does not however invalidate any other reasons why + * the executable file might be covered by the GNU General Public License. + * + * This exception applies only to the code released by the + * Free Software Foundation under the name SCM. If you copy + * code from other Free Software Foundation releases into a copy of + * SCM, as the General Public License permits, the exception does + * not apply to the code that you add in this way. To avoid misleading + * anyone as to the status of such modified files, you must delete + * this exception notice from them. + * + * If you write modifications of your own for SCM, it is your choice + * whether to permit this exception to apply to your modifications. + * If you do not wish that, delete this exception notice. + */ + +/* "byte.c" Strings as Bytes + Author: Aubrey Jaffer */ + +#include "scm.h" + +char s_make_bytes[] = "make-bytes"; +SCM scm_make_bytes(k, n) + SCM k, n; +{ + SCM res; + register unsigned char *dst; + register long i; + ASRTER(INUMP(k) && (k >= 0), k, ARG1, s_make_bytes); + i = INUM(k); + res = makstr(i); + dst = UCHARS(res); + if (!UNBNDP(n)) { + ASRTER(INUMP(n) && 0 <= n && n <= MAKINUM(255), n, ARG2, s_make_bytes); + for(i--;i >= 0;i--) dst[i] = INUM(n); + } + return res; +} +#define s_bytes (s_make_bytes+5) +SCM scm_bytes(ints) + SCM ints; +{ + SCM res; + register unsigned char *data; + long i = ilength(ints); + ASRTER(i >= 0, ints, ARG1, s_bytes); + res = makstr(i); + data = UCHARS(res); + for(;NNULLP(ints);ints = CDR(ints)) { + int n = INUM(CAR(ints)); + ASRTER(INUMP(CAR(ints)) && 0 <= n && n <= 255, ints, ARG1, s_bytes); + *data++ = n; + } + return res; +} +static char s_bt_ref[] = "byte-ref"; +SCM scm_byte_ref(str, k) + SCM str, k; +{ + ASRTER(NIMP(str) && STRINGP(str), str, ARG1, s_bt_ref); + ASRTER(INUMP(k), k, ARG2, s_bt_ref); + ASRTER(0 <= INUM(k) && INUM(k) < LENGTH(str), k, OUTOFRANGE, s_bt_ref); + return MAKINUM(UCHARS(str)[INUM(k)]); +} +static char s_bt_set[] = "byte-set!"; +SCM scm_byte_set(str, k, n) + SCM str, k, n; +{ + ASRTER(NIMP(str) && STRINGP(str), str, ARG1, s_bt_set); + ASRTER(INUMP(k), k, ARG2, s_bt_set); + ASRTER(INUMP(n), n, ARG3, s_bt_set); + ASRTER(0 <= INUM(k) && INUM(k) < LENGTH(str), k, OUTOFRANGE, s_bt_set); + UCHARS(str)[INUM(k)] = INUM(n); + return UNSPECIFIED; +} +static char s_bytes2list[] = "bytes->list"; +SCM scm_bytes2list(str) + SCM str; +{ + long i; + SCM res = EOL; + unsigned char *src; + ASRTER(NIMP(str) && STRINGP(str), str, ARG1, s_bytes2list); + src = UCHARS(str); + for(i = LENGTH(str)-1;i >= 0;i--) res = cons((SCM)MAKINUM(src[i]), res); + return res; +} +static char s_bt_reverse[] = "bytes-reverse!"; +SCM scm_bytes_reverse(str) + SCM str; +{ + register char *dst; + register long k, len; + ASRTER(NIMP(str) && STRINGP(str), str, ARG1, s_bt_reverse); + len = LENGTH(str); + dst = CHARS(str); + for(k = len/2;k >= 0;k--) { + int tmp = dst[k]; + dst[k] = dst[len - k - 1]; + dst[len - k - 1] = tmp; + } + return str; +} +static char s_write_byte[] = "write-byte"; +SCM scm_write_byte(chr, port) + SCM chr, port; +{ + int k = INUM(chr); + 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); + return UNSPECIFIED; +} +static char s_read_byte[] = "read-byte"; +SCM scm_read_byte(port) + SCM port; +{ + int c; + 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; + return MAKINUM(c); +} + +static char s_sub_rd[] = "substring-read!"; +SCM scm_substring_read(sstr, start, args) + SCM sstr, start, args; +{ + SCM end, port; + long len; + long alen = ilength(args); + ASRTER(1 <= alen && alen <= 2, args, WNA, s_sub_rd); + end = CAR(args); + port = (2==alen) ? CAR(CDR(args)) : cur_inp; + ASRTER(NIMP(sstr) && STRINGP(sstr), sstr, ARG1, s_sub_rd); + ASRTER(INUMP(start), start, ARG2, s_sub_rd); + ASRTER(INUMP(end), end, ARG3, s_sub_rd); + ASRTER(NIMP(port) && OPINFPORTP(port), port, ARG4, s_sub_rd); + len = LENGTH(sstr); + start = INUM(start); + end = INUM(end); + ASRTER(0 <= start && start <= len, MAKINUM(start), OUTOFRANGE, s_sub_rd); + ASRTER(0 <= end && end <= len, MAKINUM(end), OUTOFRANGE, s_sub_rd); + if (start==end) return INUM0; + if (start < end) { + 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) { + CHARS(sstr)[start] = lgetc(port); + start += 1; + len -= 1; + ans = 1; + } + SYSCALL(ans += fread(CHARS(sstr)+start, + (sizet)1, + (sizet)(end - start), + STREAM(port));); + return MAKINUM(ans); + } + else { + long idx = start; + while (end <= idx) { + int chr = lgetc(port); + if (EOF==chr) return MAKINUM(start - idx); + CHARS(sstr)[--idx] = chr; + } + return MAKINUM(start - end); + } +} + +static char s_sub_wr[] = "substring-write"; +SCM scm_substring_write(sstr, start, args) + SCM sstr, start, args; +{ + SCM end, port; + long len; + long alen = ilength(args); + ASRTER(1 <= alen && alen <= 2, args, WNA, s_sub_wr); + end = CAR(args); + port = (2==alen) ? CAR(CDR(args)) : cur_outp; + ASRTER(NIMP(sstr) && STRINGP(sstr), sstr, ARG1, s_sub_wr); + ASRTER(INUMP(start), start, ARG2, s_sub_wr); + ASRTER(INUMP(end), end, ARG3, s_sub_wr); + ASRTER(NIMP(port) && OPOUTFPORTP(port), port, ARG4, s_sub_wr); + len = LENGTH(sstr); + start = INUM(start); + end = INUM(end); + ASRTER(0 <= start && start <= len, MAKINUM(start), OUTOFRANGE, s_sub_wr); + ASRTER(0 <= end && end <= len, MAKINUM(end), OUTOFRANGE, s_sub_wr); + if (start==end) return INUM0; + if (start < end) { + long ans; + SYSCALL(ans = lfwrite(CHARS(sstr)+start, + (sizet)1, + (sizet)(sizet)(end - start), + port);); + return MAKINUM(ans); + } + else { + long idx = start; + while (end <= --idx) { + if (feof(STREAM(port))) return MAKINUM(start - idx - 1); + lputc(CHARS(sstr)[idx], port); + } + return MAKINUM(start - end); + } +} + +static iproc subr1s[] = { + {"list->bytes", scm_bytes}, + {s_bytes2list, scm_bytes2list}, + {s_bt_reverse, scm_bytes_reverse}, + {0, 0}}; + +static iproc subr2os[] = { + {s_write_byte, scm_write_byte}, + {s_make_bytes, scm_make_bytes}, + {0, 0}}; + +static iproc lsubr2s[] = { + {s_sub_rd, scm_substring_read}, + {s_sub_wr, scm_substring_write}, + {0, 0}}; + + +void init_byte() +{ + init_iprocs(subr1s, tc7_subr_1); + init_iprocs(subr2os, tc7_subr_2o); + init_iprocs(lsubr2s, tc7_lsubr_2); + make_subr(s_bytes, tc7_lsubr, scm_bytes); + make_subr(s_read_byte, tc7_subr_1o, scm_read_byte); + make_subr(s_bt_ref, tc7_subr_2, scm_byte_ref); + make_subr(s_bt_set, tc7_subr_3, scm_byte_set); + add_feature("byte"); + scm_ldstr("\n\ +(define bytes-length string-length)\n\ +(define bytes-copy string-copy)\n\ +(define (bytes-reverse bytes)\n\ + (bytes-reverse! (bytes-copy bytes)))\n\ +(define (read-bytes n . port)\n\ + (let* ((len (abs n))\n\ + (byts (make-bytes len))\n\ + (cnt (if (positive? n)\n\ + (apply substring-read! byts 0 n port)\n\ + (apply substring-read! byts (- n) 0 port))))\n\ + (if (= cnt len)\n\ + byts\n\ + (if (positive? n)\n\ + (substring byts 0 cnt)\n\ + (substring byts (- len cnt) len)))))\n\ +(define (write-bytes bytes n . port)\n\ + (if (positive? n)\n\ + (apply substring-write bytes 0 n port)\n\ + (apply substring-write bytes (- n) 0 port)))\n\ +"); +} diff --git a/compile.scm b/compile.scm index ce96822..1242231 100755 --- a/compile.scm +++ b/compile.scm @@ -44,13 +44,18 @@ ;;;; "compile.scm", Compile C ==> Scheme ==> object-file. ;;; Author: Aubrey Jaffer. -(define (go-script) - (cond ((not *script*)) - ((and (<= 1 (- (length *argv*) *optind*)) - (not (eqv? #\- (string-ref (car (list-tail *argv* *optind*)) 0)))) - (apply compile-file (list-tail *argv* *optind*))) - (else - (display "\ +(require-if 'compiling 'hobbit) +(require-if 'compiling 'glob) +(require-if 'compiling 'build) + +(define (compile.scm args) + (cond ((and (<= 1 (length args)) + (not (eqv? #\- (string-ref (car args) 0)))) + (apply compile-file args)) + (else (compile.usage)))) + +(define (compile.usage) + (display "\ \ Usage: compile.scm FILE1.scm FILE2.scm ... \ @@ -58,9 +63,11 @@ Usage: compile.scm FILE1.scm FILE2.scm ... FILE1<object-suffix>, where <object-suffix> is the object file suffix for your computer (for instance, `.o'). FILE1.scm must be in the current directory; FILE2.scm ... can be in other directories. + +http://swissnet.ai.mit.edu/~jaffer/SCM " - (current-error-port)) - (exit #f)))) + (current-error-port)) + #f) ;;; This unusual autoload loads either the ;;; source or compiled version if present. @@ -69,44 +76,53 @@ Usage: compile.scm FILE1.scm FILE2.scm ... (require 'hobbit) (apply hobbit args))) +(define (find-option-file file) + (let ((opt file)) + (if (file-exists? opt) + (list "-f" opt) + '()))) +;@ (define (compile-file file . args) + (define sfs (scheme-file-suffix)) (require 'glob) (apply hobbit file args) (let ((command - (list "build" - "-hsystem" - "-tdll" - (string-append "--compiler-options=-I" (implementation-vicinity)) - "-c" (replace-suffix file (scheme-file-suffix) ".c")))) + (apply list + "build" + "-hsystem" + "-tdll" + (string-append "--compiler-options=-I" (implementation-vicinity)) + "-c" (replace-suffix file sfs ".c") + (find-option-file (replace-suffix file sfs ".opt"))))) (require 'build) (cond ((>= (verbose) 3) (write command) (newline))) (build-from-whole-argv command))) - -(define (compile->executable name . args) +;@ +(define (compile->executable exename . files) (define sfs (scheme-file-suffix)) (require 'glob) - (for-each hobbit args) + (for-each hobbit files) (let ((inits (map (lambda (file) (string-append "-iinit_" (replace-suffix file sfs ""))) - args)) + files)) (files (map (lambda (file) (string-append "-c" (replace-suffix file sfs ".c"))) - args))) + files))) (define command (append (list "build" "-hsystem" "--type=exe" - "-o" name + "-o" exename "-F" "compiled-closure" "inexact" (string-append "--linker-options=-L" (implementation-vicinity))) + (find-option-file (string-append exename ".opt")) files inits)) (require 'build) (cond ((>= (verbose) 3) (write command) (newline))) (build-from-whole-argv command))) -(go-script) - ;;; Local Variables: ;;; mode:scheme ;;; End: +(and *script* (exit (compile.scm (list-tail *argv* *optind*)))) @@ -98,7 +98,10 @@ # endif #endif #ifdef MSDOS -# define SHORT_ALIGN +# ifndef _M_ARM +/* arm processors need DWORD aligned data access */ +# define SHORT_ALIGN +# endif #endif #ifdef atarist # define SHORT_ALIGN @@ -47,7 +47,11 @@ #ifdef __FreeBSD__ # include <ncurses.h> #else -# include <curses.h> +# ifdef __NetBSD__ +# include <ncurses.h> +# else +# include <curses.h> +# endif #endif #ifdef MWC @@ -128,13 +132,13 @@ SCM lnewwin(lines, cols, args) { SCM begin_y, begin_x; WINDOW *win; - ASSERT(INUMP(lines), lines, ARG1, s_newwin); - ASSERT(INUMP(cols), cols, ARG2, s_newwin); - ASSERT(2==ilength(args), args, WNA, s_newwin); + ASRTER(INUMP(lines), lines, ARG1, s_newwin); + ASRTER(INUMP(cols), cols, ARG2, s_newwin); + ASRTER(2==ilength(args), args, WNA, s_newwin); begin_y = CAR(args); begin_x = CAR(CDR(args)); - ASSERT(INUMP(begin_y), begin_y, ARG3, s_newwin); - ASSERT(INUMP(begin_x), begin_y, ARG4, s_newwin); + ASRTER(INUMP(begin_y), begin_y, ARG3, s_newwin); + ASRTER(INUMP(begin_x), begin_y, ARG4, s_newwin); win = newwin(INUM(lines), INUM(cols), INUM(begin_y), INUM(begin_x)); return mkwindow(win); @@ -143,9 +147,9 @@ SCM lnewwin(lines, cols, args) SCM lmvwin(win, y, x) SCM win, y, x; { - ASSERT(NIMP(win) && WINP(win), win, ARG1, s_mvwin); - ASSERT(INUMP(x), x, ARG2, s_mvwin); - ASSERT(INUMP(y), y, ARG3, s_mvwin); + ASRTER(NIMP(win) && WINP(win), win, ARG1, s_mvwin); + ASRTER(INUMP(x), x, ARG2, s_mvwin); + ASRTER(INUMP(y), y, ARG3, s_mvwin); return ERR==mvwin(WIN(win), INUM(y), INUM(x)) ? BOOL_F : BOOL_T; } @@ -154,16 +158,16 @@ SCM lsubwin(win, lines, args) { SCM cols, begin_y, begin_x; WINDOW *nwin; - ASSERT(NIMP(win) && WINP(win), win, ARG1, s_subwin); - ASSERT(INUMP(lines), lines, ARG2, s_subwin); - ASSERT(3==ilength(args), args, WNA, s_subwin); + ASRTER(NIMP(win) && WINP(win), win, ARG1, s_subwin); + ASRTER(INUMP(lines), lines, ARG2, s_subwin); + ASRTER(3==ilength(args), args, WNA, s_subwin); cols = CAR(args); args = CDR(args); begin_y = CAR(args); begin_x = CAR(CDR(args)); - ASSERT(INUMP(cols), cols, ARG3, s_subwin); - ASSERT(INUMP(begin_y), begin_y, ARG3, s_subwin); - ASSERT(INUMP(begin_x), begin_y, ARG4, s_subwin); + ASRTER(INUMP(cols), cols, ARG3, s_subwin); + ASRTER(INUMP(begin_y), begin_y, ARG3, s_subwin); + ASRTER(INUMP(begin_x), begin_y, ARG4, s_subwin); nwin = subwin(WIN(win), INUM(lines), INUM(cols), INUM(begin_y), INUM(begin_x)); return mkwindow(nwin); @@ -172,16 +176,16 @@ SCM lsubwin(win, lines, args) SCM loverlay(srcwin, dstwin) SCM srcwin, dstwin; { - ASSERT(NIMP(srcwin) && WINP(srcwin), srcwin, ARG1, s_overlay); - ASSERT(NIMP(dstwin) && WINP(dstwin), dstwin, ARG2, s_overlay); + ASRTER(NIMP(srcwin) && WINP(srcwin), srcwin, ARG1, s_overlay); + ASRTER(NIMP(dstwin) && WINP(dstwin), dstwin, ARG2, s_overlay); return ERR==overlay(WIN(srcwin), WIN(dstwin)) ? BOOL_F : BOOL_T; } SCM loverwrite(srcwin, dstwin) SCM srcwin, dstwin; { - ASSERT(NIMP(srcwin) && WINP(srcwin), srcwin, ARG1, s_overwrite); - ASSERT(NIMP(dstwin) && WINP(dstwin), dstwin, ARG2, s_overwrite); + ASRTER(NIMP(srcwin) && WINP(srcwin), srcwin, ARG1, s_overwrite); + ASRTER(NIMP(dstwin) && WINP(dstwin), dstwin, ARG2, s_overwrite); return ERR==overwrite(WIN(srcwin), WIN(dstwin)) ? BOOL_F : BOOL_T; } @@ -190,31 +194,31 @@ static char s_wmove[] = "wmove", s_wadd[] = "wadd", s_winsch[] = "winsch", SCM lwmove(win, y, x) SCM win, y, x; { - ASSERT(NIMP(win) && WINP(win), win, ARG1, s_wmove); - ASSERT(INUMP(x), x, ARG2, s_wmove); - ASSERT(INUMP(y), y, ARG3, s_wmove); + ASRTER(NIMP(win) && WINP(win), win, ARG1, s_wmove); + ASRTER(INUMP(x), x, ARG2, s_wmove); + ASRTER(INUMP(y), y, ARG3, s_wmove); return ERR==wmove(WIN(win), INUM(y), INUM(x)) ? BOOL_F : BOOL_T; } SCM lwadd(win, obj) SCM win, obj; { - ASSERT(NIMP(win) && WINP(win), win, ARG1, s_wadd); + ASRTER(NIMP(win) && WINP(win), win, ARG1, s_wadd); if ICHRP(obj) return ERR==waddch(WIN(win), ICHR(obj)) ? BOOL_F : BOOL_T; if INUMP(obj) return ERR==waddch(WIN(win), INUM(obj)) ? BOOL_F : BOOL_T; - ASSERT(NIMP(obj) && STRINGP(obj), obj, ARG2, s_wadd); + ASRTER(NIMP(obj) && STRINGP(obj), obj, ARG2, s_wadd); return ERR==waddstr(WIN(win), CHARS(obj)) ? BOOL_F : BOOL_T; } SCM lwinsch(win, obj) SCM win, obj; { - ASSERT(NIMP(win) && WINP(win), win, ARG1, s_winsch); + ASRTER(NIMP(win) && WINP(win), win, ARG1, s_winsch); if INUMP(obj) return ERR==winsch(WIN(win), INUM(obj)) ? BOOL_F : BOOL_T; - ASSERT(ICHRP(obj), obj, ARG2, s_winsch); + ASRTER(ICHRP(obj), obj, ARG2, s_winsch); return ERR==winsch(WIN(win), ICHR(obj)) ? BOOL_F : BOOL_T; } @@ -222,15 +226,15 @@ SCM lbox(win, vertch, horch) SCM win, vertch, horch; { int v, h; - ASSERT(NIMP(win) && WINP(win), win, ARG1, s_box); + ASRTER(NIMP(win) && WINP(win), win, ARG1, s_box); if INUMP(vertch) v = INUM(vertch); else { - ASSERT(ICHRP(vertch), vertch, ARG2, s_box); + ASRTER(ICHRP(vertch), vertch, ARG2, s_box); v = ICHR(vertch); } if INUMP(horch) h = INUM(horch); else { - ASSERT(ICHRP(horch), horch, ARG3, s_box); + ASRTER(ICHRP(horch), horch, ARG3, s_box); h = ICHR(horch); } return ERR==box(WIN(win), v, h) ? BOOL_F : BOOL_T; @@ -241,7 +245,7 @@ SCM lgetyx(win) SCM win; { int y, x; - ASSERT(NIMP(win) && WINP(win), win, ARG1, s_getyx); + ASRTER(NIMP(win) && WINP(win), win, ARG1, s_getyx); getyx(WIN(win), y, x); return cons2(MAKINUM(y), MAKINUM(x), EOL); } @@ -249,14 +253,14 @@ SCM lgetyx(win) SCM lwinch(win) SCM win; { - ASSERT(NIMP(win) && WINP(win), win, ARG1, s_winch); + ASRTER(NIMP(win) && WINP(win), win, ARG1, s_winch); return MAKICHR(winch(WIN(win))); } SCM lunctrl(c) SCM c; { - ASSERT(ICHRP(c), c, ARG1, s_unctrl); + ASRTER(ICHRP(c), c, ARG1, s_unctrl); { char *str = unctrl(ICHR(c)); return makfrom0str(str); @@ -268,7 +272,7 @@ SCM owidth(arg) SCM arg; { if UNBNDP(arg) arg = cur_outp; - ASSERT(NIMP(arg) && OPOUTPORTP(arg), arg, ARG1, s_owidth); + ASRTER(NIMP(arg) && OPOUTPORTP(arg), arg, ARG1, s_owidth); if NIMP(*loc_stdscr) if WINP(arg) return MAKINUM(WIN(arg)->_maxx+1); else return MAKINUM(COLS); @@ -278,7 +282,7 @@ SCM oheight(arg) SCM arg; { if UNBNDP(arg) arg = cur_outp; - ASSERT(NIMP(arg) && OPOUTPORTP(arg), arg, ARG1, s_owidth); + ASRTER(NIMP(arg) && OPOUTPORTP(arg), arg, ARG1, s_owidth); if NIMP(*loc_stdscr) if WINP(arg) return MAKINUM(WIN(arg)->_maxy+1); else return MAKINUM(LINES); @@ -322,7 +326,7 @@ static iproc subr0s[] = { #define SUBRW(ln, n, s_n, sn) static char s_n[]=sn;\ SCM ln(w)SCM w;\ - {ASSERT(NIMP(w) && WINP(w), w, ARG1, sn);\ + {ASRTER(NIMP(w) && WINP(w), w, ARG1, sn);\ return ERR==n(WIN(w))?BOOL_F:BOOL_T;} SUBRW(lwerase, werase, s_werase, "werase") @@ -356,7 +360,7 @@ static iproc subr1s[] = { #define SUBROPT(ln, n, s_n, sn) static char s_n[]=sn;\ SCM ln(w, b)SCM w, b;\ - {ASSERT(NIMP(w) && WINP(w), w, ARG1, sn);\ + {ASRTER(NIMP(w) && WINP(w), w, ARG1, sn);\ return ERR==n(WIN(w), BOOL_F != b)?BOOL_F:BOOL_T;} SUBROPT(lidlok, idlok, s_idlok, "idlok") @@ -369,7 +373,7 @@ static char s_clearok[] = "clearok"; SCM lclearok(w, b) SCM w, b; { if (BOOL_T==w) return ERR==clearok(curscr, BOOL_F != b)?BOOL_F:BOOL_T; - ASSERT(NIMP(w) && WINP(w), w, ARG1, s_clearok); + ASRTER(NIMP(w) && WINP(w), w, ARG1, s_clearok); return ERR==clearok(WIN(w), BOOL_F != b)?BOOL_F:BOOL_T; } diff --git a/debian/changelog b/debian/changelog index e25b173..179bb8b 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,8 +1,42 @@ -scm (5d6-3.2) unstable; urgency=low +scm (5d9-4.1) unstable; urgency=high - * Fix hppa compile. Closes: #144062 + * Non-maintainer upload. + * High-urgency upload for sarge-targetted RC bugfix. + * Revert upstream "CAUTIOUS" define, which causes the scm build to + fail its test suite on alpha (and, it appears, powerpc as well). + Closes: #245810. - -- LaMont Jones <lamont@debian.org> Wed, 7 May 2003 08:36:40 -0600 + -- Steve Langasek <vorlon@debian.org> Tue, 7 Dec 2004 23:23:48 -0800 + +scm (5d9-4) unstable; urgency=low + + * Apply patch from 144062 to fix hppa build (Closes: #144062) + * Change scm.1 section from Jan 4 200 to 1. (lintian) + + -- James LewisMoss <dres@debian.org> Thu, 6 May 2004 14:24:32 -0400 + +scm (5d9-3) unstable; urgency=low + + * Properly clean up info files. + * Make and install Xlibscm.info. + + -- James LewisMoss <dres@debian.org> Sat, 3 Apr 2004 15:44:38 -0500 + +scm (5d9-2) unstable; urgency=low + + * Fix path problem in slibcat. Hack at mklibcat.scm. (Closes: #241510) + + -- James LewisMoss <dres@debian.org> Sat, 3 Apr 2004 15:35:52 -0500 + +scm (5d9-1) unstable; urgency=low + + * New upstream release + * Merge NMU sparc changes (Closes: #191171, #191356) + * SHORT_INT is defined for ia64 upstream (Closes: #141928) + * Scheme imps now grouped in info file (has been for a while) + (Closes: #115452) + + -- James LewisMoss <dres@debian.org> Sun, 14 Mar 2004 11:44:51 -0500 scm (5d6-3.1) unstable; urgency=low @@ -52,7 +86,7 @@ scm (5d4-3) unstable; urgency=low * Don't link with regexx, but just use libc6's regular expression functions. * Define (terms) to output /usr/share/common-licenses/GPL (Closes: - #119321) + #119321) -- James LewisMoss <dres@debian.org> Wed, 12 Dec 2001 16:27:02 -0500 @@ -193,7 +227,7 @@ scm (5c3-4) frozen unstable; urgency=low scm (5c3-3) frozen unstable; urgency=low * -nw - * Fixes #16762. + * Fixes #16762. * Fixes #18163. * Fixes #18164. * Fixes #23743. @@ -235,4 +269,3 @@ scm (4e6-1) unstable; urgency=low * Makefile.in: scm compiles with regex. -- Karl Sackett <krs@debian.org> Fri, 13 Dec 1996 08:55:23 -0600 - diff --git a/debian/control b/debian/control index 533edb2..42b1b1d 100644 --- a/debian/control +++ b/debian/control @@ -3,14 +3,13 @@ Section: interpreters Priority: optional Maintainer: James LewisMoss <dres@debian.org> Standards-Version: 3.1.1 -Build-Depends: slib, libncurses5-dev, libreadline4-dev, texi2html, texinfo, xlibs-dev +Build-Depends: slib (>> 3a1), libncurses5-dev, libreadline4-dev, texi2html, texinfo, xlibs-dev Package: scm Architecture: any Section: interpreters Priority: optional Depends: slib, ${shlibs:Depends} -Description: A Scheme language interpreter. +Description: A Scheme language interpreter Scm conforms to Revised^5 Report on the Algorithmic Language Scheme and the IEEE P1178 specification. - diff --git a/debian/copyright b/debian/copyright index 419226e..a9a786e 100644 --- a/debian/copyright +++ b/debian/copyright @@ -4,11 +4,11 @@ This package was put together by Karl Sackett <krs@debian.org>, and upgraded by James LewisMoss <dres@debian.org> from sources obtained from: - ftp://swiss-ftp.ai.mit.edu/archive/scm/scm5d0.tar.gz + ftp://swissnet.ai.mit.edu/ftpdir/scm/scm5d9.tar.gz For more information see: - http://www-swiss.ai.mit.edu/~jaffer/SCM.html + http://www-swiss.ai.mit.edu/~jaffer/SCM License: diff --git a/debian/doc-base b/debian/doc-base index 59abf3f..1e9e5f3 100644 --- a/debian/doc-base +++ b/debian/doc-base @@ -7,6 +7,13 @@ Section: Apps/Programming Format: info Files: /usr/share/info/scm.info +Format: info +Files: /usr/share/info/Xlibscm.info + Format: HTML Index: /usr/share/doc/scm/scm.html Files: /usr/share/doc/scm/scm.html + +Format: HTML +Index: /usr/share/doc/scm/Xlibscm.html +Files: /usr/share/doc/scm/Xlibscm.html diff --git a/debian/postinst b/debian/postinst index c762db4..e188be8 100644 --- a/debian/postinst +++ b/debian/postinst @@ -6,11 +6,10 @@ install-info --quiet --section "The Algorithmic Language Scheme" \ --description="A Scheme language interpreter" \ /usr/share/info/scm.info.gz -if [ "$1" = "configure" ]; then - if [ -d /usr/doc -a ! -e /usr/doc/scm -a -d /usr/share/doc/scm ]; then - ln -sf ../share/doc/scm /usr/doc/scm - fi -fi +install-info --quiet --section "The Algorithmic Language Scheme" \ + "The Algorithmic Language Scheme" \ + --description="SCM Language X Interface" \ + /usr/share/info/Xlibscm.info.gz # doc base support if [ "$1" = configure ]; then diff --git a/debian/rules b/debian/rules index da0e302..9ed76c6 100755 --- a/debian/rules +++ b/debian/rules @@ -48,6 +48,8 @@ SCM_OPTIONS = -p linux \ # -F heap-can-shrink \ +#SCHEME_LIBRARY_PATH=../slib-3a1/ +#export SCHEME_LIBRARY_PATH NON_LIB_FILES = 'bench.scm|build.scm|example.scm|r4rstest.scm|pi.scm|grtest.scm' #test: stamp-configure @@ -70,14 +72,17 @@ endif chmod ug+x debian/bld debian/bld make scm.info + make Xlibscm.info texi2html -monolithic scm.texi + texi2html -monolithic Xlibscm.texi touch build-stamp clean: $(checkdir) -rm -f scm.info* scm.html tmp1 tmp2 scmflags.h scmlit + -rm -f Xlibscm.info* -rm -f features.txi platform.txi - -rm -f scm5d0.info + -rm -f *.info -rm require.scm scm make distclean -rm -f srcdir.mk @@ -89,7 +94,7 @@ binary-indep: checkroot $(checkdir) binary-arch: checkroot build - $(checkdir) + $(checkdir) -rm -rf debian/tmp* # debian/tmp @@ -114,7 +119,7 @@ binary-arch: checkroot build # man pages $(INSTALL_DIR) debian/tmp/usr/share/man/man1 $(INSTALL_MAN) scm.1 debian/tmp/usr/share/man/man1 - gzip -9vr debian/tmp/usr/share/man + gzip -9vr debian/tmp/usr/share/man || true # documentation $(INSTALL_DIR) debian/tmp/usr/share/doc/scm @@ -124,6 +129,7 @@ binary-arch: checkroot build $(INSTALL_DATA) README debian/tmp/usr/share/doc/scm gzip -9v debian/tmp/usr/share/doc/scm/* $(INSTALL_DATA) scm.html debian/tmp/usr/share/doc/scm + $(INSTALL_DATA) Xlibscm.html debian/tmp/usr/share/doc/scm $(INSTALL_DATA) debian/copyright debian/tmp/usr/share/doc/scm $(INSTALL_DIR) debian/tmp/usr/share/doc-base @@ -142,6 +148,7 @@ binary-arch: checkroot build # info pages $(INSTALL_DIR) debian/tmp/usr/share/info $(INSTALL_DATA) scm.info* debian/tmp/usr/share/info + $(INSTALL_DATA) Xlibscm.info* debian/tmp/usr/share/info gzip -9 debian/tmp/usr/share/info/* dpkg-shlibdeps scm @@ -82,7 +82,7 @@ SCM scm_env_rlookup(addr, stenv, what) for (env = stenv; NIMP(env); env = CDR(env)) { fr = CAR(env); if (INUMP(fr)) { - ASSERT(NIMP(env) && CONSP(env), stenv, s_badenv, what); + ASRTER(NIMP(env) && CONSP(env), stenv, s_badenv, what); env = CDR(env); continue; } @@ -122,7 +122,7 @@ SCM scm_env_getprop(prop, env) if (INUMP(CAR(e))) { if (CAR(e)==prop) return CDR(e); e = CDR(e); - ASSERT(NIMP(e), env, s_badenv, "env_getprop"); + ASRTER(NIMP(e), env, s_badenv, "env_getprop"); } e = CDR(e); } @@ -348,7 +348,7 @@ SCM scm_int2linum(n) SCM n; { int i = INUM(n); - ASSERT(INUMP(n) && i >= 0, n, ARG1, s_int2linum); + ASRTER(INUMP(n) && i >= 0, n, ARG1, s_int2linum); return SCM_MAKE_LINUM(i); } @@ -356,7 +356,7 @@ static char s_linum2int[] = "line-number->integer"; SCM scm_linum2int(linum) SCM linum; { - ASSERT(SCM_LINUMP(linum), linum, ARG1, s_linum2int); + ASRTER(SCM_LINUMP(linum), linum, ARG1, s_linum2int); return MAKINUM(SCM_LINUM(linum)); } @@ -490,7 +490,7 @@ SCM scm_stack_trace(contin) } else { CONTINUATION *cont; - ASSERT(NIMP(contin) && (tc7_contin==TYP7(contin)), contin, ARG1, + ASRTER(NIMP(contin) && (tc7_contin==TYP7(contin)), contin, ARG1, s_stack_trace); cont = CONT(contin); estk = cont->other.estk; @@ -504,9 +504,9 @@ SCM scm_frame_trace(contin, nf) SCM contin, nf; { SCM *stkframe, code, env; - ASSERT(NIMP(contin) && tc7_contin==TYP7(contin), contin, ARG1, + ASRTER(NIMP(contin) && tc7_contin==TYP7(contin), contin, ARG1, s_frame_trace); - ASSERT(INUMP(nf) && INUM(nf) >= 0, nf, ARG2, s_frame_trace); + ASRTER(INUMP(nf) && INUM(nf) >= 0, nf, ARG2, s_frame_trace); if (!(stkframe = cont_frame(contin, INUM(nf)))) return BOOL_F; env = stkframe[2]; @@ -521,9 +521,9 @@ SCM scm_frame2env(contin, nf) SCM contin, nf; { SCM *stkframe; - ASSERT(NIMP(contin) && tc7_contin==TYP7(contin), contin, ARG1, + ASRTER(NIMP(contin) && tc7_contin==TYP7(contin), contin, ARG1, s_frame2env); - ASSERT(INUMP(nf) && INUM(nf) >= 0, nf, ARG2, s_frame2env); + ASRTER(INUMP(nf) && INUM(nf) >= 0, nf, ARG2, s_frame2env); if (!(stkframe = cont_frame(contin, INUM(nf)))) return BOOL_F; return stkframe[2]; @@ -534,9 +534,9 @@ SCM scm_frame_eval(contin, nf, expr) SCM contin, nf, expr; { SCM res, env, *stkframe; - ASSERT(NIMP(contin) && tc7_contin==TYP7(contin), contin, ARG1, + ASRTER(NIMP(contin) && tc7_contin==TYP7(contin), contin, ARG1, s_frame_eval); - ASSERT(INUMP(nf) && INUM(nf) >= 0, nf, ARG2, s_frame_eval); + ASRTER(INUMP(nf) && INUM(nf) >= 0, nf, ARG2, s_frame_eval); if (!(stkframe = cont_frame(contin, INUM(nf)))) return BOOL_F; env = stkframe[2]; @@ -73,7 +73,7 @@ SCM l_dyn_link(fname) SCM fname; { int status; - ASSERT(NIMP(fname) && STRINGP(fname), fname, ARG1, s_link); + ASRTER(NIMP(fname) && STRINGP(fname), fname, ARG1, s_link); DEFER_INTS; status = dld_link(CHARS(fname)); ALLOW_INTS; @@ -89,7 +89,7 @@ SCM l_dyn_call(symb, shl) int i; void (*func)() = 0; /* SCM oloadpath = *loc_loadpath; */ - ASSERT(NIMP(symb) && STRINGP(symb), symb, ARG1, s_call); + ASRTER(NIMP(symb) && STRINGP(symb), symb, ARG1, s_call); DEFER_INTS; if ((i = dld_function_executable_p(CHARS(symb)))) func = (void (*) ()) dld_get_func(CHARS(symb)); @@ -113,7 +113,7 @@ SCM l_dyn_main_call(symb, shl, args) int (*func)(int argc, char **argv) = 0; char **argv; /* SCM oloadpath = *loc_loadpath; */ - ASSERT(NIMP(symb) && STRINGP(symb), symb, ARG1, s_main_call); + 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)))) @@ -141,7 +141,7 @@ SCM l_dyn_unlink(fname) SCM fname; { int status; - ASSERT(NIMP(fname) && STRINGP(fname), fname, ARG1, s_unlink); + ASRTER(NIMP(fname) && STRINGP(fname), fname, ARG1, s_unlink); DEFER_INTS; status = dld_unlink_by_file(CHARS(fname), 1); ALLOW_INTS; @@ -194,7 +194,7 @@ SCM l_dyn_link(fname) { SCM z; shl_t shl; - ASSERT(NIMP(fname) && STRINGP(fname), fname, ARG1, s_link); + ASRTER(NIMP(fname) && STRINGP(fname), fname, ARG1, s_link); NEWCELL(z); DEFER_INTS; shl = shl_load(CHARS(fname), BIND_DEFERRED , 0L); @@ -214,8 +214,8 @@ SCM l_dyn_call(symb, shl) void (*func)() = 0; int i; /* SCM oloadpath = *loc_loadpath; */ - ASSERT(NIMP(symb) && STRINGP(symb), symb, ARG1, s_call); - ASSERT(NIMP(shl) && CAR(shl)==tc16_shl, shl, ARG2, s_call); + ASRTER(NIMP(symb) && STRINGP(symb), symb, ARG1, s_call); + ASRTER(NIMP(shl) && CAR(shl)==tc16_shl, shl, ARG2, s_call); DEFER_INTS; if ((i = shl_findsym(P_SHL(shl), CHARS(symb), @@ -238,8 +238,8 @@ SCM l_dyn_main_call(symb, shl, args) int (*func)P((int argc, char **argv)) = 0; char **argv; /* SCM oloadpath = *loc_loadpath; */ - ASSERT(NIMP(symb) && STRINGP(symb), symb, ARG1, s_main_call); - ASSERT(NIMP(shl) && CAR(shl)==tc16_shl, shl, ARG2, s_main_call); + ASRTER(NIMP(symb) && STRINGP(symb), symb, ARG1, s_main_call); + ASRTER(NIMP(shl) && CAR(shl)==tc16_shl, shl, ARG2, s_main_call); DEFER_INTS; if ((i = shl_findsym(P_SHL(shl), CHARS(symb), @@ -263,7 +263,7 @@ SCM l_dyn_unlink(shl) SCM shl; { int status; - ASSERT(NIMP(shl) && CAR(shl)==tc16_shl, shl, ARG1, s_unlink); + ASRTER(NIMP(shl) && CAR(shl)==tc16_shl, shl, ARG1, s_unlink); DEFER_INTS; status = shl_unload(SHL(shl)); ALLOW_INTS; @@ -318,9 +318,9 @@ SCM dynl(dir, symbol, fname) struct dsc$descriptor fnamed, symbold, dird; void (*fcn)(); long retval; - ASSERT(IMP(dir) || STRINGP(dir), dir, ARG1, s_dynl); - ASSERT(NIMP(fname) && STRINGP(fname), fname, ARG2, s_dynl); - ASSERT(NIMP(symbol) && STRINGP(symbol), symbol, ARG3, s_dynl); + ASRTER(IMP(dir) || STRINGP(dir), dir, ARG1, s_dynl); + ASRTER(NIMP(fname) && STRINGP(fname), fname, ARG2, s_dynl); + ASRTER(NIMP(symbol) && STRINGP(symbol), symbol, ARG3, s_dynl); descriptorize(&fnamed, fname); descriptorize(&symbold, symbol); DEFER_INTS; @@ -393,7 +393,7 @@ SCM l_dyn_link(fname) SCM z; void *handle; if FALSEP(fname) return fname; - ASSERT(NIMP(fname) && STRINGP(fname), fname, ARG1, s_link); + ASRTER(NIMP(fname) && STRINGP(fname), fname, ARG1, s_link); NEWCELL(z); DEFER_INTS; handle = dlopen(CHARS(fname), DLOPEN_MODE); @@ -421,8 +421,8 @@ SCM l_dyn_call(symb, shl) { void (*func)() = 0; /* SCM oloadpath = *loc_loadpath; */ - ASSERT(NIMP(symb) && STRINGP(symb), symb, ARG1, s_call); - ASSERT(NIMP(shl) && CAR(shl)==tc16_shl, shl, ARG2, s_call); + ASRTER(NIMP(symb) && STRINGP(symb), symb, ARG1, s_call); + ASRTER(NIMP(shl) && CAR(shl)==tc16_shl, shl, ARG2, s_call); DEFER_INTS; func = dlsym(SHL(shl), CHARS(symb)); if (!func) { @@ -450,8 +450,8 @@ SCM l_dyn_main_call(symb, shl, args) int (*func)P((int argc, char **argv)) = 0; char **argv; /* SCM oloadpath = *loc_loadpath; */ - ASSERT(NIMP(symb) && STRINGP(symb), symb, ARG1, s_main_call); - ASSERT(NIMP(shl) && CAR(shl)==tc16_shl, shl, ARG2, s_main_call); + ASRTER(NIMP(symb) && STRINGP(symb), symb, ARG1, s_main_call); + ASRTER(NIMP(shl) && CAR(shl)==tc16_shl, shl, ARG2, s_main_call); DEFER_INTS; func = dlsym(SHL(shl), CHARS(symb)); if (!func) { @@ -481,7 +481,7 @@ SCM l_dyn_unlink(shl) SCM shl; { int status; - ASSERT(NIMP(shl) && CAR(shl)==tc16_shl, shl, ARG1, s_unlink); + ASRTER(NIMP(shl) && CAR(shl)==tc16_shl, shl, ARG1, s_unlink); DEFER_INTS; status = dlclose(SHL(shl)); SETCHARS(shl, NULL); @@ -549,7 +549,7 @@ SCM l_dyn_link(fname) Str255 errMessage; if FALSEP(fname) return fname; - ASSERT(NIMP(fname) && STRINGP(fname), fname, ARG1, s_link); + ASRTER(NIMP(fname) && STRINGP(fname), fname, ARG1, s_link); NEWCELL(z); DEFER_INTS; strcpy((char *)libName, CHARS(fname)); @@ -577,8 +577,8 @@ SCM l_dyn_call(symb, shl) Str255 symName; /* SCM oloadpath = *loc_loadpath; */ - ASSERT(NIMP(symb) && STRINGP(symb), symb, ARG1, s_call); - ASSERT(NIMP(shl) && CAR(shl)==tc16_shl, shl, ARG2, s_call); + ASRTER(NIMP(symb) && STRINGP(symb), symb, ARG1, s_call); + ASRTER(NIMP(shl) && CAR(shl)==tc16_shl, shl, ARG2, s_call); DEFER_INTS; strcpy((char *)symName, CHARS(symb)); @@ -609,8 +609,8 @@ SCM l_dyn_main_call(symb, shl, args) Str255 symName; /* SCM oloadpath = *loc_loadpath; */ - ASSERT(NIMP(symb) && STRINGP(symb), symb, ARG1, s_main_call); - ASSERT(NIMP(shl) && CAR(shl)==tc16_shl, shl, ARG2, s_main_call); + ASRTER(NIMP(symb) && STRINGP(symb), symb, ARG1, s_main_call); + ASRTER(NIMP(shl) && CAR(shl)==tc16_shl, shl, ARG2, s_main_call); DEFER_INTS; strcpy((char *)symName, CHARS(symb)); c2pstr((char *)symName); @@ -640,7 +640,7 @@ SCM l_dyn_unlink(shl) OSErr status; CFragConnectionID connID; - ASSERT(NIMP(shl) && CAR(shl)==tc16_shl, shl, ARG1, s_unlink); + ASRTER(NIMP(shl) && CAR(shl)==tc16_shl, shl, ARG1, s_unlink); DEFER_INTS; connID = (CFragConnectionID)SHL(shl); status = CloseConnection(&connID); @@ -665,3 +665,106 @@ void init_dynl() } } #endif /* MACOS */ + +#ifdef _WIN32 +# include <windows.h> +# define SHL(obj) ((HINSTANCE)(CDR(obj))) +int prinshl(exp, port, writing) + SCM exp; SCM port; int writing; +{ + lputs("#<shl ", port); + intprint(CDR(exp), 16, port); + lputc('>', port); + return 1; +} + +int tc16_shl; +static smobfuns shlsmob = {mark0, free0, prinshl}; + +static char s_link[] = "dyn:link"; +SCM scm_dyn_link(fname) + SCM fname; +{ + SCM z, shl = BOOL_F; + HINSTANCE hshl; + ASRTER(NIMP(fname) && STRINGP(fname), fname, ARG1, s_link); + NEWCELL(z); + DEFER_INTS; + hshl = LoadLibrary(CHARS(fname)); + if (hshl) { + SETCHARS(z, hshl); + CAR(z) = tc16_shl; + shl = z; + } + ALLOW_INTS; + return shl; +} + +static char s_unlink[] = "dyn:unlink"; +SCM scm_dyn_unlink(shl) + SCM shl; +{ + BOOL status; + ASRTER(NIMP(shl) && CAR(shl)==tc16_shl, shl, ARG1, s_unlink); + DEFER_INTS; + status = FreeLibrary(SHL(shl)); + ALLOW_INTS; + return status ? BOOL_T : BOOL_F; +} + +static char s_call[] = "dyn:call"; +SCM scm_dyn_call(symb, shl) + SCM symb, shl; +{ + FARPROC func; + int i; + ASRTER(NIMP(symb) && STRINGP(symb), symb, ARG1, s_call); + ASRTER(NIMP(shl) && CAR(shl)==tc16_shl, shl, ARG2, s_call); + DEFER_INTS; + func = GetProcAddress(SHL(shl), CHARS(symb)); + ALLOW_INTS; + if (!func) return BOOL_F; + (*func) (); + return BOOL_T; +} + +static char s_main_call[] = "dyn:main-call"; +SCM scm_dyn_main_call(symb, shl, args) + SCM symb, shl, args; +{ + int i; + FARPROC func; + 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; + func = GetProcAddress(SHL(shl), CHARS(symb)); + if (!func) { + ALLOW_INTS; + return BOOL_F; + } + argv = makargvfrmstrs(args, s_main_call); + ALLOW_INTS; + i = (*func) ((int)ilength(args), argv); + DEFER_INTS; + must_free_argv(argv); + ALLOW_INTS; + return MAKINUM(0L+i); +} + +static iproc subr1s[] = { + {s_link, scm_dyn_link}, + {s_unlink, scm_dyn_unlink}, + {0, 0}}; + +void init_dynl() +{ + if (!dumped) { + tc16_shl = newsmob(&shlsmob); + init_iprocs(subr1s, tc7_subr_1); + make_subr(s_call, tc7_subr_2, scm_dyn_call); + make_subr(s_main_call, tc7_lsubr_2, scm_dyn_main_call); + add_feature("win32-dl"); + } +} +#endif @@ -54,7 +54,7 @@ SCM lreadline(prompt) { SCM res; char *s; - ASSERT(NIMP(prompt) && STRINGP(prompt), prompt, ARG1, s_readline); + ASRTER(NIMP(prompt) && STRINGP(prompt), prompt, ARG1, s_readline); s = readline(CHARS(prompt)); if (NULL == s) return EOF_VAL; NEWCELL(res); @@ -68,7 +68,7 @@ static char s_add_history[] = "add-history"; SCM ladd_history(line) SCM line; { - ASSERT(NIMP(line) && STRINGP(line), line, ARG1, s_add_history); + ASRTER(NIMP(line) && STRINGP(line), line, ARG1, s_add_history); add_history(CHARS(line)); return UNSPECIFIED; } @@ -45,8 +45,16 @@ #include "scm.h" #include "setjump.h" -#define I_SYM(x) (CAR((x)-1L)) -#define I_VAL(x) (CDR((x)-1L)) +#ifdef _M_ARM +/* The Microsoft CLARM compiler has a bug in pointer arithmetic. + It doesn't always take into account that data acceses have to be + DWORD aligned. The MS_CLARM_dumy assignment resolves this problem. */ +# define I_SYM(x) (CAR((SCM)(MS_CLARM_dumy = (x)-1L))) +# define I_VAL(x) (CDR((SCM)(MS_CLARM_dumy = (x)-1L))) +#else +# define I_SYM(x) (CAR((x)-1L)) +# define I_VAL(x) (CDR((x)-1L)) +#endif #define ATOMP(x) (5==(5 & (int)CAR(x))) #define EVALCELLCAR(x) (ATOMP(CAR(x))?evalatomcar(x, 0):ceval_1(CAR(x))) #define EVALIMP(x) (ILOCP(x)?*ilookup(x):x) @@ -103,7 +111,7 @@ #endif #define EXTEND_ENV cons -SCM scm_env = EOL, scm_env_tmp = UNSPECIFIED; +SCM scm_env, scm_env_tmp; long tc16_env; /* Type code for environments passed to macro transformers. */ @@ -221,8 +229,7 @@ static void debug_env_save P((char *fnam, int line)); #endif #ifndef RECKLESS -SCM scm_trace = BOOL_F; -SCM scm_trace_env = EOL; +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;} @@ -250,8 +257,8 @@ long tc16_macro; /* Type code for macros */ #define MAC_MACRO 0x8L #define MAC_MMACRO 0x2L #define MAC_IDMACRO 0x6L -/* uncomment this to experiment with inline procedures - #define MAC_INLINE 0x10L */ +/* Uncomment this to experiment with inline procedures: */ +/* #define MAC_INLINE 0x10L */ #ifdef MACRO long tc16_ident; /* synthetic macro identifier */ @@ -272,11 +279,16 @@ long eval_clo_cases[5][4]; /* actual args, required args */ SCM scm_profile(resetp) SCM resetp; { - SCM ev = make_uve(sizeof(eval_cases)/sizeof(long), MAKINUM(-1)); - SCM evo = make_uve(sizeof(eval_cases_other)/sizeof(long), MAKINUM(-1)); + SCM ev = make_uve(sizeof(eval_cases)/sizeof(long), + MAKINUM(-8L*sizeof(long))); + SCM evo = make_uve(sizeof(eval_cases_other)/sizeof(long), + MAKINUM(-8L*sizeof(long))); SCM il = dims2ura(cons2(MAKINUM(10), MAKINUM(10), cons(MAKINUM(2), EOL)), - MAKINUM(-1), EOL); - SCM evc = dims2ura(cons2(MAKINUM(5), MAKINUM(4), EOL), MAKINUM(-1), EOL); + MAKINUM(-8L*sizeof(long)), + EOL); + SCM evc = dims2ura(cons2(MAKINUM(5), MAKINUM(4), EOL), + MAKINUM(-8L*sizeof(long)), + EOL); long *v = (long *)VELTS(ev); int i; for (i = 0; i < sizeof(eval_cases)/sizeof(long); i++) @@ -291,14 +303,14 @@ SCM scm_profile(resetp) for (i = 0; i < sizeof(eval_clo_cases)/sizeof(long); i++) v[i] = ((long *)eval_clo_cases)[i]; if (! UNBNDP(resetp)) { - for (i = 0; i < sizeof(eval_cases)/sizeof(long); i++) - eval_cases[i] = 0; - for (i = 0; i < sizeof(eval_cases_other)/sizeof(long); i++) - eval_cases_other[i] = 0; - for (i = 0; i < sizeof(ilookup_cases)/sizeof(long); i++) - ((long *)ilookup_cases)[i] = 0; - for (i = 0; i < sizeof(eval_clo_cases)/sizeof(long); i++) - ((long *)eval_clo_cases)[i] = 0; + for (i = 0; i < sizeof(eval_cases)/sizeof(long); i++) + eval_cases[i] = 0; + for (i = 0; i < sizeof(eval_cases_other)/sizeof(long); i++) + eval_cases_other[i] = 0; + for (i = 0; i < sizeof(ilookup_cases)/sizeof(long); i++) + ((long *)ilookup_cases)[i] = 0; + for (i = 0; i < sizeof(eval_clo_cases)/sizeof(long); i++) + ((long *)eval_clo_cases)[i] = 0; } return cons2(ev, evo, cons2(il, evc, EOL)); } @@ -540,7 +552,7 @@ static SCM *lookupcar(vloc) #endif else { /* global ref */ #ifdef MACRO - ASSERT(SYMBOLP(addr), var, s_escaped, ""); + ASRTER(SYMBOLP(addr), var, s_escaped, ""); #endif val = sym2vcell(addr); addr = val + tc3_cons_gloc; @@ -549,7 +561,7 @@ static SCM *lookupcar(vloc) ASRTGO(!KEYWORDP(*pv), badkey); #endif } - ASSERT(!UNBNDP(*pv) && undefineds != *pv, var, s_unbnd, ""); + ASRTER(!UNBNDP(*pv) && undefineds != *pv, var, s_unbnd, ""); CAR(vloc) = addr; return pv; } @@ -576,13 +588,13 @@ static SCM scm_lookupval(vloc, memo) } else { /* global ref */ #ifdef MACRO - ASSERT(SYMBOLP(addr), var, s_escaped, ""); + ASRTER(SYMBOLP(addr), var, s_escaped, ""); #endif addr = sym2vcell(addr); val = CDR(addr); addr += tc3_cons_gloc; } - ASSERT(!UNBNDP(val) && val != undefineds, var, s_unbnd, ""); + ASRTER(!UNBNDP(val) && val != undefineds, var, s_unbnd, ""); if (memo && !KEYWORDP(val)) /* Don't memoize forms to be macroexpanded. */ CAR(vloc) = addr; return val; @@ -643,7 +655,7 @@ SCM scm_multi_set(syms, vals) SCM res = EOL, *pres = &res; SCM *loc; do { - ASSERT(NIMP(vals) && CONSP(vals), vals, WNA, s_set); + ASRTER(NIMP(vals) && CONSP(vals), vals, WNA, s_set); switch (7 & (int)(CAR(syms))) { case 0: loc = lookupcar(syms); @@ -661,7 +673,7 @@ SCM scm_multi_set(syms, vals) syms = CDR(syms); vals = CDR(vals); } while (NIMP(syms)); - ASSERT(NULLP(vals) && NULLP(syms), vals, WNA, s_set); + ASRTER(NULLP(vals) && NULLP(syms), vals, WNA, s_set); return res; } @@ -743,7 +755,7 @@ static SCM toplevel_define(xorig, env) { SCM x = CDR(xorig); SCM name = CAR(x); - ASSERT(scm_nullenv_p(env), xorig, s_placement, s_define); + ASRTER(scm_nullenv_p(env), xorig, s_placement, s_define); ENV_PUSH; x = cons(m_binding(name, CAR(CDR(x)), env, EOL), EOL); x = evalcar(x); @@ -845,7 +857,7 @@ SCM scm_values(arg1, arg2, rest, what) char *what; { DEFER_INTS_EGC; - ASSERT(IM_VALUES_TOKEN==scm_env_tmp, UNDEFINED, "one value expected", what); + ASRTER(IM_VALUES_TOKEN==scm_env_tmp, UNDEFINED, "one value expected", what); if (! UNBNDP(arg2)) scm_env_cons(arg2, rest); return arg1; @@ -1051,7 +1063,7 @@ SCM m_case(xorig, env, ctxt) while(NIMP(x = CDR(x))) { clause = CAR(x); s = scm_check_linum(clause, 0L); - ASSYNT(ilength(clause) >= 2, clause /* xorig */, s_clauses, s_case); + ASSYNT(ilength(s) >= 2, clause /* xorig */, s_clauses, s_case); clause = s; if (TOPDENOTE_EQ(i_else, CAR(clause), env)) { ASSYNT(NULLP(CDR(x)), xorig, s_bad_else_clause, s_case); @@ -1165,7 +1177,7 @@ SCM m_lambda(xorig, env, ctxt) SCM name, linum; #endif int argc; - ASSERT(ilength(x) > 1, x, s_body, s_lambda); + ASRTER(ilength(x) > 1, x, s_body, s_lambda); formals = CAR(x); argc = varcheck(formals, IM_LAMBDA, s_formals); formals = scm_check_linum(formals, 0L); @@ -1219,8 +1231,8 @@ SCM m_inline_lambda(xorig, env) SCM x = CDR(xorig); SCM typ = (SCM)(tc16_macro | (MAC_INLINE << 16)); int depth = env_depth(); - ASSERT(ilength(x) > 1, xorig, s_formals, s_lambda); - ASSERT(ilength(CAR(x)) >= 0, xorig, s_formals, s_lambda); + ASRTER(ilength(x) > 1, xorig, s_formals, s_lambda); + ASRTER(ilength(CAR(x)) >= 0, xorig, s_formals, s_lambda); varcheck(CAR(x), IM_LAMBDA, s_formals); x = cons2(typ, MAKINUM((long)depth), cons(CAR(x), m_body(CDR(x), env))); @@ -1235,13 +1247,13 @@ int scm_nullenv_p(env) SCM fr, e; if (IMP(env)) return !0; for (e = env; NIMP(e); e = CDR(e)) { - ASSERT(CONSP(e), e, s_badenv, s_nullenv_p); + ASRTER(CONSP(e), e, s_badenv, s_nullenv_p); fr = CAR(e); if (IMP(fr)) { if (NULLP(fr)) return 0; if (INUMP(fr)) { /* These frames are for meta-data, not bindings. */ e = CDR(e); - ASSERT(NIMP(e), env, s_badenv, s_nullenv_p); + ASRTER(NIMP(e), env, s_badenv, s_nullenv_p); } } else return 0; } @@ -1314,7 +1326,6 @@ SCM m_do(xorig, env, ctxt) x = CDR(x); test = scm_check_linum(CAR(x), 0L); ASSYNT(ilength(test) >= 1, CAR(x), s_test, s_do); - test = m_seq(test, env, ctxt); if (IMP(CDR(test))) test = cons(CAR(test), list_unspecified); ASSYNT(ilength(CDR(x))>=0, xorig, s_expression, s_do); varcheck(vars, IM_DO, s_variable); @@ -1396,7 +1407,7 @@ static SCM m_iqq(form, depth, env, ctxt) if (0==depth) tmp = IM_UNQUOTE; label: form = CDR(form); - ASSERT(NIMP(form) && ECONSP(form) && NULLP(CDR(form)), + ASRTER(NIMP(form) && ECONSP(form) && NULLP(CDR(form)), form, ARG1, s_quasiquote); if (0!=depth) form = cons(m_iqq(CAR(form), depth, env, ctxt), EOL); @@ -1444,6 +1455,11 @@ static int built_inp(name, x) return 0; } +extern char s_redefining[]; +#ifndef RECKLESS +char s_built_in_syntax[] = "built-in syntax "; +# define s_syntax (&s_built_in_syntax[9]) +#endif static void checked_define(name, val, what) SCM name, val; char *what; @@ -1451,7 +1467,7 @@ static void checked_define(name, val, what) SCM old, vcell; #ifdef MACRO while (M_IDENTP(name)) { - ASSERT(IMP(IDENT_ENV(name)), name, s_escaped, what); + ASRTER(IMP(IDENT_ENV(name)), name, s_escaped, what); name = IDENT_PARENT(name); } #endif @@ -1459,17 +1475,17 @@ static void checked_define(name, val, what) old = CDR(vcell); #ifndef RECKLESS if ('@'==CHARS(name)[0] && UNDEFINED != old) - scm_warn("redefining internal name ", "", name); + scm_warn(s_redefining, "internal name ", name); if (KEYWORDP(old)) { if (1 <= verbose && built_inp(name, KEYWORD_MACRO(old))) - scm_warn("redefining built-in syntax ", "", name); + scm_warn(s_redefining, s_built_in_syntax, name); else if (3 <= verbose) - scm_warn("redefining syntax ", "", name); + scm_warn(s_redefining, s_syntax, name); } else if (2 <= verbose && built_inp(name, old) && (old != val)) - scm_warn("redefining built-in ", "", name); + scm_warn(s_redefining, "built-in ", name); else if (5 <= verbose && UNDEFINED != old) - scm_warn("redefining ", "", name); + scm_warn(s_redefining, "", name); #endif CDR(vcell) = val; } @@ -1594,7 +1610,7 @@ static SCM m_body(xorig, env, ctxt) SCM xorig, env, ctxt; { SCM form, denv = env, x = xorig, defs = EOL; - char *what = ISYMCHARS(CAR(xorig)) + 2; + char *what = 0; /* Should this be passed in? */ ASRTSYNTAX(ilength(xorig) >= 1, s_expression); while NIMP(x) { form = scm_check_linum(CAR(x), 0L); @@ -1627,9 +1643,9 @@ static SCM m_body(xorig, env, ctxt) } } #ifdef CAUTIOUS - ASSYNT(ilength(x) > 0, x, s_body, what); + ASSYNT(ilength(x) > 0, xorig, s_body, what); #else - ASSYNT(ilength(x) > 0, CDR(xorig), s_body, what); + ASSYNT(ilength(x) > 0, xorig, s_body, what); #endif if (IMP(defs)) return x; return cons(m_letrec1(IM_DEFINE, cons2(i_define, defs, x), env, ctxt), EOL); @@ -2019,11 +2035,26 @@ SCM scm_eval_values(x, env, valenv) return res; } +#ifdef __GNUC__ +# define GCC_VERSION (__GNUC__ * 100 + __GNUC_MINOR__) +/* __GNUC_PATCHLEVEL__ */ +# if 302 == GCC_VERSION +# ifdef sparc +# define GCC_SPARC_BUG +# endif +# endif +#endif + static SCM ceval_1(x) SCM x; { - union {SCM *lloc; SCM arg1;} t; - SCM proc, arg2, arg3; +#ifdef GCC_SPARC_BUG + SCM arg1; +#else + struct {SCM arg_1;} t; +# define arg1 t.arg_1 +#endif + SCM arg2, arg3, proc; int envpp = 0; /* 1 means an environment has been pushed in this invocation of ceval_1, -1 means pushed and then popped. */ #ifdef CAUTIOUS @@ -2044,19 +2075,19 @@ static SCM ceval_1(x) goto retx; case (127 & IM_AND): x = CDR(x); - t.arg1 = x; - while(NNULLP(t.arg1 = CDR(t.arg1))) + arg1 = x; + while(NNULLP(arg1 = CDR(arg1))) if (FALSEP(EVALCAR(x))) {x = BOOL_F; goto retx;} - else x = t.arg1; + else x = arg1; goto carloop; cdrxbegin: case (127 & IM_BEGIN): x = CDR(x); begin: - t.arg1 = x; - while(NNULLP(t.arg1 = CDR(t.arg1))) { + arg1 = x; + while(NNULLP(arg1 = CDR(arg1))) { if (NIMP(CAR(x))) ceval_1(CAR(x)); - x = t.arg1; + x = arg1; } carloop: /* eval car of last form in list */ if NCELLP(CAR(x)) { @@ -2080,11 +2111,11 @@ static SCM ceval_1(x) case (127 & IM_COND): while(NIMP(x = CDR(x))) { proc = CAR(x); - t.arg1 = EVALCAR(proc); - if NFALSEP(t.arg1) { + arg1 = EVALCAR(proc); + if NFALSEP(arg1) { x = CDR(proc); if NULLP(x) { - x = t.arg1; + x = arg1; goto retx; } if (IM_ARROW != CAR(x)) goto begin; @@ -2106,8 +2137,8 @@ static SCM ceval_1(x) x = CDR(CDR(x)); while (proc = CAR(x), FALSEP(EVALCAR(proc))) { for(proc = CAR(CDR(x));NIMP(proc);proc = CDR(proc)) { - t.arg1 = CAR(proc); /* body */ - SIDEVAL_1(t.arg1); + arg1 = CAR(proc); /* body */ + SIDEVAL_1(arg1); } ecache_evalx(CDR(CDR(x))); /* steps */ scm_env = CDR(scm_env); @@ -2125,13 +2156,13 @@ static SCM ceval_1(x) ENV_MAY_PUSH(envpp); TRACE(x); #ifdef MAC_INLINE - t.arg1 = CAR(x); + arg1 = CAR(x); #endif x = CDR(x); ecache_evalx(CAR(CDR(x))); #ifdef MAC_INLINE - if (t.arg1 != IM_LET) /* inline call */ - env_tail(ISYMVAL(t.arg1)); + if (arg1 != IM_LET) /* inline call */ + env_tail(ISYMVAL(arg1)); #endif STATIC_ENV = CAR(x); EXTEND_VALENV; @@ -2171,11 +2202,11 @@ static SCM ceval_1(x) goto cdrxbegin; case (127 & IM_OR): x = CDR(x); - t.arg1 = x; - while(NNULLP(t.arg1 = CDR(t.arg1))) { + arg1 = x; + while(NNULLP(arg1 = CDR(arg1))) { x = EVALCAR(x); if NFALSEP(x) goto retx; - x = t.arg1; + x = arg1; } goto carloop; case (127 & IM_LAMBDA): @@ -2226,18 +2257,18 @@ static SCM ceval_1(x) x = CDR(x); proc = evalcar(x); ASRTGO(NIMP(proc), badfun); - t.arg1 = evalcar(CDR(x)); + arg1 = evalcar(CDR(x)); if (CLOSUREP(proc)) { ENV_MAY_PUSH(envpp); TRACE(x); - scm_env_tmp = t.arg1; + scm_env_tmp = arg1; #ifndef RECKLESS goto clo_checked; #else goto clo_unchecked; #endif } - x = apply(proc, t.arg1, EOL); + x = apply(proc, arg1, EOL); goto retx; case (ISYMNUM(IM_DELAY)): x = makprom(closure(CDR(x), 0)); @@ -2338,13 +2369,13 @@ static SCM ceval_1(x) #ifdef CAUTIOUS if (0!=ARGC(proc)) { clo_checked: - t.arg1 = SCM_ENV_FORMALS(CAR(CODE(proc))); + arg1 = SCM_ENV_FORMALS(CAR(CODE(proc))); DEFER_INTS_EGC; arg2 = scm_env_tmp; - while NIMP(t.arg1) { - if NCONSP(t.arg1) goto clo_unchecked; + while NIMP(arg1) { + if NCONSP(arg1) goto clo_unchecked; if IMP(arg2) goto umwrongnumargs; - t.arg1 = CDR(t.arg1); + arg1 = CDR(arg1); arg2 = CDR(arg2); } if NNULLP(arg2) goto umwrongnumargs; @@ -2364,7 +2395,7 @@ static SCM ceval_1(x) /* default: break; */ #ifdef CCLO case tc16_cclo: - t.arg1 = proc; + arg1 = proc; proc = CCLO_SUBR(proc); goto evap1; #endif @@ -2400,77 +2431,77 @@ static SCM ceval_1(x) if (IMP(x)) goto wrongnumargs; #endif - t.arg1 = EVALCAR(x); + arg1 = EVALCAR(x); x = CDR(x); if NULLP(x) { TOP_TRACE(xorig, STATIC_ENV); evap1: ENV_MAY_POP(envpp, CLOSUREP(proc)); ALLOW_INTS_EGC; - switch TYP7(proc) { /* have one argument in t.arg1 */ + switch TYP7(proc) { /* have one argument in arg1 */ case tc7_subr_2o: - return SUBRF(proc)(t.arg1, UNDEFINED); + return SUBRF(proc)(arg1, UNDEFINED); case tc7_subr_1: case tc7_subr_1o: - return SUBRF(proc)(t.arg1); + return SUBRF(proc)(arg1); case tc7_cxr: #ifdef FLOATS if SUBRF(proc) { - if INUMP(t.arg1) - return makdbl(DSUBRF(proc)((double) INUM(t.arg1)), 0.0); - ASRTGO(NIMP(t.arg1), floerr); - if REALP(t.arg1) - return makdbl(DSUBRF(proc)(REALPART(t.arg1)), 0.0); + if INUMP(arg1) + return makdbl(DSUBRF(proc)((double) INUM(arg1)), 0.0); + ASRTGO(NIMP(arg1), floerr); + if REALP(arg1) + return makdbl(DSUBRF(proc)(REALPART(arg1)), 0.0); # ifdef BIGDIG - if BIGP(t.arg1) - return makdbl(DSUBRF(proc)(big2dbl(t.arg1)), 0.0); + if BIGP(arg1) + return makdbl(DSUBRF(proc)(big2dbl(arg1)), 0.0); # endif floerr: - wta(t.arg1, (char *)ARG1, SNAME(proc)); + wta(arg1, (char *)ARG1, SNAME(proc)); } #endif { int op = CXR_OP(proc); #ifndef RECKLESS - x = t.arg1; + x = arg1; #endif while (op) { - ASSERT(NIMP(t.arg1) && CONSP(t.arg1), + ASRTER(NIMP(arg1) && CONSP(arg1), x, ARG1, SNAME(proc)); - t.arg1 = (1 & op ? CAR(t.arg1) : CDR(t.arg1)); + arg1 = (1 & op ? CAR(arg1) : CDR(arg1)); op >>= 2; } - return t.arg1; + return arg1; } case tc7_rpsubr: return BOOL_T; case tc7_asubr: - return SUBRF(proc)(t.arg1, UNDEFINED); + return SUBRF(proc)(arg1, UNDEFINED); case tc7_lsubr: - return SUBRF(proc)(cons(t.arg1, EOL)); + return SUBRF(proc)(cons(arg1, EOL)); case tcs_closures: ENV_MAY_PUSH(envpp); #ifdef SCM_PROFILE eval_clo_cases[1][ARGC(proc)]++; #endif if (1==ARGC(proc)) { - scm_env_cons(t.arg1, EOL); + scm_env_cons(arg1, EOL); goto clo_unchecked; } else { - scm_env_tmp = cons(t.arg1, EOL); + scm_env_tmp = cons(arg1, EOL); goto clo_checked; } case tc7_contin: - scm_dynthrow(proc, t.arg1); + scm_dynthrow(proc, arg1); case tc7_specfun: switch TYP16(proc) { case tc16_call_cc: - proc = t.arg1; + proc = arg1; DEFER_INTS_EGC; - t.arg1 = scm_make_cont(); - EGC_ROOT(t.arg1); - x = setjump(CONT(t.arg1)->jmpbuf); + arg1 = scm_make_cont(); + EGC_ROOT(arg1); + x = setjump(CONT(arg1)->jmpbuf); if (x) { #ifdef SHORT_INT x = (SCM)thrown_value; @@ -2484,22 +2515,22 @@ evap1: goto evap1; case tc16_eval: ENV_MAY_PUSH(envpp); - TRACE(t.arg1); + TRACE(arg1); STATIC_ENV = eval_env; scm_env = EOL; - x = t.arg1; + x = arg1; if (IMP(x)) goto retx; goto loop; #ifdef CCLO case tc16_cclo: arg2 = UNDEFINED; goto cclon; - /* arg2 = t.arg1; - t.arg1 = proc; + /* arg2 = arg1; + arg1 = proc; proc = CCLO_SUBR(proc); goto evap2; */ #endif - case tc16_values: return t.arg1; + case tc16_values: return arg1; } case tc7_subr_2: case tc7_subr_0: @@ -2524,25 +2555,25 @@ evap1: switch TYP7(proc) { case tc7_subr_2: case tc7_subr_2o: - return SUBRF(proc)(t.arg1, arg2); + return SUBRF(proc)(arg1, arg2); case tc7_lsubr: - return SUBRF(proc)(cons2(t.arg1, arg2, EOL)); + return SUBRF(proc)(cons2(arg1, arg2, EOL)); case tc7_lsubr_2: - return SUBRF(proc)(t.arg1, arg2, EOL); + return SUBRF(proc)(arg1, arg2, EOL); case tc7_rpsubr: case tc7_asubr: - return SUBRF(proc)(t.arg1, arg2); + return SUBRF(proc)(arg1, arg2); case tc7_specfun: switch TYP16(proc) { case tc16_apply: - proc = t.arg1; + proc = arg1; ASRTGO(NIMP(proc), badfun); if NULLP(arg2) goto evap0; if (IMP(arg2) || NCONSP(arg2)) { x = arg2; badlst: wta(x, (char *)ARGn, s_apply); } - t.arg1 = CAR(arg2); + arg1 = CAR(arg2); x = CDR(arg2); apply3: if NULLP(x) goto evap1; @@ -2562,25 +2593,25 @@ evap1: #ifdef CCLO case tc16_cclo: cclon: arg3 = arg2; - arg2 = t.arg1; - t.arg1 = proc; + arg2 = arg1; + arg1 = proc; proc = CCLO_SUBR(proc); if (UNBNDP(arg3)) goto evap2; goto evap3; /* return apply(CCLO_SUBR(proc), - cons2(proc, t.arg1, cons(arg2, x)), EOL); */ + cons2(proc, arg1, cons(arg2, x)), EOL); */ #endif case tc16_values: - return scm_values(t.arg1, arg2, EOL, s_values); + return scm_values(arg1, arg2, EOL, s_values); case tc16_call_wv: ENV_MAY_PUSH(envpp); scm_env_tmp = IM_VALUES_TOKEN; /* Magic value recognized by VALUES */ - t.arg1 = apply(t.arg1, EOL, EOL); + arg1 = apply(arg1, EOL, EOL); proc = arg2; DEFER_INTS_EGC; if (IM_VALUES_TOKEN==scm_env_tmp) { scm_env_tmp = EOL; - if (UNBNDP(t.arg1)) goto evap0; + if (UNBNDP(arg1)) goto evap0; goto evap1; } arg2 = CAR(scm_env_tmp); @@ -2604,14 +2635,14 @@ evap1: #endif switch ARGC(proc) { case 2: - scm_env_cons2(t.arg1, arg2, EOL); + scm_env_cons2(arg1, arg2, EOL); goto clo_unchecked; case 1: - scm_env_cons(t.arg1, cons(arg2, EOL)); + scm_env_cons(arg1, cons(arg2, EOL)); goto clo_checked; case 0: case 3: /* Error, will be caught at clo_checked: */ - scm_env_tmp = cons2(t.arg1, arg2, EOL); + scm_env_tmp = cons2(arg1, arg2, EOL); goto clo_checked; } } @@ -2623,7 +2654,7 @@ evap1: if (CLOSUREP(proc) && 3==ARGC(proc)) { ALLOW_INTS_EGC; ENV_MAY_PUSH(envpp); - if (ecache_eval_args(proc, t.arg1, arg2, arg3, x)) + if (ecache_eval_args(proc, arg1, arg2, arg3, x)) goto clo_unchecked; goto umwrongnumargs; } @@ -2636,15 +2667,15 @@ evap1: switch TYP7(proc) { case tc7_subr_3: ASRTGO(NULLP(x), wrongnumargs); - return SUBRF(proc)(t.arg1, arg2, arg3); + return SUBRF(proc)(arg1, arg2, arg3); case tc7_asubr: case tc7_rpsubr: - return asubr_apply(proc, t.arg1, arg2, arg3, x); - /* return apply(proc, cons2(t.arg1, arg2, cons(arg3, x)), EOL); */ + return asubr_apply(proc, arg1, arg2, arg3, x); + /* return apply(proc, cons2(arg1, arg2, cons(arg3, x)), EOL); */ case tc7_lsubr_2: - return SUBRF(proc)(t.arg1, arg2, cons(arg3, x)); + return SUBRF(proc)(arg1, arg2, cons(arg3, x)); case tc7_lsubr: - return SUBRF(proc)(cons2(t.arg1, arg2, cons(arg3, x))); + return SUBRF(proc)(cons2(arg1, arg2, cons(arg3, x))); case tcs_closures: ENV_MAY_PUSH(envpp); #ifdef SCM_PROFILE @@ -2652,24 +2683,24 @@ evap1: #endif switch ARGC(proc) { case 3: - scm_env_cons3(t.arg1, arg2, arg3, x); + scm_env_cons3(arg1, arg2, arg3, x); goto clo_checked; case 2: - scm_env_cons2(t.arg1, arg2, cons(arg3, x)); + scm_env_cons2(arg1, arg2, cons(arg3, x)); goto clo_checked; case 1: - scm_env_cons(t.arg1, cons2(arg2, arg3, x)); + scm_env_cons(arg1, cons2(arg2, arg3, x)); goto clo_checked; case 0: - scm_env_tmp = cons2(t.arg1, arg2, cons(arg3, x)); + scm_env_tmp = cons2(arg1, arg2, cons(arg3, x)); goto clo_checked; } case tc7_specfun: switch TYP16(proc) { case tc16_apply: - proc = t.arg1; + proc = arg1; ASRTGO(NIMP(proc), badfun); - t.arg1 = arg2; + arg1 = arg2; if IMP(x) { x = arg3; goto apply3; @@ -2688,7 +2719,7 @@ evap1: goto cclon; #endif case tc16_values: - return scm_values(t.arg1, arg2, cons(arg3, x), s_values); + return scm_values(arg1, arg2, cons(arg3, x), s_values); } case tc7_subr_2: case tc7_subr_1o: @@ -2703,6 +2734,7 @@ evap1: } } } +#undef arg1 } SCM procedurep(obj) @@ -2723,7 +2755,7 @@ SCM l_proc_doc(proc) SCM proc; { SCM env; - ASSERT(BOOL_T==procedurep(proc) && NIMP(proc) && TYP7(proc) != tc7_contin, + ASRTER(BOOL_T==procedurep(proc) && NIMP(proc) && TYP7(proc) != tc7_contin, proc, ARG1, s_proc_doc); switch TYP7(proc) { case tcs_closures: @@ -2747,11 +2779,11 @@ SCM nconc2copy(lst) { SCM last, *lloc = &lst; #ifdef CAUTIOUS - ASSERT(ilength(lst) >= 1, lst, WNA, s_apply); + ASRTER(ilength(lst) >= 1, lst, WNA, s_apply); #endif while NNULLP(CDR(*lloc)) lloc = &CDR(*lloc); #ifdef CAUTIOUS - ASSERT(ilength(CAR(*lloc)) >= 0, lst, ARGn, s_apply); + ASRTER(ilength(CAR(*lloc)) >= 0, lst, ARGn, s_apply); #endif last = CAR(*lloc); *lloc = EOL; @@ -2846,7 +2878,7 @@ SCM apply(proc, arg1, args) args = arg1; #endif while (op) { - ASSERT(NIMP(arg1) && CONSP(arg1), + ASRTER(NIMP(arg1) && CONSP(arg1), args, ARG1, SNAME(proc)); arg1 = (1 & op ? CAR(arg1) : CDR(arg1)); op >>= 2; @@ -2865,7 +2897,7 @@ SCM apply(proc, arg1, args) case tc7_asubr: if NULLP(args) return SUBRF(proc)(arg1, UNDEFINED); while NIMP(args) { - ASSERT(CONSP(args), args, ARG2, s_apply); + ASRTER(CONSP(args), args, ARG2, s_apply); arg1 = SUBRF(proc)(arg1, CAR(args)); args = CDR(args); } @@ -2873,7 +2905,7 @@ SCM apply(proc, arg1, args) case tc7_rpsubr: if NULLP(args) return BOOL_T; while NIMP(args) { - ASSERT(CONSP(args), args, ARG2, s_apply); + ASRTER(CONSP(args), args, ARG2, s_apply); if FALSEP(SUBRF(proc)(arg1, CAR(args))) return BOOL_F; arg1 = CAR(args); args = CDR(args); @@ -2948,7 +2980,7 @@ SCM scm_cvapply(proc, n, argv) int op = CXR_OP(proc); res = argv[0]; while (op) { - ASSERT(NIMP(res) && CONSP(res), + ASRTER(NIMP(res) && CONSP(res), argv[0], ARG1, SNAME(proc)); res = (1 & op ? CAR(res) : CDR(res)); op >>= 2; @@ -3024,7 +3056,7 @@ SCM map(proc, arg1, args) #ifndef RECKLESS scm_arity_check(proc, n, s_map); #endif - ASSERT(NIMP(arg1), arg1, ARG2, s_map); + ASRTER(NIMP(arg1), arg1, ARG2, s_map); #ifdef CCLO if (tc16_cclo==TYP16(proc)) { args = cons(arg1, args); @@ -3040,10 +3072,10 @@ SCM map(proc, arg1, args) ave = &(ve[n]); } ve[0] = arg1; - ASSERT(NIMP(ve[0]), arg1, ARG2, s_map); + ASRTER(NIMP(ve[0]), arg1, ARG2, s_map); for (i = 1; i < n; i++) { ve[i] = CAR(args); - ASSERT(NIMP(ve[i]), ve[i], ARGn, s_map); + ASRTER(NIMP(ve[i]), ve[i], ARGn, s_map); args = CDR(args); } while (1) { @@ -3053,7 +3085,7 @@ SCM map(proc, arg1, args) /* We could check for lists the same length here. */ return res; } - ASSERT(CONSP(ve[i]), ve[i], 0==i ? ARG2 : ARGn, s_map); + ASRTER(CONSP(ve[i]), ve[i], 0==i ? ARG2 : ARGn, s_map); ave[i] = CAR(ve[i]); ve[i] = CDR(ve[i]); } @@ -3070,9 +3102,9 @@ SCM for_each(proc, arg1, args) scm_protect_temp(&heap_ve); /* Keep heap_ve from being optimized away. */ if NULLP(arg1) return UNSPECIFIED; #ifndef RECKLESS - scm_arity_check(proc, n, s_map); + scm_arity_check(proc, n, s_for_each); #endif - ASSERT(NIMP(arg1), arg1, ARG2, s_for_each); + ASRTER(NIMP(arg1), arg1, ARG2, s_for_each); #ifdef CCLO if (tc16_cclo==TYP16(proc)) { args = cons(arg1, args); @@ -3088,10 +3120,10 @@ SCM for_each(proc, arg1, args) ave = &(ve[n]); } ve[0] = arg1; - ASSERT(NIMP(ve[0]), arg1, ARG2, s_for_each); + ASRTER(NIMP(ve[0]), arg1, ARG2, s_for_each); for (i = 1; i < n; i++) { ve[i] = CAR(args); - ASSERT(NIMP(ve[i]), args, ARGn, s_for_each); + ASRTER(NIMP(ve[i]), args, ARGn, s_for_each); args = CDR(args); } while (1) { @@ -3100,7 +3132,7 @@ SCM for_each(proc, arg1, args) if IMP(ve[i]) { return UNSPECIFIED; } - ASSERT(CONSP(ve[i]), ve[i], 0==i ? ARG2 : ARGn, s_for_each); + ASRTER(CONSP(ve[i]), ve[i], 0==i ? ARG2 : ARGn, s_for_each); ave[i] = CAR(ve[i]); ve[i] = CDR(ve[i]); } @@ -3158,7 +3190,7 @@ static SCM makro(code, flags, what) char *what; { register SCM z; - ASSERT(scm_arity_check(code, (MAC_PRIMITIVE & flags ? 3L : 2L), + ASRTER(scm_arity_check(code, (MAC_PRIMITIVE & flags ? 3L : 2L), (char *)0), code, ARG1, what); NEWCELL(z); CDR(z) = code; @@ -3193,7 +3225,7 @@ SCM makidmacro(code) /* Functions for smart expansion */ /* @MACROEXPAND1 returns: - #F if its argument is not a macro invocation, + '#F' if its argument is not a macro invocation, the argument if the argument is a primitive syntax invocation, the result of expansion if the argument is a macro invocation (BEGIN #F) will be returned instead of #F if #F is the result. @@ -3394,7 +3426,7 @@ SCM ident2sym(id) SCM id; { id = id2sym(id); - ASSERT(NIMP(id) && SYMBOLP(id), id, ARG1, s_ident2sym); + ASRTER(NIMP(id) && SYMBOLP(id), id, ARG1, s_ident2sym); return id; } @@ -3403,18 +3435,18 @@ SCM renamed_ident(id, env) SCM id, env; { SCM z; - ASSERT(NIMP(id) && IDENTP(id), id, ARG1, s_renamed_ident); + ASRTER(NIMP(id) && IDENTP(id), id, ARG1, s_renamed_ident); NEWCELL(z); while (NIMP(env)) { if (INUMP(CAR(env))) { - ASSERT(NIMP(CDR(env)), env, s_badenv, s_renamed_ident); + ASRTER(NIMP(CDR(env)), env, s_badenv, s_renamed_ident); env = CDR(CDR(env)); } else if (SCM_LINUMP(CAR(env))) { env = CDR(env); } else { - ASSERT(NULLP(env) || (NIMP(env) && CONSP(env)), + ASRTER(NULLP(env) || (NIMP(env) && CONSP(env)), env, s_badenv, s_renamed_ident); break; } @@ -3587,6 +3619,12 @@ SCM make_specfun(name, typ, flags) } void init_eval() { + scm_env = EOL; + scm_env_tmp = UNSPECIFIED; +#ifndef RECKLESS + scm_trace = BOOL_F; + scm_trace_env = EOL; +#endif tc16_promise = newsmob(&promsmob); tc16_macro = newsmob(¯osmob); tc16_env = newsmob(&envsmob); @@ -3653,6 +3691,7 @@ void init_eval() make_synt(s_letrec_syntax, MAC_MMACRO, m_letrec_syntax); make_synt(s_the_macro, MAC_ACRO, m_the_macro); + add_feature("primitive-hygiene"); #endif f_begin = CDR(CDR(KEYWORD_MACRO(sym2vcell(i_begin)))); diff --git a/features.txi b/features.txi new file mode 100644 index 0000000..96987b8 --- /dev/null +++ b/features.txi @@ -0,0 +1,200 @@ +@item array +@cindex array +Alias for ARRAYS + +@item array-for-each +@cindex array-for-each +array-map! and array-for-each (arrays must also be featured). + +@item arrays +@cindex arrays +Use if you want arrays, uniform-arrays and uniform-vectors. + +@item bignums +@cindex bignums +Large precision integers. + +@item byte +@cindex byte +Treating strings as byte-vectors. + +@item careful-interrupt-masking +@cindex careful-interrupt-masking +Define this for extra checking of interrupt masking and some simple +checks for proper use of malloc and free. This is for debugging C +code in @file{sys.c}, @file{eval.c}, @file{repl.c} and makes the +interpreter several times slower than usual. + +@item cautious +@cindex cautious +Normally, the number of arguments arguments to interpreted closures +(from LAMBDA) are checked if the function part of a form is not a +symbol or only the first time the form is executed if the function +part is a symbol. defining @samp{reckless} disables any checking. +If you want to have SCM always check the number of arguments to +interpreted closures define feature @samp{cautious}. + +@item cheap-continuations +@cindex cheap-continuations +If you only need straight stack continuations, executables compile with +this feature will run faster and use less storage than not having it. +Machines with unusual stacks @emph{need} this. Also, if you incorporate +new C code into scm which uses VMS system services or library routines +(which need to unwind the stack in an ordrly manner) you may need to +use this feature. + +@item compiled-closure +@cindex compiled-closure +Use if you want to use compiled closures. + +@item curses +@cindex curses +For the @dfn{curses} screen management package. + +@item debug +@cindex debug +Turns on the features @samp{cautious}, +@samp{careful-interrupt-masking}, and @samp{stack-limit}; uses +@code{-g} flags for debugging SCM source code. + +@item dump +@cindex dump +Convert a running scheme program into an executable file. + +@item dynamic-linking +@cindex dynamic-linking +Be able to load compiled files while running. + +@item edit-line +@cindex edit-line +interface to the editline or GNU readline library. + +@item engineering-notation +@cindex engineering-notation +Use if you want floats to display in engineering notation (exponents +always multiples of 3) instead of scientific notation. + +@item generalized-c-arguments +@cindex generalized-c-arguments +@code{make_gsubr} for arbitrary (< 11) arguments to C functions. + +@item i/o-extensions +@cindex i/o-extensions +Commonly available I/O extensions: @dfn{exec}, line I/O, file +positioning, file delete and rename, and directory functions. + +@item inexact +@cindex inexact +Use if you want floating point numbers. + +@item lit +@cindex lit +Lightweight -- no features + +@item macro +@cindex macro +C level support for hygienic and referentially transparent macros +(syntax-rules macros). + +@item mysql +@cindex mysql +Client connections to the mysql databases. + +@item no-heap-shrink +@cindex no-heap-shrink +Use if you want segments of unused heap to not be freed up after +garbage collection. This may increase time in GC for *very* large +working sets. + +@item none +@cindex none +No features + +@item posix +@cindex posix +Posix functions available on all @dfn{Unix-like} systems. fork and +process functions, user and group IDs, file permissions, and +@dfn{link}. + +@item reckless +@cindex reckless +If your scheme code runs without any errors you can disable almost +all error checking by compiling all files with @samp{reckless}. + +@item record +@cindex record +The Record package provides a facility for user to define their own +record data types. See SLIB for documentation. + +@item regex +@cindex regex +String regular expression matching. + +@item rev2-procedures +@cindex rev2-procedures +These procedures were specified in the @cite{Revised^2 Report on Scheme} +but not in @cite{R4RS}. + +@item sicp +@cindex sicp +Use if you want to run code from: + +@cindex SICP +Harold Abelson and Gerald Jay Sussman with Julie Sussman. +@cite{Structure and Interpretation of Computer Programs.} +The MIT Press, Cambridge, Massachusetts, USA, 1985. + +Differences from R5RS are: +@itemize @bullet +@item +(eq? '() '#f) +@item +(define a 25) returns the symbol a. +@item +(set! a 36) returns 36. +@end itemize + +@item single-precision-only +@cindex single-precision-only +Use if you want all inexact real numbers to be single precision. This +only has an effect if SINGLES is also defined (which is the default). +This does not affect complex numbers. + +@item socket +@cindex socket +BSD @dfn{socket} interface. + +@item stack-limit +@cindex stack-limit +Use to enable checking for stack overflow. Define value of the C +preprocessor variable @var{STACK_LIMIT} to be the size to which SCM +should allow the stack to grow. STACK_LIMIT should be less than the +maximum size the hardware can support, as not every routine checks the +stack. + +@item tick-interrupts +@cindex tick-interrupts +Use if you want the ticks and ticks-interrupt functions. + +@item turtlegr +@cindex turtlegr +@dfn{Turtle} graphics calls for both Borland-C and X11 from +sjm@@ee.tut.fi. + +@item unix +@cindex unix +Those unix features which have not made it into the Posix specs: +nice, acct, lstat, readlink, symlink, mknod and sync. + +@item windows +@cindex windows +Microsoft Windows executable. + +@item x +@cindex x +Alias for Xlib feature. + +@item xlib +@cindex xlib +Interface to Xlib graphics routines. + @@ -16,13 +16,13 @@ Fri Sep 14 22:16:14 1990 Edgar Roeder (edgar at megamaster) dld_find_executable so that users may specify a special path for object modules. -Thu Feb 3 01:46:16 1994 Aubrey Jaffer (jaffer@jacal) +Thu Feb 3 01:46:16 1994 Aubrey Jaffer * find_exec.c (dld_find_executable): added stat check for linux so that it doesn't think directories with the same name as the program are executable. -Wed Feb 21 23:06:35 1996 Aubrey Jaffer <jaffer@jacal.bertronics> +Wed Feb 21 23:06:35 1996 Aubrey Jaffer * find_exec.c: extracted for general use. Generalized to MS-DOS. */ @@ -83,6 +83,10 @@ Wed Feb 21 23:06:35 1996 Aubrey Jaffer <jaffer@jacal.bertronics> # include <sys/types.h> # include <sys/stat.h> # endif +# ifdef __NetBSD__ +# include <stdlib.h> +# include <unistd.h> +# endif # ifdef __OpenBSD__ /* This might be same for 44bsd derived system. */ # include <stdlib.h> @@ -73,7 +73,7 @@ SCM make_gsubr(name, req, opt, rst, fcn) SCM symcell = sysintern(name, UNDEFINED); SCM z = scm_maksubr(name, tc7_subr_0, fcn); SCM cclo = makcclo(f_gsubr_apply, 3L); - ASSERT(GSUBR_MAX >= req + opt + rst, MAKINUM(req + opt + rst), + ASRTER(GSUBR_MAX >= req + opt + rst, MAKINUM(req + opt + rst), OUTOFRANGE, "make_gsubr"); GSUBR_PROC(cclo) = z; GSUBR_TYPE(cclo) = MAKINUM(GSUBR_MAKTYPE(req, opt, rst)); @@ -127,6 +127,8 @@ SCM gsubr_apply(args) } } +SCM_DLL_EXPORT void init_gsubr P((void)); + void init_gsubr() { f_gsubr_apply = make_subr(s_gsubr_apply, tc7_lsubr, gsubr_apply); diff --git a/hobbit.info b/hobbit.info index 9e0c0a9..a9d8b9f 100644 --- a/hobbit.info +++ b/hobbit.info @@ -19,6 +19,7 @@ Tammet. * Performance of Compiled Code:: * Principles of Compilation:: * About Hobbit:: +* Index:: Copyright (C) 1990-1999, 2002 Free Software Foundation @@ -66,7 +67,7 @@ Hobbit (derived from hobbit5x) is now part of the SCM Scheme implementation. The most recent information about SCM can be found on SCM's "WWW" home page: - <http://swissnet.ai.mit.edu/~jaffer/SCM.html> + <http://swissnet.ai.mit.edu/~jaffer/SCM> Hobbit4d has also been ported to the Guile Scheme implementation: @@ -104,6 +105,9 @@ Compiling And Linking instance, `.so'). NAME1.scm must be in the current directory; NAME2.scm, ... may be in other directories. + If a file named `NAME1.opt' exists, then its options are passed to + the `build' invocation which compiles the `c' files. + cd ~/scm/ scm -rcompile -e'(compile-file "example.scm")' @@ -134,7 +138,7 @@ Compiling And Linking (lambda (fp) (for-each (lambda (string) (write-line string fp)) - '("#define IMPLINIT \"Init5d6.scm\"" + '("#define IMPLINIT \"Init5d9.scm\"" "#define BIGNUMS" "#define FLOATS" "#define ARRAYS" @@ -153,6 +157,9 @@ Compiling And Linking ... to a SCM executable named EXENAME. NAME1.scm must be in the current directory; NAME2.scm, ... may be in other directories. + If a file named `EXENAME.opt' exists, then its options are passed + to the `build' invocation which compiles the `c' files. + cd ~/scm/ scm -rcompile -e'(compile->executable "exscm" "example.scm")' @@ -183,7 +190,7 @@ Compiling And Linking (lambda (fp) (for-each (lambda (string) (write-line string fp)) - '("#define IMPLINIT \"Init5d6.scm\"" + '("#define IMPLINIT \"Init5d9.scm\"" "#define COMPILED_INITS init_example();" "#define CCLO" "#define FLOATS")))) @@ -533,10 +540,8 @@ generic case, not immediate-integers-only and are thus much slower. Notice that the procedures logsleft, logsright are NOT in the the library file `logical.scm:' the universal procedure ash is instead. Procedures ash, logcount, integer-length, integer-expt, bit-extract, -ipow-by-squaring, logical:ash, logical:logcount, logical:integer-length, -logical:integer-expt, logical:bit-extract, logical:ipow-by-squaring, in -`logical.scm' are not primtives and they are all compiled into calls to -interpreted code. +ipow-by-squaring, in `logical.scm' are not primtives and they are all +compiled into calls to interpreted code. logsleft and logsright are defined for non-compiled use in the file `scmhob.scm' included in the SCM distribution. @@ -1271,13 +1276,13 @@ Expansion and Analysis let*-s inside these chunks. 5. Normalization is performed. This converts a majority of scheme - control procedures like cond, case, or, and into equivalent terms - using a small set of primitives. New variables may be introduced - in this phase. + control procedures like `cond', `case', `or', `and' into + equivalent terms using a small set of primitives. New variables + may be introduced in this phase. - In case a procedure like or or and occurs in the place where its - value is treated as a boolean (eg. first argument of if), it is - converted into an analogous boolean-returning procedure, which + In case a procedure like `or' or `and' occurs in the place where + its value is treated as a boolean (eg. first argument of `if'), it + is converted into an analogous boolean-returning procedure, which will finally be represented by an analogous C procedure (eg. || or &&). @@ -1616,7 +1621,7 @@ instead of the default: (define *build-intermediate-files* #f). -File: hobbit.info, Node: About Hobbit, Prev: Principles of Compilation, Up: Top +File: hobbit.info, Node: About Hobbit, Next: Index, Prev: Principles of Compilation, Up: Top About Hobbit ************ @@ -1674,7 +1679,7 @@ Author and Contributors University of Go"teborg S-41296 Go"teborg Sweden -A. Jaffer (jaffer @ alum.mit.edu), the author of SCM, has been of major +A. Jaffer (agj @ alum.mit.edu), the author of SCM, has been of major help with a number of suggestions and hacks, especially concerning the interface between compiled code and the SCM interpreter. @@ -1750,10 +1755,10 @@ hobbit4c: hobbit4b: The following bugs have been fixed: * Erroneous treatment of [ and ] inside symbols, reported by A. - Jaffer (jaffer @ alum.mit.edu). + Jaffer (agj @ alum.mit.edu). - * A bug in the liftability analysis, reported by A. Jaffer - (jaffer @ alum.mit.edu). + * A bug in the liftability analysis, reported by A. Jaffer (agj + @ alum.mit.edu). * A bug occurring in case arguments are evaluated right-to-left, which happens with Hobbit compiled by gcc on Linux. Reported @@ -1905,48 +1910,61 @@ hobbit1a1 (not public): hobbit1: the first release + +File: hobbit.info, Node: Index, Prev: About Hobbit, Up: Top + +Index +***** + +* Menu: + +* compile->executable: Compiling And Linking. +* compile-file: Compiling And Linking. +* hobbit: Compiling And Linking. + Tag Table: Node: Top199 -Node: Introduction1217 -Node: Compiling with Hobbit2533 -Node: Compiling And Linking2786 -Node: Error Detection7267 -Node: Hobbit Options8565 -Node: CC Optimizations15286 -Node: The Language Compiled16234 -Node: Macros16889 -Node: SCM Primitive Procedures17485 -Node: SLIB Logical Procedures18336 -Node: Fast Integer Calculations19616 -Node: Force and Delay20742 -Node: Suggestions for writing fast code21319 -Node: Performance of Compiled Code31510 -Node: Gain in Speed31766 -Node: Benchmarks33343 -Node: Benchmark Sources36435 -Node: Destruct36773 -Node: Recfib38348 -Node: div-iter and div-rec38591 -Node: Hanoi39665 -Node: Tak40234 -Node: Ctak40577 -Node: Takl41560 -Node: Cpstak42219 -Node: Pi42986 -Node: Principles of Compilation44103 -Node: Macro-Expansion and Analysis44525 -Node: Building Closures48308 -Node: Lambda-lifting51191 -Node: Statement-lifting53939 -Node: Higher-order Arglists55039 -Node: Typing and Constants56837 -Node: About Hobbit58093 -Node: The Aims of Developing Hobbit58335 -Node: Manifest59218 -Node: Author and Contributors59669 -Node: Future Improvements60719 -Node: Release History61476 +Node: Introduction1227 +Node: Compiling with Hobbit2540 +Node: Compiling And Linking2793 +Node: Error Detection7538 +Node: Hobbit Options8836 +Node: CC Optimizations15557 +Node: The Language Compiled16505 +Node: Macros17160 +Node: SCM Primitive Procedures17756 +Node: SLIB Logical Procedures18607 +Node: Fast Integer Calculations19763 +Node: Force and Delay20889 +Node: Suggestions for writing fast code21466 +Node: Performance of Compiled Code31657 +Node: Gain in Speed31913 +Node: Benchmarks33490 +Node: Benchmark Sources36582 +Node: Destruct36920 +Node: Recfib38495 +Node: div-iter and div-rec38738 +Node: Hanoi39812 +Node: Tak40381 +Node: Ctak40724 +Node: Takl41707 +Node: Cpstak42366 +Node: Pi43133 +Node: Principles of Compilation44250 +Node: Macro-Expansion and Analysis44672 +Node: Building Closures48469 +Node: Lambda-lifting51352 +Node: Statement-lifting54100 +Node: Higher-order Arglists55200 +Node: Typing and Constants56998 +Node: About Hobbit58254 +Node: The Aims of Developing Hobbit58510 +Node: Manifest59393 +Node: Author and Contributors59844 +Node: Future Improvements60891 +Node: Release History61648 +Node: Index68429 End Tag Table @@ -2,7 +2,7 @@ ;
; HOBBIT: an optimizing scheme -> C compiler for SCM
;
-; scm5d6
+; scm5d9
; 2002-04-11
;
; Copyright (C) 1992-1997: Tanel Tammet
@@ -55,7 +55,12 @@ ; - "copy-tree" and "acons" compilation introduced
; pre-april, 2002, Aubrey Jaffer:
; - numerous changes necessary for co-operation with SCM5d5
-;
+
+;;; Declare modules which might be needed:
+(require-if 'compiling 'pretty-print)
+(require-if 'compiling 'defmacroexpand)
+(require-if 'compiling 'pprint-file)
+
;=================================================================
;
; default compiler options
@@ -63,7 +68,6 @@ ;
;=================================================================
-
;;; The following variable controls whether hobbit will do any
;;; macroexpansion. In that case (require 'defmacroexpand) must
;;; be able to load the macroexpander from the scheme library.
@@ -165,7 +169,7 @@ (for-each display lst)
(display #\newline)
(abort))
-
+;@
(define compile-allnumbers #t)
;=================================================================
@@ -365,13 +369,6 @@ (define *init-fun-prefix* "init_")
-;;; The following is a string which is prepended to the name of your
-;;; scheme file (without .scm) to form a C variable which is generated
-;;; as a new global to gc-protect the constant nonimmediate objects
-;;; in your file.
-
-(define *protect-variable* "protect_constants_")
-
;;; The following is a name of a variable which may be defined to
;;; the list of inlinable functions in your scheme file.
@@ -812,11 +809,7 @@ ;
;=================================================================
-
-(define (Hobbit:compile file . files)
- (hobbit (cons file files)))
-
-
+;@ exported symbol hobbit.
(define (hobbit file . files)
(let* ((tmpname "hobbit.tmp"))
(if *build-intermediate-files*
@@ -824,8 +817,7 @@ (if *expand-macros-flag*
(begin (require 'defmacroexpand)
(require 'pprint-file)))
- (if (not (memq 'hobbit *features*))
- (set! *features* (cons 'hobbit *features*)))
+ (provide 'hobbit)
(if (or (member '"scmhob.scm" (cons file files))
(member '"scmhob" (cons file files)))
(report-error "The file scmhob.scm is not allowed to be compiled!"))
@@ -2384,9 +2376,6 @@ map for-each list call-with-input-file call-with-output-file
open-input-file open-output-file with-input-from-file
with-output-to-file string-append
- logical:logxor logical:lognot logical:logior logical:logand
- logical:ash logical:logcount logical:integer-length
- logical:bit-extract logical:integer-expt
defmacro:expand*
sin cos tan asin acos atan sinh cosh tanh asinh acosh
sin cos tan asin acos atan sinh cosh tanh asinh acosh
@@ -2561,7 +2550,7 @@ (vector->list "vector2list" 1)
(list->vector "vector" 1)
- (read "lread" 1)
+ (read "scm_read" 1)
(read-char "scm_read_char" 1)
(peek-char "peek_char" 1)
(eof-object? "eof_objectp" 1)
diff --git a/hobbit.texi b/hobbit.texi index 3b448fb..f87c1b0 100644 --- a/hobbit.texi +++ b/hobbit.texi @@ -6,8 +6,6 @@ @setchapternewpage on @c Choices for setchapternewpage are {on,off,odd}. @paragraphindent 0 -@defcodeindex ft -@syncodeindex ft cp @c %**end of header @dircategory The Algorithmic Language Scheme @@ -68,6 +66,7 @@ Tammet. * Performance of Compiled Code:: * Principles of Compilation:: * About Hobbit:: +* Index:: @end menu Copyright (C) 1990-1999, 2002 Free Software Foundation @@ -124,7 +123,7 @@ Hobbit (derived from hobbit5x) is now part of the SCM Scheme implementation. The most recent information about SCM can be found on SCM's @dfn{WWW} home page: -@center @url{http://swissnet.ai.mit.edu/~jaffer/SCM.html} +@center @url{http://swissnet.ai.mit.edu/~jaffer/SCM} Hobbit4d has also been ported to the Guile Scheme implementation: @@ -159,6 +158,10 @@ Compiles the HOBBIT translation of @var{name1}.scm, @var{name2}.scm, suffix for your computer (for instance, @file{.so}). @var{name1}.scm must be in the current directory; @var{name2}.scm, @dots{} may be in other directories. + +If a file named @file{@var{name1}.opt} exists, then its options are +passed to the @code{build} invocation which compiles the @code{c} +files. @end defun @example @@ -212,6 +215,10 @@ Compiles and links the HOBBIT translation of @var{name1}.scm, @var{name2}.scm, @dots{} to a SCM executable named @var{exename}. @var{name1}.scm must be in the current directory; @var{name2}.scm, @dots{} may be in other directories. + +If a file named @file{@var{exename}.opt} exists, then its options are +passed to the @code{build} invocation which compiles the @code{c} +files. @end defun @example @@ -663,13 +670,11 @@ The following alternative names @t{logical:logand}, @t{logical:logior}, generic case, not immediate-integers-only and are thus much slower. Notice that the procedures @t{logsleft}, @t{logsright} are @b{NOT} in -the the library file @file{logical.scm:} the universal procedure @t{ash} -is instead. Procedures @t{ash}, @t{logcount}, @t{integer-length}, -@t{integer-expt}, @t{bit-extract}, @t{ipow-by-squaring}, -@t{logical:ash}, @t{logical:logcount}, @t{logical:integer-length}, -@t{logical:integer-expt}, @t{logical:bit-extract}, -@t{logical:ipow-by-squaring}, in @file{logical.scm} are not primtives -and they are all compiled into calls to interpreted code. +the the library file @file{logical.scm:} the universal procedure +@t{ash} is instead. Procedures @t{ash}, @t{logcount}, +@t{integer-length}, @t{integer-expt}, @t{bit-extract}, +@t{ipow-by-squaring}, in @file{logical.scm} are not primtives and they +are all compiled into calls to interpreted code. @t{logsleft} and @t{logsright} are defined for non-compiled use in the file @file{scmhob.scm} included in the SCM distribution. @@ -1514,14 +1519,15 @@ passed variables. Wherever possible, @t{letrec}-s are replaced by @item Normalization is performed. This converts a majority of scheme -control procedures like cond, case, or, and into equivalent -terms using a small set of primitives. New variables may be -introduced in this phase. +control procedures like @code{cond}, @code{case}, @code{or}, +@code{and} into equivalent terms using a small set of primitives. New +variables may be introduced in this phase. -In case a procedure like or or and occurs in the place where its value -is treated as a boolean (eg. first argument of if), it is converted -into an analogous boolean-returning procedure, which will finally -be represented by an analogous C procedure (eg. || or &&). +In case a procedure like @code{or} or @code{and} occurs in the place +where its value is treated as a boolean (eg. first argument of +@code{if}), it is converted into an analogous boolean-returning +procedure, which will finally be represented by an analogous C +procedure (eg. || or &&). Associative procedures are converted into structures of corresponding nonassociative procedures. List is converted to a structure of cons-s. @@ -1928,7 +1934,7 @@ instead of the default: @end example -@node About Hobbit, , Principles of Compilation, Top +@node About Hobbit, Index, Principles of Compilation, Top @chapter About Hobbit @menu @@ -1988,7 +1994,7 @@ University of Go"teborg@* S-41296 Go"teborg Sweden @end quotation -A. Jaffer (jaffer @@ alum.mit.edu), the author of SCM, has been of major +A. Jaffer (agj @@ alum.mit.edu), the author of SCM, has been of major help with a number of suggestions and hacks, especially concerning the interface between compiled code and the SCM interpreter. @@ -2083,10 +2089,10 @@ The following bugs have been fixed: @itemize @bullet @item Erroneous treatment of [ and ] inside symbols, -reported by A. Jaffer (jaffer @@ alum.mit.edu). +reported by A. Jaffer (agj @@ alum.mit.edu). @item A bug in the liftability analysis, -reported by A. Jaffer (jaffer @@ alum.mit.edu). +reported by A. Jaffer (agj @@ alum.mit.edu). @item A bug occurring in case arguments are evaluated right-to-left, which happens with Hobbit compiled by gcc on Linux. @@ -2269,5 +2275,10 @@ the first release @end table +@node Index, , About Hobbit, Top +@unnumbered Index + +@printindex fn + @contents @bye @@ -43,11 +43,13 @@ ;;;; "inc2scm", Convert numeric C #defines to Scheme definitions. ;;; Author: Aubrey Jaffer. -(define (go-script) - (cond ((< 1 (- (length *argv*) *optind*)) - (apply inc2scm (list-tail *argv* *optind*))) - (else - (display "\ +(define (inc2scm.script args) + (cond ((< 1 (length args)) + (apply scm<-usr/includes args)) + (else (inc2scm.usage)))) + +(define (inc2scm.usage) + (display "\ \ Usage: inc2scm defines.scm [pre:] [/usr/include/] file1.h file2.h ... \ @@ -57,9 +59,11 @@ Usage: inc2scm defines.scm [pre:] [/usr/include/] file1.h file2.h ... PRE: is prepended to those scheme names lacking a prefix. /USR/INCLUDE/ defaults to /usr/include/. + +http://swissnet.ai.mit.edu/~jaffer/SCM " - (current-error-port)) - (exit #f)))) + (current-error-port)) + #f) (require 'string-search) (require 'printf) @@ -172,7 +176,6 @@ Usage: inc2scm defines.scm [pre:] [/usr/include/] file1.h file2.h ... (apply scm<-includes scmname pre include-path filenames) (delete-file "tmpprog.c") (delete-file "tmpprog")) -(define inc2scm scm<-usr/includes) (define (scm<-h* scmname . filenames) (define pre (let ((first (car filenames))) @@ -183,8 +186,7 @@ Usage: inc2scm defines.scm [pre:] [/usr/include/] file1.h file2.h ... (delete-file "tmpprog")) (define h2scm scm<-h*) -(go-script) - ;;; Local Variables: ;;; mode:scheme ;;; End: +(exit (inc2scm.script (list-tail *argv* *optind*))) @@ -70,6 +70,9 @@ SCM stat2scm P((struct stat *stat_temp)); #ifdef __FreeBSD__ # include <unistd.h> #endif +#ifdef __NetBSD__ +# include <unistd.h> +#endif #ifdef __OpenBSD__ # include <unistd.h> #endif @@ -134,7 +137,7 @@ SCM read_line(port) SCM tok_buf = makstr((long) len); register char *p = CHARS(tok_buf); if UNBNDP(port) port = cur_inp; - else ASSERT(NIMP(port) && OPINPORTP(port), port, ARG1, s_read_line); + else ASRTER(NIMP(port) && OPINPORTP(port), port, ARG1, s_read_line); if (EOF==(c = lgetc(port))) return EOF_VAL; while(1) { switch (c) { @@ -161,11 +164,11 @@ SCM read_line1(str, port) register int j = 0; register char *p; sizet len; - ASSERT(NIMP(str) && STRINGP(str), str, ARG1, s_read_line1); + ASRTER(NIMP(str) && STRINGP(str), str, ARG1, s_read_line1); p = CHARS(str); len = LENGTH(str); if UNBNDP(port) port = cur_inp; - else ASSERT(NIMP(port) && OPINPORTP(port), port, ARG2, s_read_line1); + else ASRTER(NIMP(port) && OPINPORTP(port), port, ARG2, s_read_line1); c = lgetc(port); if (EOF==c) return EOF_VAL; while(1) { @@ -197,7 +200,7 @@ SCM file_position(port) SCM port; { long ans; - ASSERT(NIMP(port) && OPFPORTP(port), port, ARG1, s_file_position); + ASRTER(NIMP(port) && OPFPORTP(port), port, ARG1, s_file_position); SYSCALL(ans = ftell(STREAM(port));); if CRDYP(port) ans--; return MAKINUM(ans); @@ -206,7 +209,7 @@ SCM file_set_position(port, pos) SCM port, pos; { SCM ans; - ASSERT(NIMP(port) && OPFPORTP(port), port, ARG1, s_file_set_pos); + ASRTER(NIMP(port) && OPFPORTP(port), port, ARG1, s_file_set_pos); #ifndef RECKLESS if (TRACKED & SCM_PORTFLAGS(port)) { if (INUM0==pos) { @@ -226,7 +229,7 @@ SCM file_set_position(port, pos) #ifdef HAVE_PIPE # ifdef ESPIPE if (!OPIOPORTP(port)) - ASSERT(ESPIPE != errno, port, ARG1, s_file_set_pos); + ASRTER(ESPIPE != errno, port, ARG1, s_file_set_pos); # endif #endif return ans; @@ -239,12 +242,12 @@ SCM reopen_file(filename, modes, port) FILE *f; char cmodes[4]; long flags; - ASSERT(NIMP(filename) && STRINGP(filename), filename, ARG1, s_reopen_file); - ASSERT(NIMP(modes) && (STRINGP(modes) || SYMBOLP(modes)), modes, ARG2, s_reopen_file); + ASRTER(NIMP(filename) && STRINGP(filename), filename, ARG1, s_reopen_file); + ASRTER(NIMP(modes) && (STRINGP(modes) || SYMBOLP(modes)), modes, ARG2, s_reopen_file); flags = mode_bits(CHARS(modes), cmodes); - ASSERT(flags, modes, ARG2, s_reopen_file); + ASRTER(flags, modes, ARG2, s_reopen_file); DEFER_INTS; - ASSERT(NIMP(port) && FPORTP(port) && OPENP(port), port, ARG3, s_reopen_file); + ASRTER(NIMP(port) && FPORTP(port) && OPENP(port), port, ARG3, s_reopen_file); SCM_OPENCALL(f = freopen(CHARS(filename), cmodes, STREAM(port))); if (!f) { ALLOW_INTS; @@ -272,10 +275,10 @@ SCM l_dup(oldpt, modes) int tfd; FILE *f; SCM newpt; - ASSERT(NIMP(oldpt) && OPFPORTP(oldpt), oldpt, ARG1, s_dup); - ASSERT(NIMP(modes) && (STRINGP(modes) || SYMBOLP(modes)), modes, ARG2, s_dup); + ASRTER(NIMP(oldpt) && OPFPORTP(oldpt), oldpt, ARG1, s_dup); + ASRTER(NIMP(modes) && (STRINGP(modes) || SYMBOLP(modes)), modes, ARG2, s_dup); flags = mode_bits(CHARS(modes), cmodes); - ASSERT(flags, modes, ARG2, s_dup); + ASRTER(flags, modes, ARG2, s_dup); NEWCELL(newpt); DEFER_INTS; SCM_OPENCALL(tfd = dup(fileno(STREAM(oldpt)))); @@ -303,8 +306,8 @@ SCM l_dup2(into_pt, from_pt) { int ans, oldfd, newfd; DEFER_INTS; - ASSERT(NIMP(into_pt) && OPFPORTP(into_pt), into_pt, ARG1, s_dup2); - ASSERT(NIMP(from_pt) && OPFPORTP(from_pt), from_pt, ARG1, s_dup2); + ASRTER(NIMP(into_pt) && OPFPORTP(into_pt), into_pt, ARG1, s_dup2); + ASRTER(NIMP(from_pt) && OPFPORTP(from_pt), from_pt, ARG1, s_dup2); oldfd = fileno(STREAM(into_pt)); newfd = fileno(STREAM(from_pt)); SCM_OPENCALL(ans = dup2(oldfd, newfd)); @@ -315,15 +318,18 @@ SCM l_dup2(into_pt, from_pt) # endif # ifndef vms +static char s_opendir[]="opendir"; +static char s_readdir[]="readdir"; +static char s_rewinddir[]="rewinddir"; +static char s_closedir[]="closedir"; # ifndef _WIN32 # include <dirent.h> -static char s_opendir[]="opendir"; SCM l_opendir(dirname) SCM dirname; { DIR *ds; SCM dir; - ASSERT(NIMP(dirname) && STRINGP(dirname), dirname, ARG1, s_opendir); + ASRTER(NIMP(dirname) && STRINGP(dirname), dirname, ARG1, s_opendir); NEWCELL(dir); DEFER_INTS; SCM_OPENCALL(ds = opendir(CHARS(dirname))); @@ -333,33 +339,33 @@ SCM l_opendir(dirname) ALLOW_INTS; return dir; } -static char s_readdir[]="readdir"; + SCM l_readdir(port) SCM port; { struct dirent *rdent; DEFER_INTS; - ASSERT(OPDIRP(port), port, ARG1, s_readdir); + ASRTER(OPDIRP(port), port, ARG1, s_readdir); SYSCALL(rdent = readdir((DIR *)CDR(port));); if (!rdent) {ALLOW_INTS; return BOOL_F;} ALLOW_INTS; /* rdent could be overwritten by another readdir to the same handle */ return makfrom0str((char *)rdent->d_name); } -static char s_rewinddir[]="rewinddir"; + SCM l_rewinddir(port) SCM port; { - ASSERT(OPDIRP(port), port, ARG1, s_rewinddir); + ASRTER(OPDIRP(port), port, ARG1, s_rewinddir); rewinddir((DIR *)CDR(port)); return UNSPECIFIED; } -static char s_closedir[]="closedir"; + SCM l_closedir(port) SCM port; { int sts; - ASSERT(DIRP(port), port, ARG1, s_closedir); + ASRTER(DIRP(port), port, ARG1, s_closedir); DEFER_INTS; if CLOSEDP(port) {ALLOW_INTS;return BOOL_F;} SYSCALL(sts = closedir((DIR *)CDR(port));); @@ -381,10 +387,117 @@ sizet dir_free(p) if OPENP((SCM)p) closedir((DIR *)CDR((SCM)p)); return 0; } +# define dir_mark mark0 +# else /* _WIN32 */ +struct WDIR { + long handle; //-1 if at end of list. + struct _finddata_t info; + SCM fspec; //for rewind, needs gc protection. +}; -long tc16_dir; -static smobfuns dir_smob = {mark0, dir_free, dir_print, 0}; +SCM l_opendir(dirname) + SCM dirname; +{ + long handle; + SCM fspec, dir; + struct _finddata_t info; + struct WDIR *wdir; + int dlen; + ASRTER(NIMP(dirname) && STRINGP(dirname), dirname, ARG1, s_opendir); + dlen = LENGTH(dirname); + fspec = makstr(dlen + 2); + strcpy(CHARS(fspec), CHARS(dirname)); + if ('/' != CHARS(fspec)[dlen - 1] && '\\' != CHARS(fspec)[dlen - 1]) + CHARS(fspec)[dlen++] = '/'; + CHARS(fspec)[dlen++] = '*'; + CHARS(fspec)[dlen] = 0; + DEFER_INTS; + dir = must_malloc_cell(sizeof(struct WDIR)+0L, tc16_dir, s_opendir); + wdir = (struct WDIR*)CHARS(dir); + wdir->fspec = fspec; + SCM_OPENCALL(handle = _findfirst(CHARS(fspec), &(wdir->info))); + if (-1 == handle) {ALLOW_INTS; return BOOL_F;} + wdir->handle = handle; + CAR(dir) |= OPN; + ALLOW_INTS; + return dir; +} + +SCM l_readdir(port) + SCM port; +{ + SCM fname; + struct WDIR *wdir; + int ret; + ASRTER(OPDIRP(port), port, ARG1, s_readdir); + wdir = (struct WDIR*)CHARS(port); + if (-1 == wdir->handle) return BOOL_F; + fname = makfrom0str(wdir->info.name); + DEFER_INTS; + SYSCALL(ret = _findnext(wdir->handle, &(wdir->info));); + if (0 != ret) { + SYSCALL(_findclose(wdir->handle);); + wdir->handle = -1; + } + ALLOW_INTS; + return fname; +} + +SCM l_rewinddir(port) + SCM port; +{ + struct WDIR *wdir; + ASRTER(OPDIRP(port), port, ARG1, s_rewinddir); + wdir = (struct WDIR*)CHARS(port); + DEFER_INTS; + if (-1 != wdir->handle) + SYSCALL(_findclose(wdir->handle);); + SYSCALL(wdir->handle = _findfirst(CHARS(wdir->fspec), &(wdir->info));); + ALLOW_INTS; + return UNSPECIFIED; +} + +SCM l_closedir(port) + SCM port; +{ + struct WDIR *wdir; + ASRTER(DIRP(port), port, ARG1, s_closedir); + wdir = (struct WDIR*)CHARS(port); + DEFER_INTS; + if CLOSEDP(port) {ALLOW_INTS;return BOOL_F;} + if (-1 != wdir->handle) { + SYSCALL(_findclose(wdir->handle);); + wdir->handle = -1; + } + CAR(port) = tc16_dir; + wdir->fspec = UNSPECIFIED; + ALLOW_INTS; + return BOOL_T; +} + +int dir_print(sexp, port, writing) + SCM sexp; SCM port; int writing; +{ + prinport(sexp, port, "directory"); + return !0; +} +sizet dir_free(p) + CELLPTR p; +{ + struct WDIR *wdir = (struct WDIR*)CHARS((SCM)p); + if (-1 != wdir->handle) + _findclose(wdir->handle); + must_free(CHARS((SCM)p), (sizet)sizeof(struct WDIR)); + return 0; +} +SCM dir_mark(ptr) + SCM ptr; +{ + return ((struct WDIR*)CHARS(ptr))->fspec; +} # endif /* _WIN32 */ +long tc16_dir; +static smobfuns dir_smob = {dir_mark, dir_free, dir_print, 0}; # endif /* vms */ static char s_mkdir[] = "mkdir"; @@ -392,8 +505,8 @@ SCM l_mkdir(path, mode) SCM path, mode; { int val; - ASSERT(NIMP(path) && STRINGP(path), path, ARG1, s_mkdir); - ASSERT(INUMP(mode), mode, ARG2, s_mkdir); + ASRTER(NIMP(path) && STRINGP(path), path, ARG1, s_mkdir); + ASRTER(INUMP(mode), mode, ARG2, s_mkdir); # ifdef _WIN32 SYSCALL(val = mkdir(CHARS(path));); # else @@ -410,7 +523,7 @@ SCM l_rmdir(path) SCM path; { int val; - ASSERT(NIMP(path) && STRINGP(path), path, ARG1, s_rmdir); + ASRTER(NIMP(path) && STRINGP(path), path, ARG1, s_rmdir); # ifdef vms return del_fil(st_append(cons2(path, s_dot_dir, EOL))); # else @@ -426,7 +539,7 @@ SCM lchdir(str) SCM str; { int ans; - ASSERT(NIMP(str) && STRINGP(str), str, ARG1, s_chdir); + ASRTER(NIMP(str) && STRINGP(str), str, ARG1, s_chdir); SYSCALL(ans = chdir(CHARS(str));); return ans ? BOOL_F : BOOL_T; } @@ -453,8 +566,8 @@ SCM l_chmod(pathname, mode) SCM pathname, mode; { int val; - ASSERT(NIMP(pathname) && STRINGP(pathname), pathname, ARG1, s_chmod); - ASSERT(INUMP(mode), mode, ARG2, s_chmod); + ASRTER(NIMP(pathname) && STRINGP(pathname), pathname, ARG1, s_chmod); + ASRTER(INUMP(mode), mode, ARG2, s_chmod); SYSCALL(val = chmod(CHARS(pathname), INUM(mode));); return val ? BOOL_F : BOOL_T; } @@ -478,7 +591,7 @@ SCM l_utime(pathname, acctime, modtime) struct utimbuf utm_tmp; utm_tmp.actime = num2ulong(acctime, (char *)ARG2, s_utime); utm_tmp.modtime = num2ulong(modtime, (char *)ARG3, s_utime); - ASSERT(NIMP(pathname) && STRINGP(pathname), pathname, ARG1, s_utime); + ASRTER(NIMP(pathname) && STRINGP(pathname), pathname, ARG1, s_utime); SYSCALL(val = utime(CHARS(pathname), &utm_tmp);); return val ? BOOL_F : BOOL_T; } @@ -489,7 +602,7 @@ static char s_umask[] = "umask"; SCM l_umask(mode) SCM mode; { - ASSERT(INUMP(mode), mode, ARG1, s_umask); + ASRTER(INUMP(mode), mode, ARG1, s_umask); return MAKINUM(umask(INUM(mode))); } # endif @@ -501,8 +614,8 @@ SCM ren_fil(oldname, newname) SCM oldname, newname; { SCM ans; - ASSERT(NIMP(oldname) && STRINGP(oldname), oldname, ARG1, s_ren_fil); - ASSERT(NIMP(newname) && STRINGP(newname), newname, ARG2, s_ren_fil); + ASRTER(NIMP(oldname) && STRINGP(oldname), oldname, ARG1, s_ren_fil); + ASRTER(NIMP(newname) && STRINGP(newname), newname, ARG2, s_ren_fil); #if 1 /* def STDC_HEADERS */ SYSCALL(ans = (rename(CHARS(oldname), CHARS(newname))) ? BOOL_F: BOOL_T;); return ans; @@ -522,7 +635,7 @@ static char s_fileno[] = "fileno"; SCM l_fileno(port) SCM port; { - ASSERT(NIMP(port) && OPPORTP(port), port, ARG1, s_fileno); + ASRTER(NIMP(port) && OPPORTP(port), port, ARG1, s_fileno); if (tc16_fport != TYP16(port)) return BOOL_F; return MAKINUM(fileno(STREAM(port))); } @@ -540,10 +653,10 @@ SCM l_access(pathname, mode) { int val; int imodes; - ASSERT(NIMP(pathname) && STRINGP(pathname), pathname, ARG1, s_access); + ASRTER(NIMP(pathname) && STRINGP(pathname), pathname, ARG1, s_access); if INUMP(mode) imodes = INUM(mode); else { - ASSERT(NIMP(mode) && STRINGP(mode), mode, ARG2, s_access); + ASRTER(NIMP(mode) && STRINGP(mode), mode, ARG2, s_access); imodes = F_OK | (strchr(CHARS(mode), 'r') ? R_OK : 0) | (strchr(CHARS(mode), 'w') ? W_OK : 0) | (strchr(CHARS(mode), 'x') ? X_OK : 0); @@ -630,8 +743,8 @@ SCM i_execv(modes, path, args) { char **execargv; int i = ilength(args); - ASSERT(i>0, args, WNA, s_execv); - ASSERT(NIMP(path) && STRINGP(path), path, ARG1, s_execv); + ASRTER(i>0, args, WNA, s_execv); + ASRTER(NIMP(path) && STRINGP(path), path, ARG1, s_execv); /* dowinds(EOL); */ args = cons(path, args); DEFER_INTS; @@ -667,7 +780,7 @@ static char s_putenv[] = "putenv"; SCM l_putenv(str) SCM str; { - ASSERT(NIMP(str) && STRINGP(str), str, ARG1, s_putenv); + ASRTER(NIMP(str) && STRINGP(str), str, ARG1, s_putenv); return putenv(CHARS(str)) ? BOOL_F : BOOL_T; } # endif @@ -680,12 +793,10 @@ static iproc subr1s[] = { {s_fileno, l_fileno}, #ifndef MCH_AMIGA # ifndef vms -# ifndef _WIN32 {s_opendir, l_opendir}, {s_readdir, l_readdir}, {s_rewinddir, l_rewinddir}, {s_closedir, l_closedir}, -# endif # endif {s_rmdir, l_rmdir}, #endif @@ -734,11 +845,11 @@ SCM scm_try_create_file(fname, modes, perms) # else int cperms = 0666; # endif - ASSERT(NIMP(fname) && STRINGP(fname), fname, ARG1, s_try_create_file); - ASSERT(NIMP(modes) && (STRINGP(modes) || SYMBOLP(modes)), modes, ARG2, s_try_create_file); + ASRTER(NIMP(fname) && STRINGP(fname), fname, ARG1, s_try_create_file); + ASRTER(NIMP(modes) && (STRINGP(modes) || SYMBOLP(modes)), modes, ARG2, s_try_create_file); if (NNULLP(perms)) { perms = CAR(perms); - ASSERT(INUMP(perms), perms, ARG3, s_try_create_file); + ASRTER(INUMP(perms), perms, ARG3, s_try_create_file); # ifdef S_IROTH cperms = (mode_t)INUM(perms); # else @@ -746,7 +857,7 @@ SCM scm_try_create_file(fname, modes, perms) # endif } flags = mode_bits(CHARS(modes), cmodes); - ASSERT(flags, modes, ARG2, s_try_create_file); + ASRTER(flags, modes, ARG2, s_try_create_file); fdflags |= (RDNG & flags) ? O_RDWR : O_WRONLY; DEFER_INTS; SCM_OPENCALL(fd = open(CHARS(fname), fdflags, cperms)); @@ -768,6 +879,8 @@ static iproc subr2os[] = { {s_write_line, l_write_line}, {0, 0}}; +SCM_DLL_EXPORT void init_ioext P((void)); + void init_ioext() { init_iprocs(subr1os, tc7_subr_1o); @@ -787,8 +900,8 @@ void init_ioext() # ifndef vms # ifndef _WIN32 make_subr(s_utime, tc7_subr_3, l_utime); - tc16_dir = newsmob(&dir_smob); # endif + tc16_dir = newsmob(&dir_smob); # endif # endif #endif @@ -809,6 +922,11 @@ void init_ioext() add_feature("line-i/o"); scm_ldstr("\n\ (define (file-exists? path) (access path \"r\"))\n\ +(define (make-directory path)\n\ + (define umsk (umask 18))\n\ + (umask umsk)\n\ + (mkdir path (logxor #o777 umsk)))\n\ +(define current-directory getcwd)\n\ (define (directory-for-each proc dirname . args)\n\ (define dir (opendir (if (symbol? dirname)\n\ (symbol->string dirname)\n\ @@ -830,6 +948,17 @@ void init_ioext() (do ((filename (readdir dir) (readdir dir)))\n\ ((not filename) (closedir dir))\n\ (and (selector filename) (proc filename))))))\n\ +(define (system->line command . tmp)\n\ + (require 'filename)\n\ + (cond ((null? tmp)\n\ + (call-with-tmpnam\n\ + (lambda (tmp) (system->line command tmp))))\n\ + (else\n\ + (set! tmp (car tmp))\n\ + (and (zero? (system (string-append command \" > \" tmp)))\n\ + (file-exists? tmp)\n\ + (let ((line (call-with-input-file tmp read-line)))\n\ + (if (eof-object? line) \"\" line))))))\n\ "); - add_feature("directory-for-each"); + add_feature("directory"); } diff --git a/keysymdef.scm b/keysymdef.scm index d35fcc7..1329c4b 100644 --- a/keysymdef.scm +++ b/keysymdef.scm @@ -226,6 +226,8 @@ (define XK:dead-voiced-sound 65118) (define XK:dead-semivoiced-sound 65119) (define XK:dead-belowdot 65120) +(define XK:dead-hook 65121) +(define XK:dead-horn 65122) (define XK:First-Virtual-Screen 65232) (define XK:Prev-Virtual-Screen 65233) (define XK:Next-Virtual-Screen 65234) @@ -427,6 +429,7 @@ (define XK:Odiaeresis 214) (define XK:multiply 215) (define XK:Ooblique 216) +(define XK:Oslash 216) (define XK:Ugrave 217) (define XK:Uacute 218) (define XK:Ucircumflex 219) @@ -460,6 +463,7 @@ (define XK:odiaeresis 246) (define XK:division 247) (define XK:oslash 248) +(define XK:ooblique 248) (define XK:ugrave 249) (define XK:uacute 250) (define XK:ucircumflex 251) @@ -582,13 +586,340 @@ (define XK:uogonek 1017) (define XK:utilde 1021) (define XK:umacron 1022) +(define XK:Babovedot 4769) +(define XK:babovedot 4770) +(define XK:Dabovedot 4774) +(define XK:Wgrave 4776) +(define XK:Wacute 4778) +(define XK:dabovedot 4779) +(define XK:Ygrave 4780) +(define XK:Fabovedot 4784) +(define XK:fabovedot 4785) +(define XK:Mabovedot 4788) +(define XK:mabovedot 4789) +(define XK:Pabovedot 4791) +(define XK:wgrave 4792) +(define XK:pabovedot 4793) +(define XK:wacute 4794) +(define XK:Sabovedot 4795) +(define XK:ygrave 4796) +(define XK:Wdiaeresis 4797) +(define XK:wdiaeresis 4798) +(define XK:sabovedot 4799) +(define XK:Wcircumflex 4816) +(define XK:Tabovedot 4823) +(define XK:Ycircumflex 4830) +(define XK:wcircumflex 4848) +(define XK:tabovedot 4855) +(define XK:ycircumflex 4862) (define XK:OE 5052) (define XK:oe 5053) (define XK:Ydiaeresis 5054) +(define XK:overline 1150) +(define XK:kana-fullstop 1185) +(define XK:kana-openingbracket 1186) +(define XK:kana-closingbracket 1187) +(define XK:kana-comma 1188) +(define XK:kana-conjunctive 1189) +(define XK:kana-middledot 1189) +(define XK:kana-WO 1190) +(define XK:kana-a 1191) +(define XK:kana-i 1192) +(define XK:kana-u 1193) +(define XK:kana-e 1194) +(define XK:kana-o 1195) +(define XK:kana-ya 1196) +(define XK:kana-yu 1197) +(define XK:kana-yo 1198) +(define XK:kana-tsu 1199) +(define XK:kana-tu 1199) +(define XK:prolongedsound 1200) +(define XK:kana-A 1201) +(define XK:kana-I 1202) +(define XK:kana-U 1203) +(define XK:kana-E 1204) +(define XK:kana-O 1205) +(define XK:kana-KA 1206) +(define XK:kana-KI 1207) +(define XK:kana-KU 1208) +(define XK:kana-KE 1209) +(define XK:kana-KO 1210) +(define XK:kana-SA 1211) +(define XK:kana-SHI 1212) +(define XK:kana-SU 1213) +(define XK:kana-SE 1214) +(define XK:kana-SO 1215) +(define XK:kana-TA 1216) +(define XK:kana-CHI 1217) +(define XK:kana-TI 1217) +(define XK:kana-TSU 1218) +(define XK:kana-TU 1218) +(define XK:kana-TE 1219) +(define XK:kana-TO 1220) +(define XK:kana-NA 1221) +(define XK:kana-NI 1222) +(define XK:kana-NU 1223) +(define XK:kana-NE 1224) +(define XK:kana-NO 1225) +(define XK:kana-HA 1226) +(define XK:kana-HI 1227) +(define XK:kana-FU 1228) +(define XK:kana-HU 1228) +(define XK:kana-HE 1229) +(define XK:kana-HO 1230) +(define XK:kana-MA 1231) +(define XK:kana-MI 1232) +(define XK:kana-MU 1233) +(define XK:kana-ME 1234) +(define XK:kana-MO 1235) +(define XK:kana-YA 1236) +(define XK:kana-YU 1237) +(define XK:kana-YO 1238) +(define XK:kana-RA 1239) +(define XK:kana-RI 1240) +(define XK:kana-RU 1241) +(define XK:kana-RE 1242) +(define XK:kana-RO 1243) +(define XK:kana-WA 1244) +(define XK:kana-N 1245) +(define XK:voicedsound 1246) +(define XK:semivoicedsound 1247) +(define XK:kana-switch 65406) +(define XK:Farsi-0 1424) +(define XK:Farsi-1 1425) +(define XK:Farsi-2 1426) +(define XK:Farsi-3 1427) +(define XK:Farsi-4 1428) +(define XK:Farsi-5 1429) +(define XK:Farsi-6 1430) +(define XK:Farsi-7 1431) +(define XK:Farsi-8 1432) +(define XK:Farsi-9 1433) +(define XK:Arabic-percent 1445) +(define XK:Arabic-superscript-alef 1446) +(define XK:Arabic-tteh 1447) +(define XK:Arabic-peh 1448) +(define XK:Arabic-tcheh 1449) +(define XK:Arabic-ddal 1450) +(define XK:Arabic-rreh 1451) +(define XK:Arabic-comma 1452) +(define XK:Arabic-fullstop 1454) +(define XK:Arabic-0 1456) +(define XK:Arabic-1 1457) +(define XK:Arabic-2 1458) +(define XK:Arabic-3 1459) +(define XK:Arabic-4 1460) +(define XK:Arabic-5 1461) +(define XK:Arabic-6 1462) +(define XK:Arabic-7 1463) +(define XK:Arabic-8 1464) +(define XK:Arabic-9 1465) +(define XK:Arabic-semicolon 1467) +(define XK:Arabic-question-mark 1471) +(define XK:Arabic-hamza 1473) +(define XK:Arabic-maddaonalef 1474) +(define XK:Arabic-hamzaonalef 1475) +(define XK:Arabic-hamzaonwaw 1476) +(define XK:Arabic-hamzaunderalef 1477) +(define XK:Arabic-hamzaonyeh 1478) +(define XK:Arabic-alef 1479) +(define XK:Arabic-beh 1480) +(define XK:Arabic-tehmarbuta 1481) +(define XK:Arabic-teh 1482) +(define XK:Arabic-theh 1483) +(define XK:Arabic-jeem 1484) +(define XK:Arabic-hah 1485) +(define XK:Arabic-khah 1486) +(define XK:Arabic-dal 1487) +(define XK:Arabic-thal 1488) +(define XK:Arabic-ra 1489) +(define XK:Arabic-zain 1490) +(define XK:Arabic-seen 1491) +(define XK:Arabic-sheen 1492) +(define XK:Arabic-sad 1493) +(define XK:Arabic-dad 1494) +(define XK:Arabic-tah 1495) +(define XK:Arabic-zah 1496) +(define XK:Arabic-ain 1497) +(define XK:Arabic-ghain 1498) +(define XK:Arabic-tatweel 1504) +(define XK:Arabic-feh 1505) +(define XK:Arabic-qaf 1506) +(define XK:Arabic-kaf 1507) +(define XK:Arabic-lam 1508) +(define XK:Arabic-meem 1509) +(define XK:Arabic-noon 1510) +(define XK:Arabic-ha 1511) +(define XK:Arabic-heh 1511) +(define XK:Arabic-waw 1512) +(define XK:Arabic-alefmaksura 1513) +(define XK:Arabic-yeh 1514) +(define XK:Arabic-fathatan 1515) +(define XK:Arabic-dammatan 1516) +(define XK:Arabic-kasratan 1517) +(define XK:Arabic-fatha 1518) +(define XK:Arabic-damma 1519) +(define XK:Arabic-kasra 1520) +(define XK:Arabic-shadda 1521) +(define XK:Arabic-sukun 1522) +(define XK:Arabic-madda-above 1523) +(define XK:Arabic-hamza-above 1524) +(define XK:Arabic-hamza-below 1525) +(define XK:Arabic-jeh 1526) +(define XK:Arabic-veh 1527) +(define XK:Arabic-keheh 1528) +(define XK:Arabic-gaf 1529) +(define XK:Arabic-noon-ghunna 1530) +(define XK:Arabic-heh-doachashmee 1531) +(define XK:Farsi-yeh 1532) +(define XK:Arabic-farsi-yeh 1532) +(define XK:Arabic-yeh-baree 1533) +(define XK:Arabic-heh-goal 1534) +(define XK:Arabic-switch 65406) +(define XK:Cyrillic-GHE-bar 1664) +(define XK:Cyrillic-ghe-bar 1680) +(define XK:Cyrillic-ZHE-descender 1665) +(define XK:Cyrillic-zhe-descender 1681) +(define XK:Cyrillic-KA-descender 1666) +(define XK:Cyrillic-ka-descender 1682) +(define XK:Cyrillic-KA-vertstroke 1667) +(define XK:Cyrillic-ka-vertstroke 1683) +(define XK:Cyrillic-EN-descender 1668) +(define XK:Cyrillic-en-descender 1684) +(define XK:Cyrillic-U-straight 1669) +(define XK:Cyrillic-u-straight 1685) +(define XK:Cyrillic-U-straight-bar 1670) +(define XK:Cyrillic-u-straight-bar 1686) +(define XK:Cyrillic-HA-descender 1671) +(define XK:Cyrillic-ha-descender 1687) +(define XK:Cyrillic-CHE-descender 1672) +(define XK:Cyrillic-che-descender 1688) +(define XK:Cyrillic-CHE-vertstroke 1673) +(define XK:Cyrillic-che-vertstroke 1689) +(define XK:Cyrillic-SHHA 1674) +(define XK:Cyrillic-shha 1690) +(define XK:Cyrillic-SCHWA 1676) +(define XK:Cyrillic-schwa 1692) +(define XK:Cyrillic-I-macron 1677) +(define XK:Cyrillic-i-macron 1693) +(define XK:Cyrillic-O-bar 1678) +(define XK:Cyrillic-o-bar 1694) +(define XK:Cyrillic-U-macron 1679) +(define XK:Cyrillic-u-macron 1695) +(define XK:Serbian-dje 1697) +(define XK:Macedonia-gje 1698) +(define XK:Cyrillic-io 1699) +(define XK:Ukrainian-ie 1700) +(define XK:Ukranian-je 1700) +(define XK:Macedonia-dse 1701) +(define XK:Ukrainian-i 1702) +(define XK:Ukranian-i 1702) +(define XK:Ukrainian-yi 1703) +(define XK:Ukranian-yi 1703) +(define XK:Cyrillic-je 1704) +(define XK:Serbian-je 1704) +(define XK:Cyrillic-lje 1705) +(define XK:Serbian-lje 1705) +(define XK:Cyrillic-nje 1706) +(define XK:Serbian-nje 1706) +(define XK:Serbian-tshe 1707) +(define XK:Macedonia-kje 1708) +(define XK:Ukrainian-ghe-with-upturn 1709) +(define XK:Byelorussian-shortu 1710) +(define XK:Cyrillic-dzhe 1711) +(define XK:Serbian-dze 1711) +(define XK:numerosign 1712) +(define XK:Serbian-DJE 1713) +(define XK:Macedonia-GJE 1714) +(define XK:Cyrillic-IO 1715) +(define XK:Ukrainian-IE 1716) +(define XK:Ukranian-JE 1716) +(define XK:Macedonia-DSE 1717) +(define XK:Ukrainian-I 1718) +(define XK:Ukranian-I 1718) +(define XK:Ukrainian-YI 1719) +(define XK:Ukranian-YI 1719) +(define XK:Cyrillic-JE 1720) +(define XK:Serbian-JE 1720) +(define XK:Cyrillic-LJE 1721) +(define XK:Serbian-LJE 1721) +(define XK:Cyrillic-NJE 1722) +(define XK:Serbian-NJE 1722) +(define XK:Serbian-TSHE 1723) +(define XK:Macedonia-KJE 1724) +(define XK:Ukrainian-GHE-WITH-UPTURN 1725) +(define XK:Byelorussian-SHORTU 1726) +(define XK:Cyrillic-DZHE 1727) +(define XK:Serbian-DZE 1727) +(define XK:Cyrillic-yu 1728) +(define XK:Cyrillic-a 1729) +(define XK:Cyrillic-be 1730) +(define XK:Cyrillic-tse 1731) +(define XK:Cyrillic-de 1732) +(define XK:Cyrillic-ie 1733) +(define XK:Cyrillic-ef 1734) +(define XK:Cyrillic-ghe 1735) +(define XK:Cyrillic-ha 1736) +(define XK:Cyrillic-i 1737) +(define XK:Cyrillic-shorti 1738) +(define XK:Cyrillic-ka 1739) +(define XK:Cyrillic-el 1740) +(define XK:Cyrillic-em 1741) +(define XK:Cyrillic-en 1742) +(define XK:Cyrillic-o 1743) +(define XK:Cyrillic-pe 1744) +(define XK:Cyrillic-ya 1745) +(define XK:Cyrillic-er 1746) +(define XK:Cyrillic-es 1747) +(define XK:Cyrillic-te 1748) +(define XK:Cyrillic-u 1749) +(define XK:Cyrillic-zhe 1750) +(define XK:Cyrillic-ve 1751) +(define XK:Cyrillic-softsign 1752) +(define XK:Cyrillic-yeru 1753) +(define XK:Cyrillic-ze 1754) +(define XK:Cyrillic-sha 1755) +(define XK:Cyrillic-e 1756) +(define XK:Cyrillic-shcha 1757) +(define XK:Cyrillic-che 1758) +(define XK:Cyrillic-hardsign 1759) +(define XK:Cyrillic-YU 1760) +(define XK:Cyrillic-A 1761) +(define XK:Cyrillic-BE 1762) +(define XK:Cyrillic-TSE 1763) +(define XK:Cyrillic-DE 1764) +(define XK:Cyrillic-IE 1765) +(define XK:Cyrillic-EF 1766) +(define XK:Cyrillic-GHE 1767) +(define XK:Cyrillic-HA 1768) +(define XK:Cyrillic-I 1769) +(define XK:Cyrillic-SHORTI 1770) +(define XK:Cyrillic-KA 1771) +(define XK:Cyrillic-EL 1772) +(define XK:Cyrillic-EM 1773) +(define XK:Cyrillic-EN 1774) +(define XK:Cyrillic-O 1775) +(define XK:Cyrillic-PE 1776) +(define XK:Cyrillic-YA 1777) +(define XK:Cyrillic-ER 1778) +(define XK:Cyrillic-ES 1779) +(define XK:Cyrillic-TE 1780) +(define XK:Cyrillic-U 1781) +(define XK:Cyrillic-ZHE 1782) +(define XK:Cyrillic-VE 1783) +(define XK:Cyrillic-SOFTSIGN 1784) +(define XK:Cyrillic-YERU 1785) +(define XK:Cyrillic-ZE 1786) +(define XK:Cyrillic-SHA 1787) +(define XK:Cyrillic-E 1788) +(define XK:Cyrillic-SHCHA 1789) +(define XK:Cyrillic-CHE 1790) +(define XK:Cyrillic-HARDSIGN 1791) (define XK:Greek-ALPHAaccent 1953) (define XK:Greek-EPSILONaccent 1954) (define XK:Greek-ETAaccent 1955) (define XK:Greek-IOTAaccent 1956) +(define XK:Greek-IOTAdieresis 1957) (define XK:Greek-IOTAdiaeresis 1957) (define XK:Greek-OMICRONaccent 1959) (define XK:Greek-UPSILONaccent 1960) @@ -659,6 +990,503 @@ (define XK:Greek-psi 2040) (define XK:Greek-omega 2041) (define XK:Greek-switch 65406) +(define XK:hebrew-doublelowline 3295) +(define XK:hebrew-aleph 3296) +(define XK:hebrew-bet 3297) +(define XK:hebrew-beth 3297) +(define XK:hebrew-gimel 3298) +(define XK:hebrew-gimmel 3298) +(define XK:hebrew-dalet 3299) +(define XK:hebrew-daleth 3299) +(define XK:hebrew-he 3300) +(define XK:hebrew-waw 3301) +(define XK:hebrew-zain 3302) +(define XK:hebrew-zayin 3302) +(define XK:hebrew-chet 3303) +(define XK:hebrew-het 3303) +(define XK:hebrew-tet 3304) +(define XK:hebrew-teth 3304) +(define XK:hebrew-yod 3305) +(define XK:hebrew-finalkaph 3306) +(define XK:hebrew-kaph 3307) +(define XK:hebrew-lamed 3308) +(define XK:hebrew-finalmem 3309) +(define XK:hebrew-mem 3310) +(define XK:hebrew-finalnun 3311) +(define XK:hebrew-nun 3312) +(define XK:hebrew-samech 3313) +(define XK:hebrew-samekh 3313) +(define XK:hebrew-ayin 3314) +(define XK:hebrew-finalpe 3315) +(define XK:hebrew-pe 3316) +(define XK:hebrew-finalzade 3317) +(define XK:hebrew-finalzadi 3317) +(define XK:hebrew-zade 3318) +(define XK:hebrew-zadi 3318) +(define XK:hebrew-qoph 3319) +(define XK:hebrew-kuf 3319) +(define XK:hebrew-resh 3320) +(define XK:hebrew-shin 3321) +(define XK:hebrew-taw 3322) +(define XK:hebrew-taf 3322) +(define XK:Hebrew-switch 65406) +(define XK:Thai-kokai 3489) +(define XK:Thai-khokhai 3490) +(define XK:Thai-khokhuat 3491) +(define XK:Thai-khokhwai 3492) +(define XK:Thai-khokhon 3493) +(define XK:Thai-khorakhang 3494) +(define XK:Thai-ngongu 3495) +(define XK:Thai-chochan 3496) +(define XK:Thai-choching 3497) +(define XK:Thai-chochang 3498) +(define XK:Thai-soso 3499) +(define XK:Thai-chochoe 3500) +(define XK:Thai-yoying 3501) +(define XK:Thai-dochada 3502) +(define XK:Thai-topatak 3503) +(define XK:Thai-thothan 3504) +(define XK:Thai-thonangmontho 3505) +(define XK:Thai-thophuthao 3506) +(define XK:Thai-nonen 3507) +(define XK:Thai-dodek 3508) +(define XK:Thai-totao 3509) +(define XK:Thai-thothung 3510) +(define XK:Thai-thothahan 3511) +(define XK:Thai-thothong 3512) +(define XK:Thai-nonu 3513) +(define XK:Thai-bobaimai 3514) +(define XK:Thai-popla 3515) +(define XK:Thai-phophung 3516) +(define XK:Thai-fofa 3517) +(define XK:Thai-phophan 3518) +(define XK:Thai-fofan 3519) +(define XK:Thai-phosamphao 3520) +(define XK:Thai-moma 3521) +(define XK:Thai-yoyak 3522) +(define XK:Thai-rorua 3523) +(define XK:Thai-ru 3524) +(define XK:Thai-loling 3525) +(define XK:Thai-lu 3526) +(define XK:Thai-wowaen 3527) +(define XK:Thai-sosala 3528) +(define XK:Thai-sorusi 3529) +(define XK:Thai-sosua 3530) +(define XK:Thai-hohip 3531) +(define XK:Thai-lochula 3532) +(define XK:Thai-oang 3533) +(define XK:Thai-honokhuk 3534) +(define XK:Thai-paiyannoi 3535) +(define XK:Thai-saraa 3536) +(define XK:Thai-maihanakat 3537) +(define XK:Thai-saraaa 3538) +(define XK:Thai-saraam 3539) +(define XK:Thai-sarai 3540) +(define XK:Thai-saraii 3541) +(define XK:Thai-saraue 3542) +(define XK:Thai-sarauee 3543) +(define XK:Thai-sarau 3544) +(define XK:Thai-sarauu 3545) +(define XK:Thai-phinthu 3546) +(define XK:Thai-maihanakat-maitho 3550) +(define XK:Thai-baht 3551) +(define XK:Thai-sarae 3552) +(define XK:Thai-saraae 3553) +(define XK:Thai-sarao 3554) +(define XK:Thai-saraaimaimuan 3555) +(define XK:Thai-saraaimaimalai 3556) +(define XK:Thai-lakkhangyao 3557) +(define XK:Thai-maiyamok 3558) +(define XK:Thai-maitaikhu 3559) +(define XK:Thai-maiek 3560) +(define XK:Thai-maitho 3561) +(define XK:Thai-maitri 3562) +(define XK:Thai-maichattawa 3563) +(define XK:Thai-thanthakhat 3564) +(define XK:Thai-nikhahit 3565) +(define XK:Thai-leksun 3568) +(define XK:Thai-leknung 3569) +(define XK:Thai-leksong 3570) +(define XK:Thai-leksam 3571) +(define XK:Thai-leksi 3572) +(define XK:Thai-lekha 3573) +(define XK:Thai-lekhok 3574) +(define XK:Thai-lekchet 3575) +(define XK:Thai-lekpaet 3576) +(define XK:Thai-lekkao 3577) +(define XK:Hangul 65329) +(define XK:Hangul-Start 65330) +(define XK:Hangul-End 65331) +(define XK:Hangul-Hanja 65332) +(define XK:Hangul-Jamo 65333) +(define XK:Hangul-Romaja 65334) +(define XK:Hangul-Codeinput 65335) +(define XK:Hangul-Jeonja 65336) +(define XK:Hangul-Banja 65337) +(define XK:Hangul-PreHanja 65338) +(define XK:Hangul-PostHanja 65339) +(define XK:Hangul-SingleCandidate 65340) +(define XK:Hangul-MultipleCandidate 65341) +(define XK:Hangul-PreviousCandidate 65342) +(define XK:Hangul-Special 65343) +(define XK:Hangul-switch 65406) +(define XK:Hangul-Kiyeog 3745) +(define XK:Hangul-SsangKiyeog 3746) +(define XK:Hangul-KiyeogSios 3747) +(define XK:Hangul-Nieun 3748) +(define XK:Hangul-NieunJieuj 3749) +(define XK:Hangul-NieunHieuh 3750) +(define XK:Hangul-Dikeud 3751) +(define XK:Hangul-SsangDikeud 3752) +(define XK:Hangul-Rieul 3753) +(define XK:Hangul-RieulKiyeog 3754) +(define XK:Hangul-RieulMieum 3755) +(define XK:Hangul-RieulPieub 3756) +(define XK:Hangul-RieulSios 3757) +(define XK:Hangul-RieulTieut 3758) +(define XK:Hangul-RieulPhieuf 3759) +(define XK:Hangul-RieulHieuh 3760) +(define XK:Hangul-Mieum 3761) +(define XK:Hangul-Pieub 3762) +(define XK:Hangul-SsangPieub 3763) +(define XK:Hangul-PieubSios 3764) +(define XK:Hangul-Sios 3765) +(define XK:Hangul-SsangSios 3766) +(define XK:Hangul-Ieung 3767) +(define XK:Hangul-Jieuj 3768) +(define XK:Hangul-SsangJieuj 3769) +(define XK:Hangul-Cieuc 3770) +(define XK:Hangul-Khieuq 3771) +(define XK:Hangul-Tieut 3772) +(define XK:Hangul-Phieuf 3773) +(define XK:Hangul-Hieuh 3774) +(define XK:Hangul-A 3775) +(define XK:Hangul-AE 3776) +(define XK:Hangul-YA 3777) +(define XK:Hangul-YAE 3778) +(define XK:Hangul-EO 3779) +(define XK:Hangul-E 3780) +(define XK:Hangul-YEO 3781) +(define XK:Hangul-YE 3782) +(define XK:Hangul-O 3783) +(define XK:Hangul-WA 3784) +(define XK:Hangul-WAE 3785) +(define XK:Hangul-OE 3786) +(define XK:Hangul-YO 3787) +(define XK:Hangul-U 3788) +(define XK:Hangul-WEO 3789) +(define XK:Hangul-WE 3790) +(define XK:Hangul-WI 3791) +(define XK:Hangul-YU 3792) +(define XK:Hangul-EU 3793) +(define XK:Hangul-YI 3794) +(define XK:Hangul-I 3795) +(define XK:Hangul-J-Kiyeog 3796) +(define XK:Hangul-J-SsangKiyeog 3797) +(define XK:Hangul-J-KiyeogSios 3798) +(define XK:Hangul-J-Nieun 3799) +(define XK:Hangul-J-NieunJieuj 3800) +(define XK:Hangul-J-NieunHieuh 3801) +(define XK:Hangul-J-Dikeud 3802) +(define XK:Hangul-J-Rieul 3803) +(define XK:Hangul-J-RieulKiyeog 3804) +(define XK:Hangul-J-RieulMieum 3805) +(define XK:Hangul-J-RieulPieub 3806) +(define XK:Hangul-J-RieulSios 3807) +(define XK:Hangul-J-RieulTieut 3808) +(define XK:Hangul-J-RieulPhieuf 3809) +(define XK:Hangul-J-RieulHieuh 3810) +(define XK:Hangul-J-Mieum 3811) +(define XK:Hangul-J-Pieub 3812) +(define XK:Hangul-J-PieubSios 3813) +(define XK:Hangul-J-Sios 3814) +(define XK:Hangul-J-SsangSios 3815) +(define XK:Hangul-J-Ieung 3816) +(define XK:Hangul-J-Jieuj 3817) +(define XK:Hangul-J-Cieuc 3818) +(define XK:Hangul-J-Khieuq 3819) +(define XK:Hangul-J-Tieut 3820) +(define XK:Hangul-J-Phieuf 3821) +(define XK:Hangul-J-Hieuh 3822) +(define XK:Hangul-RieulYeorinHieuh 3823) +(define XK:Hangul-SunkyeongeumMieum 3824) +(define XK:Hangul-SunkyeongeumPieub 3825) +(define XK:Hangul-PanSios 3826) +(define XK:Hangul-KkogjiDalrinIeung 3827) +(define XK:Hangul-SunkyeongeumPhieuf 3828) +(define XK:Hangul-YeorinHieuh 3829) +(define XK:Hangul-AraeA 3830) +(define XK:Hangul-AraeAE 3831) +(define XK:Hangul-J-PanSios 3832) +(define XK:Hangul-J-KkogjiDalrinIeung 3833) +(define XK:Hangul-J-YeorinHieuh 3834) +(define XK:Korean-Won 3839) +(define XK:Armenian-eternity 5281) +(define XK:Armenian-ligature-ew 5282) +(define XK:Armenian-full-stop 5283) +(define XK:Armenian-verjaket 5283) +(define XK:Armenian-parenright 5284) +(define XK:Armenian-parenleft 5285) +(define XK:Armenian-guillemotright 5286) +(define XK:Armenian-guillemotleft 5287) +(define XK:Armenian-em-dash 5288) +(define XK:Armenian-dot 5289) +(define XK:Armenian-mijaket 5289) +(define XK:Armenian-separation-mark 5290) +(define XK:Armenian-but 5290) +(define XK:Armenian-comma 5291) +(define XK:Armenian-en-dash 5292) +(define XK:Armenian-hyphen 5293) +(define XK:Armenian-yentamna 5293) +(define XK:Armenian-ellipsis 5294) +(define XK:Armenian-exclam 5295) +(define XK:Armenian-amanak 5295) +(define XK:Armenian-accent 5296) +(define XK:Armenian-shesht 5296) +(define XK:Armenian-question 5297) +(define XK:Armenian-paruyk 5297) +(define XK:Armenian-AYB 5298) +(define XK:Armenian-ayb 5299) +(define XK:Armenian-BEN 5300) +(define XK:Armenian-ben 5301) +(define XK:Armenian-GIM 5302) +(define XK:Armenian-gim 5303) +(define XK:Armenian-DA 5304) +(define XK:Armenian-da 5305) +(define XK:Armenian-YECH 5306) +(define XK:Armenian-yech 5307) +(define XK:Armenian-ZA 5308) +(define XK:Armenian-za 5309) +(define XK:Armenian-E 5310) +(define XK:Armenian-e 5311) +(define XK:Armenian-AT 5312) +(define XK:Armenian-at 5313) +(define XK:Armenian-TO 5314) +(define XK:Armenian-to 5315) +(define XK:Armenian-ZHE 5316) +(define XK:Armenian-zhe 5317) +(define XK:Armenian-INI 5318) +(define XK:Armenian-ini 5319) +(define XK:Armenian-LYUN 5320) +(define XK:Armenian-lyun 5321) +(define XK:Armenian-KHE 5322) +(define XK:Armenian-khe 5323) +(define XK:Armenian-TSA 5324) +(define XK:Armenian-tsa 5325) +(define XK:Armenian-KEN 5326) +(define XK:Armenian-ken 5327) +(define XK:Armenian-HO 5328) +(define XK:Armenian-ho 5329) +(define XK:Armenian-DZA 5330) +(define XK:Armenian-dza 5331) +(define XK:Armenian-GHAT 5332) +(define XK:Armenian-ghat 5333) +(define XK:Armenian-TCHE 5334) +(define XK:Armenian-tche 5335) +(define XK:Armenian-MEN 5336) +(define XK:Armenian-men 5337) +(define XK:Armenian-HI 5338) +(define XK:Armenian-hi 5339) +(define XK:Armenian-NU 5340) +(define XK:Armenian-nu 5341) +(define XK:Armenian-SHA 5342) +(define XK:Armenian-sha 5343) +(define XK:Armenian-VO 5344) +(define XK:Armenian-vo 5345) +(define XK:Armenian-CHA 5346) +(define XK:Armenian-cha 5347) +(define XK:Armenian-PE 5348) +(define XK:Armenian-pe 5349) +(define XK:Armenian-JE 5350) +(define XK:Armenian-je 5351) +(define XK:Armenian-RA 5352) +(define XK:Armenian-ra 5353) +(define XK:Armenian-SE 5354) +(define XK:Armenian-se 5355) +(define XK:Armenian-VEV 5356) +(define XK:Armenian-vev 5357) +(define XK:Armenian-TYUN 5358) +(define XK:Armenian-tyun 5359) +(define XK:Armenian-RE 5360) +(define XK:Armenian-re 5361) +(define XK:Armenian-TSO 5362) +(define XK:Armenian-tso 5363) +(define XK:Armenian-VYUN 5364) +(define XK:Armenian-vyun 5365) +(define XK:Armenian-PYUR 5366) +(define XK:Armenian-pyur 5367) +(define XK:Armenian-KE 5368) +(define XK:Armenian-ke 5369) +(define XK:Armenian-O 5370) +(define XK:Armenian-o 5371) +(define XK:Armenian-FE 5372) +(define XK:Armenian-fe 5373) +(define XK:Armenian-apostrophe 5374) +(define XK:Armenian-section-sign 5375) +(define XK:Georgian-an 5584) +(define XK:Georgian-ban 5585) +(define XK:Georgian-gan 5586) +(define XK:Georgian-don 5587) +(define XK:Georgian-en 5588) +(define XK:Georgian-vin 5589) +(define XK:Georgian-zen 5590) +(define XK:Georgian-tan 5591) +(define XK:Georgian-in 5592) +(define XK:Georgian-kan 5593) +(define XK:Georgian-las 5594) +(define XK:Georgian-man 5595) +(define XK:Georgian-nar 5596) +(define XK:Georgian-on 5597) +(define XK:Georgian-par 5598) +(define XK:Georgian-zhar 5599) +(define XK:Georgian-rae 5600) +(define XK:Georgian-san 5601) +(define XK:Georgian-tar 5602) +(define XK:Georgian-un 5603) +(define XK:Georgian-phar 5604) +(define XK:Georgian-khar 5605) +(define XK:Georgian-ghan 5606) +(define XK:Georgian-qar 5607) +(define XK:Georgian-shin 5608) +(define XK:Georgian-chin 5609) +(define XK:Georgian-can 5610) +(define XK:Georgian-jil 5611) +(define XK:Georgian-cil 5612) +(define XK:Georgian-char 5613) +(define XK:Georgian-xan 5614) +(define XK:Georgian-jhan 5615) +(define XK:Georgian-hae 5616) +(define XK:Georgian-he 5617) +(define XK:Georgian-hie 5618) +(define XK:Georgian-we 5619) +(define XK:Georgian-har 5620) +(define XK:Georgian-hoe 5621) +(define XK:Georgian-fi 5622) +(define XK:Ccedillaabovedot 5794) +(define XK:Xabovedot 5795) +(define XK:Qabovedot 5797) +(define XK:Ibreve 5798) +(define XK:IE 5799) +(define XK:UO 5800) +(define XK:Zstroke 5801) +(define XK:Gcaron 5802) +(define XK:Obarred 5807) +(define XK:ccedillaabovedot 5810) +(define XK:xabovedot 5811) +(define XK:Ocaron 5812) +(define XK:qabovedot 5813) +(define XK:ibreve 5814) +(define XK:ie 5815) +(define XK:uo 5816) +(define XK:zstroke 5817) +(define XK:gcaron 5818) +(define XK:ocaron 5821) +(define XK:obarred 5823) +(define XK:SCHWA 5830) +(define XK:schwa 5878) +(define XK:Lbelowdot 5841) +(define XK:Lstrokebelowdot 5842) +(define XK:lbelowdot 5857) +(define XK:lstrokebelowdot 5858) +(define XK:Gtilde 5843) +(define XK:gtilde 5859) +(define XK:Abelowdot 7840) +(define XK:abelowdot 7841) +(define XK:Ahook 7842) +(define XK:ahook 7843) +(define XK:Acircumflexacute 7844) +(define XK:acircumflexacute 7845) +(define XK:Acircumflexgrave 7846) +(define XK:acircumflexgrave 7847) +(define XK:Acircumflexhook 7848) +(define XK:acircumflexhook 7849) +(define XK:Acircumflextilde 7850) +(define XK:acircumflextilde 7851) +(define XK:Acircumflexbelowdot 7852) +(define XK:acircumflexbelowdot 7853) +(define XK:Abreveacute 7854) +(define XK:abreveacute 7855) +(define XK:Abrevegrave 7856) +(define XK:abrevegrave 7857) +(define XK:Abrevehook 7858) +(define XK:abrevehook 7859) +(define XK:Abrevetilde 7860) +(define XK:abrevetilde 7861) +(define XK:Abrevebelowdot 7862) +(define XK:abrevebelowdot 7863) +(define XK:Ebelowdot 7864) +(define XK:ebelowdot 7865) +(define XK:Ehook 7866) +(define XK:ehook 7867) +(define XK:Etilde 7868) +(define XK:etilde 7869) +(define XK:Ecircumflexacute 7870) +(define XK:ecircumflexacute 7871) +(define XK:Ecircumflexgrave 7872) +(define XK:ecircumflexgrave 7873) +(define XK:Ecircumflexhook 7874) +(define XK:ecircumflexhook 7875) +(define XK:Ecircumflextilde 7876) +(define XK:ecircumflextilde 7877) +(define XK:Ecircumflexbelowdot 7878) +(define XK:ecircumflexbelowdot 7879) +(define XK:Ihook 7880) +(define XK:ihook 7881) +(define XK:Ibelowdot 7882) +(define XK:ibelowdot 7883) +(define XK:Obelowdot 7884) +(define XK:obelowdot 7885) +(define XK:Ohook 7886) +(define XK:ohook 7887) +(define XK:Ocircumflexacute 7888) +(define XK:ocircumflexacute 7889) +(define XK:Ocircumflexgrave 7890) +(define XK:ocircumflexgrave 7891) +(define XK:Ocircumflexhook 7892) +(define XK:ocircumflexhook 7893) +(define XK:Ocircumflextilde 7894) +(define XK:ocircumflextilde 7895) +(define XK:Ocircumflexbelowdot 7896) +(define XK:ocircumflexbelowdot 7897) +(define XK:Ohornacute 7898) +(define XK:ohornacute 7899) +(define XK:Ohorngrave 7900) +(define XK:ohorngrave 7901) +(define XK:Ohornhook 7902) +(define XK:ohornhook 7903) +(define XK:Ohorntilde 7904) +(define XK:ohorntilde 7905) +(define XK:Ohornbelowdot 7906) +(define XK:ohornbelowdot 7907) +(define XK:Ubelowdot 7908) +(define XK:ubelowdot 7909) +(define XK:Uhook 7910) +(define XK:uhook 7911) +(define XK:Uhornacute 7912) +(define XK:uhornacute 7913) +(define XK:Uhorngrave 7914) +(define XK:uhorngrave 7915) +(define XK:Uhornhook 7916) +(define XK:uhornhook 7917) +(define XK:Uhorntilde 7918) +(define XK:uhorntilde 7919) +(define XK:Uhornbelowdot 7920) +(define XK:uhornbelowdot 7921) +(define XK:Ybelowdot 7924) +(define XK:ybelowdot 7925) +(define XK:Yhook 7926) +(define XK:yhook 7927) +(define XK:Ytilde 7928) +(define XK:ytilde 7929) +(define XK:Ohorn 7930) +(define XK:ohorn 7931) +(define XK:Uhorn 7932) +(define XK:uhorn 7933) +(define XK:combining-tilde 7839) +(define XK:combining-grave 7922) +(define XK:combining-acute 7923) +(define XK:combining-hook 7934) +(define XK:combining-belowdot 7935) (define XK:EcuSign 8352) (define XK:ColonSign 8353) (define XK:CruzeiroSign 8354) diff --git a/mkimpcat.scm b/mkimpcat.scm index f94f949..df6c813 100644 --- a/mkimpcat.scm +++ b/mkimpcat.scm @@ -44,6 +44,7 @@ (let ((catname "implcat") (iv (implementation-vicinity))) (define (in-implementation-vicinity . paths) (apply in-vicinity iv paths)) + (define (in-installation-vicinity . paths) (apply in-vicinity "/usr/lib/scm/" paths)) (call-with-output-file (in-implementation-vicinity catname) (lambda (op) (define (display* . args) @@ -82,11 +83,15 @@ (in-implementation-vicinity "ioext" link:able-suffix) (usr:lib "c")) (add-alias 'directory-for-each 'i/o-extensions) + (add-alias 'directory 'i/o-extensions) (add-alias 'line-i/o 'i/o-extensions) (add-alias 'pipe 'i/o-extensions))) (cond ((add-link 'rev2-procedures (in-implementation-vicinity "sc2" link:able-suffix)))) + (cond ((add-link 'byte + (in-implementation-vicinity "byte" + link:able-suffix)))) (cond ((or (add-link 'db (in-wb-vicinity "db.so")) @@ -104,6 +109,8 @@ (usr:lib "c"))) (add-source 'wb-table (in-wb-vicinity "wbtab")) + (add-source 'rwb-isam + (in-wb-vicinity "rwb-isam")) (add-alias 'wb 'db))) (cond ((add-link 'mysql (in-implementation-vicinity "database" @@ -182,27 +189,22 @@ (add-alias '3rs 'r3rs) (add-alias '4rs 'r4rs) (add-alias '5rs 'r5rs) - (add-alias 'hobbit (in-implementation-vicinity "hobbit")) - (add-alias 'scmhob (in-implementation-vicinity "scmhob")) - (add-alias 'regex-case (in-implementation-vicinity "rgxcase")) - (add-alias 'url-filename (in-implementation-vicinity "urlfile")) - (add-source 'disarm (in-implementation-vicinity + (add-alias 'hobbit (in-installation-vicinity "hobbit")) + (add-alias 'scmhob (in-installation-vicinity "scmhob")) + (add-alias 'regex-case (in-installation-vicinity "rgxcase")) + (add-alias 'url-filename (in-installation-vicinity "urlfile")) + (add-source 'disarm (in-installation-vicinity (string-append "disarm" (scheme-file-suffix)))) - (add-source 'build (in-implementation-vicinity "build")) - (add-source 'compile (in-implementation-vicinity + (add-source 'build (in-installation-vicinity "build")) + (add-source 'compile (in-installation-vicinity (string-append "compile" (scheme-file-suffix)))) (display* ")") ) - (begin - ;; Messy because this trait has no C-installed feature name - (display* "#.(if (defined? renamed-identifier)") - (display* " '(") - (display " " op) - (add-source 'macro (in-implementation-vicinity "Macro")) - (display* " )") - (display* " '())") - ) + (display* "#+" 'primitive-hygiene) + (display* "(") + (add-source 'macro (in-installation-vicinity "Macro")) + (display* ")") (add-links 'dld (lambda (lib) (string-append "/usr/lib/lib" lib ".a")) @@ -229,4 +231,8 @@ (lambda (lib) #f) (lambda (lib) #f) ".so") + (add-links 'win32-dl + (lambda (lib) #f) + (lambda (lib) #f) + ".dll") ))) @@ -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=5d6 +VERSION=5d9 #endif #ifndef SCMVERSION -# define SCMVERSION "5d6" +# define SCMVERSION "5d9" #endif #ifdef nosve # define INIT_FILE_NAME "Init"SCMVERSION"_scm"; diff --git a/platform.txi b/platform.txi new file mode 100644 index 0000000..d7b3d13 --- /dev/null +++ b/platform.txi @@ -0,0 +1,47 @@ +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 @@ -57,14 +57,15 @@ #else /* added by Denys Duchier */ # ifdef SVR4 # include <unistd.h> -# else -# ifdef linux -# include <unistd.h> -# else -# ifdef __OpenBSD__ -# include <unistd.h> -# endif -# endif +# endif +# ifdef linux +# include <unistd.h> +# endif +# ifdef __OpenBSD__ +# include <unistd.h> +# endif +# ifdef __NetBSD__ +# include <unistd.h> # endif #endif @@ -73,9 +74,9 @@ SCM l_chown(path, owner, group) SCM path, owner, group; { int val; - ASSERT(NIMP(path) && STRINGP(path), path, ARG1, s_chown); - ASSERT(INUMP(owner), owner, ARG2, s_chown); - ASSERT(INUMP(group), group, ARG3, s_chown); + ASRTER(NIMP(path) && STRINGP(path), path, ARG1, s_chown); + ASRTER(INUMP(owner), owner, ARG2, s_chown); + ASRTER(INUMP(group), group, ARG3, s_chown); SYSCALL(val = chown(CHARS(path), INUM(owner), INUM(group));); return val ? BOOL_F : BOOL_T; } @@ -85,8 +86,8 @@ SCM l_link(oldpath, newpath) SCM oldpath, newpath; { int val; - ASSERT(NIMP(oldpath) && STRINGP(oldpath), oldpath, ARG1, s_link); - ASSERT(NIMP(newpath) && STRINGP(newpath), newpath, ARG2, s_link); + ASRTER(NIMP(oldpath) && STRINGP(oldpath), oldpath, ARG1, s_link); + ASRTER(NIMP(newpath) && STRINGP(newpath), newpath, ARG2, s_link); SYSCALL(val = link(CHARS(oldpath), CHARS(newpath));); return val ? BOOL_F : BOOL_T; } @@ -124,8 +125,8 @@ SCM open_pipe(pipestr, modes) { FILE *f; register SCM z; - ASSERT(NIMP(pipestr) && STRINGP(pipestr), pipestr, ARG1, s_op_pipe); - ASSERT(NIMP(modes) && (STRINGP(modes) || SYMBOLP(modes)), modes, ARG2, s_op_pipe); + ASRTER(NIMP(pipestr) && STRINGP(pipestr), pipestr, ARG1, s_op_pipe); + ASRTER(NIMP(modes) && (STRINGP(modes) || SYMBOLP(modes)), modes, ARG2, s_op_pipe); NEWCELL(z); /* DEFER_INTS, SYSCALL, and ALLOW_INTS are probably paranoid here*/ DEFER_INTS; @@ -180,7 +181,7 @@ SCM l_pwinfo(user) if UNBNDP(user) SYSCALL(entry = getpwent();); else if INUMP(user) SYSCALL(entry = getpwuid(INUM(user));); else { - ASSERT(NIMP(user) && STRINGP(user), user, ARG1, s_pwinfo); + ASRTER(NIMP(user) && STRINGP(user), user, ARG1, s_pwinfo); SYSCALL(entry = getpwnam(CHARS(user));); } ALLOW_INTS; @@ -206,7 +207,7 @@ SCM l_grinfo(name) if UNBNDP(name) SYSCALL(entry = getgrent();); else if INUMP(name) SYSCALL(entry = getgrgid(INUM(name));); else { - ASSERT(NIMP(name) && STRINGP(name), name, ARG1, s_grinfo); + ASRTER(NIMP(name) && STRINGP(name), name, ARG1, s_grinfo); SYSCALL(entry = getgrnam(CHARS(name));); } ALLOW_INTS; @@ -237,8 +238,8 @@ SCM l_kill(pid, sig) SCM pid, sig; { int i; - ASSERT(INUMP(pid), pid, ARG1, s_kill); - ASSERT(INUMP(sig), sig, ARG2, s_kill); + ASRTER(INUMP(pid), pid, ARG1, s_kill); + ASRTER(INUMP(sig), sig, ARG2, s_kill); SYSCALL(i = kill((int)INUM(pid), (int)INUM(sig));); return MAKINUM(0L+i); } @@ -247,8 +248,8 @@ SCM l_waitpid(pid, options) SCM pid, options; { int i, status; - ASSERT(INUMP(pid), pid, ARG1, s_waitpid); - ASSERT(INUMP(options), options, ARG2, s_waitpid); + ASRTER(INUMP(pid), pid, ARG1, s_waitpid); + ASRTER(INUMP(options), options, ARG2, s_waitpid); SYSCALL(i = waitpid(INUM(pid), &status, INUM(options));); return i < 0 ? BOOL_F : MAKINUM(0L+status); } @@ -258,10 +259,6 @@ SCM l_getppid() return MAKINUM(0L+getppid()); } -SCM scm_getlogin() -{ - return makfrom0str(getlogin()); -} SCM l_getuid() { return MAKINUM(0L+getuid()); @@ -285,14 +282,14 @@ static char s_setuid[] = "setuid"; SCM l_setuid(id) SCM id; { - ASSERT(INUMP(id), id, ARG1, s_setuid); + ASRTER(INUMP(id), id, ARG1, s_setuid); return setuid(INUM(id)) ? BOOL_F : BOOL_T; } static char s_setgid[] = "setgid"; SCM l_setgid(id) SCM id; { - ASSERT(INUMP(id), id, ARG1, s_setgid); + ASRTER(INUMP(id), id, ARG1, s_setgid); return setgid(INUM(id)) ? BOOL_F : BOOL_T; } @@ -301,14 +298,14 @@ static char s_seteuid[] = "seteuid"; SCM l_seteuid(id) SCM id; { - ASSERT(INUMP(id), id, ARG1, s_seteuid); + ASRTER(INUMP(id), id, ARG1, s_seteuid); return seteuid(INUM(id)) ? BOOL_F : BOOL_T; } static char s_setegid[] = "setegid"; SCM l_setegid(id) SCM id; { - ASSERT(INUMP(id), id, ARG1, s_setegid); + ASRTER(INUMP(id), id, ARG1, s_setegid); return setegid(INUM(id)) ? BOOL_F : BOOL_T; } #endif @@ -318,7 +315,7 @@ SCM l_ttyname(port) SCM port; { char *ans; - ASSERT(NIMP(port) && OPPORTP(port), port, ARG1, s_ttyname); + ASRTER(NIMP(port) && OPPORTP(port), port, ARG1, s_ttyname); if (tc16_fport != TYP16(port)) return BOOL_F; SYSCALL(ans = ttyname(fileno(STREAM(port)));); /* ans could be overwritten by another call to ttyname */ @@ -351,7 +348,6 @@ static iproc subr0s[] = { {"pipe", l_pipe}, {scm_s_getgroups, scm_getgroups}, {"getppid", l_getppid}, - {"getlogin", scm_getlogin}, {"getuid", l_getuid}, {"getgid", l_getgid}, #ifndef LACK_E_IDs @@ -405,8 +401,11 @@ void init_posix() scm_ldstr("\n\ (define (open-input-pipe cmd) (open-pipe cmd \"r\"))\n\ (define (open-output-pipe cmd) (open-pipe cmd \"w\"))\n\ -(define getlogin\n\ - (let ((getlogin getlogin))\n\ - (lambda () (or (getlogin) (getenv \"USER\") (getenv \"LOGNAME\")))))\n\ +(define (system->line command . tmp)\n\ + (define line\n\ + (call-with-open-ports\n\ + read-line\n\ + (open-input-pipe command)))\n\ + (if (eof-object? line) \"\" line))\n\ "); } diff --git a/r4rstest.scm b/r4rstest.scm index 3683f0d..f6f3ae0 100644 --- a/r4rstest.scm +++ b/r4rstest.scm @@ -1,4 +1,4 @@ -;; Copyright (C) 1991, 1992, 1993, 1994, 1995, 2000 Free Software Foundation, Inc. +;; Copyright (C) 1991, 1992, 1993, 1994, 1995, 2000, 2003 Free Software Foundation, Inc. ;; ;; This program is free software; you can redistribute it and/or modify it ;; under the terms of the GNU General Public License as published by the @@ -30,16 +30,16 @@ ;;; There are three optional tests: ;;; (TEST-CONT) tests multiple returns from call-with-current-continuation -;;; +;;; ;;; (TEST-SC4) tests procedures required by R4RS but not by IEEE -;;; +;;; ;;; (TEST-DELAY) tests DELAY and FORCE, which are not required by ;;; either standard. ;;; If you are testing a R3RS version which does not have `list?' do: ;;; (define list? #f) -;;; send corrections or additions to jaffer @ai.mit.edu +;;; send corrections or additions to agj @ alum.mit.edu (define cur-section '())(define errs '()) (define SECTION (lambda args @@ -224,7 +224,7 @@ `((foo ,(- 10 3)) ,@(cdr '(c)) . ,(car '(cons)))) ;;; sqt is defined here because not all implementations are required to -;;; support it. +;;; support it. (define (sqt x) (do ((i 0 (+ i 1))) ((> (* i i) x) (- i 1)))) @@ -557,6 +557,21 @@ (test 288 lcm 32 -36) (test 1 lcm) +(SECTION 6 5 5) +;;; Implementations which don't allow division by 0 can have fragile +;;; string->number. +(define (test-string->number str) + (define ans (string->number str)) + (cond ((not ans) #t) ((number? ans) #t) (else ans))) +(for-each (lambda (str) (test #t test-string->number str)) + '("+#.#" "-#.#" "#.#" "1/0" "-1/0" "0/0" + "+1/0i" "-1/0i" "0/0i" "0/0-0/0i" "1/0-1/0i" "-1/0+1/0i" + "#i" "#e" "#" "#i0/0")) +(cond ((number? (string->number "1+1i")) ;More kawa bait + (test #t number? (string->number "#i-i")) + (test #t number? (string->number "#i+i")) + (test #t number? (string->number "#i2+i")))) + ;;;;From: fred@sce.carleton.ca (Fred J Kaudel) ;;; Modified by jaffer. (define (test-inexact) @@ -574,11 +589,17 @@ (newline) (display ";testing inexact numbers; ") (newline) + (SECTION 6 2) + (test #f eqv? 1 f1.0) + (test #f eqv? 0 f0.0) (SECTION 6 5 5) (test #t inexact? f3.9) - (test #t 'inexact? (inexact? (max f3.9 4))) - (test f4.0 'max (max f3.9 4)) - (test f4.0 'exact->inexact (exact->inexact 4)) + (test #t 'max (inexact? (max f3.9 4))) + (test f4.0 max f3.9 4) + (test f4.0 exact->inexact 4) + (test f4.0 exact->inexact 4.0) + (test 4 inexact->exact 4) + (test 4 inexact->exact 4.0) (test (- f4.0) round (- f4.5)) (test (- f4.0) round (- f3.5)) (test (- f4.0) round (- f3.9)) @@ -618,14 +639,14 @@ (define log2 (let ((l2 (log 2))) (lambda (x) (/ (log x) l2)))) - + (define (slow-frexp x) (if (zero? x) (list f0.0 0) (let* ((l2 (log2 x)) (e (floor (log2 x))) (e (if (= l2 e) - (inexact->exact e) + (inexact->exact e) (+ (inexact->exact e) 1))) (f (/ x (expt 2 e)))) (list f e)))) @@ -649,7 +670,7 @@ minval eps))) (slow-frexp x))))) - + (define (float-print-test x) (define (testit number) (eqv? number (string->number (number->string number)))) @@ -671,7 +692,7 @@ (define (mult-float-print-test x) (let ((res #t)) - (for-each + (for-each (lambda (mult) (or (float-print-test (* mult x)) (set! res #f))) (map string->number @@ -682,7 +703,7 @@ (SECTION 6 5 6) (test #t 'float-print-test (float-print-test f0.0)) (test #t 'mult-float-print-test (mult-float-print-test f1.0)) - (test #t 'mult-float-print-test (mult-float-print-test + (test #t 'mult-float-print-test (mult-float-print-test (string->number "3.0"))) (test #t 'mult-float-print-test (mult-float-print-test (string->number "7.0"))) @@ -1023,15 +1044,15 @@ (test '(1 2 3) map * '(1 2 3)) (test '(-1 -2 -3) map - '(1 2 3)) (test '#(0 1 4 9 16) 'for-each - (let ((v (make-vector 5))) - (for-each (lambda (i) (vector-set! v i (* i i))) - '(0 1 2 3 4)) - v)) + (let ((v (make-vector 5))) + (for-each (lambda (i) (vector-set! v i (* i i))) + '(0 1 2 3 4)) + v)) (test -3 call-with-current-continuation - (lambda (exit) - (for-each (lambda (x) (if (negative? x) (exit x))) - '(54 0 37 -3 245 19)) - #t)) + (lambda (exit) + (for-each (lambda (x) (if (negative? x) (exit x))) + '(54 0 37 -3 245 19)) + #t)) (define list-length (lambda (obj) (call-with-current-continuation @@ -1049,7 +1070,7 @@ ;;; other than escape procedures. I am indebted to ;;; raja@copper.ucs.indiana.edu (Raja Sooriamurthi) for fixing this ;;; code. The function leaf-eq? compares the leaves of 2 arbitrary -;;; trees constructed of conses. +;;; trees constructed of conses. (define (next-leaf-generator obj eot) (letrec ((return #f) (cont (lambda (x) @@ -1191,7 +1212,7 @@ (report-errs)) (report-errs) -(let ((have-inexacts? +(let ((have-inexacts? (and (string->number "0.0") (inexact? (string->number "0.0")))) (have-bignums? (let ((n (string->number "281474976710655325431"))) @@ -44,6 +44,8 @@ #include "scm.h" +SCM sc2array P((SCM s, SCM ra, SCM prot)); + typedef struct { char *name; SCM sproc; @@ -206,7 +208,7 @@ int ramapc(cproc, data, ra0, lra, what) long *indv = &auto_indv[0]; if (ARRAY_NDIM(ra0) >= 5) { scm_protect_temp(&hp_indv); - hp_indv = make_uve(ARRAY_NDIM(ra0)+0L, MAKINUM(-1L)); + hp_indv = make_uve(ARRAY_NDIM(ra0)+0L, MAKINUM(-32L)); indv = (long *)VELTS(hp_indv); } vra0 = make_ra(1); @@ -278,7 +280,6 @@ int ramapc(cproc, data, ra0, lra, what) } } -static char s_array_fill[] = "array-fill!"; SCM array_fill(ra, fill) SCM ra, fill; { @@ -444,7 +445,7 @@ SCM array_copy(src, dst) { #ifndef RECKLESS if (INUM0==array_rank(dst)) - ASSERT(NIMP(dst) && ARRAYP(dst) && INUM0==array_rank(src), + ASRTER(NIMP(dst) && ARRAYP(dst) && INUM0==array_rank(src), dst, ARG2, s_array_copy); #endif ramapc(racp, UNDEFINED, src, cons(dst, EOL), s_array_copy); @@ -512,7 +513,7 @@ SCM sc2array(s, ra, prot) SCM s, ra, prot; { SCM res; - ASSERT(NIMP(ra), ra, ARG2, s_sc2array); + ASRTER(NIMP(ra), ra, ARG2, s_sc2array); if ARRAYP(ra) { int k = ARRAY_NDIM(ra); res = make_ra(k); @@ -524,7 +525,7 @@ SCM sc2array(s, ra, prot) ra = ARRAY_V(ra); } else { - ASSERT(BOOL_T==arrayp(ra, UNDEFINED), ra, ARG2, s_sc2array); + ASRTER(BOOL_T==arrayp(ra, UNDEFINED), ra, ARG2, s_sc2array); res = make_ra(1); ARRAY_DIMS(res)->ubnd = LENGTH(ra) - 1; ARRAY_DIMS(res)->lbnd = 0; @@ -1433,7 +1434,7 @@ SCM array_imap(ra, proc) long auto_indv[5]; long *indv = &auto_indv[0]; sizet i; - ASSERT(NIMP(ra), ra, ARG1, s_array_imap); + ASRTER(NIMP(ra), ra, ARG1, s_array_imap); i = INUM(array_rank(ra)); #ifndef RECKLESS scm_arity_check(proc, i+0L, s_array_imap); @@ -1443,7 +1444,7 @@ SCM array_imap(ra, proc) scm_protect_temp(&hp_indv); hp_av = make_vector(MAKINUM(i), BOOL_F); av = VELTS(hp_av); - hp_indv = make_uve(i+0L, MAKINUM(-1L)); + hp_indv = make_uve(i+0L, MAKINUM(-32L)); indv = (long *)VELTS(hp_indv); } switch TYP7(ra) { @@ -1662,6 +1663,8 @@ static void init_raprocs(subra) subra->sproc = CDR(sysintern(subra->name, UNDEFINED)); } +SCM_DLL_EXPORT void init_ramap P((void)); + void init_ramap() { init_raprocs(ra_rpsubrs); @@ -1677,5 +1680,9 @@ scm_ldstr("\n\ (let ((ra0 (apply create-array '#() (array-shape ra))))\n\ (array-index-map! ra0 list)\n\ ra0))\n\ +(define (array-map prototype proc ra1 . ras)\n\ + (define nra (apply create-array prototype (array-shape ra1)))\n\ + (apply array-map! nra proc ra1 ras)\n\ + nra)\n\ "); } @@ -68,7 +68,7 @@ static SCM the_rtd_rtd; arrays will be available when the dll is loaded */ #ifdef ARRAYS # ifndef DLL -# define MAKE_REC_INDS(n) make_uve((long)n, MAKINUM(1)) +# define MAKE_REC_INDS(n) make_uve((long)n, MAKINUM(32L)) # define REC_IND_REF(x, i) VELTS(x)[(i)] # define REC_IND_SET(x, i, val) VELTS(x)[(i)] = (val) # endif @@ -99,7 +99,7 @@ SCM rec_pred(rtd) SCM rtd; { SCM cclo = makcclo(f_rec_pred1, 2L); - ASSERT(NIMP(rtd) && RTDP(rtd), rtd, ARG1, s_rec_pred); + ASRTER(NIMP(rtd) && RTDP(rtd), rtd, ARG1, s_rec_pred); RCLO_RTD(cclo) = rtd; return cclo; } @@ -121,7 +121,7 @@ SCM rec_constr(rtd, flds) SCM cclo = makcclo(f_rec_constr1, 4L); SCM indices; sizet i, j; - ASSERT(NIMP(rtd) && RTDP(rtd), rtd, ARG1, s_rec_constr); + ASRTER(NIMP(rtd) && RTDP(rtd), rtd, ARG1, s_rec_constr); RCLO_RTD(cclo) = rtd; i = ilength(RTD_FIELDS(rtd)); RCONSTR_SIZE(cclo) = MAKINUM(i); @@ -131,14 +131,14 @@ SCM rec_constr(rtd, flds) } else { i = ilength(flds); - ASSERT(i>=0, flds, ARG2, s_rec_constr); + ASRTER(i>=0, flds, ARG2, s_rec_constr); indices = MAKE_REC_INDS(i); for(i = 0; NIMP(flds); i++, flds = CDR(flds)) { fld = CAR(flds); - ASSERT(NIMP(fld) && SYMBOLP(fld), fld, ARG2, s_rec_constr); + ASRTER(NIMP(fld) && SYMBOLP(fld), fld, ARG2, s_rec_constr); flst = RTD_FIELDS(rtd); for (j = 0; ; j++, flst = CDR(flst)) { - ASSERT(NNULLP(flst), fld, ARG2, s_rec_constr); + ASRTER(NNULLP(flst), fld, ARG2, s_rec_constr); if (fld==CAR(flst)) { REC_IND_SET(indices, i, j+1); break; @@ -204,12 +204,12 @@ static SCM makrecclo(proc, rtd, field, what) SCM flst; SCM cclo = makcclo(proc, 3L); int i; - ASSERT(NIMP(rtd) && RTDP(rtd), rtd, ARG1, what); - ASSERT(NIMP(field) && SYMBOLP(field), field, ARG2, what); + ASRTER(NIMP(rtd) && RTDP(rtd), rtd, ARG1, what); + ASRTER(NIMP(field) && SYMBOLP(field), field, ARG2, what); RCLO_RTD(cclo) = rtd; flst = RTD_FIELDS(rtd); for (i = 1; ; i++) { - ASSERT(NNULLP(flst), field, ARG2, what); + ASRTER(NNULLP(flst), field, ARG2, what); if (CAR(flst)==field) break; flst = CDR(flst); } @@ -274,8 +274,8 @@ static char s_rec_prinset[] = "record-printer-set!"; SCM rec_prinset(rtd, printer) SCM rtd, printer; { - ASSERT(NIMP(rtd) && RTDP(rtd), rtd, ARG1, s_rec_prinset); - ASSERT(BOOL_F==printer || scm_arity_check(printer, 3L, (char *)0), + ASRTER(NIMP(rtd) && RTDP(rtd), rtd, ARG1, s_rec_prinset); + ASRTER(BOOL_F==printer || scm_arity_check(printer, 3L, (char *)0), printer, ARG2, s_rec_prinset); RTD_PRINTER(rtd) = printer; return UNSPECIFIED; @@ -385,6 +385,9 @@ static iproc subr2s[] = { {s_makrectyp, makrectyp}, {s_rec_prinset, rec_prinset}, {0, 0}}; + +SCM_DLL_EXPORT void init_record P((void)); + void init_record() { SCM i_name = CAR(sysintern("name", UNDEFINED)); @@ -53,6 +53,11 @@ void scm_fill_freelist P((void)); # include <sys/types.h> #endif +#ifdef __NetBSD__ +# include <ctype.h> +# include <unistd.h> +#endif + #ifdef __OpenBSD__ # include <ctype.h> # include <unistd.h> @@ -143,17 +148,17 @@ char *isymnames[] = { }; static char s_read_char[] = "read-char", s_peek_char[] = "peek-char"; -char s_read[] = "read", s_write[] = "write", s_newline[] = "newline"; +char s_write[] = "write", s_newline[] = "newline"; static char s_display[] = "display", s_write_char[] = "write-char"; 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 nump, char *what)); -static SCM lreadr P((SCM tok_buf, SCM port, int nump)); -static SCM lreadpr P((SCM tok_buf, SCM port, int nump)); -static SCM lreadparen P((SCM tok_buf, SCM port, int nump, char *name)); +static SCM lread1 P((SCM port, int flgs, 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)); static SCM lread_rec P((SCM tok_buf, SCM port)); static sizet read_token P((int ic, SCM tok_buf, SCM port)); static void err_head P((char *str)); @@ -256,7 +261,12 @@ taloop: break; } lputs("#@", port); +#ifdef _M_ARM + /* MS CLARM compiler workaround */ + exp = CAR(MS_CLARM_dumy = exp - 1); +#else exp = CAR(exp-1); +#endif goto taloop; default: idef: @@ -427,7 +437,7 @@ static int input_waiting(f) tv.tv_usec = 0; SYSCALL(ret = select((fileno(f) + 1), &ifds, (fd_set *) NULL, (fd_set *) NULL, &tv);); - ASSERT(ret>=0, MAKINUM(ret), "select error", s_char_readyp); + ASRTER(ret>=0, MAKINUM(ret), "select error", s_char_readyp); return FD_ISSET(fileno(f), &ifds); # else # ifdef FIONREAD @@ -446,7 +456,7 @@ SCM char_readyp(port) SCM port; { if UNBNDP(port) port = cur_inp; - ASSERT(NIMP(port) && OPINPORTP(port), port, ARG1, s_char_readyp); + 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; } @@ -472,7 +482,7 @@ SCM wait_for_input(args) { SCM how_long, port1, port, ports, ans = EOL; int timeout, pos = ARG2; - ASSERT(!NULLP(args), INUM0, WNA, s_wfi); + ASRTER(!NULLP(args), INUM0, WNA, s_wfi); how_long = CAR(args); args = CDR(args); if NULLP(args) port1 = cur_inp; @@ -481,11 +491,11 @@ SCM wait_for_input(args) args = CDR(args); } timeout = num2long(how_long, (char *)ARG1, s_wfi); - ASSERT(timeout >= 0, how_long, ARG1, s_wfi); + ASRTER(timeout >= 0, how_long, ARG1, s_wfi); port = port1; ports = args; while (1) { - ASSERT(NIMP(port) && OPINPORTP(port) && (BUF0 & SCM_PORTFLAGS(port)), + ASRTER(NIMP(port) && OPINPORTP(port) && (BUF0 & SCM_PORTFLAGS(port)), port, pos, s_wfi); if (CRDYP(port) || feof(STREAM(port))) timeout = 0; if (NULLP(ports)) break; @@ -516,7 +526,7 @@ SCM wait_for_input(args) ports = CDR(ports); } SYSCALL(ret = select(fd_max + 1, &ifds, (fd_set *)0L, (fd_set *)0L, &tv);); - ASSERT(ret>=0, MAKINUM(ret), "select error", s_wfi); + ASRTER(ret>=0, MAKINUM(ret), "select error", s_wfi); port = port1; ports = args; @@ -538,17 +548,21 @@ SCM wait_for_input(args) FILE *f = STREAM(port); if (feof(f)) ans = cons(port, ans); else { -# ifdef FIONREAD - long remir; - ioctl(fileno(f), FIONREAD, &remir); - if (remir) ans = cons(port, ans); +# ifdef _WIN32 + if (fileno(f)==fileno(stdin) && (isatty(fileno(stdin))) && kbhit()) + ans = cons(port, ans); # else - if (fileno(f)==fileno(stdin) && (isatty(fileno(stdin))) && kbhit()) - ans = cons(port, ans); +# ifdef FIONREAD + long remir; + ioctl(fileno(f), FIONREAD, &remir); + if (remir) ans = cons(port, ans); +# else + /* If we get here this is not going to work */ +# endif # endif - if (NULLP(ports)) break; - port = CAR(ports); - ports = CDR(ports); + if (NULLP(ports)) break; + port = CAR(ports); + ports = CDR(ports); } } while (time((timet*)0L) < start); #endif @@ -608,7 +622,7 @@ SCM lflush(port) /* user accessible as force-output */ SCM port; { if UNBNDP(port) port = cur_outp; - else ASSERT(NIMP(port) && OPOUTPORTP(port), port, ARG1, s_flush); + else ASRTER(NIMP(port) && OPOUTPORTP(port), port, ARG1, s_flush); { sizet i = PTOBNUM(port); while ((ptobs[i].fflush)(STREAM(port)) && @@ -622,7 +636,7 @@ SCM lwrite(obj, port) SCM obj, port; { if UNBNDP(port) port = cur_outp; - else ASSERT(NIMP(port) && OPOUTPORTP(port), port, ARG2, s_write); + else ASRTER(NIMP(port) && OPOUTPORTP(port), port, ARG2, s_write); iprin1(obj, port, 1); return UNSPECIFIED; } @@ -630,7 +644,7 @@ SCM display(obj, port) SCM obj, port; { if UNBNDP(port) port = cur_outp; - else ASSERT(NIMP(port) && OPOUTPORTP(port), port, ARG2, s_display); + else ASRTER(NIMP(port) && OPOUTPORTP(port), port, ARG2, s_display); iprin1(obj, port, 0); return UNSPECIFIED; } @@ -638,7 +652,7 @@ SCM newline(port) SCM port; { if UNBNDP(port) port = cur_outp; - else ASSERT(NIMP(port) && OPOUTPORTP(port), port, ARG1, s_newline); + else ASRTER(NIMP(port) && OPOUTPORTP(port), port, ARG1, s_newline); lputc('\n', port); if (port==cur_outp) lfflush(port); return UNSPECIFIED; @@ -647,8 +661,8 @@ SCM write_char(chr, port) SCM chr, port; { if UNBNDP(port) port = cur_outp; - else ASSERT(NIMP(port) && OPOUTPORTP(port), port, ARG2, s_write_char); - ASSERT(ICHRP(chr), chr, ARG1, s_write_char); + else ASRTER(NIMP(port) && OPOUTPORTP(port), port, ARG2, s_write_char); + ASRTER(ICHRP(chr), chr, ARG1, s_write_char); lputc((int)ICHR(chr), port); return UNSPECIFIED; } @@ -656,7 +670,7 @@ SCM scm_freshline(port) SCM port; { if UNBNDP(port) port = cur_outp; - else ASSERT(NIMP(port) && OPOUTPORTP(port), port, ARG1, s_freshline); + else ASRTER(NIMP(port) && OPOUTPORTP(port), port, ARG1, s_freshline); if (INUM0==scm_port_col(port)) return UNSPECIFIED; lputc('\n', port); if (port==cur_outp) lfflush(port); @@ -688,7 +702,7 @@ void lputs(s, port) SCM port; { sizet i = PTOBNUM(port); - ASSERT(s, INUM0, ARG1, "lputs"); + ASRTER(s, INUM0, ARG1, "lputs"); while (EOF==(ptobs[i].fputs)(s, STREAM(port)) && scm_io_error(port, "fputs")) ; @@ -775,7 +789,7 @@ void lungetc(c, port) SCM port; { int i = PTOBNUM(port); -/* ASSERT(!CRDYP(port), port, ARG2, "too many lungetc");*/ +/* ASRTER(!CRDYP(port), port, ARG2, "too many lungetc");*/ if (ptobs[i].ungetc) (ptobs[i].ungetc)(c, port); else { @@ -789,7 +803,7 @@ SCM scm_read_char(port) { int c; if UNBNDP(port) port = cur_inp; - ASSERT(NIMP(port) && OPINPORTP(port), port, ARG1, s_read_char); + ASRTER(NIMP(port) && OPINPORTP(port), port, ARG1, s_read_char); c = lgetc(port); if (EOF==c) return EOF_VAL; return MAKICHR(c); @@ -799,7 +813,7 @@ SCM peek_char(port) { int c; if UNBNDP(port) port = cur_inp; - else ASSERT(NIMP(port) && OPINPORTP(port), port, ARG1, s_peek_char); + else ASRTER(NIMP(port) && OPINPORTP(port), port, ARG1, s_peek_char); c = lgetc(port); if (EOF==c) return EOF_VAL; lungetc(c, port); @@ -832,187 +846,209 @@ static int flush_ws(port) return c; } } -SCM lread(port) + +/* Top-level readers */ +static SCM p_read_numbered, p_read_for_load, p_read; +static char s_read[] = "read"; +static char s_read_for_load[] = "read-for-load"; +static char s_read_numbered[] = "read-numbered"; +SCM scm_read(port) SCM port; { return lread1(port, 0, s_read); } -static SCM lread1(port, nump, what) + +SCM scm_read_for_load(port) + SCM port; +{ + return lread1(port, 4, s_read_for_load); +} + +SCM scm_read_numbered(port) + SCM port; +{ + return lread1(port, 6, s_read_numbered); +} + +static SCM lread1(port, flgs, what) SCM port; - int nump; + int flgs; char *what; { int c; SCM tok_buf; if UNBNDP(port) port = cur_inp; - ASSERT(NIMP(port) && OPINPORTP(port), port, ARG1, what); + ASRTER(NIMP(port) && OPINPORTP(port), port, ARG1, what); do { c = flush_ws(port); if (EOF==c) return EOF_VAL; lungetc(c, port); tok_buf = makstr(30L); - } while (EOF_VAL==(tok_buf = lreadr(tok_buf, port, nump))); + } while (EOF_VAL==(tok_buf = lreadr(tok_buf, port, flgs))); return tok_buf; } -static SCM *loc_readsharp = 0, *loc_readsharpc = 0; -static SCM lreadpr(tok_buf, port, nump) +static SCM *loc_loadsharp = 0, *loc_readsharp = 0, *loc_charsharp = 0; +static SCM lreadpr(tok_buf, port, flgs) SCM tok_buf; SCM port; - int nump; + int flgs; { - int c; - sizet j; - SCM p; - if (2==nump) - return lread_rec(tok_buf, port); -tryagain: - c = flush_ws(port); - switch (c) { - case EOF: return EOF_VAL; + int c; + sizet j; + SCM p; + if (2==(3&flgs)) return lread_rec(tok_buf, port); + tryagain: + c = flush_ws(port); + switch (c) { + case EOF: return EOF_VAL; #ifdef BRACKETS_AS_PARENS - case '[': + case '[': #endif - case '(': - return lreadparen(tok_buf, port, nump, s_list); + case '(': return lreadparen(tok_buf, port, flgs, s_list); #ifdef BRACKETS_AS_PARENS - case ']': + case ']': #endif - case ')': return UNDEFINED; /* goto tryagain; */ - case '\'': return cons2(i_quote, - lreadr(tok_buf, port, nump), EOL); - case '`': return cons2(i_quasiquote, - lreadr(tok_buf, port, nump), EOL); - case ',': - c = lgetc(port); - if ('@'==c) p = i_uq_splicing; - else { - lungetc(c, port); - p = i_unquote; - } - return cons2(p, lreadr(tok_buf, port, nump), EOL); - case '#': - c = lgetc(port); - switch (c) { + case ')': return UNDEFINED; /* goto tryagain; */ + case '\'': return cons2(i_quote, + lreadr(tok_buf, port, flgs), EOL); + case '`': return cons2(i_quasiquote, + lreadr(tok_buf, port, flgs), EOL); + case ',': + c = lgetc(port); + if ('@'==c) p = i_uq_splicing; + else { + lungetc(c, port); + p = i_unquote; + } + return cons2(p, lreadr(tok_buf, port, flgs), EOL); + case '#': + c = lgetc(port); + switch (c) { #ifdef BRACKETS_AS_PARENS - case '[': + case '[': #endif - case '(': - p = lreadparen(tok_buf, port, nump, s_vector); - return NULLP(p) ? nullvect : vector(p); - case 't': case 'T': return BOOL_T; - case 'f': case 'F': return BOOL_F; - case 'b': case 'B': case 'o': case 'O': - case 'd': case 'D': case 'x': case 'X': - case 'i': case 'I': case 'e': case 'E': - lungetc(c, port); - c = '#'; - goto num; - case '*': - j = read_token(c, tok_buf, port); - p = istr2bve(CHARS(tok_buf)+1, (long)(j-1)); - if (NFALSEP(p)) return p; - else goto unkshrp; - case '\\': - c = lgetc(port); - j = read_token(c, tok_buf, port); - if (j==1) return MAKICHR(c); - if (c >= '0' && c < '8') { - p = istr2int(CHARS(tok_buf), (long)j, 8); - if (NFALSEP(p)) return MAKICHR(INUM(p)); - } - for (c = 0;c<sizeof charnames/sizeof(char *);c++) - if (charnames[c] - && (0==strcmp(charnames[c], CHARS(tok_buf)))) - return MAKICHR(charnums[c]); - if (loc_readsharpc && NIMP(*loc_readsharpc)) { - resizuve(tok_buf, MAKINUM(j)); - p = apply(*loc_readsharpc, tok_buf, listofnull); - if ICHRP(p) return p; - } - wta(UNDEFINED, "unknown # object: #\\", CHARS(tok_buf)); - case '|': - j = 1; /* here j is the comment nesting depth */ -lp: c = lgetc(port); -lpc: switch (c) { - case EOF: - wta(UNDEFINED, s_eofin, "balanced comment"); - case LINE_INCREMENTORS: - default: - goto lp; - case '|': - if ('#' != (c = lgetc(port))) goto lpc; - if (--j) goto lp; - break; - case '#': - if ('|' != (c = lgetc(port))) goto lpc; - ++j; goto lp; - } - goto tryagain; - default: callshrp: - if (loc_readsharp && NIMP(*loc_readsharp)) { - p = apply(*loc_readsharp, cons2(MAKICHR(c), port, EOL), EOL); - if (UNSPECIFIED==p) goto tryagain; - return p; - } - unkshrp: wta((SCM)MAKICHR(c), s_unknown_sharp, ""); - } - case '\"': - j = 0; - while ('\"' != (c = lgetc(port))) { - ASSERT(EOF != c, UNDEFINED, s_eofin, s_string); - if (j+1 >= LENGTH(tok_buf)) grow_tok_buf(tok_buf); - switch (c) { - case LINE_INCREMENTORS: break; - case '\\': - switch (c = lgetc(port)) { - case LINE_INCREMENTORS: continue; - case '0': c = '\0'; break; - case 'f': c = '\f'; break; - case 'n': c = '\n'; break; - case 'r': c = '\r'; break; - case 't': c = '\t'; break; - case 'a': c = '\007'; break; - case 'v': c = '\v'; break; - } - } - CHARS(tok_buf)[j] = c; - ++j; - } - if (j==0) return nullstr; - CHARS(tok_buf)[j] = 0; - return makfromstr(CHARS(tok_buf), j); - case DIGITS: - case '.': case '-': case '+': -num: - j = read_token(c, tok_buf, port); - p = istring2number(CHARS(tok_buf), (long)j, 10L); - if NFALSEP(p) return p; - if (c=='#') { - if ((j==2) && (lgetc(port)=='(')) { - lungetc('(', port); - c = CHARS(tok_buf)[1]; - goto callshrp; - } - wta(UNDEFINED, s_unknown_sharp, CHARS(tok_buf)); - } - goto tok; - default: - j = read_token(c, tok_buf, port); -tok: - p = intern(CHARS(tok_buf), j); - return CAR(p); + case '(': + p = lreadparen(tok_buf, port, flgs, s_vector); + return NULLP(p) ? nullvect : vector(p); + case 't': case 'T': return BOOL_T; + case 'f': case 'F': return BOOL_F; + case 'b': case 'B': case 'o': case 'O': + case 'd': case 'D': case 'x': case 'X': + case 'i': case 'I': case 'e': case 'E': + lungetc(c, port); + c = '#'; + goto num; + case '*': + j = read_token(c, tok_buf, port); + p = istr2bve(CHARS(tok_buf)+1, (long)(j-1)); + if (NFALSEP(p)) return p; + else goto unkshrp; + case '\\': + c = lgetc(port); + j = read_token(c, tok_buf, port); + if (j==1) return MAKICHR(c); + for (c = 0;c<sizeof charnames/sizeof(char *);c++) + if (charnames[c] + && (0==strcmp(charnames[c], CHARS(tok_buf)))) + return MAKICHR(charnums[c]); + if (loc_charsharp && NIMP(*loc_charsharp)) { + resizuve(tok_buf, MAKINUM(j)); + p = apply(*loc_charsharp, tok_buf, listofnull); + if ICHRP(p) return p; + } + wta(UNDEFINED, "unknown # object: #\\", CHARS(tok_buf)); + case '|': + j = 1; /* here j is the comment nesting depth */ + lp: c = lgetc(port); + lpc: + switch (c) { + case EOF: wta(UNDEFINED, s_eofin, "balanced comment"); + case LINE_INCREMENTORS: + default: + goto lp; + case '|': + if ('#' != (c = lgetc(port))) goto lpc; + if (--j) goto lp; + break; + case '#': + if ('|' != (c = lgetc(port))) goto lpc; + ++j; goto lp; + } + goto tryagain; + default: callshrp: + { + SCM reader = (3&flgs) ? p_read_numbered : + ((4&flgs) ? p_read_for_load : p_read); + SCM args = cons2(MAKICHR(c), port, cons(reader, EOL)); + if ((4&flgs) && loc_loadsharp && NIMP(*loc_loadsharp)) { + p = apply(*loc_loadsharp, args, EOL); + if (UNSPECIFIED==p) goto tryagain; + return p; + } else if (loc_readsharp && NIMP(*loc_readsharp)) { + p = apply(*loc_readsharp, args, EOL); + if (UNSPECIFIED==p) goto tryagain; + return p; } + } + unkshrp: wta((SCM)MAKICHR(c), s_unknown_sharp, ""); + } + case '\"': + j = 0; + while ('\"' != (c = lgetc(port))) { + ASRTER(EOF != c, UNDEFINED, s_eofin, s_string); + if (j+1 >= LENGTH(tok_buf)) grow_tok_buf(tok_buf); + switch (c) { + case LINE_INCREMENTORS: break; + case '\\': + switch (c = lgetc(port)) { + case LINE_INCREMENTORS: continue; + case '0': c = '\0'; break; + case 'f': c = '\f'; break; + case 'n': c = '\n'; break; + case 'r': c = '\r'; break; + case 't': c = '\t'; break; + case 'a': c = '\007'; break; + case 'v': c = '\v'; break; + } + } + CHARS(tok_buf)[j] = c; + ++j; + } + if (j==0) return nullstr; + CHARS(tok_buf)[j] = 0; + return makfromstr(CHARS(tok_buf), j); + case DIGITS: + case '.': case '-': case '+': + num: + j = read_token(c, tok_buf, port); + p = istring2number(CHARS(tok_buf), (long)j, 10L); + if NFALSEP(p) return p; + if (c=='#') { + if ((j==2) && (lgetc(port)=='(')) { + lungetc('(', port); + c = CHARS(tok_buf)[1]; + goto callshrp; + } + wta(UNDEFINED, s_unknown_sharp, CHARS(tok_buf)); + } + goto tok; + default: + j = read_token(c, tok_buf, port); + tok: + p = intern(CHARS(tok_buf), j); + return CAR(p); + } } -static SCM lreadr(tok_buf, port, nump) +static SCM lreadr(tok_buf, port, flgs) SCM tok_buf; SCM port; - int nump; + int flgs; { - SCM ans = lreadpr(tok_buf, port, nump); + SCM ans = lreadpr(tok_buf, port, flgs); switch (ans) { case UNDEFINED: scm_warn("unexpected \")\"", "", port); - return lreadpr(tok_buf, port, nump); + return lreadpr(tok_buf, port, flgs); } return ans; } @@ -1026,8 +1062,8 @@ static SCM lread_rec(tok_buf, port) default: lungetc(c, port); line = scm_port_line(port); - form = lreadpr(tok_buf, port, 1); - if (NFALSEP(line) && NIMP(form) && + form = lreadpr(tok_buf, port, 5); + if (NFALSEP(line) && NIMP(form) && (CONSP(form) || VECTORP(form))) { return cons(SCM_MAKE_LINUM(INUM(line)), form); } @@ -1076,26 +1112,37 @@ static sizet read_token(ic, tok_buf, port) _Pragma("opt"); /* # pragma _CRI opt */ #endif -static SCM lreadparen(tok_buf, port, nump, name) +/* flgs was originally an argument to determine whether a read was */ +/* top-level or recursve. It has been overloaded to determine also */ +/* what to do in the case of a recursive read. */ +/* It distinguishes four states: */ +/* 0 - not adding line-numbers - never changes. Uses READ:SHARP */ +/* 4 - not adding line-numbers - never changes. Uses LOAD:SHARP */ +/* 5 - top level read when adding line-numbers. Uses LOAD:SHARP */ +/* 6 - recursive read when adding line-numbers. Uses LOAD:SHARP */ + +static SCM lreadparen(tok_buf, port, flgs, name) SCM tok_buf; SCM port; - int nump; + int flgs; char *name; { - SCM lst, fst, tmp = lreadpr(tok_buf, port, nump ? 2 : 0); + SCM lst, fst, + tmp = lreadpr(tok_buf, port, (4&flgs) | ((3&flgs) ? 2 : 0)); if (UNDEFINED==tmp) return EOL; if (i_dot==tmp) { - fst = lreadr(tok_buf, port, nump ? 1 : 0); + fst = lreadr(tok_buf, port, (4&flgs) | ((3&flgs) ? 1 : 0)); closeit: tmp = lreadpr(tok_buf, port, 0); if (UNDEFINED != tmp) wta(UNDEFINED, "missing close paren", name); return fst; } fst = lst = cons(tmp, EOL); - while (UNDEFINED != (tmp = lreadpr(tok_buf, port, nump ? 2 : 0))) { + while (UNDEFINED != + (tmp = lreadpr(tok_buf, port, (4&flgs) | ((3&flgs) ? 2 : 0)))) { if (EOF_VAL==tmp) wta(lst, s_eofin, s_list); if (i_dot==tmp) { - CDR(lst) = lreadr(tok_buf, port, nump ? 1 : 0); + CDR(lst) = lreadr(tok_buf, port, (4&flgs) | ((3&flgs) ? 1 : 0)); goto closeit; } lst = (CDR(lst) = cons(tmp, EOL)); @@ -1111,7 +1158,7 @@ SCM swapcar(pair, value) SCM pair, value; { SCM ret; - ASSERT(NIMP(pair) && CONSP(pair), pair, ARG1, s_swapcar); + ASRTER(NIMP(pair) && CONSP(pair), pair, ARG1, s_swapcar); DEFER_INTS; ret = CAR(pair); CAR(pair) = value; @@ -1124,7 +1171,7 @@ long tc16_arbiter; SCM tryarb(arb) SCM arb; { - ASSERT((TYP16(arb)==tc16_arbiter), arb, ARG1, s_tryarb); + ASRTER((TYP16(arb)==tc16_arbiter), arb, ARG1, s_tryarb); DEFER_INTS; if (CAR(arb) & (1L<<16)) arb = BOOL_F; @@ -1138,7 +1185,7 @@ SCM tryarb(arb) SCM relarb(arb) SCM arb; { - ASSERT((TYP16(arb)==tc16_arbiter), arb, ARG1, s_relarb); + ASRTER((TYP16(arb)==tc16_arbiter), arb, ARG1, s_relarb); if (!(CAR(arb) & (1L<<16))) return BOOL_F; CAR(arb) = tc16_arbiter; return BOOL_T; @@ -1226,7 +1273,7 @@ int handle_it(i) 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; DEFER_INTS; #ifndef NO_ENV_CACHE @@ -1254,40 +1301,6 @@ int handle_it(i) } return errmsgs[i-WNA].parent_err; } -static char s_eval_string[] = "eval-string"; -static char s_load_string[] = "load-string"; -static SCM i_eval_string = 0; -SCM scm_eval_string(str) - SCM str; -{ - SCM env = EOL; -#ifdef SCM_ENV_FILENAME - if (i_eval_string) - env = scm_env_addprop(SCM_ENV_FILENAME, i_eval_string, env); -#endif - str = mkstrport(INUM0, str, OPN | RDNG, s_eval_string); - str = lread(str); - return EVAL(str, env, EOL); -} -static SCM i_load_string = 0; -SCM scm_load_string(str) - SCM str; -{ - SCM env = EOL; -#ifdef SCM_ENV_FILENAME - if (i_load_string) - env = scm_env_addprop(SCM_ENV_FILENAME, i_load_string, env); -#endif - ASSERT(NIMP(str) && (STRINGP(str) || SYMBOLP(str)), str, ARG1, - s_load_string); - str = mkstrport(INUM0, str, OPN | RDNG, s_load_string); - while(1) { - SCM form = lread(str); - if (EOF_VAL==form) break; - SIDEVAL(form, env, EOL); - } - return BOOL_T; -} SCM exitval = MAKINUM(EXIT_FAILURE); /* INUM return value */ extern char s_unexec[]; @@ -1423,7 +1436,7 @@ SCM scm_port_line(port) SCM port; { sizet lnum; - ASSERT(NIMP(port) && PORTP(port), port, ARG1, s_port_line); + ASRTER(NIMP(port) && PORTP(port), port, ARG1, s_port_line); if (! (TRACKED & SCM_PORTFLAGS(port))) return BOOL_F; lnum = scm_port_table[SCM_PORTNUM(port)].line; switch (CGETUN(port)) { @@ -1441,7 +1454,7 @@ SCM scm_port_col(port) SCM port; { long col; - ASSERT(NIMP(port) && PORTP(port), port, ARG1, s_port_col); + ASRTER(NIMP(port) && PORTP(port), port, ARG1, s_port_col); if (! (TRACKED & SCM_PORTFLAGS(port))) return BOOL_F; col = scm_port_table[SCM_PORTNUM(port)].col; switch (CGETUN(port)) { @@ -1461,7 +1474,7 @@ SCM scm_port_filename(port) SCM port; { SCM x; - ASSERT(NIMP(port) && PORTP(port), port, ARG1, s_port_filename); + ASRTER(NIMP(port) && PORTP(port), port, ARG1, s_port_filename); x = SCM_PORTDATA(port); if (NIMP(x) && STRINGP(x)) return SCM_PORTDATA(port); @@ -1672,7 +1685,7 @@ SCM repl() scm_env_work = scm_ecache_index - scm_ecache_len; scm_egcs = scm_clo_moved = scm_stk_moved = 0; lmallocated = mallocated; - x = lread(cur_inp); + x = scm_read_for_load(cur_inp); rt = INUM(my_time()); scm_gcs = 0; gc_time_taken = 0; @@ -1732,7 +1745,7 @@ SCM abrt() char s_restart[] = "restart"; SCM restart() { - /* ASSERT(!dumped, UNDEFINED, "dumped can't", s_restart); */ + /* ASRTER(!dumped, UNDEFINED, "dumped can't", s_restart); */ longjump(CONT(rootcont)->jmpbuf, COOKIE(-3)); } @@ -1741,8 +1754,8 @@ char s_unexec[] = "unexec"; SCM scm_unexec(newpath) SCM newpath; { - ASSERT(NIMP(newpath) && STRINGP(newpath), newpath, ARG1, s_unexec); - ASSERT(execpath, UNSPECIFIED, s_no_execpath, s_unexec); + ASRTER(NIMP(newpath) && STRINGP(newpath), newpath, ARG1, s_unexec); + ASRTER(execpath, UNSPECIFIED, s_no_execpath, s_unexec); *loc_errobj = newpath; longjump(CONT(rootcont)->jmpbuf, COOKIE(-4)); } @@ -1796,20 +1809,10 @@ void ints_warn(str1, str2, fname, linum) } #endif -#ifdef CAUTIOUS -static SCM f_read_numbered; -static char s_read_numbered[] = "read-numbered"; -SCM scm_read_numbered(port) - SCM port; -{ - return lread1(port, 2, s_read_numbered); -} -#endif - SCM tryload(filename, reader) SCM filename, reader; { - ASSERT(NIMP(filename) && STRINGP(filename), filename, ARG1, s_load); + ASRTER(NIMP(filename) && STRINGP(filename), filename, ARG1, s_load); if (FALSEP(reader)) reader = UNDEFINED; #ifndef RECKLESS if (!UNBNDP(reader)) scm_arity_check(reader, 1L, s_load); @@ -1828,7 +1831,7 @@ SCM tryload(filename, reader) #endif while(1) { if (UNBNDP(reader)) - form = lread(port); + form = scm_read_for_load(port); else form = scm_cvapply(reader, 1L, &port); if (EOF_VAL==form) break; @@ -1840,6 +1843,40 @@ SCM tryload(filename, reader) } return BOOL_T; } +static char s_eval_string[] = "eval-string"; +static char s_load_string[] = "load-string"; +static SCM i_eval_string = 0; +SCM scm_eval_string(str) + SCM str; +{ + SCM env = EOL; +#ifdef SCM_ENV_FILENAME + if (i_eval_string) + env = scm_env_addprop(SCM_ENV_FILENAME, i_eval_string, env); +#endif + str = mkstrport(INUM0, str, OPN | RDNG, s_eval_string); + str = scm_read(str); + return EVAL(str, env, EOL); +} +static SCM i_load_string = 0; +SCM scm_load_string(str) + SCM str; +{ + SCM env = EOL; +#ifdef SCM_ENV_FILENAME + if (i_load_string) + env = scm_env_addprop(SCM_ENV_FILENAME, i_load_string, env); +#endif + ASRTER(NIMP(str) && (STRINGP(str) || SYMBOLP(str)), str, ARG1, + s_load_string); + str = mkstrport(INUM0, str, OPN | RDNG, s_load_string); + while(1) { + SCM form = scm_read_for_load(str); + if (EOF_VAL==form) break; + SIDEVAL(form, env, EOL); + } + return BOOL_T; +} void scm_line_msg(file, linum, port) SCM file, linum, port; @@ -1925,7 +1962,7 @@ static char s_perror[] = "perror"; SCM lperror(arg) SCM arg; { - ASSERT(NIMP(arg) && STRINGP(arg), arg, ARG1, s_perror); + ASRTER(NIMP(arg) && STRINGP(arg), arg, ARG1, s_perror); err_head(CHARS(arg)); return UNSPECIFIED; } @@ -1984,9 +2021,10 @@ static void def_err_response() err_pos = 0; if (!UNBNDP(obj)) if (reset_safeport(sys_safep, 55, cur_errp)) - if (0==setjmp(SAFEP_JMPBUF(sys_safep))) + if (0==setjmp(SAFEP_JMPBUF(sys_safep))) { 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 (reset_safeport(sys_safep, 55, cur_errp)) @@ -2079,7 +2117,7 @@ SCM set_inp(port) SCM port; { SCM oinp; - ASSERT(NIMP(port) && INPORTP(port), port, ARG1, s_cur_inp); + ASRTER(NIMP(port) && INPORTP(port), port, ARG1, s_cur_inp); DEFER_INTS; oinp = cur_inp; cur_inp = port; @@ -2090,7 +2128,7 @@ SCM set_outp(port) SCM port; { SCM ooutp; - ASSERT(NIMP(port) && OUTPORTP(port), port, ARG1, s_cur_outp); + ASRTER(NIMP(port) && OUTPORTP(port), port, ARG1, s_cur_outp); DEFER_INTS; ooutp = cur_outp; cur_outp = port; @@ -2101,7 +2139,7 @@ SCM set_errp(port) SCM port; { SCM oerrp; - ASSERT(NIMP(port) && OUTPORTP(port), port, ARG1, s_cur_errp); + ASRTER(NIMP(port) && OUTPORTP(port), port, ARG1, s_cur_errp); DEFER_INTS; oerrp = cur_errp; cur_errp = port; @@ -2112,7 +2150,7 @@ static char s_isatty[] = "isatty?"; SCM l_isatty(port) SCM port; { - ASSERT(NIMP(port) && OPPORTP(port), port, ARG1, s_isatty); + ASRTER(NIMP(port) && OPPORTP(port), port, ARG1, s_isatty); if (tc16_fport != TYP16(port)) return BOOL_F; return isatty(fileno(STREAM(port)))?BOOL_T:BOOL_F; } @@ -2144,7 +2182,6 @@ static iproc subr1s[] = { {0, 0}}; static iproc subr1os[] = { - {s_read, lread}, {s_read_char, scm_read_char}, {s_peek_char, peek_char}, {s_newline, newline}, @@ -2177,21 +2214,24 @@ void init_repl( iverbose ) i_repl = CAR(sysintern("repl", UNDEFINED)); loc_errobj = &CDR(sysintern("errobj", UNDEFINED)); loc_loadpath = &CDR(sysintern("*load-pathname*", BOOL_F)); + loc_loadsharp = &CDR(sysintern("load:sharp", UNDEFINED)); loc_readsharp = &CDR(sysintern("read:sharp", UNDEFINED)); - loc_readsharpc = &CDR(sysintern("read:sharp-char", UNDEFINED)); + loc_charsharp = &CDR(sysintern("char:sharp", UNDEFINED)); loc_broken_pipe = &CDR(sysintern("broken-pipe", UNDEFINED)); scm_verbose = iverbose; init_iprocs(subr0s, tc7_subr_0); init_iprocs(subr1os, tc7_subr_1o); init_iprocs(subr1s, tc7_subr_1); init_iprocs(subr2os, tc7_subr_2o); -#ifdef CAUTIOUS - f_read_numbered = - make_subr(s_read_numbered, tc7_subr_1, scm_read_numbered); -#endif add_feature(s_char_readyp); make_subr(s_swapcar, tc7_subr_2, swapcar); make_subr(s_wfi, tc7_lsubr, wait_for_input); + p_read_numbered = + make_subr(s_read_numbered, tc7_subr_1, scm_read_numbered); + p_read_for_load = + make_subr(s_read_for_load, tc7_subr_1, scm_read_for_load); + p_read = + make_subr(s_read, tc7_subr_1o, scm_read); i_eval_string = CAR(sysintern(s_eval_string, UNDEFINED)); i_load_string = CAR(sysintern(s_load_string, UNDEFINED)); #ifdef CAN_DUMP @@ -2214,6 +2254,7 @@ void init_repl( iverbose ) } void final_repl() { + i_eval_string = i_load_string = 0; loc_errobj = (SCM *)&tmp_errobj; loc_loadpath = (SCM *)&tmp_loadpath; loadports = EOL; diff --git a/requires.scm b/requires.scm index 97d7cdd..cad8db0 100644 --- a/requires.scm +++ b/requires.scm @@ -1,6 +1,6 @@ ;;; "require.scm" Trampoline to slib/require.scm -(set! library-vicinity +(define library-vicinity (let* ((vl (case (software-type) ((AMIGA) '(#\: #\/)) ((MS-DOS WINDOWS ATARIST OS/2) '(#\\ #\/)) @@ -19,4 +19,3 @@ (string-append (substring iv 0 (+ 1 pos)) "slib" vs)) (else (loop (- pos 1))))))) (lambda () lv))) -(load (in-vicinity (library-vicinity) "require")) @@ -55,7 +55,7 @@ #endif static char rcsid[] = - "$Id: rgx.c,v 1.15 2002/04/13 20:41:02 jaffer Exp $"; + "$Id: rgx.c,v 1.16 2002/11/25 20:34:31 jaffer Exp $"; #ifdef HAVE_ALLOCA # include <alloca.h> @@ -161,7 +161,7 @@ SCM lregerror(scode) int len; #endif SCM str; - ASSERT(INUMP(scode), scode, ARG1, s_regerror); + ASRTER(INUMP(scode), scode, ARG1, s_regerror); code = INUM(scode); if (code < 0) return makfromstr("Invalid code", sizeof("Invalid code")-1); @@ -192,8 +192,8 @@ SCM lregcomp(pattern, flags) char *err_msg; #endif - ASSERT(NIMP(pattern) && STRINGP(pattern), pattern, ARG1, s_regcomp); - ASSERT(UNBNDP(flags) || (NIMP(flags) && STRINGP(flags)), + ASRTER(NIMP(pattern) && STRINGP(pattern), pattern, ARG1, s_regcomp); + ASRTER(UNBNDP(flags) || (NIMP(flags) && STRINGP(flags)), flags, ARG2, s_regcomp); DEFER_INTS; z = must_malloc_cell((long)sizeof(regex_info), (SCM)tc16_rgx, s_regex); @@ -302,8 +302,8 @@ SCM lregexec(prog, str) ALLOCA_PROTECT; FIXUP_REGEXP(prog); - ASSERT(NIMP(prog) && tc16_rgx==CAR(prog), prog, ARG1, s_regexec); - ASSERT(NIMP(str) && STRINGP(str), str, ARG2, s_regexec); + ASRTER(NIMP(prog) && tc16_rgx==CAR(prog), prog, ARG1, s_regexec); + ASRTER(NIMP(str) && STRINGP(str), str, ARG2, s_regexec); #ifdef _GNU_SOURCE return lregsearchv(prog, str, EOL); @@ -334,8 +334,8 @@ SCM lregmatp(prog, str) SCM prog, str; { FIXUP_REGEXP(prog); - ASSERT(NIMP(prog) && tc16_rgx==CAR(prog), prog, ARG1, s_regmatp); - ASSERT(NIMP(str) && STRINGP(str), str, ARG2, s_regmatp); + ASRTER(NIMP(prog) && tc16_rgx==CAR(prog), prog, ARG1, s_regmatp); + ASRTER(NIMP(str) && STRINGP(str), str, ARG2, s_regmatp); #ifdef _GNU_SOURCE return (lregsearch(prog, str, EOL)==BOOL_F)?BOOL_F:BOOL_T; @@ -367,11 +367,11 @@ SCM lregsearchmatch(prog, str, args, search, vector) ALLOCA_PROTECT; FIXUP_REGEXP(prog); - ASSERT(NIMP(prog) && tc16_rgx==CAR(prog), prog, ARG1, s_regsearch); - ASSERT(NIMP(str) && STRINGP(str), str, ARG2, s_regsearch); - ASSERT(len<=2, args, WNA, s_regsearch); - ASSERT((len<1)||(INUMP(CAR(args))), CAR(args), ARG3, s_regsearch); - ASSERT((len<2)||(INUMP(CAR(CDR(args)))), CAR(CDR(args)), ARG4, s_regsearch); + ASRTER(NIMP(prog) && tc16_rgx==CAR(prog), prog, ARG1, s_regsearch); + ASRTER(NIMP(str) && STRINGP(str), str, ARG2, s_regsearch); + ASRTER(len<=2, args, WNA, s_regsearch); + ASRTER((len<1)||(INUMP(CAR(args))), CAR(args), ARG3, s_regsearch); + ASRTER((len<2)||(INUMP(CAR(CDR(args)))), CAR(CDR(args)), ARG4, s_regsearch); start = (len>=1)?(INUM(CAR(args))):0; size = (len>=2)?(INUM(CAR(CDR(args)))):LENGTH(str); @@ -503,8 +503,8 @@ SCM stringsplitutil(prog, str, vector) SCM st_start, st_end; FIXUP_REGEXP(prog); - ASSERT(NIMP(prog) && tc16_rgx==CAR(prog), prog, ARG1, s_stringsplit); - ASSERT(NIMP(str) && STRINGP(str), str, ARG2, s_stringsplit); + ASRTER(NIMP(prog) && tc16_rgx==CAR(prog), prog, ARG1, s_stringsplit); + ASRTER(NIMP(str) && STRINGP(str), str, ARG2, s_stringsplit); substrings = EOL; anchor = 0; @@ -599,16 +599,16 @@ SCM lstringedit(prog, editspec, args) args_len = ilength(args); FIXUP_REGEXP(prog); - ASSERT(NIMP(prog) && tc16_rgx==CAR(prog), prog, ARG1, s_stringedit); - ASSERT(NIMP(editspec) && STRINGP(editspec), editspec, ARG2, s_stringedit); - ASSERT((args_len==1)||(args_len==2), args, WNA, s_stringedit); + ASRTER(NIMP(prog) && tc16_rgx==CAR(prog), prog, ARG1, s_stringedit); + ASRTER(NIMP(editspec) && STRINGP(editspec), editspec, ARG2, s_stringedit); + ASRTER((args_len==1)||(args_len==2), args, WNA, s_stringedit); str = CAR(args); - ASSERT(NIMP(str)&&STRINGP(str), str, ARG3, s_stringedit); + ASRTER(NIMP(str)&&STRINGP(str), str, ARG3, s_stringedit); if (args_len==2) { count = CAR(CDR(args)); - ASSERT(INUMP(count)||(count==BOOL_T), count, ARG4, s_stringedit); + ASRTER(INUMP(count)||(count==BOOL_T), count, ARG4, s_stringedit); } else count = MAKINUM(1); @@ -85,7 +85,7 @@ unsigned char num2uchar(num, pos, s_caller) char *pos, *s_caller; { unsigned long res = INUM(num); - ASSERT(INUMP(num) && (255L >= res), num, pos, s_caller); + ASRTER(INUMP(num) && (255L >= res), num, pos, s_caller); return (unsigned char) res; } unsigned short num2ushort(num, pos, s_caller) @@ -93,7 +93,7 @@ unsigned short num2ushort(num, pos, s_caller) char *pos, *s_caller; { unsigned long res = INUM(num); - ASSERT(INUMP(num) && (65535L >= res), num, pos, s_caller); + ASRTER(INUMP(num) && (65535L >= res), num, pos, s_caller); return (unsigned short) res; } unsigned long num2ulong(num, pos, s_caller) @@ -223,7 +223,7 @@ char **makargvfrmstrs(args, s_name) int argc = ilength(args); argv = (char **)must_malloc((1L+argc)*sizeof(char *), s_vector); for(argc = 0; NNULLP(args); args=CDR(args), ++argc) { - ASSERT(NIMP(CAR(args)) && STRINGP(CAR(args)), CAR(args), ARG2, s_name); + ASRTER(NIMP(CAR(args)) && STRINGP(CAR(args)), CAR(args), ARG2, s_name); { sizet len = 1 + LENGTH(CAR(args)); char *dst = (char *)must_malloc((long)len, s_string); @@ -300,13 +300,13 @@ unsigned long scm_addr(args, s_name) } else { if NIMP(args) { - ASSERT(CONSP(args) && INUMP(CAR(args)), args, ARG2, s_name); + 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 { - ASSERT(INUMP(args), args, ARG2, s_name); + ASRTER(INUMP(args), args, ARG2, s_name); pos = INUM(args); } ASRTGO(pos >= 0 && pos < LENGTH(v), outrng); @@ -418,8 +418,11 @@ SCM scm_gc_protect(obj) SCM obj; { long len; - ASSERT(NIMP(scm_uprotects), MAKINUM(20), NALLOC, "protects"); + ASRTER(NIMP(scm_uprotects), MAKINUM(20), NALLOC, "protects"); if IMP(obj) return obj; + for (len = LENGTH(scm_uprotects);len--;) { + if (obj==VELTS(scm_uprotects)[len]) return obj; + } len = LENGTH(scm_uprotects); if (scm_protidx >= len) resizuve(scm_uprotects, MAKINUM(len + (len>>2))); VELTS(scm_uprotects)[scm_protidx++] = obj; @@ -428,5 +431,6 @@ SCM scm_gc_protect(obj) void init_rope() { + scm_protidx = 0; scm_uprotects = make_vector(MAKINUM(20), UNDEFINED); } @@ -50,7 +50,7 @@ SCM last_pair(sx) { register SCM res = sx; register SCM x; - ASSERT(NIMP(res) && CONSP(res), res, ARG1, s_last_pair); + ASRTER(NIMP(res) && CONSP(res), res, ARG1, s_last_pair); while (!0) { x = CDR(res); if (IMP(x) || NCONSP(x)) return res; @@ -59,7 +59,7 @@ SCM last_pair(sx) if (IMP(x) || NCONSP(x)) return res; res = x; sx = CDR(sx); - ASSERT(x != sx, sx, ARG1, s_last_pair); + ASRTER(x != sx, sx, ARG1, s_last_pair); } } @@ -69,20 +69,20 @@ SCM subml(str1, start1, args) { SCM end1, str2, start2; long i, j, e; - ASSERT(3==ilength(args), args, WNA, s_subml); + ASRTER(3==ilength(args), args, WNA, s_subml); end1 = CAR(args); args = CDR(args); str2 = CAR(args); args = CDR(args); start2 = CAR(args); - ASSERT(NIMP(str1) && STRINGP(str1), str1, ARG1, s_subml); - ASSERT(INUMP(start1), start1, ARG2, s_subml); - ASSERT(INUMP(end1), end1, ARG3, s_subml); - ASSERT(NIMP(str2) && STRINGP(str2), str2, ARG4, s_subml); - ASSERT(INUMP(start2), start2, ARG5, s_subml); + ASRTER(NIMP(str1) && STRINGP(str1), str1, ARG1, s_subml); + ASRTER(INUMP(start1), start1, ARG2, s_subml); + ASRTER(INUMP(end1), end1, ARG3, s_subml); + ASRTER(NIMP(str2) && STRINGP(str2), str2, ARG4, s_subml); + ASRTER(INUMP(start2), start2, ARG5, s_subml); i = INUM(start1), j = INUM(start2), e = INUM(end1); - ASSERT(i <= LENGTH(str1) && i >= 0, start1, OUTOFRANGE, s_subml); - ASSERT(j <= LENGTH(str2) && j >= 0, start2, OUTOFRANGE, s_subml); - ASSERT(e <= LENGTH(str1) && e >= 0, end1, OUTOFRANGE, s_subml); - ASSERT(e-i+j <= LENGTH(str2), start2, OUTOFRANGE, s_subml); + ASRTER(i <= LENGTH(str1) && i >= 0, start1, OUTOFRANGE, s_subml); + ASRTER(j <= LENGTH(str2) && j >= 0, start2, OUTOFRANGE, s_subml); + ASRTER(e <= LENGTH(str1) && e >= 0, end1, OUTOFRANGE, s_subml); + ASRTER(e-i+j <= LENGTH(str2), start2, OUTOFRANGE, s_subml); while(i<e) CHARS(str2)[j++] = CHARS(str1)[i++]; return UNSPECIFIED; } @@ -92,20 +92,20 @@ SCM submr(str1, start1, args) { SCM end1, str2, start2; long i, j, e; - ASSERT(3==ilength(args), args, WNA, s_submr); + ASRTER(3==ilength(args), args, WNA, s_submr); end1 = CAR(args); args = CDR(args); str2 = CAR(args); args = CDR(args); start2 = CAR(args); - ASSERT(NIMP(str1) && STRINGP(str1), str1, ARG1, s_submr); - ASSERT(INUMP(start1), start1, ARG2, s_submr); - ASSERT(INUMP(end1), end1, ARG3, s_submr); - ASSERT(NIMP(str2) && STRINGP(str2), str2, ARG4, s_submr); - ASSERT(INUMP(start2), start2, ARG5, s_submr); + ASRTER(NIMP(str1) && STRINGP(str1), str1, ARG1, s_submr); + ASRTER(INUMP(start1), start1, ARG2, s_submr); + ASRTER(INUMP(end1), end1, ARG3, s_submr); + ASRTER(NIMP(str2) && STRINGP(str2), str2, ARG4, s_submr); + ASRTER(INUMP(start2), start2, ARG5, s_submr); i = INUM(start1), j = INUM(start2), e = INUM(end1); - ASSERT(i <= LENGTH(str1) && i >= 0, start1, OUTOFRANGE, s_submr); - ASSERT(j <= LENGTH(str2) && j >= 0, start2, OUTOFRANGE, s_submr); - ASSERT(e <= LENGTH(str1) && e >= 0, end1, OUTOFRANGE, s_submr); - ASSERT((j = e-i+j) <= LENGTH(str2), start2, OUTOFRANGE, s_submr); + ASRTER(i <= LENGTH(str1) && i >= 0, start1, OUTOFRANGE, s_submr); + ASRTER(j <= LENGTH(str2) && j >= 0, start2, OUTOFRANGE, s_submr); + ASRTER(e <= LENGTH(str1) && e >= 0, end1, OUTOFRANGE, s_submr); + ASRTER((j = e-i+j) <= LENGTH(str2), start2, OUTOFRANGE, s_submr); while(i<e) CHARS(str2)[--j] = CHARS(str1)[--e]; return UNSPECIFIED; } @@ -116,16 +116,16 @@ SCM subfl(str, start, args) SCM end, fill; long i, e; char c; - ASSERT(2==ilength(args), args, WNA, s_subfl); + ASRTER(2==ilength(args), args, WNA, s_subfl); end = CAR(args); args = CDR(args); fill = CAR(args); - ASSERT(NIMP(str) && STRINGP(str), str, ARG1, s_subfl); - ASSERT(INUMP(start), start, ARG2, s_subfl); - ASSERT(INUMP(end), end, ARG3, s_subfl); - ASSERT(ICHRP(fill), fill, ARG4, s_subfl); + ASRTER(NIMP(str) && STRINGP(str), str, ARG1, s_subfl); + ASRTER(INUMP(start), start, ARG2, s_subfl); + ASRTER(INUMP(end), end, ARG3, s_subfl); + ASRTER(ICHRP(fill), fill, ARG4, s_subfl); i = INUM(start), e = INUM(end);c = ICHR(fill); - ASSERT(i <= LENGTH(str) && i >= 0, start, OUTOFRANGE, s_subfl); - ASSERT(e <= LENGTH(str) && e >= 0, end, OUTOFRANGE, s_subfl); + ASRTER(i <= LENGTH(str) && i >= 0, start, OUTOFRANGE, s_subfl); + ASRTER(e <= LENGTH(str) && e >= 0, end, OUTOFRANGE, s_subfl); while(i<e) CHARS(str)[i++] = c; return UNSPECIFIED; } @@ -134,7 +134,7 @@ static char s_strnullp[] = "string-null?"; SCM strnullp(str) SCM str; { - ASSERT(NIMP(str) && STRINGP(str), str, ARG1, s_strnullp); + ASRTER(NIMP(str) && STRINGP(str), str, ARG1, s_strnullp); if LENGTH(str) return BOOL_F; else return BOOL_T; } @@ -150,7 +150,7 @@ SCM appendb(args) args = CDR(args); if NULLP(args) return arg; if NULLP(arg) goto tail; - ASSERT(NIMP(arg) && CONSP(arg), arg, ARG1, s_appendb); + ASRTER(NIMP(arg) && CONSP(arg), arg, ARG1, s_appendb); CDR(last_pair(arg)) = appendb(args); return arg; } @@ -161,6 +161,8 @@ static iproc lsubr2s[] = { {s_subfl, subfl}, {0, 0}}; +SCM_DLL_EXPORT void init_sc2 P((void)); + void init_sc2() { make_subr(s_last_pair, tc7_subr_1, last_pair); @@ -74,8 +74,9 @@ sizet num_protects = NUM_PROTECTS; char s_inexactp[] = "inexact?"; static char s_zerop[] = "zero?", s_positivep[] = "positive?", s_negativep[] = "negative?"; -static char s_eqp[] = "=", s_lessp[] = "<", s_grp[] = ">"; +static char s_lessp[] = "<", s_grp[] = ">"; static char s_leqp[] = "<=", s_greqp[] = ">="; +#define s_eqp (&s_leqp[1]) static char s_max[] = "max", s_min[] = "min"; char s_sum[] = "+", s_difference[] = "-", s_product[] = "*", s_divide[] = "/"; @@ -91,9 +92,6 @@ static char s_intexpt[] = "integer-expt"; /*** NUMBERS -> STRINGS ***/ #ifdef FLOATS -# ifndef DBL_MANT_DIG -# define DBL_MANT_DIG dbl_mant_dig -# endif static int dbl_mant_dig = 0; static double max_dbl_int; /* Integers less than or equal to max_dbl_int are representable exactly as doubles. */ @@ -105,10 +103,10 @@ double dbl_prec(x) double frac = frexp(x, &expt); # ifdef DBL_MIN_EXP if (0.0==x || expt < DBL_MIN_EXP) /* gradual underflow */ - return ldexp(1.0, -DBL_MANT_DIG) * ldexp(1.0, DBL_MIN_EXP); + return ldexp(1.0, - dbl_mant_dig) * ldexp(1.0, DBL_MIN_EXP); # endif - if (1.0==frac) return ldexp(1.0, expt - DBL_MANT_DIG + 1); - return ldexp(1.0, expt - DBL_MANT_DIG); + if (1.0==frac) return ldexp(1.0, expt - dbl_mant_dig + 1); + return ldexp(1.0, expt - dbl_mant_dig); } static double llog2 = 0.3010299956639812; /* log10(2) */ @@ -142,6 +140,17 @@ static double lpow10(x, n) return x/p10[-n]; } +int NaN2str(f, a) + double f; + char *a; +{ + sizet ch = 0; + if (f < 0.0) a[ch++] = '-'; + a[ch++] = IS_INF(f)?'1':'0'; + a[ch++] = '/'; a[ch++] = '0'; + return ch; +} + /* DBL2STR_FUZZ is a somewhat arbitrary guard against round off error in scaling f and fprec. */ # define DBL2STR_FUZZ 0.9 @@ -155,13 +164,10 @@ static sizet idbl2str(f, a) sizet ch = 0; if (f==0.0) {exp = 0; goto zero;} /*{a[0]='0'; a[1]='.'; a[2]='0'; return 3;}*/ + if IS_INF(f) return NaN2str(f, a); if (f < 0.0) {f = -f;a[ch++]='-';} else if (f > 0.0) ; - else goto funny; - if IS_INF(f) { - if (ch==0) a[ch++]='+'; - funny: a[ch++]='#'; a[ch++]='.'; a[ch++]='#'; return ch; - } + else return NaN2str(f, a); exp = apx_log10(f); f = lpow10(f, -exp); fprec = lpow10(fprec, -exp); @@ -171,12 +177,13 @@ static sizet idbl2str(f, a) while (f < 1.0) { f *= 10.0; fprec *= 10.0; - if (exp-- < DBL_MIN_10_EXP - DBL_DIG - 1) goto funny; + if (exp-- < DBL_MIN_10_EXP - DBL_DIG - 1) return NaN2str(f, a); } while (f > 10.0) { f /= 10.0; fprec /= 10.0; - if (exp++ > DBL_MAX_10_EXP) goto funny;} + if (exp++ > DBL_MAX_10_EXP) return NaN2str(f, a); + } # else while (f < 1.0) {f *= 10.0; fprec *= 10.0; exp--;} while (f > 10.0) {f /= 10.0; fprec /= 10.0; exp++;} @@ -258,8 +265,7 @@ static sizet iflo2str(flt, str) # endif i = idbl2str(REAL(flt), str); if CPLXP(flt) { - if(0 <= IMAG(flt)) /* jeh */ - str[i++] = '+'; /* jeh */ + if (!(0 > IMAG(flt))) str[i++] = '+'; i += idbl2str(IMAG(flt), &str[i]); str[i++] = 'i'; } @@ -340,7 +346,7 @@ SCM number2string(x, radix) SCM x, radix; { if UNBNDP(radix) radix=MAKINUM(10L); - else ASSERT(INUMP(radix), radix, ARG2, s_number2string); + else ASRTER(INUMP(radix), radix, ARG2, s_number2string); #ifdef FLOATS if NINUMP(x) { char num_buf[FLOBUFLEN]; @@ -352,18 +358,18 @@ SCM number2string(x, radix) badx: wta(x, (char *)ARG1, s_number2string); # endif # else - ASSERT(NIMP(x) && INEXP(x), x, ARG1, s_number2string); + ASRTER(NIMP(x) && INEXP(x), x, ARG1, s_number2string); # endif return makfromstr(num_buf, iflo2str(x, num_buf)); } #else # ifdef BIGDIG if NINUMP(x) { - ASSERT(NIMP(x) && BIGP(x), x, ARG1, s_number2string); + ASRTER(NIMP(x) && BIGP(x), x, ARG1, s_number2string); return big2str(x, (unsigned int)INUM(radix)); } # else - ASSERT(INUMP(x), x, ARG1, s_number2string); + ASRTER(INUMP(x), x, ARG1, s_number2string); # endif #endif { @@ -451,7 +457,7 @@ SCM istr2int(str, len, radix) ds[k++] = BIGLO(t2); t2 = BIGDN(t2); } - ASSERT(blen <= j, (SCM)MAKINUM(blen), OVFLOW, "bignum"); + ASRTER(blen <= j, (SCM)MAKINUM(blen), OVFLOW, "bignum"); if (t2) {blen++; goto moretodo;} break; default: @@ -630,7 +636,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; @@ -679,9 +685,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; @@ -786,8 +792,8 @@ SCM string2number(str, radix) SCM str, radix; { if UNBNDP(radix) radix=MAKINUM(10L); - else ASSERT(INUMP(radix), radix, ARG2, s_str2number); - ASSERT(NIMP(str) && STRINGP(str), str, ARG1, s_str2number); + 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)); } /*** END strs->nums ***/ @@ -840,9 +846,7 @@ SCM eqv(x, y) if BIGP(x) return (0==bigcomp(x, y)) ? BOOL_T : BOOL_F; # endif # ifdef FLOATS - if (REALPART(x) != REALPART(y)) return BOOL_F; - if (CPLXP(x) && (IMAG(x) != IMAG(y))) return BOOL_F; - return BOOL_T; + return floequal(x, y); # endif } return BOOL_F; @@ -882,10 +886,10 @@ SCM list_tail(lst, k) SCM lst, k; { register long i; - ASSERT(INUMP(k), k, ARG2, s_list_tail); + ASRTER(INUMP(k), k, ARG2, s_list_tail); i = INUM(k); while (i-- > 0) { - ASSERT(NIMP(lst) && CONSP(lst), lst, ARG1, s_list_tail); + ASRTER(NIMP(lst) && CONSP(lst), lst, ARG1, s_list_tail); lst = CDR(lst); } return lst; @@ -897,7 +901,7 @@ SCM string2list(str) long i; SCM res = EOL; unsigned char *src; - ASSERT(NIMP(str) && STRINGP(str), str, ARG1, s_str2list); + ASRTER(NIMP(str) && STRINGP(str), str, ARG1, s_str2list); src = UCHARS(str); for(i = LENGTH(str)-1;i >= 0;i--) res = cons((SCM)MAKICHR(src[i]), res); return res; @@ -905,7 +909,7 @@ SCM string2list(str) SCM string_copy(str) SCM str; { - ASSERT(NIMP(str) && STRINGP(str), str, ARG1, s_st_copy); + ASRTER(NIMP(str) && STRINGP(str), str, ARG1, s_st_copy); return makfromstr(CHARS(str), (sizet)LENGTH(str)); } SCM string_fill(str, chr) @@ -913,8 +917,8 @@ SCM string_fill(str, chr) { register char *dst, c; register long k; - ASSERT(NIMP(str) && STRINGP(str), str, ARG1, s_st_fill); - ASSERT(ICHRP(chr), chr, ARG2, s_st_fill); + ASRTER(NIMP(str) && STRINGP(str), str, ARG1, s_st_fill); + ASRTER(ICHRP(chr), chr, ARG2, s_st_fill); c = ICHR(chr); dst = CHARS(str); for(k = LENGTH(str)-1;k >= 0;k--) dst[k] = c; @@ -926,7 +930,7 @@ SCM vector2list(v) SCM res = EOL; long i; SCM *data; - ASSERT(NIMP(v) && VECTORP(v), v, ARG1, s_vect2list); + ASRTER(NIMP(v) && VECTORP(v), v, ARG1, s_vect2list); data = VELTS(v); for(i = LENGTH(v)-1;i >= 0;i--) res = cons(data[i], res); return res; @@ -936,7 +940,7 @@ SCM vector_fill(v, fill) { register long i; register SCM *data; - ASSERT(NIMP(v) && VECTORP(v), v, ARG1, s_ve_fill); + ASRTER(NIMP(v) && VECTORP(v), v, ARG1, s_ve_fill); data = VELTS(v); for(i = LENGTH(v)-1;i >= 0;i--) data[i] = fill; return UNSPECIFIED; @@ -958,12 +962,14 @@ SCM bigequal(x, y) } #endif #ifdef FLOATS +# define REALLY_UNEQUAL(x,y) ((x) != (y) && !((x)!=(x) && (y)!=(y))) SCM floequal(x, y) SCM x, y; { - if (REALPART(x) != REALPART(y)) return BOOL_F; - if (!(CPLXP(x) && (IMAG(x) != IMAG(y)))) return BOOL_T; - return BOOL_F; + if (REALLY_UNEQUAL(REALPART(x), REALPART(y))) return BOOL_F; + if (CPLXP(x)) + return (CPLXP(y) && !REALLY_UNEQUAL(IMAG(x), IMAG(y))) ? BOOL_T : BOOL_F; + return CPLXP(y) ? BOOL_F : BOOL_T; } #endif SCM equal(x, y) @@ -1030,7 +1036,7 @@ int scm_bigdblcomp(b, d) blen = INUM(scm_intlength(b)); if (blen > dlen) return dneg ? 1 : -1; if (blen < dlen) return dneg ? -1 : 1; - if ((blen <= DBL_MANT_DIG) || (blen - scm_twos_power(b)) <= DBL_MANT_DIG) { + if ((blen <= dbl_mant_dig) || (blen - scm_twos_power(b)) <= dbl_mant_dig) { double bd = big2dbl(b); if (bd > d) return -1; if (bd < d) return 1; @@ -1075,6 +1081,7 @@ SCM inexactp(x) #endif return BOOL_F; } + SCM eqp(x, y) SCM x, y; { @@ -1097,7 +1104,7 @@ SCM eqp(x, y) } ASRTGO(INEXP(x), badx); # else - ASSERT(NIMP(x) && INEXP(x), x, ARG1, s_eqp); + ASRTER(NIMP(x) && INEXP(x), x, ARG1, s_eqp); # endif if INUMP(y) {t = x; x = y; y = t; goto realint;} # ifdef BIGDIG @@ -1107,10 +1114,8 @@ SCM eqp(x, y) # else ASRTGO(NIMP(y) && INEXP(y), bady); # endif - if (REALPART(x) != REALPART(y)) return BOOL_F; - if CPLXP(x) - return (CPLXP(y) && (IMAG(x)==IMAG(y))) ? BOOL_T : BOOL_F; - return CPLXP(y) ? BOOL_F : BOOL_T; + if (x==y) return BOOL_T; + return floequal(x, y); } if NINUMP(y) { # ifdef BIGDIG @@ -1132,7 +1137,7 @@ SCM eqp(x, y) #else # ifdef BIGDIG if NINUMP(x) { - ASSERT(NIMP(x) && BIGP(x), x, ARG1, s_eqp); + ASRTER(NIMP(x) && BIGP(x), x, ARG1, s_eqp); if INUMP(y) return BOOL_F; ASRTGO(NIMP(y) && BIGP(y), bady); return (0==bigcomp(x, y)) ? BOOL_T : BOOL_F; @@ -1145,8 +1150,8 @@ SCM eqp(x, y) return BOOL_F; } # else - ASSERT(INUMP(x), x, ARG1, s_eqp); - ASSERT(INUMP(y), y, ARG2, s_eqp); + ASRTER(INUMP(x), x, ARG1, s_eqp); + ASRTER(INUMP(y), y, ARG2, s_eqp); # endif #endif return ((long)x==(long)y) ? BOOL_T : BOOL_F; @@ -1170,7 +1175,7 @@ SCM lessp(x, y) } ASRTGO(REALP(x), badx); # else - ASSERT(NIMP(x) && REALP(x), x, ARG1, s_lessp); + ASRTER(NIMP(x) && REALP(x), x, ARG1, s_lessp); # endif if INUMP(y) return (REALPART(x) < ((double)INUM(y))) ? BOOL_T : BOOL_F; # ifdef BIGDIG @@ -1201,7 +1206,7 @@ SCM lessp(x, y) #else # ifdef BIGDIG if NINUMP(x) { - ASSERT(NIMP(x) && BIGP(x), x, ARG1, s_lessp); + ASRTER(NIMP(x) && BIGP(x), x, ARG1, s_lessp); 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; @@ -1214,8 +1219,8 @@ SCM lessp(x, y) return BIGSIGN(y) ? BOOL_F : BOOL_T; } # else - ASSERT(INUMP(x), x, ARG1, s_lessp); - ASSERT(INUMP(y), y, ARG2, s_lessp); + ASRTER(INUMP(x), x, ARG1, s_lessp); + ASRTER(INUMP(y), y, ARG2, s_lessp); # endif #endif return ((long)x < (long)y) ? BOOL_T : BOOL_F; @@ -1248,18 +1253,18 @@ SCM zerop(z) badz: wta(z, (char *)ARG1, s_zerop); # endif # else - ASSERT(NIMP(z) && INEXP(z), z, ARG1, s_zerop); + ASRTER(NIMP(z) && INEXP(z), z, ARG1, s_zerop); # endif return (z==flo0) ? BOOL_T : BOOL_F; } #else # ifdef BIGDIG if NINUMP(z) { - ASSERT(NIMP(z) && BIGP(z), z, ARG1, s_zerop); + ASRTER(NIMP(z) && BIGP(z), z, ARG1, s_zerop); return BOOL_F; } # else - ASSERT(INUMP(z), z, ARG1, s_zerop); + ASRTER(INUMP(z), z, ARG1, s_zerop); # endif #endif return (z==INUM0) ? BOOL_T: BOOL_F; @@ -1277,18 +1282,18 @@ SCM positivep(x) badx: wta(x, (char *)ARG1, s_positivep); # endif # else - ASSERT(NIMP(x) && REALP(x), x, ARG1, s_positivep); + ASRTER(NIMP(x) && REALP(x), x, ARG1, s_positivep); # endif return (REALPART(x) > 0.0) ? BOOL_T : BOOL_F; } #else # ifdef BIGDIG if NINUMP(x) { - ASSERT(NIMP(x) && BIGP(x), x, ARG1, s_positivep); + ASRTER(NIMP(x) && BIGP(x), x, ARG1, s_positivep); return TYP16(x)==tc16_bigpos ? BOOL_T : BOOL_F; } # else - ASSERT(INUMP(x), x, ARG1, s_positivep); + ASRTER(INUMP(x), x, ARG1, s_positivep); # endif #endif return (x > INUM0) ? BOOL_T : BOOL_F; @@ -1306,18 +1311,18 @@ SCM negativep(x) badx: wta(x, (char *)ARG1, s_negativep); # endif # else - ASSERT(NIMP(x) && REALP(x), x, ARG1, s_negativep); + ASRTER(NIMP(x) && REALP(x), x, ARG1, s_negativep); # endif return (REALPART(x) < 0.0) ? BOOL_T : BOOL_F; } #else # ifdef BIGDIG if NINUMP(x) { - ASSERT(NIMP(x) && BIGP(x), x, ARG1, s_negativep); + ASRTER(NIMP(x) && BIGP(x), x, ARG1, s_negativep); return (TYP16(x)==tc16_bigneg) ? BOOL_T : BOOL_F; } # else - ASSERT(INUMP(x), x, ARG1, s_negativep); + ASRTER(INUMP(x), x, ARG1, s_negativep); # endif #endif return (x < INUM0) ? BOOL_T : BOOL_F; @@ -1350,12 +1355,12 @@ SCM lmax(x, y) big_dbl: if (-1 != scm_bigdblcomp(x, REALPART(y))) return y; z = big2dbl(x); - ASSERT(0==scm_bigdblcomp(x, z), x, s_exactprob, s_max); + ASRTER(0==scm_bigdblcomp(x, z), x, s_exactprob, s_max); return makdbl(z, 0.0); } ASRTGO(REALP(x), badx); # else - ASSERT(NIMP(x) && REALP(x), x, ARG1, s_max); + ASRTER(NIMP(x) && REALP(x), x, ARG1, s_max); # endif if INUMP(y) return (REALPART(x) < (z = INUM(y))) ? makdbl(z, 0.0) : x; # ifdef BIGDIG @@ -1388,7 +1393,7 @@ SCM lmax(x, y) #else # ifdef BIGDIG if NINUMP(x) { - ASSERT(NIMP(x) && BIGP(x), x, ARG1, s_max); + ASRTER(NIMP(x) && BIGP(x), x, ARG1, s_max); if INUMP(y) return BIGSIGN(x) ? y : x; ASRTGO(NIMP(y) && BIGP(y), bady); return (1==bigcomp(x, y)) ? y : x; @@ -1401,8 +1406,8 @@ SCM lmax(x, y) return BIGSIGN(y) ? x : y; } # else - ASSERT(INUMP(x), x, ARG1, s_max); - ASSERT(INUMP(y), y, ARG2, s_max); + ASRTER(INUMP(x), x, ARG1, s_max); + ASRTER(INUMP(y), y, ARG2, s_max); # endif #endif return ((long)x < (long)y) ? y : x; @@ -1434,12 +1439,12 @@ SCM lmin(x, y) big_dbl: if (1 != scm_bigdblcomp(x, REALPART(y))) return y; z = big2dbl(x); - ASSERT(0==scm_bigdblcomp(x, z), x, s_exactprob, s_min); + ASRTER(0==scm_bigdblcomp(x, z), x, s_exactprob, s_min); return makdbl(z, 0.0); } ASRTGO(REALP(x), badx); # else - ASSERT(NIMP(x) && REALP(x), x, ARG1, s_min); + ASRTER(NIMP(x) && REALP(x), x, ARG1, s_min); # endif if INUMP(y) return (REALPART(x) > (z = INUM(y))) ? makdbl(z, 0.0) : x; # ifdef BIGDIG @@ -1472,7 +1477,7 @@ SCM lmin(x, y) #else # ifdef BIGDIG if NINUMP(x) { - ASSERT(NIMP(x) && BIGP(x), x, ARG1, s_min); + ASRTER(NIMP(x) && BIGP(x), x, ARG1, s_min); if INUMP(y) return BIGSIGN(x) ? x : y; ASRTGO(NIMP(y) && BIGP(y), bady); return (-1==bigcomp(x, y)) ? y : x; @@ -1485,8 +1490,8 @@ SCM lmin(x, y) return BIGSIGN(y) ? y : x; } # else - ASSERT(INUMP(x), x, ARG1, s_min); - ASSERT(INUMP(y), y, ARG2, s_min); + ASRTER(INUMP(x), x, ARG1, s_min); + ASRTER(INUMP(y), y, ARG2, s_min); # endif #endif return ((long)x > (long)y) ? y : x; @@ -1589,7 +1594,7 @@ SCM sum(x, y) } # else ASRTGO(INUMP(x), badx); - ASSERT(INUMP(y), y, ARG2, s_sum); + ASRTER(INUMP(y), y, ARG2, s_sum); # endif #endif x = INUM(x)+INUM(y); @@ -1642,11 +1647,12 @@ SCM difference(x, y) ASRTGO(INEXP(x), badx); ASRTGO(NIMP(y) && INEXP(y), bady); # endif - if CPLXP(x) + 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;} @@ -1678,7 +1684,7 @@ SCM difference(x, y) #else # ifdef BIGDIG if NINUMP(x) { - ASSERT(NIMP(x) && BIGP(x), x, ARG1, s_difference); + ASRTER(NIMP(x) && BIGP(x), x, ARG1, s_difference); if UNBNDP(y) { x = copybig(x, !BIGSIGN(x)); return NUMDIGS(x) * BITSPERDIG/CHAR_BIT <= sizeof(SCM) ? @@ -1717,9 +1723,9 @@ SCM difference(x, y) } } # else - ASSERT(INUMP(x), x, ARG1, s_difference); + ASRTER(INUMP(x), x, ARG1, s_difference); if UNBNDP(y) {x = -INUM(x); goto checkx;} - ASSERT(INUMP(y), y, ARG2, s_difference); + ASRTER(INUMP(y), y, ARG2, s_difference); # endif #endif x = INUM(x)-INUM(y); @@ -1779,12 +1785,13 @@ SCM product(x, y) bady: wta(y, (char *)ARG2, s_product); # endif # endif - if CPLXP(x) + 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 return makdbl(REAL(x)*REALPART(y), IMAG(x)*REALPART(y)); + } return makdbl(REALPART(x)*REALPART(y), CPLXP(y)?REALPART(x)*IMAG(y):0.0); } @@ -1842,7 +1849,7 @@ SCM product(x, y) } # else ASRTGO(INUMP(x), badx); - ASSERT(INUMP(y), y, ARG2, s_product); + ASRTER(INUMP(y), y, ARG2, s_product); # endif #endif { @@ -1902,7 +1909,7 @@ SCM divide(x, y) SCM z; if INUMP(y) { z = INUM(y); - ASSERT(z, y, OVFLOW, s_divide); + ASRTER(z, y, OVFLOW, s_divide); if (1==z) return x; if (z < 0) z = -z; if (z < BIGRAD) { @@ -1978,7 +1985,7 @@ SCM divide(x, y) # ifdef BIGDIG if NINUMP(x) { SCM z; - ASSERT(NIMP(x) && BIGP(x), x, ARG1, s_divide); + ASRTER(NIMP(x) && BIGP(x), x, ARG1, s_divide); if UNBNDP(y) goto ov; if INUMP(y) { z = INUM(y); @@ -2020,12 +2027,12 @@ SCM divide(x, y) goto ov; } # else - ASSERT(INUMP(x), x, ARG1, s_divide); + ASRTER(INUMP(x), x, ARG1, s_divide); if UNBNDP(y) { if ((MAKINUM(1L)==x) || (MAKINUM(-1L)==x)) return x; goto ov; } - ASSERT(INUMP(y), y, ARG2, s_divide); + ASRTER(INUMP(y), y, ARG2, s_divide); # endif #endif { @@ -2056,7 +2063,7 @@ SCM scm_intexpt(z1, z2) if (INUM0==z1 || acc==z1) return z1; else if (MAKINUM(-1L)==z1) return BOOL_F==evenp(z2)?z1:acc; #endif - ASSERT(INUMP(z2), z2, ARG2, s_intexpt); + ASRTER(INUMP(z2), z2, ARG2, s_intexpt); z2 = INUM(z2); if (z2 < 0) { z2 = -z2; @@ -2101,7 +2108,7 @@ SCM scm_intexpt(z1, z2) #endif goto ret; } - ASSERT(NIMP(z1), z1, ARG1, s_intexpt); + ASRTER(NIMP(z1), z1, ARG1, s_intexpt); #ifdef FLOATS if REALP(z1) { dz1 = REALPART(z1); @@ -2183,7 +2190,7 @@ void two_doubles(z1, z2, sstring, xy) # endif xy->x = REALPART(z1);} # else - {ASSERT(NIMP(z1) && REALP(z1), z1, ARG1, sstring); + {ASRTER(NIMP(z1) && REALP(z1), z1, ARG1, sstring); xy->x = REALPART(z1);} # endif } @@ -2199,7 +2206,7 @@ void two_doubles(z1, z2, sstring, xy) # endif xy->y = REALPART(z2);} # else - {ASSERT(NIMP(z2) && REALP(z2), z2, ARG2, sstring); + {ASRTER(NIMP(z2) && REALP(z2), z2, ARG2, sstring); xy->y = REALPART(z2);} # endif } @@ -2246,7 +2253,7 @@ SCM real_part(z) badz: wta(z, (char *)ARG1, s_real_part); # endif # else - ASSERT(NIMP(z) && INEXP(z), z, ARG1, s_real_part); + ASRTER(NIMP(z) && INEXP(z), z, ARG1, s_real_part); # endif if CPLXP(z) return makdbl(REAL(z), 0.0); } @@ -2264,7 +2271,7 @@ SCM imag_part(z) badz: wta(z, (char *)ARG1, s_imag_part); # endif # else - ASSERT(NIMP(z) && INEXP(z), z, ARG1, s_imag_part); + ASRTER(NIMP(z) && INEXP(z), z, ARG1, s_imag_part); # endif if CPLXP(z) return makdbl(IMAG(z), 0.0); return flo0; @@ -2281,7 +2288,7 @@ SCM magnitude(z) badz: wta(z, (char *)ARG1, s_magnitude); # endif # else - ASSERT(NIMP(z) && INEXP(z), z, ARG1, s_magnitude); + ASRTER(NIMP(z) && INEXP(z), z, ARG1, s_magnitude); # endif if CPLXP(z) { @@ -2304,7 +2311,7 @@ SCM angle(z) badz: wta(z, (char *)ARG1, s_angle);} # endif # else - ASSERT(NIMP(z) && INEXP(z), z, ARG1, s_angle); + ASRTER(NIMP(z) && INEXP(z), z, ARG1, s_angle); # endif if REALP(z) {x = REALPART(z); goto do_angle;} x = REAL(z); y = IMAG(z); @@ -2336,7 +2343,7 @@ SCM in2ex(z) badz: wta(z, (char *)ARG1, s_in2ex); # endif # else - ASSERT(NIMP(z) && REALP(z), z, ARG1, s_in2ex); + ASRTER(NIMP(z) && REALP(z), z, ARG1, s_in2ex); # endif # ifdef BIGDIG { @@ -2349,7 +2356,7 @@ SCM in2ex(z) SCM ans = MAKINUM((long)u); if (INUM(ans)==(long)u) return ans; } - ASRTGO(!IS_INF(u), badz); /* problem? */ + ASRTGO(!(IS_INF(u) || (u)!=(u)), badz); /* problem? */ return dbl2big(u); } # else @@ -2361,7 +2368,7 @@ static char s_trunc[] = "truncate"; SCM numident(x) SCM x; { - ASSERT(INUMP(x), x, ARG1, s_trunc); + ASRTER(INUMP(x), x, ARG1, s_trunc); return x; } #endif /* FLOATS */ @@ -2385,7 +2392,7 @@ SCM dbl2big(d) u -= c; digits[i] = c; } - ASSERT(0==u, INUM0, OVFLOW, "dbl2big"); + ASRTER(0==u, INUM0, OVFLOW, "dbl2big"); return ans; } double big2dbl(b) @@ -2480,7 +2487,7 @@ static char s_dfloat_parts[] = "double-float-parts"; SCM scm_dfloat_parts(f) SCM f; { - int expt, ndig = DBL_MANT_DIG; + int expt, ndig = dbl_mant_dig; double mant = frexp(num2dbl(f, (char *)ARG1, s_dfloat_parts), &expt); # ifdef DBL_MIN_EXP if (expt < DBL_MIN_EXP) @@ -2496,8 +2503,8 @@ SCM scm_make_dfloat(mant, expt) { double dmant = num2dbl(mant, (char *)ARG1, s_make_dfloat); int e = INUM(expt); - ASSERT(INUMP(expt), expt, ARG2, s_make_dfloat); - ASSERT((dmant < 0 ? -dmant : dmant)<=max_dbl_int, mant, + ASRTER(INUMP(expt), expt, ARG2, s_make_dfloat); + ASRTER((dmant < 0 ? -dmant : dmant)<=max_dbl_int, mant, OUTOFRANGE, s_make_dfloat); return makdbl(ldexp(dmant, e), 0.0); } @@ -2515,7 +2522,7 @@ SCM scm_next_dfloat(f1, f2) if (e < DBL_MIN_EXP) eps = ldexp(eps, DBL_MIN_EXP - e); else if (0.0==d) - eps = ldexp(1.0, DBL_MIN_EXP - DBL_MANT_DIG); + eps = ldexp(1.0, DBL_MIN_EXP - dbl_mant_dig); # endif d = ldexp(d + eps, e); } @@ -2524,7 +2531,7 @@ SCM scm_next_dfloat(f1, f2) if (e < DBL_MIN_EXP) eps = ldexp(eps, DBL_MIN_EXP - e); else if (0.0==d) - eps = ldexp(-1.0, DBL_MIN_EXP - DBL_MANT_DIG); + eps = ldexp(-1.0, DBL_MIN_EXP - dbl_mant_dig); # endif if (0.5==d) eps *= 0.5; d = ldexp(d - eps, e); @@ -2616,7 +2623,7 @@ SCM hash(obj, n) SCM obj; SCM n; { - ASSERT(INUMP(n) && 0 <= n, n, ARG2, s_hash); + ASRTER(INUMP(n) && 0 <= n, n, ARG2, s_hash); return MAKINUM(hasher(obj, INUM(n), 10)); } @@ -2624,7 +2631,7 @@ SCM hashv(obj, n) SCM obj; SCM n; { - ASSERT(INUMP(n) && 0 <= n, n, ARG2, s_hashv); + ASRTER(INUMP(n) && 0 <= n, n, ARG2, s_hashv); 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)); @@ -2634,7 +2641,7 @@ SCM hashq(obj, n) SCM obj; SCM n; { - ASSERT(INUMP(n) && 0 <= n, n, ARG2, s_hashq); + ASRTER(INUMP(n) && 0 <= n, n, ARG2, s_hashq); return MAKINUM((((unsigned) obj) >> 1) % INUM(n)); } @@ -2755,13 +2762,11 @@ static dblproc cxrs[] = { #endif #ifdef FLOATS -/* # ifndef DBL_DIG -- also needed for ifndef DBL_MANT_DIG */ static void add1(f, fsum) double f, *fsum; { *fsum = f + 1.0; } -/* #endif */ #endif void init_scl() @@ -2803,7 +2808,7 @@ void init_scl() # ifdef DBL_MANT_DIG dbl_mant_dig = DBL_MANT_DIG; # else - if (!DBL_MANT_DIG) { /* means we #defined it. */ + { /* means we #defined it. */ double fsum = 0.0, eps = 1.0; int i = 0; while (fsum != 1.0) { @@ -2816,7 +2821,7 @@ void init_scl() # endif /* DBL_MANT_DIG */ max_dbl_int = pow(2.0, dbl_mant_dig - 1.0); max_dbl_int = max_dbl_int + (max_dbl_int - 1.0); - dbl_eps = ldexp(1.0, -dbl_mant_dig); - sysintern("double-float-mantissa-length", MAKINUM(DBL_MANT_DIG)); + dbl_eps = ldexp(1.0, - dbl_mant_dig); + sysintern("double-float-mantissa-length", MAKINUM(dbl_mant_dig)); #endif } @@ -1,5 +1,5 @@ .\" dummy line -.TH SCM "Jan 4 2000" +.TH SCM "1" .UC 4 .SH NAME scm \- a Scheme Language Interpreter @@ -128,12 +128,12 @@ contains initialization code, it will be run when the database is opened. .TP .BI -o dumpname -saves the current SCM session as the executable program +saves the current SCM session as the executable program .I dumpname. -This option works only in SCM builds supporting +This option works only in SCM builds supporting .BI dump. -If options appear on the command line after +If options appear on the command line after .I -o dumpname, then the saved session will continue with processing those options when it is invoked. Otherwise the (new) command line is processed as @@ -248,7 +248,7 @@ can be overridden by subsequent -i and -b options. .ne 5 .TP 5 % scm foo.scm arg1 arg2 arg3 -.br +.br Load and execute the contents of foo.scm. Parameters arg1 arg2 and arg3 are stored in the global list *argv*. .TP @@ -1,4 +1,4 @@ -/* Copyright (C) 1990-1999 Free Software Foundation, Inc. +/* Copyright (C) 1990-2002 Free Software Foundation, Inc. * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -50,6 +50,10 @@ #include "scm.h" #include "patchlvl.h" +#ifdef _WIN32 +#include <io.h> +#endif + #ifdef __IBMC__ # include <io.h> #endif @@ -66,6 +70,9 @@ # ifdef SVR4 # include <unistd.h> # endif +# ifdef __NetBSD__ +# include <unistd.h> +# endif # ifdef __OpenBSD__ # include <unistd.h> # endif @@ -104,7 +111,7 @@ void final_repl P((void)); void init_banner() { - fputs("SCM version "SCMVERSION", Copyright (C) 1990-1999 \ + fputs("SCM version "SCMVERSION", Copyright (C) 1990-2002 \ Free Software Foundation.\n\ SCM comes with ABSOLUTELY NO WARRANTY; for details type `(terms)'.\n\ This is free software, and you are welcome to redistribute it\n\ @@ -119,6 +126,8 @@ void scm_init_INITS() #endif } } + +void (*init_user_scm) P((void)); SCM scm_init_extensions() { #ifdef COMPILED_INITS @@ -195,6 +204,71 @@ void process_signals() } deferred_proc = 0; } + + +#ifdef WINSIGNALS +SCM_EXPORT HANDLE scm_hMainThread; +HANDLE scm_hMainThread; +static SIGRETTYPE scmable_signal(int sig); +# ifdef __MINGW32__ +static void sigintstub(); +__asm(".globl _sigintstub"); +__asm("_sigintstub:"); +__asm(" pushl $2"); +__asm(" call _scmable_signal"); +__asm(" addl $4, %esp"); +__asm(" popal"); +__asm(" popfl"); +__asm(" ret"); +# else /* works for Microsoft VC++ */ +static __declspec(naked) void sigintstub() +{ + scmable_signal(SIGINT); + __asm popad; + __asm popfd; + __asm ret; +} +# endif /* def __MINGW32__ */ + +/* control-c signal handler */ +SIGRETTYPE win32_sigint(int sig) +{ + CONTEXT ctx; + DWORD *Stack; + + if(-1 == SuspendThread(scm_hMainThread)) + return; + + ctx.ContextFlags = CONTEXT_FULL; + if(0 == GetThreadContext(scm_hMainThread, &ctx)) + { + ResumeThread(scm_hMainThread); + return; + } + + Stack = (DWORD *)ctx.Esp; + + *--Stack = ctx.Eip; + *--Stack = ctx.EFlags; + *--Stack = ctx.Eax; + *--Stack = ctx.Ecx; + *--Stack = ctx.Edx; + *--Stack = ctx.Ebx; + *--Stack = ctx.Esp; + *--Stack = ctx.Ebp; + *--Stack = ctx.Esi; + *--Stack = ctx.Edi; + ctx.Esp = (DWORD)Stack; + + ctx.Eip = (DWORD)sigintstub; + + SetThreadContext(scm_hMainThread, &ctx); + ResumeThread(scm_hMainThread); +} + +#endif /*def WINSIGNALS*/ + + static char s_unksig[] = "unknown signal"; static SIGRETTYPE err_signal(sig) int sig; @@ -205,6 +279,7 @@ static SIGRETTYPE err_signal(sig) if (sig == sigdesc[i].signo) break; wta(MAKINUM(sig), (i < 0 ? s_unksig : (char *)(i + SIGNAL_BASE)), ""); } + static SIGRETTYPE scmable_signal(sig) int sig; { @@ -212,7 +287,12 @@ static SIGRETTYPE scmable_signal(sig) int i = NUM_SIGNALS; while (i--) if (sig == sigdesc[i].signo) break; - ASSERT(i >= 0, MAKINUM(sig), s_unksig, ""); + ASRTER(i >= 0, MAKINUM(sig), s_unksig, ""); +#ifdef WINSIGNALS + if(SIGINT == sig) + signal(sig, win32_sigint); + else +#endif signal(sig, scmable_signal); if (ints_disabled) { deferred_proc = process_signals; @@ -235,6 +315,8 @@ static SIGRETTYPE scmable_signal(sig) errno = oerr; } + + /* If doesn't have SIGFPE, disable FLOATS for the rest of this file. */ #ifndef SIGFPE @@ -259,7 +341,7 @@ SCM lalarm(i) SCM i; { unsigned int j; - ASSERT(INUMP(i) && (INUM(i) >= 0), i, ARG1, s_alarm); + ASRTER(INUMP(i) && (INUM(i) >= 0), i, ARG1, s_alarm); SYSCALL(j = alarm(INUM(i));); return MAKINUM(j); } @@ -282,9 +364,9 @@ SCM scm_setitimer(which, value, interval) SYSCALL(w = getitimer(w, &oval);); else { if (BOOL_F==value) value = INUM0; - ASSERT(INUMP(value), value, ARG2, s_setitimer); + ASRTER(INUMP(value), value, ARG2, s_setitimer); if (BOOL_F==interval) interval = INUM0; - ASSERT(INUMP(interval), interval, ARG3, s_setitimer); + ASRTER(INUMP(interval), interval, ARG3, s_setitimer); tval.it_value.tv_sec = INUM(value) / 1000; tval.it_value.tv_usec = (INUM(value) % 1000)*1000; tval.it_interval.tv_sec = INUM(interval) / 1000; @@ -326,7 +408,7 @@ SCM l_sleep(i) SCM i; { unsigned int j = 0; - ASSERT(INUMP(i) && (INUM(i) >= 0), i, ARG1, s_sleep); + ASRTER(INUMP(i) && (INUM(i) >= 0), i, ARG1, s_sleep); # ifdef __HIGHC__ SYSCALL(sleep(INUM(i));); # else @@ -387,7 +469,7 @@ static char s_raise[] = "raise"; SCM l_raise(sig) SCM sig; { - ASSERT(INUMP(sig), sig, ARG1, s_raise); + ASRTER(INUMP(sig), sig, ARG1, s_raise); #ifdef LACK_RAISE # ifdef vms return MAKINUM(gsignal((int)INUM(sig))); @@ -472,15 +554,19 @@ static void init_sig1(scm_err, signo, handler) SIGRETTYPE (*handler)(); { int i = scm_err - SIGNAL_BASE; - ASSERT(i < NUM_SIGNALS, MAKINUM(i), OUTOFRANGE, "init_sig1"); + ASRTER(i < NUM_SIGNALS, MAKINUM(i), OUTOFRANGE, "init_sig1"); sigdesc[i].signo = signo; sigdesc[i].nsig = handler; sigdesc[i].osig = signal(signo, handler); } void init_signals() { -#ifdef SIGINT +#ifdef WINSIGNALS + init_sig1(INT_SIGNAL, SIGINT, win32_sigint); +#else +# ifdef SIGINT init_sig1(INT_SIGNAL, SIGINT, scmable_signal); +# endif #endif #ifdef SIGHUP init_sig1(HUP_SIGNAL, SIGHUP, scmable_signal); @@ -707,6 +793,10 @@ void final_scm(freeall) # define SYSTNAME "amiga" # define DIRSEP "/" #endif +#ifdef __NetBSD__ +# define SYSTNAME "unix" +# define DIRSEP "/" +#endif const char dirsep[] = DIRSEP; SCM softtype() @@ -766,9 +856,9 @@ int init_buf0(inport) # endif # endif # endif +#endif return !0; /* stdin gets marked BUF0 in init_scm() */ } -#endif return 0; } @@ -786,10 +876,10 @@ SCM scm_execpath(newpath) execpath = 0; return retval; } - ASSERT(NIMP(newpath) && STRINGP(newpath), newpath, ARG1, s_execpath); + ASRTER(NIMP(newpath) && STRINGP(newpath), newpath, ARG1, s_execpath); if (execpath) free(execpath); execpath = (char *)malloc((sizet)(LENGTH(newpath) + 1)); - ASSERT(execpath, newpath, NALLOC, s_execpath); + ASRTER(execpath, newpath, NALLOC, s_execpath); strncpy(execpath, CHARS(newpath), LENGTH(newpath) + 1); return retval; } @@ -836,7 +926,7 @@ char s_system[] = "system"; SCM lsystem(cmd) SCM cmd; { - ASSERT(NIMP(cmd) && STRINGP(cmd), cmd, ARG1, s_system); + ASRTER(NIMP(cmd) && STRINGP(cmd), cmd, ARG1, s_system); ignore_signals(); # ifdef AZTEC_C cmd = MAKINUM(Execute(CHARS(cmd), 0, 0)); @@ -854,7 +944,7 @@ SCM lgetenv(nam) SCM nam; { char *val; - ASSERT(NIMP(nam) && STRINGP(nam), nam, ARG1, s_getenv); + ASRTER(NIMP(nam) && STRINGP(nam), nam, ARG1, s_getenv); val = getenv(CHARS(nam)); if (!val) return BOOL_F; return makfrom0str(val); @@ -868,7 +958,7 @@ SCM ed(fname) SCM fname; { struct dsc$descriptor_s d; - ASSERT(NIMP(fname) && STRINGP(fname), fname, ARG1, s_ed); + ASRTER(NIMP(fname) && STRINGP(fname), fname, ARG1, s_ed); d.dsc$b_dtype = DSC$K_DTYPE_T; d.dsc$b_class = DSC$K_CLASS_S; d.dsc$w_length = LENGTH(fname); @@ -45,6 +45,14 @@ extern "C" { #endif +#ifdef _WIN32 +# include <windows.h> +#endif + +#ifdef _WIN32_WCE +# include <windows.h> +#endif + #ifdef hpux # ifndef __GNUC__ # define const /**/ @@ -71,6 +79,27 @@ typedef struct {const char *name;} subr_info; #include <stdio.h> #include "scmfig.h" +#ifdef _WIN32 +# ifdef DLLSCM +# define SCM_DLL_EXPORT __declspec(dllexport) +# define SCM_DLL_IMPORT __declspec(dllimport) +# ifdef SCM_DLL +# define SCM_EXPORT SCM_DLL_EXPORT +# else +# define SCM_EXPORT SCM_DLL_IMPORT +# endif +# else +# define SCM_DLL_EXPORT /**/ +# define SCM_DLL_IMPORT extern +# define SCM_EXPORT extern +# endif +#else +# define SCM_DLL_EXPORT /**/ +# define SCM_DLL_IMPORT extern +# define SCM_EXPORT extern +#endif + + typedef struct { sizet eltsize; sizet len; @@ -178,7 +207,7 @@ typedef struct {SCM type;double *real;} dbl; as in backtraces, make a little more sense. */ #define MAKSPCSYM2(work, look) ((127L & (work)) | ((127L<<9) & (look))) -extern char *isymnames[]; +SCM_EXPORT char *isymnames[]; #define NUM_ISPCSYM 14 #define IM_AND MAKSPCSYM(0) #define IM_BEGIN MAKSPCSYM(1) @@ -213,7 +242,7 @@ extern char *isymnames[]; #define s_quasiquote (ISYMCHARS(IM_QUASIQUOTE)+2) #define s_let_syntax (ISYMCHARS(IM_LET_SYNTAX)+2) -extern SCM i_dot, i_quote, i_quasiquote, i_unquote, i_uq_splicing; +SCM_EXPORT SCM i_dot, i_quote, i_quasiquote, i_unquote, i_uq_splicing; #define s_apply (ISYMCHARS(IM_APPLY)+2) /* each symbol defined here must have a unique number which @@ -301,8 +330,14 @@ extern SCM i_dot, i_quote, i_quasiquote, i_unquote, i_uq_splicing; #define GCCDR(x) (~1L & CDR(x)) #define SETCDR(x, v) CDR(x) = (SCM)(v) +#ifdef _M_ARM +/* MS CLARM compiler bug workaround. */ +volatile SCM MS_CLARM_dumy; +# define CODE(x) (MS_CLARM_dumy = (CAR(x)-tc3_closure)) +#else +# define CODE(x) (CAR(x)-tc3_closure) +#endif #define CLOSUREP(x) (TYP3(x)==tc3_closure) -#define CODE(x) (CAR(x)-tc3_closure) #define SETCODE(x, e) CAR(x) = (e)+tc3_closure #define ENV(x) ((~7L & CDR(x)) ? (~7L & CDR(x)) : EOL) #define GCENV ENV @@ -316,7 +351,7 @@ extern SCM i_dot, i_quote, i_quasiquote, i_unquote, i_uq_splicing; #define SCM_ESTK_PARENT(v) (VELTS(v)[0]) #define SCM_ESTK_PARENT_WRITABLEP(v) (VELTS(v)[1]) #define SCM_ESTK_PARENT_INDEX(v) (VELTS(v)[2]) -extern long tc16_env, tc16_ident; +SCM_EXPORT long tc16_env, tc16_ident; #define ENVP(x) (tc16_env==TYP16(x)) #define SCM_ENV_FORMALS CAR #ifdef MACRO @@ -360,8 +395,6 @@ extern long tc16_env, tc16_ident; #define SETSTREAM SETCDR #define CRDYP(port) ((CAR(port) & CRDY) && (EOF != CGETUN(port))) #define CLRDY(port) (CAR(port) &= (SCM_PORTFLAGS(port) | (~0xf0000))) - /* #define CRDYP(port) (CAR(port) & CRDY) - #define CLRDY(port) (CAR(port) &= (~CRDY)) */ #define CGETUN(port) (scm_port_table[SCM_PORTNUM(port)].unread) #define tc_socket (tc7_port | OPN) @@ -427,7 +460,7 @@ extern long tc16_env, tc16_ident; #define SETCHARS SETCDR #define SETVELTS SETCDR -extern long tc16_array; +SCM_EXPORT long tc16_array; #define ARRAYP(a) (tc16_array==TYP16(a)) #define ARRAY_V(a) (((array *)CDR(a))->v) /*#define ARRAY_NDIM(x) NUMDIGS(x)*/ @@ -567,28 +600,28 @@ extern long tc16_array; #define EXCLUSIVE (128L<<16) /* LSB is used for gc mark */ -extern scm_gra subrs_gra; +SCM_EXPORT scm_gra subrs_gra; #define subrs ((subr_info *)(subrs_gra.elts)) -/* extern sizet numsmob, numptob; - extern smobfuns *smobs; - extern ptobfuns *ptobs; - extern ptobfuns pipob; */ -extern scm_gra smobs_gra; +/* SCM_EXPORT sizet numsmob, numptob; + SCM_EXPORT smobfuns *smobs; + SCM_EXPORT ptobfuns *ptobs; + SCM_EXPORT ptobfuns pipob; */ +SCM_EXPORT scm_gra smobs_gra; #define numsmob (smobs_gra.len) #define smobs ((smobfuns *)(smobs_gra.elts)) -extern scm_gra ptobs_gra; +SCM_EXPORT scm_gra ptobs_gra; #define numptob (ptobs_gra.len) #define ptobs ((ptobfuns *)(ptobs_gra.elts)) -extern port_info *scm_port_table; +SCM_EXPORT port_info *scm_port_table; #define tc16_fport (tc7_port + 0*256L) #define tc16_pipe (tc7_port + 1*256L) #define tc16_strport (tc7_port + 2*256L) #define tc16_sfport (tc7_port + 3*256L) -extern long tc16_dir; -extern long tc16_clport; +SCM_EXPORT long tc16_dir; +SCM_EXPORT long tc16_clport; -extern SCM sys_protects[]; +SCM_EXPORT SCM sys_protects[]; #define cur_inp sys_protects[0] #define cur_outp sys_protects[1] #define cur_errp sys_protects[2] @@ -615,484 +648,476 @@ extern SCM sys_protects[]; /* now for connects between source files */ -/* extern sizet num_finals; - extern void (**finals)P((void)); - extern sizet num_finals; */ -extern scm_gra finals_gra; +/* SCM_EXPORT sizet num_finals; + SCM_EXPORT void (**finals)P((void)); + SCM_EXPORT sizet num_finals; */ +SCM_EXPORT scm_gra finals_gra; #define num_finals (finals_gra.len) #define finals ((void (**)())(finals_gra.elts)) -extern unsigned char upcase[], downcase[]; -extern SCM symhash; -extern int symhash_dim; -extern long heap_cells; -extern CELLPTR heap_org; -extern VOLATILE SCM freelist; -extern long gc_cells_collected, gc_malloc_collected, gc_ports_collected; -extern long gc_syms_collected; -extern long cells_allocated, lcells_allocated, mallocated, lmallocated; -extern long mtrigger; -extern SCM *loc_loadpath; -extern SCM *loc_errobj; -extern SCM loadport; -extern char *errjmp_bad; -extern int ints_disabled, output_deferred, gc_hook_pending, gc_hook_active; -extern unsigned long SIG_deferred; -extern SCM exitval; -extern int cursinit; -extern unsigned int poll_count, tick_count; -extern int dumped; -extern char *execpath; -extern char s_no_execpath[]; -extern int scm_verbose; +SCM_EXPORT unsigned char upcase[], downcase[]; +SCM_EXPORT SCM symhash; +SCM_EXPORT int symhash_dim; +SCM_EXPORT long heap_cells; +SCM_EXPORT CELLPTR heap_org; +SCM_EXPORT VOLATILE SCM freelist; +SCM_EXPORT long gc_cells_collected, gc_malloc_collected, gc_ports_collected; +SCM_EXPORT long gc_syms_collected; +SCM_EXPORT long cells_allocated, lcells_allocated, mallocated, lmallocated; +SCM_EXPORT long mtrigger; +SCM_EXPORT SCM *loc_loadpath; +SCM_EXPORT SCM *loc_errobj; +SCM_EXPORT SCM loadport; +SCM_EXPORT char *errjmp_bad; +SCM_EXPORT int ints_disabled, output_deferred, gc_hook_pending, gc_hook_active; +SCM_EXPORT unsigned long SIG_deferred; +SCM_EXPORT SCM exitval; +SCM_EXPORT int cursinit; +SCM_EXPORT unsigned int poll_count, tick_count; +SCM_EXPORT int dumped; +SCM_EXPORT char *execpath; +SCM_EXPORT char s_no_execpath[]; +SCM_EXPORT int scm_verbose; #define verbose (scm_verbose+0) -extern const char dirsep[]; +SCM_EXPORT const char dirsep[]; /* strings used in several source files */ -extern char s_read[], s_write[], s_newline[], s_system[]; -extern char s_make_string[], s_make_vector[], s_list[], s_op_pipe[]; +SCM_EXPORT char s_read[], s_write[], s_newline[], s_system[]; +SCM_EXPORT char s_make_string[], s_make_vector[], s_list[], s_op_pipe[]; #define s_string (s_make_string+5) #define s_vector (s_make_vector+5) #define s_pipe (s_op_pipe+5) -extern char s_make_sh_array[]; +SCM_EXPORT char s_make_sh_array[]; +SCM_EXPORT char s_array_fill[]; #define s_array (s_make_sh_array+12) -extern char s_ccl[]; +SCM_EXPORT char s_ccl[]; #define s_limit (s_ccl+10) -extern char s_close_port[]; +SCM_EXPORT char s_close_port[]; #define s_port_type (s_close_port+6) -extern char s_call_cc[]; +SCM_EXPORT char s_call_cc[]; #define s_cont (s_call_cc+18) -extern char s_try_create_file[]; -extern char s_badenv[]; +SCM_EXPORT char s_try_create_file[]; +SCM_EXPORT char s_badenv[]; + +SCM_EXPORT void (*init_user_scm) P((void)); /* function prototypes */ -extern void (* deferred_proc) P((void)); -void process_signals P((void)); -int handle_it P((int i)); -SCM must_malloc_cell P((long len, SCM c, char *what)); -void must_realloc_cell P((SCM z, long olen, long len, char *what)); -char *must_malloc P((long len, char *what)); -char *must_realloc P((char *where, long olen, long len, char *what)); -void must_free P((char *obj, sizet len)); -void scm_protect_temp P((SCM *ptr)); -long ilength P((SCM sx)); -SCM hash P((SCM obj, SCM n)); -SCM hashv P((SCM obj, SCM n)); -SCM hashq P((SCM obj, SCM n)); -SCM obhash P((SCM obj)); -SCM obunhash P((SCM obj)); -unsigned long strhash P((unsigned char *str, sizet len, unsigned long n)); -unsigned long hasher P((SCM obj, unsigned long n, sizet d)); -SCM lroom P((SCM args)); -SCM lflush P((SCM port)); -void scm_init_gra P((scm_gra *gra, sizet eltsize, sizet len, +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 void must_free P((char *obj, sizet len)); +SCM_EXPORT void scm_protect_temp P((SCM *ptr)); +SCM_EXPORT long ilength P((SCM sx)); +SCM_EXPORT SCM hash P((SCM obj, SCM n)); +SCM_EXPORT SCM hashv P((SCM obj, SCM n)); +SCM_EXPORT SCM hashq P((SCM obj, SCM n)); +SCM_EXPORT SCM obhash P((SCM obj)); +SCM_EXPORT SCM obunhash P((SCM obj)); +SCM_EXPORT unsigned long strhash P((unsigned char *str, sizet len, unsigned long n)); +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)); -int scm_grow_gra P((scm_gra *gra, char *elt)); -void scm_trim_gra P((scm_gra *gra)); -void scm_free_gra P((scm_gra *gra)); -long newsmob P((smobfuns *smob)); -long newptob P((ptobfuns *ptob)); -SCM scm_port_entry P((FILE *stream, long ptype, long flags)); -SCM scm_open_ports P((void)); -void prinport P((SCM exp, SCM port, char *type)); -SCM repl P((void)); -void repl_report P((void)); -void growth_mon P((char *obj, long size, char *units, int grewp)); -void gc_start P((char *what)); -void gc_end P((void)); -void gc_mark P((SCM p)); -void scm_gc_hook P((void)); -SCM scm_gc_protect P((SCM obj)); -SCM scm_add_finalizer P((SCM value, SCM finalizer)); -void scm_run_finalizers P((int exiting)); -void scm_egc_start P((void)); -void scm_egc_end P((void)); -void heap_report P((void)); -void gra_report P((void)); -void exit_report P((void)); -void stack_report P((void)); -SCM scm_stack_trace P((SCM contin)); -SCM scm_scope_trace P((SCM env)); -SCM scm_frame_trace P((SCM contin, SCM nf)); -SCM scm_frame2env P((SCM contin, SCM nf)); -SCM scm_frame_eval P((SCM contin, SCM nf, SCM expr)); -void iprin1 P((SCM exp, SCM port, int writing)); -void intprint P((long n, int radix, SCM port)); -void iprlist P((char *hdr, SCM exp, int tlr, SCM port, int writing)); -SCM scm_env_lookup P((SCM var, SCM stenv)); -SCM scm_env_rlookup P((SCM addr, SCM stenv, char *what)); -SCM scm_env_getprop P((SCM prop, SCM env)); -SCM scm_env_addprop P((SCM prop, SCM val, SCM env)); -long num_frames P((SCM estk, int i)); -SCM *estk_frame P((SCM estk, int i, int nf)); -SCM *cont_frame P((SCM contin, int nf)); -SCM stacktrace1 P((SCM estk, int i)); -void scm_princode P((SCM code, SCM env, SCM port, int writing)); -void scm_princlosure P((SCM proc, SCM port, int writing)); -void lputc P((int c, SCM port)); -void lputs P((char *s, SCM port)); -sizet lfwrite P((char *ptr, sizet size, sizet nitems, SCM port)); -int lgetc P((SCM port)); -void lungetc P((int c, SCM port)); -char *grow_tok_buf P((SCM tok_buf)); -long mode_bits P((char *modes, char *cmodes)); -long time_in_msec P((long x)); -SCM my_time P((void)); -SCM your_time P((void)); -void init_iprocs P((iproc *subra, int type)); - -void final_scm P((int)); -void init_sbrk P((void)); -int init_buf0 P((FILE *inport)); -void scm_init_from_argv P((int argc, char **argv, char *script_arg, +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)); +SCM_EXPORT long newsmob P((smobfuns *smob)); +SCM_EXPORT long newptob P((ptobfuns *ptob)); +SCM_EXPORT SCM scm_port_entry P((FILE *stream, long ptype, long flags)); +SCM_EXPORT SCM scm_open_ports P((void)); +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_end P((void)); +SCM_EXPORT void gc_mark P((SCM p)); +SCM_EXPORT void scm_gc_hook P((void)); +SCM_EXPORT SCM scm_gc_protect P((SCM obj)); +SCM_EXPORT SCM scm_add_finalizer P((SCM value, SCM finalizer)); +SCM_EXPORT void scm_run_finalizers P((int exiting)); +SCM_EXPORT void scm_egc_start P((void)); +SCM_EXPORT void scm_egc_end P((void)); +SCM_EXPORT void heap_report P((void)); +SCM_EXPORT void gra_report P((void)); +SCM_EXPORT void exit_report P((void)); +SCM_EXPORT void stack_report P((void)); +SCM_EXPORT SCM scm_stack_trace P((SCM contin)); +SCM_EXPORT SCM scm_scope_trace P((SCM env)); +SCM_EXPORT SCM scm_frame_trace P((SCM contin, SCM nf)); +SCM_EXPORT SCM scm_frame2env P((SCM contin, SCM nf)); +SCM_EXPORT SCM scm_frame_eval P((SCM contin, SCM nf, SCM expr)); +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_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)); +SCM_EXPORT SCM *estk_frame P((SCM estk, int i, int nf)); +SCM_EXPORT SCM *cont_frame P((SCM contin, int nf)); +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 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)); +SCM_EXPORT char *grow_tok_buf P((SCM tok_buf)); +SCM_EXPORT long mode_bits P((char *modes, char *cmodes)); +SCM_EXPORT long time_in_msec P((long x)); +SCM_EXPORT SCM my_time P((void)); +SCM_EXPORT SCM your_time P((void)); +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, int iverbose, int buf0stdin)); -void init_signals P((void)); -SCM scm_top_level P((char *initpath, SCM (*toplvl_fun)())); -void restore_signals P((void)); -void free_storage P((void)); -char *dld_find_executable P((const char* command)); -char *scm_find_execpath P((int argc, char **argv, char *script_arg)); -void init_scm P((int iverbose, int buf0stdin, long init_heap_size)); -void scm_init_INITS P((void)); -SCM scm_init_extensions P((void)); -void init_user_scm P((void)); -void ignore_signals P((void)); -void unignore_signals P((void)); - -void add_feature P((char *str)); -int raprin1 P((SCM exp, SCM port, int writing)); -SCM markcdr P((SCM ptr)); +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 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)); +SCM_EXPORT void ignore_signals P((void)); +SCM_EXPORT void unignore_signals P((void)); + +SCM_EXPORT void add_feature P((char *str)); +SCM_EXPORT int raprin1 P((SCM exp, SCM port, int writing)); +SCM_EXPORT SCM markcdr P((SCM ptr)); #define mark0 (0) /*SCM mark0 P((SCM ptr)); */ -SCM equal0 P((SCM ptr1, SCM ptr2)); -sizet free0 P((CELLPTR ptr)); -void scm_warn P((char *str1, char *str2, SCM obj)); -void everr P((SCM exp, SCM env, SCM arg, char *pos, char *s_subr, int codep)); -void wta P((SCM arg, char *pos, char *s_subr)); -void scm_experr P((SCM arg, char *pos, char *s_subr)); -SCM intern P((char *name, sizet len)); -SCM sysintern P((const char *name, SCM val)); -SCM sym2vcell P((SCM sym)); -SCM makstr P((long len)); -SCM scm_maksubr P((const char *name, int type, SCM (*fcn)())); -SCM make_subr P((const char *name, int type, SCM (*fcn)())); -SCM make_synt P((const char *name, long flags, SCM (*fcn)())); -SCM make_gsubr P((const char *name, int req, int opt, int rst, +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 SCM intern P((char *name, sizet len)); +SCM_EXPORT SCM sysintern P((const char *name, SCM val)); +SCM_EXPORT SCM sym2vcell P((SCM sym)); +SCM_EXPORT SCM makstr P((long len)); +SCM_EXPORT SCM scm_maksubr P((const char *name, int type, SCM (*fcn)())); +SCM_EXPORT SCM make_subr P((const char *name, int type, SCM (*fcn)())); +SCM_EXPORT SCM make_synt P((const char *name, long flags, SCM (*fcn)())); +SCM_EXPORT SCM make_gsubr P((const char *name, int req, int opt, int rst, SCM (*fcn)())); -SCM closure P((SCM code, int nargs)); -SCM makprom P((SCM code)); -SCM force P((SCM x)); -SCM makarb P((SCM name)); -SCM tryarb P((SCM arb)); -SCM relarb P((SCM arb)); -SCM ceval P((SCM x, SCM static_env, SCM env)); -SCM scm_wrapcode P((SCM code, SCM env)); -SCM scm_current_env P((void)); -SCM prolixity P((SCM arg)); -SCM gc_for_newcell P((void)); -void gc_for_open_files P((void)); -SCM gc P((SCM arg)); -SCM tryload P((SCM filename, SCM reader)); -SCM acons P((SCM w, SCM x, SCM y)); -SCM cons2 P((SCM w, SCM x, SCM y)); -SCM resizuve P((SCM vect, SCM len)); -SCM lnot P((SCM x)); -SCM booleanp P((SCM obj)); -SCM eq P((SCM x, SCM y)); -SCM equal P((SCM x, SCM y)); -SCM consp P((SCM x)); -SCM cons P((SCM x, SCM y)); -SCM nullp P((SCM x)); -SCM setcar P((SCM pair, SCM value)); -SCM setcdr P((SCM pair, SCM value)); -SCM listp P((SCM x)); -SCM list P((SCM objs)); -SCM length P((SCM x)); -SCM append P((SCM args)); -SCM reverse P((SCM lst)); -SCM list_ref P((SCM lst, SCM k)); -SCM memq P((SCM x, SCM lst)); -SCM member P((SCM x, SCM lst)); -SCM memv P((SCM x, SCM lst)); -SCM assq P((SCM x, SCM alist)); -SCM assoc P((SCM x, SCM alist)); -SCM symbolp P((SCM x)); -SCM symbol2string P((SCM s)); -SCM string2symbol P((SCM s)); -SCM numberp P((SCM x)); -SCM exactp P((SCM x)); -SCM inexactp P((SCM x)); -SCM eqp P((SCM x, SCM y)); -SCM lessp P((SCM x, SCM y)); -SCM greaterp P((SCM x, SCM y)); -SCM leqp P((SCM x, SCM y)); -SCM greqp P((SCM x, SCM y)); -SCM zerop P((SCM z)); -SCM positivep P((SCM x)); -SCM negativep P((SCM x)); -SCM oddp P((SCM n)); -SCM evenp P((SCM n)); -SCM lmax P((SCM x, SCM y)); -SCM lmin P((SCM x, SCM y)); -SCM sum P((SCM x, SCM y)); -SCM difference P((SCM x, SCM y)); -SCM product P((SCM x, SCM y)); -SCM divide P((SCM x, SCM y)); -SCM lquotient P((SCM x, SCM y)); -SCM absval P((SCM x)); -SCM lremainder P((SCM x, SCM y)); -SCM modulo P((SCM x, SCM y)); -SCM lgcd P((SCM x, SCM y)); -SCM llcm P((SCM n1, SCM n2)); -SCM number2string P((SCM x, SCM radix)); -SCM istring2number P((char *str, long len, long radix)); -SCM string2number P((SCM str, SCM radix)); -SCM istr2flo P((char *str, long len, long radix)); -SCM mkbig P((sizet nlen, int sign)); -SCM mkstrport P((SCM pos, SCM str, long modes, char *caller)); -SCM mksafeport P((int maxlen, SCM port)); -int reset_safeport P((SCM sfp, int maxlen, SCM port)); -SCM long2big P((long n)); -SCM ulong2big P((unsigned long n)); -SCM big2inum P((SCM b, sizet l)); -sizet iint2str P((long num, int rad, char *p)); -SCM floequal P((SCM x, SCM y)); -SCM uve_equal P((SCM u, SCM v)); -SCM raequal P((SCM ra0, SCM ra1)); -SCM array_equal P((SCM u, SCM v)); -SCM array_rank P((SCM ra)); -int rafill P((SCM ra, SCM fill, SCM ignore)); -SCM uve_fill P((SCM uve, SCM fill)); -SCM array_fill P((SCM ra, SCM fill)); -SCM array_prot P((SCM ra)); -SCM array_rank P((SCM ra)); -int bigprint P((SCM exp, SCM port, int writing)); -int floprint P((SCM sexp, SCM port, int writing)); -SCM istr2int P((char *str, long len, long radix)); -SCM istr2bve P((char *str, long len)); -void ipruk P((char *hdr, SCM ptr, SCM port)); -SCM charp P((SCM x)); -SCM char_lessp P((SCM x, SCM y)); -SCM chci_eq P((SCM x, SCM y)); -SCM chci_lessp P((SCM x, SCM y)); -SCM char_alphap P((SCM chr)); -SCM char_nump P((SCM chr)); -SCM char_whitep P((SCM chr)); -SCM char_upperp P((SCM chr)); -SCM char_lowerp P((SCM chr)); -SCM char2int P((SCM chr)); -SCM int2char P((SCM n)); -SCM char_upcase P((SCM chr)); -SCM char_downcase P((SCM chr)); -SCM stringp P((SCM x)); -SCM string P((SCM chrs)); -SCM make_string P((SCM k, SCM chr)); -SCM string2list P((SCM str)); -SCM st_length P((SCM str)); -SCM st_ref P((SCM str, SCM k)); -SCM st_set P((SCM str, SCM k, SCM chr)); -SCM st_equal P((SCM s1, SCM s2)); -SCM stci_equal P((SCM s1, SCM s2)); -SCM st_lessp P((SCM s1, SCM s2)); -SCM stci_lessp P((SCM s1, SCM s2)); -SCM substring P((SCM str, SCM start, SCM end)); -SCM st_append P((SCM args)); -SCM vectorp P((SCM x)); -SCM vector_length P((SCM v)); -SCM vector P((SCM l)); -SCM vector_ref P((SCM v, SCM k)); -SCM vector_set P((SCM v, SCM k, SCM obj)); -SCM make_vector P((SCM k, SCM fill)); -SCM vector2list P((SCM v)); -SCM for_each P((SCM proc, SCM arg1, SCM args)); -SCM procedurep P((SCM obj)); -SCM apply P((SCM proc, SCM arg1, SCM args)); -SCM scm_cvapply P((SCM proc, long n, SCM *argv)); -int scm_arity_check P((SCM proc, long argc, char *what)); -SCM map P((SCM proc, SCM arg1, SCM args)); -SCM scm_make_cont P((void)); -SCM copytree P((SCM obj)); -SCM eval P((SCM obj)); -SCM scm_values P((SCM arg1, SCM arg2, SCM rest, char *what)); -SCM scm_eval_values P((SCM x, SCM static_env, SCM env)); -SCM identp P((SCM obj)); -SCM ident2sym P((SCM id)); -SCM ident_eqp P((SCM id1, SCM id2, SCM env)); -int scm_nullenv_p P((SCM env)); -SCM env2tree P((SCM env)); -SCM renamed_ident P((SCM id, SCM env)); -SCM scm_check_linum P((SCM x, SCM *linum)); -SCM scm_add_linum P((SCM linum, SCM x)); -SCM input_portp P((SCM x)); -SCM output_portp P((SCM x)); -SCM cur_input_port P((void)); -SCM cur_output_port P((void)); -SCM i_setbuf0 P((SCM port)); -SCM try_open_file P((SCM filename, SCM modes)); -SCM open_file P((SCM filename, SCM modes)); -SCM open_pipe P((SCM pipestr, SCM modes)); -SCM close_port P((SCM port)); -SCM lread P((SCM port)); -SCM scm_read_char P((SCM port)); -SCM peek_char P((SCM port)); -SCM eof_objectp P((SCM x)); -int scm_io_error P((SCM port, char *what)); -SCM lwrite P((SCM obj, SCM port)); -SCM display P((SCM obj, SCM port)); -SCM newline P((SCM port)); -SCM write_char P((SCM chr, SCM port)); -SCM file_position P((SCM port)); -SCM file_set_position P((SCM port, SCM pos)); -SCM scm_port_line P((SCM port)); -SCM scm_port_col P((SCM port)); -void scm_line_msg P((SCM file, SCM linum, SCM port)); -void scm_err_line P((char *what, SCM file, SCM linum, SCM port)); -SCM lgetenv P((SCM nam)); -SCM prog_args P((void)); -SCM makacro P((SCM code)); -SCM makmacro P((SCM code)); -SCM makmmacro P((SCM code)); -SCM makidmacro P((SCM code)); -void poll_routine P((void)); -void tick_signal P((void)); -void stack_check P((void)); -SCM list2ura P((SCM ndim, SCM prot, SCM lst)); -SCM make_ra P((int ndim)); -SCM makflo P((float x)); -SCM arrayp P((SCM v, SCM prot)); -SCM array_contents P((SCM ra, SCM strict)); -SCM uve_read P((SCM v, SCM port)); -SCM uve_write P((SCM v, SCM port)); -SCM ura_read P((SCM v, SCM port)); -SCM ura_write P((SCM v, SCM port)); -SCM aset P((SCM v, SCM obj, SCM args)); -SCM aref P((SCM v, SCM args)); -SCM scm_array_ref P((SCM args)); -SCM cvref P((SCM v, sizet pos, SCM last)); -SCM quit P((SCM n)); +SCM_EXPORT SCM closure P((SCM code, int nargs)); +SCM_EXPORT SCM makprom P((SCM code)); +SCM_EXPORT SCM force P((SCM x)); +SCM_EXPORT SCM makarb P((SCM name)); +SCM_EXPORT SCM tryarb P((SCM arb)); +SCM_EXPORT SCM relarb P((SCM arb)); +SCM_EXPORT SCM ceval P((SCM x, SCM static_env, SCM env)); +SCM_EXPORT SCM scm_wrapcode P((SCM code, SCM env)); +SCM_EXPORT SCM scm_current_env P((void)); +SCM_EXPORT SCM prolixity P((SCM arg)); +SCM_EXPORT SCM gc_for_newcell P((void)); +SCM_EXPORT void gc_for_open_files P((void)); +SCM_EXPORT SCM gc P((SCM arg)); +SCM_EXPORT SCM tryload P((SCM filename, SCM reader)); +SCM_EXPORT SCM acons P((SCM w, SCM x, SCM y)); +SCM_EXPORT SCM cons2 P((SCM w, SCM x, SCM y)); +SCM_EXPORT SCM resizuve P((SCM vect, SCM len)); +SCM_EXPORT SCM lnot P((SCM x)); +SCM_EXPORT SCM booleanp P((SCM obj)); +SCM_EXPORT SCM eq P((SCM x, SCM y)); +SCM_EXPORT SCM equal P((SCM x, SCM y)); +SCM_EXPORT SCM consp P((SCM x)); +SCM_EXPORT SCM cons P((SCM x, SCM y)); +SCM_EXPORT SCM nullp P((SCM x)); +SCM_EXPORT SCM setcar P((SCM pair, SCM value)); +SCM_EXPORT SCM setcdr P((SCM pair, SCM value)); +SCM_EXPORT SCM listp P((SCM x)); +SCM_EXPORT SCM list P((SCM objs)); +SCM_EXPORT SCM length P((SCM x)); +SCM_EXPORT SCM append P((SCM args)); +SCM_EXPORT SCM reverse P((SCM lst)); +SCM_EXPORT SCM list_ref P((SCM lst, SCM k)); +SCM_EXPORT SCM memq P((SCM x, SCM lst)); +SCM_EXPORT SCM member P((SCM x, SCM lst)); +SCM_EXPORT SCM memv P((SCM x, SCM lst)); +SCM_EXPORT SCM assq P((SCM x, SCM alist)); +SCM_EXPORT SCM assoc P((SCM x, SCM alist)); +SCM_EXPORT SCM symbolp P((SCM x)); +SCM_EXPORT SCM symbol2string P((SCM s)); +SCM_EXPORT SCM string2symbol P((SCM s)); +SCM_EXPORT SCM numberp P((SCM x)); +SCM_EXPORT SCM exactp P((SCM x)); +SCM_EXPORT SCM inexactp P((SCM x)); +SCM_EXPORT SCM eqp P((SCM x, SCM y)); +SCM_EXPORT SCM lessp P((SCM x, SCM y)); +SCM_EXPORT SCM greaterp P((SCM x, SCM y)); +SCM_EXPORT SCM leqp P((SCM x, SCM y)); +SCM_EXPORT SCM greqp P((SCM x, SCM y)); +SCM_EXPORT SCM zerop P((SCM z)); +SCM_EXPORT SCM positivep P((SCM x)); +SCM_EXPORT SCM negativep P((SCM x)); +SCM_EXPORT SCM oddp P((SCM n)); +SCM_EXPORT SCM evenp P((SCM n)); +SCM_EXPORT SCM lmax P((SCM x, SCM y)); +SCM_EXPORT SCM lmin P((SCM x, SCM y)); +SCM_EXPORT SCM sum P((SCM x, SCM y)); +SCM_EXPORT SCM difference P((SCM x, SCM y)); +SCM_EXPORT SCM product P((SCM x, SCM y)); +SCM_EXPORT SCM divide P((SCM x, SCM y)); +SCM_EXPORT SCM lquotient P((SCM x, SCM y)); +SCM_EXPORT SCM absval 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)); +SCM_EXPORT SCM llcm P((SCM n1, SCM n2)); +SCM_EXPORT SCM number2string P((SCM x, SCM radix)); +SCM_EXPORT SCM istring2number P((char *str, long len, long radix)); +SCM_EXPORT SCM string2number P((SCM str, SCM radix)); +SCM_EXPORT SCM istr2flo P((char *str, long len, long radix)); +SCM_EXPORT SCM mkbig P((sizet nlen, int sign)); +SCM_EXPORT SCM mkstrport P((SCM pos, SCM str, long modes, char *caller)); +SCM_EXPORT SCM mksafeport P((int maxlen, SCM port)); +SCM_EXPORT int reset_safeport P((SCM sfp, int maxlen, SCM port)); +SCM_EXPORT SCM long2big P((long n)); +SCM_EXPORT SCM ulong2big P((unsigned long n)); +SCM_EXPORT SCM big2inum P((SCM b, sizet l)); +SCM_EXPORT sizet iint2str P((long num, int rad, char *p)); +SCM_EXPORT SCM floequal P((SCM x, SCM y)); +SCM_EXPORT SCM uve_equal P((SCM u, SCM v)); +SCM_EXPORT SCM uve_read P((SCM v, SCM port)); +SCM_EXPORT SCM uve_write P((SCM v, SCM port)); +SCM_EXPORT SCM raequal P((SCM ra0, SCM ra1)); +SCM_EXPORT SCM array_equal P((SCM u, SCM v)); +SCM_EXPORT SCM array_rank P((SCM ra)); +SCM_EXPORT int rafill P((SCM ra, SCM fill, SCM ignore)); +SCM_EXPORT SCM uve_fill P((SCM uve, SCM fill)); +SCM_EXPORT SCM array_fill P((SCM ra, SCM fill)); +SCM_EXPORT SCM array_prot P((SCM ra)); +SCM_EXPORT SCM array_rank P((SCM ra)); +SCM_EXPORT SCM array_contents P((SCM ra, SCM strict)); +SCM_EXPORT int bigprint P((SCM exp, SCM port, int writing)); +SCM_EXPORT int floprint P((SCM sexp, SCM port, int writing)); +SCM_EXPORT SCM istr2int P((char *str, long len, long radix)); +SCM_EXPORT SCM istr2bve P((char *str, long len)); +SCM_EXPORT void ipruk P((char *hdr, SCM ptr, SCM port)); +SCM_EXPORT SCM charp P((SCM x)); +SCM_EXPORT SCM char_lessp P((SCM x, SCM y)); +SCM_EXPORT SCM chci_eq P((SCM x, SCM y)); +SCM_EXPORT SCM chci_lessp P((SCM x, SCM y)); +SCM_EXPORT SCM char_alphap P((SCM chr)); +SCM_EXPORT SCM char_nump P((SCM chr)); +SCM_EXPORT SCM char_whitep P((SCM chr)); +SCM_EXPORT SCM char_upperp P((SCM chr)); +SCM_EXPORT SCM char_lowerp P((SCM chr)); +SCM_EXPORT SCM char2int P((SCM chr)); +SCM_EXPORT SCM int2char P((SCM n)); +SCM_EXPORT SCM char_upcase P((SCM chr)); +SCM_EXPORT SCM char_downcase P((SCM chr)); +SCM_EXPORT SCM stringp P((SCM x)); +SCM_EXPORT SCM string P((SCM chrs)); +SCM_EXPORT SCM make_string P((SCM k, SCM chr)); +SCM_EXPORT SCM string2list P((SCM str)); +SCM_EXPORT SCM st_length P((SCM str)); +SCM_EXPORT SCM st_ref P((SCM str, SCM k)); +SCM_EXPORT SCM st_set P((SCM str, SCM k, SCM chr)); +SCM_EXPORT SCM st_equal P((SCM s1, SCM s2)); +SCM_EXPORT SCM stci_equal P((SCM s1, SCM s2)); +SCM_EXPORT SCM st_lessp P((SCM s1, SCM s2)); +SCM_EXPORT SCM stci_lessp P((SCM s1, SCM s2)); +SCM_EXPORT SCM substring P((SCM str, SCM start, SCM end)); +SCM_EXPORT SCM st_append P((SCM args)); +SCM_EXPORT SCM vectorp P((SCM x)); +SCM_EXPORT SCM vector_length P((SCM v)); +SCM_EXPORT SCM vector P((SCM l)); +SCM_EXPORT SCM vector_ref P((SCM v, SCM k)); +SCM_EXPORT SCM vector_set P((SCM v, SCM k, SCM obj)); +SCM_EXPORT SCM make_vector P((SCM k, SCM fill)); +SCM_EXPORT SCM vector2list P((SCM v)); +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 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_eval_values P((SCM x, SCM static_env, SCM env)); +SCM_EXPORT SCM identp P((SCM obj)); +SCM_EXPORT SCM ident2sym P((SCM id)); +SCM_EXPORT SCM ident_eqp P((SCM id1, SCM id2, SCM env)); +SCM_EXPORT int scm_nullenv_p P((SCM env)); +SCM_EXPORT SCM env2tree P((SCM env)); +SCM_EXPORT SCM renamed_ident P((SCM id, SCM env)); +SCM_EXPORT SCM scm_check_linum P((SCM x, SCM *linum)); +SCM_EXPORT SCM scm_add_linum P((SCM linum, SCM x)); +SCM_EXPORT SCM input_portp P((SCM x)); +SCM_EXPORT SCM output_portp P((SCM x)); +SCM_EXPORT SCM cur_input_port P((void)); +SCM_EXPORT SCM cur_output_port P((void)); +SCM_EXPORT SCM i_setbuf0 P((SCM port)); +SCM_EXPORT SCM try_open_file P((SCM filename, SCM modes)); +SCM_EXPORT SCM open_file P((SCM filename, SCM modes)); +SCM_EXPORT SCM open_pipe P((SCM pipestr, SCM modes)); +SCM_EXPORT SCM close_port P((SCM port)); +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 SCM lwrite P((SCM obj, SCM port)); +SCM_EXPORT SCM display P((SCM obj, SCM port)); +SCM_EXPORT SCM newline P((SCM port)); +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 SCM lgetenv P((SCM nam)); +SCM_EXPORT SCM prog_args P((void)); +SCM_EXPORT SCM makacro P((SCM code)); +SCM_EXPORT SCM makmacro P((SCM code)); +SCM_EXPORT SCM makmmacro P((SCM code)); +SCM_EXPORT SCM makidmacro P((SCM code)); +SCM_EXPORT void poll_routine P((void)); +SCM_EXPORT void tick_signal P((void)); +SCM_EXPORT void stack_check P((void)); +SCM_EXPORT SCM list2ura P((SCM ndim, SCM prot, SCM lst)); +SCM_EXPORT SCM make_ra P((int ndim)); +SCM_EXPORT SCM makflo P((float x)); +SCM_EXPORT SCM arrayp P((SCM v, SCM prot)); +SCM_EXPORT SCM aset P((SCM v, SCM obj, SCM args)); +SCM_EXPORT SCM aref P((SCM v, SCM args)); +SCM_EXPORT SCM scm_array_ref P((SCM args)); +SCM_EXPORT SCM cvref P((SCM v, sizet pos, SCM last)); +SCM_EXPORT SCM quit P((SCM n)); #ifdef CAREFUL_INTS -void ints_viol P((ints_infot *info, int sense)); -void ints_warn P((char *s1, char* s2, char *fname, int linum)); +SCM_EXPORT void ints_viol P((ints_infot *info, int sense)); +SCM_EXPORT void ints_warn P((char *s1, char* s2, char *fname, int linum)); #endif -void add_final P((void (*final)(void))); -SCM makcclo P((SCM proc, long len)); -SCM make_uve P((long k, SCM prot)); -long scm_prot2type P((SCM prot)); -SCM ra2contig P((SCM ra, int copy)); -SCM sc2array P((SCM s, SCM ra, SCM prot)); -SCM array_copy P((SCM src, SCM dst)); -long aind P((SCM ra, SCM args, char *what)); -SCM scm_eval_string P((SCM str)); -SCM scm_load_string P((SCM str)); -void scm_print_stack P((SCM stk)); -SCM scm_unexec P((const SCM pathname)); -SCM scm_log_aref P((SCM args)); -SCM scm_log_aset P((SCM ra, SCM obj, SCM args)); -SCM scm_logbitp P((SCM index, SCM j1)); -SCM scm_logtest P((SCM x, SCM y)); -SCM scm_logxor P((SCM x, SCM y)); -SCM scm_logand P((SCM x, SCM y)); -SCM scm_logior P((SCM x, SCM y)); -SCM scm_lognot P((SCM n)); -SCM scm_intexpt P((SCM z1, SCM z2)); -SCM scm_ash P((SCM n, SCM cnt)); -SCM scm_bitfield P((SCM n, SCM start, SCM end)); -SCM scm_logcount P((SCM n)); -SCM scm_intlength P((SCM n)); -SCM scm_copybit P((SCM index, SCM j1, SCM bit)); -SCM scm_bitif P((SCM mask, SCM n0, SCM n1)); -SCM scm_copybitfield P((SCM to, SCM start, SCM rest)); +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 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)); +SCM_EXPORT SCM scm_logbitp P((SCM index, SCM j1)); +SCM_EXPORT SCM scm_logtest P((SCM x, SCM y)); +SCM_EXPORT SCM scm_logxor P((SCM x, SCM y)); +SCM_EXPORT SCM scm_logand P((SCM x, SCM y)); +SCM_EXPORT SCM scm_logior P((SCM x, SCM y)); +SCM_EXPORT SCM scm_lognot P((SCM n)); +SCM_EXPORT SCM scm_intexpt P((SCM z1, SCM z2)); +SCM_EXPORT SCM scm_ash P((SCM n, SCM cnt)); +SCM_EXPORT SCM scm_bitfield P((SCM n, SCM start, SCM end)); +SCM_EXPORT SCM scm_logcount P((SCM n)); +SCM_EXPORT SCM scm_intlength P((SCM n)); +SCM_EXPORT SCM scm_copybit P((SCM index, SCM j1, SCM bit)); +SCM_EXPORT SCM scm_bitif P((SCM mask, SCM n0, SCM n1)); +SCM_EXPORT SCM scm_copybitfield P((SCM to, SCM start, SCM rest)); /* Defined in "rope.c" */ -SCM long2num P((long n)); -SCM ulong2num P((unsigned long n)); -unsigned char num2uchar P((SCM num, char *pos, char *s_caller)); -unsigned short num2ushort P((SCM num, char *pos, char *s_caller)); -unsigned long num2ulong P((SCM num, char *pos, char *s_caller)); - long num2long P((SCM num, char *pos, char *s_caller)); - short num2short P((SCM num, char *pos, char *s_caller)); - double num2dbl P((SCM num, char *pos, char *s_caller)); -SCM makfromstr P((char *src, sizet len)); -SCM makfromstrs P((int argc, char **argv)); -SCM makfrom0str P((char *scr)); -char **makargvfrmstrs P((SCM args, char *s_v)); -void must_free_argv P((char **argv)); -SCM scm_evstr P((char *str)); -void scm_ldstr P((char *str)); -int scm_ldfile P((char *path)); -int scm_ldprog P((char *path)); -unsigned long scm_addr P((SCM args, char *name)); -unsigned long scm_base_addr P((SCM v, char *name)); -int scm_cell_p P((SCM x)); +SCM_EXPORT SCM long2num P((long n)); +SCM_EXPORT SCM ulong2num P((unsigned long n)); +SCM_EXPORT unsigned char num2uchar P((SCM num, char *pos, char *s_caller)); +SCM_EXPORT unsigned short num2ushort P((SCM num, char *pos, char *s_caller)); +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 scm_evstr P((char *str)); +SCM_EXPORT void scm_ldstr P((char *str)); +SCM_EXPORT int scm_ldfile P((char *path)); +SCM_EXPORT int scm_ldprog P((char *path)); +SCM_EXPORT unsigned long scm_addr P((SCM args, char *name)); +SCM_EXPORT unsigned long scm_base_addr P((SCM v, char *name)); +SCM_EXPORT int scm_cell_p P((SCM x)); #ifdef FLOATS -SCM makdbl P((double x, double y)); -SCM dbl2big P((double d)); -double big2dbl P((SCM b)); -double lasinh P((double x)); -double lacosh P((double x)); -double latanh P((double x)); -double ltrunc P((double x)); -double scm_round P((double x)); -double floident P((double 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_round P((double x)); +SCM_EXPORT double floident P((double x)); #endif #ifdef BIGDIG -void longdigs P((long x, BIGDIG digs[DIGSPERLONG])); -SCM adjbig P((SCM b, sizet nlen)); -SCM normbig P((SCM b)); -SCM copybig P((SCM b, int sign)); -SCM addbig P((BIGDIG *x, sizet nx, int xsgn, SCM bigy, int sgny)); -SCM mulbig P((BIGDIG *x, sizet nx, BIGDIG *y, sizet ny, int sgn)); -unsigned int divbigdig P((BIGDIG *ds, sizet h, BIGDIG div)); -SCM divbigint P((SCM x, long z, int sgn, int mode)); -SCM divbigbig P((BIGDIG *x, sizet nx, BIGDIG *y, sizet ny, int sgn, +SCM_EXPORT void longdigs P((long x, BIGDIG digs[DIGSPERLONG])); +SCM_EXPORT SCM adjbig P((SCM b, sizet nlen)); +SCM_EXPORT SCM normbig P((SCM b)); +SCM_EXPORT SCM copybig P((SCM b, int sign)); +SCM_EXPORT SCM addbig P((BIGDIG *x, sizet nx, int xsgn, SCM bigy, int sgny)); +SCM_EXPORT SCM mulbig P((BIGDIG *x, sizet nx, BIGDIG *y, sizet ny, int sgn)); +SCM_EXPORT unsigned int divbigdig P((BIGDIG *ds, sizet h, BIGDIG div)); +SCM_EXPORT SCM divbigint P((SCM x, long z, int sgn, int mode)); +SCM_EXPORT SCM divbigbig P((BIGDIG *x, sizet nx, BIGDIG *y, sizet ny, int sgn, int modes)); -long pseudolong P((long x)); +SCM_EXPORT long pseudolong P((long x)); #endif -int bigcomp P((SCM x, SCM y)); -SCM bigequal P((SCM x, SCM y)); -int scm_bigdblcomp P((SCM b, double d)); +SCM_EXPORT int bigcomp P((SCM x, SCM y)); +SCM_EXPORT SCM bigequal P((SCM x, SCM y)); +SCM_EXPORT int scm_bigdblcomp P((SCM b, double d)); /* "script.c" functions */ -char * scm_cat_path P((char *str1, const char *str2, long n)); -char * scm_try_path P((char *path)); -char * script_find_executable P((const char *command)); -char ** script_process_argv P((int argc, char **argv)); -int script_count_argv P((char **argv)); -char * find_impl_file P((char *exec_path, const char *generic_name, +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, const char *initname, const char *sep)); /* environment cache functions */ -void scm_ecache_report P((void)); -void scm_estk_reset P((sizet size)); -void scm_env_cons P((SCM x, SCM y)); -void scm_env_cons2 P((SCM w, SCM x, SCM y)); -void scm_env_cons3 P((SCM v, SCM w, SCM x, SCM y)); -void scm_env_v2lst P((long argc, SCM *argv)); -void scm_extend_env P((void)); -void scm_egc P((void)); +SCM_EXPORT void scm_ecache_report P((void)); +SCM_EXPORT void scm_estk_reset P((sizet size)); +SCM_EXPORT void scm_env_cons P((SCM x, SCM y)); +SCM_EXPORT void scm_env_cons2 P((SCM w, SCM x, SCM y)); +SCM_EXPORT void scm_env_cons3 P((SCM v, SCM w, SCM x, SCM y)); +SCM_EXPORT void scm_env_v2lst P((long argc, SCM *argv)); +SCM_EXPORT void scm_extend_env P((void)); +SCM_EXPORT void scm_egc P((void)); /* Global state for environment cache */ -extern CELLPTR scm_ecache; -extern VOLATILE long scm_ecache_index, scm_ecache_len; -extern SCM scm_env, scm_env_tmp; -extern SCM scm_egc_roots[]; -extern VOLATILE long scm_egc_root_index; -extern SCM scm_estk; -extern SCM *scm_estk_v, *scm_estk_ptr; -extern long scm_estk_size; +SCM_EXPORT CELLPTR scm_ecache; +SCM_EXPORT VOLATILE long scm_ecache_index, scm_ecache_len; +SCM_EXPORT SCM scm_env, scm_env_tmp; +SCM_EXPORT SCM scm_egc_roots[]; +SCM_EXPORT VOLATILE long scm_egc_root_index; +SCM_EXPORT SCM scm_estk; +SCM_EXPORT SCM *scm_estk_v, *scm_estk_ptr; +SCM_EXPORT long scm_estk_size; #ifndef RECKLESS -extern SCM scm_trace, scm_trace_env; +SCM_EXPORT SCM scm_trace, scm_trace_env; #endif #ifdef RECKLESS -# define ASSERT(_cond, _arg, _pos, _subr) ; +# define ASRTER(_cond, _arg, _pos, _subr) ; # define ASRTGO(_cond, _label) ; #else -# define ASSERT(_cond, _arg, _pos, _subr) if(!(_cond))wta(_arg, (char *)(_pos), _subr); +# define ASRTER(_cond, _arg, _pos, _subr) if(!(_cond))wta(_arg, (char *)(_pos), _subr); # define ASRTGO(_cond, _label) if(!(_cond)) goto _label; #endif @@ -1,4 +1,4 @@ -This is scm.info, produced by makeinfo version 4.0 from scm.texi. +This is scm.info, produced by makeinfo version 4.0 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 -5d6 was released April 2002. The most recent information about SCM can | -be found on SCM's "WWW" home page: | +5d9 was released November 2003. The most recent information about SCM | +can be found on SCM's "WWW" home page: - <http://swissnet.ai.mit.edu/~jaffer/SCM.html> + <http://swissnet.ai.mit.edu/~jaffer/SCM> Copyright (C) 1990-1999 Free Software Foundation @@ -33,7 +33,7 @@ approved by the author. * Menu: * Overview:: -* Installing SCM:: +* Installing SCM:: How to * Operational Features:: * The Language:: Reference. * Packages:: Optional Capabilities. @@ -112,7 +112,7 @@ File: scm.info, Node: SCM Authors, Next: Copying, Prev: SCM Features, Up: Ov Authors ======= -Aubrey Jaffer (jaffer @ alum.mit.edu) | +Aubrey Jaffer (agj @ alum.mit.edu) Most of SCM. Radey Shouman @@ -332,22 +332,21 @@ 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: - * swissnet.ai.mit.edu:/pub/scm/slib2d4.tar.gz | + * swissnet.ai.mit.edu:/pub/scm/slib3a1.tar.gz | - * ftp.gnu.org:/pub/gnu/jacal/slib2d4.tar.gz | + * ftp.gnu.org:/pub/gnu/jacal/slib3a1.tar.gz | - * ftp.cs.indiana.edu:/pub/scheme-repository/imp/slib2d4.tar.gz | + * ftp.cs.indiana.edu:/pub/scheme-repository/imp/slib3a1.tar.gz | -Unpack SLIB (`tar xzf slib2d4.tar.gz' or `unzip -ao slib2d4.zip') in an | +Unpack SLIB (`tar xzf slib3a1.tar.gz' or `unzip -ao slib3a1.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 `Init5d6.scm' is | +(this is the same directory as where the file `Init5d9.scm' is | installed). `require.scm' should have the contents: (define (library-vicinity) "/usr/local/lib/slib/") - (load (in-vicinity (library-vicinity) "require")) where the pathname string `/usr/local/lib/slib/' is to be replaced by the pathname into which you installed SLIB. Absolute pathnames are @@ -359,7 +358,6 @@ implementation-vicinity, which is absolute: (define library-vicinity (let ((lv (string-append (implementation-vicinity) "../slib/"))) (lambda () lv))) - (load (in-vicinity (library-vicinity) "require")) Alternatively, you can set the (shell) environment variable `SCHEME_LIBRARY_PATH' to the pathname of the SLIB directory (*note @@ -413,33 +411,33 @@ script with the `arrays', `inexact', and `bignums' options as defaults. bash$ ./build -| #! /bin/sh - # unix (linux) script created by SLIB/batch | - # ================ Write file with C defines | + # unix (linux) script created by SLIB/batch + # ================ Write file with C defines rm -f scmflags.h - echo '#define IMPLINIT "Init5d6.scm"'>>scmflags.h | + echo '#define IMPLINIT "Init5d9.scm"'>>scmflags.h | echo '#define BIGNUMS'>>scmflags.h echo '#define FLOATS'>>scmflags.h echo '#define ARRAYS'>>scmflags.h - # ================ Compile C source files | + # ================ Compile C source files gcc -O2 -c continue.c scm.c scmmain.c findexec.c script.c time.c repl.c scl.c eval.c sys.c subr.c debug.c unif.c rope.c - # ================ Link C object files | + # ================ Link C object files gcc -rdynamic -o scm continue.o scm.o scmmain.o findexec.o script.o time.o repl.o scl.o eval.o sys.o subr.o debug.o unif.o rope.o -lm -lc To cross compile for another platform, invoke build with the `-p' or `--platform=' option. This will create a script for the platform named in the `-p' or `--platform=' option. - bash$ ./build -o scmlit -p darwin -F lit | + bash$ ./build -o scmlit -p darwin -F lit -| - #! /bin/sh | - # unix (darwin) script created by SLIB/batch | - # ================ Write file with C defines | - rm -f scmflags.h | - echo '#define IMPLINIT "Init5d6.scm"'>>scmflags.h | - # ================ Compile C source files | + #! /bin/sh + # unix (darwin) script created by SLIB/batch + # ================ Write file with C defines + rm -f scmflags.h + echo '#define IMPLINIT "Init5d9.scm"'>>scmflags.h | + # ================ Compile C source files cc -O3 -c continue.c scm.c scmmain.c findexec.c script.c time.c repl.c scl.c eval.c sys.c subr.c debug.c unif.c rope.c - # ================ Link C object files | - mv -f scmlit scmlit~ | + # ================ Link C object files + mv -f scmlit scmlit~ cc -o scmlit continue.o scm.o scmmain.o findexec.o script.o time.o repl.o scl.o eval.o sys.o subr.o debug.o unif.o rope.o @@ -465,12 +463,11 @@ the SCM command line options. name processor operating-system compiler | #f processor-family operating-system #f | symbol processor-family operating-system symbol | - symbol atom symbol symbol | + symbol symbol symbol symbol | ================= ================= ================= ================= | *unknown* *unknown* unix cc | acorn-unixlib acorn *unknown* cc | aix powerpc aix cc | - alpha alpha osf1 cc | alpha-elf alpha unix cc | alpha-linux alpha linux gcc | amiga-aztec m68000 amiga cc | @@ -479,35 +476,65 @@ the SCM command line options. amiga-sas m68000 amiga lc | atari-st-gcc m68000 atari.st gcc | atari-st-turbo-c m68000 atari.st tcc | - borland-c 8086 ms-dos bcc | - cygwin32 i386 unix gcc | + 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 8086 ms-dos cl | + microsoft-c i8086 ms-dos cl | microsoft-c-nt i386 ms-dos cl | - microsoft-quick-c 8086 ms-dos qcl | - ms-dos 8086 ms-dos cc | + 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 8086 ms-dos tcc | + 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 myscm4 (scm). | + | + `udscm5.opt' | + Options for targets udscm5 and myscm5 (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 @@ -539,7 +566,7 @@ the SCM command line options. - Build Option: -s PATHNAME - Build Option: --scheme-initial=PATHNAME specifies that PATHNAME should be the default location of the SCM - initialization file `Init5d6.scm'. SCM tries several likely | + initialization file `Init5d9.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. @@ -586,7 +613,7 @@ the SCM command line options. * vms - * amigaos (was amigados) | + * amigaos (was amigados) * system @@ -619,6 +646,9 @@ the SCM command line options. "bignums" Large precision integers. + "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 @@ -786,11 +816,11 @@ 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: - bash$ build -c foo.c -i init_foo + bash$ ./build -c foo.c -i init_foo -| #! /bin/sh rm -f scmflags.h - echo '#define IMPLINIT "/home/jaffer/scm/Init5d6.scm"'>>scmflags.h | + echo '#define IMPLINIT "/home/jaffer/scm/Init5d9.scm"'>>scmflags.h | echo '#define COMPILED_INITS init_foo();'>>scmflags.h echo '#define BIGNUMS'>>scmflags.h echo '#define FLOATS'>>scmflags.h @@ -802,11 +832,11 @@ options to build: To make a dynamically loadable object file use the `-t dll' option: - bash$ build -t dll -c foo.c + bash$ ./build -t dll -c foo.c -| #! /bin/sh rm -f scmflags.h - echo '#define IMPLINIT "/home/jaffer/scm/Init5d6.scm"'>>scmflags.h | + echo '#define IMPLINIT "/home/jaffer/scm/Init5d9.scm"'>>scmflags.h | echo '#define BIGNUMS'>>scmflags.h echo '#define FLOATS'>>scmflags.h echo '#define ARRAYS'>>scmflags.h @@ -830,7 +860,7 @@ in the BSD family (a.out binary format) can usually be ported to "DLD". The "dl" library (`#define SUN_DL' for SCM) was a proposed POSIX standard and may be available on other machines with "COFF" binary format. For notes about porting to MS-Windows and finishing the port -to VMS *Note Finishing Dynamic Linking::. +to VMS *Note VMS Dynamic Linking::. "DLD" is a library package of C functions that performs "dynamic link editing" on Linux, VAX (Ultrix), Sun 3 (SunOS 3.4 and 4.0), @@ -962,9 +992,9 @@ lines or add a `#define FLAG' line to `scmfig.h' or the beginning of __ZTC__ Zortech C _AIX AIX operating system - __APPLE__ Apple Darwin | + __APPLE__ Apple Darwin AMIGA SAS/C 5.10 or Dice C on AMIGA - __amigaos__ Gnu CC on AMIGA | + __amigaos__ Gnu CC on AMIGA atarist ATARI-ST under Gnu CC __FreeBSD__ FreeBSD GNUDOS DJGPP (obsolete in version 1.08) @@ -973,9 +1003,11 @@ lines or add a `#define FLAG' line to `scmfig.h' or the beginning of linux Linux macintosh Macintosh (THINK_C and __MWERKS__ define) MCH_AMIGA Aztec_c 5.2a on AMIGA - __MACH__ Apple Darwin | + __MACH__ Apple Darwin 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. __SVR4 SunOS @@ -990,16 +1022,22 @@ lines or add a `#define FLAG' line to `scmfig.h' or the beginning of VAX11 VAX C compiler _Windows Borland C 3.1 compiling for Windows _WIN32 MS VisualC++ 4.2 and Cygwin (Win32 API) + _WIN32_WCE MS Windows CE vms (and VMS) VAX-11 C under VMS. __alpha DEC Alpha processor __alpha__ DEC Alpha processor hp9000s800 HP RISC processor + __ia64 GCC on IA64 | + __ia64__ GCC on IA64 | + _LONGLONG GCC on IA64 | __i386__ DJGPP i386 DJGPP + _M_ARM Microsoft CLARM compiler defines as 4 for ARM. + _M_ARMT Microsoft CLTHUMB compiler defines as 4 for Thumb. MULTIMAX Encore computer - ppc PowerPC | - __ppc__ PowerPC | + ppc PowerPC + __ppc__ PowerPC pyr Pyramid 9810 processor __sgi__ Silicon Graphics Inc. sparc SPARC processor @@ -1072,17 +1110,17 @@ remove <FLAG> in scmfig.h and Do so and recompile files. recompile scm. add <FLAG> in scmfig.h and recompile scm. -ERROR: Init5d6.scm not found. Assign correct IMPLINIT in makefile | +ERROR: Init5d9.scm not found. Assign correct IMPLINIT in makefile | or scmfig.h. Define environment variable SCM_INIT_PATH to be the full - pathname of Init5d6.scm. | + pathname of Init5d9.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 - Init5d6.scm to point to library or | + Init5d9.scm to point to library or | remove. Make sure the value of (library-vicinity) has a trailing @@ -1114,13 +1152,13 @@ of pi. > (load "pi") ;loading "pi" ;done loading "pi.scm" - ;Evaluation took 20 ms (0 in gc) 767 cells work, 233.B other | + ;Evaluation took 20 ms (0 in gc) 767 cells work, 233.B other #<unspecified> > (pi 100 5) 00003 14159 26535 89793 23846 26433 83279 50288 41971 69399 37510 58209 74944 59230 78164 06286 20899 86280 34825 34211 70679 - ;Evaluation took 550 ms (60 in gc) 36976 cells work, 1548.B other | + ;Evaluation took 550 ms (60 in gc) 36976 cells work, 1548.B other #<unspecified> Loading `bench.scm' will compute and display performance statistics of @@ -1142,7 +1180,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. `Init5d6.scm'). | +output files. `Init5d9.scm'). | Spaces or control characters appear Check character defines in in symbol names. `scmfig.h'. Negative numbers turn positive. Check SRS in `scmfig.h'. @@ -1167,8 +1205,8 @@ Reporting Problems Reported problems and solutions are grouped under Compiling, Linking, Running, and Testing. If you don't find your problem listed there, you -can send a bug report to `jaffer @ alum.mit.edu'. The bug report | -should include: | +can send a bug report to `agj @ alum.mit.edu'. The bug report should +include: 1. The version of SCM (printed when SCM is invoked with no arguments). @@ -1223,7 +1261,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 `Init5d6.scm') in platform-dependent directories relative | +file (usually `Init5d9.scm') in platform-dependent directories relative | to this directory. See *Note File-System Habitat:: for a blow-by-blow description. @@ -1232,19 +1270,19 @@ 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, `Init5d6.scm' checks to see if there is file | +command line, `Init5d9.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. -`Init5d6.scm' then looks for command input from one of three sources: | +`Init5d9.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. This explanation applies to SCMLIT or other builds of SCM. Scheme-code files can also invoke SCM and its variants. *Note #!: -Syntax Extensions. +Lexical Conventions. File: scm.info, Node: SCM Options, Next: Invocation Examples, Prev: Invoking SCM, Up: Operational Features @@ -1254,8 +1292,8 @@ Options The options are processed in the order specified on the command line. - - Command Option: -a k | - specifies that `scm' should allocate an initial heapsize of 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 @@ -1273,10 +1311,10 @@ The options are processed in the order specified on the command line. - 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, r2rs, 3, | - 3rs, r3rs, 4, 4rs, 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 provides FEATURE. @@ -1284,11 +1322,11 @@ The options are processed in the order specified on the command line. - 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 + on the command line if no `-c', `-e', `-f', `-l', or `-s' option preceeds it. - Command Option: -d filename - Loads SLIB `databases' feature and opens FILENAME as a database. | + Loads SLIB `databases' feature and opens FILENAME as a database. - Command Option: -e expression - Command Option: -c expression @@ -1349,12 +1387,14 @@ The options are processed in the order specified on the command line. are errors. - Command Option: -s - specifies, by analogy with `sh', that further options are to be - treated as program aguments. + 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: -- - specifies that there are no more options on the command line. + 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 @@ -1396,13 +1436,13 @@ Environment Variables - Environment Variable: SCM_INIT_PATH is the pathname where `scm' will look for its initialization code. - The default is the file `Init5d6.scm' in the source directory. | + The default is the file `Init5d9.scm' in the source directory. | - Environment Variable: SCHEME_LIBRARY_PATH is the [SLIB] Scheme library directory. - Environment Variable: HOME - is the directory where `Init5d6.scm' will look for the user | + is the directory where `Init5d9.scm' will look for the user | initialization file `ScmInit.scm'. - Environment Variable: EDITOR @@ -1417,7 +1457,7 @@ Scheme Variables 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' @@ -1452,14 +1492,19 @@ SCM Session SCM can also tail-call another program. *Note execp: I/O-Extensions. - - 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. | - | + - 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 Returns a list of strings of the arguments scm was called with. + - 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. + For documentation of the procedures `getenv' and `system' *Note System Interface: (slib)System Interface. @@ -1483,14 +1528,11 @@ Editing Scheme Code Gnu Emacs: Editing of Scheme code is supported by emacs. Buffers holding - files ending in .scm are automatically put into scheme-mode. - EMACS for MS-DOS and MS-Windows systems is available (free) from: - - <http://simtel.coast.net/SimTel/gnu/demacs.html> + 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 @@ -1716,13 +1758,13 @@ warnings and errors. - Function: warn arg1 arg2 arg3 ... Alias for *Note slib:warn: (slib)System. Outputs an error message - containing the arguments. `warn' is defined in `Init5d6.scm'. | + containing the arguments. `warn' is defined in `Init5d9.scm'. | - Function: error arg1 arg2 arg3 ... Alias for *Note slib:error: (slib)System. Outputs an error message containing the arguments, aborts evaluation of the current form and resumes the top level read-eval-print loop. `Error' is - defined in `Init5d6.scm'. | + defined in `Init5d9.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 @@ -1740,7 +1782,7 @@ with Lisp systems. - Function: stack-trace Prints information describing the stack of partially evaluated expressions. `stack-trace' returns `#t' if any lines were printed - and `#f' otherwise. See `Init5d6.scm' for an example of the use | + and `#f' otherwise. See `Init5d9.scm' for an example of the use | of `stack-trace'. @@ -1765,7 +1807,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 `Init5d6.scm': | +For instance, `open-input-file' is defined as follows in `Init5d9.scm': | (define (open-input-file str) (or (open-file str OPEN_READ) @@ -1814,7 +1856,7 @@ Internal State *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 `Init5d6.scm' for details. | + more complicated; see `Init5d9.scm' for details. | - Function: abort Resumes the top level Read-Eval-Print loop. @@ -1844,19 +1886,19 @@ Internal State a prompt is printed. >= 2 - messages bracketing file loading are printed. | + messages bracketing file loading are printed. >= 3 - the CPU time is printed after each top level form evaluated; | - notifications of heap growth printed. | + the CPU time is printed after each top level form evaluated; + notifications of heap growth printed. >= 4 - a garbage collection summary is printed after each top level | - form evaluated; | + a garbage collection summary is printed after each top level + form evaluated; >= 5 - a message for each GC (*note Garbage Collection::) is printed; | - warnings issued for top-level symbols redefined. | + a message for each GC (*note Garbage Collection::) is printed; + warnings issued for top-level symbols redefined. - Function: gc Scans all of SCM objects and reclaims for further use those that @@ -1868,7 +1910,7 @@ Internal State #t)' also gives the hexadecimal heap segment and stack bounds. - Constant: *scm-version* - Contains the version string (e.g. `5d6') of SCM. | + Contains the version string (e.g. `5d9') of SCM. | Executable path --------------- @@ -1923,9 +1965,9 @@ file has (different) meanings to SCM and the operating system When executing a shell-script, the operating system invokes INTERPRETER with a single argument encapsulating the rest of the - first line's contents (if if not just whitespace), the pathname of - the Scheme Script file, and then any arguments which the - shell-script was invoked with. + first line's contents (if not just whitespace), the pathname of the + Scheme Script file, and then any arguments which the shell-script + was invoked with. Put one space character between `#!' and the first character of INTERPRETER (`/'). The INTERPRETER name is followed by ` \'; SCM @@ -1957,25 +1999,25 @@ The following Scheme-Script prints factorial of its argument: #! /usr/local/bin/scm \ %0 %1 %2 %3 %4 %5 %6 %7 %8 %9 - !# - ; -*-scheme-*- - (define (go-script) - (cond ((not *script*)) - ((and (= 1 (- (length *argv*) *optind*)) - (string->number (list-ref *argv* *optind*))) - => (lambda (n) (print (fact n)))) - (else - (print *argv*) - (display "\ - Usage: fact n - Returns the factorial of N. - http://swissnet.ai.mit.edu/~jaffer/SLIB.html + (define (fact.script args) + (cond ((and (= 1 (length args)) + (string->number (car args))) + => (lambda (n) (print (fact n)) #t)) + (else (fact.usage)))) + + (define (fact.usage) + (print *argv*) + (display "\ + Usage: fact N + Returns the factorial of N. " - (current-error-port)) - (exit #f)))) + (current-error-port)) + #f) (define (fact n) (if (< n 2) 1 (* n (fact (+ -1 n))))) - (go-script) + + (if *script* (exit (fact.script (list-tail *argv* *optind*)))) ./fact 32 => @@ -1987,10 +2029,8 @@ usage information. ./fact 3 2 -| ("./fact" "3" "2") - Usage: fact n + Usage: fact N Returns the factorial of N. - - http://swissnet.ai.mit.edu/~jaffer/SLIB.html File: scm.info, Node: MS-DOS Compatible Scripts, Next: Unix Shell Scripts, Prev: Unix Scheme Scripts, Up: Scripting @@ -2000,7 +2040,8 @@ 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'. +`#!.bat' and `!#.exe', which are available from: | +<http://swissnet.ai.mit.edu/ftpdir/scm/sharpbang.zip> | With these two programs installed in a `PATH' directory, we have the following syntax for <PROGRAM>.BAT files. @@ -2022,9 +2063,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 the 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. @@ -2070,25 +2111,24 @@ example. #! /bin/sh :;exec scm -e"(set! *script* \"$0\")" -l$0 $* - (define (go-script) - (cond ((not *script*)) - ((and (= 1 (- (length *argv*) *optind*)) - (string->number (list-ref *argv* *optind*))) - => (lambda (n) (print (fact n)))) - (else - (print *argv*) - (display "\ - Usage: fact n - Returns the factorial of N. + (define (fact.script args) + (cond ((and (= 1 (length args)) + (string->number (car args))) + => (lambda (n) (print (fact n)) #t)) + (else (fact.usage)))) - http://swissnet.ai.mit.edu/~jaffer/SLIB.html + (define (fact.usage) + (print *argv*) + (display "\ + Usage: fact N + Returns the factorial of N. " - (current-error-port)) - (exit #f)))) + (current-error-port)) + #f) (define (fact n) (if (< n 2) 1 (* n (fact (+ -1 n))))) - (go-script) + (if *script* (exit (fact.script (list-tail *argv* *optind*)))) ./fact 6 => 720 @@ -2102,19 +2142,17 @@ The Language * Menu: * Standards Compliance:: Links to sections in [R5RS] and [SLIB] -* Miscellaneous Procedures:: +* Storage:: Finalizers, GC-hook, vector-set-length! * Time:: Both real time and processor time * Interrupts:: and exceptions * Process Synchronization:: Because interrupts are preemptive * Files and Ports:: -* Line Numbers:: | -* Soft Ports:: Emulate I/O devices -* Syntax Extensions:: -* Low Level Syntactic Hooks:: -* Syntactic Hooks for Hygienic Macros:: +* Eval and Load:: and line-numbers +* Lexical Conventions:: Also called read-syntax +* Syntax:: Macros -File: scm.info, Node: Standards Compliance, Next: Miscellaneous Procedures, Prev: The Language, Up: The Language +File: scm.info, Node: Standards Compliance, Next: Storage, Prev: The Language, Up: The Language Standards Compliance ==================== @@ -2234,52 +2272,10 @@ Optionals of [R5RS] not Supported by SCM *Note Require: (slib)Require. -File: scm.info, Node: Miscellaneous Procedures, Next: Time, Prev: Standards Compliance, Up: The Language - -Miscellaneous Procedures -======================== - - - 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'. - If not, try-load returns `#f'. The try-load procedure does not - affect the values returned by `current-input-port' and - `current-output-port'. +File: scm.info, Node: Storage, Next: Time, Prev: Standards Compliance, Up: The Language - - 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: line-number - Returns the current line number of the file currently being loaded. - - - 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 - 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: eval obj - Alias for *Note eval: (slib)System. - - - 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 - 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'. +Storage +======= - Function: vector-set-length! object length Change the length of string, vector, bit-vector, or uniform-array @@ -2296,22 +2292,45 @@ Miscellaneous Procedures on this feature; `copy-tree' could get redefined. - Function: acons obj1 obj2 obj3 - Returns (cons (cons obj1 obj2) obj3). The expression (set! a-list - (acons key datum a-list)) adds a new association to a-list. + Returns (cons (cons obj1 obj2) obj3). - - Function: terms - This command displays the GNU General Public License. + (set! a-list (acons key datum a-list)) - - Function: list-file filename - Displays the text contents of FILENAME. + Adds a new association to a-list. - - Procedure: 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. + - 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 + warning will be printed. + + To remove the gc-hook, `(set! gc-hook #f)'. + + - 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 + procedure taking no arguments. + + FINALIZER will be invoked asynchronously exactly once some time + after OBJECT becomes eligible for garbage collection. A reference + to OBJECT in the environment of FINALIZER will not prevent + finalization, but will delay the reclamation of OBJECT at least + until the next garbage collection. A reference to OBJECT in some + other object's finalizer will necessarily prevent finalization + until both objects are eligible for garbage collection. + + Finalizers are not run in any predictable order. All finalizers + will be run by the time the program ends. + + This facility was based on the paper by Simon Peyton Jones, et al, + "Stretching the storage manager: weak pointers and stable names in + Haskell", Proc. 11th International Workshop on the Implementation + of Functional Languages, The Netherlands, September 7-10 1999, + Springer-Verlag LNCS. -File: scm.info, Node: Time, Next: Interrupts, Prev: Miscellaneous Procedures, Up: The Language +File: scm.info, Node: Time, Next: Interrupts, Prev: Storage, Up: The Language Time ==== @@ -2417,70 +2436,40 @@ Interrupts To unestablish a response for an error set the handler symbol to `#f'. For instance, `(set! could-not-open #f)'. - - 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 | - warning will be printed. | - | - - 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 | - procedure taking no arguments. | - | - FINALIZER will be invoked asynchronously exactly once some time | - after OBJECT becomes eligible for garbage collection. A reference | - to OBJECT in the environment of FINALIZER will not prevent | - finalization, but will delay the reclamation of OBJECT at least | - until the next garbage collection. A reference to OBJECT in some | - other object's finalizer will necessarily prevent finalization | - until both objects are eligible for garbage collection. | - | - Finalizers are not run in any predictable order. All finalizers | - will be run by the time the program ends. | - | - This facility was based on the paper by Simon Peyton Jones, et al, | - "Stretching the storage manager: weak pointers and stable names in | - Haskell", Proc. 11th International Workshop on the Implementation | - of Functional Languages, The Netherlands, September 7-10 1999, | - Springer-Verlag LNCS. | - | - | File: scm.info, Node: Process Synchronization, Next: Files and Ports, Prev: Interrupts, Up: The Language 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 | -operation. | - | - - Function: make-exchanger obj | - Returns a new exchanger with the argument OBJ as its initial | - content. | - | - (define queue (make-exchanger (list a))) | - | - A queue implemented as an exchanger holding a list can be | - protected from reentrant execution thus: | - | - (define (pop queue) | - (let ((lst #f)) | - (dynamic-wind | - (lambda () (set! lst (queue #f))) | - (lambda () (and lst (not (null? lst)) | - (let ((ret (car lst))) | - (set! lst (cdr lst)) | - ret))) | - (lambda () (and lst (queue lst)))))) | - | - (pop queue) => a | - | - (pop queue) => #f | - | +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 + Returns a new exchanger with the argument OBJ as its initial + content. + + (define queue (make-exchanger (list a))) + + A queue implemented as an exchanger holding a list can be + protected from reentrant execution thus: + + (define (pop queue) + (let ((lst #f)) + (dynamic-wind + (lambda () (set! lst (queue #f))) + (lambda () (and lst (not (null? lst)) + (let ((ret (car lst))) + (set! lst (cdr lst)) + ret))) + (lambda () (and lst (queue lst)))))) + + (pop queue) => a + + (pop queue) => #f + - Function: make-arbiter name Returns an object of type arbiter and name NAME. Its state is initially unlocked. @@ -2494,14 +2483,27 @@ operation. | Otherwise, returns `#f'. -File: scm.info, Node: Files and Ports, Next: Line Numbers, Prev: Process Synchronization, Up: The Language - | +File: scm.info, Node: Files and Ports, Next: Eval and Load, Prev: Process Synchronization, Up: The Language + Files and Ports =============== These procedures generalize and extend the standard capabilities in *Note Ports: (r5rs)Ports. +* Menu: + +* Opening and Closing:: +* Port Properties:: +* Port Redirection:: +* Soft Ports:: + + +File: scm.info, Node: Opening and Closing, Next: Port Properties, Prev: Files and Ports, Up: Files and Ports + +Opening and Closing +------------------- + - Function: open-file string modes - Function: try-open-file string modes Returns a port capable of receiving or delivering characters as @@ -2519,15 +2521,15 @@ These procedures generalize and extend the standard capabilities in Contain modes strings specifying that a file is to be opened for reading, writing, and both reading and writing respectively. - Both input and output functions can be used with io-ports. An end | - 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. | - | + Both input and output functions can be used with io-ports. An end + 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 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 | + 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 @@ -2536,49 +2538,58 @@ These procedures generalize and extend the standard capabilities in port maintains current line and column numbers, which may be queried with `port-line' and `port-column'. - - 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: port-closed? port | - Returns #t if PORT is closed. | - | - - 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: _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 + 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 Closes PORT. The same as close-input-port and close-output-port. - | - - Function: current-error-port - Returns the current port to which diagnostic output is directed. - - 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 - current-error-port, and the THUNK is called with no arguments. - When the thunk returns, the port is closed and the previous - default is restored. With-error-to-file returns the value yielded - by THUNK. + +File: scm.info, Node: Port Properties, Next: Port Redirection, Prev: Opening and Closing, Up: Files and Ports - - 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. +Port Properties +--------------- - - 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 - error-string, and the value returned by THUNK. If THUNK does not - return a value (perhaps because of error), PROC is called with - just the output-string and the error-string as arguments. + - Function: port-closed? port + Returns #t if PORT is closed. + + - 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 + 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 + 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 + 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 + Returns `#t' if PORT is input or output to a serial non-file + device. - procedure: char-ready? - procedure: char-ready? port @@ -2606,81 +2617,44 @@ These procedures generalize and extend the standard capabilities in omitted, in which case they default to the list of the value returned by `current-input-port'. - - Function: isatty? port - Returns `#t' if PORT is input or output to a serial non-file - device. + +File: scm.info, Node: Port Redirection, Next: Soft Ports, Prev: Port Properties, Up: Files and Ports - - 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'. +Port Redirection +---------------- + + - Function: current-error-port + Returns the current port to which diagnostic output is directed. + + - 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 + current-error-port, and the THUNK is called with no arguments. + When the thunk returns, the port is closed and the previous + 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 + 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 + 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 + error-string, and the value returned by THUNK. If THUNK does not + return a value (perhaps because of error), PROC is called with + just the output-string and the error-string as arguments. - - 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. | - | - -File: scm.info, Node: Line Numbers, Next: Soft Ports, Prev: Files and Ports, Up: The Language - | -Line Numbers | -============ | - | -Scheme code define 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 | - 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 | - code as list structure. The default value is `read', which is | - used if READER is not supplied or is false. | - | -Line number objects are disjoint from integers or other Scheme types. | -When evaluated or loaded as Scheme code, an s-expression containing a | -line-number in the car is equivalent to the cdr of the s-expression. A | -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 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 | - Returns the value of line-number object LINUM as an integer. | - | - - Function: line-number? obj | - Returns true if and only if OBJ is a line-number object. | - | - - 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 | - value of `*slib-load-reader*' will similarly be used during calls | - to `slib:load' and `require'. | - | - In order to disable all line-numbering, it is sufficient to set! | - `*load-reader*' and `*slib-load-reader*' to #f. | - | -File: scm.info, Node: Soft Ports, Next: Syntax Extensions, Prev: Line Numbers, Up: The Language - | +File: scm.info, Node: Soft Ports, Prev: Port Redirection, Up: Files and Ports + 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. @@ -2710,9 +2684,9 @@ accepting or delivering characters. It allows emulation of I/O ports. (r5rs)Input.) it indicates that the port has reached end-of-file. For example: - If it is necessary to explicitly close the port when it is garbage | - collected, (*note add-finalizer: Interrupts.). | - | + If it is necessary to explicitly close the port when it is garbage + collected, (*note add-finalizer: Interrupts.). + (define stdout (current-output-port)) (define p (make-soft-port (vector @@ -2726,10 +2700,194 @@ accepting or delivering characters. It allows emulation of I/O ports. (write p p) => #<input-output-soft#\space45d10#\> -File: scm.info, Node: Syntax Extensions, Next: Low Level Syntactic Hooks, Prev: Soft Ports, Up: The Language +File: scm.info, Node: Eval and Load, Next: Lexical Conventions, Prev: Files and Ports, Up: The Language + +Eval and Load +============= + + - 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'. + If not, try-load returns `#f'. The try-load procedure does not + affect the values returned by `current-input-port' and + `current-output-port'. + + - 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 + Alias for *Note eval: (slib)System. + + - 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 + 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 + Returns the current line number of the file currently being loaded. + +* Menu: + +* Line Numbers:: + + +File: scm.info, Node: Line Numbers, Prev: Eval and Load, Up: Eval and Load + +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 + 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 + code as list structure. The default value is `read', which is + used if READER is not supplied or is false. + +Line number objects are disjoint from integers or other Scheme types. +When evaluated or loaded as Scheme code, an s-expression containing a +line-number in the car is equivalent to the cdr of the s-expression. A +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 + Returns a line-number object with value INT. INT should be an + exact non-negative integer. + + - Function: line-number->integer linum + Returns the value of line-number object LINUM as an integer. + + - 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* + 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 + value of `*slib-load-reader*' will similarly be used during calls + to `slib:load' and `require'. + + In order to disable all line-numbering, it is sufficient to set! + `*load-reader*' and `*slib-load-reader*' to #f. + + +File: scm.info, Node: Lexical Conventions, Next: Syntax, Prev: Eval and Load, Up: The Language + +Lexical Conventions +=================== + +* Menu: + +* Common-Lisp Read 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 + | +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))'. | + + 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. + + Feature is a boolean expression composed of symbols and `and', + `or', and `not' of boolean expressions. + + For more information on `provided?' and `*features*', *Note + Require: (slib)Require. -Syntax Extensions -================= + - Read syntax: #- feature form + is equivalent to `#+(not feature) expression'. + | + - 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 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: | + | + #.(define foo 9) => #<unspecified> | + '(#.foo #.(+ foo foo)) => (9 18) | + | + - 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 + | +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. | + | + +File: scm.info, Node: Documentation and Comments, Next: Modifying Read Syntax, Prev: Load Syntax, Up: Lexical Conventions + | +Documentation and Comments +-------------------------- - procedure: procedure-documentation proc Returns the documentation string of PROC if it exists, or `#f' if @@ -2755,52 +2913,83 @@ Syntax Extensions Returns the (appended) strings given as arguments to previous calls `comment' and empties the current string collection. - - Read syntax: #;text-till-end-of-line + - Load syntax: #;text-till-end-of-line | Behaves as `(comment "TEXT-TILL-END-OF-LINE")'. - - Read syntax: #. expression - Is read as the object resulting from the evaluation of EXPRESSION. - This substitution occurs even inside quoted structure. + +File: scm.info, Node: Modifying Read Syntax, Prev: Documentation and Comments, Up: Lexical Conventions - 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: +Modifying Read Syntax +--------------------- - #.(define foo 9) => #<unspecified> - '(#.foo #.(+ foo foo)) => (9 18) + - 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 + from. The value returned by this function will be the value of + `read' for this expression unless the function returns + `#<unspecified>' in which case the expression will be treated as + whitespace. `#<unspecified>' is the value returned by the + expression `(if #f #f)'. - - 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. + - 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. | - Feature is a boolean expression composed of symbols and `and', - `or', and `not' of boolean expressions. +_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'). | - For more information on `provided?' and `*features*', *Note - Require: (slib)Require. + +File: scm.info, Node: Syntax, Prev: Lexical Conventions, Up: The Language - - Read syntax: #- feature form - is equivalent to `#+(not feature) expression'. +Syntax +====== - - Read syntax: #' form - is equivalent to FORM (for compatibility with common-lisp). +SCM provides a native implementation of "defmacro". *Note Defmacro: +(slib)Defmacro. - - Read syntax: #| any thing |# - Is a balanced comment. Everything up to the matching `|#' is - ignored by the `read'. Nested `#|...|#' can occur inside ANY - THING. +When built with `-F macro' build option (*note Build Options::) and +`*syntax-rules*' is non-false, SCM also supports [R5RS] `syntax-rules' +macros. *Note Macros: (r5rs)Macros. + +Other Scheme Syntax Extension Packages from SLIB can be employed through +the use of `macro:eval' and `macro:load'; Or by using the SLIB +read-eval-print-loop: -A similar read syntax "#!" (exclamation rather than vertical bar) is -supported for Posix shell-scripts (*note Scripting::). + (require 'repl) + (repl:top-level macro:eval) - - 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))'. +With the appropriate catalog entries (*note Library Catalogs: +(slib)Library Catalogs.), files using macro packages will automatically +use the correct macro loader when `require'd. - 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. +* Menu: + +* Define and Set:: +* Defmacro:: +* Syntax-Rules:: +* Macro Primitives:: +* Environment Frames:: +* Syntactic Hooks for Hygienic Macros:: + + +File: scm.info, Node: Define and Set, Next: Defmacro, Prev: Syntax, Up: Syntax + +Define and Set +-------------- - Special Form: defined? symbol Equivalent to `#t' if SYMBOL is a syntactic keyword (such as `if') @@ -2814,7 +3003,7 @@ supported for Posix shell-scripts (*note Scripting::). 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. `defconst' is valid only when used at + value is not changed. `defvar' is valid only when used at | top-level. - Special Form: defconst identifier value @@ -2840,9 +3029,9 @@ supported for Posix shell-scripts (*note Scripting::). (set! (x y) (list 4 5)) => _unspecified_ (+ x y) => 9 - - 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 | + - 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: * literal datums, or @@ -2852,7 +3041,7 @@ supported for Posix shell-scripts (*note Scripting::). * a comma followed by an at-sign (@) followed by the name of a symbolic constant whose value is a list. - A `qase' statement is equivalent to a `case' statement in which | + A `qase' statement is equivalent to a `case' statement in which these symbolic constants preceded by commas have been replaced by the values of the constants, and all symbolic constants preceded by comma-at-signs have been replaced by the elements of the list @@ -2861,27 +3050,32 @@ supported for Posix shell-scripts (*note Scripting::). unquoted expressions must be "symbolic constants". Symbolic constants are defined using `defconst', their values are - substituted in the head of each `qase' clause during macro | + substituted in the head of each `qase' clause during macro expansion. `defconst' constants should be defined before use. - `qase' can be substituted for any correct use of `case'. | + `qase' can be substituted for any correct use of `case'. (defconst unit '1) (defconst semivowels '(w y)) - (qase (* 2 3) | + (qase (* 2 3) ((2 3 5 7) 'prime) ((,unit 4 6 8 9) 'composite)) ==> composite - (qase (car '(c d)) | + (qase (car '(c d)) ((a) 'a) ((b) 'b)) ==> _unspecified_ - (qase (car '(c d)) | + (qase (car '(c d)) ((a e i o u) 'vowel) ((,@semivowels) 'semivowel) (else 'consonant)) ==> consonant + +File: scm.info, Node: Defmacro, Next: Syntax-Rules, Prev: Define and Set, Up: Syntax + +Defmacro +-------- -SCM also supports the following constructs from Common Lisp: -`defmacro', `macroexpand', `macroexpand-1', and `gentemp'. *Note -Defmacro: (slib)Defmacro. +SCM supports the following constructs from Common Lisp: `defmacro', +`macroexpand', `macroexpand-1', and `gentemp'. *Note Defmacro: +(slib)Defmacro. SCM `defmacro' is extended over that described for SLIB: @@ -2907,13 +3101,19 @@ For example: (let1 not legal syntax) error--> not "does not match" ((name value)) + +File: scm.info, Node: Syntax-Rules, Next: Macro Primitives, Prev: Defmacro, Up: Syntax + +Syntax-Rules +------------ + SCM supports [R5RS] `syntax-rules' macros *Note Macros: (r5rs)Macros. -The pattern language is extended by the syntax `(... <obj>)', which is | -identical to `<obj>' except that ellipses in `<obj>' are treated as | -ordinary identifiers in a template, or as literals in a pattern. In | -particular, `(... ...)' quotes the ellipsis token `...' in a pattern or | -template. | +The pattern language is extended by the syntax `(... <obj>)', which is +identical to `<obj>' except that ellipses in `<obj>' are treated as +ordinary identifiers in a template, or as literals in a pattern. In +particular, `(... ...)' quotes the ellipsis token `...' in a pattern or +template. For example: (define-syntax check-tree @@ -2956,34 +3156,10 @@ For example: (set! eight 9) => ERROR -File: scm.info, Node: Low Level Syntactic Hooks, Next: Syntactic Hooks for Hygienic Macros, Prev: Syntax Extensions, Up: The Language - -Low Level Syntactic Hooks -========================= +File: scm.info, Node: Macro Primitives, Next: Environment Frames, Prev: Syntax-Rules, Up: Syntax - - 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 - from. The value returned by this function will be the value of - `read' for this expression unless the function returns - `#<unspecified>' in which case the expression will be treated as - whitespace. `#<unspecified>' is the value returned by the - expression `(if #f #f)'. - - - Callback procedure: read:sharp-char token - If the sequence <#\> followed by a non-standard character name is - encountered by `read', `read' will call the value of the symbol - `read:sharp-char' 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 `read:sharp' or `read:sharp-char' 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 use `read:sharp'). +Macro Primitives +---------------- - Function: procedure->syntax proc Returns a "macro" which, when a symbol defined to this value @@ -3000,7 +3176,7 @@ supported (as they use `read:sharp'). `PROCEDURE->MEMOIZING-MACRO' replaces the form passed to PROC. For example: - (defsyntax trace | + (defsyntax trace (procedure->macro (lambda (x env) `(set! ,(cadr x) (tracef ,(cadr x) ',(cadr x)))))) @@ -3014,56 +3190,62 @@ supported (as they use `read:sharp'). identifier. - - 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. | - | -An "environment" is a list of frames representing lexical bindings. | -Only the names and scope of the bindings are included in environments | -passed to macro expanders - run-time values are not included. | - | -There are several types of environment frames: | + - 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. + + +File: scm.info, Node: Environment Frames, Next: Syntactic Hooks for Hygienic Macros, Prev: Macro Primitives, Up: Syntax + +Environment Frames +------------------ + +An "environment" is a list of frames representing lexical bindings. +Only the names and scope of the bindings are included in environments +passed to macro expanders - run-time values are not included. + +There are several types of environment frames: `((lambda (variable1 ...) ...) value1 ...)' `(let ((variable1 value1) (variable2 value2) ...) ...)' `(letrec ((variable1 value1) ...) ...)' result in a single enviroment frame: - | - (variable1 variable2 ...) | + + (variable1 variable2 ...) `(let ((variable1 value1)) ...)' `(let* ((variable1 value1) ...) ...)' result in an environment frame for each variable: - | - variable1 variable2 ... | - | -`(let-syntax ((key1 macro1) (key2 macro2)) ...)' | -`(letrec-syntax ((key1 value1) (key2 value2)) ...)' | - Lexically bound macros result in environment frames consisting of | - a marker and an alist of keywords and macro objects: | - | - (<env-syntax-marker> (key1 . value1) (key2 . value2)) | - Currently <env-syntax-marker> is the integer 6. | - | -`line numbers' | - Line numbers (*note Line Numbers::) may be included in the | - environment as frame entries to indicate the line number on which | - a function is defined. They are ignored for variable lookup. | - | - #<line 8> | - | -`miscellaneous' | - Debugging information is stored in environments in a plist format: | - Any exact integer stored as an environment frame may be followed | - by any value. The two frame entries are ignored when doing | - variable lookup. Load file names, procedure names, and closure | - documentation strings are stored in this format. | - | - <env-filename-marker> "foo.scm" <env-procedure-name-marker> foo ... | - | - Currently <env-filename-marker> is the integer 1 and | - <env-procedure-name-marker> the integer 2. | + + variable1 variable2 ... + +`(let-syntax ((key1 macro1) (key2 macro2)) ...)' +`(letrec-syntax ((key1 value1) (key2 value2)) ...)' + Lexically bound macros result in environment frames consisting of + a marker and an alist of keywords and macro objects: + + (<env-syntax-marker> (key1 . value1) (key2 . value2)) + Currently <env-syntax-marker> is the integer 6. + +`line numbers' + Line numbers (*note Line Numbers::) may be included in the + environment as frame entries to indicate the line number on which + a function is defined. They are ignored for variable lookup. + + #<line 8> + +`miscellaneous' + Debugging information is stored in environments in a plist format: + Any exact integer stored as an environment frame may be followed + by any value. The two frame entries are ignored when doing + variable lookup. Load file names, procedure names, and closure + documentation strings are stored in this format. + + <env-filename-marker> "foo.scm" <env-procedure-name-marker> foo ... + + Currently <env-filename-marker> is the integer 1 and + <env-procedure-name-marker> the integer 2. - Special Form: @apply procedure argument-list Returns the result of applying PROCEDURE to ARGUMENT-LIST. @@ -3078,10 +3260,10 @@ There are several types of environment frames: | bindings. -File: scm.info, Node: Syntactic Hooks for Hygienic Macros, Prev: Low Level Syntactic Hooks, Up: The Language +File: scm.info, Node: Syntactic Hooks for Hygienic Macros, Prev: Environment Frames, Up: Syntax Syntactic Hooks for Hygienic Macros -=================================== +----------------------------------- SCM provides a synthetic identifier type for efficient implementation of hygienic macros (for example, `syntax-rules' *note Macros: @@ -3117,7 +3299,7 @@ will be repeatedly replaced by its parent, until a symbol is obtained. Returns the symbol obtained by recursively extracting the parent of ID, which must be an identifier. -Use of synthetic identifiers +Use of Synthetic Identifiers ---------------------------- `renamed-identifier' may be used as a replacement for `gentemp': @@ -3156,10 +3338,10 @@ lexical scope of its environment. There is another restriction imposed for implementation convenience: Macros passing their lexical environments to `renamed-identifier' may -be lexically bound only by the special forms `let-syntax' or | -`letrec-syntax'. No error is signaled if this restriction is not met, | +be lexically bound only by the special forms `let-syntax' or +`letrec-syntax'. No error is signaled if this restriction is not met, but synthetic identifier lookup will not work properly. - | + In order to maintain referential transparency it is necessary to determine whether two identifiers have the same denotation. With synthetic identifiers it is not necessary that two identifiers be `eq?' @@ -3238,15 +3420,15 @@ Packages ******** * Menu: - | + * Dynamic Linking:: * Dump:: Create Fast-Booting Executables * Numeric:: Numeric Language Extensions * Arrays:: As in APL -* Records:: Define new aggregate data types | +* Records:: Define new aggregate data types * I/O-Extensions:: i/o-extensions * Posix Extensions:: posix -* Unix Extensions:: non-posix unix | +* Unix Extensions:: non-posix unix * Regular Expression Pattern Matching:: regex * Line Editing:: edit-line * Curses:: Screen Control @@ -3255,11 +3437,11 @@ Packages * 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 - | + Dynamic Linking =============== @@ -3405,8 +3587,8 @@ There are constraints on which sessions are savable using `dump' * Creates an executable program named NEWPATH which continues the state of the current SCM session when invoked. The optional argument THUNK, if provided, should be a procedure - of no arguments; BOOT-TAIL will be set to this procedure, | - causing it to be called in the restored executable. | + of no arguments; BOOT-TAIL will be set to this procedure, + causing it to be called in the restored executable. If the optional argument is missing or a boolean, SCM's standard command line processing will be called in the @@ -3434,7 +3616,7 @@ The procedure `program-arguments' returns the command line arguments for the curent invocation. More specifically, `program-arguments' for the restored session are _not_ saved from the dumping session. Command line processing is done on the value of the identifier `*argv*'. - | + The following example shows how to create `rscm', which is like regular scm, but which loads faster and has the `random' package alreadly provided. @@ -3531,73 +3713,39 @@ operations: (r5rs)Numerical operations. File: scm.info, Node: Arrays, Next: Records, Prev: Numeric, Up: Packages - | + Arrays ====== * Menu: * Conventional Arrays:: -* Array Mapping:: array-for-each * Uniform Array:: * Bit Vectors:: +* Array Mapping:: array-for-each -File: scm.info, Node: Conventional Arrays, Next: Array Mapping, Prev: Arrays, Up: Arrays +File: scm.info, Node: Conventional Arrays, Next: Uniform Array, Prev: Arrays, Up: Arrays Conventional Arrays ------------------- +The following syntax and procedures are SCM extensions to feature +`array' in *Note Arrays: (slib)Arrays. + "Arrays" read and write as a `#' followed by the "rank" (number of dimensions) followed by the character #\a or #\A and what appear as 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 3 3) => - #2A((ho ho ho) (ho ho ho) (ho ho ho)) + (create-array '#(ho) 4 3) => | + #2A((ho ho ho) (ho ho ho) (ho ho ho) (ho ho ho)) | The rank may be elided, in which case it is read as one. '#A(a b c) == '#(a b c) -Unshared conventional (not uniform) 0-based arrays of rank 1 (dimension) -are equivalent to (and can't be distinguished from) vectors. - (make-array 'ho 3) => #(ho ho ho) - -When constructing an array, BOUND is either an inclusive range of -indices expressed as a two element list, or an upper bound expressed as -a single integer. So - (make-array 'foo 3 3) == (make-array 'foo '(0 2) '(0 2)) - - - Function: array? obj - Returns `#t' if the OBJ is an array, and `#f' if not. - - - Function: make-array initial-value bound1 bound2 ... - Creates and returns an array that has as many dimensions as there - are BOUNDs and fills it with INITIAL-VALUE. - - - Function: array-ref array index1 index2 ... - Returns the INDEX1, INDEX2, ...'th element of ARRAY. - - - Function: array-in-bounds? array index1 index2 ... - Returns `#t' if its arguments would be acceptable to ARRAY-REF. - - - Function: array-set! array new-value index1 index2 ... - Sets the INDEX1, INDEX2, ...'th element of ARRAY to NEW-VALUE. - The value returned by `array-set!' is unspecified. - - - Function: make-shared-array array mapper bound1 bound2 ... - `make-shared-array' can be used to create shared subarrays of other - arrays. The MAPPER is a function that translates coordinates in - the new array into coordinates in the old array. A MAPPER must be - linear, and its range must stay within the bounds of the old - array, but it can be otherwise arbitrary. A simple example: - (define fred (make-array #f 8 8)) - (define freds-diagonal - (make-shared-array fred (lambda (i) (list i i)) 8)) - (array-set! freds-diagonal 'foo 3) - (array-ref fred 3 3) => foo - (define freds-center - (make-shared-array fred (lambda (i j) (list (+ 3 i) (+ 3 j))) 2 2)) - (array-ref freds-center 0 0) => foo +Unshared, conventional (not uniform) 0-based arrays of rank 1 are +equivalent to (and can't be distinguished from) scheme vectors. + (create-array '#(ho) 3) => #(ho ho ho) - Function: transpose-array array dim0 dim1 ... Returns an array sharing contents with ARRAY, but with dimensions @@ -3638,110 +3786,24 @@ a single integer. So (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-shape array - Returns a list of inclusive bounds of integers. - (array-shape (make-array 'foo '(-1 3) 5)) => ((-1 3) (0 4)) - - - Function: array-dimensions array - `Array-dimensions' is similar to `array-shape' but replaces - elements with a `0' minimum with one greater than the maximum. So: - (array-dimensions (make-array 'foo '(-1 3) 5)) => ((-1 3) 5) - - - Function: array-rank obj - Returns the number of dimensions of OBJ. If OBJ is not an array, - `0' is returned. - - 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-copy! source destination - Copies every element from vector or array SOURCE to the - corresponding element of DESTINATION. DESTINATION must have the - same rank as SOURCE, and be at least as large in each dimension. - The order of copying is unspecified. - - - Function: serial-array-copy! source destination - Same as `array-copy!' but guaranteed to copy in row-major order. - - - Function: array-fill! array fill - Stores FILL in every element of ARRAY. The value returned is - unspecified. - - - 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-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 and CREATE-ARRAY may | - be unrolled, some arrays made by MAKE-SHARED-ARRAY may not be. | + returns `#f'. All arrays made by CREATE-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 in memory. -File: scm.info, Node: Array Mapping, Next: Uniform Array, Prev: Conventional Arrays, Up: Arrays - -Array Mapping -------------- - -`(require 'array-for-each)' - - - 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 - are scalars, that is, not arrays, vectors, or strings, then they - will be converted internally to arrays of the appropriate shape. - PROC is applied to each tuple of elements of ARRAY1 ... and the - result is stored as the corresponding element in ARRAY0. The - value returned is unspecified. The order of application is - unspecified. - - - - Function: serial-array-map! array0 proc array1 ... - Same as ARRAY-MAP!, but guaranteed to apply PROC in row-major - order. - - - Function: array-for-each proc array0 ... - PROC is applied to each tuple of elements of ARRAY0 ... in - row-major order. The value returned is unspecified. - - - Function: array-index-map! array proc - applies PROC to the indices of each element of ARRAY in turn, - storing the result in the corresponding element. The value - returned and the order of application are unspecified. - - One can implement ARRAY-INDEXES as - (define (array-indexes array) - (let ((ra (apply make-array #f (array-shape array)))) - (array-index-map! ra (lambda x x)) - ra)) - Another example: - (define (apl:index-generator n) - (let ((v (make-vector n 1))) | - (array-index-map! v (lambda (i) i)) - v)) - - - Function: scalar->array scalar array prototype - 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 - for the returned array. Otherwise the returned array will be of - the same type as `array' if that is possible, and a conventional - array if it is not. This function is used internally by - `array-map!' and friends to handle scalar arguments. - - -File: scm.info, Node: Uniform Array, Next: Bit Vectors, Prev: Array Mapping, Up: Arrays +File: scm.info, Node: Uniform Array, Next: Bit Vectors, Prev: Conventional Arrays, Up: Arrays Uniform Array ------------- @@ -3751,51 +3813,51 @@ same type. Uniform vectors occupy less storage than conventional 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 `create-array', detailed in *Note Arrays: (slib)Arrays. | +SLIB now supports uniform arrys. The primary array creation procedure +is `create-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. - (create-array "" 3) => "$q2" | + (create-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. - (create-array '#at() 3) => #*000 | + (create-array '#at() 3) => #*000 == #At(#f #f #f) => #*000 == #1At(#f #f #f) => #*000 -PROTOTYPE arguments in the following procedures are interpreted | -according to the table: | +PROTOTYPE arguments in the following procedures are interpreted +according to the table: - prototype type display prefix | + prototype type display prefix - () conventional vector #a | - +64i complex (double precision) #ac64 | - 64.0 double (double precision) #ar64 | - 32.0 float (single precision) #ar32 | - 32 unsigned integer (32-bit) #au32 | - -32 signed integer (32-bit) #as32 | - -16 signed integer (16-bit) #as16 | - #\a char (string) #a\ | - #t boolean (bit-vector) #at | - | -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, `'#As32(3 5 9)' | -returns a uniform vector of signed integers. | + () conventional vector #a + +64i complex (double precision) #ac64 + 64.0 double (double precision) #ar64 + 32.0 float (single precision) #ar32 + 32 unsigned integer (32-bit) #au32 + -32 signed integer (32-bit) #as32 + -16 signed integer (16-bit) #as16 + #\a char (string) #a\ + #t boolean (bit-vector) #at + +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, `'#As32(3 5 9)' +returns a uniform vector of signed integers. - 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 Returns an object that would produce an array of the same type as - ARRAY, if used as the PROTOTYPE for `list->uniform-array'. | + 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. @@ -3808,19 +3870,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-vector-fill! uve fill - Stores FILL in every element of UVE. The value returned is - unspecified. - | - - Function: dimensions->uniform-array dims prototype fill - - Function: dimensions->uniform-array dims prototype | - Creates and returns a uniform array or vector of type - corresponding to PROTOTYPE with dimensions DIMS or length LENGTH. - If the FILL argument is supplied, the returned array is filled with - this value. - - Function: uniform-array-read! ura - - Function: uniform-array-read! ura port | + - 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 @@ -3832,7 +3883,7 @@ returns a uniform vector of signed integers. | `(current-input-port)'. - Function: uniform-array-write ura - - Function: uniform-array-write ura port | + - 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 @@ -3860,7 +3911,7 @@ returns a uniform vector of signed integers. | integer or if VAL is not boolean. -File: scm.info, Node: Bit Vectors, Prev: Uniform Array, Up: Arrays +File: scm.info, Node: Bit Vectors, Next: Array Mapping, Prev: Uniform Array, Up: Arrays Bit Vectors ----------- @@ -3901,30 +3952,90 @@ uniform-arrays. BV is not modified. -File: scm.info, Node: Records, Next: I/O-Extensions, Prev: Arrays, Up: Packages - | -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 | - 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: | - the record to be printed, the port to print to, and a boolean | - which is true if the record is being written on behalf of `write' | - and false if for `display'. If PRINTER returns #f, the default | - record printer will be called. | - | - A PRINTER value of #f means use the default printer. | - | - Only the default printer will be used when printing error messages. | +File: scm.info, Node: Array Mapping, Prev: Bit Vectors, Up: Arrays + +Array Mapping +------------- + +`(require 'array-for-each)' + +SCM has some extra functions in feature `array-for-each': + + - Function: array-fill! array fill + Stores FILL in every element of ARRAY. The value returned is + unspecified. + + - Function: serial-array-copy! source destination + Same as `array-copy!' but guaranteed to copy in row-major order. + + - 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 ... + 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 + are scalars, that is, not arrays, vectors, or strings, then they + will be converted internally to arrays of the appropriate shape. + PROC is applied to each tuple of elements of ARRAY1 ... and the + result is stored as the corresponding element in ARRAY0. The + value returned is unspecified. The order of application is + unspecified. + + Handling non-array arguments is a SCM extension of *Note + array-map!: (slib)Array Mapping + + - 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 + 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 + for the returned array. Otherwise the returned array will be of + the same type as `array' if that is possible, and a conventional + array if it is not. This function is used internally by + `array-map!' and friends to handle scalar arguments. + + +File: scm.info, Node: Records, Next: I/O-Extensions, Prev: Arrays, Up: Packages + +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 + 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: + the record to be printed, the port to print to, and a boolean + which is true if the record is being written on behalf of `write' + and false if for `display'. If PRINTER returns #f, the default + record printer will be called. + + A PRINTER value of #f means use the default printer. + + Only the default printer will be used when printing error messages. + File: scm.info, Node: I/O-Extensions, Next: Posix Extensions, Prev: Records, Up: Packages - | + I/O-Extensions ============== @@ -3988,13 +4099,13 @@ I/O: (slib)Line I/O, and the following functions are defined: `file-set-position' is unspecified. The result of `file-set-position' is unspecified. - - Function: try-create-file name modes perms | - If the file with name NAME already exists, return `#f', otherwise | + - 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). | - | + 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 Closes port PORT and reopens it with FILENAME and MODES. `reopen-file' returns `#t' if successful, `#f' if not. @@ -4027,11 +4138,11 @@ I/O: (slib)Line I/O, and the following functions are defined: `closedir' returns a `#f'. - Function: directory-for-each proc directory - The LISTs must be lists, and 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 elements of the LISTs is unspecified. The value - returned by `directory-for-each' is unspecified. + 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 Applies PROC only to those filenames for which the procedure PRED @@ -4042,7 +4153,7 @@ I/O: (slib)Line I/O, and the following functions are defined: MATCH)' would return a non-false value (*note Filenames: (slib)Filenames.). - (require 'directory-for-each) + (require 'directory) (directory-for-each print "." "[A-Z]*.scm") -| "Init.scm" @@ -4050,7 +4161,7 @@ I/O: (slib)Line I/O, and the following functions are defined: "Link.scm" "Macro.scm" "Transcen.scm" - "Init5d6.scm" | + "Init5d9.scm" | - Function: mkdir path mode The `mkdir' function creates a new, empty directory whose name is @@ -4164,7 +4275,7 @@ 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 - | + Posix Extensions ================ @@ -4188,14 +4299,14 @@ functions are defined: the standard input of the system command STRING. If a pipe cannot be created `#f' is returned. - - 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 | - passed so that any necessary cleanup may be done. An error is not | - 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: 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 + passed so that any necessary cleanup may be done. An error is not + 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 Closes the PIPE, rendering it incapable of delivering or accepting characters. This routine has no effect if the pipe has already @@ -4218,11 +4329,6 @@ Persona. Returns the process ID of the parent of the current process. For a process's own ID *Note getpid: I/O-Extensions. - - 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. | - | - Function: getuid Returns the real user ID of this process. @@ -4435,14 +4541,14 @@ Persona. File: scm.info, Node: Unix Extensions, Next: Regular Expression Pattern Matching, Prev: Posix Extensions, Up: Packages - | + 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: | +These "privileged" and symbolic link functions are not in Posix: - Function: symlink oldname newname The `symlink' function makes a symbolic link to OLDNAME named @@ -4468,7 +4574,7 @@ These "privileged" and symbolic link functions are not in Posix: | - Function: acct filename When called with the name of an exisitng file as argument, - accounting is turned on, records for each terminating process are | + accounting is turned on, records for each terminating process are appended to FILENAME as it terminates. An argument of `#f' causes accounting to be turned off. @@ -4489,7 +4595,7 @@ These "privileged" and symbolic link functions are not in Posix: | File: scm.info, Node: Regular Expression Pattern Matching, Next: Line Editing, Prev: Unix Extensions, Up: Packages - | + Regular Expression Pattern Matching =================================== @@ -5021,15 +5127,15 @@ Sockets: (libc)Sockets. * Menu: -* Host Data:: +* Host and Other Inquiries:: * Internet Addresses and Socket Names:: * Socket:: -File: scm.info, Node: Host Data, Next: Internet Addresses and Socket Names, Prev: Sockets, Up: Sockets +File: scm.info, Node: Host and Other Inquiries, Next: Internet Addresses and Socket Names, Prev: Sockets, Up: Sockets -Host Data, Network, Protocol, and Service Inquiries ---------------------------------------------------- +Host and Other Inquiries +------------------------ - Constant: af_inet - Constant: af_unix @@ -5119,7 +5225,7 @@ Host Data, Network, Protocol, and Service Inquiries When called without an argument, the service table is closed. -File: scm.info, Node: Internet Addresses and Socket Names, Next: Socket, Prev: Host Data, Up: Sockets +File: scm.info, Node: Internet Addresses and Socket Names, Next: Socket, Prev: Host and Other Inquiries, Up: Sockets Internet Addresses and Socket Names ----------------------------------- @@ -5622,9 +5728,9 @@ memory allocated by `malloc'. - Header: tc7_uvect uniform vector of non-negative integers - - Header: tc7_svect | - uniform vector of short integers | - | + - Header: tc7_svect + uniform vector of short integers + - Header: tc7_fvect uniform vector of short inexact real numbers @@ -5861,7 +5967,7 @@ Defining Smobs::). These are the initial smobs: synchronization object. *Note Process Synchronization::. - smob: tc16_macro - macro expanding function. *Note Low Level Syntactic Hooks::. + macro expanding function. *Note Macro Primitives::. - smob: tc16_array multi-dimensional array. *Note Arrays::. @@ -5908,7 +6014,7 @@ bvect .........long length....G0010101 ..........long *words........... ivect .........long length....G0011101 ..........long *words........... uvect .........long length....G0011111 ......unsigned long *words...... spare G0100101 -svect .........long length....G0100111 ........ short *words........... | +svect .........long length....G0100111 ........ short *words........... fvect .........long length....G0101101 .........float *words........... dvect .........long length....G0101111 ........double *words........... cvect .........long length....G0110101 ........double *words........... @@ -5917,15 +6023,15 @@ contin .........long length....G0111101 .............*regs.............. specfun ................xxxxxxxxG1111111 ...........SCM name............. cclo ..short length..xxxxxx10G1111111 ...........SCM **elts........... PTOBs: - port 0bwroxxxxxxxxG0110111 ..........FILE *stream.......... - socket ttttttt 00001xxxxxxxxG0110111 ..........FILE *stream.......... - inport uuuuuuuuuuU00011xxxxxxxxG0110111 ..........FILE *stream.......... -outport 0000000000000101xxxxxxxxG0110111 ..........FILE *stream.......... - ioport uuuuuuuuuuU00111xxxxxxxxG0110111 ..........FILE *stream.......... -fport 00 00000000G0110111 ..........FILE *stream.......... -pipe 00 00000001G0110111 ..........FILE *stream.......... -strport 00 00000010G0110111 ..........FILE *stream.......... -sfport 00 00000011G0110111 ..........FILE *stream.......... + 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 @@ -6215,7 +6321,7 @@ File: scm.info, Node: C Macros, Next: Changing Scm, Prev: Signals, Up: Opera C Macros -------- - - Macro: ASSERT 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 @@ -6256,12 +6362,12 @@ C Macros * a C string `(char *)' - Error checking is not done by `ASSERT' if the flag `RECKLESS' is + Error checking is not done by `ASRTER' if the flag `RECKLESS' is defined. An error condition can still be signaled in this case with a call to `wta(arg, pos, subr)'. - Macro: ASRTGO cond label - `goto' LABEL if the expression (COND) is 0. Like `ASSERT', + `goto' LABEL if the expression (COND) is 0. Like `ASRTER', `ASRTGO' does is not active if the flag `RECKLESS' is defined. @@ -6289,11 +6395,18 @@ 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) + Forces the SCM object PTR to be saved on the C-stack, where it + will be traced for GC. + Also, if you maintain a static pointer to some (non-immediate) `SCM' object, you must either make your pointer be the value cell of a symbol -(see `errobj' for an example) or make your pointer be one of the -`sys_protects' (see `dynwinds' for an example). The former method is -prefered since it does not require any changes to the SCM distribution. +(see `errobj' for an example) or (permanently) add your pointer to +`sys_protects' using: + + - Function: SCM scm_gc_protect (SCM OBJ) + Permanently adds OBJ to a table of objects protected from garbage + collection. `scm_gc_protect' returns OBJ. To add a C routine to scm: @@ -6353,7 +6466,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 `Init5d6.scm' which loads `Ifoo.scm' if your | + 8. put an `if' into `Init5d9.scm' which loads `Ifoo.scm' if your | package is included: (if (defined? twiddle-bits!) @@ -6385,7 +6498,7 @@ Special forms (new syntax) can be added to scm. New syntax can now be added without recompiling SCM by the use of the `procedure->syntax', `procedure->macro', `procedure->memoizing-macro', -and `defmacro'. For details, *Note Syntax Extensions::. +and `defmacro'. For details, *Note Syntax::. File: scm.info, Node: Defining Subrs, Next: Defining Smobs, Prev: Changing Scm, Up: Operations @@ -6494,10 +6607,10 @@ following lines need to be added to your code: is the smob object. The second, of type `SCM', is the stream on which to write the result. The third, of type int, is 1 if the object should be `write'n, 0 if it should be - `display'ed, and 2 if it should be `write'n for an error | - report. This function should return non-zero if it printed, | - and zero otherwise (in which case a hexadecimal number will | - be printed). | + `display'ed, and 2 if it should be `write'n for an error + report. This function should return non-zero if it printed, + and zero otherwise (in which case a hexadecimal number will + be printed). `smob.equalp' is 0 or a function of 2 `SCM' arguments. Both of these @@ -6584,9 +6697,9 @@ following functions are provided for that purpose: `must_malloc', `must_malloc_cell', `must_realloc', and `must_realloc_cell' must be called with interrupts deferred *Note -Signals::. `must_realloc' and `must_realloc_cell' must not be called | -during initialization (non-zero errjmp_bad) - the initial allocations | -must be large enough. | +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) `must_free' is used to free a block of memory allocated by the @@ -6653,7 +6766,7 @@ SCM, then you can replace `scm_find_implpath'. environment variable is defined, its value will be returned from `scm_find_implpath'. Otherwise find_impl_file() is called with the arguments EXECPATH, GENERIC_NAME (default "scm"), INIT_FILE_NAME - (default "Init5d6_scm"), and the directory separator string | + (default "Init5d9_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. @@ -6740,9 +6853,9 @@ Here is a minimal embedding program `libtest.c': /* include patchlvl.h for SCM's INIT_FILE_NAME. */ #include "patchlvl.h" - void init_user_scm() + void libtest_init_user_scm() | { - fputs("This is 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")); } @@ -6761,6 +6874,7 @@ Here is a minimal embedding program `libtest.c': SCM retval; char *implpath, *execpath; + 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); @@ -6775,8 +6889,8 @@ Here is a minimal embedding program `libtest.c': -| dld_find_executable(./libtest): /home/jaffer/scm/libtest - implpath: /home/jaffer/scm/Init5d6.scm | - This is init_user_scm + implpath: /home/jaffer/scm/Init5d9.scm | + This is libtest_init_user_scm | hello world @@ -6791,7 +6905,7 @@ The source code for these routines are found in `rope.c'. - Function: int scm_ldfile (char *FILE) Loads the Scheme source file FILE. Returns 0 if successful, non-0 if not. This function is used to load SCM's initialization file - `Init5d6.scm'. | + `Init5d9.scm'. | - Function: int scm_ldprog (char *FILE) Loads the Scheme source file `(in-vicinity (program-vicinity) @@ -6849,21 +6963,23 @@ code. Most are defined in `rope.c'. - 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 *S_CALLER) - Function: unsigned char num2uchar (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 - number is returned. If not, the `ASSERT' macro calls `wta' with + number is returned. If not, the `ASRTER' macro calls `wta' with 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 `num2long' and - `num2ulong' (for when `SCM' is compiled without bignums). To - convert inexact numbers to exact numbers, *Note inexact->exact: - (r5rs)Numerical operations. + _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. - Function: unsigned long scm_addr (SCM ARGS, char *S_NAME) Returns a pointer (cast to an `unsigned long') to the storage @@ -6874,10 +6990,16 @@ code. Most are defined in `rope.c'. `scm_addr' is useful for performing C operations on strings or other uniform arrays (*note Uniform Array::). - _Note:_ While you use a pointer returned from `scm_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. + - 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 + `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) @@ -7203,7 +7325,7 @@ File: scm.info, Node: Executable Pathname, Next: Script Support, Prev: File-S Executable Pathname ------------------- -For purposes of finding `Init5d6.scm', dumping an executable, and | +For purposes of finding `Init5d9.scm', dumping an executable, and | dynamic linking, a SCM session needs the pathname of its executable image. @@ -7316,22 +7438,20 @@ Improvements To Make gets set which tells the interpreter to instead always look up the values of the associated symbols. + * Scott Schwartz <schwartz@galapagos.cse.psu.edu> suggests: One way + to tidy up the dynamic loading stuff would be to grab the code + from perl5. + * Menu: -* Finishing Dynamic Linking:: +* VMS Dynamic Linking:: Finishing the job. | -File: scm.info, Node: Finishing Dynamic Linking, Prev: Improvements To Make, Up: Improvements To Make - -Finishing Dynamic Linking -------------------------- - -Scott Schwartz <schwartz@galapagos.cse.psu.edu> suggests: One way to -tidy up the dynamic loading stuff would be to grab the code from perl5. - -VMS -... +File: scm.info, Node: VMS Dynamic Linking, Prev: Improvements To Make, Up: Improvements To Make + | +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 @@ -7447,97 +7567,9 @@ with a VMS system needs to finish and debug it. modify and relink `LISPLIB.EXE' without having to relink programs that have been linked against it. -Windows NT -.......... - -George Carrette (gjc@mitech.com) outlines how to dynamically link on -Windows NT: - - * The Software Developers Kit has a sample called SIMPLDLL. Here is - the gist of it, following along the lines of the VMS description - above (contents of a makefile for the SDK NMAKE) - - LISPLIB.exp: - LISPLIB.lib: LISPLIB.def - $(implib) -machine:$(CPU) -def:LISPLIB.def -out:LISPLIB.lib - - LISPLIB.DLL : $(LISPLIB_OBJS) LISPLIB.EXP - $(link) $(linkdebug) \ - -dll \ - -out:LISPLIB.DLL \ - LISPLIB.EXP $(LISPLIB_OBJS) $(conlibsdll) - - * The `LISPDEF.DEF' file has this: - - LIBRARY lisplib - EXPORT - init_lisp - init_repl - - * And `MAIN.EXE' using: - - CLINK = $(link) $(ldebug) $(conflags) -out:$*.exe $** $(conlibsdll) - - MAIN.EXE : MAIN.OBJ LISPLIB.LIB - $(CLINK) - - * And `MYSUBRS.DLL' is produced using: - - mysubrs.exp: - mysubrs.lib: mysubrs.def - $(implib) -machine:$(CPU) -def:MYSUBRS.def -out:MYSUBRS.lib - - mysubrs.dll : mysubrs.obj mysubrs.exp mysubrs.lib - $(link) $(linkdebug) \ - -dll \ - -out:mysubrs.dll \ - MYSUBRS.OBJ MYSUBRS.EXP LISPLIB.LIB $(conlibsdll) - - * Where `MYSUBRS.DEF' has - - LIBRARY mysubrs - EXPORT - INIT_MYSUBRS - - * And the dynamic loader looks something like this, calling the two - procedures `LoadLibrary' and `GetProcAddress'. - - LISP share_image_load(LISP fname) - {long iflag; - LISP retval,(*fcn)(void); - HANDLE hLib; - DWORD err; - char *libname,fcnname[64]; - iflag = nointerrupt(1); - libname = c_string(fname); - _snprintf(fcnname,sizeof(fcnname),"INIT_%s",libname); - if (!(hLib = LoadLibrary(libname))) - {err = GetLastError(); - retval = list2(fname,LSPNUM(err)); - serror1("library failed to load",retval);} - if (!(fcn = (LISP (*)(void)) GetProcAddress(hLib,fcnname))) - {err = GetLastError(); - retval = list2(fname,LSPNUM(err)); - serror1("could not find library init procedure",retval);} - retval = (*fcn)(); - nointerrupt(iflag); - return(retval);} - - * _Note:_ in VMS the linker and dynamic loader is case sensitive, but - all the language compilers, including C, will by default upper-case - external symbols for use by the linker, although the debugger gets - its own symbols and case sensitivity is language mode dependant. - In Windows NT things are case sensitive generally except for file - and device names, which are case canonicalizing like in the - Symbolics filesystem. - - * _Also:_ All this WINDOWS NT stuff will work in MS-DOS MS-Windows - 3.1 too, by a method of compiling and linking under Windows NT, - and then copying various files over to MS-DOS/WINDOWS. - File: scm.info, Node: Index, Prev: The Implementation, Up: Top - + | Procedure and Macro Index ************************* @@ -7546,13 +7578,16 @@ This is an alphabetical list of all the procedures and macros in SCM. * Menu: * #!: Unix Scheme Scripts. -* #': Syntax Extensions. -* #+: Syntax Extensions. -* #-: Syntax Extensions. -* #.: Syntax Extensions. -* #;text-till-end-of-line: Syntax Extensions. -* #\token: Syntax Extensions. -* #|: Syntax Extensions. +* #': Common-Lisp Read Syntax. +* #+: Common-Lisp Read Syntax. +* #-: Common-Lisp Read Syntax. +* #.: Common-Lisp Read Syntax. +* #;text-till-end-of-line: Documentation and Comments. +* #?column: Load Syntax. | +* #?file: Load Syntax. | +* #?line: Load Syntax. | +* #\token: Common-Lisp Read Syntax. +* #|: Common-Lisp Read Syntax. * $abs: Numeric. * $acos: Numeric. * $acosh: Numeric. @@ -7600,6 +7635,7 @@ This is an alphabetical list of all the procedures and macros in SCM. * -e: SCM Options. * -f: SCM Options. * -F: Build Options. +* -f: Build Options. * -h <1>: SCM Options. * -h: Build Options. * -i <1>: SCM Options. @@ -7621,19 +7657,19 @@ This is an alphabetical list of all the procedures and macros in SCM. * -u: SCM Options. * -v: SCM Options. * -w: Build Options. -* @apply: Low Level Syntactic Hooks. -* @copy-tree: Miscellaneous Procedures. | +* @apply: Environment Frames. +* @copy-tree: Storage. * @macroexpand1: Syntactic Hooks for Hygienic Macros. -* _exclusive: Files and Ports. | -* _ionbf: Files and Ports. -* _tracked: Files and Ports. +* _exclusive: Opening and Closing. +* _ionbf: Opening and Closing. +* _tracked: Opening and Closing. * abort: Internal State. * access: I/O-Extensions. -* acct: Unix Extensions. | -* acons: Miscellaneous Procedures. +* acct: Unix Extensions. +* acons: Storage. * acosh: Numeric. * add-alias: Configure Module Catalog. -* add-finalizer: Interrupts. | +* add-finalizer: Storage. * add-link: Configure Module Catalog. * add-source: Configure Module Catalog. * alarm: Interrupts. @@ -7644,73 +7680,64 @@ This is an alphabetical list of all the procedures and macros in SCM. * arithmetic-error: Interrupts. * array->list: Conventional Arrays. * array-contents: Conventional Arrays. -* array-copy!: Conventional Arrays. -* array-dimensions: Conventional Arrays. -* array-equal?: Conventional Arrays. -* array-fill!: Conventional Arrays. -* array-for-each: Array Mapping. -* array-in-bounds?: Conventional Arrays. -* array-index-map!: Array Mapping. +* array-equal?: Array Mapping. +* array-fill!: Array Mapping. +* array-map: Array Mapping. | * array-map!: Array Mapping. * array-prototype: Uniform Array. -* array-rank: Conventional Arrays. -* array-ref: Conventional Arrays. -* array-set!: Conventional Arrays. -* array-shape: Conventional Arrays. -* array? <1>: Uniform Array. -* array?: Conventional Arrays. +* array?: Uniform Array. * asinh: Numeric. +* ASRTER: C Macros. * ASRTGO: C Macros. -* ASSERT: C Macros. * atanh: Numeric. * bit-count: Bit Vectors. * bit-count*: Bit Vectors. * bit-invert!: Bit Vectors. * bit-position: Bit Vectors. * bit-set*!: Bit Vectors. -* boot-tail <1>: Dump. | -* boot-tail: SCM Session. | +* boot-tail <1>: Dump. +* boot-tail: SCM Session. * box: Curses Miscellany. -* broken-pipe: Posix Extensions. | -* call-with-outputs: Files and Ports. -* CAR: Cells. | +* broken-pipe: Posix Extensions. +* call-with-outputs: Port Redirection. +* CAR: Cells. * cbreak: Terminal Mode Setting. * CCLO_LENGTH: Header Cells. * CDR: Cells. * char: Type Conversions. -* char-ready: Files and Ports. +* char-ready: Port Properties. * char-ready? <1>: Socket. -* char-ready?: Files and Ports. +* char-ready?: Port Properties. +* char:sharp: Modifying Read Syntax. | * CHARS: Header Cells. * chdir: I/O-Extensions. * CHEAP_CONTINUATIONS: Continuations. * chmod: I/O-Extensions. * chown: Posix Extensions. -* clearok: Output Options Setting. | +* clearok: Output Options Setting. * close-port <1>: Window Manipulation. * close-port <2>: Posix Extensions. -* close-port: Files and Ports. +* close-port: Opening and Closing. * closedir: I/O-Extensions. * CLOSEDP: Ptob Cells. * CLOSUREP: Cells. * CODE: Cells. -* comment: Syntax Extensions. | +* comment: Documentation and Comments. * CONSP: Cells. -* copy-tree: Miscellaneous Procedures. +* copy-tree: Storage. * cosh: Numeric. * could-not-open: Interrupts. -* current-error-port: Files and Ports. -* current-input-port: Files and Ports. +* current-error-port: Port Redirection. +* current-input-port: Port Properties. * current-time: Time. * default-input-port: Line Editing. * default-output-port: Line Editing. -* defconst: Syntax Extensions. +* defconst: Define and Set. * DEFER_INTS: Signals. -* defined?: Syntax Extensions. -* defmacro: Syntax Extensions. -* defsyntax: Low Level Syntactic Hooks. | -* defvar: Syntax Extensions. -* dimensions->uniform-array: Uniform Array. +* defined?: Define and Set. +* defmacro: Defmacro. +* defsyntax: Macro Primitives. +* defvar: Define and Set. * directory-for-each: I/O-Extensions. * display: Output. * dld_find_executable: Executable Pathname. @@ -7725,13 +7752,13 @@ This is an alphabetical list of all the procedures and macros in SCM. * enclose-array: Conventional Arrays. * end-of-program: Interrupts. * endwin: Curses. -* ENV: Cells. | +* ENV: Cells. * errno: Errors. * error: Errors. * eval: Evaluation. * EVAL: Evaluation. -* eval: Miscellaneous Procedures. -* eval-string: Miscellaneous Procedures. +* eval: Eval and Load. +* eval-string: Eval and Load. * exec-self: Internal State. * execl: I/O-Extensions. * execlp: I/O-Extensions. @@ -7749,13 +7776,13 @@ This is an alphabetical list of all the procedures and macros in SCM. * fork: Posix Extensions. * FPORTP: Ptob Cells. * free_continuation: Continuations. -* freshline: Files and Ports. +* freshline: Port Properties. * gc: Internal State. -* gc-hook: Interrupts. | +* gc-hook: Storage. * gc_mark: Marking Cells. * GCCDR: Marking Cells. * GCTYP16: Marking Cells. -* gentemp: Syntax Extensions. +* gentemp: Defmacro. * get-internal-real-time: Time. * get-internal-run-time: Time. * getcwd: I/O-Extensions. @@ -7764,15 +7791,15 @@ This is an alphabetical list of all the procedures and macros in SCM. * getgid: Posix Extensions. * getgr: Posix Extensions. * getgroups: Posix Extensions. -* gethost: Host Data. -* getlogin: Posix Extensions. | -* getnet: Host Data. +* gethost: Host and Other Inquiries. +* getlogin: SCM Session. +* getnet: Host and Other Inquiries. * getpeername: Internet Addresses and Socket Names. * getpid: I/O-Extensions. * getppid: Posix Extensions. -* getproto: Host Data. +* getproto: Host and Other Inquiries. * getpw: Posix Extensions. -* getserv: Host Data. +* getserv: Host and Other Inquiries. * getsockname: Internet Addresses and Socket Names. * getuid: Posix Extensions. * getyx: Input. @@ -7797,10 +7824,10 @@ This is an alphabetical list of all the procedures and macros in SCM. * initscr: Curses. * INPORTP: Ptob Cells. * int_signal: Signals. -* integer->line-number: Line Numbers. | +* integer->line-number: Line Numbers. * INUM: Immediates. * INUMP: Immediates. -* isatty?: Files and Ports. +* isatty?: Port Properties. * ISYMCHARS: Immediates. * ISYMNUM: Immediates. * ISYMP: Immediates. @@ -7808,32 +7835,30 @@ This is an alphabetical list of all the procedures and macros in SCM. * leaveok: Output Options Setting. * LENGTH: Header Cells. * line-editing: Line Editing. -* line-number: Miscellaneous Procedures. -* line-number->integer: Line Numbers. | -* line-number?: Line Numbers. | -* link: Posix Extensions. | -* list->uniform-array: Uniform Array. | -* list-file: Miscellaneous Procedures. +* line-number: Eval and Load. +* line-number->integer: Line Numbers. +* line-number?: Line Numbers. +* link: Posix Extensions. +* list->uniform-array: Uniform Array. * load: Dynamic Linking. -* load-string: Miscellaneous Procedures. +* load-string: Eval and Load. +* load:sharp: Modifying Read Syntax. | * logaref: Uniform Array. * logaset!: Uniform Array. * long: Type Conversions. * long2num: Type Conversions. -* lstat: Unix Extensions. | -* macroexpand: Syntax Extensions. -* macroexpand-1: Syntax Extensions. +* lstat: Unix Extensions. +* macroexpand: Defmacro. +* macroexpand-1: Defmacro. * main: Embedding SCM. * makargvfrmstrs: Type Conversions. * makcclo: Header Cells. * make-arbiter: Process Synchronization. -* make-array: Conventional Arrays. * make-edited-line-port: Line Editing. -* make-exchanger: Process Synchronization. | -* make-shared-array: Conventional Arrays. +* make-exchanger: Process Synchronization. * make-soft-port: Soft Ports. * make-stream-socket: Socket. -* make-stream-socketpair: Socket. | +* make-stream-socketpair: Socket. * make_continuation: Continuations. * make_gsubr: Defining Subrs. * make_root_continuation: Continuations. @@ -7848,7 +7873,7 @@ This is an alphabetical list of all the procedures and macros in SCM. * mark_locations: Marking Cells. * milli-alarm: Interrupts. * mkdir: I/O-Extensions. -* mknod: Unix Extensions. | +* mknod: Unix Extensions. * must_free: Allocating memory. * must_free_argv: Type Conversions. * must_malloc: Allocating memory. @@ -7859,7 +7884,7 @@ This is an alphabetical list of all the procedures and macros in SCM. * NCONSP: Cells. * NEWCELL: Cells. * newwin: Window Manipulation. -* nice: Unix Extensions. | +* nice: Unix Extensions. * NIMP: Immediates. * NINUMP: Immediates. * nl: Terminal Mode Setting. @@ -7869,13 +7894,15 @@ This is an alphabetical list of all the procedures and macros in SCM. * nonl: Terminal Mode Setting. * noraw: Terminal Mode Setting. * NSTRINGP: Header Cells. +* num2dbl: Type Conversions. * num2long: Type Conversions. +* num2short: Type Conversions. * NVECTORP: Header Cells. -* open-file: Files and Ports. -* open-input-pipe: Posix Extensions. | +* open-file: Opening and Closing. +* open-input-pipe: Posix Extensions. * open-output-pipe: Posix Extensions. * open-pipe: Posix Extensions. -* open-ports: Files and Ports. | +* open-ports: Opening and Closing. * opendir: I/O-Extensions. * OPENP: Ptob Cells. * OPFPORTP: Ptob Cells. @@ -7892,35 +7919,34 @@ This is an alphabetical list of all the procedures and macros in SCM. * pi*: Numeric. * pi/: Numeric. * pipe: Posix Extensions. -* port-closed?: Files and Ports. | -* port-column: Miscellaneous Procedures. -* port-filename: Miscellaneous Procedures. -* port-line: Miscellaneous Procedures. -* port-type: Files and Ports. | +* port-closed?: Port Properties. +* port-column: Port Properties. +* port-filename: Port Properties. +* port-line: Port Properties. +* port-type: Port Properties. * PORTP: Ptob Cells. -* print <1>: Miscellaneous Procedures. * print: Debugging Scheme Code. * print-args: Debugging Scheme Code. -* procedure->identifier-macro: Low Level Syntactic Hooks. -* procedure->macro: Low Level Syntactic Hooks. -* procedure->memoizing-macro: Low Level Syntactic Hooks. -* procedure->syntax: Low Level Syntactic Hooks. -* procedure-documentation: Syntax Extensions. +* procedure->identifier-macro: Macro Primitives. +* procedure->macro: Macro Primitives. +* procedure->memoizing-macro: Macro Primitives. +* procedure->syntax: Macro Primitives. +* procedure-documentation: Documentation and Comments. * profile-alarm: Interrupts. * profile-alarm-interrupt: Interrupts. * program-arguments: SCM Session. * putenv: I/O-Extensions. -* qase: Syntax Extensions. | +* qase: Define and Set. * quit: SCM Session. * raw: Terminal Mode Setting. * read-char <1>: Input. -* read-char: Files and Ports. -* read-numbered: Line Numbers. | -* read:sharp: Low Level Syntactic Hooks. -* read:sharp-char: Low Level Syntactic Hooks. +* read-char: Port Properties. +* read-for-load: Line Numbers. | +* read-numbered: Line Numbers. +* read:sharp: Modifying Read Syntax. | * readdir: I/O-Extensions. -* readlink: Unix Extensions. | -* record-printer-set!: Records. | +* readlink: Unix Extensions. +* record-printer-set!: Records. * redirect-port!: I/O-Extensions. * refresh: Window Manipulation. * regcomp: Regular Expression Pattern Matching. @@ -7948,28 +7974,30 @@ This is an alphabetical list of all the procedures and macros in SCM. * scm_evstr: Callbacks. * scm_find_execpath: Embedding SCM. * scm_find_implpath: Embedding SCM. +* scm_gc_protect: Changing Scm. * scm_init_from_argv: Embedding SCM. * scm_ldfile: Callbacks. * scm_ldprog: Callbacks. * scm_ldstr: Callbacks. +* scm_protect_temp: Changing Scm. * scm_top_level: Embedding SCM. * script_count_argv: Script Support. * script_find_executable: Script Support. * script_process_argv: Script Support. * scroll: Output. * scrollok: Output Options Setting. -* serial-array-copy!: Conventional Arrays. +* serial-array-copy!: Array Mapping. * serial-array-map!: Array Mapping. -* set!: Syntax Extensions. +* set!: Define and Set. * setegid: Posix Extensions. * seteuid: Posix Extensions. * setgid: Posix Extensions. * setgrent: Posix Extensions. -* sethostent: Host Data. -* setnetent: Host Data. -* setprotoent: Host Data. +* sethostent: Host and Other Inquiries. +* setnetent: Host and Other Inquiries. +* setprotoent: Host and Other Inquiries. * setpwent: Posix Extensions. -* setservent: Host Data. +* setservent: Host and Other Inquiries. * setuid: Posix Extensions. * short: Type Conversions. * SHORT_ALIGN: Continuations. @@ -7994,12 +8022,11 @@ This is an alphabetical list of all the procedures and macros in SCM. * STRINGP: Header Cells. * subwin: Window Manipulation. * SYMBOLP: Header Cells. -* symlink: Unix Extensions. | -* sync: Unix Extensions. | +* symlink: Unix Extensions. +* sync: Unix Extensions. * syntax-quote: Syntactic Hooks for Hygienic Macros. -* syntax-rules: Syntax Extensions. +* syntax-rules: Syntax-Rules. * tanh: Numeric. -* terms: Miscellaneous Procedures. * the-macro: Syntactic Hooks for Hygienic Macros. * throw_to_continuation: Continuations. * ticks: Interrupts. @@ -8009,10 +8036,10 @@ This is an alphabetical list of all the procedures and macros in SCM. * trace: Debugging Scheme Code. * transpose-array: Conventional Arrays. * try-arbiter: Process Synchronization. -* try-create-file: I/O-Extensions. | -* try-load <1>: Line Numbers. | -* try-load: Miscellaneous Procedures. -* try-open-file: Files and Ports. +* try-create-file: I/O-Extensions. +* try-load <1>: Line Numbers. +* try-load: Eval and Load. +* try-open-file: Opening and Closing. * ttyname: Posix Extensions. * TYP16: Cells. * TYP3: Cells. @@ -8024,12 +8051,11 @@ This is an alphabetical list of all the procedures and macros in SCM. * unctrl: Curses Miscellany. * uniform-array-read!: Uniform Array. * uniform-array-write: Uniform Array. -* uniform-vector-fill!: Uniform Array. | * untrace: Debugging Scheme Code. * user-interrupt: Interrupts. * usr:lib: Dynamic Linking. * utime: I/O-Extensions. -* vector-set-length!: Miscellaneous Procedures. +* vector-set-length!: Storage. * VECTORP: Header Cells. * VELTS: Header Cells. * verbose: Internal State. @@ -8038,7 +8064,7 @@ This is an alphabetical list of all the procedures and macros in SCM. * vms-debug: SCM Session. * void: Sweeping the Heap. * wadd: Output. -* wait-for-input: Files and Ports. +* wait-for-input: Port Properties. * waitpid: Posix Extensions. * warn: Errors. * wclear: Output. @@ -8050,10 +8076,10 @@ This is an alphabetical list of all the procedures and macros in SCM. * winch: Input. * winsch: Output. * winsertln: Output. -* with-error-to-file: Files and Ports. -* with-error-to-port: Files and Ports. -* with-input-from-port: Files and Ports. -* with-output-to-port: Files and Ports. +* with-error-to-file: Port Redirection. +* with-error-to-port: Port Redirection. +* with-input-from-port: Port Redirection. +* with-output-to-port: Port Redirection. * wmove: Window Manipulation. * wstandend: Curses Miscellany. * wstandout: Curses Miscellany. @@ -8071,13 +8097,13 @@ This is an alphabetical list of all the global variables in SCM. * *execpath: Embedding SCM. * *interactive* <1>: Internal State. * *interactive*: SCM Variables. -* *load-pathname*: Miscellaneous Procedures. -* *load-reader*: Line Numbers. | +* *load-pathname*: Eval and Load. +* *load-reader*: Line Numbers. * *scm-version*: Internal State. -* *slib-load-reader*: Line Numbers. | -* *syntax-rules*: SCM Variables. | -* af_inet: Host Data. -* af_unix: Host Data. +* *slib-load-reader*: Line Numbers. +* *syntax-rules*: SCM Variables. +* af_inet: Host and Other Inquiries. +* af_unix: Host and Other Inquiries. * BOOL_F: Immediates. * BOOL_T: Immediates. * EDITOR: SCM Variables. @@ -8092,9 +8118,9 @@ This is an alphabetical list of all the global variables in SCM. * most-positive-fixnum: Numeric. * NUM_ISPCSYM: Immediates. * NUM_ISYMS: Immediates. -* open_both: Files and Ports. -* open_read: Files and Ports. -* open_write: Files and Ports. +* open_both: Opening and Closing. +* open_read: Opening and Closing. +* open_write: Opening and Closing. * pi: Numeric. * SCHEME_LIBRARY_PATH: SCM Variables. * SCM_INIT_PATH: SCM Variables. @@ -8179,7 +8205,7 @@ This is an alphabetical list of data types and feature names in SCM. * tc7_subr_2: Subr Cells. * tc7_subr_2o: Subr Cells. * tc7_subr_3: Subr Cells. -* tc7_svect: Header Cells. | +* tc7_svect: Header Cells. * tc7_uvect: Header Cells. * tc7_vector: Header Cells. * tc_dblc: Smob Cells. @@ -8204,6 +8230,7 @@ Concept Index * array-for-each: Build Options. * arrays: Build Options. * bignums: Build Options. +* byte: Build Options. | * callbacks: Callbacks. * careful-interrupt-masking: Build Options. * cautious: Build Options. @@ -8212,32 +8239,34 @@ Concept Index * continuations: Continuations. * curses: Build Options. * debug: Build Options. -* documentation string: Syntax Extensions. +* documentation string: Documentation and Comments. * dump: Build Options. * dynamic-linking: Build Options. -* ecache: Memory Management for Environments. | +* ecache: Memory Management for Environments. * edit-line: Build Options. * Embedding SCM: Embedding SCM. * engineering-notation: Build Options. -* environments: Memory Management for Environments. | -* exchanger: Process Synchronization. | +* environments: Memory Management for Environments. +* exchanger: Process Synchronization. * Exrename: Bibliography. * Extending Scm: Compiling and Linking Custom Files. * foo.c: Compiling and Linking Custom Files. * generalized-c-arguments: Build Options. * graphics: Packages. -* hobbit: Packages. | +* hobbit: Packages. * i/o-extensions: Build Options. * IEEE: Bibliography. * inexact: Build Options. * JACAL: Bibliography. * lit: Build Options. * macro: Build Options. -* memory management: Memory Management for Environments. | +* memory management: Memory Management for Environments. * mysql: Build Options. * no-heap-shrink: Build Options. -* NO_ENV_CACHE: Memory Management for Environments. | +* NO_ENV_CACHE: Memory Management for Environments. * none: Build Options. +* posix: Posix Extensions. +* Posix: Posix Extensions. * posix: Build Options. * R4RS: Bibliography. * R5RS: Bibliography. @@ -8245,6 +8274,8 @@ Concept Index * record: Build Options. * regex: Build Options. * rev2-procedures: Build Options. +* rope <1>: Type Conversions. +* rope: Callbacks. * SchemePrimer: Bibliography. * SICP: Build Options. * sicp: Build Options. @@ -8257,6 +8288,8 @@ Concept Index * stack-limit: Build Options. * tick-interrupts: Build Options. * turtlegr: Build Options. +* unix: Unix Extensions. +* Unix: Unix Extensions. * unix: Build Options. * windows: Build Options. * X: Packages. @@ -8271,113 +8304,126 @@ Concept Index Tag Table: -Node: Top203 -Node: Overview1481 -Node: SCM Features1792 -Node: SCM Authors3804 -Node: Copying4742 -Node: Bibliography7831 -Node: Installing SCM9699 -Node: Making SCM10214 -Node: SLIB11131 -Node: Building SCM13149 -Node: Invoking Build13723 -Node: Build Options16516 -Node: Compiling and Linking Custom Files29598 -Node: Installing Dynamic Linking31577 -Node: Configure Module Catalog33361 -Node: Saving Images35358 -Node: Automatic C Preprocessor Definitions36033 -Node: Problems Compiling39541 -Node: Problems Linking41194 -Node: Problems Running41459 -Node: Testing43567 -Node: Reporting Problems46654 -Node: Operational Features47577 -Node: Invoking SCM47941 -Node: SCM Options49585 -Node: Invocation Examples54026 -Node: SCM Variables54978 -Node: SCM Session56487 -Node: Editing Scheme Code58010 -Node: Debugging Scheme Code60153 -Node: Errors63776 -Node: Memoized Expressions68075 -Node: Internal State70439 -Node: Scripting73727 -Node: Unix Scheme Scripts74021 -Node: MS-DOS Compatible Scripts77233 -Node: Unix Shell Scripts79045 -Node: The Language81235 -Node: Standards Compliance81890 -Node: Miscellaneous Procedures84304 -Node: Time87460 -Node: Interrupts88454 -Node: Process Synchronization94464 -Node: Files and Ports97244 -Node: Line Numbers104204 -Node: Soft Ports108304 -Node: Syntax Extensions110296 -Node: Low Level Syntactic Hooks119654 -Node: Syntactic Hooks for Hygienic Macros126507 -Node: Packages133588 -Node: Dynamic Linking134544 -Node: Dump139232 -Node: Numeric143350 -Node: Arrays145077 -Node: Conventional Arrays145366 -Node: Array Mapping152015 -Node: Uniform Array154278 -Node: Bit Vectors160302 -Node: Records161567 -Node: I/O-Extensions163253 -Node: Posix Extensions172179 -Node: Unix Extensions182353 -Node: Regular Expression Pattern Matching184358 -Node: Line Editing188387 -Node: Curses189733 -Node: Output Options Setting190656 -Node: Terminal Mode Setting193305 -Node: Window Manipulation196383 -Node: Output199843 -Node: Input203469 -Node: Curses Miscellany204496 -Node: Sockets205920 -Node: Host Data206244 -Node: Internet Addresses and Socket Names209392 -Node: Socket210926 -Node: The Implementation218163 -Node: Data Types218422 -Node: Immediates219243 -Node: Cells223579 -Node: Header Cells225671 -Node: Subr Cells228892 -Node: Ptob Cells231110 -Node: Smob Cells232649 -Node: Data Type Representations235845 -Node: Operations240503 -Node: Garbage Collection241089 -Node: Marking Cells241710 -Node: Sweeping the Heap243812 -Node: Memory Management for Environments244757 -Node: Signals249314 -Node: C Macros250858 -Node: Changing Scm251981 -Node: Defining Subrs256253 -Node: Defining Smobs258130 -Node: Defining Ptobs261265 -Node: Allocating memory262442 -Node: Embedding SCM264833 -Node: Callbacks272486 -Node: Type Conversions274289 -Node: Continuations277845 -Node: Evaluation282059 -Node: Program Self-Knowledge287222 -Node: File-System Habitat287468 -Node: Executable Pathname291068 -Node: Script Support292686 -Node: Improvements To Make294004 -Node: Finishing Dynamic Linking296036 -Node: Index303782 +Node: Top217 +Node: Overview1471 +Node: SCM Features1782 +Node: SCM Authors3794 +Node: Copying4687 +Node: Bibliography7776 +Node: Installing SCM9644 +Node: Making SCM10159 +Node: SLIB11076 +Node: Building SCM12984 +Node: Invoking Build13558 +Node: Build Options15882 +Node: Compiling and Linking Custom Files31338 +Node: Installing Dynamic Linking33321 +Node: Configure Module Catalog35099 +Node: Saving Images37096 +Node: Automatic C Preprocessor Definitions37771 +Node: Problems Compiling41545 +Node: Problems Linking43198 +Node: Problems Running43463 +Node: Testing45571 +Node: Reporting Problems48635 +Node: Operational Features49477 +Node: Invoking SCM49841 +Node: SCM Options51487 +Node: Invocation Examples55906 +Node: SCM Variables56858 +Node: SCM Session58315 +Node: Editing Scheme Code59830 +Node: Debugging Scheme Code61891 +Node: Errors65514 +Node: Memoized Expressions69813 +Node: Internal State72177 +Node: Scripting75309 +Node: Unix Scheme Scripts75603 +Node: MS-DOS Compatible Scripts78663 +Node: Unix Shell Scripts80641 +Node: The Language82786 +Node: Standards Compliance83404 +Node: Storage85801 +Node: Time88267 +Node: Interrupts89244 +Node: Process Synchronization92854 +Node: Files and Ports94391 +Node: Opening and Closing94724 +Node: Port Properties97193 +Node: Port Redirection99852 +Node: Soft Ports101326 +Node: Eval and Load103105 +Node: Line Numbers104507 +Node: Lexical Conventions107446 +Node: Common-Lisp Read Syntax107764 +Node: Load Syntax110587 +Node: Documentation and Comments112063 +Node: Modifying Read Syntax113388 +Node: Syntax115499 +Node: Define and Set116395 +Node: Defmacro119928 +Node: Syntax-Rules121006 +Node: Macro Primitives122815 +Node: Environment Frames124447 +Node: Syntactic Hooks for Hygienic Macros126853 +Node: Packages133814 +Node: Dynamic Linking134616 +Node: Dump139225 +Node: Numeric143234 +Node: Arrays144961 +Node: Conventional Arrays145171 +Node: Uniform Array148868 +Node: Bit Vectors153661 +Node: Array Mapping154948 +Node: Records157791 +Node: I/O-Extensions158654 +Node: Posix Extensions167248 +Node: Unix Extensions176757 +Node: Regular Expression Pattern Matching178659 +Node: Line Editing182609 +Node: Curses183955 +Node: Output Options Setting184878 +Node: Terminal Mode Setting187527 +Node: Window Manipulation190605 +Node: Output194065 +Node: Input197691 +Node: Curses Miscellany198718 +Node: Sockets200142 +Node: Host and Other Inquiries200481 +Node: Internet Addresses and Socket Names203590 +Node: Socket205139 +Node: The Implementation212376 +Node: Data Types212635 +Node: Immediates213456 +Node: Cells217792 +Node: Header Cells219884 +Node: Subr Cells222925 +Node: Ptob Cells225143 +Node: Smob Cells226682 +Node: Data Type Representations229869 +Node: Operations234567 +Node: Garbage Collection235153 +Node: Marking Cells235774 +Node: Sweeping the Heap237876 +Node: Memory Management for Environments238821 +Node: Signals243378 +Node: C Macros244922 +Node: Changing Scm246045 +Node: Defining Subrs250493 +Node: Defining Smobs252370 +Node: Defining Ptobs255416 +Node: Allocating memory256593 +Node: Embedding SCM258906 +Node: Callbacks266761 +Node: Type Conversions268564 +Node: Continuations272586 +Node: Evaluation276800 +Node: Program Self-Knowledge281963 +Node: File-System Habitat282209 +Node: Executable Pathname285809 +Node: Script Support287427 +Node: Improvements To Make288745 +Node: VMS Dynamic Linking290984 +Node: Index295773 End Tag Table @@ -1,5 +1,5 @@ %define name scm -%define version 5d6 +%define version 5d9 %define release 1 %define implpath %{prefix}/lib/scm # rpm seems to require all on one line, bleah. @@ -18,7 +18,7 @@ Requires: slib Summary: SCM Scheme implementation. Source: ftp://swissnet.ai.mit.edu/pub/scm/scm%{version}.zip -URL: http://swissnet.ai.mit.edu/~jaffer/SCM.html +URL: http://swissnet.ai.mit.edu/~jaffer/SCM BuildRoot: %{_tmppath}/%{name}%{version} Prefix: /usr @@ -53,20 +53,21 @@ make clean export PATH=.:$PATH # to get scmlit in the path. # Build the executable. -./build -h system -o udscm5 -l debug -s %{implpath} -F %{features} +./build -h system -o udscm5 --compiler-options="-O3" -l debug -s %{implpath} -F %{features} echo "(quit)" | ./udscm5 -no-init-file -r5 -o scm make check # Build dlls make x.so -./build -h system -F curses -t dll +./build -h system -F curses -t dll --compiler-options="-O3" ./build -h system -t dll -c sc2.c rgx.c record.c gsubr.c ioext.c posix.c \ - unix.c socket.c ramap.c -./build -h system -F edit-line -t dll -./build -h system -F x -t dll + unix.c socket.c ramap.c --compiler-options="-O3" +./build -h system -F edit-line -t dll --compiler-options="-O3" +./build -h system -F x -t dll --compiler-options="-O3" # Build libscm.a static library -./build -h system -F cautious bignums arrays inexact dynamic-linking -t lib +./build -h system -F cautious bignums arrays inexact dynamic-linking -t lib \ + --compiler-options="-O3" %install mkdir -p ${RPM_BUILD_ROOT}%{prefix}/bin @@ -143,6 +144,7 @@ rm -f %{prefix}/bin/scm %{prefix}/lib/scm/hobbit.scm %{prefix}/lib/scm/scmhob.scm %{prefix}/lib/scm/scmhob.h +%{prefix}/lib/scm/patchlvl.h %{prefix}/lib/scm/build.scm %{prefix}/lib/scm/build %{prefix}/lib/scm/Iedline.scm @@ -55,7 +55,7 @@ This manual documents the SCM Scheme implementation. SCM version @value{SCMVERSION} was released @value{SCMDATE}. The most recent information about SCM can be found on SCM's @dfn{WWW} home page: -@center @url{http://swissnet.ai.mit.edu/~jaffer/SCM.html} +@center @url{http://swissnet.ai.mit.edu/~jaffer/SCM} Copyright (C) 1990-1999 Free Software Foundation @@ -84,7 +84,7 @@ by the author. @menu * Overview:: -* Installing SCM:: +* Installing SCM:: How to * Operational Features:: * The Language:: Reference. * Packages:: Optional Capabilities. @@ -105,9 +105,9 @@ The most recent information about SCM can be found on SCM's @dfn{WWW} home page: @ifset html -<A HREF="http://swissnet.ai.mit.edu/~jaffer/SCM.html"> +<A HREF="http://swissnet.ai.mit.edu/~jaffer/SCM"> @end ifset -@center @url{http://swissnet.ai.mit.edu/~jaffer/SCM.html} +@center @url{http://swissnet.ai.mit.edu/~jaffer/SCM} @ifset html </A> @end ifset @@ -174,7 +174,7 @@ timing information printed interactively (the @code{verbose} function). @section Authors @table @b -@item Aubrey Jaffer (jaffer @@ alum.mit.edu) +@item Aubrey Jaffer (agj @@ alum.mit.edu) Most of SCM. @item Radey Shouman Arrays, @code{gsubr}s, compiled closures, records, Ecache, syntax-rules @@ -480,34 +480,34 @@ low priority. SLIB is available from the same sites as SCM: @ifclear html @itemize @bullet @item -swissnet.ai.mit.edu:/pub/scm/slib2d4.tar.gz +swissnet.ai.mit.edu:/pub/scm/slib3a1.tar.gz @item -ftp.gnu.org:/pub/gnu/jacal/slib2d4.tar.gz +ftp.gnu.org:/pub/gnu/jacal/slib3a1.tar.gz @item -ftp.cs.indiana.edu:/pub/scheme-repository/imp/slib2d4.tar.gz +ftp.cs.indiana.edu:/pub/scheme-repository/imp/slib3a1.tar.gz @end itemize @end ifclear @ifset html @itemize @bullet @item -<A HREF="http://swissnet.ai.mit.edu/ftpdir/scm/slib2d4.zip"> -http://swissnet.ai.mit.edu/ftpdir/scm/slib2d4.zip +<A HREF="http://swissnet.ai.mit.edu/ftpdir/scm/slib3a1.zip"> +http://swissnet.ai.mit.edu/ftpdir/scm/slib3a1.zip </A> @item -<A HREF="ftp://ftp.gnu.org/pub/gnu/jacal/slib2d4.tar.gz"> -ftp.gnu.org:/pub/gnu/jacal/slib2d4.tar.gz +<A HREF="ftp://ftp.gnu.org/pub/gnu/jacal/slib3a1.tar.gz"> +ftp.gnu.org:/pub/gnu/jacal/slib3a1.tar.gz </A> @item -<A HREF="ftp://ftp.cs.indiana.edu/pub/scheme-repository/code/lib/slib2d4.tar.gz"> -ftp.cs.indiana.edu:/pub/scheme-repository/code/lib/slib2d4.tar.gz +<A HREF="ftp://ftp.cs.indiana.edu/pub/scheme-repository/code/lib/slib3a1.tar.gz"> +ftp.cs.indiana.edu:/pub/scheme-repository/code/lib/slib3a1.tar.gz </A> @end itemize @end ifset @noindent -Unpack SLIB (@samp{tar xzf slib2d4.tar.gz} or @samp{unzip -ao -slib2d4.zip}) in an appropriate directory for your system; both +Unpack SLIB (@samp{tar xzf slib3a1.tar.gz} or @samp{unzip -ao +slib3a1.zip}) in an appropriate directory for your system; both @code{tar} and @code{unzip} will create the directory @file{slib}. @noindent @@ -518,7 +518,6 @@ file @file{Init@value{SCMVERSION}.scm} is installed). @example (define (library-vicinity) "/usr/local/lib/slib/") -(load (in-vicinity (library-vicinity) "require")) @end example @noindent @@ -533,7 +532,6 @@ implementation-vicinity, which is absolute: (define library-vicinity (let ((lv (string-append (implementation-vicinity) "../slib/"))) (lambda () lv))) -(load (in-vicinity (library-vicinity) "require")) @end example @noindent @@ -647,6 +645,33 @@ The platforms defined by table @dfn{platform} in @file{build.scm} are: @include platform.txi @end example +@deffn {Build Option} -f @var{pathname} +specifies that the build options contained in @var{pathname} be +spliced into the argument list at this point. The use of option files +can separate functional features from platform-specific ones. + +The @file{Makefile} calls out builds with the options in @samp{.opt} +files: + +@table @file +@item dlls.opt +Options for Makefile targets mydlls, myturtle, and x.so. +@item gdb.opt +Options for udgdbscm and gdbscm. +@item libscm.opt +Options for libscm.a. +@item pg.opt +Options for pgscm, which instruments C functions. +@item udscm4.opt +Options for targets udscm4 and myscm4 (scm). +@item udscm5.opt +Options for targets udscm5 and myscm5 (scm). +@end table + +The Makefile creates options files it depends on only if they do not +already exist. +@end deffn + @deffn {Build Option} -o @var{filename} @deffnx {Build Option} ---outname=@var{filename} specifies that the compilation should produce an executable or object @@ -793,7 +818,7 @@ compile and link your file at compile time, use the @samp{-c} and @samp{-i} options to build: @example -bash$ build -c foo.c -i init_foo +bash$ ./build -c foo.c -i init_foo @print{} #! /bin/sh rm -f scmflags.h @@ -812,7 +837,7 @@ gcc -rdynamic -o scm continue.o scm.o findexec.o script.o time.o \ To make a dynamically loadable object file use the @code{-t dll} option: @example -bash$ build -t dll -c foo.c +bash$ ./build -t dll -c foo.c @print{} #! /bin/sh rm -f scmflags.h @@ -840,7 +865,7 @@ in the BSD family (a.out binary format) can usually be ported to @dfn{DLD}. The @dfn{dl} library (@code{#define SUN_DL} for SCM) was a proposed POSIX standard and may be available on other machines with @dfn{COFF} binary format. For notes about porting to MS-Windows and -finishing the port to VMS @ref{Finishing Dynamic Linking}. +finishing the port to VMS @ref{VMS Dynamic Linking}. @noindent @dfn{DLD} is a library package of C functions that performs @dfn{dynamic @@ -1006,7 +1031,9 @@ macintosh Macintosh (THINK_C and __MWERKS__ define) MCH_AMIGA Aztec_c 5.2a on AMIGA __MACH__ Apple Darwin 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. __SVR4 SunOS @@ -1021,13 +1048,19 @@ vax11c VAX C compiler VAX11 VAX C compiler _Windows Borland C 3.1 compiling for Windows _WIN32 MS VisualC++ 4.2 and Cygwin (Win32 API) +_WIN32_WCE MS Windows CE vms (and VMS) VAX-11 C under VMS. __alpha DEC Alpha processor __alpha__ DEC Alpha processor hp9000s800 HP RISC processor +__ia64 GCC on IA64 +__ia64__ GCC on IA64 +_LONGLONG GCC on IA64 __i386__ DJGPP i386 DJGPP +_M_ARM Microsoft CLARM compiler defines as 4 for ARM. +_M_ARMT Microsoft CLTHUMB compiler defines as 4 for Thumb. MULTIMAX Encore computer ppc PowerPC __ppc__ PowerPC @@ -1230,7 +1263,7 @@ call-with-current-continuations. @noindent Reported problems and solutions are grouped under Compiling, Linking, Running, and Testing. If you don't find your problem listed there, you -can send a bug report to @code{jaffer @@ alum.mit.edu}. The bug report +can send a bug report to @code{agj @@ alum.mit.edu}. The bug report should include: @enumerate @@ -1313,8 +1346,8 @@ on the command line, or from standard input. This explanation applies to SCMLIT or other builds of SCM. @noindent -Scheme-code files can also invoke SCM and its variants. @xref{Syntax -Extensions, #!}. +Scheme-code files can also invoke SCM and its variants. +@xref{Lexical Conventions, #!}. @node SCM Options, Invocation Examples, Invoking SCM, Operational Features @section Options @@ -1345,10 +1378,10 @@ prints version information and exit. @deffn {Command Option} -r feature requires @var{feature}. This will load a file from [SLIB] if that -@var{feature} is not already provided. If @var{feature} is 2, 2rs, -r2rs, 3, 3rs, r3rs, 4, 4rs, r4rs, 5, 5rs, or r5rs; @code{scm} will -require the features neccessary to support [R2RS], [R3RS], [R4RS], or -[R5RS], respectively. +@var{feature} is not already provided. If @var{feature} is 2, 2rs, or +r2rs; 3, 3rs, or r3rs; 4, 4rs, or r4rs; 5, 5rs, or r5rs; @code{scm} +will require the features neccessary to support [R2RS]; [R3RS]; +[R4RS]; or [R5RS], respectively. @end deffn @deffn {Command Option} -h feature @@ -1357,10 +1390,9 @@ provides @var{feature}. @deffn {Command Option} -l filename @deffnx {Command Option} -f filename -loads @var{filename}. @code{Scm} will load the first (unoptioned) file -named on the command line if no @code{-c}, @code{-e}, @code{-f}, -@code{-l}, or @code{-s} option preceeds -it. +loads @var{filename}. @code{Scm} will load the first (unoptioned) +file named on the command line if no @code{-c}, @code{-e}, @code{-f}, +@code{-l}, or @code{-s} option preceeds it. @end deffn @deffn {Command Option} -d filename @@ -1435,13 +1467,14 @@ are errors. @end deffn @deffn {Command Option} -s -specifies, by analogy with @code{sh}, that further options are to be -treated as program aguments. +specifies, by analogy with @code{sh}, that @code{scm} should run +interactively and that further options are to be treated as program +aguments. @end deffn @deffn {Command Option} - @deffnx {Command Option} --- -specifies that there are no more options on the command line. +specifies that further options are to be treated as program aguments. @end deffn @node Invocation Examples, SCM Variables, SCM Options, Operational Features @@ -1556,6 +1589,11 @@ interactive top-level is not entered. Returns a list of strings of the arguments scm was called with. @end defun +@defun 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. +@end defun + @noindent For documentation of the procedures @code{getenv} and @code{system} @xref{System Interface, , , slib, SLIB}. @@ -1583,10 +1621,7 @@ single the single argument @var{filename}. @table @asis @item Gnu Emacs: Editing of Scheme code is supported by emacs. Buffers holding files -ending in .scm are automatically put into scheme-mode. EMACS for MS-DOS -and MS-Windows systems is available (free) from: - -@center @url{http://simtel.coast.net/SimTel/gnu/demacs.html} +ending in .scm are automatically put into scheme-mode. If your Emacs can run a process in a buffer you can use the Emacs command @samp{M-x run-scheme} with SCM. Otherwise, use the emacs @@ -2059,7 +2094,7 @@ variable @code{PATH} are @emph{not} searched to find @var{interpreter}. When executing a shell-script, the operating system invokes @var{interpreter} with a single argument encapsulating the rest of the -first line's contents (if if not just whitespace), the pathname of the +first line's contents (if not just whitespace), the pathname of the Scheme Script file, and then any arguments which the shell-script was invoked with. @@ -2104,25 +2139,25 @@ The following Scheme-Script prints factorial of its argument: @example #! /usr/local/bin/scm \ %0 %1 %2 %3 %4 %5 %6 %7 %8 %9 - !# - ; -*-scheme-*- -(define (go-script) - (cond ((not *script*)) - ((and (= 1 (- (length *argv*) *optind*)) - (string->number (list-ref *argv* *optind*))) - => (lambda (n) (print (fact n)))) - (else - (print *argv*) - (display "\ -Usage: fact n - Returns the factorial of N. -http://swissnet.ai.mit.edu/~jaffer/SLIB.html +(define (fact.script args) + (cond ((and (= 1 (length args)) + (string->number (car args))) + => (lambda (n) (print (fact n)) #t)) + (else (fact.usage)))) + +(define (fact.usage) + (print *argv*) + (display "\ +Usage: fact N + Returns the factorial of N. " - (current-error-port)) - (exit #f)))) + (current-error-port)) + #f) (define (fact n) (if (< n 2) 1 (* n (fact (+ -1 n))))) -(go-script) + +(if *script* (exit (fact.script (list-tail *argv* *optind*)))) @end example @example @@ -2139,10 +2174,8 @@ If the wrong number of arguments is given, @code{fact} prints its ./fact 3 2 @print{} ("./fact" "3" "2") -Usage: fact n +Usage: fact N Returns the factorial of N. - -http://swissnet.ai.mit.edu/~jaffer/SLIB.html @end example @@ -2152,11 +2185,13 @@ http://swissnet.ai.mit.edu/~jaffer/SLIB.html @noindent 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: -@code{#!.bat} and @code{!#.exe}. +@code{#!.bat} and @code{!#.exe}, @cindex !# @cindex !#.exe @cindex #! @cindex #!.bat +which are available from: +@url{http://swissnet.ai.mit.edu/ftpdir/scm/sharpbang.zip} @noindent With these two programs installed in a @code{PATH} directory, we have @@ -2183,7 +2218,7 @@ executables, @code{#!} tries all directories named by environment variable @code{PATH}. Once the @var{interpreter} executable path is found, arguments are -processed in the manner of scheme-shell, with the all the text after the +processed in the manner of scheme-shell, with all the text after the @samp{\} taken as part of the meta-argument. More precisely, @code{#!} calls @var{interpreter} with any options on the second line of the Scheme-Script up to @samp{!#}, the name of the Scheme-Script file, and @@ -2241,25 +2276,24 @@ example. #! /bin/sh :;exec scm -e"(set! *script* \"$0\")" -l$0 $* -(define (go-script) - (cond ((not *script*)) - ((and (= 1 (- (length *argv*) *optind*)) - (string->number (list-ref *argv* *optind*))) - => (lambda (n) (print (fact n)))) - (else - (print *argv*) - (display "\ -Usage: fact n - Returns the factorial of N. +(define (fact.script args) + (cond ((and (= 1 (length args)) + (string->number (car args))) + => (lambda (n) (print (fact n)) #t)) + (else (fact.usage)))) -http://swissnet.ai.mit.edu/~jaffer/SLIB.html +(define (fact.usage) + (print *argv*) + (display "\ +Usage: fact N + Returns the factorial of N. " - (current-error-port)) - (exit #f)))) + (current-error-port)) + #f) (define (fact n) (if (< n 2) 1 (* n (fact (+ -1 n))))) -(go-script) +(if *script* (exit (fact.script (list-tail *argv* *optind*)))) @end example @example @@ -2273,19 +2307,17 @@ http://swissnet.ai.mit.edu/~jaffer/SLIB.html @menu * Standards Compliance:: Links to sections in [R5RS] and [SLIB] -* Miscellaneous Procedures:: +* Storage:: Finalizers, GC-hook, vector-set-length! * Time:: Both real time and processor time * Interrupts:: and exceptions * Process Synchronization:: Because interrupts are preemptive * Files and Ports:: -* Line Numbers:: -* Soft Ports:: Emulate I/O devices -* Syntax Extensions:: -* Low Level Syntactic Hooks:: -* Syntactic Hooks for Hygienic Macros:: +* Eval and Load:: and line-numbers +* Lexical Conventions:: Also called read-syntax +* Syntax:: Macros @end menu -@node Standards Compliance, Miscellaneous Procedures, The Language, The Language +@node Standards Compliance, Storage, The Language, The Language @section Standards Compliance @noindent @@ -2408,59 +2440,9 @@ See SLIB file @file{Template.scm}. @xref{Require, , , slib, SLIB}. @end table -@node Miscellaneous Procedures, Time, Standards Compliance, The Language -@section Miscellaneous Procedures -@defun try-load filename -If the string @var{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 @code{#t}. If not, -try-load returns @code{#f}. The try-load procedure does not affect the -values returned by @code{current-input-port} and -@code{current-output-port}. -@end defun - -@defvar *load-pathname* -Is set to the pathname given as argument to @code{load}, -@code{try-load}, and @code{dyn:link} -(@pxref{Compiling And Linking, , , hobbit, Hobbit}). -@code{*load-pathname*} is used to compute the value of -@ref{Vicinity, program-vicinity, , slib, SLIB}. -@end defvar - -@defun line-number -Returns the current line number of the file currently being loaded. -@end defun - -@defun port-filename port -Returns the filename @var{port} was opened with. If @var{port} is -not open to a file the result is unspecified. -@end defun - -@defun port-line port -@defunx port-column port -If @var{port} is a tracked port, return the current line (column) number, -otherwise return @code{#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. -@end defun - -@defun eval obj -Alias for @ref{System, eval, , slib, SLIB}. -@end defun - -@defun eval-string str -Returns the result of reading an expression from @var{str} and -evaluating it. @code{eval-string} does not change -@code{*load-pathname*} or @code{line-number}. -@end defun - -@defun load-string str -Reads and evaluates all the expressions from @var{str}. As with -@code{load}, the value returned is unspecified. @code{load-string} does -not change @code{*load-pathname*} or @code{line-number}. -@end defun +@node Storage, Time, Standards Compliance, The Language +@section Storage @defun vector-set-length! object length Change the length of string, vector, bit-vector, or uniform-array @@ -2479,25 +2461,50 @@ depend on this feature; @code{copy-tree} could get redefined. @end defun @defun acons obj1 obj2 obj3 -Returns (cons (cons obj1 obj2) obj3). The expression (set! a-list -(acons key datum a-list)) adds a new association to a-list. -@end defun +Returns (cons (cons obj1 obj2) obj3). -@defun terms -This command displays the GNU General Public License. -@end defun +@lisp +(set! a-list (acons key datum a-list)) +@end lisp -@defun list-file filename -Displays the text contents of @var{filename}. +Adds a new association to a-list. @end defun -@deffn Procedure print arg1 @dots{} -@code{Print} writes all its arguments, separated by spaces. -@code{Print} outputs a @code{newline} at the end and returns the value -of the last argument. +@deffn {Callback procedure} gc-hook @dots{} +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 warning will be +printed. + +To remove the gc-hook, @code{(set! gc-hook #f)}. @end deffn -@node Time, Interrupts, Miscellaneous Procedures, The Language +@defun add-finalizer object finalizer +@var{object} may be any garbage collected object, that is, any object +other than an immediate integer, character, or special token such +as @code{#f} or @code{#t}, @xref{Immediates}. @var{finalizer} is +a thunk, or procedure taking no arguments. + +@var{finalizer} will be invoked asynchronously exactly once some time +after @var{object} becomes eligible for garbage collection. A reference +to @var{object} in the environment of @var{finalizer} will not prevent +finalization, but will delay the reclamation of @var{object} at least +until the next garbage collection. A reference to @var{object} in some +other object's finalizer will necessarily prevent finalization until both +objects are eligible for garbage collection. + +Finalizers are not run in any predictable order. All finalizers will be +run by the time the program ends. + +This facility was based on the paper by Simon Peyton Jones, et al, +``Stretching the storage manager: weak pointers and stable names in +Haskell'', Proc. 11th International Workshop on the Implementation of +Functional Languages, The Netherlands, September 7-10 1999, +Springer-Verlag LNCS. +@end defun + + +@node Time, Interrupts, Storage, The Language @section Time @defvr Constant internal-time-units-per-second @@ -2610,37 +2617,6 @@ To unestablish a response for an error set the handler symbol to @code{#f}. For instance, @code{(set! could-not-open #f)}. @end deffn -@deffn {Callback procedure} gc-hook @dots{} -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 warning will be -printed. -@end deffn - -@defun add-finalizer object finalizer -@var{object} may be any garbage collected object, that is, any object -other than an immediate integer, character, or special token such -as @code{#f} or @code{#t}, @xref{Immediates}. @var{finalizer} is -a thunk, or procedure taking no arguments. - -@var{finalizer} will be invoked asynchronously exactly once some time -after @var{object} becomes eligible for garbage collection. A reference -to @var{object} in the environment of @var{finalizer} will not prevent -finalization, but will delay the reclamation of @var{object} at least -until the next garbage collection. A reference to @var{object} in some -other object's finalizer will necessarily prevent finalization until both -objects are eligible for garbage collection. - -Finalizers are not run in any predictable order. All finalizers will be -run by the time the program ends. - -This facility was based on the paper by Simon Peyton Jones, et al, -``Stretching the storage manager: weak pointers and stable names in -Haskell'', Proc. 11th International Workshop on the Implementation of -Functional Languages, The Netherlands, September 7-10 1999, -Springer-Verlag LNCS. - -@end defun @node Process Synchronization, Files and Ports, Interrupts, The Language @section Process Synchronization @@ -2699,13 +2675,26 @@ Returns @code{#t} and unlocks @var{arbiter} if @var{arbiter} was locked. Otherwise, returns @code{#f}. @end defun -@node Files and Ports, Line Numbers, Process Synchronization, The Language + + +@node Files and Ports, Eval and Load, Process Synchronization, The Language @section Files and Ports @noindent These procedures generalize and extend the standard capabilities in @ref{Ports, , ,r5rs, Revised(5) Scheme}. + +@menu +* Opening and Closing:: +* Port Properties:: +* Port Redirection:: +* Soft Ports:: +@end menu + +@node Opening and Closing, Port Properties, Files and Ports, Files and Ports +@subsection Opening and Closing + @defun open-file string modes @defunx try-open-file string modes Returns a port capable of receiving or delivering characters as @@ -2752,6 +2741,22 @@ does not already exist. This functionality is provided by calling for all platforms. @end defun +@defun open-ports +Returns a list of all currently open ports, excluding string ports, +see @xref{String Ports, , , slib, SLIB}. This may be useful after +a fork @xref{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. +@end defun + +@defun close-port port +Closes @var{port}. The same as close-input-port and close-output-port. +@end defun + + +@node Port Properties, Port Redirection, Opening and Closing, Files and Ports +@subsection Port Properties + @defun port-closed? port Returns #t if @var{port} is closed. @end defun @@ -2761,38 +2766,31 @@ If @var{obj} is not a port returns false, otherwise returns a symbol describing the port type, for example string or pipe. @end defun -@defun close-port port -Closes @var{port}. The same as close-input-port and close-output-port. -@end defun - -@defun current-error-port -Returns the current port to which diagnostic output is directed. +@defun port-filename port +Returns the filename @var{port} was opened with. If @var{port} is +not open to a file the result is unspecified. @end defun -@defun with-error-to-file string thunk -@var{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 -current-error-port, and the @var{thunk} is called with no arguments. When -the thunk returns, the port is closed and the previous default is -restored. With-error-to-file returns the value yielded by @var{thunk}. +@defun port-line port +@defunx port-column port +If @var{port} is a tracked port, return the current line (column) number, +otherwise return @code{#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. @end defun -@defun with-input-from-port port thunk -@defunx with-output-to-port port thunk -@defunx 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. +@defun freshline port +Outputs a newline to optional argument @var{port} unless the current +output column number of @var{port} is known to be zero, ie output will +start at the beginning of a new line. @var{port} defaults to +@code{current-output-port}. If @var{port} is not a tracked port +@code{freshline} is equivalent to @code{newline}. @end defun -@defun call-with-outputs thunk proc -Calls the @var{thunk} procedure while the current-output-port and -current-error-port are directed to string-ports. If @var{thunk} -returns, the @var{proc} procedure is called with the output-string, the -error-string, and the value returned by @var{thunk}. If @var{thunk} -does not return a value (perhaps because of error), @var{proc} is called -with just the output-string and the error-string as arguments. +@defun isatty? port +Returns @code{#t} if @var{port} is input or output to a serial non-file +device. @end defun @deffn {procedure} char-ready? @@ -2836,31 +2834,145 @@ to the list of the value returned by @code{current-input-port}. @findex current-input-port @end deffn -@defun isatty? port -Returns @code{#t} if @var{port} is input or output to a serial non-file device. + +@node Port Redirection, Soft Ports, Port Properties, Files and Ports +@subsection Port Redirection + +@defun current-error-port +Returns the current port to which diagnostic output is directed. @end defun -@defun freshline port -Outputs a newline to optional argument @var{port} unless the current -output column number of @var{port} is known to be zero, ie output will -start at the beginning of a new line. @var{port} defaults to -@code{current-output-port}. If @var{port} is not a tracked port -@code{freshline} is equivalent to @code{newline}. +@defun with-error-to-file string thunk +@var{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 +current-error-port, and the @var{thunk} is called with no arguments. When +the thunk returns, the port is closed and the previous default is +restored. With-error-to-file returns the value yielded by @var{thunk}. @end defun -@defun open-ports -Returns a list of all currently open ports, excluding string ports, -see @xref{String Ports, , , slib, SLIB}. This may be useful after -a fork @xref{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. +@defun with-input-from-port port thunk +@defunx with-output-to-port port thunk +@defunx 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. @end defun +@defun call-with-outputs thunk proc +Calls the @var{thunk} procedure while the current-output-port and +current-error-port are directed to string-ports. If @var{thunk} +returns, the @var{proc} procedure is called with the output-string, the +error-string, and the value returned by @var{thunk}. If @var{thunk} +does not return a value (perhaps because of error), @var{proc} is called +with just the output-string and the error-string as arguments. +@end defun + + +@node Soft Ports, , Port Redirection, Files and Ports +@subsection Soft Ports + +@noindent +A @dfn{soft-port} is a port based on a vector of procedures capable of +accepting or delivering characters. It allows emulation of I/O ports. + +@defun make-soft-port vector modes +Returns a port capable of receiving or delivering characters as +specified by the @var{modes} string (@pxref{Files and Ports, +open-file}). @var{vector} must be a vector of length 6. Its components +are as follows: + +@enumerate 0 +@item +procedure accepting one character for output +@item +procedure accepting a string for output +@item +thunk for flushing output +@item +thunk for getting one character +@item +thunk for closing port (not by garbage collection) +@end enumerate -@node Line Numbers, Soft Ports, Files and Ports, The Language -@section Line Numbers +For an output-only port only elements 0, 1, 2, and 4 need be +procedures. For an input-only port only elements 3 and 4 need be +procedures. Thunks 2 and 4 can instead be @code{#f} if there is no useful +operation for them to perform. -Scheme code define by load may optionally contain line number +If thunk 3 returns @code{#f} or an @code{eof-object} (@pxref{Input, +eof-object?, ,r5rs, Revised(5) Scheme}) it indicates that the port has +reached end-of-file. For example: + +If it is necessary to explicitly close the port when it is garbage +collected, (@pxref{Interrupts, add-finalizer}). + +@example +(define stdout (current-output-port)) +(define p (make-soft-port + (vector + (lambda (c) (write c stdout)) + (lambda (s) (display s stdout)) + (lambda () (display "." stdout)) + (lambda () (char-upcase (read-char))) + (lambda () (display "@@" stdout))) + "rw")) + +(write p p) @result{} #<input-output-soft#\space45d10#\> +@end example +@end defun + + + +@node Eval and Load, Lexical Conventions, Files and Ports, The Language +@section Eval and Load + +@defun try-load filename +If the string @var{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 @code{#t}. If not, +try-load returns @code{#f}. The try-load procedure does not affect the +values returned by @code{current-input-port} and +@code{current-output-port}. +@end defun + +@defvar *load-pathname* +Is set to the pathname given as argument to @code{load}, +@code{try-load}, and @code{dyn:link} +(@pxref{Compiling And Linking, , , hobbit, Hobbit}). +@code{*load-pathname*} is used to compute the value of +@ref{Vicinity, program-vicinity, , slib, SLIB}. +@end defvar + +@defun eval obj +Alias for @ref{System, eval, , slib, SLIB}. +@end defun + +@defun eval-string str +Returns the result of reading an expression from @var{str} and +evaluating it. @code{eval-string} does not change +@code{*load-pathname*} or @code{line-number}. +@end defun + +@defun load-string str +Reads and evaluates all the expressions from @var{str}. As with +@code{load}, the value returned is unspecified. @code{load-string} does +not change @code{*load-pathname*} or @code{line-number}. +@end defun + +@defun line-number +Returns the current line number of the file currently being loaded. +@end defun + + +@menu +* Line Numbers:: +@end menu + +@node Line Numbers, , Eval and Load, Eval and Load +@subsection 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. @@ -2881,10 +2993,18 @@ equivalent to the vector. The meaning of s-expressions with line-numbers in other positions is undefined. @defun read-numbered port -Behaves like @code{read}, except that every s-expression read will be +Behaves like @code{read}, except that + +@itemize bullet +@item +Load (read) sytnaxes are enabled. +@item +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 @var{port} is a tracked port See @xref{Files and Ports}. +@end itemize + @end defun @defun integer->line-number int @@ -2900,6 +3020,10 @@ Returns the value of line-number object @var{linum} as an integer. Returns true if and only if @var{obj} is a line-number object. @end defun +@defun read-for-load port +Behaves like @code{read}, except that load syntaxes are enabled. +@end defun + @defvar *load-reader* @defvarx *slib-load-reader* The value of @code{*load-reader*} should be a value acceptable as @@ -2913,61 +3037,102 @@ In order to disable all line-numbering, it is sufficient to set! @end defvar -@node Soft Ports, Syntax Extensions, Line Numbers, The Language -@section Soft Ports +@node Lexical Conventions, Syntax, Eval and Load, The Language +@section Lexical Conventions -@noindent -A @dfn{soft-port} is a port based on a vector of procedures capable of -accepting or delivering characters. It allows emulation of I/O ports. -@defun make-soft-port vector modes -Returns a port capable of receiving or delivering characters as -specified by the @var{modes} string (@pxref{Files and Ports, -open-file}). @var{vector} must be a vector of length 6. Its components -are as follows: +@menu +* Common-Lisp Read Syntax:: +* Load Syntax:: +* Documentation and Comments:: +* Modifying Read Syntax:: +@end menu -@enumerate 0 -@item -procedure accepting one character for output -@item -procedure accepting a string for output -@item -thunk for flushing output -@item -thunk for getting one character -@item -thunk for closing port (not by garbage collection) -@end enumerate +@node Common-Lisp Read Syntax, Load Syntax, Lexical Conventions, Lexical Conventions +@subsection Common-Lisp Read Syntax -For an output-only port only elements 0, 1, 2, and 4 need be -procedures. For an input-only port only elements 3 and 4 need be -procedures. Thunks 2 and 4 can instead be @code{#f} if there is no useful -operation for them to perform. +@deffn {Read syntax} #\token +If @var{token} is a sequence of two or more digits, then this syntax is +equivalent to @code{#.(integer->char (string->number token 8))}. -If thunk 3 returns @code{#f} or an @code{eof-object} (@pxref{Input, -eof-object?, ,r5rs, Revised(5) Scheme}) it indicates that the port has -reached end-of-file. For example: +If @var{token} is @code{C-}, @code{c-}, or @code{^} followed by a +character, then this syntax is read as a control character. If +@var{token} is @code{M-} or @code{m-} followed by a character, then a +meta character is read. @code{c-} and @code{m-} prefixes may be +combined. +@end deffn -If it is necessary to explicitly close the port when it is garbage -collected, (@pxref{Interrupts, add-finalizer}). +@deffn {Read syntax} #+ feature form +If feature is @code{provided?} (by @code{*features*}) then @var{form} is +read as a scheme expression. If not, then @var{form} is treated as +whitespace. -@example -(define stdout (current-output-port)) -(define p (make-soft-port - (vector - (lambda (c) (write c stdout)) - (lambda (s) (display s stdout)) - (lambda () (display "." stdout)) - (lambda () (char-upcase (read-char))) - (lambda () (display "@@" stdout))) - "rw")) +Feature is a boolean expression composed of symbols and @code{and}, +@code{or}, and @code{not} of boolean expressions. -(write p p) @result{} #<input-output-soft#\space45d10#\> +For more information on @code{provided?} and @code{*features*}, +@xref{Require, , , slib, SLIB}. +@end deffn + +@deffn {Read syntax} #- feature form +is equivalent to @code{#+(not feature) expression}. +@end deffn + +@deffn {Read syntax} #| any thing |# +Is a balanced comment. Everything up to the matching @code{|#} is +ignored by the @code{read}. Nested @code{#|@dots{}|#} can occur inside +@var{any thing}. +@end deffn + +@noindent +@dfn{Load sytax} is Read syntax enabled for @code{read} only when that +@code{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 @samp{#.}. + +@deffn {Load syntax} #. expression +Is read as the object resulting from the evaluation of @var{expression}. +This substitution occurs even inside quoted structure. + +In order to allow compiled code to work with @code{#.} it is good +practice to define those symbols used inside of @var{expression} with +@code{#.(define @dots{})}. For example: + +@example +#.(define foo 9) @result{} #<unspecified> +'(#.foo #.(+ foo foo)) @result{} (9 18) @end example -@end defun +@end deffn + +@deffn {Load syntax} #' form +is equivalent to @var{form} (for compatibility with common-lisp). +@end deffn + + +@node Load Syntax, Documentation and Comments, Common-Lisp Read Syntax, Lexical Conventions +@subsection Load Syntax + +@noindent +@dfn{#!} is the unix mechanism for executing scripts. +See @ref{Unix Scheme Scripts} for the full description of how this +comment supports scripting. -@node Syntax Extensions, Low Level Syntactic Hooks, Soft Ports, The Language -@section Syntax Extensions +@deffn {Load syntax} #?line +@deffnx {Load syntax} #?column +Return integers for the current line and column being read during a +load. +@end deffn + +@deffn {Load syntax} #?file +Returns the string naming the file currently being loaded. This path +is the string passed to @code{load}, possibly with @samp{.scm} +appended. +@end deffn + + + +@node Documentation and Comments, Modifying Read Syntax, Load Syntax, Lexical Conventions +@subsection Documentation and Comments @deffn {procedure} procedure-documentation proc Returns the documentation string of @var{proc} if it exists, or @@ -2992,69 +3157,91 @@ internal definitions) is a string, then that string is the @defun comment string1 @dots{} Appends @var{string1} @dots{} to the strings given as arguments to previous calls @code{comment}. + @defunx comment Returns the (appended) strings given as arguments to previous calls @code{comment} and empties the current string collection. @end defun -@deffn {Read syntax} #;text-till-end-of-line +@deffn {Load syntax} #;text-till-end-of-line Behaves as @code{(comment "@var{text-till-end-of-line}")}. @end deffn -@deffn {Read syntax} #. expression -Is read as the object resulting from the evaluation of @var{expression}. -This substitution occurs even inside quoted structure. -In order to allow compiled code to work with @code{#.} it is good -practice to define those symbols used inside of @var{expression} with -@code{#.(define @dots{})}. For example: -@example -#.(define foo 9) @result{} #<unspecified> -'(#.foo #.(+ foo foo)) @result{} (9 18) -@end example -@end deffn +@node Modifying Read Syntax, , Documentation and Comments, Lexical Conventions +@subsection Modifying Read Syntax -@deffn {Read syntax} #+ feature form -If feature is @code{provided?} (by @code{*features*}) then @var{form} is -read as a scheme expression. If not, then @var{form} is treated as -whitespace. - -Feature is a boolean expression composed of symbols and @code{and}, -@code{or}, and @code{not} of boolean expressions. +@deffn {Callback procedure} read:sharp c port +If a @key{#} followed by a character (for a non-standard syntax) is +encountered by @code{read}, @code{read} will call the value of the +symbol @code{read:sharp} with arguments the character and the port being +read from. The value returned by this function will be the value of +@code{read} for this expression unless the function returns +@code{#<unspecified>} in which case the expression will be treated as +whitespace. @code{#<unspecified>} is the value returned by the +expression @code{(if #f #f)}. -For more information on @code{provided?} and @code{*features*}, -@xref{Require, , , slib, SLIB}. +@deffnx {Callback procedure} load:sharp c port +Dispatches like @code{read:sharp}, but only during @code{load}s. The +read-syntaxes handled by @code{load:sharp} are a superset of those +handled by @code{read:sharp}. @code{load:sharp} calls +@code{read:sharp} if none of its syntaxes match @var{c}. @end deffn -@deffn {Read syntax} #- feature form -is equivalent to @code{#+(not feature) expression}. +@deffn {Callback procedure} char:sharp token +If the sequence @key{#\} followed by a non-standard character name is +encountered by @code{read}, @code{read} will call the value of the +symbol @code{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 @code{read} for this expression, otherwise an error +will be signaled. @end deffn -@deffn {Read syntax} #' form -is equivalent to @var{form} (for compatibility with common-lisp). -@end deffn +@emph{Note:} When adding new @key{#} syntaxes, have your code save the +previous value of @code{load:sharp}, @code{read:sharp}, or +@code{char:sharp} when defining it. Call this saved value if an +invocation's syntax is not recognized. This will allow @code{#+}, +@code{#-}, and @ref{Uniform Array}s to still be supported (as they +dispatch from @code{read:sharp}). -@deffn {Read syntax} #| any thing |# -Is a balanced comment. Everything up to the matching @code{|#} is -ignored by the @code{read}. Nested @code{#|@dots{}|#} can occur inside -@var{any thing}. -@end deffn -@noindent -A similar read syntax @dfn{#!} (exclamation rather than vertical bar) is -supported for Posix shell-scripts (@pxref{Scripting}). -@deffn {Read syntax} #\token -If @var{token} is a sequence of two or more digits, then this syntax is -equivalent to @code{#.(integer->char (string->number token 8))}. +@node Syntax, , Lexical Conventions, The Language +@section Syntax -If @var{token} is @code{C-}, @code{c-}, or @code{^} followed by a -character, then this syntax is read as a control character. If -@var{token} is @code{M-} or @code{m-} followed by a character, then a -meta character is read. @code{c-} and @code{m-} prefixes may be -combined. -@end deffn +SCM provides a native implementation of @dfn{defmacro}. +@xref{Defmacro, , , slib, SLIB}. + +When built with @samp{-F macro} build option (@pxref{Build Options}) and +@samp{*syntax-rules*} is non-false, SCM also supports [R5RS] +@code{syntax-rules} macros. @xref{Macros, , ,r5rs, Revised(5) Scheme}. + +Other Scheme Syntax Extension Packages from SLIB can be employed through +the use of @samp{macro:eval} and @samp{macro:load}; Or by using the SLIB +read-eval-print-loop: + +@example +(require 'repl) +(repl:top-level macro:eval) +@end example + +With the appropriate catalog entries +(@pxref{Library Catalogs, , , slib, SLIB}), files using macro +packages will automatically use the correct macro loader when +@samp{require}d. + +@menu +* Define and Set:: +* Defmacro:: +* Syntax-Rules:: +* Macro Primitives:: +* Environment Frames:: +* Syntactic Hooks for Hygienic Macros:: +@end menu + +@node Define and Set, Defmacro, Syntax, Syntax +@subsection Define and Set @defspec defined? symbol Equivalent to @code{#t} if @var{symbol} is a syntactic keyword (such as @@ -3069,7 +3256,7 @@ If @var{identifier} is unbound in the top level environment, then @var{initial-value} as if the @code{defvar} form were instead the form @code{(define identifier initial-value)} . If @var{identifier} already has a value, then @var{initial-value} is @emph{not} evaluated and -@var{identifier}'s value is not changed. @code{defconst} is valid only +@var{identifier}'s value is not changed. @code{defvar} is valid only when used at top-level. @end defspec @@ -3145,15 +3332,19 @@ expansion. @code{defconst} constants should be defined before use. (else 'consonant)) ==> consonant } @end format - @end defspec + + +@node Defmacro, Syntax-Rules, Define and Set, Syntax +@subsection Defmacro + @noindent @findex defmacro @findex macroexpand @findex macroexpand-1 @findex gentemp -SCM also supports the following constructs from Common Lisp: +SCM supports the following constructs from Common Lisp: @code{defmacro}, @code{macroexpand}, @code{macroexpand-1}, and @code{gentemp}. @xref{Defmacro, , , slib, SLIB}. @@ -3187,6 +3378,10 @@ For example: (let1 not legal syntax) @error{} not "does not match" ((name value)) @end lisp + +@node Syntax-Rules, Macro Primitives, Defmacro, Syntax +@subsection Syntax-Rules + @findex syntax-rules SCM supports [R5RS] @code{syntax-rules} macros @xref{Macros, , ,r5rs, Revised(5) Scheme}. @@ -3241,34 +3436,9 @@ For example: (set! eight 9) @result{} ERROR @end lisp -@node Low Level Syntactic Hooks, Syntactic Hooks for Hygienic Macros, Syntax Extensions, The Language -@section Low Level Syntactic Hooks - -@deffn {Callback procedure} read:sharp c port -If a @key{#} followed by a character (for a non-standard syntax) is -encountered by @code{read}, @code{read} will call the value of the -symbol @code{read:sharp} with arguments the character and the port being -read from. The value returned by this function will be the value of -@code{read} for this expression unless the function returns -@code{#<unspecified>} in which case the expression will be treated as -whitespace. @code{#<unspecified>} is the value returned by the -expression @code{(if #f #f)}. -@end deffn - -@deffn {Callback procedure} read:sharp-char token -If the sequence @key{#\} followed by a non-standard character name is -encountered by @code{read}, @code{read} will call the value of the -symbol @code{read:sharp-char} 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 @code{read} for this expression, otherwise an error -will be signaled. -@end deffn -@emph{Note:} When adding new @key{#} syntaxes, have your code save the -previous value of @code{read:sharp} or @code{read:sharp-char} when -defining it. Call this saved value if an invocation's syntax is not -recognized. This will allow @code{#+}, @code{#-}, @code{#!}, and -@ref{Uniform Array}s to still be supported (as they use @code{read:sharp}). +@node Macro Primitives, Environment Frames, Syntax-Rules, Syntax +@subsection Macro Primitives @defun procedure->syntax proc Returns a @dfn{macro} which, when a symbol defined to this value appears @@ -3310,6 +3480,10 @@ purpose may not result in @var{name} being interpreted as a macro keyword. @end defspec + +@node Environment Frames, Syntactic Hooks for Hygienic Macros, Macro Primitives, Syntax +@subsection Environment Frames + An @dfn{environment} is a list of frames representing lexical bindings. Only the names and scope of the bindings are included in environments passed to macro expanders -- run-time values are not included. @@ -3391,8 +3565,8 @@ Thus a mutable environment can be treated as both a list and local bindings. @end defspec -@node Syntactic Hooks for Hygienic Macros, , Low Level Syntactic Hooks, The Language -@section Syntactic Hooks for Hygienic Macros +@node Syntactic Hooks for Hygienic Macros, , Environment Frames, Syntax +@subsection Syntactic Hooks for Hygienic Macros SCM provides a synthetic identifier type for efficient implementation of hygienic macros (for example, @code{syntax-rules} @pxref{Macros, , , @@ -3432,7 +3606,8 @@ Returns the symbol obtained by recursively extracting the parent of @var{id}, which must be an identifier. @end defun -@subsection Use of synthetic identifiers +@subsection Use of Synthetic Identifiers + @code{renamed-identifier} may be used as a replacement for @code{gentemp}: @lisp (define gentemp @@ -3931,22 +4106,25 @@ is not real. @menu * Conventional Arrays:: -* Array Mapping:: array-for-each * Uniform Array:: * Bit Vectors:: +* Array Mapping:: array-for-each @end menu -@node Conventional Arrays, Array Mapping, Arrays, Arrays +@node Conventional Arrays, Uniform Array, Arrays, Arrays @subsection Conventional Arrays +The following syntax and procedures are SCM extensions to feature +@code{array} in @ref{Arrays, , , slib, SLIB}. + @dfn{Arrays} read and write as a @code{#} followed by the @dfn{rank} @cindex array (number of 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. @example -(make-array 'ho 3 3) @result{} -#2A((ho ho ho) (ho ho ho) (ho ho ho)) +(create-array '#(ho) 4 3) @result{} +#2A((ho ho ho) (ho ho ho) (ho ho ho) (ho ho ho)) @end example The rank may be elided, in which case it is read as one. @@ -3954,60 +4132,11 @@ The rank may be elided, in which case it is read as one. '#A(a b c) @equiv{} '#(a b c) @end example -Unshared conventional (not uniform) 0-based arrays of rank 1 (dimension) -are equivalent to (and can't be distinguished from) vectors. -@example -(make-array 'ho 3) @result{} #(ho ho ho) -@end example - -When constructing an array, @var{bound} is either an inclusive range of -indices expressed as a two element list, or an upper bound expressed -as a single integer. So -@example -(make-array 'foo 3 3) @equiv{} (make-array 'foo '(0 2) '(0 2)) -@end example - -@defun array? obj -Returns @code{#t} if the @var{obj} is an array, and @code{#f} if not. -@end defun - -@defun make-array initial-value bound1 bound2 @dots{} -Creates and returns an array that has as many dimensions as there are -@var{bound}s and fills it with @var{initial-value}. -@end defun - -@defun array-ref array index1 index2 @dots{} -Returns the @var{index1}, @var{index2}, @dots{}'th element of -@var{array}. -@end defun - -@defun array-in-bounds? array index1 index2 @dots{} -Returns @code{#t} if its arguments would be acceptable to @var{array-ref}. -@end defun - -@defun array-set! array new-value index1 index2 @dots{} -Sets the @var{index1}, @var{index2}, @dots{}'th element of @var{array} -to @var{new-value}. The value returned by @code{array-set!} is -unspecified. -@end defun - -@defun make-shared-array array mapper bound1 bound2 @dots{} -@code{make-shared-array} can be used to create shared subarrays of other -arrays. The @var{mapper} is a function that translates coordinates in -the new array into coordinates in the old array. A @var{mapper} must be -linear, and its range must stay within the bounds of the old array, but -it can be otherwise arbitrary. A simple example: +Unshared, conventional (not uniform) 0-based arrays of rank 1 are +equivalent to (and can't be distinguished from) scheme vectors. @example -(define fred (make-array #f 8 8)) -(define freds-diagonal - (make-shared-array fred (lambda (i) (list i i)) 8)) -(array-set! freds-diagonal 'foo 3) -(array-ref fred 3 3) @result{} foo -(define freds-center - (make-shared-array fred (lambda (i j) (list (+ 3 i) (+ 3 j))) 2 2)) -(array-ref freds-center 0 0) @result{} foo +(create-array '#(ho) 3) @result{} #(ho ho ho) @end example -@end defun @defun transpose-array array dim0 dim1 @dots{} Returns an array sharing contents with @var{array}, but with dimensions @@ -4055,132 +4184,26 @@ examples: @end example @end defun -@defun array-shape array -Returns a list of inclusive bounds of integers. -@example -(array-shape (make-array 'foo '(-1 3) 5)) @result{} ((-1 3) (0 4)) -@end example -@end defun - -@defun array-dimensions array -@code{Array-dimensions} is similar to @code{array-shape} but replaces -elements with a @code{0} minimum with one greater than the maximum. So: -@example -(array-dimensions (make-array 'foo '(-1 3) 5)) @result{} ((-1 3) 5) -@end example -@end defun - -@defun array-rank obj -Returns the number of dimensions of @var{obj}. If @var{obj} is not an -array, @code{0} is returned. -@end defun - @defun array->list array Returns a list consisting of all the elements, in order, of @var{array}. In the case of a rank-0 array, returns the single element. @end defun -@defun array-copy! source destination -Copies every element from vector or array @var{source} to the -corresponding element of @var{destination}. @var{destination} must have -the same rank as @var{source}, and be at least as large in each -dimension. The order of copying is unspecified. -@end defun - -@defun serial-array-copy! source destination -Same as @code{array-copy!} but guaranteed to copy in row-major order. -@end defun - -@defun array-fill! array fill -Stores @var{fill} in every element of @var{array}. The value returned -is unspecified. -@end defun - -@defun array-equal? array0 array1 @dots{} -Returns @code{#t} iff all arguments are arrays with the same shape, the -same type, and have corresponding elements which are either -@code{equal?} or @code{array-equal?}. This function differs from -@code{equal?} in that a one dimensional shared array may be -@var{array-equal?} but not @var{equal?} to a vector or uniform vector. -@end defun - @defun array-contents array @defunx array-contents array strict -If @var{array} may be @dfn{unrolled} into a one dimensional shared array -without changing their order (last subscript changing fastest), then -@code{array-contents} returns that shared array, otherwise it returns -@code{#f}. All arrays made by @var{make-array} and -@var{create-array} may be unrolled, some arrays made by -@var{make-shared-array} may not be. +If @var{array} may be @dfn{unrolled} into a one dimensional shared +array without changing their order (last subscript changing fastest), +then @code{array-contents} returns that shared array, otherwise it +returns @code{#f}. All arrays made by @var{create-array} may be +unrolled, some arrays made by @var{make-shared-array} may not be. If the optional argument @var{strict} is provided, a shared array will be returned only if its elements are stored internally contiguous in memory. @end defun -@node Array Mapping, Uniform Array, Conventional Arrays, Arrays -@subsection Array Mapping -@code{(require 'array-for-each)} -@ftindex array-for-each - -@defun array-map! array0 proc array1 @dots{} - -If @var{array1}, @dots{} are arrays, they must have the same number of -dimensions as @var{array0} and have a range for each index which -includes the range for the corresponding index in @var{array0}. -If they are scalars, that is, not arrays, vectors, or strings, then -they will be converted internally to arrays of the appropriate shape. -@var{proc} is applied to each tuple of elements of @var{array1} @dots{} -and the result is stored as the corresponding element in @var{array0}. -The value returned is unspecified. The order of application is -unspecified. - -@end defun - -@defun serial-array-map! array0 proc array1 @dots{} -Same as @var{array-map!}, but guaranteed to apply @var{proc} in -row-major order. -@end defun - -@defun array-for-each proc array0 @dots{} -@var{proc} is applied to each tuple of elements of @var{array0} @dots{} -in row-major order. The value returned is unspecified. -@end defun - -@defun array-index-map! array proc -applies @var{proc} to the indices of each element of @var{array} in -turn, storing the result in the corresponding element. The value -returned and the order of application are unspecified. - -One can implement @var{array-indexes} as -@example -(define (array-indexes array) - (let ((ra (apply make-array #f (array-shape array)))) - (array-index-map! ra (lambda x x)) - ra)) -@end example -Another example: -@example -(define (apl:index-generator n) - (let ((v (make-vector n 1))) - (array-index-map! v (lambda (i) i)) - v)) -@end example -@end defun - -@defun scalar->array scalar array prototype -Returns a uniform array of the same shape as @var{array}, having only -one shared element, which is @code{eqv?} to @var{scalar}. -If the optional argument @var{prototype} is supplied it will be used -as the prototype for the returned array. Otherwise the returned array -will be of the same type as @code{array} if that is possible, and -a conventional array if it is not. This function is used internally -by @code{array-map!} and friends to handle scalar arguments. -@end defun - - -@node Uniform Array, Bit Vectors, Array Mapping, Arrays +@node Uniform Array, Bit Vectors, Conventional Arrays, Arrays @subsection Uniform Array @noindent @@ -4260,19 +4283,6 @@ If @var{rank} is zero, @var{lst}, which need not be a list, is the single element of the returned array. @end defun -@defun uniform-vector-fill! uve fill -Stores @var{fill} in every element of @var{uve}. The value returned is -unspecified. -@end defun - -@defun dimensions->uniform-array dims prototype fill -@defunx dimensions->uniform-array dims prototype -Creates and returns a uniform array or vector of type corresponding to -@var{prototype} with dimensions @var{dims} or length @var{length}. If -the @var{fill} argument is supplied, the returned array is filled with -this value. -@end defun - @defun uniform-array-read! ura @defunx uniform-array-read! ura port Attempts to read all elements of @var{ura}, in lexicographic order, as @@ -4321,7 +4331,7 @@ if the array element is not an exact integer or if @var{val} is not boolean. @end defun -@node Bit Vectors, , Uniform Array, Arrays +@node Bit Vectors, Array Mapping, Uniform Array, Arrays @subsection Bit Vectors @noindent @@ -4370,6 +4380,74 @@ Returns @var{bv} is not modified. @end defun + +@node Array Mapping, , Bit Vectors, Arrays +@subsection Array Mapping + +@code{(require 'array-for-each)} +@ftindex array-for-each + +SCM has some extra functions in feature @code{array-for-each}: + +@defun array-fill! array fill +Stores @var{fill} in every element of @var{array}. The value returned +is unspecified. +@end defun + +@defun serial-array-copy! source destination +Same as @code{array-copy!} but guaranteed to copy in row-major order. +@end defun + +@defun array-equal? array0 array1 @dots{} +Returns @code{#t} iff all arguments are arrays with the same shape, the +same type, and have corresponding elements which are either +@code{equal?} or @code{array-equal?}. This function differs from +@code{equal?} in that a one dimensional shared array may be +@var{array-equal?} but not @var{equal?} to a vector or uniform vector. +@end defun + +@defun array-map! array0 proc array1 @dots{} +If @var{array1}, @dots{} are arrays, they must have the same number of +dimensions as @var{array0} and have a range for each index which +includes the range for the corresponding index in @var{array0}. If +they are scalars, that is, not arrays, vectors, or strings, then they +will be converted internally to arrays of the appropriate shape. +@var{proc} is applied to each tuple of elements of @var{array1} +@dots{} and the result is stored as the corresponding element in +@var{array0}. The value returned is unspecified. The order of +application is unspecified. + +Handling non-array arguments is a SCM extension of +@ref{Array Mapping, array-map!, , slib, SLIB} +@end defun + +@defun serial-array-map! array0 proc array1 @dots{} +Same as @var{array-map!}, but guaranteed to apply @var{proc} in +row-major order. +@end defun + +@defun array-map prototype proc array1 array2 @dots{} +@var{array2}, @dots{} must have the same number of dimensions as +@var{array1} and have a range for each index which includes the +range for the corresponding index in @var{array1}. @var{proc} is +applied to each tuple of elements of @var{array1}, @var{array2}, +@dots{} and the result is stored as the corresponding element in a +new array of type @var{prototype}. The new array is returned. The +order of application is unspecified. +@end defun + +@defun scalar->array scalar array prototype +@defunx scalar->array scalar array +Returns a uniform array of the same shape as @var{array}, having only +one shared element, which is @code{eqv?} to @var{scalar}. +If the optional argument @var{prototype} is supplied it will be used +as the prototype for the returned array. Otherwise the returned array +will be of the same type as @code{array} if that is possible, and +a conventional array if it is not. This function is used internally +by @code{array-map!} and friends to handle scalar arguments. +@end defun + + @node Records, I/O-Extensions, Arrays, Packages @section Records @@ -4498,12 +4576,11 @@ closed,, @code{closedir} returns a @code{#f}. @end defun @defun directory-for-each proc directory -The @var{list}s must be lists, and @var{proc} must be a procedure taking -one argument. @samp{Directory-For-Each} applies @var{proc} to the -(string) name of each file in @var{directory}. The dynamic order in -which @var{proc} is applied to the elements of the @var{list}s is -unspecified. The value returned by @samp{directory-for-each} is -unspecified. +@var{proc} must be a procedure taking one argument. +@samp{Directory-For-Each} applies @var{proc} to the (string) name of +each file in @var{directory}. The dynamic order in which @var{proc} is +applied to the filenames is unspecified. The value returned by +@samp{directory-for-each} is unspecified. @defunx directory-for-each proc directory pred Applies @var{proc} only to those filenames for which the procedure @@ -4515,7 +4592,7 @@ Applies @var{proc} only to those filenames for which (@pxref{Filenames, , , slib, SLIB}). @example -(require 'directory-for-each) +(require 'directory) (directory-for-each print "." "[A-Z]*.scm") @print{} "Init.scm" @@ -4657,6 +4734,8 @@ Interface, getenv, , slib, SLIB}). @node Posix Extensions, Unix Extensions, I/O-Extensions, Packages @section Posix Extensions +@cindex Posix +@cindex posix @noindent If @code{'posix} is provided (by linking in @file{posix.o}), the following functions are defined: @@ -4718,11 +4797,6 @@ Returns the process ID of the parent of the current process. For a process's own ID @xref{I/O-Extensions, getpid}. @end defun -@defun 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. -@end defun - @defun getuid Returns the real user ID of this process. @end defun @@ -4974,6 +5048,8 @@ string containing the file name of termainal device; otherwise @node Unix Extensions, Regular Expression Pattern Matching, Posix Extensions, Packages @section Unix Extensions +@cindex Unix +@cindex unix @noindent If @code{'unix} is provided (by linking in @file{unix.o}), the following functions are defined: @@ -5613,13 +5689,13 @@ to most of the C @dfn{socket} library. For more information on sockets, @xref{Sockets, , , libc, The GNU C Library Reference Manual}. @menu -* Host Data:: +* Host and Other Inquiries:: * Internet Addresses and Socket Names:: * Socket:: @end menu -@node Host Data, Internet Addresses and Socket Names, Sockets, Sockets -@subsection Host Data, Network, Protocol, and Service Inquiries +@node Host and Other Inquiries, Internet Addresses and Socket Names, Sockets, Sockets +@subsection Host and Other Inquiries @defvr Constant af_inet @defvrx Constant af_unix @@ -5728,7 +5804,7 @@ between calls to getserv. Otherwise, the table stays open. When called without an argument, the service table is closed. @end defun -@node Internet Addresses and Socket Names, Socket, Host Data, Sockets +@node Internet Addresses and Socket Names, Socket, Host and Other Inquiries, Sockets @subsection Internet Addresses and Socket Names @defun inet:string->address string @@ -6620,7 +6696,7 @@ synchronization object. @xref{Process Synchronization}. @end deftp @deftp smob tc16_macro -macro expanding function. @xref{Low Level Syntactic Hooks}. +macro expanding function. @xref{Macro Primitives}. @end deftp @deftp smob tc16_array @@ -6676,15 +6752,15 @@ contin .........long length....G0111101 .............*regs.............. specfun ................xxxxxxxxG1111111 ...........SCM name............. cclo ..short length..xxxxxx10G1111111 ...........SCM **elts...........} @r{ PTOBs:} -@t{ port 0bwroxxxxxxxxG0110111 ..........FILE *stream.......... - socket ttttttt 00001xxxxxxxxG0110111 ..........FILE *stream.......... - inport uuuuuuuuuuU00011xxxxxxxxG0110111 ..........FILE *stream.......... -outport 0000000000000101xxxxxxxxG0110111 ..........FILE *stream.......... - ioport uuuuuuuuuuU00111xxxxxxxxG0110111 ..........FILE *stream.......... -fport 00 00000000G0110111 ..........FILE *stream.......... -pipe 00 00000001G0110111 ..........FILE *stream.......... -strport 00 00000010G0110111 ..........FILE *stream.......... -sfport 00 00000011G0110111 ..........FILE *stream..........} +@t{ port int portnum.CwroxxxxxxxxG0110111 ..........FILE *stream.......... + socket int portnum.C001xxxxxxxxG0110111 ..........FILE *stream.......... + inport int portnum.C011xxxxxxxxG0110111 ..........FILE *stream.......... +outport int portnum.0101xxxxxxxxG0110111 ..........FILE *stream.......... + ioport int portnum.C111xxxxxxxxG0110111 ..........FILE *stream.......... +fport int portnum.C 00000000G0110111 ..........FILE *stream.......... +pipe int portnum.C 00000001G0110111 ..........FILE *stream.......... +strport 00000000000.0 00000010G0110111 ..........FILE *stream.......... +sfport int portnum.C 00000011G0110111 ..........FILE *stream..........} @r{ SUBRs:} @t{ spare 010001x1 spare 010011x1 @@ -6823,6 +6899,9 @@ object is freed. If the type header of smob is collected, the smob's @node Memory Management for Environments, Signals, Garbage Collection, Operations @subsection Memory Management for Environments +@ifset html +<A NAME="ecache"></A> +@end ifset @cindex memory management @cindex environments @cindex ecache @@ -6979,7 +7058,7 @@ that this constraint is satisfied @code{#define CAREFUL_INTS} in @subsection C Macros -@defmac ASSERT cond arg pos subr +@defmac ASRTER cond arg pos subr signals an error if the expression (@var{cond}) is 0. @var{arg} is the offending object, @var{subr} is the string naming the subr, and @var{pos} indicates the position or type of error. @var{pos} can be one @@ -7006,14 +7085,14 @@ of @item a C string @code{(char *)} @end itemize -Error checking is not done by @code{ASSERT} if the flag @code{RECKLESS} +Error checking is not done by @code{ASRTER} if the flag @code{RECKLESS} is defined. An error condition can still be signaled in this case with a call to @code{wta(arg, pos, subr)}. @end defmac @defmac ASRTGO cond label @code{goto} @var{label} if the expression (@var{cond}) is 0. Like -@code{ASSERT}, @code{ASRTGO} does is not active if the flag +@code{ASRTER}, @code{ASRTGO} does is not active if the flag @code{RECKLESS} is defined. @end defmac @@ -7049,13 +7128,21 @@ address of the local @code{SCM} variable to @emph{any} procedure also protects it. The procedure @code{scm_protect_temp} is provided for this purpose. +@deftypefun void scm_protect_temp (SCM *@var{ptr}) +Forces the SCM object @var{ptr} to be saved on the C-stack, where it +will be traced for GC. +@end deftypefun + @noindent Also, if you maintain a static pointer to some (non-immediate) @code{SCM} object, you must either make your pointer be the value cell -of a symbol (see @code{errobj} for an example) or make your pointer be -one of the @code{sys_protects} (see @code{dynwinds} for an example). -The former method is prefered since it does not require any changes to -the SCM distribution. +of a symbol (see @code{errobj} for an example) or (permanently) add +your pointer to @code{sys_protects} using: + +@deftypefun SCM scm_gc_protect (SCM @var{obj}) +Permanently adds @var{obj} to a table of objects protected from +garbage collection. @code{scm_gc_protect} returns @var{obj}. +@end deftypefun @noindent To add a C routine to scm: @@ -7178,7 +7265,8 @@ add @code{case:} clause to @code{ceval()} near @code{i_quasiquote} (in New syntax can now be added without recompiling SCM by the use of the @code{procedure->syntax}, @code{procedure->macro}, @code{procedure->memoizing-macro}, and @code{defmacro}. For details, -@xref{Syntax Extensions}. +@xref{Syntax}. + @node Defining Subrs, Defining Smobs, Changing Scm, Operations @subsection Defining Subrs @@ -7557,9 +7645,9 @@ Here is a minimal embedding program @file{libtest.c}: /* include patchlvl.h for SCM's INIT_FILE_NAME. */ #include "patchlvl.h" -void init_user_scm() +void libtest_init_user_scm() @{ - fputs("This is 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")); @} @@ -7578,6 +7666,7 @@ int main(argc, argv) SCM retval; char *implpath, *execpath; + 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); @@ -7593,7 +7682,7 @@ int main(argc, argv) @print{} dld_find_executable(./libtest): /home/jaffer/scm/libtest implpath: /home/jaffer/scm/Init@value{SCMVERSION}.scm -This is init_user_scm +This is libtest_init_user_scm hello world @end example @@ -7602,6 +7691,7 @@ hello world @subsection Callbacks @cindex callbacks +@cindex rope @noindent SCM now has routines to make calling back to Scheme procedures easier. The source code for these routines are found in @file{rope.c}. @@ -7653,9 +7743,12 @@ can use a wrapper like this for your Scheme procedures: @noindent Calls to procedures so wrapped will return even if an error occurs. + + @node Type Conversions, Continuations, Callbacks, Operations @subsection Type Conversions +@cindex rope These type conversion functions are very useful for connecting SCM and C code. Most are defined in @file{rope.c}. @@ -7672,19 +7765,21 @@ To convert integer numbers of smaller types (@code{short} or @deftypefun long num2long (SCM @var{num}, char *@var{pos}, char *@var{s_caller}) @deftypefunx unsigned long num2ulong (SCM @var{num}, char *@var{pos}, char *@var{s_caller}) +@deftypefunx short num2short (SCM @var{num}, char *@var{pos}, char *@var{s_caller}) @deftypefunx unsigned short num2ushort (SCM @var{num}, char *@var{pos}, char *@var{s_caller}) @deftypefunx unsigned char num2uchar (SCM @var{num}, char *@var{pos}, char *@var{s_caller}) +@deftypefunx double num2dbl (SCM @var{num}, char *@var{pos}, char *@var{s_caller}) These functions are used to check and convert @code{SCM} arguments to the named C type. The first argument @var{num} is checked to see it it is within the range of the destination type. If so, the converted -number is returned. If not, the @code{ASSERT} macro calls @code{wta} +number is returned. If not, the @code{ASRTER} macro calls @code{wta} with @var{num} and strings @var{pos} and @var{s_caller}. For a listing of useful predefined @var{pos} macros, @xref{C Macros}. -@emph{Note:} Inexact numbers are accepted only by @code{num2long} and -@code{num2ulong} (for when @code{SCM} is compiled without bignums). To -convert inexact numbers to exact numbers, @xref{Numerical operations, -inexact->exact, , r5rs, Revised(5) Scheme}. +@emph{Note:} Inexact numbers are accepted only by @code{num2dbl}, +@code{num2long}, and @code{num2ulong} (for when @code{SCM} is compiled +without bignums). To convert inexact numbers to exact numbers, +@xref{Numerical operations, inexact->exact, , r5rs, Revised(5) Scheme}. @end deftypefun @deftypefun unsigned long scm_addr (SCM @var{args}, char *@var{s_name}) @@ -7696,10 +7791,17 @@ any messages from error calls by @code{scm_addr}. @code{scm_addr} is useful for performing C operations on strings or other uniform arrays (@pxref{Uniform Array}). -@emph{Note:} While you use a pointer returned from @code{scm_addr} you -must keep a pointer to the associated @code{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. +@deftypefunx unsigned long scm_base_addr(SCM @var{ra}, char *@var{s_name}) +Returns a pointer (cast to an @code{unsigned long}) to the beginning +of storage of array @var{ra}. Note that if @var{ra} is a +shared-array, the strorage accessed this way may be much larger than +@var{ra}. + +@emph{Note:} While you use a pointer returned from @code{scm_addr} or +@code{scm_base_addr} you must keep a pointer to the associated +@code{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. @xref{Changing Scm, scm_gc_protect}. @end deftypefun @deftypefun SCM makfrom0str (char *@var{src}) @@ -8178,20 +8280,18 @@ the interpreter to instead always look up the values of the associated symbols. @end quotation +@item +Scott Schwartz <schwartz@@galapagos.cse.psu.edu> suggests: One way to +tidy up the dynamic loading stuff would be to grab the code from perl5. + @end itemize @menu -* Finishing Dynamic Linking:: +* VMS Dynamic Linking:: Finishing the job. @end menu -@node Finishing Dynamic Linking, , Improvements To Make, Improvements To Make -@subsection Finishing Dynamic Linking - -@noindent -Scott Schwartz <schwartz@@galapagos.cse.psu.edu> suggests: One way to -tidy up the dynamic loading stuff would be to grab the code from perl5. - -@subsubheading VMS +@node VMS Dynamic Linking, , Improvements To Make, Improvements To Make +@subsection VMS Dynamic Linking @noindent George Carrette (gjc@@mitech.com) outlines how to dynamically link on @@ -8329,113 +8429,6 @@ modify and relink @file{LISPLIB.EXE} without having to relink programs that have been linked against it. @end enumerate -@subsubheading Windows NT -@noindent -George Carrette (gjc@@mitech.com) outlines how to dynamically link on -Windows NT: - -@itemize @bullet -@item -The Software Developers Kit has a sample called SIMPLDLL. -Here is the gist of it, following along the lines of the VMS description -above (contents of a makefile for the SDK NMAKE) - -@format -@t{LISPLIB.exp: -LISPLIB.lib: LISPLIB.def - $(implib) -machine:$(CPU) -def:LISPLIB.def -out:LISPLIB.lib - -LISPLIB.DLL : $(LISPLIB_OBJS) LISPLIB.EXP - $(link) $(linkdebug) \ - -dll \ - -out:LISPLIB.DLL \ - LISPLIB.EXP $(LISPLIB_OBJS) $(conlibsdll)} -@end format - -@item -The @file{LISPDEF.DEF} file has this: - -@format -@t{LIBRARY lisplib -EXPORT - init_lisp - init_repl} -@end format - -@item -And @file{MAIN.EXE} using: - -@format -@t{CLINK = $(link) $(ldebug) $(conflags) -out:$*.exe $** $(conlibsdll) - -MAIN.EXE : MAIN.OBJ LISPLIB.LIB - $(CLINK)} -@end format - -@item -And @file{MYSUBRS.DLL} is produced using: - -@format -@t{mysubrs.exp: -mysubrs.lib: mysubrs.def - $(implib) -machine:$(CPU) -def:MYSUBRS.def -out:MYSUBRS.lib - -mysubrs.dll : mysubrs.obj mysubrs.exp mysubrs.lib - $(link) $(linkdebug) \ - -dll \ - -out:mysubrs.dll \ - MYSUBRS.OBJ MYSUBRS.EXP LISPLIB.LIB $(conlibsdll)} -@end format - -@item -Where @file{MYSUBRS.DEF} has - -@format -@t{LIBRARY mysubrs -EXPORT - INIT_MYSUBRS} -@end format - -@item -And the dynamic loader looks something like this, calling the two -procedures @code{LoadLibrary} and @code{GetProcAddress}. - -@format -@t{LISP share_image_load(LISP fname) -@{long iflag; - LISP retval,(*fcn)(void); - HANDLE hLib; - DWORD err; - char *libname,fcnname[64]; - iflag = nointerrupt(1); - libname = c_string(fname); - _snprintf(fcnname,sizeof(fcnname),"INIT_%s",libname); - if (!(hLib = LoadLibrary(libname))) - @{err = GetLastError(); - retval = list2(fname,LSPNUM(err)); - serror1("library failed to load",retval);@} - if (!(fcn = (LISP (*)(void)) GetProcAddress(hLib,fcnname))) - @{err = GetLastError(); - retval = list2(fname,LSPNUM(err)); - serror1("could not find library init procedure",retval);@} - retval = (*fcn)(); - nointerrupt(iflag); - return(retval);@}} -@end format - -@item -@emph{Note:} in VMS the linker and dynamic loader is case sensitive, but -all the language compilers, including C, will by default upper-case -external symbols for use by the linker, although the debugger gets its -own symbols and case sensitivity is language mode dependant. In Windows -NT things are case sensitive generally except for file and device names, -which are case canonicalizing like in the Symbolics filesystem. - -@item -@emph{Also:} All this WINDOWS NT stuff will work in MS-DOS MS-Windows -3.1 too, by a method of compiling and linking under Windows NT, and then -copying various files over to MS-DOS/WINDOWS. -@end itemize @node Index, , The Implementation, Top diff --git a/scm5d6.info b/scm5d6.info deleted file mode 100644 index 7dbf40d..0000000 --- a/scm5d6.info +++ /dev/null @@ -1,8382 +0,0 @@ -This is scm.info, produced by makeinfo version 4.3 from scm.texi. - -INFO-DIR-SECTION The Algorithmic Language Scheme -START-INFO-DIR-ENTRY -* SCM: (scm). A Scheme interpreter. -END-INFO-DIR-ENTRY - - -File: scm.info, Node: Top, Next: Overview, Prev: (dir), Up: (dir) - -This manual documents the SCM Scheme implementation. SCM version -5d6 was released May 2002. The most recent information about SCM can -be found on SCM's "WWW" home page: - - <http://swissnet.ai.mit.edu/~jaffer/SCM.html> - -Copyright (C) 1990-1999 Free Software Foundation - -Permission is granted to make and distribute verbatim copies of this -manual provided the copyright notice and this permission notice are -preserved on all copies. - -Permission is granted to copy and distribute modified versions of this -manual under the conditions for verbatim copying, provided that the -entire resulting derived work is distributed under the terms of a -permission notice identical to this one. - -Permission is granted to copy and distribute translations of this manual -into another language, under the above conditions for modified versions, -except that this permission notice may be stated in a translation -approved by the author. - -* Menu: - -* Overview:: -* Installing SCM:: -* Operational Features:: -* The Language:: Reference. -* Packages:: Optional Capabilities. -* The Implementation:: How it works. -* Index:: - - -File: scm.info, Node: Overview, Next: Installing SCM, Prev: Top, Up: Top - -Overview -******** - -Scm is a portable Scheme implementation written in C. Scm provides a -machine independent platform for [JACAL], a symbolic algebra system. - -* Menu: - -* SCM Features:: -* SCM Authors:: -* Copying:: -* Bibliography:: - - -File: scm.info, Node: SCM Features, Next: SCM Authors, Prev: Overview, Up: Overview - -Features -======== - - * Conforms to Revised^5 Report on the Algorithmic Language Scheme - [R5RS] and the [IEEE] P1178 specification. - - * Support for [SICP], [R2RS], [R3RS], and [R5RS] scheme code. - - * Runs under Amiga, Atari-ST, MacOS, MS-DOS, OS/2, NOS/VE, Unicos, - VMS, Unix and similar systems. Supports ASCII and EBCDIC - character sets. - - * Is fully documented in TeXinfo form, allowing documentation to be - generated in info, TeX, html, nroff, and troff formats. - - * Supports inexact real and complex numbers, 30 bit immediate - integers and large precision integers. - - * 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 emulation ports. - I/O extensions providing ANSI C and POSIX.1 facilities. - - * Interfaces to standard libraries including REGEX string regular - expression matching and the CURSES screen management package. - - * Available add-on packages including an interactive debugger, - database, X-window graphics, BGI graphics, Motif, and Open-Windows - packages. - - * A compiler (HOBBIT, available separately) and dynamic linking of - compiled modules. - - * User definable responses to interrupts and errors, - Process-syncronization primitives. Setable levels of monitoring - and timing information printed interactively (the `verbose' - function). `Restart', `quit', and `exec'. - - -File: scm.info, Node: SCM Authors, Next: Copying, Prev: SCM Features, Up: Overview - -Authors -======= - -Aubrey Jaffer (jaffer @ alum.mit.edu) - Most of SCM. - -Radey Shouman - Arrays, `gsubr's, compiled closures, records, Ecache, syntax-rules - macros, and "safeport"s. - -Jerry D. Hedden - Real and Complex functions. Fast mixed type arithmetics. - -Hugh Secker-Walker - Syntax checking and memoization of special forms by evaluator. - Storage allocation strategy and parameters. - -George Carrette - "Siod", written by George Carrette, was the starting point for SCM. - The major innovations taken from Siod are the evaluator's use of - the C-stack and being able to garbage collect off the C-stack - (*note Garbage Collection::). - -There are many other contributors to SCM. They are acknowledged in the -file `ChangeLog', a log of changes that have been made to scm. - - -File: scm.info, Node: Copying, Next: Bibliography, Prev: SCM Authors, Up: Overview - -Copyright -========= - -Authors have assigned their SCM copyrights to: - - Free Software Foundation, Inc. - 59 Temple Place, Suite 330, Boston, MA 02111, USA - -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 -both that copyright notice and this permission notice appear in -supporting documentation. - - NO WARRANTY - -BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR -THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN -OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES -PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER -EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED -WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE -ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH -YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL -NECESSARY SERVICING, REPAIR OR CORRECTION. - -IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING -WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR -REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR -DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL -DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM -(INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED -INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF -THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR -OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. - -SIOD copyright -============== - - - COPYRIGHT (c) 1989 BY - PARADIGM ASSOCIATES INCORPORATED, CAMBRIDGE, MASSACHUSETTS. - ALL RIGHTS RESERVED - -Permission to use, copy, modify, distribute and sell this software and -its documentation for any purpose and without fee is hereby granted, -provided that the above copyright notice appear in all copies and that -both that copyright notice and this permission notice appear in -supporting documentation, and that the name of Paradigm Associates Inc -not be used in advertising or publicity pertaining to distribution of -the software without specific, written prior permission. - -PARADIGM DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, -INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, IN NO -EVENT SHALL PARADIGM BE LIABLE FOR ANY SPECIAL, INDIRECT OR -CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF -USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR -OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR -PERFORMANCE OF THIS SOFTWARE. - -gjc@paradigm.com - Phone: 617-492-6079 - -Paradigm Associates Inc -29 Putnam Ave, Suite 6 -Cambridge, MA 02138 - - -File: scm.info, Node: Bibliography, Prev: Copying, Up: Overview - -Bibliography -============ - -[IEEE] - `IEEE Standard 1178-1990. IEEE Standard for the Scheme - Programming Language.' IEEE, New York, 1991. - -[R4RS] - William Clinger and Jonathan Rees, Editors. Revised(4) Report on - the Algorithmic Language Scheme. `ACM Lisp Pointers' Volume IV, - Number 3 (July-September 1991), pp. 1-55. - - *Note Top: (r4rs)Top. - -[R5RS] - Richard Kelsey and William Clinger and Jonathan (Rees, editors) - Revised(5) Report on the Algorithmic Language Scheme. - `Higher-Order and Symbolic Computation' Volume 11, Number 1 (1998), - pp. 7-105, and `ACM SIGPLAN Notices' 33(9), September 1998. - - *Note Top: (r5rs)Top. - -[Exrename] - William Clinger Hygienic Macros Through Explicit Renaming `Lisp - Pointers' Volume IV, Number 4 (December 1991), pp 17-23. - -[SICP] - Harold Abelson and Gerald Jay Sussman with Julie Sussman. - `Structure and Interpretation of Computer Programs.' MIT Press, - Cambridge, 1985. - -[Simply] - Brian Harvey and Matthew Wright. `Simply Scheme: Introducing - Computer Science' MIT Press, 1994 ISBN 0-262-08226-8 - -[SchemePrimer] - $B8$;tBg(B(Dai Inukai) `$BF~Lg(BScheme' - 1999$BG/(B12$B7n=iHG(B ISBN4-87966-954-7 - -[SLIB] - Todd R. Eigenschink, Dave Love, and Aubrey Jaffer. SLIB, The - Portable Scheme Library. Version 2c8, June 2000. - - *Note Top: (slib)Top. - -[JACAL] - Aubrey Jaffer. JACAL Symbolic Mathematics System. Version 1b0, - Sep 1999. - - *Note Top: (jacal)Top. - -`scm.texi' -`scm.info' - Documentation of `scm' extensions (beyond Scheme standards). - Documentation on the internal representation and how to extend or - include `scm' in other programs. - -`Xlibscm.texi' -`Xlibscm.info' - Documentation of the Xlib - SCM Language X Interface. - - -File: scm.info, Node: Installing SCM, Next: Operational Features, Prev: Overview, Up: Top - -Installing SCM -************** - -* Menu: - -* Making SCM:: Bootstrapping. -* SLIB:: REQUIREd reading. -* Building SCM:: -* Installing Dynamic Linking:: -* Configure Module Catalog:: -* Saving Images:: Make Fast-Booting Executables -* Automatic C Preprocessor Definitions:: -* Problems Compiling:: -* Problems Linking:: -* Problems Running:: -* Testing:: -* Reporting Problems:: - - -File: scm.info, Node: Making SCM, Next: SLIB, Prev: Installing SCM, Up: Installing SCM - -Making SCM -========== - -The SCM distribution has "Makefile" which contains rules for making -"scmlit", a "bare-bones" version of SCM sufficient for running `build'. -`build' is used to compile (or create scripts to compile) full -featured versions. - -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://swissnet.ai.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 - to build SCM; - - * Use another implementation of Scheme to run `build' to create a - script to build SCM; - - * Create your own script or `Makefile'. - - -File: scm.info, Node: SLIB, Next: Building SCM, Prev: Making SCM, Up: Installing SCM - -SLIB -==== - -[SLIB] is a portable Scheme library meant to provide compatibility and -utility functions for all standard Scheme implementations. Although -SLIB is not _neccessary_ to run SCM, I strongly suggest you obtain and -install it. Bug reports about running SCM without SLIB have very low -priority. SLIB is available from the same sites as SCM: - - * swissnet.ai.mit.edu:/pub/scm/slib2d4.tar.gz - - * ftp.gnu.org:/pub/gnu/jacal/slib2d4.tar.gz - - * ftp.cs.indiana.edu:/pub/scheme-repository/imp/slib2d4.tar.gz - -Unpack SLIB (`tar xzf slib2d4.tar.gz' or `unzip -ao slib2d4.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 `Init5d6.scm' is -installed). `require.scm' should have the contents: - - (define (library-vicinity) "/usr/local/lib/slib/") - (load (in-vicinity (library-vicinity) "require")) - -where the pathname string `/usr/local/lib/slib/' is to be replaced by -the pathname into which you installed SLIB. Absolute pathnames are -recommended here; if you use a relative pathname, SLIB can get confused -when the working directory is changed (*note chmod: I/O-Extensions.). -The way to specify a relative pathname is to append it to the -implementation-vicinity, which is absolute: - - (define library-vicinity - (let ((lv (string-append (implementation-vicinity) "../slib/"))) - (lambda () lv))) - (load (in-vicinity (library-vicinity) "require")) - -Alternatively, you can set the (shell) environment variable -`SCHEME_LIBRARY_PATH' to the pathname of the SLIB directory (*note -SCHEME_LIBRARY_PATH: SCM Variables.). If set, the environment variable -overrides `require.scm'. Again, absolute pathnames are recommended. - - -File: scm.info, Node: Building SCM, Next: Installing Dynamic Linking, Prev: SLIB, Up: Installing SCM - -Building SCM -============ - -The file "build" loads the file "build.scm", which constructs a -relational database of how to compile and link SCM executables. -`build.scm' has information for the platforms which SCM has been ported -to (of which I have been notified). Some of this information is old, -incorrect, or incomplete. Send corrections and additions to jaffer @ -ai.mit.edu. - -* Menu: - -* Invoking Build:: -* Build Options:: -* Compiling and Linking Custom Files:: - - -File: scm.info, Node: Invoking Build, Next: Build Options, Prev: Building SCM, Up: Building SCM - -Invoking Build --------------- - -The _all_ method will also work for MS-DOS and unix. Use the _all_ -method if you encounter problems with `build'. - -MS-DOS - From the SCM source directory, type `build' followed by up to 9 - command line arguments. - -unix - From the SCM source directory, type `./build' followed by command - line arguments. - -_all_ - From the SCM source directory, start `scm' or `scmlit' and type - `(load "build")'. Alternatively, start `scm' or `scmlit' with the - command line argument `-ilbuild'. - -Invoking build without the `-F' option will build or create a shell -script with the `arrays', `inexact', and `bignums' options as defaults. - - bash$ ./build - -| - #! /bin/sh - # unix (linux) script created by SLIB/batch - # ================ Write file with C defines - rm -f scmflags.h - echo '#define IMPLINIT "Init5d6.scm"'>>scmflags.h - echo '#define BIGNUMS'>>scmflags.h - echo '#define FLOATS'>>scmflags.h - echo '#define ARRAYS'>>scmflags.h - # ================ Compile C source files - gcc -O2 -c continue.c scm.c scmmain.c findexec.c script.c time.c repl.c scl.c eval.c sys.c subr.c debug.c unif.c rope.c - # ================ Link C object files - gcc -rdynamic -o scm continue.o scm.o scmmain.o findexec.o script.o time.o repl.o scl.o eval.o sys.o subr.o debug.o unif.o rope.o -lm -lc - -To cross compile for another platform, invoke build with the `-p' or -`--platform=' option. This will create a script for the platform named -in the `-p' or `--platform=' option. - - bash$ ./build -o scmlit -p darwin -F lit - -| - #! /bin/sh - # unix (darwin) script created by SLIB/batch - # ================ Write file with C defines - rm -f scmflags.h - echo '#define IMPLINIT "Init5d6.scm"'>>scmflags.h - # ================ Compile C source files - cc -O3 -c continue.c scm.c scmmain.c findexec.c script.c time.c repl.c scl.c eval.c sys.c subr.c debug.c unif.c rope.c - # ================ Link C object files - mv -f scmlit scmlit~ - cc -o scmlit continue.o scm.o scmmain.o findexec.o script.o time.o repl.o scl.o eval.o sys.o subr.o debug.o unif.o rope.o - - -File: scm.info, Node: Build Options, Next: Compiling and Linking Custom Files, Prev: Invoking Build, Up: Building SCM - -Build Options -------------- - -The options to "build" specify what, where, and how to build a SCM -program or dynamically linked module. These options are unrelated to -the SCM command line options. - - - Build Option: -p PLATFORM-NAME - - Build Option: --platform=PLATFORM-NAME - specifies that the compilation should be for a - computer/operating-system combination called PLATFORM-NAME. - _Note:_ The case of PLATFORM-NAME is distinguised. The current - PLATFORM-NAMEs are all lower-case. - - The platforms defined by table "platform" in `build.scm' are: - - Table: platform - name processor operating-system compiler - #f processor-family operating-system #f - symbol processor-family operating-system symbol - symbol atom symbol symbol - ================= ================= ================= ================= - *unknown* *unknown* unix cc - acorn-unixlib acorn *unknown* cc - aix powerpc aix cc - alpha alpha osf1 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 8086 ms-dos bcc - cygwin32 i386 unix gcc - darwin powerpc unix cc - djgpp i386 ms-dos gcc - freebsd i386 unix cc - gcc *unknown* 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 8086 ms-dos cl - microsoft-c-nt i386 ms-dos cl - microsoft-quick-c 8086 ms-dos qcl - ms-dos 8086 ms-dos cc - openbsd *unknown* unix gcc - os/2-cset i386 os/2 icc - os/2-emx i386 os/2 gcc - sunos sparc sunos cc - svr4 *unknown* unix cc - svr4-gcc-sun-ld sparc sunos gcc - turbo-c 8086 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: -o FILENAME - - Build Option: --outname=FILENAME - specifies that the compilation should produce an executable or - object name of FILENAME. The default is `scm'. Executable - suffixes will be added if neccessary, e.g. `scm' => `scm.exe'. - - - Build Option: -l LIBNAME ... - - Build Option: --libraries=LIBNAME - specifies that the LIBNAME should be linked with the executable - produced. If compile flags or include directories (`-I') are - needed, they are automatically supplied for compilations. The `c' - library is always included. SCM "features" specify any libraries - they need; so you shouldn't need this option often. - - - Build Option: -D DEFINITION ... - - Build Option: --defines=DEFINITION - specifies that the DEFINITION should be made in any C source - compilations. If compile flags or include directories (`-I') are - needed, they are automatically supplied for compilations. SCM - "features" specify any flags they need; so you shouldn't need this - option often. - - - Build Option: --compiler-options=FLAG - specifies that that FLAG will be put on compiler command-lines. - - - Build Option: --linker-options=FLAG - specifies that that FLAG will be put on linker command-lines. - - - Build Option: -s PATHNAME - - Build Option: --scheme-initial=PATHNAME - specifies that PATHNAME should be the default location of the SCM - initialization file `Init5d6.scm'. SCM tries several likely - locations before resorting to PATHNAME (*note File-System - Habitat::). If not specified, the current directory (where build - is building) is used. - - - Build Option: -c PATHNAME ... - - Build Option: --c-source-files=PATHNAME - specifies that the C source files PATHNAME ... are to be compiled. - - - Build Option: -j PATHNAME ... - - Build Option: --object-files=PATHNAME - specifies that the object files PATHNAME ... are to be linked. - - - Build Option: -i CALL ... - - Build Option: --initialization=CALL - specifies that the C functions CALL ... are to be invoked during - initialization. - - - Build Option: -t BUILD-WHAT - - Build Option: --type=BUILD-WHAT - specifies in general terms what sort of thing to build. The - choices are: - `exe' - executable program. - - `lib' - library module. - - `dlls' - archived dynamically linked library object files. - - `dll' - dynamically linked library object file. - - The default is to build an executable. - - - Build Option: -h BATCH-SYNTAX - - Build Option: -batch-dialect=BATCH-SYNTAX - specifies how to build. The default is to create a batch file for - the host system. The SLIB file `batch.scm' knows how to create - batch files for: - * unix - - * dos - - * vms - - * amigaos (was amigados) - - * system - - This option executes the compilation and linking commands - through the use of the `system' procedure. - - * *unknown* - - This option outputs Scheme code. - - - Build Option: -w BATCH-FILENAME - - Build Option: -script-name=BATCH-FILENAME - specifies where to write the build script. The default is to - display it on `(current-output-port)'. - - - Build Option: -F FEATURE ... - - Build Option: --features=FEATURE - specifies to build the given features into the executable. The - defined features are: - - "array" - Alias for ARRAYS - - "array-for-each" - array-map! and array-for-each (arrays must also be featured). - - "arrays" - Use if you want arrays, uniform-arrays and uniform-vectors. - - "bignums" - Large precision integers. - - "careful-interrupt-masking" - Define this for extra checking of interrupt masking and some - simple checks for proper use of malloc and free. This is for - debugging C code in `sys.c', `eval.c', `repl.c' and makes the - interpreter several times slower than usual. - - "cautious" - Normally, the number of arguments arguments to interpreted - closures (from LAMBDA) are checked if the function part of a - form is not a symbol or only the first time the form is - executed if the function part is a symbol. defining - `reckless' disables any checking. If you want to have SCM - always check the number of arguments to interpreted closures - define feature `cautious'. - - "cheap-continuations" - If you only need straight stack continuations, executables - compile with this feature will run faster and use less - storage than not having it. Machines with unusual stacks - _need_ this. Also, if you incorporate new C code into scm - which uses VMS system services or library routines (which - need to unwind the stack in an ordrly manner) you may need to - use this feature. - - "compiled-closure" - Use if you want to use compiled closures. - - "curses" - For the "curses" screen management package. - - "debug" - Turns on the features `cautious', - `careful-interrupt-masking', and `stack-limit'; uses `-g' - flags for debugging SCM source code. - - "dump" - Convert a running scheme program into an executable file. - - "dynamic-linking" - Be able to load compiled files while running. - - "edit-line" - interface to the editline or GNU readline library. - - "engineering-notation" - Use if you want floats to display in engineering notation - (exponents always multiples of 3) instead of scientific - notation. - - "generalized-c-arguments" - `make_gsubr' for arbitrary (< 11) arguments to C functions. - - "i/o-extensions" - Commonly available I/O extensions: "exec", line I/O, file - positioning, file delete and rename, and directory functions. - - "inexact" - Use if you want floating point numbers. - - "lit" - Lightweight - no features - - "macro" - C level support for hygienic and referentially transparent - macros (syntax-rules macros). - - "mysql" - Client connections to the mysql databases. - - "no-heap-shrink" - Use if you want segments of unused heap to not be freed up - after garbage collection. This may increase time in GC for - *very* large working sets. - - "none" - No features - - "posix" - Posix functions available on all "Unix-like" systems. fork - and process functions, user and group IDs, file permissions, - and "link". - - "reckless" - If your scheme code runs without any errors you can disable - almost all error checking by compiling all files with - `reckless'. - - "record" - The Record package provides a facility for user to define - their own record data types. See SLIB for documentation. - - "regex" - String regular expression matching. - - "rev2-procedures" - These procedures were specified in the `Revised^2 Report on - Scheme' but not in `R4RS'. - - "sicp" - Use if you want to run code from: - - Harold Abelson and Gerald Jay Sussman with Julie Sussman. - `Structure and Interpretation of Computer Programs.' The MIT - Press, Cambridge, Massachusetts, USA, 1985. - - Differences from R5RS are: - * (eq? '() '#f) - - * (define a 25) returns the symbol a. - - * (set! a 36) returns 36. - - "single-precision-only" - Use if you want all inexact real numbers to be single - precision. This only has an effect if SINGLES is also - defined (which is the default). This does not affect complex - numbers. - - "socket" - BSD "socket" interface. - - "stack-limit" - Use to enable checking for stack overflow. Define value of - the C preprocessor variable STACK_LIMIT to be the size to - which SCM should allow the stack to grow. STACK_LIMIT should - be less than the maximum size the hardware can support, as - not every routine checks the stack. - - "tick-interrupts" - Use if you want the ticks and ticks-interrupt functions. - - "turtlegr" - "Turtle" graphics calls for both Borland-C and X11 from - sjm@ee.tut.fi. - - "unix" - Those unix features which have not made it into the Posix - specs: nice, acct, lstat, readlink, symlink, mknod and sync. - - "windows" - Microsoft Windows executable. - - "x" - Alias for Xlib feature. - - "xlib" - Interface to Xlib graphics routines. - - - -File: scm.info, Node: Compiling and Linking Custom Files, Prev: Build Options, Up: Building SCM - -Compiling and Linking Custom Files ----------------------------------- - -A correspondent asks: - - How can we link in our own c files to the SCM interpreter so that - we can add our own functionality? (e.g. we have a bunch of tcp - functions we want access to). Would this involve changing - build.scm or the Makefile or both? - -(*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: - - bash$ build -c foo.c -i init_foo - -| - #! /bin/sh - rm -f scmflags.h - echo '#define IMPLINIT "/home/jaffer/scm/Init5d6.scm"'>>scmflags.h - echo '#define COMPILED_INITS init_foo();'>>scmflags.h - echo '#define BIGNUMS'>>scmflags.h - echo '#define FLOATS'>>scmflags.h - echo '#define ARRAYS'>>scmflags.h - gcc -O2 -c continue.c scm.c findexec.c script.c time.c repl.c scl.c \ - eval.c sys.c subr.c unif.c rope.c foo.c - gcc -rdynamic -o scm continue.o scm.o findexec.o script.o time.o \ - repl.o scl.o eval.o sys.o subr.o unif.o rope.o foo.o -lm -lc - -To make a dynamically loadable object file use the `-t dll' option: - - bash$ build -t dll -c foo.c - -| - #! /bin/sh - rm -f scmflags.h - echo '#define IMPLINIT "/home/jaffer/scm/Init5d6.scm"'>>scmflags.h - echo '#define BIGNUMS'>>scmflags.h - echo '#define FLOATS'>>scmflags.h - echo '#define ARRAYS'>>scmflags.h - echo '#define DLL'>>scmflags.h - gcc -O2 -fpic -c foo.c - gcc -shared -o foo.so foo.o -lm -lc - -Once `foo.c' compiles correctly (and your SCM build supports -dynamic-loading), you can load the compiled file with the Scheme command -`(load "./foo.so")'. See *Note Configure Module Catalog:: for how to -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 - -Installing Dynamic Linking -========================== - -Dynamic linking has not been ported to all platforms. Operating systems -in the BSD family (a.out binary format) can usually be ported to "DLD". -The "dl" library (`#define SUN_DL' for SCM) was a proposed POSIX -standard and may be available on other machines with "COFF" binary -format. For notes about porting to MS-Windows and finishing the port -to VMS *Note Finishing Dynamic Linking::. - -"DLD" is a library package of C functions that performs "dynamic link -editing" on Linux, VAX (Ultrix), Sun 3 (SunOS 3.4 and 4.0), -SPARCstation (SunOS 4.0), Sequent Symmetry (Dynix), and Atari ST. It is -available from: - - * ftp.gnu.org:pub/gnu/dld-3.3.tar.gz - -These notes about using libdl on SunOS are from `gcc.info': - - On a Sun, linking using GNU CC fails to find a shared library and - reports that the library doesn't exist at all. - - This happens if you are using the GNU linker, because it does only - static linking and looks only for unshared libraries. If you have - a shared library with no unshared counterpart, the GNU linker - won't find anything. - - We hope to make a linker which supports Sun shared libraries, but - please don't ask when it will be finished-we don't know. - - Sun forgot to include a static version of `libdl.a' with some - versions of SunOS (mainly 4.1). This results in undefined symbols - when linking static binaries (that is, if you use `-static'). If - you see undefined symbols `_dlclose', `_dlsym' or `_dlopen' when - linking, compile and link against the file `mit/util/misc/dlsym.c' - from the MIT version of X windows. - - -File: scm.info, Node: Configure Module Catalog, Next: Saving Images, Prev: Installing Dynamic Linking, Up: Installing SCM - -Configure Module Catalog -======================== - -The SLIB module "catalog" can be extended to define other -`require'-able packages by adding calls to the Scheme source file -`mkimpcat.scm'. Within `mkimpcat.scm', the following procedures are -defined. - - - Function: add-link feature object-file lib1 ... - FEATURE should be a symbol. OBJECT-FILE should be a string naming - a file containing compiled "object-code". Each LIBn argument - should be either a string naming a library file or `#f'. - - If OBJECT-FILE exists, the `add-link' procedure registers symbol - FEATURE so that the first time `require' is called with the symbol - FEATURE as its argument, OBJECT-FILE and the LIB1 ... are - dynamically linked into the executing SCM session. - - If OBJECT-FILE exists, `add-link' returns `#t', otherwise it - returns `#f'. - - For example, to install a compiled dll `foo', add these lines to - `mkimpcat.scm': - - (add-link 'foo - (in-vicinity (implementation-vicinity) "foo" - link:able-suffix)) - - - - Function: add-alias alias feature - ALIAS and FEATURE are symbols. The procedure `add-alias' - registers ALIAS as an alias for FEATURE. An unspecified value is - returned. - - `add-alias' causes `(require 'ALIAS)' to behave like `(require - 'FEATURE)'. - - - Function: add-source feature filename - FEATURE is a symbol. FILENAME is a string naming a file - containing Scheme source code. The procedure `add-source' - registers FEATURE so that the first time `require' is called with - the symbol FEATURE as its argument, the file FILENAME will be - `load'ed. An unspecified value is returned. - -Remember to delete the file `slibcat' after modifying the file -`mkimpcat.scm' in order to force SLIB to rebuild its cache. - - -File: scm.info, Node: Saving Images, Next: Automatic C Preprocessor Definitions, Prev: Configure Module Catalog, Up: Installing SCM - -Saving Images -============= - -In SCM, the ability to save running program images is called "dump" -(*note Dump::). In order to make `dump' available to SCM, build with -feature `dump'. `dump'ed executables are compatible with dynamic -linking. - -Most of the code for "dump" is taken from `emacs-19.34/src/unex*.c'. -No modifications to the emacs source code were required to use -`unexelf.c'. Dump has not been ported to all platforms. If `unexec.c' -or `unexelf.c' don't work for you, try using the appropriate `unex*.c' -file from emacs. - - -File: scm.info, Node: Automatic C Preprocessor Definitions, Next: Problems Compiling, Prev: Saving Images, Up: Installing SCM - -Automatic C Preprocessor Definitions -==================================== - -These `#defines' are automatically provided by preprocessors of various -C compilers. SCM uses the presence or absence of these definitions to -configure "include file" locations and aliases for library functions. -If the definition(s) corresponding to your system type is missing as -your system is configured, add `-DFLAG' to the compilation command -lines or add a `#define FLAG' line to `scmfig.h' or the beginning of -`scmfig.h'. - - #define Platforms: - ------- ---------- - ARM_ULIB Huw Rogers free unix library for acorn archimedes - AZTEC_C Aztec_C 5.2a - __CYGWIN__ Cygwin - _DCC Dice C on AMIGA - __GNUC__ Gnu CC (and DJGPP) - __EMX__ Gnu C port (gcc/emx 0.8e) to OS/2 2.0 - __HIGHC__ MetaWare High C - __IBMC__ C-Set++ on OS/2 2.1 - _MSC_VER MS VisualC++ 4.2 - MWC Mark Williams C on COHERENT - __MWERKS__ Metrowerks Compiler; Macintosh and WIN32 (?) - _POSIX_SOURCE ?? - _QC Microsoft QuickC - __STDC__ ANSI C compliant - __TURBOC__ Turbo C and Borland C - __USE_POSIX ?? - __WATCOMC__ Watcom C on MS-DOS - __ZTC__ Zortech C - - _AIX AIX operating system - __APPLE__ Apple Darwin - AMIGA SAS/C 5.10 or Dice C on AMIGA - __amigaos__ Gnu CC on AMIGA - atarist ATARI-ST under Gnu CC - __FreeBSD__ FreeBSD - GNUDOS DJGPP (obsolete in version 1.08) - __GO32__ DJGPP (future?) - hpux HP-UX - linux Linux - macintosh Macintosh (THINK_C and __MWERKS__ define) - MCH_AMIGA Aztec_c 5.2a on AMIGA - __MACH__ Apple Darwin - MSDOS Microsoft C 5.10 and 6.00A - __MSDOS__ Turbo C, Borland C, and DJGPP - nosve Control Data NOS/VE - SVR2 System V Revision 2. - __SVR4 SunOS - THINK_C developement environment for the Macintosh - ultrix VAX with ULTRIX operating system. - unix most Unix and similar systems and DJGPP (!?) - __unix__ Gnu CC and DJGPP - _UNICOS Cray operating system - vaxc VAX C compiler - VAXC VAX C compiler - vax11c VAX C compiler - VAX11 VAX C compiler - _Windows Borland C 3.1 compiling for Windows - _WIN32 MS VisualC++ 4.2 and Cygwin (Win32 API) - vms (and VMS) VAX-11 C under VMS. - - __alpha DEC Alpha processor - __alpha__ DEC Alpha processor - hp9000s800 HP RISC processor - __i386__ DJGPP - i386 DJGPP - MULTIMAX Encore computer - ppc PowerPC - __ppc__ PowerPC - pyr Pyramid 9810 processor - __sgi__ Silicon Graphics Inc. - sparc SPARC processor - sequent Sequent computer - tahoe CCI Tahoe processor - vax VAX processor - - -File: scm.info, Node: Problems Compiling, Next: Problems Linking, Prev: Automatic C Preprocessor Definitions, Up: Installing SCM - -Problems Compiling -================== - -FILE PROBLEM / MESSAGE HOW TO FIX -*.c include file not found. Correct the status of - STDC_HEADERS in scmfig.h. - fix #include statement or add - #define for system type to - scmfig.h. -*.c Function should return a value. Ignore. - Parameter is never used. - Condition is always false. - Unreachable code in function. -scm.c assignment between incompatible Change SIGRETTYPE in scm.c. - types. -time.c CLK_TCK redefined. incompatablility between - <stdlib.h> and <sys/types.h>. - Remove STDC_HEADERS in scmfig.h. - Edit <sys/types.h> to remove - incompatability. -subr.c Possibly incorrect assignment Ignore. - in function lgcd. -sys.c statement not reached. Ignore. - constant in conditional - expression. -sys.c undeclared, outside of #undef STDC_HEADERS in scmfig.h. - functions. -scl.c syntax error. #define SYSTNAME to your system - type in scl.c (softtype). - - -File: scm.info, Node: Problems Linking, Next: Problems Running, Prev: Problems Compiling, Up: Installing SCM - -Problems Linking -================ - -PROBLEM HOW TO FIX -_sin etc. missing. Uncomment LIBS in makefile. - - -File: scm.info, Node: Problems Running, Next: Testing, Prev: Problems Linking, Up: Installing SCM - -Problems Running -================ - -PROBLEM HOW TO FIX -Opening message and then machine Change memory model option to C -crashes. compiler (or makefile). - Make sure sizet definition is - correct in scmfig.h. - Reduce the size of HEAP_SEG_SIZE in - setjump.h. -Input hangs. #define NOSETBUF -ERROR: heap: need larger initial. Increase initial heap allocation - using -a<kb> or INIT_HEAP_SIZE. -ERROR: Could not allocate. Check sizet definition. - Use 32 bit compiler mode. - Don't try to run as subproccess. -remove <FLAG> in scmfig.h and Do so and recompile files. -recompile scm. -add <FLAG> in scmfig.h and -recompile scm. -ERROR: Init5d6.scm not found. Assign correct IMPLINIT in makefile - or scmfig.h. - Define environment variable - SCM_INIT_PATH to be the full - pathname of Init5d6.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 - Init5d6.scm to point to library or - remove. - Make sure the value of - (library-vicinity) has a trailing - file separator (like / or \). - - -File: scm.info, Node: Testing, Next: Reporting Problems, Prev: Problems Running, Up: Installing SCM - -Testing -======= - -Loading `r4rstest.scm' in the distribution will run an [R4RS] -conformance test on `scm'. - - > (load "r4rstest.scm") - -| - ;loading "r4rstest.scm" - SECTION(2 1) - SECTION(3 4) - #<primitive-procedure boolean?> - #<primitive-procedure char?> - #<primitive-procedure null?> - #<primitive-procedure number?> - ... - -Loading `pi.scm' in the distribution will enable you to compute digits -of pi. - - > (load "pi") - ;loading "pi" - ;done loading "pi.scm" - ;Evaluation took 20 ms (0 in gc) 767 cells work, 233.B other - #<unspecified> - > (pi 100 5) - 00003 14159 26535 89793 23846 26433 83279 50288 41971 69399 - 37510 58209 74944 59230 78164 06286 20899 86280 34825 34211 - 70679 - ;Evaluation took 550 ms (60 in gc) 36976 cells work, 1548.B other - #<unspecified> - -Loading `bench.scm' will compute and display performance statistics of -SCM running `pi.scm'. `make bench' or `make benchlit' appends the -performance report to the file `BenchLog', facilitating tracking -effects of changes to SCM on performance. - -PROBLEM HOW TO FIX -Runs some and then machine crashes. See above under machine crashes. -Runs some and then ERROR: ... Remove optimization option to C -(after a GC has happened). compiler and recompile. - #define SHORT_ALIGN in `scmfig.h'. -Some symbol names print incorrectly. Change memory model option to C - compiler (or makefile). - Check that HEAP_SEG_SIZE fits - within sizet. - Increase size of HEAP_SEG_SIZE (or - INIT_HEAP_SIZE if it is smaller - 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. `Init5d6.scm'). -Spaces or control characters appear Check character defines in -in symbol names. `scmfig.h'. -Negative numbers turn positive. Check SRS in `scmfig.h'. -VMS: Couldn't unwind stack. #define CHEAP_CONTIUATIONS in - `scmfig.h'. -VAX: botched longjmp. - -Sparc(SUN-4) heap is growing out of control - You are experiencing a GC problem peculiar to the Sparc. The - problem is that SCM doesn't know how to clear register windows. - Every location which is not reused still gets marked at GC time. - This causes lots of stuff which should be collected to not be. - This will be a problem with any _conservative_ GC until we find - what instruction will clear the register windows. This problem is - exacerbated by using lots of call-with-current-continuations. - - -File: scm.info, Node: Reporting Problems, Prev: Testing, Up: Installing SCM - -Reporting Problems -================== - -Reported problems and solutions are grouped under Compiling, Linking, -Running, and Testing. If you don't find your problem listed there, you -can send a bug report to `jaffer @ alum.mit.edu'. The bug report -should include: - - 1. The version of SCM (printed when SCM is invoked with no arguments). - - 2. The type of computer you are using. - - 3. The name and version of your computer's operating system. - - 4. The values of the environment variables `SCM_INIT_PATH' and - `SCHEME_LIBRARY_PATH'. - - 5. The name and version of your C compiler. - - 6. If you are using an executable from a distribution, the name, - vendor, and date of that distribution. In this case, - corresponding with the vendor is recommended. - - -File: scm.info, Node: Operational Features, Next: The Language, Prev: Installing SCM, Up: Top - -Operational Features -******************** - -* Menu: - -* Invoking SCM:: -* SCM Options:: -* Invocation Examples:: -* SCM Variables:: -* SCM Session:: -* Editing Scheme Code:: -* Debugging Scheme Code:: -* Errors:: -* Memoized Expressions:: -* Internal State:: -* Scripting:: - - -File: scm.info, Node: Invoking SCM, Next: SCM Options, Prev: Operational Features, Up: Operational Features - -Invoking SCM -============ - - scm [-a kbytes] [-muvbiq] [-version] [-help] - [[-]-no-init-file] [-p int] [-r feature] [-h feature] - [-d filename] [-f filename] [-l filename] - [-c expression] [-e expression] [-o dumpname] - [-- | - | -s] [filename] [arguments ...] - -Upon startup `scm' loads the file specified by by the environment -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 `Init5d6.scm') in platform-dependent directories relative -to this directory. See *Note File-System Habitat:: for a blow-by-blow -description. - -As a last resort (if initialization file cannot be located), the C -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, `Init5d6.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. - -`Init5d6.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. - -This explanation applies to SCMLIT or other builds of SCM. - -Scheme-code files can also invoke SCM and its variants. *Note #!: -Syntax Extensions. - - -File: scm.info, Node: SCM Options, Next: Invocation Examples, Prev: Invoking SCM, Up: Operational Features - -Options -======= - -The options are processed in the order specified on the command line. - - - 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 - Inhibits the loading of `ScmInit.scm' as described above. - - - Command Option: --help - prints usage information and URI; then exit. - - - Command Option: --version - prints version information and exit. - - - 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, r2rs, 3, - 3rs, r3rs, 4, 4rs, r4rs, 5, 5rs, or r5rs; `scm' will require the - features neccessary to support [R2RS], [R3RS], [R4RS], or [R5RS], - respectively. - - - Command Option: -h feature - provides FEATURE. - - - 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 - Loads SLIB `databases' feature and opens FILENAME as a database. - - - 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 - saves the current SCM session as the executable program `dumpname'. - This option works only in SCM builds supporting `dump' (*note - Dump::). - - 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. - - - Command Option: -p level - sets the prolixity (verboseness) to LEVEL. This is the same as - the `scm' command (verobse LEVEL). - - - 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 - (quiet mode) specifies that `scm' will print no extra information. - This is the same as `-p0'. - - - 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 - 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 - 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. - - - 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 - specifies, by analogy with `sh', that further options are to be - treated as program aguments. - - - Command Option: - - - Command Option: -- - specifies that there are no more options on the command line. - - -File: scm.info, Node: Invocation Examples, Next: SCM Variables, Prev: SCM Options, Up: Operational Features - -Invocation Examples -=================== - -`% scm foo.scm' - Loads and executes the contents of `foo.scm' and then enters - interactive session. - -`% scm -f foo.scm arg1 arg2 arg3' - Parameters `arg1', `arg2', and `arg3' are stored in the global - list `*argv*'; Loads and executes the contents of `foo.scm' and - exits. - -`% scm -s foo.scm arg1 arg2' - Sets *argv* to `("foo.scm" "arg1" "arg2")' and enters interactive - session. - -`% scm -e `(write (list-ref *argv* *optind*))' bar' - Prints `"bar"'. - -`% scm -rpretty-print -r format -i' - Loads `pretty-print' and `format' and enters interactive session. - -`% scm -r5' - Loads `dynamic-wind', `values', and syntax-rules macros and enters - interactive (with macros) session. - -`% scm -r5 -r4' - Like above but `rev4-optional-procedures' are also loaded. - - -File: scm.info, Node: SCM Variables, Next: SCM Session, Prev: Invocation Examples, Up: Operational Features - -Environment Variables -===================== - - - Environment Variable: SCM_INIT_PATH - is the pathname where `scm' will look for its initialization code. - The default is the file `Init5d6.scm' in the source directory. - - - Environment Variable: SCHEME_LIBRARY_PATH - is the [SLIB] Scheme library directory. - - - Environment Variable: HOME - is the directory where `Init5d6.scm' will look for the user - initialization file `ScmInit.scm'. - - - Environment Variable: EDITOR - is the name of the program which `ed' will call. If EDITOR is not - defined, the default is `ed'. - -Scheme Variables -================ - - - 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* - 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* - 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. - - -File: scm.info, Node: SCM Session, Next: Editing Scheme Code, Prev: SCM Variables, Up: Operational Features - -SCM Session -=========== - - * Options, file loading and features can be specified from the - command line. *Note System interface: (scm)System interface. - *Note Require: (slib)Require. - - * Typing the end-of-file character at the top level session (while - SCM is not waiting for parenthesis closure) causes SCM to exit. - - * 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 - 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? - `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 - Returns a list of strings of the arguments scm was called with. - -For documentation of the procedures `getenv' and `system' *Note System -Interface: (slib)System Interface. - - - 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 - -Editing Scheme Code -=================== - - - Function: ed arg1 ... - The value of the environment variable `EDITOR' (or just `ed' if it - isn't defined) is invoked as a command with arguments ARG1 .... - - - Function: ed filename - If SCM is compiled under VMS `ed' will invoke the editor with a - single the single argument FILENAME. - -Gnu Emacs: - Editing of Scheme code is supported by emacs. Buffers holding - files ending in .scm are automatically put into scheme-mode. - EMACS for MS-DOS and MS-Windows systems is available (free) from: - - <http://simtel.coast.net/SimTel/gnu/demacs.html> - If your Emacs can - run a process in a buffer you can use the Emacs command `M-x - run-scheme' with SCM. Otherwise, use the emacs command `M-x - suspend-emacs'; or see "other systems" below. - -Epsilon (MS-DOS): - There is lisp (and scheme) mode available by use of the package - `LISP.E'. It offers several different indentation formats. With - this package, buffers holding files ending in `.L', `.LSP', `.S', - and `.SCM' (my modification) are automatically put into lisp-mode. - - It is possible to run a process in a buffer under Epsilon. With - Epsilon 5.0 the command line options `-e512 -m0' are neccessary to - manage RAM properly. It has been reported that when compiling SCM - with Turbo C, you need to `#define NOSETBUF' for proper operation - in a process buffer with Epsilon 5.0. - - One can also call out to an editor from SCM if RAM is at a - premium; See "under other systems" below. - -other systems: - Define the environment variable `EDITOR' to be the name of the - editing program you use. The SCM procedure `(ed arg1 ...)' will - invoke your editor and return to SCM when you exit the editor. The - following definition is convenient: - - (define (e) (ed "work.scm") (load "work.scm")) - - Typing `(e)' will invoke the editor with the file of interest. - After editing, the modified file will be loaded. - - -File: scm.info, Node: Debugging Scheme Code, Next: Errors, Prev: Editing Scheme Code, Up: Operational Features - -Debugging Scheme Code -===================== - -The `cautious' and `stack-limit' options of `build' (*note Build -Options::) support debugging in Scheme. - -"CAUTIOUS" - If SCM is built with the `CAUTIOUS' flag, then when an error - occurs, a "stack trace" of certain pending calls are printed as - part of the default error response. A (memoized) expression and - newline are printed for each partially evaluated combination whose - procedure is not builtin. See *Note Memoized Expressions:: for - how to read memoized expressions. - - Also as the result of the `CAUTIOUS' flag, both `error' and - `user-interrupt' (invoked by <C-c>) to print stack traces and - conclude by calling `breakpoint' (*note Breakpoints: - (slib)Breakpoints.) instead of aborting to top level. Under - either condition, program execution can be resumed by `(continue)'. - - In this configuration one can interrupt a running Scheme program - with <C-c>, inspect or modify top-level values, trace or untrace - procedures, and continue execution with `(continue)'. - -"STACK_LIMIT" - If SCM is built with the `STACK_LIMIT' flag, the interpreter will - check stack size periodically. If the size of stack exceeds a - certain amount (default is `HEAP_SEG_SIZE/2'), SCM generates a - `segment violation' interrupt. - - The usefulness of `STACK_LIMIT' depends on the user. I don't use - it; but the user I added this feature for got primarily this type - of error. - -There are several SLIB macros which so useful that SCM automatically -loads the appropriate module from SLIB if they are invoked. - - - Macro: trace proc1 ... - Traces the top-level named procedures given as arguments. - - - 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 ... - Turns tracing off for its arguments. - - - 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: - - - Procedure: 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 '<proc-name>' and `)' around an - expression in order to see its value as a program operates. - - - Syntax: print-args name1 ... - Writes NAME1 ... (separated by spaces) and then writes the values - of the closest lexical bindings enclosing the call to `Print-args'. - - (define (foo a b) (print-args foo) (+ a b)) - (foo 3 6) - -| In foo: a = 3; b = 6; - => 9 - -Sometimes more elaborate measures are needed to print values in a useful -manner. When the values to be printed may have very large (or infinite) -external representations, *Note Quick Print: (slib)Quick Print, can be -used. - -When `trace' is not sufficient to find program flow problems, SLIB-PSD, -the Portable Scheme Debugger offers source code debugging from GNU -Emacs. PSD runs slowly, so start by instrumenting only a few functions -at a time. - http://swissnet.ai.mit.edu/ftpdir/scm/slib-psd1-3.tar.gz - swissnet.ai.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: Errors, Next: Memoized Expressions, Prev: Debugging Scheme Code, Up: Operational Features - -Errors -====== - -A computer-language implementation designer faces choices of how -reflexive to make the implementation in handling exceptions and errors; -that is, how much of the error and exception routines should be written -in the language itself. The design of a portable implementation is -further constrained by the need to have (almost) all errors print -meaningful messages, even when the implementation itself is not -functioning correctly. Therefore, SCM implements much of its error -response code in C. - -The following common error and conditions are handled by C code. Those -with callback names after them can also be handled by Scheme code -(*note Interrupts::). If the callback identifier is not defined at top -level, the default error handler (C code) is invoked. There are many -other error messages which are not treated specially. - -"ARGn" - Wrong type in argument - -"ARG1" - Wrong type in argument 1 - -"ARG2" - Wrong type in argument 2 - -"ARG3" - Wrong type in argument 3 - -"ARG4" - Wrong type in argument 4 - -"ARG5" - Wrong type in argument 5 - -"WNA" - Wrong number of args - -"OVFLOW" - numerical overflow - -"OUTOFRANGE" - Argument out of range - -"NALLOC" - `(out-of-storage)' - -"THRASH" - GC is `(thrashing)' - -"EXIT" - `(end-of-program)' - -"HUP_SIGNAL" - `(hang-up)' - -"INT_SIGNAL" - `(user-interrupt)' - -"FPE_SIGNAL" - `(arithmetic-error)' - -"BUS_SIGNAL" - bus error - -"SEGV_SIGNAL" - segment violation - -"ALRM_SIGNAL" - `(alarm-interrupt)' - -"VTALRM_SIGNAL" - `(virtual-alarm-interrupt)' - -"PROF_SIGNAL" - `(profile-alarm-interrupt)' - - - 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 - offending object if appropriate. The builtin procedure `error' - does _not_ set ERROBJ. - -`errno' and `perror' report ANSI C errors encountered during a call to -a system or library function. - - - 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 - 0)' will clear outstanding errors. This is recommended after - `try-load' returns `#f' since this occurs when the file could not - be opened. - - - 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. - -`warn' and `error' provide a uniform way for Scheme code to signal -warnings and errors. - - - Function: warn arg1 arg2 arg3 ... - Alias for *Note slib:warn: (slib)System. Outputs an error message - containing the arguments. `warn' is defined in `Init5d6.scm'. - - - Function: error arg1 arg2 arg3 ... - Alias for *Note slib:error: (slib)System. Outputs an error - message containing the arguments, aborts evaluation of the current - form and resumes the top level read-eval-print loop. `Error' is - defined in `Init5d6.scm'. - -If SCM is built with the `CAUTIOUS' flag, then when an error occurs, a -"stack trace" of certain pending calls are printed as part of the -default error response. A (memoized) expression and newline are -printed for each partially evaluated combination whose procedure is not -builtin. See *Note Memoized Expressions:: for how to read memoized -expressions. - -Also as the result of the `CAUTIOUS' flag, both `error' and -`user-interrupt' (invoked by <C-c>) are defined to print stack traces -and conclude by calling `breakpoint' (*note Breakpoints: -(slib)Breakpoints.). This allows the user to interract with SCM as -with Lisp systems. - - - Function: stack-trace - Prints information describing the stack of partially evaluated - expressions. `stack-trace' returns `#t' if any lines were printed - and `#f' otherwise. See `Init5d6.scm' for an example of the use - of `stack-trace'. - - -File: scm.info, Node: Memoized Expressions, Next: Internal State, Prev: Errors, Up: Operational Features - -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 -that memoized expression is faster because the memoized reference -encodes where in the top-level or local environment its value is. - -When procedures are displayed, the memoized locations appear in a format -different from references which have not yet been executed. I find this -a convenient aid to locating bugs and untested expressions. - - * The names of memoized lexically bound identifiers are replaced with - #@<m>-<n>, where <m> is the number of binding contours back and - <n> is the index of the value in that binding countour. - - * 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 `Init5d6.scm': - - (define (open-input-file str) - (or (open-file str OPEN_READ) - (and (procedure? could-not-open) (could-not-open) #f) - (error "OPEN-INPUT-FILE couldn't open file " str))) - -If `open-input-file' has not yet been used, the displayed procedure is -similar to the original definition (lines wrapped for readability): - - open-input-file => - #<CLOSURE (str) (or (open-file str open_read) - (and (procedure? could-not-open) (could-not-open) #f) - (error "OPEN-INPUT-FILE couldn't open file " str))> - -If we open a file using `open-input-file', the sections of code used -become memoized: - - (open-input-file "r4rstest.scm") => #<input-port 3> - open-input-file => - #<CLOSURE (str) (#@or (#@open-file #@0+0 #@open_read) - (and (procedure? could-not-open) (could-not-open) #f) - (error "OPEN-INPUT-FILE couldn't open file " str))> - -If we cause `open-input-file' to execute other sections of code, they -too become memoized: - - (open-input-file "foo.scm") => - - ERROR: No such file or directory - ERROR: OPEN-INPUT-FILE couldn't open file "foo.scm" - - open-input-file => - #<CLOSURE (str) (#@or (#@open-file #@0+0 #@open_read) - (#@and (#@procedure? #@could-not-open) (could-not-open) #f) - (#@error "OPEN-INPUT-FILE couldn't open file " #@0+0))> - - -File: scm.info, Node: Internal State, Next: Scripting, Prev: Memoized Expressions, Up: Operational Features - -Internal State -============== - - - 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 `Init5d6.scm' for details. - - - Function: abort - Resumes the top level Read-Eval-Print loop. - - - 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' - is redefined to be `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 - Controls how much monitoring information is printed. If N is: - - 0 - no prompt or information is printed. - - >= 1 - a prompt is printed. - - >= 2 - messages bracketing file loading are printed. - - >= 3 - the CPU time is printed after each top level form evaluated; - notifications of heap growth printed. - - >= 4 - a garbage collection summary is printed after each top level - form evaluated; - - >= 5 - a message for each GC (*note Garbage Collection::) is printed; - warnings issued for top-level symbols redefined. - - - Function: gc - Scans all of SCM objects and reclaims for further use those that - are no longer accessible. - - - 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. `5d6') of SCM. - -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 -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 - 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 - Sets the path to `#f' or NEWPATH, respectively. The old path is - returned. - -For other configuration constants and procedures *Note Configuration: -(slib)Configuration. - - -File: scm.info, Node: Scripting, Prev: Internal State, Up: Operational Features - -Scripting -========= - -* Menu: - -* Unix Scheme Scripts:: From Olin Shivers' Scheme Shell -* MS-DOS Compatible Scripts:: Run in MS-DOS and Unix -* Unix Shell Scripts:: Use /bin/sh to run Scheme - - -File: scm.info, Node: Unix Scheme Scripts, Next: MS-DOS Compatible Scripts, Prev: Scripting, Up: Scripting - -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 \ ... - 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 - of the file. The directories named by environment variable `PATH' - are _not_ searched to find INTERPRETER. - - When executing a shell-script, the operating system invokes - INTERPRETER with a single argument encapsulating the rest of the - first line's contents (if if not just whitespace), the pathname of - the Scheme Script file, and then any arguments which the - shell-script was invoked with. - - Put one space character between `#!' and the first character of - INTERPRETER (`/'). The INTERPRETER name is followed by ` \'; SCM - substitutes the second line of FILE for `\' (and the rest of the - line), then appends any arguments given on the command line - invoking this Scheme-Script. - - When SCM executes the script, the Scheme variable *SCRIPT* will be - set to the script pathname. The last argument before `!#' on the - second line should be `-'; SCM will load the script file, preserve - the unprocessed arguments, and set *ARGV* to a list of the script - pathname and the unprocessed arguments. - - Note that the interpreter, not the operating system, provides the - `\' substitution; this will only take place if INTERPRETER is a - SCM or SCSH interpreter. - - - 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'. - -This combination of interpretatons allows SCM source files to be used as -POSIX shell-scripts if the first line is: - - #! /usr/local/bin/scm \ - -The following Scheme-Script prints factorial of its argument: - - #! /usr/local/bin/scm \ %0 %1 %2 %3 %4 %5 %6 %7 %8 %9 - - !# - ; -*-scheme-*- - (define (go-script) - (cond ((not *script*)) - ((and (= 1 (- (length *argv*) *optind*)) - (string->number (list-ref *argv* *optind*))) - => (lambda (n) (print (fact n)))) - (else - (print *argv*) - (display "\ - Usage: fact n - Returns the factorial of N. - - http://swissnet.ai.mit.edu/~jaffer/SLIB.html - " - (current-error-port)) - (exit #f)))) - - (define (fact n) (if (< n 2) 1 (* n (fact (+ -1 n))))) - (go-script) - - ./fact 32 - => - 263130836933693530167218012160000000 - -If the wrong number of arguments is given, `fact' prints its ARGV with -usage information. - - ./fact 3 2 - -| - ("./fact" "3" "2") - Usage: fact n - Returns the factorial of N. - - http://swissnet.ai.mit.edu/~jaffer/SLIB.html - - -File: scm.info, Node: MS-DOS Compatible Scripts, Next: Unix Shell Scripts, Prev: Unix Scheme Scripts, Up: Scripting - -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'. - -With these two programs installed in a `PATH' directory, we have the -following syntax for <PROGRAM>.BAT files. - - - file: #! interpreter \ %0 %1 %2 %3 %4 %5 %6 %7 %8 %9 - 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 %1 %2 %3 %4 %5 %6 %7 %8 %9', as shown. - - If INTERPRETER has `/' in it, INTERPRETER is converted to a DOS - style filename (`/' => `\'). - - In looking for an executable named INTERPRETER, `#!' first checks - this (converted) filename; if INTERPRETER doesn't exist, it then - tries to find a program named like the string starting after the - last `\' (or `/') in INTERPRETER. When searching for executables, - `#!' 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 the 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. - -The previous example Scheme-Script works in both MS-DOS and unix -systems. - - -File: scm.info, Node: Unix Shell Scripts, Prev: MS-DOS Compatible Scripts, Up: Scripting - -Unix Shell Scripts ------------------- - -Scheme-scripts suffer from two drawbacks: - * Some Unixes limit the length of the `#!' interpreter line to the - size of an object file header, which can be as small as 32 bytes. - - * A full, explicit pathname must be specified, perhaps requiring - more than 32 bytes and making scripts vulnerable to breakage when - programs are moved. - -The following approach solves these problems at the expense of slower -startup. Make `#! /bin/sh' the first line and prepend every subsequent -line to be executed by the shell with `:;'. The last line to be -executed by the shell should contain an "exec" command; `exec' -tail-calls its argument. - -`/bin/sh' is thus invoked with the name of the script file, which it -executes as a *sh script. Usually the second line starts `:;exec scm --f$0', which executes scm, which in turn loads the script file. When -SCM loads the script file, it ignores the first and second lines, and -evaluates the rest of the file as Scheme source code. - -The second line of the script file does not have the length restriction -mentioned above. Also, `/bin/sh' searches the directories listed in -the `PATH' environment variable for `scm', eliminating the need to use -absolute locations in order to invoke a program. - -The following example additionally sets *SCRIPT* to the script -argument, making it compatible with the scheme code of the previous -example. - - #! /bin/sh - :;exec scm -e"(set! *script* \"$0\")" -l$0 $* - - (define (go-script) - (cond ((not *script*)) - ((and (= 1 (- (length *argv*) *optind*)) - (string->number (list-ref *argv* *optind*))) - => (lambda (n) (print (fact n)))) - (else - (print *argv*) - (display "\ - Usage: fact n - Returns the factorial of N. - - http://swissnet.ai.mit.edu/~jaffer/SLIB.html - " - (current-error-port)) - (exit #f)))) - - (define (fact n) (if (< n 2) 1 (* n (fact (+ -1 n))))) - - (go-script) - - ./fact 6 - => 720 - - -File: scm.info, Node: The Language, Next: Packages, Prev: Operational Features, Up: Top - -The Language -************ - -* Menu: - -* Standards Compliance:: Links to sections in [R5RS] and [SLIB] -* Miscellaneous Procedures:: -* Time:: Both real time and processor time -* Interrupts:: and exceptions -* Process Synchronization:: Because interrupts are preemptive -* Files and Ports:: -* Line Numbers:: -* Soft Ports:: Emulate I/O devices -* Syntax Extensions:: -* Low Level Syntactic Hooks:: -* Syntactic Hooks for Hygienic Macros:: - - -File: scm.info, Node: Standards Compliance, Next: Miscellaneous Procedures, Prev: The Language, Up: The Language - -Standards Compliance -==================== - -Scm conforms to the `IEEE Standard 1178-1990. IEEE Standard for the -Scheme Programming Language.' (*note Bibliography::), and `Revised(5) -Report on the Algorithmic Language Scheme'. *Note Top: (r5rs)Top. All -the required features of these specifications are supported. Many of -the optional features are supported as well. - -Optionals of [R5RS] Supported by SCM ------------------------------------- - -`-' and `/' of more than 2 arguments -`exp' -`log' -`sin' -`cos' -`tan' -`asin' -`acos' -`atan' -`sqrt' -`expt' -`make-rectangular' -`make-polar' -`real-part' -`imag-part' -`magnitude' -`angle' -`exact->inexact' -`inexact->exact' - *Note Numerical operations: (r5rs)Numerical operations. - -`with-input-from-file' -`with-output-to-file' - *Note Ports: (r5rs)Ports. - -`load' -`transcript-on' -`transcript-off' - *Note System interface: (r5rs)System interface. - -Optionals of [R5RS] not Supported by SCM ----------------------------------------- - -`numerator' -`denominator' -`rationalize' - *Note Numerical operations: (r5rs)Numerical operations. - -[SLIB] Features of SCM and SCMLIT ---------------------------------- - -`delay' -`full-continuation' -`ieee-p1178' -`object-hash' -`rev4-report' -`source' - See SLIB file `Template.scm'. - -`current-time' - *Note Time: (slib)Time. - -`defmacro' - *Note Defmacro: (slib)Defmacro. - -`getenv' -`system' - *Note System Interface: (slib)System Interface. - -`hash' - *Note Hashing: (slib)Hashing. - -`logical' - *Note Bit-Twiddling: (slib)Bit-Twiddling. - -`multiarg-apply' - *Note Multi-argument Apply: (slib)Multi-argument Apply. - -`multiarg/and-' - *Note Multi-argument / and -: (slib)Multi-argument / and -. - -`rev4-optional-procedures' - *Note Rev4 Optional Procedures: (slib)Rev4 Optional Procedures. - -`string-port' - *Note String Ports: (slib)String Ports. - -`tmpnam' - *Note Input/Output: (slib)Input/Output. - -`transcript' - *Note Transcripts: (slib)Transcripts. - -`vicinity' - *Note Vicinity: (slib)Vicinity. - -`with-file' - *Note With-File: (slib)With-File. - -[SLIB] Features of SCM ----------------------- - -`array' - *Note Arrays: (slib)Arrays. - -`array-for-each' - *Note Array Mapping: (slib)Array Mapping. - -`bignum' -`complex' -`inexact' -`rational' -`real' - *Note Require: (slib)Require. - - -File: scm.info, Node: Miscellaneous Procedures, Next: Time, Prev: Standards Compliance, Up: The Language - -Miscellaneous Procedures -======================== - - - 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'. - If not, try-load returns `#f'. The try-load procedure does not - affect the values returned by `current-input-port' and - `current-output-port'. - - - 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: line-number - Returns the current line number of the file currently being loaded. - - - 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 - 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: eval obj - Alias for *Note eval: (slib)System. - - - 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 - 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: 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 - extended part are undefined but the original part is unchanged. - It is an error to change the length of literal datums. The new - object is returned. - - - 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 - Returns (cons (cons obj1 obj2) obj3). The expression (set! a-list - (acons key datum a-list)) adds a new association to a-list. - - - Function: terms - This command displays the GNU General Public License. - - - Function: list-file filename - Displays the text contents of FILENAME. - - - Procedure: 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. - - -File: scm.info, Node: Time, Next: Interrupts, Prev: Miscellaneous Procedures, Up: The Language - -Time -==== - - - Constant: internal-time-units-per-second - Is the integer number of internal time units in a second. - - - 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 - 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 - Returns the time since 00:00:00 GMT, January 1, 1970, measured in - seconds. *Note current-time: (slib)Time. `current-time' is used - in *Note Time: (slib)Time. - - -File: scm.info, Node: Interrupts, Next: Process Synchronization, Prev: Time, Up: The Language - -Interrupts -========== - - - 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. - - If N is 0, any ticks request is canceled. Otherwise a - `ticks-interrupt' will be signaled N from the current time. - `ticks' is supported if SCM is compiled with the `ticks' flag - defined. - - - 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 - 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 - `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 - INTERVAL is supplied then alarm interrupts will be scheduled every - INTERVAL milliseconds until turned off by a call to `milli-alarm' - or `alarm'. - - `virtual-alarm' and `profile-alarm' are similar. `virtual-alarm' - decrements process execution time rather than real time, and - causes `SIGVTALRM' to be signaled. `profile-alarm' decrements - both process execution time and system execution time on behalf - of the process, and causes `SIGPROF' to be signaled. - - `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 ... - Establishes a response for `SIGINT' (control-C interrupt) and - `SIGALRM', `SIGVTALRM', and `SIGPROF' interrupts. 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 after it returns. - - Interrupt handlers are disabled during execution `system' and `ed' - procedures. - - 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 ... - 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 - action which does not return if it does not want the default error - message to also be displayed. If no procedure is defined for - HANG-UP then END-OF-PROGRAM (if defined) will be called. - - To unestablish a response for an error set the handler symbol to - `#f'. For instance, `(set! could-not-open #f)'. - - - 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 - warning will be printed. - - - 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 - procedure taking no arguments. - - FINALIZER will be invoked asynchronously exactly once some time - after OBJECT becomes eligible for garbage collection. A reference - to OBJECT in the environment of FINALIZER will not prevent - finalization, but will delay the reclamation of OBJECT at least - until the next garbage collection. A reference to OBJECT in some - other object's finalizer will necessarily prevent finalization - until both objects are eligible for garbage collection. - - Finalizers are not run in any predictable order. All finalizers - will be run by the time the program ends. - - This facility was based on the paper by Simon Peyton Jones, et al, - "Stretching the storage manager: weak pointers and stable names in - Haskell", Proc. 11th International Workshop on the Implementation - of Functional Languages, The Netherlands, September 7-10 1999, - Springer-Verlag LNCS. - - - -File: scm.info, Node: Process Synchronization, Next: Files and Ports, Prev: Interrupts, Up: The Language - -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 -operation. - - - Function: make-exchanger obj - Returns a new exchanger with the argument OBJ as its initial - content. - - (define queue (make-exchanger (list a))) - - A queue implemented as an exchanger holding a list can be - protected from reentrant execution thus: - - (define (pop queue) - (let ((lst #f)) - (dynamic-wind - (lambda () (set! lst (queue #f))) - (lambda () (and lst (not (null? lst)) - (let ((ret (car lst))) - (set! lst (cdr lst)) - ret))) - (lambda () (and lst (queue lst)))))) - - (pop queue) => a - - (pop queue) => #f - - - Function: make-arbiter name - Returns an object of type arbiter and name NAME. Its state is - initially unlocked. - - - Function: try-arbiter arbiter - Returns `#t' and locks ARBITER if ARBITER was unlocked. - Otherwise, returns `#f'. - - - Function: release-arbiter arbiter - Returns `#t' and unlocks ARBITER if ARBITER was locked. - Otherwise, returns `#f'. - - -File: scm.info, Node: Files and Ports, Next: Line Numbers, Prev: Process Synchronization, Up: The Language - -Files and Ports -=============== - -These procedures generalize and extend the standard capabilities in -*Note Ports: (r5rs)Ports. - - - 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. - - Internal functions opening files "callback" to the SCM function - `open-file'. You can extend `open-file' by redefining it. - `try-open-file' is the primitive procedure; Do not redefine - `try-open-file'! - - - 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. - - Both input and output functions can be used with io-ports. An end - 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 - 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 - 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 - 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: port-closed? port - Returns #t if PORT is closed. - - - 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: close-port port - Closes PORT. The same as close-input-port and close-output-port. - - - Function: current-error-port - Returns the current port to which diagnostic output is directed. - - - 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 - current-error-port, and the THUNK is called with no arguments. - When the thunk returns, the port is closed and the previous - 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 - 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 - 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 - error-string, and the value returned by THUNK. If THUNK does not - return a value (perhaps because of error), PROC is called with - just the output-string and the error-string as arguments. - - - 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 ... - 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 - omitted, in which case they default to the list of the value - returned by `current-input-port'. - - - Function: isatty? port - Returns `#t' if PORT is input or output to a serial non-file - device. - - - 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: 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. - - -File: scm.info, Node: Line Numbers, Next: Soft Ports, Prev: Files and Ports, Up: The Language - -Line Numbers -============ - -Scheme code define 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 - 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 - code as list structure. The default value is `read', which is - used if READER is not supplied or is false. - -Line number objects are disjoint from integers or other Scheme types. -When evaluated or loaded as Scheme code, an s-expression containing a -line-number in the car is equivalent to the cdr of the s-expression. A -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 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 - Returns the value of line-number object LINUM as an integer. - - - Function: line-number? obj - Returns true if and only if OBJ is a line-number object. - - - 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 - value of `*slib-load-reader*' will similarly be used during calls - to `slib:load' and `require'. - - In order to disable all line-numbering, it is sufficient to set! - `*load-reader*' and `*slib-load-reader*' to #f. - - -File: scm.info, Node: Soft Ports, Next: Syntax Extensions, Prev: Line Numbers, Up: The Language - -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 - 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 6. Its components are as - follows: - - 0. procedure accepting one character for output - - 1. procedure accepting a string for output - - 2. thunk for flushing output - - 3. thunk for getting one character - - 4. thunk for closing port (not by garbage collection) - - For an output-only port only elements 0, 1, 2, and 4 need be - procedures. For an input-only port only elements 3 and 4 need be - procedures. Thunks 2 and 4 can instead be `#f' if there is no - useful operation for them to perform. - - If thunk 3 returns `#f' or an `eof-object' (*note eof-object?: - (r5rs)Input.) it indicates that the port has reached end-of-file. - For example: - - If it is necessary to explicitly close the port when it is garbage - collected, (*note add-finalizer: Interrupts.). - - (define stdout (current-output-port)) - (define p (make-soft-port - (vector - (lambda (c) (write c stdout)) - (lambda (s) (display s stdout)) - (lambda () (display "." stdout)) - (lambda () (char-upcase (read-char))) - (lambda () (display "@" stdout))) - "rw")) - - (write p p) => #<input-output-soft#\space45d10#\> - - -File: scm.info, Node: Syntax Extensions, Next: Low Level Syntactic Hooks, Prev: Soft Ports, Up: The Language - -Syntax Extensions -================= - - - procedure: procedure-documentation proc - Returns the documentation string of PROC if it exists, or `#f' if - not. - - If the body of a `lambda' (or the definition of a procedure) has - more than one expression, and the first expression (preceeding any - internal definitions) is a string, then that string is the - "documentation string" of that procedure. - - (procedure-documentation (lambda (x) "Identity" x)) => "Identity" - (define (square x) - "Return the square of X." - (* x x)) - => #<unspecified> - (procedure-documentation square) => "Return the square of X." - - - Function: comment string1 ... - Appends STRING1 ... to the strings given as arguments to previous - calls `comment'. - - - Function: comment - Returns the (appended) strings given as arguments to previous calls - `comment' and empties the current string collection. - - - Read syntax: #;text-till-end-of-line - Behaves as `(comment "TEXT-TILL-END-OF-LINE")'. - - - Read 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: - - #.(define foo 9) => #<unspecified> - '(#.foo #.(+ foo foo)) => (9 18) - - - 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. - - Feature is a boolean expression composed of symbols and `and', - `or', and `not' of boolean expressions. - - For more information on `provided?' and `*features*', *Note - Require: (slib)Require. - - - Read syntax: #- feature form - is equivalent to `#+(not feature) expression'. - - - Read syntax: #' form - is equivalent to FORM (for compatibility with common-lisp). - - - Read syntax: #| any thing |# - Is a balanced comment. Everything up to the matching `|#' is - ignored by the `read'. Nested `#|...|#' can occur inside ANY - THING. - -A similar read syntax "#!" (exclamation rather than vertical bar) is -supported for Posix shell-scripts (*note Scripting::). - - - 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))'. - - 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. - - - 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 - 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. `defconst' is valid only when used at - top-level. - - - 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 - identifier value)' . If IDENTIFIER already has a value, then - VALUE is _not_ evaluated, IDENTIFIER's value is not changed, and - an error is signaled. `defconst' is valid only when used at - top-level. - - - 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. - - <Expression> is evaluated, and the elements of the resulting list - are stored in the locations to which each corresponding VARIABLE - is bound. The result of the `set!' expression is unspecified. - - (define x 2) - (define y 3) - (+ x y) => 5 - (set! (x y) (list 4 5)) => _unspecified_ - (+ x y) => 9 - - - 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: - - * literal datums, or - - * a comma followed by the name of a symbolic constant, or - - * a comma followed by an at-sign (@) followed by the name of a - symbolic constant whose value is a list. - - A `qase' statement is equivalent to a `case' statement in which - these symbolic constants preceded by commas have been replaced by - the values of the constants, and all symbolic constants preceded by - comma-at-signs have been replaced by the elements of the list - values of the constants. This use of comma, (or, equivalently, - `unquote') is similar to that of `quasiquote' except that the - unquoted expressions must be "symbolic constants". - - Symbolic constants are defined using `defconst', their values are - substituted in the head of each `qase' clause during macro - expansion. `defconst' constants should be defined before use. - `qase' can be substituted for any correct use of `case'. - - (defconst unit '1) - (defconst semivowels '(w y)) - (qase (* 2 3) - ((2 3 5 7) 'prime) - ((,unit 4 6 8 9) 'composite)) ==> composite - (qase (car '(c d)) - ((a) 'a) - ((b) 'b)) ==> _unspecified_ - (qase (car '(c d)) - ((a e i o u) 'vowel) - ((,@semivowels) 'semivowel) - (else 'consonant)) ==> consonant - - -SCM also supports the following constructs from Common Lisp: -`defmacro', `macroexpand', `macroexpand-1', and `gentemp'. *Note -Defmacro: (slib)Defmacro. - -SCM `defmacro' is extended over that described for SLIB: - - (defmacro (macro-name . arguments) body) - -is equivalent to - - (defmacro macro-name arguments body) - -As in Common Lisp, an element of the formal argument list for -`defmacro' may be a possibly nested list, in which case the -corresponding actual argument must be a list with as many members as the -formal argument. Rest arguments are indicated by improper lists, as in -Scheme. It is an error if the actual argument list does not have the -tree structure required by the formal argument list. - -For example: - - (defmacro (let1 ((name value)) . body) - `((lambda (,name) ,@body) ,value)) - - (let1 ((x (foo))) (print x) x) == ((lambda (x) (print x) x) (foo)) - - (let1 not legal syntax) error--> not "does not match" ((name value)) - -SCM supports [R5RS] `syntax-rules' macros *Note Macros: (r5rs)Macros. - -The pattern language is extended by the syntax `(... <obj>)', which is -identical to `<obj>' except that ellipses in `<obj>' are treated as -ordinary identifiers in a template, or as literals in a pattern. In -particular, `(... ...)' quotes the ellipsis token `...' in a pattern or -template. - -For example: - (define-syntax check-tree - (syntax-rules () - ((_ (?pattern (... ...)) ?obj) - (let loop ((obj ?obj)) - (or (null? obj) - (and (pair? obj) - (check-tree ?pattern (car obj)) - (loop (cdr obj)))))) - ((_ (?first . ?rest) ?obj) - (let ((obj ?obj)) - (and (pair? obj) - (check-tree ?first (car obj)) - (check-tree ?rest (cdr obj))))) - ((_ ?atom ?obj) #t))) - - (check-tree ((a b) ...) '((1 2) (3 4) (5 6))) => #t - - (check-tree ((a b) ...) '((1 2) (3 4) not-a-2list) => #f - -Note that although the ellipsis is matched as a literal token in the -defined macro it is not included in the literals list for -`syntax-rules'. - -The pattern language is also extended to support identifier macros. A -reference to an identifier macro keyword that is not the first -identifier in a form may expand into Scheme code, rather than raising a -"keyword as variable" error. The pattern for expansion of such a bare -macro keyword is a single identifier, as in other syntax rules the -identifier is ignored. - -For example: - (define-syntax eight - (syntax-rules () - (_ 8))) - - (+ 3 eight) => 11 - (eight) => ERROR - (set! eight 9) => ERROR - - -File: scm.info, Node: Low Level Syntactic Hooks, Next: Syntactic Hooks for Hygienic Macros, Prev: Syntax Extensions, Up: The Language - -Low Level Syntactic Hooks -========================= - - - 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 - from. The value returned by this function will be the value of - `read' for this expression unless the function returns - `#<unspecified>' in which case the expression will be treated as - whitespace. `#<unspecified>' is the value returned by the - expression `(if #f #f)'. - - - Callback procedure: read:sharp-char token - If the sequence <#\> followed by a non-standard character name is - encountered by `read', `read' will call the value of the symbol - `read:sharp-char' 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 `read:sharp' or `read:sharp-char' 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 use `read:sharp'). - - - 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 - 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 - returned from PROC which has been passed to - `PROCEDURE->MEMOIZING-MACRO' replaces the form passed to PROC. - For example: - - (defsyntax trace - (procedure->macro - (lambda (x env) `(set! ,(cadr x) (tracef ,(cadr x) ',(cadr x)))))) - - (trace foo) == (set! foo (tracef foo 'foo)). - - `PROCEDURE->IDENTIFIER-MACRO' is similar to - `PROCEDURE->MEMOIZING-MACRO' except that PROC is also called in - case the symbol bound to the macro appears in an expression but - _not_ as the first symbol, that is, when it looks like a variable - reference. In that case, the form passed to PROC is a single - identifier. - - - - 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. - -An "environment" is a list of frames representing lexical bindings. -Only the names and scope of the bindings are included in environments -passed to macro expanders - run-time values are not included. - -There are several types of environment frames: - -`((lambda (variable1 ...) ...) value1 ...)' -`(let ((variable1 value1) (variable2 value2) ...) ...)' -`(letrec ((variable1 value1) ...) ...)' - result in a single enviroment frame: - - (variable1 variable2 ...) - -`(let ((variable1 value1)) ...)' -`(let* ((variable1 value1) ...) ...)' - result in an environment frame for each variable: - - variable1 variable2 ... - -`(let-syntax ((key1 macro1) (key2 macro2)) ...)' -`(letrec-syntax ((key1 value1) (key2 value2)) ...)' - Lexically bound macros result in environment frames consisting of - a marker and an alist of keywords and macro objects: - - (<env-syntax-marker> (key1 . value1) (key2 . value2)) - Currently <env-syntax-marker> is the integer 6. - -`line numbers' - Line numbers (*note Line Numbers::) may be included in the - environment as frame entries to indicate the line number on which - a function is defined. They are ignored for variable lookup. - - #<line 8> - -`miscellaneous' - Debugging information is stored in environments in a plist format: - Any exact integer stored as an environment frame may be followed - by any value. The two frame entries are ignored when doing - variable lookup. Load file names, procedure names, and closure - documentation strings are stored in this format. - - <env-filename-marker> "foo.scm" <env-procedure-name-marker> foo ... - - Currently <env-filename-marker> is the integer 1 and - <env-procedure-name-marker> the integer 2. - - - 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. - - (define lst (list 'a 'b 'c)) - (@apply (lambda (v1 v2 v3) (set! v1 (cons v2 v3))) lst) - lst => ((b . c) b c) - - Thus a mutable environment can be treated as both a list and local - bindings. - - -File: scm.info, Node: Syntactic Hooks for Hygienic Macros, Prev: Low Level Syntactic Hooks, Up: The Language - -Syntactic Hooks for Hygienic Macros -=================================== - -SCM provides a synthetic identifier type for efficient implementation of -hygienic macros (for example, `syntax-rules' *note Macros: -(r5rs)Macros.) A synthetic identifier may be inserted in Scheme code by -a macro expander in any context where a symbol would normally be used. -Collectively, symbols and synthetic identifiers are _identifiers_. - - - Function: identifier? obj - Returns `#t' if OBJ is a symbol or a synthetic identifier, and - `#f' otherwise. - -If it is necessary to distinguish between symbols and synthetic -identifiers, use the predicate `symbol?'. - -A synthetic identifier includes two data: a parent, which is an -identifier, and an environment, which is either `#f' or a lexical -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 - 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 - call, even if passed identical arguments. - -There is no direct way to access all of the data internal to a synthetic -identifier, those data are used during variable lookup. If a synthetic -identifier is inserted as quoted data then during macro expansion it -will be repeatedly replaced by its parent, until a symbol is obtained. - - - Function: identifier->symbol id - Returns the symbol obtained by recursively extracting the parent of - ID, which must be an identifier. - -Use of synthetic identifiers ----------------------------- - -`renamed-identifier' may be used as a replacement for `gentemp': - (define gentemp - (let ((name (string->symbol "An unlikely variable"))) - (lambda () - (renamed-identifier name #f)))) - -If an identifier returned by this version of `gentemp' is inserted in a -binding position as the name of a variable then it is guaranteed that -no other identifier (except one produced by passing the first to -`renamed-identifier') may denote that variable. If an identifier -returned by `gentemp' is inserted free, then it will denote the -top-level value bound to its parent, the symbol named "An unlikely -variable". This behavior, of course, is meant to be put to good use: - - (define top-level-foo - (procedure->memoizing-macro - (lambda (exp env) - (renamed-identifier 'foo #f)))) - -Defines a macro which may always be used to refer to the top-level -binding of `foo'. - - (define foo 'top-level) - (let ((foo 'local)) - (top-level-foo)) => top-level - -In other words, we can avoid capturing `foo'. - -If a lexical environment is passed as the second argument to -`renamed-identifier' then if the identifier is inserted free its parent -will be looked up in that environment, rather than in the top-level -environment. The use of such an identifier _must_ be restricted to the -lexical scope of its environment. - -There is another restriction imposed for implementation convenience: -Macros passing their lexical environments to `renamed-identifier' may -be lexically bound only by the special forms `let-syntax' or -`letrec-syntax'. No error is signaled if this restriction is not met, -but synthetic identifier lookup will not work properly. - -In order to maintain referential transparency it is necessary to -determine whether two identifiers have the same denotation. With -synthetic identifiers it is not necessary that two identifiers be `eq?' -in order to denote the same binding. - - - 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 - expansion or the empty list. - - For example, - (define top-level-foo? - (procedure->memoizing-macro - (let ((foo-name (renamed-identifier 'foo #f))) - (lambda (exp env) - (identifier-equal? (cadr exp) foo-name env))))) - - (top-level-foo? foo) => #t - - (let ((foo 'local)) - (top-level-foo? foo)) => #f - - - 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 - 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, - usable as a formals list in a `lambda' expression. VALUES must be - a list of objects long enough to provide a binding for each of the - identifiers in NAMES. If NAMES is an identifier or an improper - list then VALS may be, respectively, any object or an improper - list of objects. - - - 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 - `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 - evaluated and returned once only, after which the same memoizied - value is returned. - - `the-macro' may be used to protect local copies of macros against - redefinition, for example: - (@let-syntax ((let (the-macro let))) - ;; code that will continue to work even if LET is redefined. - ...) - - - 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' - using `renaming-transformer' instead of `syntax-rules'. PROC - should evaluate to a procedure accepting three arguments: EXPR, - RENAME, and COMPARE. EXPR is a representation of Scheme code to - be expanded, as list structure. RENAME is a procedure accepting - an identifier and returning an identifier renamed in the - definition environment of the new syntax. COMPARE accepts two - identifiers and returns true if and only if both denote the same - binding in the usage environment of the new syntax. - - -File: scm.info, Node: Packages, Next: The Implementation, Prev: The Language, Up: Top - -Packages -******** - -* Menu: - -* Dynamic Linking:: -* Dump:: Create Fast-Booting Executables -* Numeric:: Numeric Language Extensions -* Arrays:: As in APL -* Records:: Define new aggregate data types -* I/O-Extensions:: i/o-extensions -* Posix Extensions:: posix -* Unix Extensions:: non-posix unix -* Regular Expression Pattern Matching:: regex -* Line Editing:: edit-line -* Curses:: Screen Control -* Sockets:: Cruise the Net - -* Menu: - -* Xlib: (Xlibscm). X Window Graphics. -* Hobbit: (hobbit). Scheme-to-C Compiler. - - -File: scm.info, Node: Dynamic Linking, Next: Dump, Prev: Packages, Up: Packages - -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 - 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 - 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 - 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 ... - 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 - instance). The object-suffix need not be given to load. For - example, - - (load (in-vicinity (implementation-vicinity) "sc2")) - or (load (in-vicinity (implementation-vicinity) "sc2.o")) - or (require 'rev2-procedures) - or (require 'rev3-procedures) - - will load/link `sc2.o' if it exists. - - The LIB1 ... pathnames specify additional libraries which may be - needed for object files not produced by the Hobbit compiler. For - instance, crs is linked on Linux by - - (load (in-vicinity (implementation-vicinity) "crs.o") - (usr:lib "ncurses") (usr:lib "c")) - or (require 'curses) - - Turtlegr graphics library is linked by: - - (load (in-vicinity (implementation-vicinity) "turtlegr") - (usr:lib "X11") (usr:lib "c") (usr:lib "m")) - or (require 'turtle-graphics) - - And the string regular expression (*note Regular Expression - Pattern Matching::) package is linked by: - - (load (in-vicinity (implementation-vicinity) "rgx") (usr:lib "c")) - or - (require 'regex) - -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 - 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, - `dyn:link' returns a "link-token" suitable for passing as the - second argument to `dyn:call'. If not successful, `#f' is - returned. - - - 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 - current SCM session. The `dyn:call' procedure calls the C - function corresponding to NAME. If successful, `dyn:call' returns - `#t'; If not successful, `#f' is returned. - - `dyn:call' is used to call the "init_..." function after loading - 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 ... - 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 - 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' - functions. If successful, `dyn:main-call' returns the integer - returned from the call to NAME. - - `dyn:main-call' can be used to call a `main' procedure from SCM. - For example, I link in and `dyn:main-call' a large C program, the - low level routines of which callback (*note Callbacks::) into SCM - (which emulates PCI hardware). - - - 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 - `#t'; If not successful, `#f' is returned. - - -File: scm.info, Node: Dump, Next: Numeric, Prev: Dynamic Linking, Up: Packages - -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 -program. Dumped executables start very quickly, since no Scheme code -has to be loaded. - -There are constraints on which sessions are savable using `dump' - - * Saved continuations are invalid in subsequent invocations; they - cause segmentation faults and other unpleasant side effects. - - * Although DLD (*note Dynamic Linking::) can be used to load compiled - modules both before and after dumping, `SUN_DL' ELF systems can - load compiled modules only after dumping. This can be worked - around by compiling in those features you wish to `dump'. - - * Ports (other than `current-input-port', `current-output-port', - `current-error-port'), X windows, etc. are invalid in subsequent - invocations. - - This restriction could be removed; *Note Improvements To Make::. - - * `Dump' should only be called from a loading file when the call to - dump is the last expression in that file. - - * `Dump' can be called from the command line. - - - 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 - the state of the current SCM session when invoked. The - optional argument THUNK, if provided, should be a procedure - of no arguments; BOOT-TAIL will be set to this procedure, - causing it to be called in the restored executable. - - If the optional argument is missing or a boolean, SCM's - standard command line processing will be called in the - restored executable. - - If the second argument to `dump' is `#t', argument processing - will continue from the command line passed to the dumping - session. If the second argument is missing or `#f' then the - command line arguments of the restoring invocation will be - processed. - - * Resumes the top level Read-Eval-Print loop. This is done - instead of continuing normally to avoid creating a saved - continuation in the dumped executable. - - `dump' may set the values of `boot-tail', `*argv*', `restart', and - *INTERACTIVE*. `dump' returns an unspecified value. - -When a dumped executable is invoked, the variable *INTERACTIVE* (*note -Internal State::) has the value it possessed when `dump' created it. -Calling `dump' with a single argument sets *INTERACTIVE* to `#f', which -is the state it has at the beginning of command line processing. - -The procedure `program-arguments' returns the command line arguments -for the curent invocation. More specifically, `program-arguments' for -the restored session are _not_ saved from the dumping session. Command -line processing is done on the value of the identifier `*argv*'. - -The following example shows how to create `rscm', which is like regular -scm, but which loads faster and has the `random' package alreadly -provided. - - bash$ scm -rrandom - > (dump "rscm") - #<unspecified> - > (quit) - bash$ ./rscm -lpi.scm -e"(pi (random 200) 5)" - 00003 14159 26535 89793 23846 26433 83279 50288 41971 69399 - 37510 58209 74944 59230 78164 06286 20899 86280 34825 34211 - 70679 82148 08651 32823 06647 09384 46095 50582 23172 53594 - 08128 48111 74502 84102 70193 85211 05559 64462 29489 - bash$ - -This task can also be accomplished using the `-o' command line option -(*note SCM Options::). - - bash$ scm -rrandom -o rscm - > (quit) - bash$ ./rscm -lpi.scm -e"(pi (random 200) 5)" - 00003 14159 26535 89793 23846 26433 83279 50288 41971 69399 - 37510 58209 74944 59230 78164 06286 20899 86280 34825 34211 - 70679 82148 08651 32823 06647 09384 46095 50582 23172 53594 - 08128 48111 74502 84102 70193 85211 05559 64462 29489 - bash$ - - -File: scm.info, Node: Numeric, Next: Arrays, Prev: Dump, Up: Packages - -Numeric -======= - - - Constant: most-positive-fixnum - The immediate integer closest to positive infinity. *Note - Configuration: (slib)Configuration. - - - Constant: most-negative-fixnum - The immediate integer closest to negative infinity. - - - 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 - `(* pi Z)' - - - Function: pi/ z - `(/ pi 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 - 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 - 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 - Real-only base 10 logarithm. - - - Function: $atan2 y x - Computes `(angle (make-rectangular x y))' for real numbers Y and X. - - - Function: $expt x1 x2 - 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. - - -File: scm.info, Node: Arrays, Next: Records, Prev: Numeric, Up: Packages - -Arrays -====== - -* Menu: - -* Conventional Arrays:: -* Array Mapping:: array-for-each -* Uniform Array:: -* Bit Vectors:: - - -File: scm.info, Node: Conventional Arrays, Next: Array Mapping, Prev: Arrays, Up: Arrays - -Conventional Arrays -------------------- - -"Arrays" read and write as a `#' followed by the "rank" (number of -dimensions) followed by the character #\a or #\A and what appear as -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 3 3) => - #2A((ho ho ho) (ho ho ho) (ho ho ho)) - -The rank may be elided, in which case it is read as one. - '#A(a b c) == '#(a b c) - -Unshared conventional (not uniform) 0-based arrays of rank 1 (dimension) -are equivalent to (and can't be distinguished from) vectors. - (make-array 'ho 3) => #(ho ho ho) - -When constructing an array, BOUND is either an inclusive range of -indices expressed as a two element list, or an upper bound expressed as -a single integer. So - (make-array 'foo 3 3) == (make-array 'foo '(0 2) '(0 2)) - - - Function: array? obj - Returns `#t' if the OBJ is an array, and `#f' if not. - - - Function: make-array initial-value bound1 bound2 ... - Creates and returns an array that has as many dimensions as there - are BOUNDs and fills it with INITIAL-VALUE. - - - Function: array-ref array index1 index2 ... - Returns the INDEX1, INDEX2, ...'th element of ARRAY. - - - Function: array-in-bounds? array index1 index2 ... - Returns `#t' if its arguments would be acceptable to ARRAY-REF. - - - Function: array-set! array new-value index1 index2 ... - Sets the INDEX1, INDEX2, ...'th element of ARRAY to NEW-VALUE. - The value returned by `array-set!' is unspecified. - - - Function: make-shared-array array mapper bound1 bound2 ... - `make-shared-array' can be used to create shared subarrays of other - arrays. The MAPPER is a function that translates coordinates in - the new array into coordinates in the old array. A MAPPER must be - linear, and its range must stay within the bounds of the old - array, but it can be otherwise arbitrary. A simple example: - (define fred (make-array #f 8 8)) - (define freds-diagonal - (make-shared-array fred (lambda (i) (list i i)) 8)) - (array-set! freds-diagonal 'foo 3) - (array-ref fred 3 3) => foo - (define freds-center - (make-shared-array fred (lambda (i j) (list (+ 3 i) (+ 3 j))) 2 2)) - (array-ref freds-center 0 0) => foo - - - 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 - between 0 and the rank of the array to be returned. Each integer - in that range must appear at least once in the argument list. - - The values of DIM0, DIM1, ... correspond to dimensions in the - array to be returned, their positions in the argument list to - dimensions of ARRAY. Several DIMs may have the same value, in - which case the returned array will have smaller rank than ARRAY. - - examples: - (transpose-array '#2A((a b) (c d)) 1 0) => #2A((a c) (b d)) - (transpose-array '#2A((a b) (c d)) 0 0) => #1A(a d) - (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 ... - 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 - as the DIMth dimensions of the original array, the dimensions of - the outer array are the same as those of the original array that - did not match a DIM. - - An enclosed array is not a general Scheme array. Its elements may - not be set using `array-set!'. Two references to the same element - of an enclosed array will be `equal?' but will not in general be - `eq?'. The value returned by ARRAY-PROTOTYPE when given an - enclosed array is unspecified. - - examples: - (enclose-array '#3A(((a b c) (d e f)) ((1 2 3) (4 5 6))) 1) => - #<enclosed-array (#1A(a d) #1A(b e) #1A(c f)) (#1A(1 4) #1A(2 5) #1A(3 6))> - - (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-shape array - Returns a list of inclusive bounds of integers. - (array-shape (make-array 'foo '(-1 3) 5)) => ((-1 3) (0 4)) - - - Function: array-dimensions array - `Array-dimensions' is similar to `array-shape' but replaces - elements with a `0' minimum with one greater than the maximum. So: - (array-dimensions (make-array 'foo '(-1 3) 5)) => ((-1 3) 5) - - - Function: array-rank obj - Returns the number of dimensions of OBJ. If OBJ is not an array, - `0' is returned. - - - 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-copy! source destination - Copies every element from vector or array SOURCE to the - corresponding element of DESTINATION. DESTINATION must have the - same rank as SOURCE, and be at least as large in each dimension. - The order of copying is unspecified. - - - Function: serial-array-copy! source destination - Same as `array-copy!' but guaranteed to copy in row-major order. - - - Function: array-fill! array fill - Stores FILL in every element of ARRAY. The value returned is - unspecified. - - - 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-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 and CREATE-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 - in memory. - - -File: scm.info, Node: Array Mapping, Next: Uniform Array, Prev: Conventional Arrays, Up: Arrays - -Array Mapping -------------- - -`(require 'array-for-each)' - - - 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 - are scalars, that is, not arrays, vectors, or strings, then they - will be converted internally to arrays of the appropriate shape. - PROC is applied to each tuple of elements of ARRAY1 ... and the - result is stored as the corresponding element in ARRAY0. The - value returned is unspecified. The order of application is - unspecified. - - - - Function: serial-array-map! array0 proc array1 ... - Same as ARRAY-MAP!, but guaranteed to apply PROC in row-major - order. - - - Function: array-for-each proc array0 ... - PROC is applied to each tuple of elements of ARRAY0 ... in - row-major order. The value returned is unspecified. - - - Function: array-index-map! array proc - applies PROC to the indices of each element of ARRAY in turn, - storing the result in the corresponding element. The value - returned and the order of application are unspecified. - - One can implement ARRAY-INDEXES as - (define (array-indexes array) - (let ((ra (apply make-array #f (array-shape array)))) - (array-index-map! ra (lambda x x)) - ra)) - Another example: - (define (apl:index-generator n) - (let ((v (make-vector n 1))) - (array-index-map! v (lambda (i) i)) - v)) - - - Function: scalar->array scalar array prototype - 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 - for the returned array. Otherwise the returned array will be of - the same type as `array' if that is possible, and a conventional - array if it is not. This function is used internally by - `array-map!' and friends to handle scalar arguments. - - -File: scm.info, Node: Uniform Array, Next: Bit Vectors, Prev: Array Mapping, Up: Arrays - -Uniform Array -------------- - -"Uniform Arrays" and vectors are arrays whose elements are all of the -same type. Uniform vectors occupy less storage than conventional -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 `create-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. - (create-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. - (create-array '#at() 3) => #*000 - == - #At(#f #f #f) => #*000 - == - #1At(#f #f #f) => #*000 - -PROTOTYPE arguments in the following procedures are interpreted -according to the table: - - prototype type display prefix - - () conventional vector #a - +64i complex (double precision) #ac64 - 64.0 double (double precision) #ar64 - 32.0 float (single precision) #ar32 - 32 unsigned integer (32-bit) #au32 - -32 signed integer (32-bit) #as32 - -16 signed integer (16-bit) #as16 - #\a char (string) #a\ - #t boolean (bit-vector) #at - -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, `'#As32(3 5 9)' -returns a uniform vector of signed integers. - - - 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 - 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 - 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. - - In, for example, the case of a rank-2 array, LST must be a list of - lists, all of the same length. The length of LST will be the - first dimension of the result array, and the length of each - element the second dimension. - - If RANK is zero, LST, which need not be a list, is the single - element of the returned array. - - - Function: uniform-vector-fill! uve fill - Stores FILL in every element of UVE. The value returned is - unspecified. - - - Function: dimensions->uniform-array dims prototype fill - - Function: dimensions->uniform-array dims prototype - Creates and returns a uniform array or vector of type - corresponding to PROTOTYPE with dimensions DIMS or length LENGTH. - If the FILL argument is supplied, the returned array is filled with - this value. - - - 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 - URA (starting at the beginning) and the remainder of the array is - unchanged. - - `uniform-array-read!' returns the number of objects read. PORT - 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 - 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 ... - 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 - twos-complement representation of the array element indexed by the - other INDEXs returning `#t' if the bit is 1, and `#f' if 0. It is - an error if this element is not an exact integer. - - (logaref '#(#b1101 #b0010) 0) => #b1101 - (logaref '#(#b1101 #b0010) 0 1) => #f - (logaref '#2((#b1101 #b0010)) 0 0) => #b1101 - - - 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 - twos-complement representation of an exact integer array element, - setting the bit to 1 if VAL is `#t' and to 0 if VAL is `#f'. In - this case it is an error if the array element is not an exact - integer or if VAL is not boolean. - - -File: scm.info, Node: Bit Vectors, Prev: Uniform Array, Up: Arrays - -Bit Vectors ------------ - -Bit vectors can be written and read as a sequence of `0's and `1's -prefixed by `#*'. - - #At(#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 occurrences of BOOL in BV. - - - 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 - Modifies BV by replacing each element with its negation. - - - Function: bit-set*! bv uve bool - If uve is a bit-vector BV and uve must be of the same length. If - BOOL is `#t', uve is OR'ed into BV; If BOOL is `#f', the inversion - of uve is AND'ed into BV. - - If uve is a unsigned integer vector all the elements of uve must be - between 0 and the `LENGTH' of BV. The bits of BV corresponding to - the indexes in uve are set to BOOL. - - The return value is unspecified. - - - Function: bit-count* bv uve bool - Returns - (bit-count (bit-set*! (if bool bv (bit-invert! bv)) uve #t) #t). - BV is not modified. - - -File: scm.info, Node: Records, Next: I/O-Extensions, Prev: Arrays, Up: Packages - -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 - 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: - the record to be printed, the port to print to, and a boolean - which is true if the record is being written on behalf of `write' - and false if for `display'. If PRINTER returns #f, the default - record printer will be called. - - A PRINTER value of #f means use the default printer. - - Only the default printer will be used when printing error messages. - - -File: scm.info, Node: I/O-Extensions, Next: Posix Extensions, Prev: Records, Up: Packages - -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> - 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 - the port is opened; If the argument is a string then the returned - vector describes the file named by that string. If there exists - no file with the name string, or if the file cannot be accessed - `#f' is returned. The elements of the returned vector are as - follows: - - 0 st_dev - ID of device containing a directory entry for this file - - 1 st_ino - Inode number - - 2 st_mode - File type, attributes, and access control summary - - 3 st_nlink - Number of links - - 4 st_uid - User ID of file owner - - 5 st_gid - Group ID of file group - - 6 st_rdev - Device ID; this entry defined only for char or blk spec files - - 7 st_size - File size (bytes) - - 8 st_atime - Time of last access - - 9 st_mtime - Last modification time - - 10 st_ctime - Last file status change time - - - Function: getpid - Returns the process ID of the current process. - - - 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 - 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 - 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 - Closes port PORT and reopens it with FILENAME and MODES. - `reopen-file' returns `#t' if successful, `#f' if not. - - - 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 - 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 - Returns a "directory" object corresponding to the file system - directory named DIRNAME. If unsuccessful, returns `#f'. - - - 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 - Reinitializes DIR so that the next call to `readdir' with DIR will - return the first entry in the directory again. - - - Function: closedir dir - Closes DIR and returns `#t'. If DIR is already closed,, - `closedir' returns a `#f'. - - - Function: directory-for-each proc directory - The LISTs must be lists, and 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 elements of the LISTs is unspecified. The value - returned by `directory-for-each' is unspecified. - - - 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 - Applies PROC only to those filenames for which `(filename:match?? - MATCH)' would return a non-false value (*note Filenames: - (slib)Filenames.). - - (require 'directory-for-each) - (directory-for-each print "." "[A-Z]*.scm") - -| - "Init.scm" - "Iedline.scm" - "Link.scm" - "Macro.scm" - "Transcen.scm" - "Init5d6.scm" - - - 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: - (libc)The Mode Bits for Access Permission, for more information - about this. - - `mkdir' returns if successful, `#f' if not. - - - 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 - 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 - 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 - Renames the file specified by OLDFILENAME to NEWFILENAME. If the - renaming is successful, `#t' is returned. Otherwise, `#f' is - returned. - - - Function: chmod file mode - The function `chmod' sets the access permission bits for the file - named by FILE to MODE. The FILE argument may be a string - containing the filename or a port open to the file. - - `chmod' returns if successful, `#f' if not. - - - 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 - 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 - Returns the integer file descriptor associated with the port PORT. - If an error is detected, `#f' is returned. - - - 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: - - 0. File-exists? - - 1. File-is-executable? - - 2. File-is-writable? - - 4. File-is-readable? - - Or the HOW argument can be a string of 0 to 3 of the following - characters in any order. The test performed is the `and' of the - associated tests and `file-exists?'. - - <x> - File-is-executable? - - <w> - File-is-writable? - - <r> - File-is-readable? - - - 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 - directories specified by the environment variable PATH. The - convention is that ARG0 is the same name as COMMAND. - - 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 - Like `execl' and `execlp' except that the set of arguments to - COMMAND is ARGLIST. - - - 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 - an environment variable, and any definition for this variable in - the environment is removed. - - Names of environment variables are case-sensitive and must not - contain the character `='. System-defined environment variables - are invariably uppercase. - - `Putenv' is used to set up the environment before calls to - `execl', `execlp', `execv', `execvp', `system', or `open-pipe' - (*note open-pipe: Posix Extensions.). - - To access environment variables, use `getenv' (*note getenv: - (slib)System Interface.). - - -File: scm.info, Node: Posix Extensions, Next: Unix Extensions, Prev: I/O-Extensions, Up: Packages - -Posix Extensions -================ - -If `'posix' is provided (by linking in `posix.o'), the following -functions are defined: - - - 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 - 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 - 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 - 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 - passed so that any necessary cleanup may be done. An error is not - 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 - 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 - Returns `(cons RD WD)' where RD and WD are the read and write - (port) ends of a "pipe" respectively. - - - 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 - `fork' returns 0. - -For a discussion of "ID"s *Note Process Persona: (GNU C Library)Process -Persona. - - - 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: 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. - - - Function: getuid - Returns the real user ID of this process. - - - Function: getgid - Returns the real group ID of this process. - - - Function: getegid - Returns the effective group ID of this process. - - - Function: geteuid - Returns the effective user ID of this process. - - - Function: setuid id - Sets the real user ID of this process to ID. Returns `#t' if - successful, `#f' if not. - - - Function: setgid id - Sets the real group ID of this process to ID. Returns `#t' if - successful, `#f' if not. - - - Function: setegid id - Sets the effective group ID of this process to ID. Returns `#t' - if successful, `#f' if not. - - - Function: seteuid id - Sets the effective user ID of this process to ID. Returns `#t' if - successful, `#f' if not. - - - 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 - have a value of zero to check the validity of the PID. - - The PID specifies the process or process group to receive the - signal: - - > 0 - The process whose identifier is PID. - - 0 - All processes in the same process group as the sender. The - sender itself does not receive the signal. - - -1 - If the process is privileged, send the signal to all - processes except for some special system processes. - Otherwise, send the signal to all processes with the same - effective user ID. - - < -1 - The process group whose identifier is `(abs PID)'. - - A process can send a signal to itself with `(kill (getpid) - SIGNUM)'. If `kill' is used by a process to send a signal to - itself, and the signal is not blocked, then `kill' delivers at - least one signal (which might be some other pending unblocked - signal instead of the signal SIGNUM) to that process before it - returns. - - The return value from `kill' is zero if the signal can be sent - successfully. Otherwise, no signal is sent, and a value of `-1' is - returned. If PID specifies sending a signal to several processes, - `kill' succeeds if it can send the signal to at least one of them. - There's no way you can tell which of the processes got the signal - or whether all of them did. - - - 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 - current process or to call a signal handling function. If a child - as requested by PID has already exited by the time of the call (a - so-called "zombie" process), the function returns immediately. - Any system resources used by the child are freed. - - The value of PID can be: - - < -1 - which means to wait for any child process whose process group - ID is equal to the absolute value of PID. - - -1 - which means to wait for any child process; this is the same - behaviour which wait exhibits. - - 0 - which means to wait for any child process whose process group - ID is equal to that of the calling process. - - > 0 - which means to wait for the child whose process ID is equal - to the value of PID. - - The value of OPTIONS is one of the following: - - 0. Nothing special. - - 1. (`WNOHANG') which means to return immediately if no child is - there to be waited for. - - 2. (`WUNTRACED') which means to also return for children which - are stopped, and whose status has not been reported. - - 3. Which means both of the above. - - The return value normally is the exit status of the child process, - including the exit value along with flags indicating whether a - coredump was generated or the child terminated as a result of a - signal. If the `WNOHANG' option was specified and no child - process is waiting to be noticed, the value is zero. A value of - `#f' is returned in case of error and `errno' is set. For - information about the `errno' codes *Note Process Completion: (GNU - C Library)Process Completion. - - - Function: uname - You can use the `uname' procedure to find out some information - about the type of computer your program is running on. - - Returns a vector of strings. These strings are: - - 0. The name of the operating system in use. - - 1. The network name of this particular computer. - - 2. The current release level of the operating system - implementation. - - 3. The current version level within the release of the operating - system. - - 4. Description of the type of hardware that is in use. - - Some examples are `"i386-ANYTHING"', `"m68k-hp"', - `"sparc-sun"', `"m68k-sun"', `"m68k-sony"' and `"mips-dec"'. - - - 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: - - 0. The user's login name. - - 1. The encrypted password string. - - 2. The user ID number. - - 3. The user's default group ID number. - - 4. A string typically containing the user's real name, and - possibly other information such as a phone number. - - 5. The user's home directory, initial working directory, or - `#f', in which case the interpretation is system-dependent. - - 6. The user's default shell, the initial program run when the - user logs in, or `#f', indicating that the system default - should be used. - - - Function: setpwent #t - Rewinds the pw entry table back to the begining. - - - Function: setpwent #f - - Function: setpwent - Closes the pw table. - - - 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: - - 0. The name of the group. - - 1. The encrypted password string. - - 2. The group ID number. - - 3. A list of (string) names of users in the group. - - - Function: setgrent #t - Rewinds the group entry table back to the begining. - - - Function: setgrent #f - - Function: setgrent - Closes the group table. - - - Function: getgroups - Returns a vector of all the supplementary group IDs of the process. - - - 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 - 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 - 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: Regular Expression Pattern Matching, Prev: Posix Extensions, Up: Packages - -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 - 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 - Returns the value of the symbolic link FILENAME or `#f' for - failure. - - - 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 - 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 - 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 - accounting to be turned off. - - `acct' returns a value of `#t' if it is successful and `#f' on - failure. - - - 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 - `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: Regular Expression Pattern Matching, Next: Line Editing, Prev: Unix Extensions, Up: Packages - -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] - Compile a "regular expression". Return a compiled regular - expression, or an integer error code suitable as an argument to - `regerror'. - - FLAGS in `regcomp' is a string of option letters used to control - the compilation of the regular expression. The letters may - consist of: - - `n' - newlines won't be matched by `.' or hat lists; ( `[^...]' ) - - `i' - ignore case.only when compiled with _GNU_SOURCE: - - - `0' - allows dot to match a null character. - - `f' - enable GNU fastmaps. - - - Function: regerror ERRNO - Returns a string describing the integer ERRNO returned when - `regcomp' fails. - - - 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 - parentheses in the pattern). The last of each doublet is index of - STRING of the end of that expression. `#f' is returned if the - string does not match. - - - 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]] - `Regsearch' searches for the pattern within the string. - - `Regmatch' anchors the pattern and begins matching it against - string. - - `Regsearch' returns the character position where RE starts, or - `#f' if not found. - - `Regmatch' returns the number of characters matched, `#f' if not - matched. - - `Regsearchv' and `regmatchv' return the match vector is returned - if RE is found, `#f' otherwise. - - RE - may be either: - 1. a compiled regular expression returned by `regcomp'; - - 2. a string representing a regular expression; - - 3. a list of a string and a set of option letters. - - STRING - The string to be operated upon. - - START - 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:_ - - - When searching, if START is negative, the absolute value of - START will be used as the start location and reverse searching - will be performed. - - LEN - The search is allowed to examine only the first LEN - characters of STRING. If absent, the entire string may be - examined. - - - 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] - Returns the edited string. - - EDIT-SPEC - Is a string used to replace occurances of RE. Backquoted - integers in the range of 1-9 may be used to insert - subexpressions in RE, as in `sed'. - - COUNT - The number of substitutions for `string-edit' to perform. If - `#t', all occurances of RE will be replaced. The default is - to perform one substitution. - - -File: scm.info, Node: Line Editing, Next: Curses, Prev: Regular Expression Pattern Matching, Up: Packages - -Line Editing -============ - -These procedures provide input line editing and recall. - -These functions are defined in `edline.c' and `Iedline.scm' using the -"editline" or GNU "readline" (*note Overview: (readline)Top.) libraries -available from: - - * `ftp.sys.toronto.edu:/pub/rc/editline.shar' - - * `ftp.gnu.org:/pub/gnu/readline-2.0.tar.gz' - -When `Iedline.scm' is loaded, if the current input port is the default -input port and the environment variable EMACS is not defined, -line-editing mode will be entered. - - - Function: default-input-port - Returns the initial `current-input-port' SCM was invoked with - (stdin). - - - Function: default-output-port - Returns the initial `current-output-port' SCM was invoked with - (stdout). - - - Function: make-edited-line-port - Returns an input/output port that allows command line editing and - retrieval of history. - - - Function: line-editing - Returns the current edited line port or `#f'. - - - 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 - previous value of `(line-editing)'. - - -File: scm.info, Node: Curses, Next: Sockets, Prev: Line Editing, Up: Packages - -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 - Returns a port for a full screen window. This routine must be - called to initialize curses. - - - 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 - left corner of the screen and reset the terminal into the proper - non-visual mode. To resume after a temporary escape, call *Note - refresh: Window Manipulation. - -* Menu: - -* Output Options Setting:: -* Terminal Mode Setting:: -* Window Manipulation:: -* Output:: -* Input:: -* Curses Miscellany:: - - -File: scm.info, Node: Output Options Setting, Next: Terminal Mode Setting, Prev: Curses, Up: Curses - -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 - 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 - 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. - The "insert/delete-character" feature is always considered. This - option should be enabled only if your application needs - "insert/delete-line", for example, for a screen editor. It is - disabled by default because - - "insert/delete-line" tends to be visually annoying when used in - applications where it is not really needed. If - "insert/delete-line" cannot be used, curses will redraw the - changed portions of all lines. - - - 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 - applications where the cursor is not used, since it reduces the - need for cursor motions. If possible, the cursor is made - invisible when this option is enabled. - - - 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 - last line. If disabled (BF is `#f'), the cursor is left on the - bottom line at the location where the offending character was - entered. If enabled (BF is `#t'), `force-output' is called on the - 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 - terminal, it is also necessary to call `idlok'. - - - 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. - - -File: scm.info, Node: Terminal Mode Setting, Next: Window Manipulation, Prev: Output Options Setting, Up: Curses - -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 - 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 - processing is not performed. When in `NOCBREAK' mode, the tty - driver will buffer characters typed until a <LFD> or <RET> is - typed. Interrupt and flowcontrol characters are unaffected by - this mode. Initially the terminal may or may not be in `CBREAK' - mode, as it is inherited, therefore, a program should call - `cbreak' or `nocbreak' explicitly. Most interactive programs - using curses will set `CBREAK' mode. - - _Note:_ `cbreak' overrides `raw'. For a discussion of how these - routines interact with `echo' and `noecho' *Note read-char: Input. - - - 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 - `RAW' mode, the interrupt, quit, suspend, and flow control - characters are passed through uninterpreted, instead of generating - a signal. `RAW' mode also causes 8-bit input and output. The - behavior of the `BREAK' key depends on other bits in the terminal - driver that are not set by curses. - - - 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' - mode, so characters typed are echoed. Authors of most interactive - programs prefer to do their own echoing in a controlled area of - the screen, or not to echo at all, so they disable echoing by - calling `noecho'. For a discussion of how these routines interact - with `echo' and `noecho' *Note read-char: Input. - - - 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 - 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 - `savetty'. - - -File: scm.info, Node: Window Manipulation, Next: Output, Prev: Terminal Mode Setting, Up: Curses - -Window Manipulation -------------------- - - - 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 - 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 - the screen, and not to the window ORIG. The window is made in the - middle of the window ORIG, so that changes made to one window will - affect both windows. When using this routine, often it will be - necessary to call `touchwin' or `touchline' on ORIG before calling - `force-output'. - - - 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 - 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 - account what is already there in order to minimize the amount of - information that's sent to the terminal (called optimization). - Unless `leaveok' has been enabled, the physical cursor of the - terminal is left at the location of window WIN's cursor. With - `refresh', the number of characters output to the terminal is - returned. - - - 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 - 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 - 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 - overlapping windows, since a change to one window will affect the - other window, but the records of which lines have been changed in - the other window will not reflect the change. `touchline' only - pretends that COUNT lines have been changed, beginning with line - START. - - - 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 - specified is relative to the upper left corner of the window WIN, - which is (0, 0). - - -File: scm.info, Node: Output, Next: Input, Prev: Window Manipulation, Up: Curses - -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 - 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 - newline is performed. At the bottom of the scrolling region, if - scrollok is enabled, the scrolling region will be scrolled up one - line. - - If CH is a <TAB>, <LFD>, or backspace, the cursor will be moved - appropriately within the window WIN. A <LFD> also does a - `wclrtoeol' before moving. <TAB> characters are considered to be - at every eighth column. If CH is another control character, it - will be drawn in the `C-x' notation. (Calling `winch' after - adding a control character will not return the control character, - but instead will return the representation of the control - character.) - - Video attributes can be combined with a character by or-ing them - into the parameter. This will result in these attributes also - being set. The intent here is that text, including attributes, - 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 - character of the corresponding value. - - - Function: werase win - This routine copies blanks to every position in the window WIN. - - - Function: wclear win - This routine is like `werase', but it also calls *Note clearok: - 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 - 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 - The current line to the right of the cursor, inclusive, is erased. - - - 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 - 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 - 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 - 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 - 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 - screen will be scrolled at the same time. - - -File: scm.info, Node: Input, Next: Curses Miscellany, Prev: Output, Up: Curses - -Input ------ - - - 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' - mode). Unless `noecho' has been set, the character will also be - echoed into WIN. - - When using `read-char', do not set both `NOCBREAK' mode - (`nocbreak') and `ECHO' mode (`echo') at the same time. Depending - on the state of the terminal driver when each character is typed, - the program may produce undesirable results. - - - 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 - 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 - -Curses Miscellany ------------------ - - - 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 - move with the character through any scrolling and insert/delete - line/character operations. To the extent possible on the - particular terminal, they will be displayed as the graphic - rendition of characters put on the screen. - - `wstandout' sets the current attributes of the window WIN to be - visibly different from other text. `wstandend' turns off the - attributes. - - - 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 - character (with attributes) of the corresponding values. - - - 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 - as is. - - -File: scm.info, Node: Sockets, Prev: Curses, Up: Packages - -Sockets -======= - -These procedures (defined in `socket.c') provide a Scheme interface to -most of the C "socket" library. For more information on sockets, *Note -Sockets: (libc)Sockets. - -* Menu: - -* Host Data:: -* Internet Addresses and Socket Names:: -* Socket:: - - -File: scm.info, Node: Host Data, Next: Internet Addresses and Socket Names, Prev: Sockets, Up: Sockets - -Host Data, Network, Protocol, and Service Inquiries ---------------------------------------------------- - - - Constant: af_inet - - Constant: af_unix - Integer family codes for Internet and Unix sockets, respectively. - - - 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: - - 0. host name string - - 1. list of host aliases strings - - 2. integer address type (`AF_INET') - - 3. integer size of address entries (in bytes) - - 4. list of integer addresses - - - 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 - 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: - - 0. official network name string - - 1. list of network aliases strings - - 2. integer network address type (`AF_INET') - - 3. integer network number - - - 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 - 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: - - 1. official protocol name string - - 2. list of protocol aliases strings - - 3. integer protocol number - - - 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 - 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: - - 0. official service name string - - 1. list of service aliases strings - - 2. integer port number - - 3. protocol - - - 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. - When called without an argument, the service table is closed. - - -File: scm.info, Node: Internet Addresses and Socket Names, Next: Socket, Prev: Host Data, Up: Sockets - -Internet Addresses and Socket Names ------------------------------------ - - - Function: inet:string->address string - Returns the host address number (integer) for host STRING or `#f' - if not found. - - - Function: inet:address->string address - Converts an internet (integer) address to a string in numbers and - dots notation. - - - Function: inet:network address - Returns the network number (integer) specified from ADDRESS or - `#f' if not found. - - - 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 - 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 - Returns the socket-name of SOCKET. Returns `#f' if unsuccessful - or SOCKET is closed. - - - 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 - Returns the integer code for the family of SOCKET-NAME. - - - Function: socket-name:port-number socket-name - Returns the integer port number of 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 - -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 -buffered ports you can (assuming sock-port is a socket i/o port): - (require 'i/o-extensions) - (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 - 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 - numbers returned (as vector elements) from `(getproto)'. If the - PROTOCOL argument is not supplied, the default (0) for the - 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 - 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 - corresponds to the integer protocol numbers returned (as vector - elements) from (getproto). If the PROTOCOL argument is not - supplied, the default (0) for the specified FAMILY is used. - - - Function: socket:shutdown socket how - Makes SOCKET no longer respond to some or all operations depending - on the integer argument HOW: - - 0. Further input is disallowed. - - 1. Further output is disallowed. - - 2. Further input or output is disallowed. - - `Socket:shutdown' returns SOCKET if successful, `#f' if not. - - - 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 - 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 - 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 - 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 - Accepts a connection on a bound, listening SOCKET. Returns an - input/output port for the connection. - -The following example is not too complicated, yet shows the use of -sockets for multiple connections without input blocking. - - ;;;; Scheme chat server - - ;;; This program implements a simple `chat' server which accepts - ;;; connections from multiple clients, and sends to all clients any - ;;; characters received from any client. - - ;;; To connect to chat `telnet localhost 8001' - - (require 'socket) - (require 'i/o-extensions) - - (let ((listener-socket (socket:bind (make-stream-socket af_inet) 8001)) - (connections '())) - (socket:listen listener-socket 5) - (do () (#f) - (let ((actives (or (apply wait-for-input 5 listener-socket connections) - '()))) - (cond ((null? actives)) - ((memq listener-socket actives) - (set! actives (cdr (memq listener-socket actives))) - (let ((con (socket:accept listener-socket))) - (display "accepting connection from ") - (display (getpeername con)) - (newline) - (set! connections (cons con connections)) - (display "connected" con) - (newline con)))) - (set! connections - (let next ((con-list connections)) - (cond ((null? con-list) '()) - (else - (let ((con (car con-list))) - (cond ((memq con actives) - (let ((c (read-char con))) - (cond ((eof-object? c) - (display "closing connection from ") - (display (getpeername con)) - (newline) - (close-port con) - (next (cdr con-list))) - (else - (for-each (lambda (con) - (file-set-position con 0) - (write-char c con) - (file-set-position con 0)) - connections) - (cons con (next (cdr con-list))))))) - (else (cons con (next (cdr con-list))))))))))))) - -You can use `telnet localhost 8001' to connect to the chat server, or -you can use a client written in scheme: - - ;;;; Scheme chat client - - ;;; this program connects to socket 8001. It then sends all - ;;; characters from current-input-port to the socket and sends all - ;;; characters from the socket to current-output-port. - - (require 'socket) - (require 'i/o-extensions) - - (define con (make-stream-socket af_inet)) - (set! con (socket:connect con (inet:string->address "localhost") 8001)) - - (define (go) - (define actives (wait-for-input (* 30 60) con (current-input-port))) - (let ((cs (and actives (memq con actives) (read-char con))) - (ct (and actives (memq (current-input-port) actives) (read-char)))) - (cond ((or (eof-object? cs) (eof-object? ct)) (close-port con)) - (else (cond (cs (display cs))) - (cond (ct (file-set-position con 0) - (display ct con) - (file-set-position con 0))) - (go))))) - (cond (con (display "Connecting to ") - (display (getpeername con)) - (newline) - (go)) - (else (display "Server not listening on port 8001") - (newline))) - - -File: scm.info, Node: The Implementation, Next: Index, Prev: Packages, Up: Top - -The Implementation -****************** - -* Menu: - -* Data Types:: -* Operations:: -* Program Self-Knowledge:: What SCM needs to know about itself. -* Improvements To Make:: - - -File: scm.info, Node: Data Types, Next: Operations, Prev: The Implementation, Up: The Implementation - -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 -larger than 31 bits. With some modification, SCM could work with word -sizes as small as 24 bits. - -All SCM objects are represented by type "SCM". Type `SCM' come in 2 -basic flavors, Immediates and Cells: - -* Menu: - -* Immediates:: -* Cells:: Non-Immediate types -* Header Cells:: Malloc objects -* Subr Cells:: Built-in and Compiled Procedures -* Ptob Cells:: I/O ports -* Smob Cells:: Miscellaneous datatypes -* Data Type Representations:: How they all fit together - - -File: scm.info, Node: Immediates, Next: Cells, Prev: Data Types, Up: Data Types - -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 - Return non-zero if the `SCM' object X is an immediate or - non-immediate type, respectively. - - - 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 - Return non-zero if the `SCM' X is an immediate integer or not - an immediate integer, respectively. - - - Macro: INUM x - Returns the C `long integer' corresponding to `SCM' X. - - - Macro: MAKINUM x - Returns the `SCM' inum corresponding to C `long integer' x. - - - Immediate Constant: INUM0 - is equivalent to `MAKINUM(0)'. - - Computations on INUMs are performed by converting the arguments to - C integers (by a shift), operating on the integers, and converting - the result to an inum. The result is checked for overflow by - converting back to integer and checking the reverse operation. - - The shifts used for conversion need to be signed shifts. If the C - implementation does not support signed right shift this fact is - detected in a #if statement in `scmfig.h' and a signed right shift, - `SRS', is constructed in terms of unsigned right shift. - - - Immediate: ichr - characters. - - - Macro: ICHRP x - Return non-zero if the `SCM' object X is a character. - - - Macro: ICHR x - Returns corresponding `unsigned char'. - - - Macro: MAKICHR x - Given `char' X, returns `SCM' character. - - - - Immediate: iflags - These are frequently used immediate constants. - - - Immediate Constant: SCM BOOL_T - `#t' - - - Immediate Constant: SCM BOOL_F - `#f' - - - 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 - end of file token, `#<eof>'. - - - Immediate Constant: SCM UNDEFINED - `#<undefined>' used for variables which have not been defined - and absent optional arguments. - - - Immediate Constant: SCM UNSPECIFIED - `#<unspecified>' is returned for those procedures whose return - values are not specified. - - - - Macro: IFLAGP n - Returns non-zero if N is an ispcsym, isym or iflag. - - - Macro: ISYMP n - Returns non-zero if N is an ispcsym or isym. - - - Macro: ISYMNUM n - Given ispcsym, isym, or iflag N, returns its index in the C array - `isymnames[]'. - - - Macro: ISYMCHARS n - Given ispcsym, isym, or iflag N, returns its `char *' - representation (from `isymnames[]'). - - - Macro: MAKSPCSYM n - Returns `SCM' ispcsym N. - - - Macro: MAKISYM n - Returns `SCM' iisym N. - - - Macro: MAKIFLAG n - Returns `SCM' iflag N. - - - 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 - The number of ispcsyms and ispcsyms+isyms, respectively. Defined - in `scm.h'. - - - 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 - special symbols: syntax-checked versions of first 14 isyms - - - CAR Immediate: iloc - indexes to a variable's location in environment - - - CAR Immediate: gloc - pointer to a symbol's value cell - - - 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'. - - There is one exception to this rule, _CAR Immediate_s, described - next. - -A "CAR Immediate" is an Immediate point which can only occur in the -`CAR's of evaluated code (as a result of `ceval''s memoization process). - - -File: scm.info, Node: Cells, Next: Header Cells, Prev: Immediates, Up: Data Types - -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 -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 - Allocates a new cell and stores a pointer to it in `SCM' local - variable X. - - Care needs to be taken that stores into the new cell pointed to by - X do not create an inconsistent object. *Note Signals::. - -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 - Returns the `car' and `cdr' of cell X, respectively. - - - Macro: TYP3 x - - Macro: TYP7 x - - Macro: TYP16 x - Returns the 3, 7, and 16 bit type code of a cell. - - - Cell: tc3_cons - scheme cons-cell returned by (cons arg1 arg2). - - - Macro: CONSP x - - Macro: NCONSP x - Returns non-zero if X is a `tc3_cons' or isn't, respectively. - - - 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 - (zero-based) in the `CDR' indicate a lower bound on the number of - required arguments to the closure, which is used to avoid - allocating rest argument lists in the environment cache. This - 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 - Returns non-zero if X is a `tc3_closure'. - - - Macro: CODE x - - Macro: ENV x - Returns the code body or environment of closure X, - respectively. - - - Macro: ARGC x - Returns the a lower bound on the number of required arguments - to closure X, it cannot exceed 3. - - - -File: scm.info, Node: Header Cells, Next: Subr Cells, Prev: Cells, Up: Data Types - -Header Cells ------------- - -"Header"s are Cells whose `CDR's point elsewhere in memory, such as to -memory allocated by `malloc'. - - - Header: spare - spare `tc7' type code - - - Header: tc7_vector - scheme vector. - - - 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 - Returns the C array of `SCM's holding the elements of vector - X or its length, respectively. - - - Header: tc7_ssymbol - static scheme symbol (part of initial system) - - - Header: tc7_msymbol - `malloc'ed scheme symbol (can be GCed) - - - Macro: SYMBOLP x - Returns non-zero if X is a `tc7_ssymbol' or `tc7_msymbol'. - - - 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 - scheme string - - - 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 - 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 - uniform vector of booleans (bit-vector) - - - Header: tc7_ivect - uniform vector of integers - - - Header: tc7_uvect - uniform vector of non-negative integers - - - Header: tc7_svect - uniform vector of short integers - - - Header: tc7_fvect - uniform vector of short inexact real numbers - - - Header: tc7_dvect - uniform vector of double precision inexact real numbers - - - Header: tc7_cvect - uniform vector of double precision inexact complex numbers - - - Header: tc7_contin - applicable object produced by call-with-current-continuation - - - Header: tc7_specfun - subr that is treated specially within the evaluator - - `apply' and `call-with-current-continuation' are denoted by these - objects. Their behavior as functions is built into the evaluator; - they are not directly associated with C functions. This is - necessary in order to make them properly tail recursive. - - tc16_cclo is a subtype of tc7_specfun, a cclo is similar to a - vector (and is GCed like one), but can be applied as a function: - - 1. the cclo itself is consed onto the head of the argument list - - 2. the first element of the cclo is applied to that list. Cclo - invocation is currently not tail recursive when given 2 or - more arguments. - - - 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 - Expands to the length of CCLO. - - -File: scm.info, Node: Subr Cells, Next: Ptob Cells, Prev: Header Cells, Up: Data Types - -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 - associative C function of 2 arguments. Examples are `+', `-', - `*', `/', `max', and `min'. - - - Subr: tc7_subr_0 - C function of no arguments. - - - Subr: tc7_subr_1 - C function of one argument. - - - 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. - - `floor', `ceiling', `truncate', `round', `$sqrt', `$abs', `$exp', - `$log', `$sin', `$cos', `$tan', `$asin', `$acos', `$atan', - `$sinh', `$cosh', `$tanh', `$asinh', `$acosh', `$atanh', and - `exact->inexact' are defined this way. - - If the `CDR' is `0' (`NULL'), the name string of the procedure is - used to control traversal of its list structure argument. - - `car', `cdr', `caar', `cadr', `cdar', `cddr', `caaar', `caadr', - `cadar', `caddr', `cdaar', `cdadr', `cddar', `cdddr', `caaaar', - `caaadr', `caadar', `caaddr', `cadaar', `cadadr', `caddar', - `cadddr', `cdaaar', `cdaadr', `cdadar', `cdaddr', `cddaar', - `cddadr', `cdddar', and `cddddr' are defined this way. - - - Subr: tc7_subr_3 - C function of 3 arguments. - - - Subr: tc7_subr_2 - C function of 2 arguments. - - - 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 - C function of one optional argument. If the optional argument is - not present, `UNDEFINED' is passed in its place. - - - 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 - C function of 2 arguments and a list of (rest of) `SCM' arguments. - - - 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 - -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: - - - ptob: tc16_inport - input port. - - - ptob: tc16_outport - output port. - - - ptob: tc16_ioport - input-output port. - - - ptob: tc16_inpipe - input pipe created by `popen()'. - - - ptob: tc16_outpipe - output pipe created by `popen()'. - - - ptob: tc16_strport - String port created by `cwos()' or `cwis()'. - - - 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 - 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 - Returns non-zero if port X is open or closed, respectively. - - - 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 - 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 - -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' -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 - unused cell on the freelist. - - - smob: tc16_flo - single-precision float. - - Inexact number data types are subtypes of type `tc16_flo'. If the - sub-type is: - - 0. a single precision float is contained in the `CDR'. - - 1. `CDR' is a pointer to a `malloc'ed double. - - 3. `CDR' is a pointer to a `malloc'ed pair of doubles. - - - smob: tc_dblr - double-precision float. - - - smob: tc_dblc - double-precision complex. - - - smob: tc16_bigpos - - smob: tc16_bigneg - positive and negative bignums, respectively. - - Scm has large precision integers called bignums. They are stored - in sign-magnitude form with the sign occuring in the type code of - the SMOBs bigpos and bigneg. The magnitude is stored as a - `malloc'ed array of type `BIGDIG' which must be an unsigned - integral type with size smaller than `long'. `BIGRAD' is the - radix associated with `BIGDIG'. - - `NUMDIGS_MAX' (defined in `scmfig.h') limits the number of digits - of a bignum to 1000. These digits are base `BIGRAD', which is - typically 65536, giving 4816 decimal digits. - - Why only 4800 digits? The simple multiplication algorithm SCM - uses is O(n^2); this means the number of processor instructions - required to perform a multiplication is _some multiple_ of the - product of the number of digits of the two multiplicands. - - digits * digits ==> operations - 5 x - 50 100 * x - 500 10000 * x - 5000 1000000 * x - - To calculate numbers larger than this, FFT multiplication - [O(n*log(n))] and other specialized algorithms are required. You - should obtain a package which specializes in number-theoretical - calculations: - - <ftp://megrez.math.u-bordeaux.fr/pub/pari/> - - - - smob: tc16_promise - made by DELAY. *Note Control features: (r5rs)Control features. - - - smob: tc16_arbiter - synchronization object. *Note Process Synchronization::. - - - smob: tc16_macro - macro expanding function. *Note Low Level Syntactic Hooks::. - - - smob: tc16_array - multi-dimensional array. *Note Arrays::. - - This type implements both conventional arrays (those with - arbitrary data as elements *note Conventional Arrays::) and - uniform arrays (those with elements of a uniform type *note - Uniform Array::). - - Conventional Arrays have a pointer to a vector for their `CDR'. - Uniform Arrays have a pointer to a Uniform Vector type (string, - bvect, ivect, uvect, fvect, dvect, or cvect) in their `CDR'. - - -File: scm.info, Node: Data Type Representations, Prev: Smob Cells, Up: Data Types - -Data Type Representations -------------------------- - -IMMEDIATE: B,D,E,F=data bit, C=flag code, P=pointer address bit - ................................ -inum BBBBBBBBBBBBBBBBBBBBBBBBBBBBBB10 -ichr BBBBBBBBBBBBBBBBBBBBBBBB11110100 -iflag CCCCCCC101110100 -isym CCCCCCC001110100 - IMCAR: only in car of evaluated code, cdr has cell's GC bit -ispcsym 000CCCC00CCCC100 -iloc 0DDDDDDDDDDDEFFFFFFFFFFF11111100 -pointer PPPPPPPPPPPPPPPPPPPPPPPPPPPPP000 -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: -cons ..........SCM car..............0 ...........SCM cdr.............G -closure ..........SCM code...........011 ...........SCM env...........CCG - HEADERs: -ssymbol .........long length....G0000101 ..........char *chars........... -msymbol .........long length....G0000111 ..........char *chars........... -string .........long length....G0001101 ..........char *chars........... -vector .........long length....G0001111 ...........SCM **elts........... -bvect .........long length....G0010101 ..........long *words........... - spare G0010111 -ivect .........long length....G0011101 ..........long *words........... -uvect .........long length....G0011111 ......unsigned long *words...... - spare G0100101 -svect .........long length....G0100111 ........ short *words........... -fvect .........long length....G0101101 .........float *words........... -dvect .........long length....G0101111 ........double *words........... -cvect .........long length....G0110101 ........double *words........... - -contin .........long length....G0111101 .............*regs.............. -specfun ................xxxxxxxxG1111111 ...........SCM name............. -cclo ..short length..xxxxxx10G1111111 ...........SCM **elts........... - PTOBs: - port 0bwroxxxxxxxxG0110111 ..........FILE *stream.......... - socket ttttttt 00001xxxxxxxxG0110111 ..........FILE *stream.......... - inport uuuuuuuuuuU00011xxxxxxxxG0110111 ..........FILE *stream.......... -outport 0000000000000101xxxxxxxxG0110111 ..........FILE *stream.......... - ioport uuuuuuuuuuU00111xxxxxxxxG0110111 ..........FILE *stream.......... -fport 00 00000000G0110111 ..........FILE *stream.......... -pipe 00 00000001G0110111 ..........FILE *stream.......... -strport 00 00000010G0110111 ..........FILE *stream.......... -sfport 00 00000011G0110111 ..........FILE *stream.......... - SUBRs: - spare 010001x1 - spare 010011x1 -subr_0 ..........int hpoff.....01010101 ...........SCM (*f)()........... -subr_1 ..........int hpoff.....01010111 ...........SCM (*f)()........... -cxr ..........int hpoff.....01011101 .........double (*f)().......... -subr_3 ..........int hpoff.....01011111 ...........SCM (*f)()........... -subr_2 ..........int hpoff.....01100101 ...........SCM (*f)()........... -asubr ..........int hpoff.....01100111 ...........SCM (*f)()........... -subr_1o ..........int hpoff.....01101101 ...........SCM (*f)()........... -subr_2o ..........int hpoff.....01101111 ...........SCM (*f)()........... -lsubr_2 ..........int hpoff.....01110101 ...........SCM (*f)()........... -lsubr ..........int hpoff.....01110111 ...........SCM (*f)()........... -rpsubr ..........int hpoff.....01111101 ...........SCM (*f)()........... - SMOBs: -free_cell - 000000000000000000000000G1111111 ...........*free_cell........000 -flo 000000000000000000000001G1111111 ...........float num............ -dblr 000000000000000100000001G1111111 ..........double *real.......... -dblc 000000000000001100000001G1111111 .........complex *cmpx.......... -bignum ...int length...0000001 G1111111 .........short *digits.......... -bigpos ...int length...00000010G1111111 .........short *digits.......... -bigneg ...int length...00000011G1111111 .........short *digits.......... - xxxxxxxx = code assigned by newsmob(); -promise 000000000000000fxxxxxxxxG1111111 ...........SCM val.............. -arbiter 000000000000000lxxxxxxxxG1111111 ...........SCM name............. -macro 000000000000000mxxxxxxxxG1111111 ...........SCM name............. -array ...short rank..cxxxxxxxxG1111111 ............*array.............. - - -File: scm.info, Node: Operations, Next: Program Self-Knowledge, Prev: Data Types, Up: The Implementation - -Operations -========== - -* Menu: - -* Garbage Collection:: Automatically reclaims unused storage -* Memory Management for Environments:: -* Signals:: -* C Macros:: -* Changing Scm:: -* Defining Subrs:: -* Defining Smobs:: -* Defining Ptobs:: -* Allocating memory:: -* Embedding SCM:: In other programs -* Callbacks:: -* Type Conversions:: For use with C code. -* Continuations:: For C and SCM -* Evaluation:: Why SCM is fast - - -File: scm.info, Node: Garbage Collection, Next: Memory Management for Environments, Prev: Operations, Up: Operations - -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 -longer in use. Immediates always appear as parts of other objects, so -they are not subject to explicit garbage collection. - -All cells reside in the "heap" (composed of "heap segments"). Note -that this is different from what Computer Science usually defines as a -heap. - -* Menu: - -* Marking Cells:: -* Sweeping the Heap:: - - -File: scm.info, Node: Marking Cells, Next: Sweeping the Heap, Prev: Garbage Collection, Up: Garbage Collection - -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 -(cons cells) the lowest order bit (0) of the CDR is used. For other -types, bit 8 of the CAR is used. The GC bits are never set except -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 - Returns the CDR of a cons cell, even if that cell has been GC - marked. - - - 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 -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) - 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)) - 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 - `(STACKITEM)'. - - Each longword in the stack is tried to see if it is a valid cell - pointer into the heap. If it is, the object itself and any - objects it points to are marked using `gc_mark'. If the stack is - word rather than longword aligned `(#define WORD_ALIGN)', both - alignments are tried. This arrangement will occasionally mark an - object which is no longer used. This has not been a problem in - practice and the advantage of using the c-stack far outweighs it. - - -File: scm.info, Node: Sweeping the Heap, Prev: Marking Cells, Up: Garbage Collection - -Sweeping the Heap -................. - -After all found objects have been marked, the heap is swept. - -The storage for strings, vectors, continuations, doubles, complexes, and -bignums is managed by malloc. There is only one pointer to each malloc -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 () - 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 - `NEWCELL'. - - If a type-header cell pointing to malloc space is unmarked, the - malloc object is freed. If the type header of smob is collected, - the smob's `free' procedure is called to free its storage. - - -File: scm.info, Node: Memory Management for Environments, Next: Signals, Prev: Garbage Collection, Up: Operations - -Memory Management for Environments ----------------------------------- - - * "Ecache" was designed and implemented by Radey Shouman. - - * This documentation of ecache was written by Tom Lord. - -The memory management component of SCM contains special features which -optimize the allocation and garbage collection of environments. - -The optimizations are based on certain facts and assumptions: - -The SCM evaluator creates many environments with short lifetimes and -these account of a _large portion_ of the total number of objects -allocated. - -The general purpose allocator allocates objects from a freelist, and -collects using a mark/sweep algorithm. Research into garbage -collection suggests that such an allocator is sub-optimal for object -populations containing a large portion of short-lived members and that -allocation strategies involving a copying collector are more -appropriate. - -It is a property of SCM, reflected throughout the source code, that a -simple copying collector can not be used as the general purpose memory -manager: much code assumes that the run-time stack can be treated as a -garbage collection root set using "conservative garbage collection" -techniques, which are incompatible with objects that change location. - -Nevertheless, it is possible to use a mostly-separate -copying-collector, just for environments. Roughly speaking, cons pairs -making up environments are initially allocated from a small heap that -is collected by a precise copying collector. These objects must be -handled specially for the collector to work. The (presumably) small -number of these objects that survive one collection of the copying heap -are copied to the general purpose heap, where they will later be -collected by the mark/sweep collector. The remaining pairs are more -rapidly collected than they would otherwise be and all of this -collection is accomplished without having to mark or sweep any other -segment of the heap. - -Allocating cons pairs for environments from this special heap is a -heuristic that approximates the (unachievable) goal: - - allocate all short-lived objects from the copying-heap, at no - extra cost in allocation time. - -Implementation Details -...................... - -A separate heap (`ecache_v') is maintained for the copying collector. -Pairs are allocated from this heap in a stack-like fashion. Objects in -this heap may be protected from garbage collection by: - - 1. Pushing a reference to the object on a stack specially maintained - for that purpose. This stack (`scm_estk') is used in place of the - C run-time stack by the SCM evaluator to hold local variables - which refer to the copying heap. - - 2. Saving a reference to every object in the mark/sweep heap which - directly references the copying heap in a root set that is - specially maintained for that purpose (`scm_egc_roots'). If no - object in the mark/sweep heap directly references an object from - the copying heap, that object can be preserved by storing a direct - reference to it in the copying-collector root set. - - 3. Keeping no other references to these objects, except references - between the objects themselves, during copying collection. - -When the copying heap or root-set becomes full, the copying collector is -invoked. All protected objects are copied to the mark-sweep heap. All -references to those objects are updated. The copying collector root-set -and heap are emptied. - -References to pairs allocated specificly for environments are -inaccessible to the Scheme procedures evaluated by SCM. These pairs -are manipulated by only a small number of code fragments in the -interpreter. To support copying collection, those code fragments -(mostly in `eval.c') have been modified to protect environments from -garbage collection using the three rules listed above. - -During a mark-sweep collection, the copying collector heap is marked -and swept almost like any ordinary segment of the general purpose heap. -The only difference is that pairs from the copying heap that become -free during a sweep phase are not added to the freelist. - -The environment cache is disabled by adding `#define NO_ENV_CACHE' to -`eval.c'; all environment cells are then allocated from the regular -heap. - -Relation to Other Work -...................... - -This work seems to build upon a considerable amount of previous work -into garbage collection techniques about which a considerable amount of -literature is available. - - -File: scm.info, Node: Signals, Next: C Macros, Prev: Memory Management for Environments, Up: Operations - -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 - The low level handlers for `SIGINT' and `SIGALRM'. - -If an interrupt handler is defined when the interrupt is received, the -code is interpreted. If the code returns, execution resumes from where -the interrupt happened. `Call-with-current-continuation' allows the -stack to be saved and restored. - -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 - 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 - Checks the deferred variables and if set the appropriate handler is - called. - - Calls to `DEFER_INTS' can not be nested. An `ALLOW_INTS' must - happen before another `DEFER_INTS' can be done. In order to check - that this constraint is satisfied `#define CAREFUL_INTS' in - `scmfig.h'. - - -File: scm.info, Node: C Macros, Next: Changing Scm, Prev: Signals, Up: Operations - -C Macros --------- - - - Macro: ASSERT 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 - - * `ARGn' (> 5 or unknown ARG number) - - * `ARG1' - - * `ARG2' - - * `ARG3' - - * `ARG4' - - * `ARG5' - - * `WNA' (wrong number of args) - - * `OVFLOW' - - * `OUTOFRANGE' - - * `NALLOC' - - * `EXIT' - - * `HUP_SIGNAL' - - * `INT_SIGNAL' - - * `FPE_SIGNAL' - - * `BUS_SIGNAL' - - * `SEGV_SIGNAL' - - * `ALRM_SIGNAL' - - * a C string `(char *)' - - Error checking is not done by `ASSERT' if the flag `RECKLESS' is - defined. An error condition can still be signaled in this case - with a call to `wta(arg, pos, subr)'. - - - Macro: ASRTGO cond label - `goto' LABEL if the expression (COND) is 0. Like `ASSERT', - `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 - -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 -a `SCM' object which is returned, you need to make sure that a `SCM' -variable in your routine points to that cell as long as part of it -might be referenced by your code. - -In order to make sure this `SCM' variable does not get optimized out -you can put this assignment after its last possible use: - - SCM_dummy1 = foo; - -or put this assignment somewhere in your routine: - - SCM_dummy1 = (SCM) &foo; - -`SCM_dummy' variables are not currently defined. Passing the address -of the local `SCM' variable to _any_ procedure also protects it. The -procedure `scm_protect_temp' is provided for this purpose. - -Also, if you maintain a static pointer to some (non-immediate) `SCM' -object, you must either make your pointer be the value cell of a symbol -(see `errobj' for an example) or make your pointer be one of the -`sys_protects' (see `dynwinds' for an example). The former method is -prefered since it does not require any changes to the SCM distribution. - -To add a C routine to scm: - - 1. choose the appropriate subr type from the type list. - - 2. write the code and put into `scm.c'. - - 3. add a `make_subr' or `make_gsubr' call to `init_scm'. Or put an - entry into the appropriate `iproc' structure. - -To add a package of new procedures to scm (see `crs.c' for example): - - 1. create a new C file (`foo.c'). - - 2. at the front of `foo.c' put declarations for strings for your - procedure names. - - static char s_twiddle_bits[]="twiddle-bits!"; - static char s_bitsp[]="bits?"; - - 3. choose the appropriate subr types from the type list in `code.doc'. - - 4. write the code for the procedures and put into `foo.c' - - 5. create one `iproc' structure for each subr type used in `foo.c' - - static iproc subr3s[]= { - {s_twiddle-bits,twiddle-bits}, - {s_bitsp,bitsp}, - {0,0} }; - - 6. create an `init_<name of file>' routine at the end of the file - which calls `init_iprocs' with the correct type for each of the - `iproc's created in step 5. - - void init_foo() - { - init_iprocs(subr1s, tc7_subr_1); - init_iprocs(subr3s, tc7_subr_3); - } - - If your package needs to have a "finalization" routine called to - free up storage, close files, etc, then also have a line in - `init_foo' like: - - add_final(final_foo); - - `final_foo' should be a (void) procedure of no arguments. The - finals will be called in opposite order from their definition. - - The line: - - add_feature("foo"); - - will append a symbol `'foo' to the (list) value of `*features*'. - - 7. put any scheme code which needs to be run as part of your package - into `Ifoo.scm'. - - 8. put an `if' into `Init5d6.scm' which loads `Ifoo.scm' if your - package is included: - - (if (defined? twiddle-bits!) - (load (in-vicinity (implementation-vicinity) - "Ifoo" - (scheme-file-suffix)))) - - or use `(provided? 'foo)' instead of `(defined? twiddle-bits!)' - if you have added the feature. - - 9. put documentation of the new procedures into `foo.doc' - - 10. add lines to your `Makefile' to compile and link SCM with your - object file. Add a `init_foo\(\)\;' to the `INITS=...' line at - the beginning of the makefile. - -These steps should allow your package to be linked into SCM with a -minimum of difficulty. Your package should also work with dynamic -linking if your SCM has this capability. - -Special forms (new syntax) can be added to scm. - - 1. define a new `MAKISYM' in `scm.h' and increment `NUM_ISYMS'. - - 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'). - -New syntax can now be added without recompiling SCM by the use of the -`procedure->syntax', `procedure->macro', `procedure->memoizing-macro', -and `defmacro'. For details, *Note Syntax Extensions::. - - -File: scm.info, Node: Defining Subrs, Next: Defining Smobs, Prev: Changing Scm, Up: Operations - -Defining Subrs --------------- - -If "CCLO" is `#define'd when compiling, the compiled closure feature -will be enabled. It is automatically enabled if dynamic linking is -enabled. - -The SCM interpreter directly recognizes subrs taking small numbers of -arguments. In order to create subrs taking larger numbers of arguments -use: - - - Function: make_gsubr name req opt rest fcn - returns a cclo (compiled closure) object of name `char *' NAME - which takes `int' REQ required arguments, `int' OPT optional - arguments, and a list of rest arguments if `int' REST is 1 (0 for - not). - - `SCM (*fcn)()' is a pointer to a C function to do the work. - - The C function will always be called with REQ + OPT + REST - arguments, optional arguments not supplied will be passed - `UNDEFINED'. An error will be signaled if the subr is called with - too many or too few arguments. Currently a total of 10 arguments - may be specified, but increasing this limit should not be - difficult. - - /* A silly example, taking 2 required args, - 1 optional, and a list of rest args */ - - #include <scm.h> - - SCM gsubr_21l(req1,req2,opt,rst) - SCM req1,req2,opt,rst; - { - lputs("gsubr-2-1-l:\n req1: ", cur_outp); - display(req1,cur_outp); - lputs("\n req2: ", cur_outp); - display(req2,cur_outp); - lputs("\n opt: ", cur_outp); - display(opt,cur_outp); - lputs("\n rest: ", cur_outp); - display(rst,cur_outp); - newline(cur_outp); - return UNSPECIFIED; - } - - void init_gsubr211() - { - make_gsubr("gsubr-2-1-l", 2, 1, 1, gsubr_21l); - } - - -File: scm.info, Node: Defining Smobs, Next: Defining Ptobs, Prev: Defining Subrs, Up: Operations - -Defining Smobs --------------- - -Here is an example of how to add a new type named `foo' to SCM. The -following lines need to be added to your code: - -`long tc16_foo;' - The type code which will be used to identify the new type. - -`static smobfuns foosmob = {markfoo,freefoo,printfoo,equalpfoo};' - smobfuns is a structure composed of 4 functions: - - typedef struct { - SCM (*mark)P((SCM)); - sizet (*free)P((CELLPTR)); - int (*print)P((SCM exp, SCM port, int writing)); - SCM (*equalp)P((SCM, SCM)); - } smobfuns; - - `smob.mark' - is a function of one argument of type `SCM' (the cell to - mark) and returns type `SCM' which will then be marked. If - no further objects need to be marked then return an immediate - object such as `BOOL_F'. The smob cell itself will already - have been marked. _Note:_ This is different from SCM - versions prior to 5c5. Only additional data specific to a - smob type need be marked by `smob.mark'. - - 2 functions are provided: - - `markcdr(ptr)' - returns `CDR(ptr)'. - - `mark0(ptr)' - is a no-op used for smobs containing no additional `SCM' - data. 0 may also be used in this case. - - `smob.free' - is a function of one argument of type `CELLPTR' (the cell to - collected) and returns type `sizet' which is the number of - `malloc'ed bytes which were freed. `Smob.free' should free - any `malloc'ed storage associated with this object. The - function free0(ptr) is provided which does not free any - storage and returns 0. - - `smob.print' - is 0 or a function of 3 arguments. The first, of type `SCM', - is the smob object. The second, of type `SCM', is the stream - on which to write the result. The third, of type int, is 1 - if the object should be `write'n, 0 if it should be - `display'ed, and 2 if it should be `write'n for an error - report. This function should return non-zero if it printed, - and zero otherwise (in which case a hexadecimal number will - be printed). - - `smob.equalp' - is 0 or a function of 2 `SCM' arguments. Both of these - arguments will be of type `tc16foo'. This function should - return `BOOL_T' if the smobs are equal, `BOOL_F' if they are - not. If `smob.equalp' is 0, `equal?' will return `BOOL_F' if - they are not `eq?'. - -`tc16_foo = newsmob(&foosmob);' - Allocates the new type with the functions from `foosmob'. This - line goes in an `init_' routine. - -Promises and macros in `eval.c' and arbiters in `repl.c' provide -examples of SMOBs. There are a maximum of 256 SMOBs. Smobs that must -allocate blocks of memory should use, for example, `must_malloc' rather -than `malloc' *Note Allocating memory::. - - -File: scm.info, Node: Defining Ptobs, Next: Allocating memory, Prev: Defining Smobs, Up: Operations - -Defining Ptobs --------------- - -"ptob"s are similar to smobs but define new types of port to which SCM -procedures can read or write. The following functions are defined in -the `ptobfuns': - - typedef struct { - SCM (*mark)P((SCM ptr)); - int (*free)P((FILE *p)); - int (*print)P((SCM exp, SCM port, int writing)); - SCM (*equalp)P((SCM, SCM)); - int (*fputc)P((int c, FILE *p)); - int (*fputs)P((char *s, FILE *p)); - sizet (*fwrite)P((char *s, sizet siz, sizet num, FILE *p)); - int (*fflush)P((FILE *stream)); - int (*fgetc)P((FILE *p)); - int (*fclose)P((FILE *p)); - } ptobfuns; - -The `.free' component to the structure takes a `FILE *' or other C -construct as its argument, unlike `.free' in a smob, which takes the -whole smob cell. Often, `.free' and `.fclose' can be the same -function. See `fptob' and `pipob' in `sys.c' for examples of how to -define ptobs. Ptobs that must allocate blocks of memory should use, -for example, `must_malloc' rather than `malloc' *Note Allocating -memory::. - - -File: scm.info, Node: Allocating memory, Next: Embedding SCM, Prev: Defining Ptobs, Up: Operations - -Allocating memory ------------------ - -SCM maintains a count of bytes allocated using malloc, and calls the -garbage collector when that number exceeds a dynamically managed limit. -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) - 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 - *WHAT) - - 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 - `must_malloc_cell' and modifies the `cdr' to point to a block of - memory of length LEN. `must_realloc' takes as argument WHERE the - address of a block of memory of length OLEN allocated by - `must_malloc' and returns the address of a block of length LEN. - - The contents of the reallocated block will be unchanged up to the - minimum of the old and new sizes. - - WHAT is a pointer to a string used for error and gc messages. - -`must_malloc', `must_malloc_cell', `must_realloc', and -`must_realloc_cell' must be called with interrupts deferred *Note -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) - `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. - If it is difficult or expensive to calculate then zero may be used - instead. - - -File: scm.info, Node: Embedding SCM, Next: Callbacks, Prev: Allocating memory, Up: Operations - -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) - 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 - 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 - use DUMP (*note Dump::) or DLD. - -Rename main() and arrange your code to call it with an ARGV which sets -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) - 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 - *SCRIPT_ARG) - ARGC and ARGV are as described in main(). SCRIPT_ARG is the - pathname of the SCSH-style script (*note Scripting::) being - invoked; 0 otherwise. `scm_find_execpath' returns the pathname of - the executable being run; if `scm_find_execpath' cannot determine - the pathname, then it returns 0. - -`scm_find_implpath' is defined in `scmmain.c'. Preceeding this are -definitions ofGENERIC_NAME and INIT_GETENV. These, along with IMPLINIT -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) - Returns the full pathname of the Scheme initialization file or 0 - if it cannot find it. - - The string value of the preprocessor variable INIT_GETENV names an - environment variable (default `"SCM_INIT_PATH"'). If this - 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 "Init5d6_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) - 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. - Otherwise, 0 is returned. - - `init_buf0' should be called before any input is read from INPORT. - Its value can be used as the last argument to - scm_init_from_argv(). - - - 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 - processed to accomodate Scheme Scripts (if desired). The scheme - variable *SCRIPT* is set to the string SCRIPT_ARG, or #f if - SCRIPT_ARG is 0. IVERBOSE is the initial prolixity level. If - BUF0STDIN is non-zero, stdin is treated as an unbuffered port. - -Call `init_signals' and `restore_signals' only if you want SCM to -handle interrupts and signals. - - - 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) - Restores the handlers in effect when `init_signals' was called. - - - 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 - implements a read-eval-print loop, is called. - - If TOPLVL_FUN returns, then `scm_top_level' will return as well. - If the return value of TOPLVL_FUN is an immediate integer then it - will be used as the return value of `scm_top_level'. In the main - function supplied with SCM, this return value is the exit status - of the process. - - If the first character of string INITPATH is `;', `(' or - whitespace, then scm_ldstr() is called with INITPATH to initialize - SCM; otherwise INITPATH names a file of Scheme code to be loaded - to initialize SCM. - - When a Scheme error is signaled; control will pass into - `scm_top_level' by `longjmp', error messages will be printed to - `current-error-port', and then TOPLVL_FUN will be called again. - TOPLVL_FUN must maintain enough state to prevent errors from being - resignalled. If `toplvl_fun' can not recover from an error - situation it may simply return. - - - 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. - -You can call indivdual Scheme procedures from C code in the TOPLVL_FUN -argument passed to scm_top_level(), or from module subrs (registered by -an `init_' function, *note Changing Scm::). - -Use `apply' to call Scheme procedures from your C code. For example: - - /* If this apply fails, SCM will catch the error */ - apply(CDR(intern("srv:startup",sizeof("srv:startup")-1)), - mksproc(srvproc), - listofnull); - - func = CDR(intern(rpcname,strlen(rpcname))); - retval = apply(func, cons(mksproc(srvproc), args), EOL); - -Functions for loading Scheme files and evaluating Scheme code given as -C strings are described in the next section, (*note Callbacks::). - -Here is a minimal embedding program `libtest.c': - - /* gcc -o libtest libtest.c libscm.a -ldl -lm -lc */ - #include "scm.h" - /* include patchlvl.h for SCM's INIT_FILE_NAME. */ - #include "patchlvl.h" - - void init_user_scm() - { - fputs("This is init_user_scm\n", stderr); fflush(stderr); - sysintern("*the-string*", makfrom0str("hello world\n")); - } - - SCM user_main() - { - static int done = 0; - if (done++) return MAKINUM(EXIT_FAILURE); - scm_ldstr("(display *the-string*)"); - return MAKINUM(EXIT_SUCCESS); - } - - int main(argc, argv) - int argc; - char **argv; - { - SCM retval; - char *implpath, *execpath; - - 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); - fprintf(stderr, "implpath: %s\n", implpath); - scm_init_from_argv(argc, argv, 0L, 0, 0); - - retval = scm_top_level(implpath, user_main); - - final_scm(!0); - return (int)INUM(retval); - } - - -| - dld_find_executable(./libtest): /home/jaffer/scm/libtest - implpath: /home/jaffer/scm/Init5d6.scm - This is init_user_scm - hello world - - -File: scm.info, Node: Callbacks, Next: Type Conversions, Prev: Embedding SCM, Up: Operations - -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) - Loads the Scheme source file FILE. Returns 0 if successful, non-0 - if not. This function is used to load SCM's initialization file - `Init5d6.scm'. - - - Function: int scm_ldprog (char *FILE) - Loads the Scheme source file `(in-vicinity (program-vicinity) - FILE)'. Returns 0 if successful, non-0 if not. - - This function is useful for compiled code init_ functions to load - non-compiled Scheme (source) files. `program-vicinity' is the - directory from which the calling code was loaded (*note Vicinity: - (slib)Vicinity.). - - - Function: SCM scm_evstr (char *STR) - Returns the result of reading an expression from STR and - evaluating it. - - - 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 -can use a wrapper like this for your Scheme procedures: - - (define (srv:protect proc) - (lambda args - (define result #f) ; put default value here - (call-with-current-continuation - (lambda (cont) - (dynamic-wind (lambda () #t) - (lambda () - (set! result (apply proc args)) - (set! cont #f)) - (lambda () - (if cont (cont #f)))))) - result)) - -Calls to procedures so wrapped will return even if an error occurs. - - -File: scm.info, Node: Type Conversions, Next: Continuations, Prev: Callbacks, Up: Operations - -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) - 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 - was compiled with the `BIGDIG' or `FLOATS' flags. - - 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 - *S_CALLER) - - Function: unsigned short num2ushort (SCM NUM, char *POS, char - *S_CALLER) - - Function: unsigned char num2uchar (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 - number is returned. If not, the `ASSERT' macro calls `wta' with - 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 `num2long' and - `num2ulong' (for when `SCM' is compiled without bignums). To - convert inexact numbers to exact numbers, *Note inexact->exact: - (r5rs)Numerical operations. - - - 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 - messages from error calls by `scm_addr'. - - `scm_addr' is useful for performing C operations on strings or - other uniform arrays (*note Uniform Array::). - - _Note:_ While you use a pointer returned from `scm_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. - - - 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) - 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. - `makfromstrs' is used by `scm_init_from_argv' to convert the - arguments SCM was called with to a `SCM' list which is the value - of SCM procedure calls to `program-arguments' (*note - program-arguments: SCM Session.). - - - 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'. - - `makargvfrmstrs' is useful for constructing argument lists suitable - for passing to `main' functions. - - - 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 - -Continuations -------------- - -The source files `continue.h' and `continue.c' are designed to function -as an independent resource for programs wishing to use continuations, -but without all the rest of the SCM machinery. The concept of -continuations is explained in *Note call-with-current-continuation: -(r5rs)Control features. - -The C constructs `jmp_buf', `setjmp', and `longjmp' implement escape -continuations. On VAX and Cray platforms, the setjmp provided does not -save all the registers. The source files `setjump.mar', `setjump.s', -and `ugsetjump.s' provide implementations which do meet this criteria. - -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 - 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 - 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 - is a pointer to objects of the size specified by `SHORT_ALIGN' - being `#define'd or not. - - - 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 - 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 - Expresses which way the stack grows by its being `#define'd or not. - - - Variable: long thrown_value - Gets set to the VALUE passed to `throw_to_continuation'. - - - 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 - *STACK_BASE) - Allocates (`malloc') storage for a `CONTINUATION' of the current - extent of stack. This newly allocated `CONTINUATION' is returned - if successful, `0' if not. After `make_root_continuation' - returns, the calling routine still needs to - `setjump(NEW_CONTINUATION->jmpbuf)' in order to complete the - capture of this 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 - current top of stack. The newly allocated `CONTINUATION' is - returned if successful, `0'q if not. After `make_continuation' - returns, the calling routine still needs to - `setjump(NEW_CONTINUATION->jmpbuf)' in order to complete the - capture of this continuation. - - - 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 - VALUE, CONTINUATION *ROOT_CONT) - Sets `thrown_value' to VALUE and returns from the continuation - CONT. - - If `CHEAP_CONTINUATIONS' is `#define'd, then - `throw_to_continuation' does `longjump(CONT->jmpbuf, val)'. - - If `CHEAP_CONTINUATIONS' is not `#define'd, the CONTINUATION CONT - contains a copy of a portion of the C stack (whose bound must be - `CONT(ROOT_CONT)->stkbse'). Then: - - * the stack is grown larger than the saved stack, if neccessary. - - * the saved stack is copied back into it's original position. - - * `longjump(CONT->jmpbuf, val)'; - - -File: scm.info, Node: Evaluation, Prev: Continuations, Up: Operations - -Evaluation ----------- - -SCM uses its type representations to speed evaluation. All of the -`subr' types (*note Subr Cells::) are `tc7' types. Since the `tc7' -field is in the low order bit position of the `CAR' it can be retrieved -and dispatched on quickly by dereferencing the SCM pointer pointing to -it and masking the result. - -All the SCM "Special Forms" get translated to immediate symbols -(`isym') the first time they are encountered by the interpreter -(`ceval'). The representation of these immediate symbols is engineered -to occupy the same bits as `tc7'. All the `isym's occur only in the -`CAR' of lists. - -If the `CAR' of a expression to evaluate is not immediate, then it may -be a symbol. If so, the first time it is encountered it will be -converted to an immediate type `ILOC' or `GLOC' (*note Immediates::). -The codes for `ILOC' and `GLOC' lower 7 bits distinguish them from all -the other types we have discussed. - -Once it has determined that the expression to evaluate is not immediate, -`ceval' need only retrieve and dispatch on the low order 7 bits of the -`CAR' of that cell, regardless of whether that cell is a closure, -header, or subr, or a cons containing `ILOC' or `GLOC'. - -In order to be able to convert a SCM symbol pointer to an immediate -`ILOC' or `GLOC', the evaluator must be holding the pointer to the list -in which that symbol pointer occurs. Turning this requirement to an -advantage, `ceval' does not recursively call itself to evaluate symbols -in lists; It instead calls the macro "EVALCAR". `EVALCAR' does symbol -lookup and memoization for symbols, retrieval of values for `ILOC's and -`GLOC's, returns other immediates, and otherwise recursively calls -itself with the `CAR' of the list. - -`ceval' inlines evaluation (using `EVALCAR') of almost all procedure -call arguments. When `ceval' needs to evaluate a list of more than -length 3, the procedure `eval_args' is called. So `ceval' can be said -to have one level lookahead. The avoidance of recursive invocations of -`ceval' for the most common cases (special forms and procedure calls) -results in faster execution. The speed of the interpreter is currently -limited on most machines by interpreter size, probably having to do -with its cache footprint. In order to keep the size down, certain -`EVALCAR' calls which don't need to be fast (because they rarely occur -or because they are part of expensive operations) are instead calls to -the C function `evalcar'. - - - 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 - 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 - and how far in to go for the value. When this immediate object is - subsequently encountered, the value can be retrieved quickly. - -`ILOC's work up to a maximum depth of 4096 frames or 4096 identifiers -in a frame. Radey Shouman added "FARLOC" to handle cases exceeding -these limits. A `FARLOC' consists of a pair whose CAR is the immediate -type `IM_FARLOC_CAR' or `IM_FARLOC_CDR', and whose CDR is a pair of -INUMs specifying the frame and distance with a larger range than -`ILOC's span. - -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 - 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 - reserved for GCmark; But, since references to variables in the - code always occur in the `CAR' position and the GCmark is in the - `CDR', there is no conflict. - -If the compile FLAG `CAUTIOUS' is #defined then the number of arguments -is always checked for application of closures. If the compile FLAG -`RECKLESS' is #defined then they are not checked. Otherwise, number of -argument checks for closures are made only when the function position -(whose value is the closure) of a combination is not an `ILOC' or -`GLOC'. When the function position of a combination is a symbol it -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 - `EVAL' Returns the result of evaluating EXPRESSION in ENV. - `SIDEVAL' evaluates EXPRESSION in ENV when the value of the - expression is not used. - - Both of these macros alter the list structure of EXPRESSION as it - is memoized and hence should be used only when it is known that - EXPRESSION will not be referenced again. The C function `eval' is - safe from this problem. - - - 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'. - - -File: scm.info, Node: Program Self-Knowledge, Next: Improvements To Make, Prev: Operations, Up: The Implementation - -Program Self-Knowledge -====================== - -* Menu: - -* File-System Habitat:: -* Executable Pathname:: -* Script Support:: - - -File: scm.info, Node: File-System Habitat, Next: Executable Pathname, Prev: Program Self-Knowledge, Up: Program Self-Knowledge - -File-System Habitat -------------------- - -Where should software reside? Although individually a minor annoyance, -cumulatively this question represents many thousands of frustrated user -hours spent trying to find support files or guessing where packages need -to be installed. Even simple programs require proper habitat; games -need to find their score files. - -Aren't there standards for this? Some Operating Systems have devised -regimes of software habitats - only to have them violated by large -software packages and imports from other OS varieties. - -In some programs, the expected locations of support files are fixed at -time of compilation. This means that the program may not run on -configurations unanticipated by the authors. Compiling locations into a -program also can make it immovable - necessitating recompilation to -install it. - - Programs of the world unite! You have nothing to lose but loss - itself. - -The function `find_impl_file' in `scm.c' is an attempt to create a -utility (for inclusion in programs) which will hide the details of -platform-dependent file habitat conventions. It takes as input the -pathname of the executable file which is running. If there are systems -for which this information is either not available or unrelated to the -locations of support files, then a higher level interface will be -needed. - - - 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 - program. Return a newly allocated string of the path if - successful, 0 if not. The SEP argument is a _null-terminated - string_ of the character used to separate directory components. - - * One convention is to install the support files for an executable - program in the same directory as the program. This possibility is - tried first, which satisfies not only programs using this - convention, but also uninstalled builds when testing new releases, - etc. - - * Another convention is to install the executables in a directory - named `bin', `BIN', `exe', or `EXE' and support files in a - directroy named `lib', which is a peer the executable directory. - This arrangement allows multiple executables can be stored in a - single directory. For example, the executable might be in - `/usr/local/bin/' and initialization file in `/usr/local/lib/'. - - If the executable directory name matches, the peer directroy `lib' - is tested for INITNAME. - - * Sometimes `lib' directories become too crowded. So we look in any - subdirectories of `lib' or `src' having the name (sans type suffix - such as `.EXE') of the program we are running. For example, the - executable might be `/usr/local/bin/foo' and initialization file - in `/usr/local/lib/foo/'. - - * But the executable name may not be the usual program name; So also - look in any GENERIC_NAME subdirectories of `lib' or `src' peers. - - * Finally, if the name of the executable file being run has a (system - dependent) suffix which is not needed to invoke the program, then - look in a subdirectory (of the one containing the executable file) - named for the executable (without the suffix); And look in a - GENERIC_NAME subdirectory. For example, the executable might be - `C:\foo\bar.exe' and the initialization file in `C:\foo\bar\'. - - -File: scm.info, Node: Executable Pathname, Next: Script Support, Prev: File-System Habitat, Up: Program Self-Knowledge - -Executable Pathname -------------------- - -For purposes of finding `Init5d6.scm', dumping an executable, and -dynamic linking, a SCM session needs the pathname of its executable -image. - -When a program is executed by MS-DOS, the full pathname of that -executable is available in `argv[0]'. This value can be passed -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) - `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 - directory listed for COMMAND, and returns the absolute path name - for the first occurrence. Thus, it is advisable to invoke - `dld_init' as: - - main (int argc, char **argv) - { - ... - if (dld_init (dld_find_executable (argv[0]))) { - ... - } - ... - } - - *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'. - - -File: scm.info, Node: Script Support, Prev: Executable Pathname, Up: Program Self-Knowledge - -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) - `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) - 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 - invoked is substituted for the corresponding meta-argument. - - If the script does not have a meta-argument, or if the file named - by the argument following a meta-argument cannot be opened for - reading, then 0 is returned. - - `script_process_argv' correctly processes argument vectors of - nested script invocations. - - - 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 - -Improvements To Make -==================== - - * Allow users to set limits for `malloc()' storage. - - * Prefix and make more uniform all C function, variable, and constant - names. Provide a file full of #define's to provide backward - compatability. - - * `lgcd()' _needs_ to generate at most one bignum, but currently - generates more. - - * `divide()' could use shifts instead of multiply and divide when - scaling. - - * Currently, `dump'ing an executable does not preserve ports. When - loading a `dump'ed executable, disk files could be reopened to the - same file and position as they had when the executable was dumped. - - * Copying all of the stack is wasteful of storage. Any time a - call-with-current-continuation is called the stack could be - re-rooted with a frame which calls the contin just created. This - in combination with checking stack depth could also be used to - allow stacks deeper than 64K on the IBM PC. - - * In the quest for speed, there has been some discussion about a - "Forth" style Scheme interpreter. - - Provided there is still type code space available in SCM, if - we devote some of the IMCAR codes to "inlined" operations, we - should get a significant performance boost. What is - eliminated is the having to look up a `GLOC' or `ILOC' and - then dispatch on the subr type. The IMCAR operation would be - dispatched to directly. Another way to view this is that we - make available special form versions of `CAR', `CDR', etc. - Since the actual operation code is localized in the - interpreter, it is much easier than uncompilation and then - recompilation to handle `(trace car)'; For instance a switch - gets set which tells the interpreter to instead always look - up the values of the associated symbols. - - -* Menu: - -* Finishing Dynamic Linking:: - - -File: scm.info, Node: Finishing Dynamic Linking, Prev: Improvements To Make, Up: Improvements To Make - -Finishing Dynamic Linking -------------------------- - -Scott Schwartz <schwartz@galapagos.cse.psu.edu> suggests: One way to -tidy up the dynamic loading stuff would be to grab the code from perl5. - -VMS -... - -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 -with a VMS system needs to finish and debug it. - - 1. Say you have this `main.c' program: - - main() - {init_lisp(); - lisp_repl();} - - 2. and you have your lisp in files `repl.c', `gc.c', `eval.c' and - there are some toplevel non-static variables in use called - `the_heap', `the_environment', and some read-only toplevel - structures, such as `the_subr_table'. - - $ LINK/SHARE=LISPRTL.EXE/DEBUG REPL.OBJ,GC.OBJ,EVAL.OBJ,LISPRTL.OPT/OPT - - 3. where `LISPRTL.OPT' must contain at least this: - - SYS$LIBRARY:VAXCRTL/SHARE - UNIVERSAL=init_lisp - UNIVERSAL=lisp_repl - PSECT_ATTR=the_subr_table,SHR,NOWRT,LCL - PSECT_ATTR=the_heap,NOSHR,LCL - PSECT_ATTR=the_environment,NOSHR,LCL - - _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. - - `SHR,NOWRT' - means shared-read-only. Which is the default for code, and - is also good for efficiency of some data structures. - - `NOSHR,LCL' - is what you want for everything else. - - Note: If you do not have a handy list of all these toplevel - variables, do not dispair. Just do your link with the - /MAP=LISPRTL.MAP/FULL and then search the map file, - - $SEARCH/OUT=LISPRTL.LOSERS LISPRTL.MAP ", SHR,NOEXE, RD, WRT" - - And use an emacs keyboard macro to muck the result into the proper - form. Of course only the programmer can tell if things can be - made read-only. I have a DCL command procedure to do this if you - want it. - - 4. Now MAIN.EXE would be linked thusly: - - $ DEFINE LISPRTL USER$DISK:[JAFFER]LISPRTL.EXE - - $LINK MAIN.OBJ,SYS$INPUT:/OPT - SYS$LIBRARY:VAXCRTL/SHARE - 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. - - 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. - - $ CC MYSUBRS.C - $ LINK/SHARE=MYSUBRS.EXE MYSUBRS.OBJ,SYS$INPUT:/OPT - SYS$LIBRARY:VAXCRTL/SHARE - LISPRTL/SHARE - UNIVERSAL=INIT_MYSUBRS - - Ok. Another hint is that you can avoid having to add the `PSECT' - declaration of `NOSHR,LCL' by declaring variables `status' in the - C language source. That works great for most things. - - 6. Then the dynamic loader would have to do this: - - {void (*init_fcn)(); - long retval; - retval = lib$find_image_symbol("MYSUBRS","INIT_MYSUBRS",&init_fcn, - "SYS$DISK:[].EXE"); - if (retval != SS$_NORMAL) error(...); - (*init_fcn)();} - - But of course all string arguments must be `(struct dsc$descriptor - *)' and the last argument is optional if `MYSUBRS' is defined as a - logical name or if `MYSUBRS.EXE' has been copied over to - `SYS$SHARE'. The other consideration is that you will want to turn - off <C-c> or other interrupt handling while you are inside most - `lib$' calls. - - As far as the generation of all the `UNIVERSAL=...' declarations. - Well, you could do well to have that automatically generated from - the public `LISPRTL.H' file, of course. - - VMS has a good manual called the `Guide to Writing Modular - Procedures' or something like that, which covers this whole area - rather well, and also talks about advanced techniques, such as a - way to declare a program section with a pointer to a procedure - that will be automatically invoked whenever any shared image is - dynamically activated. Also, how to set up a handler for normal - or abnormal program exit so that you can clean up side effects - (such as opening a database). But for use with `LISPRTL' you - probably don't need that hair. - - One fancier option that is useful under VMS for `LISPLIB.EXE' is to - define all your exported procedures through an "call vector" - instead of having them just be pointers into random places in the - image, which is what you get by using `UNIVERSAL'. - - If you set up the call vector thing correctly it will allow you to - modify and relink `LISPLIB.EXE' without having to relink programs - that have been linked against it. - -Windows NT -.......... - -George Carrette (gjc@mitech.com) outlines how to dynamically link on -Windows NT: - - * The Software Developers Kit has a sample called SIMPLDLL. Here is - the gist of it, following along the lines of the VMS description - above (contents of a makefile for the SDK NMAKE) - - LISPLIB.exp: - LISPLIB.lib: LISPLIB.def - $(implib) -machine:$(CPU) -def:LISPLIB.def -out:LISPLIB.lib - - LISPLIB.DLL : $(LISPLIB_OBJS) LISPLIB.EXP - $(link) $(linkdebug) \ - -dll \ - -out:LISPLIB.DLL \ - LISPLIB.EXP $(LISPLIB_OBJS) $(conlibsdll) - - * The `LISPDEF.DEF' file has this: - - LIBRARY lisplib - EXPORT - init_lisp - init_repl - - * And `MAIN.EXE' using: - - CLINK = $(link) $(ldebug) $(conflags) -out:$*.exe $** $(conlibsdll) - - MAIN.EXE : MAIN.OBJ LISPLIB.LIB - $(CLINK) - - * And `MYSUBRS.DLL' is produced using: - - mysubrs.exp: - mysubrs.lib: mysubrs.def - $(implib) -machine:$(CPU) -def:MYSUBRS.def -out:MYSUBRS.lib - - mysubrs.dll : mysubrs.obj mysubrs.exp mysubrs.lib - $(link) $(linkdebug) \ - -dll \ - -out:mysubrs.dll \ - MYSUBRS.OBJ MYSUBRS.EXP LISPLIB.LIB $(conlibsdll) - - * Where `MYSUBRS.DEF' has - - LIBRARY mysubrs - EXPORT - INIT_MYSUBRS - - * And the dynamic loader looks something like this, calling the two - procedures `LoadLibrary' and `GetProcAddress'. - - LISP share_image_load(LISP fname) - {long iflag; - LISP retval,(*fcn)(void); - HANDLE hLib; - DWORD err; - char *libname,fcnname[64]; - iflag = nointerrupt(1); - libname = c_string(fname); - _snprintf(fcnname,sizeof(fcnname),"INIT_%s",libname); - if (!(hLib = LoadLibrary(libname))) - {err = GetLastError(); - retval = list2(fname,LSPNUM(err)); - serror1("library failed to load",retval);} - if (!(fcn = (LISP (*)(void)) GetProcAddress(hLib,fcnname))) - {err = GetLastError(); - retval = list2(fname,LSPNUM(err)); - serror1("could not find library init procedure",retval);} - retval = (*fcn)(); - nointerrupt(iflag); - return(retval);} - - * _Note:_ in VMS the linker and dynamic loader is case sensitive, but - all the language compilers, including C, will by default upper-case - external symbols for use by the linker, although the debugger gets - its own symbols and case sensitivity is language mode dependant. - In Windows NT things are case sensitive generally except for file - and device names, which are case canonicalizing like in the - Symbolics filesystem. - - * _Also:_ All this WINDOWS NT stuff will work in MS-DOS MS-Windows - 3.1 too, by a method of compiling and linking under Windows NT, - and then copying various files over to MS-DOS/WINDOWS. - - -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. -* #': Syntax Extensions. -* #+: Syntax Extensions. -* #-: Syntax Extensions. -* #.: Syntax Extensions. -* #;text-till-end-of-line: Syntax Extensions. -* #\token: Syntax Extensions. -* #|: Syntax Extensions. -* $abs: Numeric. -* $acos: Numeric. -* $acosh: Numeric. -* $asin: Numeric. -* $asinh: Numeric. -* $atan: Numeric. -* $atan2: Numeric. -* $atanh: Numeric. -* $cos: Numeric. -* $cosh: Numeric. -* $exp: Numeric. -* $expt: Numeric. -* $log: Numeric. -* $log10: Numeric. -* $sin: Numeric. -* $sinh: Numeric. -* $sqrt: Numeric. -* $tan: Numeric. -* $tanh: Numeric. -* -: SCM Options. -* ---: SCM Options. -* ---c-source-files=: Build Options. -* ---compiler-options=: Build Options. -* ---defines=: Build Options. -* ---features=: Build Options. -* ---help: SCM Options. -* ---initialization=: Build Options. -* ---libraries=: Build Options. -* ---linker-options=: Build Options. -* ---no-init-file: SCM Options. -* ---object-files=: Build Options. -* ---outname=: Build Options. -* ---platform=: Build Options. -* ---scheme-initial=: Build Options. -* ---type=: Build Options. -* ---version: SCM Options. -* --batch-dialect=: Build Options. -* --script-name=: Build Options. -* -a: SCM Options. -* -b: SCM Options. -* -c <1>: SCM Options. -* -c: Build Options. -* -d: SCM Options. -* -D: Build Options. -* -e: SCM Options. -* -f: SCM Options. -* -F: Build Options. -* -h <1>: SCM Options. -* -h: Build Options. -* -i <1>: SCM Options. -* -i: Build Options. -* -j: Build Options. -* -l <1>: SCM Options. -* -l: Build Options. -* -m: SCM Options. -* -no-init-file: SCM Options. -* -o <1>: SCM Options. -* -o: Build Options. -* -p <1>: SCM Options. -* -p: Build Options. -* -q: SCM Options. -* -r: SCM Options. -* -s <1>: SCM Options. -* -s: Build Options. -* -t: Build Options. -* -u: SCM Options. -* -v: SCM Options. -* -w: Build Options. -* @apply: Low Level Syntactic Hooks. -* @copy-tree: Miscellaneous Procedures. -* @macroexpand1: Syntactic Hooks for Hygienic Macros. -* _exclusive: Files and Ports. -* _ionbf: Files and Ports. -* _tracked: Files and Ports. -* abort: Internal State. -* access: I/O-Extensions. -* acct: Unix Extensions. -* acons: Miscellaneous Procedures. -* acosh: Numeric. -* add-alias: Configure Module Catalog. -* add-finalizer: Interrupts. -* add-link: Configure Module Catalog. -* add-source: Configure Module Catalog. -* alarm: Interrupts. -* alarm-interrupt: Interrupts. -* ALLOW_INTS: Signals. -* alrm_signal: Signals. -* ARGC: Cells. -* arithmetic-error: Interrupts. -* array->list: Conventional Arrays. -* array-contents: Conventional Arrays. -* array-copy!: Conventional Arrays. -* array-dimensions: Conventional Arrays. -* array-equal?: Conventional Arrays. -* array-fill!: Conventional Arrays. -* array-for-each: Array Mapping. -* array-in-bounds?: Conventional Arrays. -* array-index-map!: Array Mapping. -* array-map!: Array Mapping. -* array-prototype: Uniform Array. -* array-rank: Conventional Arrays. -* array-ref: Conventional Arrays. -* array-set!: Conventional Arrays. -* array-shape: Conventional Arrays. -* array? <1>: Uniform Array. -* array?: Conventional Arrays. -* asinh: Numeric. -* ASRTGO: C Macros. -* ASSERT: C Macros. -* atanh: Numeric. -* bit-count: Bit Vectors. -* bit-count*: Bit Vectors. -* bit-invert!: Bit Vectors. -* bit-position: Bit Vectors. -* bit-set*!: Bit Vectors. -* boot-tail <1>: Dump. -* boot-tail: SCM Session. -* box: Curses Miscellany. -* broken-pipe: Posix Extensions. -* call-with-outputs: Files and Ports. -* CAR: Cells. -* cbreak: Terminal Mode Setting. -* CCLO_LENGTH: Header Cells. -* CDR: Cells. -* char: Type Conversions. -* char-ready: Files and Ports. -* char-ready? <1>: Socket. -* char-ready?: Files and Ports. -* CHARS: Header Cells. -* chdir: I/O-Extensions. -* CHEAP_CONTINUATIONS: Continuations. -* chmod: I/O-Extensions. -* chown: Posix Extensions. -* clearok: Output Options Setting. -* close-port <1>: Window Manipulation. -* close-port <2>: Posix Extensions. -* close-port: Files and Ports. -* closedir: I/O-Extensions. -* CLOSEDP: Ptob Cells. -* CLOSUREP: Cells. -* CODE: Cells. -* comment: Syntax Extensions. -* CONSP: Cells. -* copy-tree: Miscellaneous Procedures. -* cosh: Numeric. -* could-not-open: Interrupts. -* current-error-port: Files and Ports. -* current-input-port: Files and Ports. -* current-time: Time. -* default-input-port: Line Editing. -* default-output-port: Line Editing. -* defconst: Syntax Extensions. -* DEFER_INTS: Signals. -* defined?: Syntax Extensions. -* defmacro: Syntax Extensions. -* defsyntax: Low Level Syntactic Hooks. -* defvar: Syntax Extensions. -* dimensions->uniform-array: Uniform Array. -* directory-for-each: I/O-Extensions. -* display: Output. -* dld_find_executable: Executable Pathname. -* dump: Dump. -* duplicate-port: I/O-Extensions. -* dyn:call: Dynamic Linking. -* dyn:link: Dynamic Linking. -* dyn:main-call: Dynamic Linking. -* dyn:unlink: Dynamic Linking. -* echo: Terminal Mode Setting. -* ed: Editing Scheme Code. -* enclose-array: Conventional Arrays. -* end-of-program: Interrupts. -* endwin: Curses. -* ENV: Cells. -* errno: Errors. -* error: Errors. -* eval: Evaluation. -* EVAL: Evaluation. -* eval: Miscellaneous Procedures. -* eval-string: Miscellaneous Procedures. -* exec-self: Internal State. -* execl: I/O-Extensions. -* execlp: I/O-Extensions. -* execpath: Internal State. -* execv: I/O-Extensions. -* execvp: I/O-Extensions. -* exit: SCM Session. -* extended-environment: Syntactic Hooks for Hygienic Macros. -* file-position: I/O-Extensions. -* file-set-position: I/O-Extensions. -* fileno: I/O-Extensions. -* final_scm: Embedding SCM. -* find_impl_file: File-System Habitat. -* force-output: Window Manipulation. -* fork: Posix Extensions. -* FPORTP: Ptob Cells. -* free_continuation: Continuations. -* freshline: Files and Ports. -* gc: Internal State. -* gc-hook: Interrupts. -* gc_mark: Marking Cells. -* GCCDR: Marking Cells. -* GCTYP16: Marking Cells. -* gentemp: Syntax Extensions. -* get-internal-real-time: Time. -* get-internal-run-time: Time. -* getcwd: I/O-Extensions. -* getegid: Posix Extensions. -* geteuid: Posix Extensions. -* getgid: Posix Extensions. -* getgr: Posix Extensions. -* getgroups: Posix Extensions. -* gethost: Host Data. -* getlogin: Posix Extensions. -* getnet: Host Data. -* getpeername: Internet Addresses and Socket Names. -* getpid: I/O-Extensions. -* getppid: Posix Extensions. -* getproto: Host Data. -* getpw: Posix Extensions. -* getserv: Host Data. -* getsockname: Internet Addresses and Socket Names. -* getuid: Posix Extensions. -* getyx: Input. -* hang-up: Interrupts. -* ICHR: Immediates. -* ICHRP: Immediates. -* identifier->symbol: Syntactic Hooks for Hygienic Macros. -* identifier-equal?: Syntactic Hooks for Hygienic Macros. -* identifier?: Syntactic Hooks for Hygienic Macros. -* idlok: Output Options Setting. -* IFLAGP: Immediates. -* IMP: Immediates. -* inet:address->string: Internet Addresses and Socket Names. -* inet:local-network-address: Internet Addresses and Socket Names. -* inet:make-address: Internet Addresses and Socket Names. -* inet:network: Internet Addresses and Socket Names. -* inet:string->address: Internet Addresses and Socket Names. -* init_buf0: Embedding SCM. -* init_sbrk: Embedding SCM. -* init_signals <1>: Embedding SCM. -* init_signals: Signals. -* initscr: Curses. -* INPORTP: Ptob Cells. -* int_signal: Signals. -* integer->line-number: Line Numbers. -* INUM: Immediates. -* INUMP: Immediates. -* isatty?: Files and Ports. -* ISYMCHARS: Immediates. -* ISYMNUM: Immediates. -* ISYMP: Immediates. -* kill: Posix Extensions. -* leaveok: Output Options Setting. -* LENGTH: Header Cells. -* line-editing: Line Editing. -* line-number: Miscellaneous Procedures. -* line-number->integer: Line Numbers. -* line-number?: Line Numbers. -* link: Posix Extensions. -* list->uniform-array: Uniform Array. -* list-file: Miscellaneous Procedures. -* load: Dynamic Linking. -* load-string: Miscellaneous Procedures. -* logaref: Uniform Array. -* logaset!: Uniform Array. -* long: Type Conversions. -* long2num: Type Conversions. -* lstat: Unix Extensions. -* macroexpand: Syntax Extensions. -* macroexpand-1: Syntax Extensions. -* main: Embedding SCM. -* makargvfrmstrs: Type Conversions. -* makcclo: Header Cells. -* make-arbiter: Process Synchronization. -* make-array: Conventional Arrays. -* make-edited-line-port: Line Editing. -* make-exchanger: Process Synchronization. -* make-shared-array: Conventional Arrays. -* make-soft-port: Soft Ports. -* make-stream-socket: Socket. -* make-stream-socketpair: Socket. -* make_continuation: Continuations. -* make_gsubr: Defining Subrs. -* make_root_continuation: Continuations. -* makfrom0str: Type Conversions. -* makfromstr: Type Conversions. -* makfromstrs: Type Conversions. -* MAKICHR: Immediates. -* MAKIFLAG: Immediates. -* MAKINUM: Immediates. -* MAKISYM: Immediates. -* MAKSPCSYM: Immediates. -* mark_locations: Marking Cells. -* milli-alarm: Interrupts. -* mkdir: I/O-Extensions. -* mknod: Unix Extensions. -* must_free: Allocating memory. -* must_free_argv: Type Conversions. -* must_malloc: Allocating memory. -* must_malloc_cell: Allocating memory. -* must_realloc: Allocating memory. -* must_realloc_cell: Allocating memory. -* mvwin: Window Manipulation. -* NCONSP: Cells. -* NEWCELL: Cells. -* newwin: Window Manipulation. -* nice: Unix Extensions. -* NIMP: Immediates. -* NINUMP: Immediates. -* nl: Terminal Mode Setting. -* nocbreak: Terminal Mode Setting. -* nodelay: Output Options Setting. -* noecho: Terminal Mode Setting. -* nonl: Terminal Mode Setting. -* noraw: Terminal Mode Setting. -* NSTRINGP: Header Cells. -* num2long: Type Conversions. -* NVECTORP: Header Cells. -* open-file: Files and Ports. -* open-input-pipe: Posix Extensions. -* open-output-pipe: Posix Extensions. -* open-pipe: Posix Extensions. -* open-ports: Files and Ports. -* opendir: I/O-Extensions. -* OPENP: Ptob Cells. -* OPFPORTP: Ptob Cells. -* OPINFPORTP: Ptob Cells. -* OPINPORTP: Ptob Cells. -* OPOUTFPORTP: Ptob Cells. -* OPOUTPORTP: Ptob Cells. -* OPPORTP: Ptob Cells. -* out-of-storage: Interrupts. -* OUTPORTP: Ptob Cells. -* overlay: Window Manipulation. -* overwrite: Window Manipulation. -* perror: Errors. -* pi*: Numeric. -* pi/: Numeric. -* pipe: Posix Extensions. -* port-closed?: Files and Ports. -* port-column: Miscellaneous Procedures. -* port-filename: Miscellaneous Procedures. -* port-line: Miscellaneous Procedures. -* port-type: Files and Ports. -* PORTP: Ptob Cells. -* print <1>: Miscellaneous Procedures. -* print: Debugging Scheme Code. -* print-args: Debugging Scheme Code. -* procedure->identifier-macro: Low Level Syntactic Hooks. -* procedure->macro: Low Level Syntactic Hooks. -* procedure->memoizing-macro: Low Level Syntactic Hooks. -* procedure->syntax: Low Level Syntactic Hooks. -* procedure-documentation: Syntax Extensions. -* profile-alarm: Interrupts. -* profile-alarm-interrupt: Interrupts. -* program-arguments: SCM Session. -* putenv: I/O-Extensions. -* qase: Syntax Extensions. -* quit: SCM Session. -* raw: Terminal Mode Setting. -* read-char <1>: Input. -* read-char: Files and Ports. -* read-numbered: Line Numbers. -* read:sharp: Low Level Syntactic Hooks. -* read:sharp-char: Low Level Syntactic Hooks. -* readdir: I/O-Extensions. -* readlink: Unix Extensions. -* record-printer-set!: Records. -* redirect-port!: I/O-Extensions. -* refresh: Window Manipulation. -* regcomp: Regular Expression Pattern Matching. -* regerror: Regular Expression Pattern Matching. -* regexec: Regular Expression Pattern Matching. -* regmatch: Regular Expression Pattern Matching. -* regmatch?: Regular Expression Pattern Matching. -* regmatchv: Regular Expression Pattern Matching. -* regsearch: Regular Expression Pattern Matching. -* regsearchv: Regular Expression Pattern Matching. -* release-arbiter: Process Synchronization. -* rename-file: I/O-Extensions. -* renamed-identifier: Syntactic Hooks for Hygienic Macros. -* renaming-transformer: Syntactic Hooks for Hygienic Macros. -* reopen-file: I/O-Extensions. -* require: Dynamic Linking. -* resetty: Terminal Mode Setting. -* restart: Internal State. -* restore_signals: Embedding SCM. -* rewinddir: I/O-Extensions. -* rmdir: I/O-Extensions. -* room: Internal State. -* savetty: Terminal Mode Setting. -* scalar->array: Array Mapping. -* scm_evstr: Callbacks. -* scm_find_execpath: Embedding SCM. -* scm_find_implpath: Embedding SCM. -* scm_init_from_argv: Embedding SCM. -* scm_ldfile: Callbacks. -* scm_ldprog: Callbacks. -* scm_ldstr: Callbacks. -* scm_top_level: Embedding SCM. -* script_count_argv: Script Support. -* script_find_executable: Script Support. -* script_process_argv: Script Support. -* scroll: Output. -* scrollok: Output Options Setting. -* serial-array-copy!: Conventional Arrays. -* serial-array-map!: Array Mapping. -* set!: Syntax Extensions. -* setegid: Posix Extensions. -* seteuid: Posix Extensions. -* setgid: Posix Extensions. -* setgrent: Posix Extensions. -* sethostent: Host Data. -* setnetent: Host Data. -* setprotoent: Host Data. -* setpwent: Posix Extensions. -* setservent: Host Data. -* setuid: Posix Extensions. -* short: Type Conversions. -* SHORT_ALIGN: Continuations. -* SIDEVAL: Evaluation. -* sinh: Numeric. -* socket-name:address: Internet Addresses and Socket Names. -* socket-name:family: Internet Addresses and Socket Names. -* socket-name:port-number: Internet Addresses and Socket Names. -* socket:accept: Socket. -* socket:bind: Socket. -* socket:connect: Socket. -* socket:listen: Socket. -* socket:shutdown: Socket. -* stack-trace: Errors. -* STACK_GROWS_UP: Continuations. -* stack_size: Continuations. -* stat: I/O-Extensions. -* STREAM: Ptob Cells. -* string-edit: Regular Expression Pattern Matching. -* string-split: Regular Expression Pattern Matching. -* string-splitv: Regular Expression Pattern Matching. -* STRINGP: Header Cells. -* subwin: Window Manipulation. -* SYMBOLP: Header Cells. -* symlink: Unix Extensions. -* sync: Unix Extensions. -* syntax-quote: Syntactic Hooks for Hygienic Macros. -* syntax-rules: Syntax Extensions. -* tanh: Numeric. -* terms: Miscellaneous Procedures. -* the-macro: Syntactic Hooks for Hygienic Macros. -* throw_to_continuation: Continuations. -* ticks: Interrupts. -* ticks-interrupt: Interrupts. -* touchline: Window Manipulation. -* touchwin: Window Manipulation. -* trace: Debugging Scheme Code. -* transpose-array: Conventional Arrays. -* try-arbiter: Process Synchronization. -* try-create-file: I/O-Extensions. -* try-load <1>: Line Numbers. -* try-load: Miscellaneous Procedures. -* try-open-file: Files and Ports. -* ttyname: Posix Extensions. -* TYP16: Cells. -* TYP3: Cells. -* TYP7: Cells. -* UCHARS: Header Cells. -* ulong2num: Type Conversions. -* umask: I/O-Extensions. -* uname: Posix Extensions. -* unctrl: Curses Miscellany. -* uniform-array-read!: Uniform Array. -* uniform-array-write: Uniform Array. -* uniform-vector-fill!: Uniform Array. -* untrace: Debugging Scheme Code. -* user-interrupt: Interrupts. -* usr:lib: Dynamic Linking. -* utime: I/O-Extensions. -* vector-set-length!: Miscellaneous Procedures. -* VECTORP: Header Cells. -* VELTS: Header Cells. -* verbose: Internal State. -* virtual-alarm: Interrupts. -* virtual-alarm-interrupt: Interrupts. -* vms-debug: SCM Session. -* void: Sweeping the Heap. -* wadd: Output. -* wait-for-input: Files and Ports. -* waitpid: Posix Extensions. -* warn: Errors. -* wclear: Output. -* wclrtobot: Output. -* wclrtoeol: Output. -* wdelch: Output. -* wdeleteln: Output. -* werase: Output. -* winch: Input. -* winsch: Output. -* winsertln: Output. -* with-error-to-file: Files and Ports. -* with-error-to-port: Files and Ports. -* with-input-from-port: Files and Ports. -* with-output-to-port: Files and Ports. -* wmove: Window Manipulation. -* wstandend: Curses Miscellany. -* wstandout: Curses Miscellany. -* x:lib: Dynamic Linking. - -Variable Index -************** - -This is an alphabetical list of all the global variables in SCM. - -* Menu: - -* $pi: Numeric. -* *argv*: SCM Variables. -* *execpath: Embedding SCM. -* *interactive* <1>: Internal State. -* *interactive*: SCM Variables. -* *load-pathname*: Miscellaneous Procedures. -* *load-reader*: Line Numbers. -* *scm-version*: Internal State. -* *slib-load-reader*: Line Numbers. -* *syntax-rules*: SCM Variables. -* af_inet: Host Data. -* af_unix: Host Data. -* BOOL_F: Immediates. -* BOOL_T: Immediates. -* EDITOR: SCM Variables. -* EOF_VAL: Immediates. -* EOL: Immediates. -* errobj: Errors. -* HOME: SCM Variables. -* internal-time-units-per-second: Time. -* INUM0: Immediates. -* isymnames: Immediates. -* most-negative-fixnum: Numeric. -* most-positive-fixnum: Numeric. -* NUM_ISPCSYM: Immediates. -* NUM_ISYMS: Immediates. -* open_both: Files and Ports. -* open_read: Files and Ports. -* open_write: Files and Ports. -* pi: Numeric. -* SCHEME_LIBRARY_PATH: SCM Variables. -* SCM_INIT_PATH: SCM Variables. -* symhash: Evaluation. -* thrown_value: Continuations. -* UNDEFINED: Immediates. -* UNSPECIFIED: Immediates. - -Type Index -********** - -This is an alphabetical list of data types and feature names in SCM. - -* Menu: - -* #! <1>: MS-DOS Compatible Scripts. -* #!: Unix Scheme Scripts. -* array-for-each: Array Mapping. -* CELLPTR: Immediates. -* CONTINUATION: Continuations. -* curses: Dynamic Linking. -* dump: Dump. -* FARLOC: Evaluation. -* GLOC: Evaluation. -* gloc: Immediates. -* i/o-extensions: Socket. -* ichr: Immediates. -* iflags: Immediates. -* ILOC: Evaluation. -* iloc: Immediates. -* inum: Immediates. -* ispcsym: Immediates. -* isym: Immediates. -* meta-argument <1>: Script Support. -* meta-argument: Unix Scheme Scripts. -* ptob: Ptob Cells. -* regex: Dynamic Linking. -* rev2-procedures: Dynamic Linking. -* rev3-procedures: Dynamic Linking. -* Scheme Script <1>: MS-DOS Compatible Scripts. -* Scheme Script: Unix Scheme Scripts. -* Scheme-Script <1>: MS-DOS Compatible Scripts. -* Scheme-Script: Unix Scheme Scripts. -* smob: Smob Cells. -* socket: Socket. -* spare: Header Cells. -* STACKITEM: Continuations. -* tc16_arbiter: Smob Cells. -* tc16_array: Smob Cells. -* tc16_bigneg: Smob Cells. -* tc16_bigpos: Smob Cells. -* tc16_flo: Smob Cells. -* tc16_inpipe: Ptob Cells. -* tc16_inport: Ptob Cells. -* tc16_ioport: Ptob Cells. -* tc16_macro: Smob Cells. -* tc16_outpipe: Ptob Cells. -* tc16_outport: Ptob Cells. -* tc16_promise: Smob Cells. -* tc16_sfport: Ptob Cells. -* tc16_strport: Ptob Cells. -* tc3_closure: Cells. -* tc3_cons: Cells. -* tc7_asubr: Subr Cells. -* tc7_bvect: Header Cells. -* tc7_contin: Header Cells. -* tc7_cvect: Header Cells. -* tc7_cxr: Subr Cells. -* tc7_dvect: Header Cells. -* tc7_fvect: Header Cells. -* tc7_ivect: Header Cells. -* tc7_lsubr: Subr Cells. -* tc7_lsubr_2: Subr Cells. -* tc7_msymbol: Header Cells. -* tc7_rpsubr: Subr Cells. -* tc7_specfun: Header Cells. -* tc7_ssymbol: Header Cells. -* tc7_string: Header Cells. -* tc7_subr_0: Subr Cells. -* tc7_subr_1: Subr Cells. -* tc7_subr_1o: Subr Cells. -* tc7_subr_2: Subr Cells. -* tc7_subr_2o: Subr Cells. -* tc7_subr_3: Subr Cells. -* tc7_svect: Header Cells. -* tc7_uvect: Header Cells. -* tc7_vector: Header Cells. -* tc_dblc: Smob Cells. -* tc_dblr: Smob Cells. -* tc_free_cell: Smob Cells. -* turtle-graphics: Dynamic Linking. -* unexec: Dump. - -This is an alphabetical list of concepts introduced in this manual. - -Concept Index -************* - -* Menu: - -* !#: MS-DOS Compatible Scripts. -* !#.exe: MS-DOS Compatible Scripts. -* #!: MS-DOS Compatible Scripts. -* #!.bat: MS-DOS Compatible Scripts. -* array <1>: Conventional Arrays. -* array: Build Options. -* array-for-each: Build Options. -* arrays: Build Options. -* bignums: Build Options. -* callbacks: Callbacks. -* careful-interrupt-masking: Build Options. -* cautious: Build Options. -* cheap-continuations: Build Options. -* compiled-closure: Build Options. -* continuations: Continuations. -* curses: Build Options. -* debug: Build Options. -* documentation string: Syntax Extensions. -* dump: Build Options. -* dynamic-linking: Build Options. -* ecache: Memory Management for Environments. -* edit-line: Build Options. -* Embedding SCM: Embedding SCM. -* engineering-notation: Build Options. -* environments: Memory Management for Environments. -* exchanger: Process Synchronization. -* Exrename: Bibliography. -* Extending Scm: Compiling and Linking Custom Files. -* foo.c: Compiling and Linking Custom Files. -* generalized-c-arguments: Build Options. -* graphics: Packages. -* hobbit: Packages. -* i/o-extensions: Build Options. -* IEEE: Bibliography. -* inexact: Build Options. -* JACAL: Bibliography. -* lit: Build Options. -* macro: Build Options. -* memory management: Memory Management for Environments. -* mysql: Build Options. -* no-heap-shrink: Build Options. -* NO_ENV_CACHE: Memory Management for Environments. -* none: Build Options. -* posix: Build Options. -* R4RS: Bibliography. -* R5RS: Bibliography. -* reckless: Build Options. -* record: Build Options. -* regex: Build Options. -* rev2-procedures: Build Options. -* SchemePrimer: Bibliography. -* SICP: Build Options. -* sicp: Build Options. -* SICP: Bibliography. -* signals: Signals. -* Simply: Bibliography. -* single-precision-only: Build Options. -* SLIB: Bibliography. -* socket: Build Options. -* stack-limit: Build Options. -* tick-interrupts: Build Options. -* turtlegr: Build Options. -* unix: Build Options. -* windows: Build Options. -* X: Packages. -* x <1>: Packages. -* x: Build Options. -* xlib: Packages. -* Xlib: Packages. -* xlib: Build Options. -* xlibscm: Packages. -* Xlibscm: Packages. - - - -Tag Table: -Node: Top203 -Node: Overview1426 -Node: SCM Features1737 -Node: SCM Authors3749 -Node: Copying4645 -Node: Bibliography7730 -Node: Installing SCM9598 -Node: Making SCM10113 -Node: SLIB11030 -Node: Building SCM12945 -Node: Invoking Build13519 -Node: Build Options15793 -Node: Compiling and Linking Custom Files27939 -Node: Installing Dynamic Linking29902 -Node: Configure Module Catalog31686 -Node: Saving Images33683 -Node: Automatic C Preprocessor Definitions34358 -Node: Problems Compiling37629 -Node: Problems Linking39282 -Node: Problems Running39547 -Node: Testing41622 -Node: Reporting Problems44659 -Node: Operational Features45504 -Node: Invoking SCM45868 -Node: SCM Options47473 -Node: Invocation Examples51745 -Node: SCM Variables52697 -Node: SCM Session54127 -Node: Editing Scheme Code55465 -Node: Debugging Scheme Code57608 -Node: Errors61231 -Node: Memoized Expressions65459 -Node: Internal State67815 -Node: Scripting70895 -Node: Unix Scheme Scripts71189 -Node: MS-DOS Compatible Scripts74401 -Node: Unix Shell Scripts76213 -Node: The Language78403 -Node: Standards Compliance78995 -Node: Miscellaneous Procedures81409 -Node: Time84509 -Node: Interrupts85503 -Node: Process Synchronization90581 -Node: Files and Ports92118 -Node: Line Numbers97992 -Node: Soft Ports100234 -Node: Syntax Extensions102032 -Node: Low Level Syntactic Hooks111007 -Node: Syntactic Hooks for Hygienic Macros116212 -Node: Packages123186 -Node: Dynamic Linking123988 -Node: Dump128597 -Node: Numeric132606 -Node: Arrays134333 -Node: Conventional Arrays134543 -Node: Array Mapping141171 -Node: Uniform Array143397 -Node: Bit Vectors148645 -Node: Records149910 -Node: I/O-Extensions150773 -Node: Posix Extensions159362 -Node: Unix Extensions169048 -Node: Regular Expression Pattern Matching170950 -Node: Line Editing174904 -Node: Curses176250 -Node: Output Options Setting177173 -Node: Terminal Mode Setting179822 -Node: Window Manipulation182900 -Node: Output186360 -Node: Input189986 -Node: Curses Miscellany191013 -Node: Sockets192437 -Node: Host Data192761 -Node: Internet Addresses and Socket Names195909 -Node: Socket197443 -Node: The Implementation204680 -Node: Data Types204939 -Node: Immediates205760 -Node: Cells210096 -Node: Header Cells212188 -Node: Subr Cells215229 -Node: Ptob Cells217447 -Node: Smob Cells218986 -Node: Data Type Representations222182 -Node: Operations226835 -Node: Garbage Collection227421 -Node: Marking Cells228042 -Node: Sweeping the Heap230144 -Node: Memory Management for Environments231089 -Node: Signals235646 -Node: C Macros237190 -Node: Changing Scm238313 -Node: Defining Subrs242572 -Node: Defining Smobs244449 -Node: Defining Ptobs247495 -Node: Allocating memory248672 -Node: Embedding SCM250985 -Node: Callbacks258587 -Node: Type Conversions260330 -Node: Continuations263886 -Node: Evaluation268100 -Node: Program Self-Knowledge273263 -Node: File-System Habitat273509 -Node: Executable Pathname277109 -Node: Script Support278713 -Node: Improvements To Make280031 -Node: Finishing Dynamic Linking282063 -Node: Index289809 - -End Tag Table @@ -52,6 +52,46 @@ # endif #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 + rather different from unix apps. If control-c is hit on a console + application Windows creates a new thread which executes the + control-c signal handler. Now, if the SCM handler does the longjmp + back to the repl loop it does it via the stack of the signal + handler thread which results always ever is an access violation. + + The solution to this problem is to let the signal handler thread + raise a software interrupt in the main thread. + + This is done with the following steps: + + 1. contol-c is hit + + 2. Windows creates the signal handler thread which in turn executes + the routine win32_sigint as its signal handler. + + 3. The handler suspends the main thread and gets the main threads + register context. + + 4. The handler simulates an interrupt call on the main thread by + pointing Eip to the sigintstub stub function and also simulates a + pushad , pushf of the main threads registers + + 5. The handler resumes the main thread which when scheduled will + execute sigintstub, which in turn calls the proper signal interupt + (scamble_signal) +*/ +#ifdef _WIN32 +/* POCKETCONSOLE has the signal handler implemented in the runtime */ +# ifndef POCKETCONSOLE +# define WINSIGNALS +# endif +#endif + + #include "scmflags.h" /* user specified, system independent flags */ /* IMPLINIT is the full pathname (surrounded by double quotes) of @@ -241,6 +281,10 @@ rgx.c init_rgx(); regcomp and regexec. */ #ifdef __alpha # define SHORT_INT #endif +#ifdef __ia64 +# define SHORT_INT +# define CDR_DOUBLES +#endif #ifdef MSDOS /* Microsoft C 5.10 and 6.00A */ # ifndef GO32 # define SHORT_INT @@ -273,9 +317,16 @@ rgx.c init_rgx(); regcomp and regexec. */ #ifdef MSDOS # define STDC_HEADERS #endif + +#ifdef POCKETCONSOLE +# define NOSETBUF +# define LACK_FTIME +#endif + #ifdef vms # define STDC_HEADERS #endif + #ifdef nosve # define STDC_HEADERS #endif @@ -637,8 +688,12 @@ extern ints_infot *ints_info; #endif #ifndef macintosh -# ifdef __WINDOWS__ /* there should be a better flag for this. */ -# define PROT386 +# ifndef _M_ARM +# ifndef _M_ARMT +# ifdef __WINDOWS__ /* there should be a better flag for this. */ +# define PROT386 +# endif +# endif # endif #endif @@ -721,7 +776,12 @@ typedef SCM *SCMPTR; # define SCM_INTERRUPTED(errno) (0) #endif -#define SYSCALL(line) do{errno = 0;line}while(SCM_INTERRUPTED(errno)) +#ifdef _WIN32 +// Windows doesn't set errno = EINTR +# define SYSCALL(line) do{ line; while(GetLastError() == ERROR_OPERATION_ABORTED){SetLastError(0);Sleep(10);line};}while(0) +#else +# define SYSCALL(line) do{errno = 0;line}while(SCM_INTERRUPTED(errno)) +#endif #ifdef EMFILE # ifdef ENFILE @@ -47,12 +47,19 @@ # include <floatingpoint.h> #endif +#ifdef _WIN32 +# include <io.h> +#endif + #include "scm.h" #include "patchlvl.h" #ifdef __IBMC__ # include <io.h> #endif +#ifdef __NetBSD__ +# include <unistd.h> +#endif #ifdef __OpenBSD__ # include <unistd.h> #endif @@ -68,6 +75,7 @@ char *scm_find_implpath(execpath) { char *implpath = 0; #ifndef nosve +# ifndef POCKETCONSOLE char *getenvpath = getenv(INIT_GETENV); /* fprintf(stderr, "%s=%s\n", INIT_GETENV, getenvpath); fflush(stderr); */ if (getenvpath) implpath = scm_cat_path(0L, getenvpath, 0L); @@ -80,6 +88,7 @@ char *scm_find_implpath(execpath) fputs("\") not found; Trying elsewhere\n", stderr); } } +# endif #endif if (!implpath && execpath) implpath = find_impl_file(execpath, GENERIC_NAME, INIT_FILE_NAME, dirsep); @@ -90,6 +99,12 @@ char *scm_find_implpath(execpath) } char *generic_name[] = { GENERIC_NAME }; +#ifdef WINSIGNALS +SCM_EXPORT HANDLE scm_hMainThread; +#endif + +void scmmain_init_user_scm(); + int main(argc, argv) int argc; char **argv; @@ -102,10 +117,19 @@ int main(argc, argv) #ifdef __FreeBSD__ fp_prec_t fpspec; #endif + +#ifdef WINSIGNALS + /* need a handle to access the main thread from the signal handler thread */ + DuplicateHandle(GetCurrentProcess(), GetCurrentThread(), GetCurrentProcess(), + &scm_hMainThread, 0, TRUE, DUPLICATE_SAME_ACCESS); +#endif + /* {char ** argvv = argv; */ /* for (;*argvv;argvv++) {fputs(*argvv, stderr); fputs(" ", stderr);} */ /* fputs("\n", stderr);} */ + init_user_scm = scmmain_init_user_scm; + if (0==argc) {argc = 1; argv = generic_name;} /* for macintosh */ #ifndef LACK_SBRK init_sbrk(); /* Do this before malloc()s. */ @@ -162,7 +186,7 @@ int main(argc, argv) /* init_user_scm() is called by the scheme procedure SCM_INIT_EXTENSIONS in "Init5xx.scm" */ -void init_user_scm() +void scmmain_init_user_scm() { /* Put calls to your C initialization routines here. */ } @@ -155,34 +155,6 @@ char *script_find_executable(name) } #endif /* unix */ -#ifdef MSDOS -# define DEFAULT_PATH "C:\\DOS" -# define PATH_DELIMITER ';' -# define ABSOLUTE_FILENAME_P(fname) ((fname[0] == '\\') \ - || (fname[0] && (fname[1] == ':'))) - -char *dld_find_executable(file) - const char *file; -{ - /* fprintf(stderr, "dld_find_executable %s -> %s\n", file, scm_cat_path(0L, file, 0L)); fflush(stderr); */ - return scm_cat_path(0L, file, 0L); -} -#endif /* def MSDOS */ - -#ifdef __IBMC__ -# define PATH_DELIMITER ';' -# define ABSOLUTE_FILENAME_P(fname) ((fname[0] == '/') \ - || (fname[0] == '\\') \ - || (fname[0] && (fname[1] == ':'))) - -char *dld_find_executable(file) - const char *file; -{ - /* fprintf(stderr, "dld_find_executable %s -> %s\n", file, scm_cat_path(0L, file, 0L)); fflush(stderr); */ - return scm_cat_path(0L, file, 0L); -} -#endif /* def __IBMC__ */ - /* Given dld_find_executable()'s best guess for the pathname of this executable, find (and verify the existence of) initname in the implementation-vicinity of this program. Returns a newly allocated @@ -420,3 +392,16 @@ int script_count_argv(argv) while (argv[argc]) argc++; return argc; } + +#ifdef __IBMC__ +# define MSDOS +#endif + +#ifdef MSDOS +char *dld_find_executable(file) + const char *file; +{ + /* fprintf(stderr, "dld_find_executable %s -> %s\n", file, scm_cat_path(0L, file, 0L)); fflush(stderr); */ + return scm_cat_path(0L, file, 0L); +} +#endif /* def MSDOS */ @@ -48,8 +48,8 @@ #include "scm.h" #ifdef macintosh -#define SOCKETDEFS -#include "macsocket.h" +# define SOCKETDEFS +# include "macsocket.h" #endif #include <sys/types.h> @@ -72,6 +72,9 @@ # ifdef __OpenBSD__ # include <unistd.h> # endif +# ifdef __NetBSD__ +# include <unistd.h> +# endif #endif /* STDC_HEADERS */ static char s_inetaddr[] = "inet:string->address"; @@ -79,7 +82,7 @@ SCM l_inetaddr (host) SCM host; { struct in_addr soka; - ASSERT(NIMP(host) && STRINGP(host), host, ARG1, s_inetaddr); + ASRTER(NIMP(host) && STRINGP(host), host, ARG1, s_inetaddr); soka.s_addr = inet_addr(CHARS(host)); if (-1==soka.s_addr) { struct hostent *entry; @@ -247,15 +250,15 @@ SCM l_servinfo(args) } name = CAR(args); proto = CDR(args); - ASSERT(NIMP(proto) && CONSP(proto), args, WNA, s_servinfo); + ASRTER(NIMP(proto) && CONSP(proto), args, WNA, s_servinfo); proto = CAR(proto); - ASSERT(NIMP(proto) && STRINGP(proto), args, ARG2, s_servinfo); + ASRTER(NIMP(proto) && STRINGP(proto), args, ARG2, s_servinfo); DEFER_INTS; if (NIMP(name) && STRINGP(name)) { SYSCALL(entry = getservbyname(CHARS(name), CHARS(proto));); } else { - ASSERT(INUMP(proto), proto, ARG1, s_servinfo); + ASRTER(INUMP(proto), proto, ARG1, s_servinfo); SYSCALL(entry = getservbyport(INUM(proto), CHARS(proto));); } comlab: ALLOW_INTS; @@ -303,9 +306,9 @@ SCM l_socket(fam, proto) int sd, j, tp = INUM(fam); FILE* f; SCM port; - ASSERT(INUMP(fam), fam, ARG1, s_socket); + ASRTER(INUMP(fam), fam, ARG1, s_socket); if UNBNDP(proto) proto = INUM0; - else ASSERT(INUMP(proto), proto, ARG2, s_socket); + else ASRTER(INUMP(proto), proto, ARG2, s_socket); NEWCELL(port); DEFER_INTS; SYSCALL(sd = socket(tp, SOCK_STREAM, INUM(proto));); @@ -326,7 +329,7 @@ SCM l_socket(fam, proto) #else sd = setsockopt(sd, SOL_SOCKET, SO_REUSEADDR, &j, sizeof(j)); #endif - ASSERT(!sd, port, "could not set socket option", s_socket); + ASRTER(!sd, port, "could not set socket option", s_socket); } return port; } @@ -338,9 +341,9 @@ SCM l_socketpair(fam, proto) int sv[2]; FILE* f[2]; SCM port[2]; - ASSERT(INUMP(fam), fam, ARG1, s_socketpair); + ASRTER(INUMP(fam), fam, ARG1, s_socketpair); if UNBNDP(proto) proto = INUM0; - else ASSERT(INUMP(proto), proto, ARG2, s_socketpair); + else ASRTER(INUMP(proto), proto, ARG2, s_socketpair); NEWCELL(port[0]); NEWCELL(port[1]); DEFER_INTS; SYSCALL(sts = socketpair(tp, SOCK_STREAM, INUM(proto), sv);); @@ -368,8 +371,8 @@ SCM l_shutdown(port, how) SCM port, how; { int sts; - ASSERT(NIMP(port) && OPFPORTP(port), port, ARG1, s_shutdown); - ASSERT(INUMP(how) && 0 <= INUM(how) && 2 >= INUM(how), + ASRTER(NIMP(port) && OPFPORTP(port), port, ARG1, s_shutdown); + ASRTER(INUMP(how) && 0 <= INUM(how) && 2 >= INUM(how), how, ARG2, s_shutdown); SYSCALL(sts = shutdown(fileno(STREAM(port)), INUM(how));); if (sts) return BOOL_F; @@ -390,14 +393,14 @@ SCM l_connect (sockpt, address, arg) { long flags; int sts; - ASSERT(NIMP(sockpt) && SOCKP(sockpt), sockpt, ARG1, s_connect); + ASRTER(NIMP(sockpt) && SOCKP(sockpt), sockpt, ARG1, s_connect); switch SOCKTYP(sockpt) { default: - ASSERT(0, sockpt, s_unkfam, s_connect); + ASRTER(0, sockpt, s_unkfam, s_connect); case AF_INET: - ASSERT(NIMP(arg) && CONSP(arg) && NULLP(CDR(arg)), arg, WNA, s_connect); + ASRTER(NIMP(arg) && CONSP(arg) && NULLP(CDR(arg)), arg, WNA, s_connect); arg = CAR(arg); - ASSERT(INUMP(arg), arg, ARG3, s_connect); + ASRTER(INUMP(arg), arg, ARG3, s_connect); { struct sockaddr_in soka; soka.sin_addr.s_addr = @@ -409,8 +412,8 @@ SCM l_connect (sockpt, address, arg) } break; case AF_UNIX: - ASSERT(NULLP(arg), arg, WNA, s_connect); - ASSERT(NIMP(address) && STRINGP(address), address, ARG2, s_connect); + ASRTER(NULLP(arg), arg, WNA, s_connect); + ASRTER(NIMP(address) && STRINGP(address), address, ARG2, s_connect); { struct sockaddr_un soka; soka.sun_family = AF_UNIX; @@ -433,12 +436,12 @@ SCM l_bind(sockpt, address) SCM sockpt, address; { int sts; - ASSERT(NIMP(sockpt) && SOCKP(sockpt), sockpt, ARG1, s_bind); + ASRTER(NIMP(sockpt) && SOCKP(sockpt), sockpt, ARG1, s_bind); switch SOCKTYP(sockpt) { default: - ASSERT(0, sockpt, s_unkfam, s_bind); + ASRTER(0, sockpt, s_unkfam, s_bind); case AF_UNIX: - ASSERT(NIMP(address) && STRINGP(address), address, ARG2, s_bind); + ASRTER(NIMP(address) && STRINGP(address), address, ARG2, s_bind); { struct sockaddr_un sa_server; bzero((char *) &sa_server, sizeof(sa_server)); @@ -449,7 +452,7 @@ SCM l_bind(sockpt, address) } break; case AF_INET: - ASSERT(INUMP(address), address, ARG2, s_bind); + ASRTER(INUMP(address), address, ARG2, s_bind); { struct sockaddr_in sa_server; bzero((char *) &sa_server, sizeof(sa_server)); @@ -470,8 +473,8 @@ SCM l_listen(port, backlog) { long flags; int sts; - ASSERT(NIMP(port) && SOCKP(port), port, ARG1, s_listen); - ASSERT(INUMP(backlog), backlog, ARG2, s_listen); + ASRTER(NIMP(port) && SOCKP(port), port, ARG1, s_listen); + ASRTER(INUMP(backlog), backlog, ARG2, s_listen); SYSCALL(sts = listen(fileno(STREAM(port)), INUM(backlog));); if (sts) return BOOL_F; DEFER_INTS; @@ -491,7 +494,7 @@ SCM l_accept(sockpt) FILE *newfd; SCM newpt; NEWCELL(newpt); - ASSERT(NIMP(sockpt) && OPINPORTP(sockpt), sockpt, ARG1, s_accept); + ASRTER(NIMP(sockpt) && OPINPORTP(sockpt), sockpt, ARG1, s_accept); sadlen=sizeof(sad); SYSCALL(newsd = accept(fileno(STREAM(sockpt)), &sad, &sadlen);); if (-1==newsd) { @@ -548,7 +551,7 @@ char s_sknm_family[] = "socket-name:family"; SCM l_sknm_family(snm) SCM snm; { - ASSERT(NIMP(snm) && TYP16(snm)==tc16_sknm, snm, ARG1, s_sknm_family); + ASRTER(NIMP(snm) && TYP16(snm)==tc16_sknm, snm, ARG1, s_sknm_family); return MAKINUM(((struct sockaddr *)CDR(snm))->sa_family + 0L); } char s_sknm_port_num[] = "socket-name:port-number"; @@ -600,11 +603,11 @@ SCM l_getpeername(sockpt) struct sockaddr_in sad; int sts, sadlen = sizeof(sad); bzero((char *) &sad, sizeof(sad)); - ASSERT(NIMP(sockpt) && OPFPORTP(sockpt), sockpt, ARG1, s_getpeername); + ASRTER(NIMP(sockpt) && OPFPORTP(sockpt), sockpt, ARG1, s_getpeername); SYSCALL(sts = getpeername(fileno(STREAM(sockpt)), (struct sockaddr*)&sad, &sadlen);); if (sts || sizeof(sad) != sadlen) return BOOL_F; -/* ASSERT(sad.sin_family==AF_INET, sockpt, "non-internet", s_getpeername); */ +/* ASRTER(sad.sin_family==AF_INET, sockpt, "non-internet", s_getpeername); */ return maksknm(&sad); } static char s_getsockname[] = "getsockname"; @@ -614,7 +617,7 @@ SCM l_getsockname(sockpt) struct sockaddr_in sad; int sts, sadlen = sizeof(sad); bzero((char *) &sad, sizeof(sad)); - ASSERT(NIMP(sockpt) && OPFPORTP(sockpt), sockpt, ARG1, s_getsockname); + ASRTER(NIMP(sockpt) && OPFPORTP(sockpt), sockpt, ARG1, s_getsockname); SYSCALL(sts = getsockname(fileno(STREAM(sockpt)), (struct sockaddr*)&sad, &sadlen);); if (sts || sizeof(sad) != sadlen) return BOOL_F; @@ -625,7 +628,6 @@ static iproc subr1s[] = { {s_inetstr, l_inetstr}, {s_network, l_network}, {s_lna, l_lna}, - {s_makaddr, l_makaddr}, {s_accept, l_accept}, {s_sknm_family, l_sknm_family}, @@ -114,14 +114,14 @@ SCM consp(x) SCM setcar(pair, value) SCM pair, value; { - ASSERT(NIMP(pair) && CONSP(pair), pair, ARG1, s_setcar); + ASRTER(NIMP(pair) && CONSP(pair), pair, ARG1, s_setcar); CAR(pair) = value; return UNSPECIFIED; } SCM setcdr(pair, value) SCM pair, value; { - ASSERT(NIMP(pair) && CONSP(pair), pair, ARG1, s_setcdr); + ASRTER(NIMP(pair) && CONSP(pair), pair, ARG1, s_setcdr); CDR(pair) = value; return UNSPECIFIED; } @@ -164,7 +164,7 @@ SCM length(x) SCM x; { SCM i = MAKINUM(ilength(x)); - ASSERT(i >= INUM0, x, ARG1, s_length); + ASRTER(i >= INUM0, x, ARG1, s_length); return i; } SCM append(args) @@ -173,25 +173,25 @@ SCM append(args) SCM res = EOL; SCM *lloc = &res, arg; if IMP(args) { - ASSERT(NULLP(args), args, ARGn, s_append); + ASRTER(NULLP(args), args, ARGn, s_append); return res; } - ASSERT(CONSP(args), args, ARGn, s_append); + ASRTER(CONSP(args), args, ARGn, s_append); while (1) { arg = CAR(args); args = CDR(args); if IMP(args) { *lloc = arg; - ASSERT(NULLP(args), args, ARGn, s_append); + ASRTER(NULLP(args), args, ARGn, s_append); return res; } - ASSERT(CONSP(args), args, ARGn, s_append); + ASRTER(CONSP(args), args, ARGn, s_append); for(;NIMP(arg);arg = CDR(arg)) { - ASSERT(CONSP(arg), arg, ARGn, s_append); + ASRTER(CONSP(arg), arg, ARGn, s_append); *lloc = cons(CAR(arg), EOL); lloc = &CDR(*lloc); } - ASSERT(NULLP(arg), arg, ARGn, s_append); + ASRTER(NULLP(arg), arg, ARGn, s_append); } } SCM reverse(lst) @@ -200,24 +200,24 @@ SCM reverse(lst) SCM res = EOL; SCM p = lst; for(;NIMP(p);p = CDR(p)) { - ASSERT(CONSP(p), lst, ARG1, s_reverse); + ASRTER(CONSP(p), lst, ARG1, s_reverse); res = cons(CAR(p), res); } - ASSERT(NULLP(p), lst, ARG1, s_reverse); + ASRTER(NULLP(p), lst, ARG1, s_reverse); return res; } SCM list_ref(lst, k) SCM lst, k; { register long i; - ASSERT(INUMP(k), k, ARG2, s_list_ref); + ASRTER(INUMP(k), k, ARG2, s_list_ref); i = INUM(k); - ASSERT(i >= 0, k, ARG2, s_list_ref); + ASRTER(i >= 0, k, ARG2, s_list_ref); while (i-- > 0) { ASRTGO(NIMP(lst) && CONSP(lst), erout); lst = CDR(lst); } -erout: ASSERT(NIMP(lst) && CONSP(lst), +erout: ASRTER(NIMP(lst) && CONSP(lst), NULLP(lst)?k:lst, NULLP(lst)?OUTOFRANGE:ARG1, s_list_ref); return CAR(lst); } @@ -225,20 +225,20 @@ SCM memq(x, lst) SCM x, lst; { for(;NIMP(lst);lst = CDR(lst)) { - ASSERT(CONSP(lst), lst, ARG2, s_memq); + ASRTER(CONSP(lst), lst, ARG2, s_memq); if (CAR(lst)==x) return lst; } - ASSERT(NULLP(lst), lst, ARG2, s_memq); + ASRTER(NULLP(lst), lst, ARG2, s_memq); return BOOL_F; } SCM member(x, lst) SCM x, lst; { for(;NIMP(lst);lst = CDR(lst)) { - ASSERT(CONSP(lst), lst, ARG2, s_member); + ASRTER(CONSP(lst), lst, ARG2, s_member); if NFALSEP(equal(CAR(lst), x)) return lst; } - ASSERT(NULLP(lst), lst, ARG2, s_member); + ASRTER(NULLP(lst), lst, ARG2, s_member); return BOOL_F; } SCM assq(x, alist) @@ -246,12 +246,12 @@ SCM assq(x, alist) { SCM tmp; for(;NIMP(alist);alist = CDR(alist)) { - ASSERT(CONSP(alist), alist, ARG2, s_assq); + ASRTER(CONSP(alist), alist, ARG2, s_assq); tmp = CAR(alist); - ASSERT(NIMP(tmp) && CONSP(tmp), alist, ARG2, s_assq); + ASRTER(NIMP(tmp) && CONSP(tmp), alist, ARG2, s_assq); if (CAR(tmp)==x) return tmp; } - ASSERT(NULLP(alist), alist, ARG2, s_assq); + ASRTER(NULLP(alist), alist, ARG2, s_assq); return BOOL_F; } SCM assoc(x, alist) @@ -259,12 +259,12 @@ SCM assoc(x, alist) { SCM tmp; for(;NIMP(alist);alist = CDR(alist)) { - ASSERT(CONSP(alist), alist, ARG2, s_assoc); + ASRTER(CONSP(alist), alist, ARG2, s_assoc); tmp = CAR(alist); - ASSERT(NIMP(tmp) && CONSP(tmp), alist, ARG2, s_assoc); + ASRTER(NIMP(tmp) && CONSP(tmp), alist, ARG2, s_assoc); if NFALSEP(equal(CAR(tmp), x)) return tmp; } - ASSERT(NULLP(alist), alist, ARG2, s_assoc); + ASRTER(NULLP(alist), alist, ARG2, s_assoc); return BOOL_F; } @@ -284,13 +284,13 @@ SCM symbolp(x) SCM symbol2string(s) SCM s; { - ASSERT(NIMP(s) && SYMBOLP(s), s, ARG1, s_symbol2string); + ASRTER(NIMP(s) && SYMBOLP(s), s, ARG1, s_symbol2string); return makfromstr(CHARS(s), (sizet)LENGTH(s)); } SCM string2symbol(s) SCM s; { - ASSERT(NIMP(s) && STRINGP(s), s, ARG1, s_str2symbol); + ASRTER(NIMP(s) && STRINGP(s), s, ARG1, s_str2symbol); s = intern(CHARS(s), (sizet)LENGTH(s)); return CAR(s); } @@ -309,11 +309,11 @@ SCM oddp(n) { #ifdef BIGDIG if NINUMP(n) { - ASSERT(NIMP(n) && BIGP(n), n, ARG1, s_oddp); + ASRTER(NIMP(n) && BIGP(n), n, ARG1, s_oddp); return (1 & BDIGITS(n)[0]) ? BOOL_T : BOOL_F; } #else - ASSERT(INUMP(n), n, ARG1, s_oddp); + ASRTER(INUMP(n), n, ARG1, s_oddp); #endif return (4 & (int)n) ? BOOL_T : BOOL_F; } @@ -322,11 +322,11 @@ SCM evenp(n) { #ifdef BIGDIG if NINUMP(n) { - ASSERT(NIMP(n) && BIGP(n), n, ARG1, s_evenp); + ASRTER(NIMP(n) && BIGP(n), n, ARG1, s_evenp); return (1 & BDIGITS(n)[0]) ? BOOL_F : BOOL_T; } #else - ASSERT(INUMP(n), n, ARG1, s_evenp); + ASRTER(INUMP(n), n, ARG1, s_evenp); #endif return (4 & (int)n) ? BOOL_F : BOOL_T; } @@ -335,12 +335,12 @@ SCM absval(x) { #ifdef BIGDIG if NINUMP(x) { - ASSERT(NIMP(x) && BIGP(x), x, ARG1, s_abs); + ASRTER(NIMP(x) && BIGP(x), x, ARG1, s_abs); if (TYP16(x)==tc16_bigpos) return x; return copybig(x, 0); } #else - ASSERT(INUMP(x), x, ARG1, s_abs); + ASRTER(INUMP(x), x, ARG1, s_abs); #endif if (INUM(x) >= 0) return x; x = -INUM(x); @@ -359,7 +359,7 @@ SCM lquotient(x, y) #ifdef BIGDIG if NINUMP(x) { long w; - ASSERT(NIMP(x) && BIGP(x), x, ARG1, s_quotient); + ASRTER(NIMP(x) && BIGP(x), x, ARG1, s_quotient); if NINUMP(y) { ASRTGO(NIMP(y) && BIGP(y), bady); return divbigbig(BDIGITS(x), NUMDIGS(x), BDIGITS(y), NUMDIGS(y), @@ -394,8 +394,8 @@ SCM lquotient(x, y) return INUM0; } #else - ASSERT(INUMP(x), x, ARG1, s_quotient); - ASSERT(INUMP(y), y, ARG2, s_quotient); + ASRTER(INUMP(x), x, ARG1, s_quotient); + ASRTER(INUMP(y), y, ARG2, s_quotient); #endif if ((z = INUM(y))==0) ov: wta(y, (char *)OVFLOW, s_quotient); @@ -428,7 +428,7 @@ SCM lremainder(x, y) register long z; #ifdef BIGDIG if NINUMP(x) { - ASSERT(NIMP(x) && BIGP(x), x, ARG1, s_remainder); + ASRTER(NIMP(x) && BIGP(x), x, ARG1, s_remainder); if NINUMP(y) { ASRTGO(NIMP(y) && BIGP(y), bady); return divbigbig(BDIGITS(x), NUMDIGS(x), BDIGITS(y), NUMDIGS(y), @@ -445,8 +445,8 @@ SCM lremainder(x, y) return x; } #else - ASSERT(INUMP(x), x, ARG1, s_remainder); - ASSERT(INUMP(y), y, ARG2, s_remainder); + ASRTER(INUMP(x), x, ARG1, s_remainder); + ASRTER(INUMP(y), y, ARG2, s_remainder); #endif if (!(z = INUM(y))) ov: wta(y, (char *)OVFLOW, s_remainder); @@ -469,7 +469,7 @@ SCM modulo(x, y) register long yy, z; #ifdef BIGDIG if NINUMP(x) { - ASSERT(NIMP(x) && BIGP(x), x, ARG1, s_modulo); + ASRTER(NIMP(x) && BIGP(x), x, ARG1, s_modulo); if NINUMP(y) { ASRTGO(NIMP(y) && BIGP(y), bady); return divbigbig(BDIGITS(x), NUMDIGS(x), BDIGITS(y), NUMDIGS(y), @@ -486,8 +486,8 @@ SCM modulo(x, y) return (BIGSIGN(y) ? (INUM(x)>0) : (INUM(x)<0)) ? sum(x, y) : x; } #else - ASSERT(INUMP(x), x, ARG1, s_modulo); - ASSERT(INUMP(y), y, ARG2, s_modulo); + ASRTER(INUMP(x), x, ARG1, s_modulo); + ASRTER(INUMP(y), y, ARG2, s_modulo); #endif if (!(yy = INUM(y))) ov: wta(y, (char *)OVFLOW, s_modulo); @@ -509,11 +509,11 @@ SCM lgcd(x, y) #ifdef BIGDIG if NINUMP(x) { big_gcd: - ASSERT(NIMP(x) && BIGP(x), x, ARG1, s_gcd); + ASRTER(NIMP(x) && BIGP(x), x, ARG1, s_gcd); if BIGSIGN(x) x = copybig(x, 0); newy: if NINUMP(y) { - ASSERT(NIMP(y) && BIGP(y), y, ARG2, s_gcd); + ASRTER(NIMP(y) && BIGP(y), y, ARG2, s_gcd); if BIGSIGN(y) y = copybig(y, 0); switch (bigcomp(x, y)) { case -1: @@ -527,8 +527,8 @@ SCM lgcd(x, y) } if NINUMP(y) { t=x; x=y; y=t; goto big_gcd;} #else - ASSERT(INUMP(x), x, ARG1, s_gcd); - ASSERT(INUMP(y), y, ARG2, s_gcd); + ASRTER(INUMP(x), x, ARG1, s_gcd); + ASRTER(INUMP(y), y, ARG2, s_gcd); #endif u = INUM(x); if (u<0) u = -u; @@ -1003,7 +1003,7 @@ SCM scm_logior(x, y) }} #else ASRTGO(INUMP(x), badx); - ASSERT(INUMP(y), y, ARG2, s_logior); + ASRTER(INUMP(y), y, ARG2, s_logior); #endif return MAKINUM(INUM(x) | INUM(y)); } @@ -1052,7 +1052,7 @@ SCM scm_logand(x, y) }} #else ASRTGO(INUMP(x), badx); - ASSERT(INUMP(y), y, ARG2, s_logand); + ASRTER(INUMP(y), y, ARG2, s_logand); #endif return MAKINUM(INUM(x) & INUM(y)); } @@ -1094,7 +1094,7 @@ SCM scm_logxor(x, y) }} #else ASRTGO(INUMP(x), badx); - ASSERT(INUMP(y), y, ARG2, s_logxor); + ASRTER(INUMP(y), y, ARG2, s_logxor); #endif return (x ^ y) + INUM0; } @@ -1132,7 +1132,7 @@ SCM scm_logtest(x, y) }} #else ASRTGO(INUMP(x), badx); - ASSERT(INUMP(y), y, ARG2, s_logtest); + ASRTER(INUMP(y), y, ARG2, s_logtest); #endif return (INUM(x) & INUM(y)) ? BOOL_T : BOOL_F; } @@ -1140,10 +1140,10 @@ SCM scm_logtest(x, y) SCM scm_logbitp(index, j1) SCM index, j1; { - ASSERT(INUMP(index) && INUM(index) >= 0, index, ARG1, s_logbitp); + ASRTER(INUMP(index) && INUM(index) >= 0, index, ARG1, s_logbitp); #ifdef BIGDIG if NINUMP(j1) { - ASSERT(NIMP(j1) && BIGP(j1), j1, ARG2, s_logbitp); + ASRTER(NIMP(j1) && BIGP(j1), j1, ARG2, s_logbitp); if (NUMDIGS(j1) * BITSPERDIG < INUM(index)) return BOOL_F; else if BIGSIGN(j1) { long num = -1; @@ -1162,15 +1162,16 @@ SCM scm_logbitp(index, j1) (1L << (INUM(index)%BITSPERDIG))) ? BOOL_T : BOOL_F; } #else - ASSERT(INUMP(j1), j1, ARG2, s_logbitp); + ASRTER(INUMP(j1), j1, ARG2, s_logbitp); #endif + if (index >= LONG_BIT) return j1 < 0 ? BOOL_T : BOOL_F; return ((1L << INUM(index)) & INUM(j1)) ? BOOL_T : BOOL_F; } SCM scm_copybit(index, j1, bit) SCM index, j1, bit; { - ASSERT(INUMP(index) && INUM(index) >= 0, index, ARG1, s_copybit); + ASRTER(INUMP(index) && INUM(index) >= 0, index, ARG1, s_copybit); #ifdef BIGDIG { SCM res; @@ -1178,7 +1179,7 @@ SCM scm_copybit(index, j1, bit) sizet i = INUM(index); int sign; if (!INUMP(j1)) { - ASSERT(NIMP(j1) && BIGP(j1), j1, ARG2, s_copybit); + ASRTER(NIMP(j1) && BIGP(j1), j1, ARG2, s_copybit); sign = BIGSIGN(j1); ovflow: res = scm_copy_big_2scomp(j1, i + 1, sign); @@ -1196,8 +1197,8 @@ SCM scm_copybit(index, j1, bit) } } #else - ASSERT(INUMP(j1), j1, ARG2, s_copybit); - ASSERT(INUM(index) < LONG_BIT - 3, index, OUTOFRANGE, s_copybit); + ASRTER(INUMP(j1), j1, ARG2, s_copybit); + ASRTER(INUM(index) < LONG_BIT - 3, index, OUTOFRANGE, s_copybit); #endif if NFALSEP(bit) return MAKINUM(INUM(j1) | (1L << INUM(index))); @@ -1215,10 +1216,13 @@ SCM scm_ash(n, cnt) SCM n, cnt; { SCM res = INUM(n); - ASSERT(INUMP(cnt), cnt, ARG2, s_ash); + ASRTER(INUMP(cnt), cnt, ARG2, s_ash); cnt = INUM(cnt); if (INUMP(n)) { - if (cnt < 0) return MAKINUM(SRS(res, -cnt)); + if (cnt < 0) { + if (-cnt >= LONG_BIT) return INUM0; + return MAKINUM(SRS(res, -cnt)); + } if (cnt >= LONG_BIT) goto ovflow; res = MAKINUM(res<<cnt); if (INUM(res)>>cnt != INUM(n)) @@ -1227,7 +1231,7 @@ SCM scm_ash(n, cnt) return res; } #ifdef BIGDIG - ASSERT(NIMP(n) && BIGP(n), n, ARG1, s_ash); + ASRTER(NIMP(n) && BIGP(n), n, ARG1, s_ash); ovflow: if (0==cnt) return n; return scm_big_ash(n, cnt); @@ -1242,15 +1246,15 @@ SCM scm_bitfield(n, start, end) SCM n, start, end; { int sign; - ASSERT(INUMP(start), start, ARG2, s_bitfield); - ASSERT(INUMP(end), end, ARG3, s_bitfield); + ASRTER(INUMP(start), start, ARG2, s_bitfield); + ASRTER(INUMP(end), end, ARG3, s_bitfield); start = INUM(start); end = INUM(end); - ASSERT(end >= start, MAKINUM(end), OUTOFRANGE, s_bitfield); + ASRTER(end >= start, MAKINUM(end), OUTOFRANGE, s_bitfield); #ifdef BIGDIG if (NINUMP(n)) { BIGDIG *ds; sizet i, nd; - ASSERT(NIMP(n) && BIGP(n), n, ARG1, s_bitfield); + ASRTER(NIMP(n) && BIGP(n), n, ARG1, s_bitfield); sign = BIGSIGN(n); big: if (sign) n = scm_copy_big_2scomp(n, (sizet)end, 0); @@ -1272,8 +1276,8 @@ SCM scm_bitfield(n, start, end) goto big; } #else - ASSERT(INUMP(n), n, ARG1, s_bitfield); - ASSERT(end < LONG_BIT - 2, MAKINUM(end), OUTOFRANGE, s_bitfield); + ASRTER(INUMP(n), n, ARG1, s_bitfield); + ASRTER(end < LONG_BIT - 2, MAKINUM(end), OUTOFRANGE, s_bitfield); #endif return MAKINUM((INUM(n)>>start) & ((1L<<(end - start)) - 1)); } @@ -1286,9 +1290,9 @@ SCM scm_bitif(mask, n0, n1) return scm_logior(scm_logand(mask, n0), scm_logand(scm_lognot(mask), n1)); #else - ASSERT(INUMP(mask), mask, ARG1, s_bitif); - ASSERT(INUMP(n0), n0, ARG2, s_bitif); - ASSERT(INUMP(n1), n1, ARG3, s_bitif); + ASRTER(INUMP(mask), mask, ARG1, s_bitif); + ASRTER(INUMP(n0), n0, ARG2, s_bitif); + ASRTER(INUMP(n1), n1, ARG3, s_bitif); #endif return MAKINUM((INUM(mask) & INUM(n0)) | (~(INUM(mask)) & INUM(n1))); } @@ -1307,10 +1311,10 @@ SCM scm_copybitfield(to, start, rest) ASRTGO(NIMP(rest) && CONSP(rest), wna); from = CAR(rest); ASRTGO(NULLP(CDR(rest)), wna); - ASSERT(INUMP(start) && INUM(start)>=0, start, ARG2, s_copybitfield); + ASRTER(INUMP(start) && INUM(start)>=0, start, ARG2, s_copybitfield); len = INUM(end) - INUM(start); - ASSERT(INUMP(end), end, ARG3, s_copybitfield); - ASSERT(len >= 0, MAKINUM(len), OUTOFRANGE, s_copybitfield); + ASRTER(INUMP(end), end, ARG3, s_copybitfield); + ASRTER(len >= 0, MAKINUM(len), OUTOFRANGE, s_copybitfield); #ifdef BIGDIG if (NINUMP(from) || NINUMP(to) || (INUM(end) >= LONG_BIT - 2)) { SCM mask = difference(scm_ash(MAKINUM(1L), MAKINUM(len)), MAKINUM(1L)); @@ -1319,9 +1323,9 @@ SCM scm_copybitfield(to, start, rest) scm_logand(scm_lognot(mask), to)); } #else - ASSERT(INUMP(to), to, ARG1, s_copybitfield); - ASSERT(INUMP(from), from, ARG4, s_copybitfield); - ASSERT(INUM(end) < LONG_BIT - 2, end, OUTOFRANGE, s_copybitfield); + ASRTER(INUMP(to), to, ARG1, s_copybitfield); + ASRTER(INUMP(from), from, ARG4, s_copybitfield); + ASRTER(INUM(end) < LONG_BIT - 2, end, OUTOFRANGE, s_copybitfield); #endif { long mask = ((1L<<len) - 1)<<INUM(start); @@ -1338,7 +1342,7 @@ SCM scm_logcount(n) #ifdef BIGDIG if NINUMP(n) { sizet i; BIGDIG *ds, d; - ASSERT(NIMP(n) && BIGP(n), n, ARG1, s_logcount); + ASRTER(NIMP(n) && BIGP(n), n, ARG1, s_logcount); if BIGSIGN(n) return scm_logcount(difference(MAKINUM(-1L), n)); ds = BDIGITS(n); for(i = NUMDIGS(n); i--; ) @@ -1346,7 +1350,7 @@ SCM scm_logcount(n) return MAKINUM(c); } #else - ASSERT(INUMP(n), n, ARG1, s_logcount); + ASRTER(INUMP(n), n, ARG1, s_logcount); #endif if ((nn = INUM(n)) < 0) nn = -1 - nn; for(; nn; nn >>= 4) c += logtab[15 & nn]; @@ -1363,7 +1367,7 @@ SCM scm_intlength(n) #ifdef BIGDIG if NINUMP(n) { BIGDIG *ds, d; - ASSERT(NIMP(n) && BIGP(n), n, ARG1, s_intlength); + ASRTER(NIMP(n) && BIGP(n), n, ARG1, s_intlength); if BIGSIGN(n) return scm_intlength(difference(MAKINUM(-1L), n)); ds = BDIGITS(n); d = ds[c = NUMDIGS(n)-1]; @@ -1371,7 +1375,7 @@ SCM scm_intlength(n) return MAKINUM(c - 4 + l); } #else - ASSERT(INUMP(n), n, ARG1, s_intlength); + ASRTER(INUMP(n), n, ARG1, s_intlength); #endif if ((nn = INUM(n)) < 0) nn = -1 - nn; for(;nn; nn >>= 4) {c += 4; l = ilentab[15 & nn];} @@ -1386,120 +1390,120 @@ SCM charp(x) SCM char_lessp(x, y) SCM x, y; { - ASSERT(ICHRP(x), x, ARG1, s_ch_lessp); - ASSERT(ICHRP(y), y, ARG2, s_ch_lessp); + ASRTER(ICHRP(x), x, ARG1, s_ch_lessp); + ASRTER(ICHRP(y), y, ARG2, s_ch_lessp); return (ICHR(x) < ICHR(y)) ? BOOL_T : BOOL_F; } SCM char_leqp(x, y) SCM x, y; { - ASSERT(ICHRP(x), x, ARG1, s_ch_leqp); - ASSERT(ICHRP(y), y, ARG2, s_ch_leqp); + ASRTER(ICHRP(x), x, ARG1, s_ch_leqp); + ASRTER(ICHRP(y), y, ARG2, s_ch_leqp); return (ICHR(x) <= ICHR(y)) ? BOOL_T : BOOL_F; } SCM char_grp(x, y) SCM x, y; { - ASSERT(ICHRP(x), x, ARG1, s_ch_grp); - ASSERT(ICHRP(y), y, ARG2, s_ch_grp); + ASRTER(ICHRP(x), x, ARG1, s_ch_grp); + ASRTER(ICHRP(y), y, ARG2, s_ch_grp); return (ICHR(x) > ICHR(y)) ? BOOL_T : BOOL_F; } SCM char_geqp(x, y) SCM x, y; { - ASSERT(ICHRP(x), x, ARG1, s_ch_geqp); - ASSERT(ICHRP(y), y, ARG2, s_ch_geqp); + ASRTER(ICHRP(x), x, ARG1, s_ch_geqp); + ASRTER(ICHRP(y), y, ARG2, s_ch_geqp); return (ICHR(x) >= ICHR(y)) ? BOOL_T : BOOL_F; } SCM chci_eq(x, y) SCM x, y; { - ASSERT(ICHRP(x), x, ARG1, s_ci_eq); - ASSERT(ICHRP(y), y, ARG2, s_ci_eq); + ASRTER(ICHRP(x), x, ARG1, s_ci_eq); + ASRTER(ICHRP(y), y, ARG2, s_ci_eq); return (upcase[ICHR(x)]==upcase[ICHR(y)]) ? BOOL_T : BOOL_F; } SCM chci_lessp(x, y) SCM x, y; { - ASSERT(ICHRP(x), x, ARG1, s_ci_lessp); - ASSERT(ICHRP(y), y, ARG2, s_ci_lessp); + ASRTER(ICHRP(x), x, ARG1, s_ci_lessp); + ASRTER(ICHRP(y), y, ARG2, s_ci_lessp); return (upcase[ICHR(x)] < upcase[ICHR(y)]) ? BOOL_T : BOOL_F; } SCM chci_leqp(x, y) SCM x, y; { - ASSERT(ICHRP(x), x, ARG1, s_ci_leqp); - ASSERT(ICHRP(y), y, ARG2, s_ci_leqp); + ASRTER(ICHRP(x), x, ARG1, s_ci_leqp); + ASRTER(ICHRP(y), y, ARG2, s_ci_leqp); return (upcase[ICHR(x)] <= upcase[ICHR(y)]) ? BOOL_T : BOOL_F; } SCM chci_grp(x, y) SCM x, y; { - ASSERT(ICHRP(x), x, ARG1, s_ci_grp); - ASSERT(ICHRP(y), y, ARG2, s_ci_grp); + ASRTER(ICHRP(x), x, ARG1, s_ci_grp); + ASRTER(ICHRP(y), y, ARG2, s_ci_grp); return (upcase[ICHR(x)] > upcase[ICHR(y)]) ? BOOL_T : BOOL_F; } SCM chci_geqp(x, y) SCM x, y; { - ASSERT(ICHRP(x), x, ARG1, s_ci_geqp); - ASSERT(ICHRP(y), y, ARG2, s_ci_geqp); + ASRTER(ICHRP(x), x, ARG1, s_ci_geqp); + ASRTER(ICHRP(y), y, ARG2, s_ci_geqp); return (upcase[ICHR(x)] >= upcase[ICHR(y)]) ? BOOL_T : BOOL_F; } SCM char_alphap(chr) SCM chr; { - ASSERT(ICHRP(chr), chr, ARG1, s_ch_alphap); + ASRTER(ICHRP(chr), chr, ARG1, s_ch_alphap); return (isascii(ICHR(chr)) && isalpha(ICHR(chr))) ? BOOL_T : BOOL_F; } SCM char_nump(chr) SCM chr; { - ASSERT(ICHRP(chr), chr, ARG1, s_ch_nump); + ASRTER(ICHRP(chr), chr, ARG1, s_ch_nump); return (isascii(ICHR(chr)) && isdigit(ICHR(chr))) ? BOOL_T : BOOL_F; } SCM char_whitep(chr) SCM chr; { - ASSERT(ICHRP(chr), chr, ARG1, s_ch_whitep); + ASRTER(ICHRP(chr), chr, ARG1, s_ch_whitep); return (isascii(ICHR(chr)) && isspace(ICHR(chr))) ? BOOL_T : BOOL_F; } SCM char_upperp(chr) SCM chr; { - ASSERT(ICHRP(chr), chr, ARG1, s_ch_upperp); + ASRTER(ICHRP(chr), chr, ARG1, s_ch_upperp); return (isascii(ICHR(chr)) && isupper(ICHR(chr))) ? BOOL_T : BOOL_F; } SCM char_lowerp(chr) SCM chr; { - ASSERT(ICHRP(chr), chr, ARG1, s_ch_lowerp); + ASRTER(ICHRP(chr), chr, ARG1, s_ch_lowerp); return (isascii(ICHR(chr)) && islower(ICHR(chr))) ? BOOL_T : BOOL_F; } SCM char2int(chr) SCM chr; { - ASSERT(ICHRP(chr), chr, ARG1, s_char2int); + ASRTER(ICHRP(chr), chr, ARG1, s_char2int); return MAKINUM(ICHR(chr)); } SCM int2char(n) SCM n; { - ASSERT(INUMP(n), n, ARG1, s_int2char); - ASSERT((n >= INUM0) && (n < MAKINUM(CHAR_CODE_LIMIT)), + ASRTER(INUMP(n), n, ARG1, s_int2char); + ASRTER((n >= INUM0) && (n < MAKINUM(CHAR_CODE_LIMIT)), n, OUTOFRANGE, s_int2char); return MAKICHR(INUM(n)); } SCM char_upcase(chr) SCM chr; { - ASSERT(ICHRP(chr), chr, ARG1, s_ch_upcase); + ASRTER(ICHRP(chr), chr, ARG1, s_ch_upcase); return MAKICHR(upcase[ICHR(chr)]); } SCM char_downcase(chr) SCM chr; { - ASSERT(ICHRP(chr), chr, ARG1, s_ch_downcase); + ASRTER(ICHRP(chr), chr, ARG1, s_ch_downcase); return MAKICHR(downcase[ICHR(chr)]); } @@ -1515,11 +1519,11 @@ SCM string(chrs) SCM res; register unsigned char *data; long i = ilength(chrs); - ASSERT(i >= 0, chrs, ARG1, s_string); + ASRTER(i >= 0, chrs, ARG1, s_string); res = makstr(i); data = UCHARS(res); for(;NNULLP(chrs);chrs = CDR(chrs)) { - ASSERT(ICHRP(CAR(chrs)), chrs, ARG1, s_string); + ASRTER(ICHRP(CAR(chrs)), chrs, ARG1, s_string); *data++ = ICHR(CAR(chrs)); } return res; @@ -1530,12 +1534,12 @@ SCM make_string(k, chr) SCM res; register unsigned char *dst; register long i; - ASSERT(INUMP(k) && (k >= 0), k, ARG1, s_make_string); + ASRTER(INUMP(k) && (k >= 0), k, ARG1, s_make_string); i = INUM(k); res = makstr(i); dst = UCHARS(res); if (!UNBNDP(chr)) { - ASSERT(ICHRP(chr), chr, ARG2, s_make_string); + ASRTER(ICHRP(chr), chr, ARG2, s_make_string); for(i--;i >= 0;i--) dst[i] = ICHR(chr); } return res; @@ -1543,24 +1547,24 @@ SCM make_string(k, chr) SCM st_length(str) SCM str; { - ASSERT(NIMP(str) && STRINGP(str), str, ARG1, s_st_length); + ASRTER(NIMP(str) && STRINGP(str), str, ARG1, s_st_length); return MAKINUM(LENGTH(str)); } SCM st_ref(str, k) SCM str, k; { - ASSERT(NIMP(str) && STRINGP(str), str, ARG1, s_st_ref); - ASSERT(INUMP(k), k, ARG2, s_st_ref); - ASSERT(INUM(k) < LENGTH(str) && INUM(k) >= 0, k, OUTOFRANGE, s_st_ref); + ASRTER(NIMP(str) && STRINGP(str), str, ARG1, s_st_ref); + ASRTER(INUMP(k), k, ARG2, s_st_ref); + ASRTER(INUM(k) < LENGTH(str) && INUM(k) >= 0, k, OUTOFRANGE, s_st_ref); return MAKICHR(UCHARS(str)[INUM(k)]); } SCM st_set(str, k, chr) SCM str, k, chr; { - ASSERT(NIMP(str) && STRINGP(str), str, ARG1, s_st_set); - ASSERT(INUMP(k), k, ARG2, s_st_set); - ASSERT(ICHRP(chr), chr, ARG3, s_st_set); - ASSERT(INUM(k) < LENGTH(str) && INUM(k) >= 0, k, OUTOFRANGE, s_st_set); + ASRTER(NIMP(str) && STRINGP(str), str, ARG1, s_st_set); + ASRTER(INUMP(k), k, ARG2, s_st_set); + ASRTER(ICHRP(chr), chr, ARG3, s_st_set); + ASRTER(INUM(k) < LENGTH(str) && INUM(k) >= 0, k, OUTOFRANGE, s_st_set); UCHARS(str)[INUM(k)] = ICHR(chr); return UNSPECIFIED; } @@ -1569,8 +1573,8 @@ SCM st_equal(s1, s2) { register sizet i; register unsigned char *c1, *c2; - ASSERT(NIMP(s1) && STRINGP(s1), s1, ARG1, s_st_equal); - ASSERT(NIMP(s2) && STRINGP(s2), s2, ARG2, s_st_equal); + ASRTER(NIMP(s1) && STRINGP(s1), s1, ARG1, s_st_equal); + ASRTER(NIMP(s2) && STRINGP(s2), s2, ARG2, s_st_equal); i = LENGTH(s2); if (LENGTH(s1) != i) return BOOL_F; c1 = UCHARS(s1); @@ -1583,8 +1587,8 @@ SCM stci_equal(s1, s2) { register sizet i; register unsigned char *c1, *c2; - ASSERT(NIMP(s1) && STRINGP(s1), s1, ARG1, s_stci_equal); - ASSERT(NIMP(s2) && STRINGP(s2), s2, ARG2, s_stci_equal); + ASRTER(NIMP(s1) && STRINGP(s1), s1, ARG1, s_stci_equal); + ASRTER(NIMP(s2) && STRINGP(s2), s2, ARG2, s_stci_equal); i = LENGTH(s2); if (LENGTH(s1) != i) return BOOL_F; c1 = UCHARS(s1); @@ -1598,8 +1602,8 @@ SCM st_lessp(s1, s2) register sizet i, len; register unsigned char *c1, *c2; register int c; - ASSERT(NIMP(s1) && STRINGP(s1), s1, ARG1, s_st_lessp); - ASSERT(NIMP(s2) && STRINGP(s2), s2, ARG2, s_st_lessp); + ASRTER(NIMP(s1) && STRINGP(s1), s1, ARG1, s_st_lessp); + ASRTER(NIMP(s2) && STRINGP(s2), s2, ARG2, s_st_lessp); len = LENGTH(s1); i = LENGTH(s2); if (len>i) i = len; @@ -1633,8 +1637,8 @@ SCM stci_lessp(s1, s2) register sizet i, len; register unsigned char *c1, *c2; register int c; - ASSERT(NIMP(s1) && STRINGP(s1), s1, ARG1, s_stci_lessp); - ASSERT(NIMP(s2) && STRINGP(s2), s2, ARG2, s_stci_lessp); + ASRTER(NIMP(s1) && STRINGP(s1), s1, ARG1, s_stci_lessp); + ASRTER(NIMP(s2) && STRINGP(s2), s2, ARG2, s_stci_lessp); len = LENGTH(s1); i = LENGTH(s2); if (len>i) i=len; @@ -1666,13 +1670,13 @@ SCM substring(str, start, end) SCM str, start, end; { long l; - ASSERT(NIMP(str) && STRINGP(str), str, ARG1, s_substring); - ASSERT(INUMP(start), start, ARG2, s_substring); - ASSERT(INUMP(end), end, ARG3, s_substring); - ASSERT(INUM(start) <= LENGTH(str), start, OUTOFRANGE, s_substring); - ASSERT(INUM(end) <= LENGTH(str), end, OUTOFRANGE, s_substring); + ASRTER(NIMP(str) && STRINGP(str), str, ARG1, s_substring); + ASRTER(INUMP(start), start, ARG2, s_substring); + ASRTER(INUMP(end), end, ARG3, s_substring); + ASRTER(INUM(start) <= LENGTH(str), start, OUTOFRANGE, s_substring); + ASRTER(INUM(end) <= LENGTH(str), end, OUTOFRANGE, s_substring); l = INUM(end)-INUM(start); - ASSERT(l >= 0, MAKINUM(l), OUTOFRANGE, s_substring); + ASRTER(l >= 0, MAKINUM(l), OUTOFRANGE, s_substring); return makfromstr(&CHARS(str)[INUM(start)], (sizet)l); } SCM st_append(args) @@ -1683,13 +1687,13 @@ SCM st_append(args) register SCM l, s; register unsigned char *data; for(l = args;NIMP(l);) { - ASSERT(CONSP(l), l, ARGn, s_st_append); + ASRTER(CONSP(l), l, ARGn, s_st_append); s = CAR(l); - ASSERT(NIMP(s) && STRINGP(s), s, ARGn, s_st_append); + ASRTER(NIMP(s) && STRINGP(s), s, ARGn, s_st_append); i += LENGTH(s); l = CDR(l); } - ASSERT(NULLP(l), args, ARGn, s_st_append); + ASRTER(NULLP(l), args, ARGn, s_st_append); res = makstr(i); data = UCHARS(res); for(l = args;NIMP(l);l = CDR(l)) { @@ -1708,7 +1712,7 @@ SCM vectorp(x) SCM vector_length(v) SCM v; { - ASSERT(NIMP(v) && VECTORP(v), v, ARG1, s_ve_length); + ASRTER(NIMP(v) && VECTORP(v), v, ARG1, s_ve_length); return MAKINUM(LENGTH(v)); } SCM vector(l) @@ -1717,7 +1721,7 @@ SCM vector(l) SCM res; register SCM *data; long i = ilength(l); - ASSERT(i >= 0, l, ARG1, s_vector); + ASRTER(i >= 0, l, ARG1, s_vector); res = make_vector(MAKINUM(i), UNSPECIFIED); data = VELTS(res); for(;NIMP(l);l = CDR(l)) *data++ = CAR(l); @@ -1726,17 +1730,17 @@ SCM vector(l) SCM vector_ref(v, k) SCM v, k; { - ASSERT(NIMP(v) && VECTORP(v), v, ARG1, s_ve_ref); - ASSERT(INUMP(k), k, ARG2, s_ve_ref); - ASSERT((INUM(k) < LENGTH(v)) && (INUM(k) >= 0), k, OUTOFRANGE, s_ve_ref); + ASRTER(NIMP(v) && VECTORP(v), v, ARG1, s_ve_ref); + ASRTER(INUMP(k), k, ARG2, s_ve_ref); + ASRTER((INUM(k) < LENGTH(v)) && (INUM(k) >= 0), k, OUTOFRANGE, s_ve_ref); return VELTS(v)[((long) INUM(k))]; } SCM vector_set(v, k, obj) SCM v, k, obj; { - ASSERT(NIMP(v) && VECTORP(v), v, ARG1, s_ve_set); - ASSERT(INUMP(k), k, ARG2, s_ve_set); - ASSERT((INUM(k) < LENGTH(v)) && (INUM(k) >= 0), k, OUTOFRANGE, s_ve_set); + ASRTER(NIMP(v) && VECTORP(v), v, ARG1, s_ve_set); + ASRTER(INUMP(k), k, ARG2, s_ve_set); + ASRTER((INUM(k) < LENGTH(v)) && (INUM(k) >= 0), k, OUTOFRANGE, s_ve_set); VELTS(v)[((long) INUM(k))] = obj; return UNSPECIFIED; } @@ -1748,9 +1752,9 @@ SCM make_vector(k, fill) register long i; register SCM *velts; #ifdef SHORT_SIZET - ASSERT(INUMP(k), k, ARG1, s_make_vector); + ASRTER(INUMP(k), k, ARG1, s_make_vector); #else - ASSERT(INUMP(k) && (!(~LENGTH_MAX & INUM(k))), k, ARG1, s_make_vector); + ASRTER(INUMP(k) && (!(~LENGTH_MAX & INUM(k))), k, ARG1, s_make_vector); #endif if UNBNDP(fill) fill = UNSPECIFIED; i = INUM(k); @@ -45,6 +45,11 @@ #include "scm.h" #include "setjump.h" + +#ifdef POCKETCONSOLE +# include <io.h> +#endif + void igc P((char *what, STACKITEM *stackbase)); void lfflush P((SCM port)); /* internal SCM call */ SCM *loc_open_file; /* for open-file callback */ @@ -73,6 +78,9 @@ SCM *loc_try_create_file; # ifdef linux # include <unistd.h> # endif +# ifdef __NetBSD__ +# include <unistd.h> +# endif # ifdef __OpenBSD__ # include <unistd.h> # endif @@ -172,10 +180,10 @@ SCM try_open_file(filename, modes) FILE *f; char cmodes[4]; long flags; - ASSERT(NIMP(filename) && STRINGP(filename), filename, ARG1, s_open_file); - ASSERT(NIMP(modes) && (STRINGP(modes) || SYMBOLP(modes)), modes, ARG2, s_open_file); + ASRTER(NIMP(filename) && STRINGP(filename), filename, ARG1, s_open_file); + ASRTER(NIMP(modes) && (STRINGP(modes) || SYMBOLP(modes)), modes, ARG2, s_open_file); flags = mode_bits(CHARS(modes), cmodes); - ASSERT(flags, modes, ARG2, s_open_file); + ASRTER(flags, modes, ARG2, s_open_file); if ((EXCLUSIVE & flags) && NIMP(*loc_try_create_file)) { port = apply(*loc_try_create_file, filename, cons(modes, listofnull)); if (UNSPECIFIED != port) return port; @@ -207,12 +215,18 @@ SCM close_port(port) SCM port; { sizet i; - ASSERT(NIMP(port) && PORTP(port), port, ARG1, s_close_port); + SCM ret = UNSPECIFIED; + ASRTER(NIMP(port) && PORTP(port), port, ARG1, s_close_port); if CLOSEDP(port) return UNSPECIFIED; i = PTOBNUM(port); DEFER_INTS; if (ptobs[i].fclose) { - SYSCALL((ptobs[i].fclose)(STREAM(port));); + int r; + SYSCALL(r = (ptobs[i].fclose)(STREAM(port));); + if (EOF == r) + ret = BOOL_F; + else + ret = MAKINUM(r); } CAR(port) &= ~OPN; SCM_PORTFLAGS(port) &= ~OPN; @@ -220,7 +234,7 @@ SCM close_port(port) This allows catching some errors cheaply. */ SCM_SET_PTOBNUM(port, tc16_clport); ALLOW_INTS; - return UNSPECIFIED; + return ret; } SCM input_portp(x) SCM x; @@ -237,7 +251,7 @@ SCM output_portp(x) SCM port_closedp(port) SCM port; { - ASSERT(NIMP(port) && PORTP(port), port, ARG1, s_port_closedp); + ASRTER(NIMP(port) && PORTP(port), port, ARG1, s_port_closedp); if CLOSEDP(port) return BOOL_T; return BOOL_F; } @@ -325,7 +339,7 @@ SCM del_fil(str) SCM str; { int ans; - ASSERT(NIMP(str) && STRINGP(str), str, ARG1, s_del_fil); + ASRTER(NIMP(str) && STRINGP(str), str, ARG1, s_del_fil); #ifdef STDC_HEADERS SYSCALL(ans = remove(CHARS(str));); #else @@ -368,6 +382,12 @@ void prinport(exp, port, type) intprint((long)fileno(STREAM(exp)), 10, port); else intprint(CDR(exp), -16, port); + if (TRACKED & SCM_PORTFLAGS(exp)) { + lputs(" L", port); + intprint(scm_port_table[SCM_PORTNUM(exp)].line, 10, port); + lputs(" C", port); + intprint(scm_port_table[SCM_PORTNUM(exp)].col+0L, 10, port); + } } lputc('>', port); } @@ -424,7 +444,7 @@ static int stungetc(c, p) ind = INUM(CAR(p)); if (ind == 0) return EOF; CAR(p) = MAKINUM(--ind); - ASSERT(UCHARS(CDR(p))[ind] == c, MAKICHR(c), "stungetc", ""); + ASRTER(UCHARS(CDR(p))[ind] == c, MAKICHR(c), "stungetc", ""); return c; } int noop0(stream) @@ -439,8 +459,8 @@ SCM mkstrport(pos, str, modes, caller) char *caller; { SCM z; - ASSERT(INUMP(pos) && INUM(pos) >= 0, pos, ARG1, caller); - ASSERT(NIMP(str) && (STRINGP(str) || SYMBOLP(str)), str, ARG1, caller); + ASRTER(INUMP(pos) && INUM(pos) >= 0, pos, ARG1, caller); + ASRTER(NIMP(str) && (STRINGP(str) || SYMBOLP(str)), str, ARG1, caller); str = cons(pos, str); NEWCELL(z); DEFER_INTS; @@ -577,7 +597,7 @@ static int sfgetc(p) ans = scm_cvapply(VELTS(p)[3], 0L, (SCM *)0); errno = 0; if (FALSEP(ans) || EOF_VAL==ans) return EOF; - ASSERT(ICHRP(ans), ans, ARG1, "getc"); + ASRTER(ICHRP(ans), ans, ARG1, "getc"); return ICHR(ans); } static int sfclose(p) @@ -606,9 +626,9 @@ SCM mksfpt(pv, modes) badarg); } #endif - ASSERT(NIMP(modes) && (STRINGP(modes) || SYMBOLP(modes)), modes, ARG2, s_mksfpt); + ASRTER(NIMP(modes) && (STRINGP(modes) || SYMBOLP(modes)), modes, ARG2, s_mksfpt); flags = mode_bits(CHARS(modes), (char *)0); - ASSERT(flags, modes, ARG2, s_mksfpt); + ASRTER(flags, modes, ARG2, s_mksfpt); DEFER_INTS; z = scm_port_entry((FILE *)pv, tc16_sfport, flags); ALLOW_INTS; @@ -752,7 +772,7 @@ SCM mksafeport(maxlen, port) { SCM z; if UNBNDP(port) port = cur_errp; - ASSERT(NIMP(port) && OPPORTP(port), port, ARG2, s_msp); + ASRTER(NIMP(port) && OPPORTP(port), port, ARG2, s_msp); z = must_malloc_cell(sizeof(safeport)+0L, tc16_safeport | OPN | WRTNG, s_msp); @@ -940,7 +960,7 @@ SCM scm_add_finalizer(value, finalizer) SCM value, finalizer; { SCM z; - ASSERT(NIMP(value), value, ARG1, s_add_finalizer); + ASRTER(NIMP(value), value, ARG1, s_add_finalizer); #ifndef RECKLESS scm_arity_check(finalizer, 0L, s_add_finalizer); #endif @@ -1035,8 +1055,10 @@ void scm_estk_shrink() parent = SCM_ESTK_PARENT(scm_estk); i = INUM(SCM_ESTK_PARENT_INDEX(scm_estk)); if IMP(parent) wta(UNDEFINED, "underflow", s_estk); - if (BOOL_F==SCM_ESTK_PARENT_WRITABLEP(scm_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; + } SCM_ESTK_PARENT(scm_estk) = estk_pool; estk_pool = scm_estk; scm_estk_size -= LENGTH(scm_estk); @@ -1239,7 +1261,7 @@ static char *igc_for_alloc(where, olen, size, what) char *ptr; long nm; /* Check to see that heap is initialized */ - ASSERT(heap_cells > 0, MAKINUM(size), NALLOC, what); + ASRTER(heap_cells > 0, MAKINUM(size), NALLOC, what); /* printf("igc_for_alloc(%lx, %lu, %u, %s)\n", where, olen, size, what); fflush(stdout); */ igc(what, CONT(rootcont)->stkbse); nm = mallocated + size - olen; @@ -1249,7 +1271,7 @@ static char *igc_for_alloc(where, olen, size, what) } if (where) SYSCALL(ptr = (char *)realloc(where, size);); else SYSCALL(ptr = (char *)malloc(size);); - ASSERT(ptr, MAKINUM(size), NALLOC, what); + ASRTER(ptr, MAKINUM(size), NALLOC, what); if (nm > mltrigger) { if (nm > mtrigger) mtrigger = nm + nm/2; else mtrigger += mtrigger/2; @@ -1267,7 +1289,7 @@ char *must_malloc(len, what) long nm = mallocated + size; VERIFY_INTS("must_malloc", what); #ifdef SHORT_SIZET - ASSERT(len==size, MAKINUM(len), NALLOC, what); + ASRTER(len==size, MAKINUM(len), NALLOC, what); #endif if (nm <= mtrigger) SYSCALL(ptr = (char *)malloc(size);); else ptr = 0; @@ -1287,7 +1309,7 @@ SCM must_malloc_cell(len, c, what) long nm = mallocated + size; VERIFY_INTS("must_malloc_cell", what); #ifdef SHORT_SIZET - ASSERT(len==size, MAKINUM(len), NALLOC, what); + ASRTER(len==size, MAKINUM(len), NALLOC, what); #endif NEWCELL(z); if (nm <= mtrigger) SYSCALL(ptr = (char *)malloc(size);); @@ -1309,9 +1331,9 @@ char *must_realloc(where, olen, len, what) long nm = mallocated + size - olen; VERIFY_INTS("must_realloc", what); #ifdef SHORT_SIZET - ASSERT(len==size, MAKINUM(len), NALLOC, what); + ASRTER(len==size, MAKINUM(len), NALLOC, what); #endif - ASSERT(!errjmp_bad, MAKINUM(len), NALLOC, what); + ASRTER(!errjmp_bad, MAKINUM(len), NALLOC, what); /* printf("must_realloc(%lx, %lu, %lu, %s)\n", where, olen, len, what); fflush(stdout); printf("nm = %ld <= mtrigger = %ld: %d; size = %u\n", nm, mtrigger, (nm <= mtrigger), size); fflush(stdout); */ if (nm <= mtrigger) SYSCALL(ptr = (char *)realloc(where, size);); @@ -1330,9 +1352,9 @@ void must_realloc_cell(z, olen, len, what) long nm = mallocated + size - olen; VERIFY_INTS("must_realloc_cell", what); #ifdef SHORT_SIZET - ASSERT(len==size, MAKINUM(len), NALLOC, what); + ASRTER(len==size, MAKINUM(len), NALLOC, what); #endif - ASSERT(!errjmp_bad, MAKINUM(len), NALLOC, what); + ASRTER(!errjmp_bad, MAKINUM(len), NALLOC, what); /* printf("must_realloc_cell(%lx, %lu, %lu, %s)\n", z, olen, len, what); fflush(stdout); */ if (nm <= mtrigger) SYSCALL(ptr = (char *)realloc(where, size);); else ptr = 0; @@ -1479,7 +1501,7 @@ SCM makstr(len) { SCM s; #ifndef SHORT_SIZET - ASSERT(!(len & ~LENGTH_MAX), MAKINUM(len), NALLOC, s_string); + ASRTER(!(len & ~LENGTH_MAX), MAKINUM(len), NALLOC, s_string); #endif DEFER_INTS; s = must_malloc_cell(len+1L, MAKE_LENGTH(len, tc7_string), s_string); @@ -1488,6 +1510,7 @@ SCM makstr(len) return s; } +char s_redefining[] = "redefining "; scm_gra subrs_gra; SCM scm_maksubr(name, type, fcn) const char *name; @@ -1498,7 +1521,14 @@ SCM scm_maksubr(name, type, fcn) int isubr; register SCM z; info.name = name; + for (isubr = subrs_gra.len; 0 < isubr--;) { + if (0==strcmp(((char **)subrs_gra.elts)[isubr], name)) { + scm_warn(s_redefining, (char *)name, UNDEFINED); + goto foundit; + } + } isubr = scm_grow_gra(&subrs_gra, (char *)&info); + foundit: NEWCELL(z); if (!fcn && tc7_cxr==type) { const char *p = name; @@ -1531,7 +1561,7 @@ SCM makcclo(proc, len) { SCM s; # ifndef SHORT_SIZET - ASSERT(len < (((unsigned long)-1L)>>16), UNDEFINED, NALLOC, s_comp_clo); + ASRTER(len < (((unsigned long)-1L)>>16), UNDEFINED, NALLOC, s_comp_clo); # endif DEFER_INTS; s = must_malloc_cell(len*sizeof(SCM), MAKE_NUMDIGS(len, tc16_cclo), @@ -1637,7 +1667,11 @@ SCM scm_make_cont() ncont->other.stkframe[0] = scm_env; ncont->other.stkframe[1] = scm_env_tmp; ncont->other.estk = estk; +#ifdef CHEAP_CONTINUATIONS ncont->other.estk_ptr = scm_estk_ptr; +#else + ncont->other.estk_ptr = (SCM *)0; +#endif #ifndef RECKLESS ncont->other.stkframe[2] = scm_trace_env; ncont->other.stkframe[3] = scm_trace; @@ -1660,11 +1694,11 @@ void scm_dynthrow(tocont, val) scm_estk_ptr = cont->other.estk_ptr; #else { - SCM *from = VELTS(cont->other.estk); - SCM *to = VELTS(scm_estk); + SCM *to, *from = VELTS(cont->other.estk); sizet n = LENGTH(cont->other.estk); - if (LENGTH(scm_estk) < n) scm_estk_reset((sizet)LENGTH(scm_estk)); - scm_estk_ptr = &(to[n]) - SCM_ESTK_FRLEN; + if (LENGTH(scm_estk) < n) scm_estk_reset(n); + to = VELTS(scm_estk); + scm_estk_ptr = &(to[n - SCM_ESTK_FRLEN]); while(n--) to[n] = from[n]; } #endif @@ -1710,7 +1744,7 @@ SCM obunhash(obj) goto comm; } #endif - ASSERT(INUMP(obj), obj, ARG1, s_obunhash); + ASRTER(INUMP(obj), obj, ARG1, s_obunhash); obj = SRS(obj, 1) & ~1L; comm: if IMP(obj) return obj; @@ -1969,7 +2003,7 @@ SCM scm_port_entry(stream, ptype, flags) int i, j; VERIFY_INTS("scm_port_entry", 0L); flags = flags | (ptype & ~0xffffL); - ASSERT(flags, INUM0, ARG1, "scm_port_entry"); + ASRTER(flags, INUM0, ARG1, "scm_port_entry"); for (i = 1; i < scm_port_table_len; i++) if (0L==scm_port_table[i].flags) goto ret; if (scm_port_table_len <= SCM_PORTNUM_MAX) { @@ -2044,6 +2078,10 @@ void init_storage(stack_start_ptr, init_heap_size) /* Because not all protects may get initialized */ freelist = EOL; expmem = 0; + estk_pool = EOL; + scm_estk = BOOL_F; + scm_port_table = 0; + scm_port_table_len = 0; #ifdef SHORT_SIZET if (sizeof(sizet) >= sizeof(long)) @@ -2064,11 +2102,12 @@ void init_storage(stack_start_ptr, init_heap_size) fixconfig(remsg, "CDR_DOUBLES", 0); #else # ifdef SINGLES - if (sizeof(float) != sizeof(long)) + if (sizeof(float) != sizeof(long)) { if (sizeof(double) == sizeof(long)) fixconfig(addmsg, "CDR_DOUBLES", 0); else fixconfig(remsg, "SINGLES", 0); + } # endif #endif #ifdef BIGDIG @@ -2508,7 +2547,7 @@ void gc_mark(p) case tc7_string: case tc7_msymbol: if GC8MARKP(ptr) break; - ASSERT(!(CHARS(ptr)[HUGE_LENGTH(ptr)]), MAKINUM(HUGE_LENGTH(ptr)), + ASRTER(!(CHARS(ptr)[HUGE_LENGTH(ptr)]), MAKINUM(HUGE_LENGTH(ptr)), s_wrong_length, s_gc); case tc7_ssymbol: case tc7_bvect: @@ -2536,7 +2575,7 @@ void gc_mark(p) switch TYP16(ptr) { /* should be faster than going through smobs */ case tc_free_cell: /* printf("found free_cell %X ", ptr); fflush(stdout); */ - ASSERT(tc_broken_heart!=CAR(ptr), ptr, "found ecache forward", s_gc); + ASRTER(tc_broken_heart!=CAR(ptr), ptr, "found ecache forward", s_gc); /* CDR(ptr) = UNDEFINED */; break; #ifdef BIGDIG @@ -2784,14 +2823,14 @@ static void mark_syms(v) while (k--) for (al = VELTS(v)[k]; NIMP(al); al = GCCDR(al)) { /* If this bucket has already been marked, then something is wrong. */ - ASSERT(!GCMARKP(al), al, s_bad_type, s_gc_sym); + ASRTER(!GCMARKP(al), al, s_bad_type, s_gc_sym); x = CAR(al); SETGCMARK(al); /* Do mark bucket list */ # ifdef CAREFUL_INTS - ASSERT(NIMP(x) && NIMP(CAR(x)) && !GCMARKP(x), x, s_bad_type, s_gc_sym); - ASSERT(!GC8MARKP(CAR(x)) && !(CHARS(CAR(x))[LENGTH(CAR(x))]), + ASRTER(NIMP(x) && NIMP(CAR(x)) && !GCMARKP(x), x, s_bad_type, s_gc_sym); + ASRTER(!GC8MARKP(CAR(x)) && !(CHARS(CAR(x))[LENGTH(CAR(x))]), CAR(x), s_wrong_length, s_gc_sym); - ASSERT(strhash(UCHARS(CAR(x)), (sizet)LENGTH(CAR(x)), + ASRTER(strhash(UCHARS(CAR(x)), (sizet)LENGTH(CAR(x)), (unsigned long)symhash_dim)==k, CAR(x), "bad hash", s_gc_sym); # endif @@ -2907,7 +2946,7 @@ static void mark_port_table(port) SCM port; { int i = SCM_PORTNUM(port); - ASSERT(i>=0 && i<scm_port_table_len, MAKINUM(i), "bad port", s_gc); + ASRTER(i>=0 && i<scm_port_table_len, MAKINUM(i), "bad port", s_gc); if (i) { scm_port_table[i].flags |= 1; if (NIMP(scm_port_table[i].data)) @@ -3004,11 +3043,12 @@ static void egc_copy_locations(ve, len) SCM x; while (len--) { x = ve[len]; - if (NIMP(x) && ECACHEP(x)) + if (NIMP(x) && ECACHEP(x)) { if (tc_broken_heart==CAR(x)) ve[len] = CDR(x); else egc_copy(&(ve[len])); + } } } static void egc_copy_stack(stk, len) @@ -3112,7 +3152,7 @@ void scm_egc() SCM stkframe[2]; long lcells = cells_allocated; sizet nstk = (scm_estk_ptr - VELTS(scm_estk) + SCM_ESTK_FRLEN); - ASSERT(nstk<=LENGTH(scm_estk), UNDEFINED, "estk corrupted", s_cache_gc); + ASRTER(nstk<=LENGTH(scm_estk), UNDEFINED, "estk corrupted", s_cache_gc); scm_egc_start(); stkframe[0] = scm_env; stkframe[1] = scm_env_tmp; @@ -117,6 +117,11 @@ # include <sys/timeb.h> # define USE_GETTIMEOFDAY #endif +#ifdef __NetBSD__ +# include <sys/timeb.h> +# include <sys/times.h> +# define USE_GETTIMEOFDAY +#endif #ifdef __OpenBSD__ # include <sys/types.h> # include <sys/time.h> @@ -352,9 +357,8 @@ SCM your_time() } else if ((1 + time_buffer1.time)==time_buffer2.time) ; else if (cnt < TIMETRIES) goto tryagain; - else { - scm_warn("could not read two ftime()s within one second in 10 tries", - "", UNDEFINED); + else { /* could not read two ftime()s within one second in 10 tries */ + scm_warn("ftime()s too fast", "", MAKINUM(TIMETRIES)); return MAKINUM(-1); } tmp = CLKTCK*(time_buffer2.millitm - your_base.millitm); @@ -66,6 +66,7 @@ #include <math.h> /* sin(), cos(), fmod() */ #include <stdlib.h> /* atexit() */ + /****************************************************/ /***** X11 specific includes & defines *****/ /****************************************************/ @@ -157,6 +158,10 @@ static char s_gr_moveTo[] = "move-to!"; static char s_gr_setdot[] = "set-dot!"; static char s_gr_validXYC[] = "valid-xyc?"; +#ifndef ASSERT +#define ASSERT(ignore1, ignore2, ignore3, ignore4) +#endif + #ifdef __GNUC__ inline #else @@ -106,7 +106,7 @@ SCM resizuve(vect, len) # endif #endif } - ASSERT(INUMP(len), len, ARG2, s_resizuve); + ASRTER(INUMP(len), len, ARG2, s_resizuve); if (!l) l = 1L; siz = l * sz; if (siz != l * sz) wta(MAKINUM(l * sz), (char *) NALLOC, s_resizuve); @@ -202,6 +202,7 @@ SCM make_uve(k, prot) # endif } DEFER_INTS; + /* Make a potentially HUGE object */ v = must_malloc_cell((i ? i : 1L), MAKE_LENGTH((k < LENGTH_MAX ? k : LENGTH_MAX), type), s_vector); @@ -287,26 +288,27 @@ long aind(ra, args, what) register sizet k = ARRAY_NDIM(ra); array_dim *s = ARRAY_DIMS(ra); if INUMP(args) { - ASSERT(1==k, UNDEFINED, WNA, what); + ASRTER(1==k, UNDEFINED, WNA, what); j = INUM(args); - ASSERT(j >= (s->lbnd) && j <= (s->ubnd), args, OUTOFRANGE, what); + ASRTER(j >= (s->lbnd) && j <= (s->ubnd), args, OUTOFRANGE, what); return pos + (j - s->lbnd)*(s->inc); } - ASSERT((IMP(args) ? NULLP(args) : CONSP(args)), args, s_bad_ind, what); + ASRTER((IMP(args) ? NULLP(args) : CONSP(args)), args, s_bad_ind, what); while (k && NIMP(args)) { ind = CAR(args); args = CDR(args); - ASSERT(INUMP(ind), ind, s_bad_ind, what); + ASRTER(INUMP(ind), ind, s_bad_ind, what); j = INUM(ind); - ASSERT(j >= (s->lbnd) && j <= (s->ubnd), ind, OUTOFRANGE, what); + ASRTER(j >= (s->lbnd) && j <= (s->ubnd), ind, OUTOFRANGE, what); pos += (j - s->lbnd)*(s->inc); k--; s++; } - ASSERT(0==k && NULLP(args), UNDEFINED, WNA, what); + ASRTER(0==k && NULLP(args), UNDEFINED, WNA, what); return pos; } +/* Given rank, allocate cell only. */ SCM make_ra(ndim) int ndim; { @@ -329,32 +331,33 @@ SCM shap2ra(args, what) array_dim *s; SCM ra, spec, sp; int ndim = ilength(args); - ASSERT(0 <= ndim, args, s_bad_spec, what); + ASRTER(0 <= ndim, args, s_bad_spec, what); ra = make_ra(ndim); ARRAY_BASE(ra) = 0; s = ARRAY_DIMS(ra); for (; NIMP(args); s++, args = CDR(args)) { spec = CAR(args); if IMP(spec) { - ASSERT(INUMP(spec)&&INUM(spec)>=0, spec, s_bad_spec, what); + ASRTER(INUMP(spec)&&INUM(spec)>=0, spec, s_bad_spec, what); s->lbnd = 0; s->ubnd = INUM(spec) - 1; s->inc = 1; } else { - ASSERT(CONSP(spec) && INUMP(CAR(spec)), spec, s_bad_spec, what); + ASRTER(CONSP(spec) && INUMP(CAR(spec)), spec, s_bad_spec, what); s->lbnd = INUM(CAR(spec)); sp = CDR(spec); - ASSERT(NIMP(sp) && INUMP(CAR(sp)) && NULLP(CDR(sp)), + ASRTER(NIMP(sp) && INUMP(CAR(sp)) && NULLP(CDR(sp)), spec, s_bad_spec, what); s->ubnd = INUM(CAR(sp)); + ASRTER(s->ubnd >= s->lbnd, spec, s_bad_spec, what); s->inc = 1; } } return ra; } -static char s_uve_fill[] = "uniform-vector-fill!"; +char s_array_fill[] = "array-fill!"; int rafill(ra, fill, ignore) SCM ra, fill, ignore; { @@ -370,8 +373,8 @@ int rafill(ra, fill, ignore) else n = LENGTH(ra); switch TYP7(ra) { - badarg2: wta(fill, (char *)ARG2, s_uve_fill); - default: ASSERT(NFALSEP(arrayp(ra, UNDEFINED)), ra, ARG1, s_uve_fill); + badarg2: wta(fill, (char *)ARG2, s_array_fill); + default: ASRTER(NFALSEP(arrayp(ra, UNDEFINED)), ra, ARG1, s_array_fill); for (i = base; n--; i += inc) aset(ra, fill, MAKINUM(i)); break; @@ -427,8 +430,8 @@ int rafill(ra, fill, ignore) { long *ve = VELTS(ra); long f = (tc7_uvect==TYP7(ra) ? - num2ulong(fill, (char *)ARG2, s_uve_fill) : - num2long(fill, (char *)ARG2, s_uve_fill)); + num2ulong(fill, (char *)ARG2, s_array_fill) : + num2long(fill, (char *)ARG2, s_array_fill)); for (i = base; n--; i += inc) ve[i] = f; break; @@ -436,14 +439,14 @@ int rafill(ra, fill, ignore) # ifdef FLOATS case tc7_fvect: { float *ve = (float *)VELTS(ra); - float f = num2dbl(fill, (char *)ARG2, s_uve_fill); + float f = num2dbl(fill, (char *)ARG2, s_array_fill); for (i = base; n--; i += inc) ve[i] = f; break; } case tc7_dvect: { double *ve = (double *)VELTS(ra); - double f = num2dbl(fill, (char *)ARG2, s_uve_fill); + double f = num2dbl(fill, (char *)ARG2, s_array_fill); for (i = base; n--; i += inc) ve[i] = f; break; @@ -456,7 +459,7 @@ int rafill(ra, fill, ignore) fi = IMAG(fill); } else - fr = num2dbl(fill, (char *)ARG2, s_uve_fill); + fr = num2dbl(fill, (char *)ARG2, s_array_fill); for (i = base; n--; i += inc) { ve[i][0] = fr; ve[i][1] = fi; @@ -467,15 +470,6 @@ int rafill(ra, fill, ignore) } return 1; } -SCM uve_fill(uve, fill) - SCM uve, fill; -{ - - ASSERT(NIMP(uve) && (!ARRAYP(uve) || 1==ARRAY_NDIM(uve)), - uve, ARG1, s_uve_fill); - rafill(uve, fill, EOL); - return UNSPECIFIED; -} static char s_dims2ura[] = "dimensions->uniform-array"; SCM dims2ura(dims, prot, fill) @@ -485,16 +479,17 @@ 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) - rafill(ra, CAR(fill), EOL); + rafill(ra, CAR(fill), UNDEFINED); return ra; } else dims = cons(dims, EOL); - ASSERT(NULLP(dims) || (NIMP(dims) && CONSP(dims)), dims, ARG1, s_dims2ura); + } + ASRTER(NULLP(dims) || (NIMP(dims) && CONSP(dims)), dims, ARG1, s_dims2ura); ra = shap2ra(dims, s_dims2ura); CAR(ra) |= ARRAY_CONTIGUOUS; s = ARRAY_DIMS(ra); @@ -504,8 +499,10 @@ SCM dims2ura(dims, prot, fill) rlen = (s[k].ubnd - s[k].lbnd + 1)*s[k].inc; vlen *= (s[k].ubnd - s[k].lbnd + 1); } - if (rlen < LENGTH_MAX) - ARRAY_V(ra) = make_uve((rlen > 0 ? rlen : 0L), prot); + if (rlen <= 0) + ARRAY_V(ra) = make_uve(0L, prot); + else if (rlen < LENGTH_MAX) + ARRAY_V(ra) = make_uve(rlen, prot); else { sizet bit; switch TYP7(make_uve(0L, prot)) { @@ -523,8 +520,8 @@ SCM dims2ura(dims, prot, fill) *((long *)VELTS(ARRAY_V(ra))) = rlen; } if NNULLP(fill) { - ASSERT(1==ilength(fill), UNDEFINED, WNA, s_dims2ura); - rafill(ARRAY_V(ra), CAR(fill), EOL); + ASRTER(1==ilength(fill), UNDEFINED, WNA, s_dims2ura); + rafill(ARRAY_V(ra), CAR(fill), UNDEFINED); } if (1==ARRAY_NDIM(ra) && 0==ARRAY_BASE(ra)) if (s->ubnd < s->lbnd || (0==s->lbnd && 1==s->inc)) return ARRAY_V(ra); @@ -557,8 +554,11 @@ SCM make_sh_array(oldra, mapfunc, dims) sizet i, k; long old_min, new_min, old_max, new_max; array_dim *s; - ASSERT(BOOL_T==procedurep(mapfunc), mapfunc, ARG2, s_make_sh_array); - ASSERT(NIMP(oldra) && arrayp(oldra, UNDEFINED), oldra, ARG1, s_make_sh_array); + ASRTER(BOOL_T==procedurep(mapfunc), mapfunc, ARG2, s_make_sh_array); + ASRTER(NIMP(oldra) && arrayp(oldra, UNDEFINED), oldra, ARG1, s_make_sh_array); +# ifndef RECKLESS + scm_arity_check(mapfunc, ilength(dims), s_make_sh_array); +# endif ra = shap2ra(dims, s_make_sh_array); if (ARRAYP(oldra)) { ARRAY_V(ra) = ARRAY_V(oldra); @@ -598,7 +598,7 @@ SCM make_sh_array(oldra, mapfunc, dims) i = (sizet)aind(oldra, imap, s_make_sh_array); else { if NINUMP(imap) { - ASSERT(1==ilength(imap) && INUMP(CAR(imap)), + ASRTER(1==ilength(imap) && INUMP(CAR(imap)), imap, s_bad_ind, s_make_sh_array); imap = CAR(imap); } @@ -616,7 +616,7 @@ SCM make_sh_array(oldra, mapfunc, dims) s[k].inc = aind(oldra, imap, s_make_sh_array) - i; else { if NINUMP(imap) { - ASSERT(1==ilength(imap) && INUMP(CAR(imap)), + ASRTER(1==ilength(imap) && INUMP(CAR(imap)), imap, s_bad_ind, s_make_sh_array); imap = CAR(imap); } @@ -631,7 +631,7 @@ SCM make_sh_array(oldra, mapfunc, dims) else s[k].inc = new_max - new_min + 1; /* contiguous by default */ } - ASSERT(old_min <= new_min && old_max >= new_max, UNDEFINED, + ASRTER(old_min <= new_min && old_max >= new_max, UNDEFINED, "mapping out of range", s_make_sh_array); if (1==ARRAY_NDIM(ra) && 0==ARRAY_BASE(ra)) { if (1==s->inc && 0==s->lbnd @@ -650,24 +650,24 @@ SCM trans_array(args) SCM ra, res, vargs, *ve = &vargs; array_dim *s, *r; int ndim, i, k; - ASSERT(NIMP(args), UNDEFINED, WNA, s_trans_array); + ASRTER(NIMP(args), UNDEFINED, WNA, s_trans_array); ra = CAR(args); args = CDR(args); switch TYP7(ra) { default: badarg: wta(ra, (char *)ARG1, s_trans_array); case tc7_vector: case tcs_uves: - ASSERT(NIMP(args) && NULLP(CDR(args)), UNDEFINED, WNA, s_trans_array); - ASSERT(INUM0==CAR(args), CAR(args), ARG1, s_trans_array); + ASRTER(NIMP(args) && NULLP(CDR(args)), UNDEFINED, WNA, s_trans_array); + ASRTER(INUM0==CAR(args), CAR(args), ARG1, s_trans_array); return ra; case tc7_smob: ASRTGO(ARRAYP(ra), badarg); vargs = vector(args); - ASSERT(LENGTH(vargs)==ARRAY_NDIM(ra), UNDEFINED, WNA, s_trans_array); + ASRTER(LENGTH(vargs)==ARRAY_NDIM(ra), UNDEFINED, WNA, s_trans_array); ve = VELTS(vargs); ndim = 0; for (k = 0; k < ARRAY_NDIM(ra); k++) { i = INUM(ve[k]); - ASSERT(INUMP(ve[k]) && i >=0 && i < ARRAY_NDIM(ra), + ASRTER(INUMP(ve[k]) && i >=0 && i < ARRAY_NDIM(ra), ve[k], ARG2, s_trans_array); if (ndim < i) ndim = i; } @@ -699,7 +699,7 @@ SCM trans_array(args) r->inc += s->inc; } } - ASSERT(ndim <= 0, args, "bad argument list", s_trans_array); + ASRTER(ndim <= 0, args, "bad argument list", s_trans_array); ra_set_contp(res); return res; } @@ -713,7 +713,7 @@ SCM encl_array(axes) SCM axv, ra, res, ra_inr; array_dim vdim, *s = &vdim; int ndim, j, k, ninr, noutr; - ASSERT(NIMP(axes), UNDEFINED, WNA, s_encl_array); + ASRTER(NIMP(axes), UNDEFINED, WNA, s_encl_array); ra = CAR(axes); axes = CDR(axes); if NULLP(axes) @@ -741,13 +741,13 @@ SCM encl_array(axes) } noutr = ndim - ninr; axv = make_string(MAKINUM(ndim), MAKICHR(0)); - ASSERT(0 <= noutr && 0 <= ninr, UNDEFINED, WNA, s_encl_array); + ASRTER(0 <= noutr && 0 <= ninr, UNDEFINED, WNA, s_encl_array); res = make_ra(noutr); ARRAY_BASE(res) = ARRAY_BASE(ra_inr); ARRAY_V(res) = ra_inr; for (k = 0; k < ninr; k++, axes = CDR(axes)) { j = INUM(CAR(axes)); - ASSERT(INUMP(CAR(axes)) && j<ndim, CAR(axes), "bad axis", s_encl_array); + ASRTER(INUMP(CAR(axes)) && j<ndim, CAR(axes), "bad axis", s_encl_array); ARRAY_DIMS(ra_inr)[k].lbnd = s[j].lbnd; ARRAY_DIMS(ra_inr)[k].ubnd = s[j].ubnd; ARRAY_DIMS(ra_inr)[k].inc = s[j].inc; @@ -787,7 +787,7 @@ SCM array_inbp(args) while (k && NIMP(args)) { ind = CAR(args); args = CDR(args); - ASSERT(INUMP(ind), ind, s_bad_ind, s_array_inbp); + ASRTER(INUMP(ind), ind, s_bad_ind, s_array_inbp); j = INUM(ind); if (j < (s->lbnd) || j > (s->ubnd)) ret = BOOL_F; k--; @@ -801,7 +801,7 @@ SCM array_inbp(args) case tcs_uves: ASRTGO(NIMP(args) && NULLP(CDR(args)), wna); ind = CAR(args); - ASSERT(INUMP(ind), ind, s_bad_ind, s_array_inbp); + ASRTER(INUMP(ind), ind, s_bad_ind, s_array_inbp); j = INUM(ind); return j >= 0 && j < LENGTH(v) ? BOOL_T : BOOL_F; } @@ -821,12 +821,12 @@ SCM aref(v, args) } else { if NIMP(args) { - ASSERT(CONSP(args) && INUMP(CAR(args)), args, ARG2, s_aref); + ASRTER(CONSP(args) && INUMP(CAR(args)), args, ARG2, s_aref); pos = INUM(CAR(args)); ASRTGO(NULLP(CDR(args)), wna); } else { - ASSERT(INUMP(args), args, ARG2, s_aref); + ASRTER(INUMP(args), args, ARG2, s_aref); pos = INUM(args); } ASRTGO(pos >= 0 && pos < LENGTH(v), outrng); @@ -886,7 +886,7 @@ SCM aref(v, args) SCM scm_array_ref(args) SCM args; { - ASSERT(NIMP(args), UNDEFINED, WNA, s_aref); + ASRTER(NIMP(args), UNDEFINED, WNA, s_aref); return aref(CAR(args), CDR(args)); } @@ -994,12 +994,12 @@ SCM aset(v, obj, args) } else { if NIMP(args) { - ASSERT(CONSP(args) && INUMP(CAR(args)), args, ARG2, s_aset); + ASRTER(CONSP(args) && INUMP(CAR(args)), args, ARG2, s_aset); pos = INUM(CAR(args)); ASRTGO(NULLP(CDR(args)), wna); } else { - ASSERT(INUMP(args), args, ARG2, s_aset); + ASRTER(INUMP(args), args, ARG2, s_aset); pos = INUM(args); } ASRTGO(pos >= 0 && pos < LENGTH(v), outrng); @@ -1099,7 +1099,7 @@ SCM uve_read(v, port) long sz, len, ans; long start=0; if UNBNDP(port) port = cur_inp; - ASSERT(NIMP(port) && OPINFPORTP(port), port, ARG2, s_uve_rd); + ASRTER(NIMP(port) && OPINFPORTP(port), port, ARG2, s_uve_rd); ASRTGO(NIMP(v), badarg1); len = LENGTH(v); loop: @@ -1164,7 +1164,7 @@ SCM uve_write(v, port) long sz, len, ans; long start=0; if UNBNDP(port) port = cur_outp; - ASSERT(NIMP(port) && OPOUTFPORTP(port), port, ARG2, s_uve_wr); + ASRTER(NIMP(port) && OPOUTFPORTP(port), port, ARG2, s_uve_wr); ASRTGO(NIMP(v), badarg1); len = LENGTH(v); loop: @@ -1220,7 +1220,7 @@ SCM lcount(item, seq) long i, imin, ubnd, lbnd = 0; int enclosed = 0; register unsigned long cnt = 0, w; - ASSERT(NIMP(seq), seq, ARG2, s_count); + ASRTER(NIMP(seq), seq, ARG2, s_count); ubnd = LENGTH(seq) - 1; tail: switch TYP7(seq) { @@ -1251,9 +1251,10 @@ 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++; + } else for (;n--; i+=inc) if ((VELTS(seq)[i/LONG_BIT]) & (1L<<(i%LONG_BIT))) cnt++; @@ -1279,14 +1280,14 @@ SCM bit_position(item, v, k) long i, len, lenw, xbits, pos = INUM(k), offset = 0; int enclosed = 0; register unsigned long w; - ASSERT(NIMP(v), v, ARG2, s_uve_pos); - ASSERT(INUMP(k), k, ARG3, s_uve_pos); + ASRTER(NIMP(v), v, ARG2, s_uve_pos); + ASRTER(INUMP(k), k, ARG3, s_uve_pos); len = LENGTH(v); tail: switch TYP7(v) { default: badarg2: wta(v, (char *)ARG2, s_uve_pos); case tc7_bvect: - ASSERT((pos <= len) && (pos >= 0), k, OUTOFRANGE, s_uve_pos); + ASRTER((pos <= len) && (pos >= 0), k, OUTOFRANGE, s_uve_pos); if (pos==len) return BOOL_F; if (0==len) return MAKINUM(-1L); lenw = (len-1)/LONG_BIT; /* watch for part words */ @@ -1315,7 +1316,7 @@ SCM bit_position(item, v, k) } return BOOL_F; case tc7_smob: ASRTGO(ARRAYP(v) && 1==ARRAY_NDIM(v) && !enclosed++, badarg2); - ASSERT(pos >= ARRAY_DIMS(v)->lbnd, k, OUTOFRANGE, s_uve_pos); + ASRTER(pos >= ARRAY_DIMS(v)->lbnd, k, OUTOFRANGE, s_uve_pos); if (1==ARRAY_DIMS(v)->inc) { len = ARRAY_DIMS(v)->ubnd - ARRAY_DIMS(v)->lbnd + ARRAY_BASE(v) + 1; offset = ARRAY_BASE(v) - ARRAY_DIMS(v)->lbnd; @@ -1357,12 +1358,12 @@ SCM bit_set(v, kv, obj) vlen = LENGTH(v); if (BOOL_F==obj) for (i = LENGTH(kv);i;) { k = VELTS(kv)[--i]; - ASSERT((k < vlen), MAKINUM(k), OUTOFRANGE, s_bit_set); + ASRTER((k < vlen), MAKINUM(k), OUTOFRANGE, s_bit_set); VELTS(v)[k/LONG_BIT] &= ~(1L<<(k%LONG_BIT)); } else if (BOOL_T==obj) for (i = LENGTH(kv); i;) { k = VELTS(kv)[--i]; - ASSERT((k < vlen), MAKINUM(k), OUTOFRANGE, s_bit_set); + ASRTER((k < vlen), MAKINUM(k), OUTOFRANGE, s_bit_set); VELTS(v)[k/LONG_BIT] |= (1L<<(k%LONG_BIT)); } else @@ -1400,12 +1401,12 @@ SCM bit_count(v, kv, obj) vlen = LENGTH(v); if (BOOL_F==obj) for (i = LENGTH(kv);i;) { k = VELTS(kv)[--i]; - ASSERT((k < vlen), MAKINUM(k), OUTOFRANGE, s_bit_count); + ASRTER((k < vlen), MAKINUM(k), OUTOFRANGE, s_bit_count); if (!(VELTS(v)[k/LONG_BIT] & (1L<<(k%LONG_BIT)))) count++; } else if (BOOL_T==obj) for (i = LENGTH(kv); i;) { k = VELTS(kv)[--i]; - ASSERT((k < vlen), MAKINUM(k), OUTOFRANGE, s_bit_count); + ASRTER((k < vlen), MAKINUM(k), OUTOFRANGE, s_bit_count); if (VELTS(v)[k/LONG_BIT] & (1L<<(k%LONG_BIT))) count++; } else @@ -1645,10 +1646,10 @@ SCM list2ura(ndim, prot, lst) SCM ra; long n; sizet k = INUM(ndim); - ASSERT(INUMP(ndim), ndim, ARG1, s_list2ura); + ASRTER(INUMP(ndim), ndim, ARG1, s_list2ura); for (; k--; NIMP(row) && (row = CAR(row))) { n = ilength(row); - ASSERT(n>=0, lst, ARG2, s_list2ura); + ASRTER(n>=0, lst, ARG2, s_list2ura); shp = cons(MAKINUM(n), shp); } ra = dims2ura(reverse(shp), prot, EOL); @@ -1915,26 +1916,26 @@ SCM scm_logaref(args) { SCM ra, inds, ibit; int i, rank = 1; - ASSERT(NIMP(args), UNDEFINED, WNA, s_logaref); + ASRTER(NIMP(args), UNDEFINED, WNA, s_logaref); ra = CAR(args); - ASSERT(NIMP(ra), ra, ARG1, s_logaref); + ASRTER(NIMP(ra), ra, ARG1, s_logaref); if ARRAYP(ra) rank = ARRAY_NDIM(ra); inds = args = CDR(args); for (i = rank; i; i--) { - ASSERT(NIMP(args) && CONSP(args), UNDEFINED, WNA, s_logaref); + ASRTER(NIMP(args) && CONSP(args), UNDEFINED, WNA, s_logaref); args = CDR(args); } if NULLP(args) return aref(ra, inds); - ASSERT(NIMP(args) && CONSP(args) && NULLP(CDR(args)), + ASRTER(NIMP(args) && CONSP(args) && NULLP(CDR(args)), inds, WNA, s_logaref); - ASSERT(INUMP(CAR(args)), CAR(args), ARGn, s_logaref); + ASRTER(INUMP(CAR(args)), CAR(args), ARGn, s_logaref); ibit = CAR(args); if (1==rank) inds = CAR(inds); else { /* Destructively modify arglist */ args = inds; for (i = rank-1; i; i--) { - ASSERT(NIMP(args) && CONSP(args), UNDEFINED, WNA, s_logaref); + ASRTER(NIMP(args) && CONSP(args), UNDEFINED, WNA, s_logaref); args = CDR(args); } CDR(args) = EOL; @@ -1951,29 +1952,29 @@ SCM scm_logaset(ra, obj, args) { SCM oval, inds, ibit; int i, rank = 1; - ASSERT(NIMP(ra), ra, ARG1, s_logaset); + ASRTER(NIMP(ra), ra, ARG1, s_logaset); if ARRAYP(ra) rank = ARRAY_NDIM(ra); inds = args; for (i = rank; i; i--) { - ASSERT(NIMP(args) && CONSP(args), UNDEFINED, WNA, s_logaset); + ASRTER(NIMP(args) && CONSP(args), UNDEFINED, WNA, s_logaset); args = CDR(args); } if NNULLP(args) { - ASSERT(NIMP(args) && CONSP(args) && NULLP(CDR(args)), + ASRTER(NIMP(args) && CONSP(args) && NULLP(CDR(args)), inds, WNA, s_logaset); - ASSERT(INUMP(CAR(args)), CAR(args), ARGn, s_logaset); + ASRTER(INUMP(CAR(args)), CAR(args), ARGn, s_logaset); ibit = CAR(args); if (1==rank) inds = CAR(inds); else { /* Destructively modify arglist */ args = inds; for (i = rank-1; i; i--) { - ASSERT(NIMP(args) && CONSP(args), UNDEFINED, WNA, s_logaset); + ASRTER(NIMP(args) && CONSP(args), UNDEFINED, WNA, s_logaset); args = CDR(args); } CDR(args) = EOL; } oval = aref(ra, inds); - ASSERT(INUMP(ibit), ibit, ARGn, s_logaset); + ASRTER(INUMP(ibit), ibit, ARGn, s_logaset); if (BOOL_T==obj) obj = INUMP(oval) ? MAKINUM(INUM(oval) | (1<<INUM(ibit))) : scm_logior(oval, MAKINUM(1<<INUM(ibit))); @@ -1997,7 +1998,6 @@ static iproc subr3s[] = { static iproc subr2s[] = { {s_resizuve, resizuve}, {s_count, lcount}, - {s_uve_fill, uve_fill}, {0, 0}}; static iproc subr1s[] = { @@ -69,6 +69,9 @@ SCM scm_lstat P((SCM str)); # ifdef SVR4 # include <unistd.h> # endif +# ifdef __NetBSD__ +# include <unistd.h> +# endif # ifdef __OpenBSD__ # include <unistd.h> # endif @@ -82,9 +85,9 @@ SCM scm_mknod(path, mode, dev) SCM path, mode, dev; { int val; - ASSERT(NIMP(path) && STRINGP(path), path, ARG1, s_mknod); - ASSERT(INUMP(mode), mode, ARG2, s_mknod); - ASSERT(INUMP(dev), dev, ARG3, s_mknod); + ASRTER(NIMP(path) && STRINGP(path), path, ARG1, s_mknod); + ASRTER(INUMP(mode), mode, ARG2, s_mknod); + ASRTER(INUMP(dev), dev, ARG3, s_mknod); SYSCALL(val = mknod(CHARS(path), INUM(mode), INUM(dev));); return val ? BOOL_F : BOOL_T; } @@ -97,7 +100,7 @@ SCM scm_acct(path) SYSCALL(val = acct(0);); return val ? BOOL_F : BOOL_T; } - ASSERT(NIMP(path) && STRINGP(path), path, ARG1, s_acct); + ASRTER(NIMP(path) && STRINGP(path), path, ARG1, s_acct); SYSCALL(val = acct(CHARS(path));); return val ? BOOL_F : BOOL_T; } @@ -106,7 +109,7 @@ static char s_nice[] = "nice"; SCM scm_nice(incr) SCM incr; { - ASSERT(INUMP(incr), incr, ARG1, s_nice); + ASRTER(INUMP(incr), incr, ARG1, s_nice); return nice(INUM(incr)) ? BOOL_F : BOOL_T; } @@ -121,8 +124,8 @@ SCM scm_symlink(oldpath, newpath) SCM oldpath, newpath; { int val; - ASSERT(NIMP(oldpath) && STRINGP(oldpath), oldpath, ARG1, s_symlink); - ASSERT(NIMP(newpath) && STRINGP(newpath), newpath, ARG2, s_symlink); + ASRTER(NIMP(oldpath) && STRINGP(oldpath), oldpath, ARG1, s_symlink); + ASRTER(NIMP(newpath) && STRINGP(newpath), newpath, ARG2, s_symlink); SYSCALL(val = symlink(CHARS(oldpath), CHARS(newpath));); return val ? BOOL_F : BOOL_T; } @@ -132,7 +135,7 @@ SCM scm_readlink(path) { int i; char buf[1024]; - ASSERT(NIMP(path) && STRINGP(path), path, ARG1, s_readlink); + ASRTER(NIMP(path) && STRINGP(path), path, ARG1, s_readlink); SYSCALL(i = readlink(CHARS(path), buf, (sizet)sizeof(buf));); if (-1==i) return BOOL_F; return makfromstr(buf, (sizet)i); @@ -143,7 +146,7 @@ SCM scm_lstat(str) { int i; struct stat stat_temp; - ASSERT(NIMP(str) && STRINGP(str), str, ARG1, s_lstat); + ASRTER(NIMP(str) && STRINGP(str), str, ARG1, s_lstat); SYSCALL(i = lstat(CHARS(str), &stat_temp);); if (i) return BOOL_F; return stat2scm(&stat_temp); diff --git a/version.txi b/version.txi index 4bfee47..e7ced09 100644 --- a/version.txi +++ b/version.txi @@ -1,2 +1,4 @@ @set SCMVERSION 5d6 @set SCMDATE May 2002 +@set SCMVERSION 5d9 +@set SCMDATE November 2003 @@ -59,6 +59,7 @@ #include <X11/Xlib.h> #include <X11/Xcms.h> /*#include <X11/Xcmsint.h>*/ /* For IntensityTbl */ +#include <X11/Xresource.h> #include <X11/Xutil.h> #include <X11/Xatom.h> @@ -644,7 +645,7 @@ sizet x_free_xevent(ptr) /* Utility macro and functions for checking and coercing SCM arguments. */ #define GET_NEXT_INT(result, args, err, rtn) \ - ASSERT(NIMP(args) && CONSP(args) && INUMP(CAR(args)), args, err, rtn); \ + ASRTER(NIMP(args) && CONSP(args) && INUMP(CAR(args)), args, err, rtn); \ result = INUM(CAR(args)); \ args = CDR(args); @@ -787,7 +788,7 @@ Pixmap thepxmap(obj, s_caller) char *s_caller; { if (FALSEP(obj) || (INUM0==obj)) return 0L; - ASSERT(NIMP(obj) && ((OpPxmpMask & (int)CAR(obj))==OpPxmp), + ASRTER(NIMP(obj) && ((OpPxmpMask & (int)CAR(obj))==OpPxmp), obj, ARGn, s_caller); return WINDOW(obj)->p.pm; } @@ -795,7 +796,7 @@ Font thefont(obj, s_caller) SCM obj; char *s_caller; { - ASSERT(NIMP(obj) && FONTP(obj), obj, ARGn, s_caller); + ASRTER(NIMP(obj) && FONTP(obj), obj, ARGn, s_caller); return FONT(obj)->font; } Colormap thecmap(obj, s_caller) @@ -803,7 +804,7 @@ Colormap thecmap(obj, s_caller) char *s_caller; { if (FALSEP(obj) || (INUM0==obj)) return 0L; - ASSERT(NIMP(obj) && COLORMAPP(obj), obj, ARGn, s_caller); + ASRTER(NIMP(obj) && COLORMAPP(obj), obj, ARGn, s_caller); return COLORMAP(obj)->cm; } Cursor thecsr(obj, s_caller) @@ -811,7 +812,7 @@ Cursor thecsr(obj, s_caller) char *s_caller; { if (FALSEP(obj) || (INUM0==obj)) return 0L; - ASSERT(NIMP(obj) && CURSORP(obj), obj, ARGn, s_caller); + ASRTER(NIMP(obj) && CURSORP(obj), obj, ARGn, s_caller); return CURSOR(obj)->cursor; } Bool thebool(obj, s_caller) @@ -819,7 +820,7 @@ Bool thebool(obj, s_caller) char *s_caller; { SCM val = thevalue(obj); - ASSERT(BOOL_F==val || BOOL_T==val, obj, ARGn, s_caller); + ASRTER(BOOL_F==val || BOOL_T==val, obj, ARGn, s_caller); return NFALSEP(val); } int theint(obj, s_caller) @@ -827,7 +828,7 @@ int theint(obj, s_caller) char *s_caller; { SCM val = thevalue(obj); - ASSERT(INUMP(val), obj, ARGn, s_caller); + ASRTER(INUMP(val), obj, ARGn, s_caller); return INUM(val); } int theuint(obj, s_caller) @@ -835,7 +836,7 @@ int theuint(obj, s_caller) char *s_caller; { SCM val = thevalue(obj); - ASSERT(INUMP(val) && (0 <= INUM(val)), obj, ARGn, s_caller); + ASRTER(INUMP(val) && (0 <= INUM(val)), obj, ARGn, s_caller); return INUM(val); } @@ -847,7 +848,7 @@ static int args2valmask(oargs, s_caller) int attr, len, attr_mask = 0; if (!(len = ilength(args))) return 0; while (len) { - ASSERT(NIMP(args), oargs, WNA, s_caller); + ASRTER(NIMP(args), oargs, WNA, s_caller); attr = theint(CAR(args), s_caller); args = CDR(args); attr_mask |= attr; len -= 1; @@ -864,11 +865,11 @@ static int args2xgcvalues(sgc, vlu, oargs) int attr, len, attr_mask = 0; /* (void)memset((char *)vlu, 0, sizeof(XGCValues)); */ if (!(len = ilength(args))) return 0; - ASSERT(len > 0 && (! (len & 1)), oargs, WNA, s_gc); + ASRTER(len > 0 && (! (len & 1)), oargs, WNA, s_gc); while (len) { - ASSERT(NIMP(args), oargs, WNA, s_gc); + ASRTER(NIMP(args), oargs, WNA, s_gc); attr = theint(CAR(args), s_gc); args = CDR(args); - ASSERT(NIMP(args), oargs, WNA, s_gc); + ASRTER(NIMP(args), oargs, WNA, s_gc); sval = CAR(args); args = CDR(args); attr_mask |= attr; switch (attr) { @@ -917,7 +918,7 @@ static int args2xgcvalues(sgc, vlu, oargs) case GCDashList: vlu->dashes = (char)theint(sval, s_gc); break; case GCArcMode: vlu->arc_mode = theint(sval, s_gc); break; - default: ASSERT(0, MAKINUM(attr), ARGn, s_gc); + default: ASRTER(0, MAKINUM(attr), ARGn, s_gc); } len -= 2; } @@ -931,11 +932,11 @@ static int args2winattribs(vlu, oargs) int attr, len, attr_mask = 0; /* (void)memset((char *)vlu, 0, sizeof(XSetWindowAttributes)); */ if (!(len = ilength(args))) return 0; - ASSERT(len > 0 && (! (len & 1)), oargs, WNA, s_window); + ASRTER(len > 0 && (! (len & 1)), oargs, WNA, s_window); while (len) { - ASSERT(NIMP(args), oargs, WNA, s_window); + ASRTER(NIMP(args), oargs, WNA, s_window); attr = theint(CAR(args), s_window); args = CDR(args); - ASSERT(NIMP(args), oargs, WNA, s_window); + ASRTER(NIMP(args), oargs, WNA, s_window); sval = CAR(args); args = CDR(args); attr_mask |= attr; switch (attr) { @@ -958,7 +959,7 @@ static int args2winattribs(vlu, oargs) case CWColormap: vlu->colormap = thecmap(sval, s_window); break; case CWCursor: vlu->cursor = thecsr(sval, s_window); break; - default: ASSERT(0, MAKINUM(attr), ARGn, s_window); + default: ASRTER(0, MAKINUM(attr), ARGn, s_window); } len -= 2; } @@ -972,11 +973,11 @@ static int args2wincfgs(vlu, oargs) int cfgs, len, cfgs_mask = 0; /* (void)memset((char *)vlu, 0, sizeof(XWindowChanges)); */ if (!(len = ilength(args))) return 0; - ASSERT(len > 0 && (! (len & 1)), oargs, WNA, s_window); + ASRTER(len > 0 && (! (len & 1)), oargs, WNA, s_window); while (len) { - ASSERT(NIMP(args), oargs, WNA, s_window); + ASRTER(NIMP(args), oargs, WNA, s_window); cfgs = theint(CAR(args), s_window); args = CDR(args); - ASSERT(NIMP(args), oargs, WNA, s_window); + ASRTER(NIMP(args), oargs, WNA, s_window); sval = CAR(args); args = CDR(args); cfgs_mask |= cfgs; switch (cfgs) { @@ -988,7 +989,7 @@ static int args2wincfgs(vlu, oargs) case CWBorderWidth: vlu->border_width = theuint(sval, s_window); break; case CWSibling: vlu->sibling =thepxmap(sval, s_window); break; case CWStackMode: vlu->stack_mode = theint(sval, s_window); break; - default: ASSERT(0, MAKINUM(cfgs), ARGn, s_window); + default: ASRTER(0, MAKINUM(cfgs), ARGn, s_window); } len -= 2; } @@ -1002,7 +1003,7 @@ SCM x_open_display(dpy_name) { Display *display; if FALSEP(dpy_name) dpy_name = nullstr; - ASSERT(NIMP(dpy_name) && STRINGP(dpy_name), dpy_name, ARG1, s_x_open_display); + 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); } @@ -1019,7 +1020,7 @@ SCM x_display_debug(sd, si) SCM x_default_screen(sdpy) SCM sdpy; { - ASSERT(NIMP(sdpy) && OPDISPLAYP(sdpy), sdpy, ARG1, s_x_default_screen); + ASRTER(NIMP(sdpy) && OPDISPLAYP(sdpy), sdpy, ARG1, s_x_default_screen); return MAKINUM(DefaultScreen(XDISPLAY(sdpy))); } @@ -1031,7 +1032,7 @@ SCM x_create_window(swin, spos, sargs) Window window; int len = ilength(sargs); - ASSERT(NIMP(swin) && OPWINDOWP(swin), swin, ARG1, s_x_create_window); + ASRTER(NIMP(swin) && OPWINDOWP(swin), swin, ARG1, s_x_create_window); scm2XPoint(!0, spos, &position, (char *)ARG2, s_x_create_window); scm2XPoint(0, CAR(sargs), &size, (char *)ARG3, s_x_create_window); sargs = CDR(sargs); @@ -1052,11 +1053,11 @@ SCM x_create_window(swin, spos, sargs) SCM svis; unsigned long valuemask; XSetWindowAttributes attributes; - ASSERT(5 <= len, sargs, WNA, s_x_create_window); + ASRTER(5 <= len, sargs, WNA, s_x_create_window); GET_NEXT_INT(depth, sargs, ARG5, s_x_create_window); GET_NEXT_INT(class, sargs, ARGn, s_x_create_window); svis = CAR(sargs); sargs = CDR(sargs); - ASSERT(NIMP(svis) && VISUALP(svis), svis, ARGn, s_x_create_window); + ASRTER(NIMP(svis) && VISUALP(svis), svis, ARGn, s_x_create_window); valuemask = args2winattribs(&attributes, sargs); window = XCreateWindow(XWINDISPLAY(swin), XWINDOW(swin), position.x, position.y, /* initial placement */ @@ -1098,7 +1099,7 @@ SCM x_create_pixmap(obj, s_size, s_depth) } else goto badarg1; scm2XPoint(0, s_size, &size, (char *)ARG2, s_x_create_pixmap); - ASSERT(INUMP(s_depth) && depth >= 0, s_depth, ARG3, s_x_create_pixmap); + ASRTER(INUMP(s_depth) && depth >= 0, s_depth, ARG3, s_x_create_pixmap); p = XCreatePixmap(dpy, drawable, size.x, size.y, depth); return make_xwindow(display, scn, p, (char) 1, (char) 0); } @@ -1111,10 +1112,10 @@ SCM x_window_ref(oargs) XWindowAttributes vlu; int attr, len = ilength(args); /* (void)memset((char *)&vlu, 0, sizeof(XWindowAttributes)); */ - ASSERT(len > 0, oargs, WNA, s_x_window_ref); + ASRTER(len > 0, oargs, WNA, s_x_window_ref); if (1==len--) return EOL; swn = CAR(args); args = CDR(args); - ASSERT(NIMP(swn) && WINDOWP(swn), swn, ARG1, s_x_window_ref); + ASRTER(NIMP(swn) && WINDOWP(swn), swn, ARG1, s_x_window_ref); xwn = WINDOW(swn); if (!XGetWindowAttributes(xwn->dpy, xwn->p.win, &vlu)) return BOOL_F; while (len) { @@ -1133,7 +1134,7 @@ SCM x_window_ref(oargs) case CWDontPropagate:sval = MAKINUM(vlu.do_not_propagate_mask); break; case CWColormap: sval = make_xcolormap(xwn->display, vlu.colormap); break; - default: ASSERT(0, MAKINUM(attr), ARGn, s_x_window_ref); + default: ASRTER(0, MAKINUM(attr), ARGn, s_x_window_ref); } CAR(valend) = sval; CDR(valend) = cons(BOOL_T, EOL); @@ -1151,9 +1152,9 @@ SCM x_window_set(args) XSetWindowAttributes vlu; unsigned long mask; - ASSERT(NIMP(args), args, WNA, s_x_window_set); + ASRTER(NIMP(args), args, WNA, s_x_window_set); swn = CAR(args); args = CDR(args); - ASSERT(NIMP(swn) && WINDOWP(swn), swn, ARG1, s_x_window_set); + ASRTER(NIMP(swn) && WINDOWP(swn), swn, ARG1, s_x_window_set); xwn = WINDOW(swn); mask = args2winattribs(&vlu, args); XChangeWindowAttributes(xwn->dpy, xwn->p.win, mask, &vlu); @@ -1169,7 +1170,7 @@ SCM x_window_geometry(swin) int x, y; unsigned int w, h, border_width, depth; - ASSERT(NIMP(swin) && OPWINDOWP(swin), swin, ARG1, s_x_window_geometry); + ASRTER(NIMP(swin) && OPWINDOWP(swin), swin, ARG1, s_x_window_geometry); sxw = WINDOW(swin); sts = XGetGeometry(sxw->dpy, sxw->p.drbl, &root, &x, &y, &w, &h, &border_width, &depth); @@ -1186,9 +1187,9 @@ SCM x_window_geometry_set(args) XWindowChanges vlu; unsigned long mask; - ASSERT(NIMP(args), args, WNA, s_x_window_geometry_set); + ASRTER(NIMP(args), args, WNA, s_x_window_geometry_set); swn = CAR(args); args = CDR(args); - ASSERT(NIMP(swn) && WINDOWP(swn), swn, ARG1, s_x_window_geometry_set); + ASRTER(NIMP(swn) && WINDOWP(swn), swn, ARG1, s_x_window_geometry_set); xwn = WINDOW(swn); mask = args2wincfgs(&vlu, args); XConfigureWindow(xwn->dpy, xwn->p.win, mask, &vlu); @@ -1198,10 +1199,10 @@ SCM x_window_geometry_set(args) SCM x_close(obj) SCM obj; { - ASSERT(NIMP(obj), obj, ARG1, s_x_close); + ASRTER(NIMP(obj), obj, ARG1, s_x_close); if WINDOWP(obj) { Display *dpy; - ASSERT(!(CAR((SCM)obj) & SCROOT), obj, ARG1, s_x_close); + ASRTER(!(CAR((SCM)obj) & SCROOT), obj, ARG1, s_x_close); if CLOSEDP(obj) return UNSPECIFIED; DEFER_INTS; dpy = XWINDISPLAY(obj); @@ -1209,7 +1210,7 @@ SCM x_close(obj) XFlush(dpy); ALLOW_INTS; } else { - ASSERT(DISPLAYP(obj), obj, ARG1, s_x_close); + ASRTER(DISPLAYP(obj), obj, ARG1, s_x_close); DEFER_INTS; free_xdisplay((CELLPTR)obj); ALLOW_INTS; @@ -1237,12 +1238,12 @@ SCM x_create_colormap(swin, s_vis, s_alloc) SCM alloc; int allo; struct xs_Window *sxw; - ASSERT(NIMP(swin) && WINDOWP(swin), swin, ARG1, s_x_create_colormap); + ASRTER(NIMP(swin) && WINDOWP(swin), swin, ARG1, s_x_create_colormap); sxw = WINDOW(swin); - ASSERT(NIMP(s_vis) && VISUALP(s_vis), s_vis, ARG2, s_x_create_colormap); + ASRTER(NIMP(s_vis) && VISUALP(s_vis), s_vis, ARG2, s_x_create_colormap); alloc = thevalue(s_alloc); allo = INUM(alloc); - ASSERT(INUMP(alloc) && (allo==AllocNone || allo==AllocAll), + ASRTER(INUMP(alloc) && (allo==AllocNone || allo==AllocAll), s_alloc, ARG3, s_x_create_colormap); return make_xcolormap(sxw->display, XCreateColormap(sxw->dpy, sxw->p.win, @@ -1252,7 +1253,7 @@ SCM x_recreate_colormap(s_cm) SCM s_cm; { struct xs_Colormap *sxw; - ASSERT(NIMP(s_cm) && COLORMAPP(s_cm), s_cm, ARG1, s_x_recreate_colormap); + ASRTER(NIMP(s_cm) && COLORMAPP(s_cm), s_cm, ARG1, s_x_recreate_colormap); sxw = COLORMAP(s_cm); return make_xcolormap(sxw->display, XCopyColormapAndFree(XDISPLAY(sxw->display), sxw->cm)); @@ -1261,7 +1262,7 @@ SCM x_install_colormap(s_cm, s_flg) SCM s_cm, s_flg; { struct xs_Colormap *xcm; - ASSERT(NIMP(s_cm) && COLORMAPP(s_cm), s_cm, ARG1, s_x_install_colormap); + ASRTER(NIMP(s_cm) && COLORMAPP(s_cm), s_cm, ARG1, s_x_install_colormap); if UNBNDP(s_flg) s_flg = BOOL_T; xcm = COLORMAP(s_cm); if FALSEP(s_flg) XUninstallColormap(XDISPLAY(xcm->display), xcm->cm); @@ -1272,19 +1273,19 @@ SCM x_install_colormap(s_cm, s_flg) /* SCM svsl; */ /* { */ /* XColormapInfo *vsl; */ -/* ASSERT(NIMP(svsl) && COLORMAPP(svsl), svsl, ARG1, s_x_colormap_basis); */ +/* ASRTER(NIMP(svsl) && COLORMAPP(svsl), svsl, ARG1, s_x_colormap_basis); */ /* vsl = XCOLORMAPINFO(svsl); */ /* return cons2(vsl->red_mult, vsl->green_mult, */ -/* cons2(vsl->blue_mult, vsl->base_pixel, EOL)); */ +/* cons2(vsl->blue_mult, vsl->base_pixel, EOL)); */ /* } */ /* SCM x_colormap_limits(svsl) */ /* SCM svsl; */ /* { */ /* XColormapInfo *vsl; */ -/* ASSERT(NIMP(svsl) && COLORMAPP(svsl), svsl, ARG1, s_x_colormap_limits); */ +/* ASRTER(NIMP(svsl) && COLORMAPP(svsl), svsl, ARG1, s_x_colormap_limits); */ /* vsl = XCOLORMAPINFO(svsl); */ /* return cons2(vsl->red_mult, vsl->green_mult, */ -/* cons2(vsl->blue_mult, vsl->base_pixel, EOL)); */ +/* cons2(vsl->blue_mult, vsl->base_pixel, EOL)); */ /* } */ /* Colors in Colormap */ @@ -1298,11 +1299,11 @@ SCM x_alloc_color_cells(scmap, spxls, sargs) Bool contig = 0; SCM pxra, plra; unsigned int npixels, nplanes; - ASSERT(NIMP(scmap) && COLORMAPP(scmap), scmap, ARG1, s_x_alloc_color_cells); + ASRTER(NIMP(scmap) && COLORMAPP(scmap), scmap, ARG1, s_x_alloc_color_cells); xcm = COLORMAP(scmap); npixels = INUM(spxls); - ASSERT(INUMP(spxls) && npixels > 0, spxls, ARG2, s_x_alloc_color_cells); - pxra = make_uve(npixels, MOST_POSITIVE_FIXNUM); /* Uniform vector of long */ + ASRTER(INUMP(spxls) && npixels > 0, spxls, ARG2, s_x_alloc_color_cells); + pxra = make_uve(npixels, MAKINUM(32L)); /* Uniform vector of long */ switch (ilength(sargs) + 2) { default: wta(sargs, (char *)WNA, s_x_alloc_color_cells); case 3: case 4: @@ -1322,7 +1323,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); - plra = make_uve(nplanes, MOST_POSITIVE_FIXNUM); /* Uniform vector of long */ + plra = make_uve(nplanes, MAKINUM(32L)); /* Uniform vector of long */ sts = XAllocColorCells(xcm->dpy, xcm->cm, contig, VELTS(plra), nplanes, VELTS(pxra), npixels); if (!sts) return BOOL_F; @@ -1334,9 +1335,9 @@ SCM x_free_color_cells(scmap, spxls, sargs) { struct xs_Colormap *xcm; unsigned int planes = 0; - ASSERT(NIMP(scmap) && COLORMAPP(scmap), scmap, ARG1, s_x_free_color_cells); + ASRTER(NIMP(scmap) && COLORMAPP(scmap), scmap, ARG1, s_x_free_color_cells); xcm = COLORMAP(scmap); - ASSERT(NIMP(spxls) && (TYP7(spxls)==tc7_uvect), spxls, ARG2, + ASRTER(NIMP(spxls) && (TYP7(spxls)==tc7_uvect), spxls, ARG2, s_x_free_color_cells); switch (ilength(sargs) + 2) { default: wta(sargs, (char *)WNA, s_x_free_color_cells); @@ -1354,10 +1355,10 @@ SCM x_find_color(scmap, dat) XColor xclr; struct xs_Colormap *xcm; (void)memset((char *)&xclr, 0, sizeof(xclr)); - ASSERT(NIMP(scmap) && COLORMAPP(scmap), scmap, ARG1, s_x_find_color); + ASRTER(NIMP(scmap) && COLORMAPP(scmap), scmap, ARG1, s_x_find_color); xcm = COLORMAP(scmap); if (!scm2XColor(dat, &xclr)) { - ASSERT(NIMP(dat) && STRINGP(dat), dat, (char*)ARG2, s_x_find_color); + ASRTER(NIMP(dat) && STRINGP(dat), dat, (char*)ARG2, s_x_find_color); if (XAllocNamedColor(xcm->dpy, xcm->cm, CHARS(dat), &xclr, &xclr)) return MAKINUM(xclr.pixel); else return BOOL_F; @@ -1372,13 +1373,13 @@ SCM x_color_set(scmap, s_pix, dat) XColor xclr; struct xs_Colormap *xcm; (void)memset((char *)&xclr, 0, sizeof(xclr)); - ASSERT(NIMP(scmap) && COLORMAPP(scmap), scmap, ARG1, s_x_color_set); - ASSERT(INUMP(s_pix), s_pix, ARG2, s_x_color_set); + ASRTER(NIMP(scmap) && COLORMAPP(scmap), scmap, ARG1, s_x_color_set); + ASRTER(INUMP(s_pix), s_pix, ARG2, s_x_color_set); xcm = COLORMAP(scmap); xclr.pixel = INUM(s_pix); xclr.flags = DoRed | DoGreen | DoBlue; if (!scm2XColor(dat, &xclr)) { - ASSERT(NIMP(dat) && STRINGP(dat), dat, (char*)ARG3, s_x_color_set); + ASRTER(NIMP(dat) && STRINGP(dat), dat, (char*)ARG3, s_x_color_set); XStoreNamedColor(xcm->dpy, xcm->cm, CHARS(dat), xclr.pixel, xclr.flags); } else XStoreColor(xcm->dpy, xcm->cm, &xclr); @@ -1390,9 +1391,9 @@ SCM x_color_ref(scmap, sidx) XColor xclr; struct xs_Colormap *xcm; (void)memset((char *)&xclr, 0, sizeof(xclr)); - ASSERT(NIMP(scmap) && COLORMAPP(scmap), scmap, ARG1, s_x_color_ref); + ASRTER(NIMP(scmap) && COLORMAPP(scmap), scmap, ARG1, s_x_color_ref); xcm = COLORMAP(scmap); - ASSERT(INUMP(sidx), sidx, (char*)ARG2, s_x_color_ref); + ASRTER(INUMP(sidx), sidx, (char*)ARG2, s_x_color_ref); xclr.pixel = INUM(sidx); XQueryColor(xcm->dpy, xcm->cm, &xclr); if (xclr.flags==(DoRed | DoGreen | DoBlue)) @@ -1407,7 +1408,7 @@ SCM x_map_window(swin) SCM swin; { struct xs_Window *w; - ASSERT(NIMP(swin) && WINDOWP(swin), swin, ARG1, s_x_map_window); + ASRTER(NIMP(swin) && WINDOWP(swin), swin, ARG1, s_x_map_window); w = WINDOW(swin); XMapWindow(w->dpy, w->p.win); return UNSPECIFIED; @@ -1416,7 +1417,7 @@ SCM x_map_subwindows(swin) SCM swin; { struct xs_Window *w; - ASSERT(NIMP(swin) && WINDOWP(swin), swin, ARG1, s_x_map_subwindows); + ASRTER(NIMP(swin) && WINDOWP(swin), swin, ARG1, s_x_map_subwindows); w = WINDOW(swin); XMapSubwindows(w->dpy, w->p.win); return UNSPECIFIED; @@ -1425,7 +1426,7 @@ SCM x_unmap_window(swin) SCM swin; { struct xs_Window *w; - ASSERT(NIMP(swin) && WINDOWP(swin), swin, ARG1, s_x_unmap_window); + ASRTER(NIMP(swin) && WINDOWP(swin), swin, ARG1, s_x_unmap_window); w = WINDOW(swin); XUnmapWindow(w->dpy, w->p.win); return UNSPECIFIED; @@ -1434,7 +1435,7 @@ SCM x_unmap_subwindows(swin) SCM swin; { struct xs_Window *w; - ASSERT(NIMP(swin) && WINDOWP(swin), swin, ARG1, s_x_unmap_subwindows); + ASRTER(NIMP(swin) && WINDOWP(swin), swin, ARG1, s_x_unmap_subwindows); w = WINDOW(swin); XUnmapSubwindows(w->dpy, w->p.win); return UNSPECIFIED; @@ -1450,9 +1451,9 @@ SCM x_create_gc(args) unsigned long mask; SCM ans; - ASSERT(NIMP(args), args, WNA, s_x_create_gc); + ASRTER(NIMP(args), args, WNA, s_x_create_gc); swin = CAR(args); args = CDR(args); - ASSERT(NIMP(swin) && WINDOWP(swin), swin, ARG1, s_x_create_gc); + ASRTER(NIMP(swin) && WINDOWP(swin), swin, ARG1, s_x_create_gc); xsw = WINDOW(swin); ans = make_xgcontext(xsw->display, xsw->screen_number, XCreateGC(xsw->dpy, xsw->p.drbl, 0L, &v), 0); @@ -1469,9 +1470,9 @@ SCM x_gc_set(args) XGCValues v; unsigned long mask; - ASSERT(NIMP(args), args, WNA, s_x_gc_set); + ASRTER(NIMP(args), args, WNA, s_x_gc_set); sgc = CAR(args); args = CDR(args); - ASSERT(NIMP(sgc) && GCONTEXTP(sgc), sgc, ARG1, s_x_gc_set); + ASRTER(NIMP(sgc) && GCONTEXTP(sgc), sgc, ARG1, s_x_gc_set); xgc = GCONTEXT(sgc); mask = args2xgcvalues(sgc, &v, args); XChangeGC(xgc->dpy, xgc->gc, mask, &v); @@ -1485,8 +1486,8 @@ SCM x_copy_gc(dst, src, args) struct xs_GContext *dgc, *sgc; unsigned long mask; - ASSERT(NIMP(dst) && GCONTEXTP(dst), dst, ARG1, s_x_copy_gc); - ASSERT(NIMP(src) && GCONTEXTP(src), src, ARG2, s_x_copy_gc); + ASRTER(NIMP(dst) && GCONTEXTP(dst), dst, ARG1, s_x_copy_gc); + ASRTER(NIMP(src) && GCONTEXTP(src), src, ARG2, s_x_copy_gc); dgc = GCONTEXT(dst); sgc = GCONTEXT(src); mask = args2valmask(args, s_gc); @@ -1503,10 +1504,10 @@ SCM x_gc_ref(oargs) XGCValues vlu; int attr, len = ilength(args); /* (void)memset((char *)&vlu, 0, sizeof(XGCValues)); */ - ASSERT(len > 0, oargs, WNA, s_x_gc_ref); + ASRTER(len > 0, oargs, WNA, s_x_gc_ref); if (1==len--) return EOL; sgc = CAR(args); args = CDR(args); - ASSERT(NIMP(sgc) && GCONTEXTP(sgc), sgc, ARG1, s_x_gc_ref); + ASRTER(NIMP(sgc) && GCONTEXTP(sgc), sgc, ARG1, s_x_gc_ref); xgc = GCONTEXT(sgc); valuemask = args2valmask(args, s_gc); /* printf("valuemask = %lx\n", valuemask); */ @@ -1553,7 +1554,7 @@ SCM x_gc_ref(oargs) case GCDashList: sval = MAKINUM(vlu.dashes); break; case GCArcMode: sval = MAKINUM(vlu.arc_mode); break; - default: ASSERT(0, MAKINUM(attr), ARGn, s_x_gc_ref); + default: ASRTER(0, MAKINUM(attr), ARGn, s_x_gc_ref); } CAR(valend) = sval; CDR(valend) = cons(BOOL_T, EOL); @@ -1570,12 +1571,12 @@ SCM x_create_cursor(sdpy, scsr, sargs) Cursor cursor; switch (ilength(sargs)) { - default: ASSERT(0, sargs, WNA, s_x_create_cursor); + default: ASRTER(0, sargs, WNA, s_x_create_cursor); case 0: { SCM shape; - ASSERT(NIMP(sdpy) && DISPLAYP(sdpy), sdpy, ARG1, s_x_create_cursor); + ASRTER(NIMP(sdpy) && DISPLAYP(sdpy), sdpy, ARG1, s_x_create_cursor); shape = thevalue(scsr); - ASSERT(INUMP(shape) && 0 <= INUM(shape), scsr, ARG2, s_x_create_cursor); + ASRTER(INUMP(shape) && 0 <= INUM(shape), scsr, ARG2, s_x_create_cursor); cursor = XCreateFontCursor(XDISPLAY(sdpy), INUM(shape)); return make_xcursor(sdpy, cursor); } @@ -1583,14 +1584,14 @@ SCM x_create_cursor(sdpy, scsr, sargs) XColor foreground_color, background_color; XPoint origin; int sts; - ASSERT(NIMP(sdpy) && WINDOWP(sdpy), sdpy, ARG1, s_x_create_cursor); - ASSERT(FALSEP(scsr) || (NIMP(scsr) && WINDOWP(scsr)), scsr, ARG2, + ASRTER(NIMP(sdpy) && WINDOWP(sdpy), sdpy, ARG1, s_x_create_cursor); + ASRTER(FALSEP(scsr) || (NIMP(scsr) && WINDOWP(scsr)), scsr, ARG2, s_x_create_cursor); sts = scm2XColor(CAR(sargs), &foreground_color); - ASSERT(sts, CAR(sargs), ARG3, s_x_create_cursor); + ASRTER(sts, CAR(sargs), ARG3, s_x_create_cursor); sargs = CDR(sargs); sts = scm2XColor(CAR(sargs), &background_color); - ASSERT(sts, CAR(sargs), ARG4, s_x_create_cursor); + ASRTER(sts, CAR(sargs), ARG4, s_x_create_cursor); sargs = CDR(sargs); scm2XPoint(0, CAR(sargs), &origin, (char*)ARG5, s_x_create_cursor); cursor = XCreatePixmapCursor(XWINDISPLAY(sdpy), XWINDOW(sdpy), @@ -1608,7 +1609,7 @@ SCM x_create_cursor(sdpy, scsr, sargs) GET_NEXT_INT(source_char, sargs, ARG2, s_x_create_cursor); if FALSEP(CAR(sargs)) { sargs = CDR(sargs); - ASSERT(FALSEP(CAR(sargs)), sargs, ARG4, s_x_create_cursor); + ASRTER(FALSEP(CAR(sargs)), sargs, ARG4, s_x_create_cursor); sargs = CDR(sargs); } else { mask_font = thefont(CAR(sargs), s_x_create_cursor); @@ -1616,10 +1617,10 @@ SCM x_create_cursor(sdpy, scsr, sargs) GET_NEXT_INT(mask_char, sargs, ARG4, s_x_create_cursor); } sts = scm2XColor(CAR(sargs), &foreground_color); - ASSERT(sts, CAR(sargs), ARG5, s_x_create_cursor); + ASRTER(sts, CAR(sargs), ARG5, s_x_create_cursor); sargs = CDR(sargs); sts = scm2XColor(CAR(sargs), &background_color); - ASSERT(sts, CAR(sargs), ARGn, s_x_create_cursor); + ASRTER(sts, CAR(sargs), ARGn, s_x_create_cursor); cursor = XCreateGlyphCursor(XWINDISPLAY(sdpy), source_font, mask_font, source_char, mask_char, &foreground_color, &background_color); @@ -1632,8 +1633,8 @@ SCM x_load_font(sdpy, fntnam) { Font font; - ASSERT(NIMP(sdpy) && DISPLAYP(sdpy), sdpy, ARG1, s_x_load_font); - ASSERT(NIMP(fntnam) && STRINGP(fntnam), fntnam, ARG2, s_x_load_font); + ASRTER(NIMP(sdpy) && DISPLAYP(sdpy), sdpy, ARG1, s_x_load_font); + ASRTER(NIMP(fntnam) && STRINGP(fntnam), fntnam, ARG2, s_x_load_font); font = XLoadFont(XDISPLAY(sdpy), CHARS(fntnam)); return make_xfont(sdpy, font, fntnam); } @@ -1749,7 +1750,7 @@ SCM x_screen_depths(sd, si) scm2display_screen(sd, si, &dspscn, s_x_screen_depths); depths = XListDepths(dspscn.dpy, dspscn.screen_number, &count_return); if (!depths) return BOOL_F; - depra = make_uve(count_return, MOST_POSITIVE_FIXNUM); /* Uniform vector of long */ + depra = make_uve(count_return, MAKINUM(32L)); /* Uniform vector of long */ for (;count_return--;) VELTS(depra)[count_return] = depths[count_return]; XFree(depths); return depra; @@ -1835,7 +1836,7 @@ SCM x_visual_geometry(svsl) SCM svsl; { XVisualInfo *vsl; - ASSERT(NIMP(svsl) && VISUALP(svsl), svsl, ARG1, s_x_visual_geometry); + ASRTER(NIMP(svsl) && VISUALP(svsl), svsl, ARG1, s_x_visual_geometry); vsl = XVISUALINFO(svsl); return cons2(MAKINUM(vsl->red_mask), MAKINUM(vsl->green_mask), cons2(MAKINUM(vsl->blue_mask), MAKINUM(vsl->colormap_size), @@ -1845,7 +1846,7 @@ SCM x_visual_class(svsl) SCM svsl; { XVisualInfo *vsl; - ASSERT(NIMP(svsl) && VISUALP(svsl), svsl, ARG1, s_x_visual_class); + ASRTER(NIMP(svsl) && VISUALP(svsl), svsl, ARG1, s_x_visual_class); vsl = XVISUALINFO(svsl); return MAKINUM(vsl->class); } @@ -1916,8 +1917,8 @@ SCM x_ccc_screen_info(sccc, sfmt) { XcmsCCC xccc; XcmsPerScrnInfo *pPerScrnInfo; - ASSERT(NIMP(sccc) && CCCP(sccc), sccc, ARG1, s_x_ccc_screen_info); - ASSERT(NIMP(sfmt) && STRINGP(sfmt), sfmt, ARG2, s_x_ccc_screen_info); + ASRTER(NIMP(sccc) && CCCP(sccc), sccc, ARG1, s_x_ccc_screen_info); + ASRTER(NIMP(sfmt) && STRINGP(sfmt), sfmt, ARG2, s_x_ccc_screen_info); xccc = XCCC(sccc); pPerScrnInfo = (XcmsFunctionSet *)xccc->pPerScrnInfo; return ; @@ -1989,13 +1990,13 @@ SCM x_get_window_property(swin, sprop, sargs) unsigned long bytes_after_return; unsigned char *prop_return; int sarglen = ilength(sargs); - ASSERT(IMP(sprop) ? INUMP(sprop) : STRINGP(sprop), + ASRTER(IMP(sprop) ? INUMP(sprop) : STRINGP(sprop), sprop, ARG2, s_x_get_window_property); - ASSERT(sarglen >= 0 && sarglen < 2, sargs, WNA, s_x_get_window_property); + ASRTER(sarglen >= 0 && sarglen < 2, sargs, WNA, s_x_get_window_property); if (1 == sarglen) { - ASSERT(NFALSEP(booleanp(CAR(sargs))), sargs, ARG3, s_x_get_window_property); + ASRTER(NFALSEP(booleanp(CAR(sargs))), sargs, ARG3, s_x_get_window_property); } - ASSERT(NIMP(swin) && WINDOWP(swin), swin, ARG1, s_x_map_window); + ASRTER(NIMP(swin) && WINDOWP(swin), swin, ARG1, s_x_map_window); xwn = WINDOW(swin); if (INUMP(sprop)) property = INUM(sprop); @@ -2024,7 +2025,7 @@ SCM x_list_properties(swin) Atom *atoms; int num_prop_return; SCM lst; - ASSERT(NIMP(swin) && WINDOWP(swin), swin, ARG1, s_x_map_window); + ASRTER(NIMP(swin) && WINDOWP(swin), swin, ARG1, s_x_map_window); xwn = WINDOW(swin); atoms = XListProperties(xwn->dpy, xwn->p.win, &num_prop_return); { @@ -2046,8 +2047,8 @@ SCM x_clear_area(swin, spos, sargs) SCM swin, spos, sargs; { XPoint position, size; - ASSERT(2==ilength(sargs), sargs, WNA, s_x_clear_area); - ASSERT(NIMP(swin) && WINDOWP(swin), swin, ARG1, s_x_clear_area); + ASRTER(2==ilength(sargs), sargs, WNA, s_x_clear_area); + ASRTER(NIMP(swin) && WINDOWP(swin), swin, ARG1, s_x_clear_area); scm2XPoint(!0, spos, &position, (char *)ARG2, s_x_clear_area); scm2XPoint(0, CAR(sargs), &size, (char *)ARG3, s_x_clear_area); sargs = CDR(sargs); @@ -2060,9 +2061,9 @@ SCM x_fill_rectangle(swin, sgc, sargs) SCM swin, sgc, sargs; { XPoint position, size; - ASSERT(2==ilength(sargs), sargs, WNA, s_x_fill_rectangle); - ASSERT(NIMP(swin) && WINDOWP(swin), swin, ARG1, s_x_fill_rectangle); - ASSERT(NIMP(sgc) && GCONTEXTP(sgc), sgc, ARG2, s_x_fill_rectangle); + ASRTER(2==ilength(sargs), sargs, WNA, s_x_fill_rectangle); + ASRTER(NIMP(swin) && WINDOWP(swin), swin, ARG1, s_x_fill_rectangle); + ASRTER(NIMP(sgc) && GCONTEXTP(sgc), sgc, ARG2, s_x_fill_rectangle); scm2XPoint(!0, CAR(sargs), &position, (char *)ARG3, s_x_fill_rectangle); sargs = CDR(sargs); scm2XPoint(0, CAR(sargs), &size, (char *)ARG4, s_x_fill_rectangle); @@ -2077,13 +2078,13 @@ void xldraw_string(sdbl, sgc, sargs, proc, s_caller) char *s_caller; { XPoint position; - ASSERT(2==ilength(sargs), sargs, WNA, s_caller); - ASSERT(NIMP(sdbl) && WINDOWP(sdbl), sdbl, ARG1, s_caller); - ASSERT(NIMP(sgc) && GCONTEXTP(sgc), sgc, ARG2, s_caller); + ASRTER(2==ilength(sargs), sargs, WNA, s_caller); + ASRTER(NIMP(sdbl) && WINDOWP(sdbl), sdbl, ARG1, s_caller); + ASRTER(NIMP(sgc) && GCONTEXTP(sgc), sgc, ARG2, s_caller); scm2XPoint(!0, CAR(sargs), &position, (char *)ARG3, s_caller); sargs = CDR(sargs); sargs = CAR(sargs); - ASSERT(NIMP(sargs) && STRINGP(sargs), sargs, ARG4, s_caller); + ASRTER(NIMP(sargs) && STRINGP(sargs), sargs, ARG4, s_caller); proc(XWINDISPLAY(sdbl), XWINDOW(sdbl), XGCONTEXT(sgc), position.x, position.y, CHARS(sargs), LENGTH(sargs)); } @@ -2106,13 +2107,13 @@ SCM x_draw_points(sdbl, sgc, sargs) XPoint pos[1]; int len; SCM sarg; - ASSERT(NIMP(sdbl) && WINDOWP(sdbl), sdbl, ARG1, s_x_draw_points); - ASSERT(NIMP(sgc) && GCONTEXTP(sgc), sgc, ARG2, s_x_draw_points); + 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; sarg = CAR(sargs); sargs = CDR(sargs); if (INUMP(sarg)) { - ASSERT(NNULLP(sargs), sargs, WNA, s_x_draw_points); + ASRTER(NNULLP(sargs), sargs, WNA, s_x_draw_points); pos[0].x = INUM(sarg); GET_NEXT_INT(pos[0].y, sargs, ARGn, s_x_draw_points); goto drawshort; @@ -2125,7 +2126,7 @@ SCM x_draw_points(sdbl, sgc, sargs) &(pos[0]), 1, CoordModeOrigin); goto loop; } else { - ASSERT(NULLP(sargs), sargs, WNA, s_x_draw_points); + ASRTER(NULLP(sargs), sargs, WNA, s_x_draw_points); XDrawPoints(XWINDISPLAY(sdbl), XWINDOW(sdbl), XGCONTEXT(sgc), (XPoint *)scm_base_addr(sarg, s_x_draw_points), len, CoordModeOrigin); @@ -2140,13 +2141,13 @@ SCM xldraw_lines(sdbl, sgc, sargs, funcod, s_caller) XPoint pos[2]; int len; SCM sarg; - ASSERT(NIMP(sdbl) && WINDOWP(sdbl), sdbl, ARG1, s_caller); - ASSERT(NIMP(sgc) && GCONTEXTP(sgc), sgc, ARG2, 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; sarg = CAR(sargs); sargs = CDR(sargs); if (INUMP(sarg)) { - ASSERT(NNULLP(sargs), sargs, WNA, s_caller); + ASRTER(NNULLP(sargs), sargs, WNA, s_caller); pos[0].x = INUM(sarg); GET_NEXT_INT(pos[0].y, sargs, ARGn, s_caller); GET_NEXT_INT(pos[1].x, sargs, ARGn, s_caller); @@ -2214,7 +2215,7 @@ SCM x_read_bitmap_file(sdbl, sfname) unsigned int w, h; int x, y; Pixmap pxmp; - ASSERT(NIMP(sdbl) && WINDOWP(sdbl), sdbl, ARG1, s_x_read_bitmap_file); + ASRTER(NIMP(sdbl) && WINDOWP(sdbl), sdbl, ARG1, s_x_read_bitmap_file); if (XReadBitmapFile(XWINDISPLAY(sdbl), WINDOW(sdbl)->p.pm, CHARS(sfname), @@ -2238,8 +2239,8 @@ SCM x_event_ref(sevent, sfield) SCM sevent, sfield; { void *x; - ASSERT(NIMP(sevent) && XEVENTP(sevent), sevent, ARG1, s_x_event_ref); - ASSERT(INUMP(sfield), sfield, ARG2, s_x_event_ref); + ASRTER(NIMP(sevent) && XEVENTP(sevent), sevent, ARG1, s_x_event_ref); + ASRTER(INUMP(sfield), sfield, ARG2, s_x_event_ref); x = (void *) CHARS(sevent); switch (((((XEvent*)x)->type)<<8)+INUM(sfield)) { default: wta(sevent, "Incompatible field for", s_x_event_ref); @@ -425,22 +425,23 @@ (define XC:xterm 152) ;;inc2scm extracted #define values from /usr/include/X11/Xlib.h (define x:Xlib-Specification-Release 6) +(define X:HAVE-UTF8-STRING 1) (define x:True 1) (define x:False 0) (define x:Queued-Already 0) (define x:Queued-After-Reading 1) (define x:Queued-After-Flush 2) (define x:All-Planes -1) -(define x:XN-Required-Char-Set 134529975) -(define x:XN-Query-Orientation 134530014) -(define x:XN-Base-Font-Name 134530054) -(define x:XNOM-Automatic 134530087) -(define x:XN-Missing-Char-Set 134530116) -(define x:XN-Default-String 134530153) -(define x:XN-Orientation 134530187) -(define x:XN-Directional-Dependent-Drawing 134530216) -(define x:XN-Contextual-Drawing 134530307) -(define x:XN-Font-Info 134530349) +(define x:XN-Required-Char-Set 134531850) +(define x:XN-Query-Orientation 134531889) +(define x:XN-Base-Font-Name 134531929) +(define x:XNOM-Automatic 134531962) +(define x:XN-Missing-Char-Set 134531991) +(define x:XN-Default-String 134532028) +(define x:XN-Orientation 134532062) +(define x:XN-Directional-Dependent-Drawing 134532091) +(define x:XN-Contextual-Drawing 134532163) +(define x:XN-Font-Info 134532205) (define x:XIM-Preedit-Area 1) (define x:XIM-Preedit-Callbacks 2) (define x:XIM-Preedit-Position 4) @@ -450,48 +451,48 @@ (define x:XIM-Status-Callbacks 512) (define x:XIM-Status-Nothing 1024) (define x:XIM-Status-None 2048) -(define x:XN-Va-Nested-List 134530560) -(define x:XN-Query-Input-Style 134530595) -(define x:XN-Client-Window 134530634) -(define x:XN-Input-Style 134530666) -(define x:XN-Focus-Window 134530694) -(define x:XN-Resource-Name 134530724) -(define x:XN-Resource-Class 134530756) -(define x:XN-Geometry-Callback 134530790) -(define x:XN-Destroy-Callback 134530830) -(define x:XN-Filter-Events 134530868) -(define x:XN-Preedit-Start-Callback 134530900) -(define x:XN-Preedit-Done-Callback 134530949) -(define x:XN-Preedit-Draw-Callback 134530996) -(define x:XN-Preedit-Caret-Callback 134531043) -(define x:XN-Preedit-State-Notify-Callback 134531092) -(define x:XN-Preedit-Attributes 134531171) -(define x:XN-Status-Start-Callback 134531213) -(define x:XN-Status-Done-Callback 134531260) -(define x:XN-Status-Draw-Callback 134531305) -(define x:XN-Status-Attributes 134531350) -(define x:XN-Area 134531390) -(define x:XN-Area-Needed 134531405) -(define x:XN-Spot-Location 134531433) -(define x:XN-Colormap 134531465) -(define x:XN-Std-Colormap 134531488) -(define x:XN-Foreground 134531518) -(define x:XN-Background 134531545) -(define x:XN-Background-Pixmap 134531572) -(define x:XN-Font-Set 134531612) -(define x:XN-Line-Space 134531634) -(define x:XN-Cursor 134531660) -(define x:XN-Query-IM-Values-List 134531679) -(define x:XN-Query-IC-Values-List 134531723) -(define x:XN-Visible-Position 134531767) -(define x:XNR6-Preedit-Callback 134531805) -(define x:XN-String-Conversion-Callback 134531847) -(define x:XN-String-Conversion 134531904) -(define x:XN-Reset-State 134531944) -(define x:XN-Hot-Key 134531972) -(define x:XN-Hot-Key-State 134531992) -(define x:XN-Preedit-State 134532023) -(define x:XN-Separatorof-Nested-List 134532055) +(define x:XN-Va-Nested-List 134532416) +(define x:XN-Query-Input-Style 134532451) +(define x:XN-Client-Window 134532490) +(define x:XN-Input-Style 134532522) +(define x:XN-Focus-Window 134532550) +(define x:XN-Resource-Name 134532580) +(define x:XN-Resource-Class 134532612) +(define x:XN-Geometry-Callback 134532646) +(define x:XN-Destroy-Callback 134532686) +(define x:XN-Filter-Events 134532724) +(define x:XN-Preedit-Start-Callback 134532756) +(define x:XN-Preedit-Done-Callback 134532805) +(define x:XN-Preedit-Draw-Callback 134532852) +(define x:XN-Preedit-Caret-Callback 134532899) +(define x:XN-Preedit-State-Notify-Callback 134532948) +(define x:XN-Preedit-Attributes 134533027) +(define x:XN-Status-Start-Callback 134533069) +(define x:XN-Status-Done-Callback 134533116) +(define x:XN-Status-Draw-Callback 134533161) +(define x:XN-Status-Attributes 134533206) +(define x:XN-Area 134533246) +(define x:XN-Area-Needed 134533261) +(define x:XN-Spot-Location 134533289) +(define x:XN-Colormap 134533321) +(define x:XN-Std-Colormap 134533344) +(define x:XN-Foreground 134533374) +(define x:XN-Background 134533401) +(define x:XN-Background-Pixmap 134533428) +(define x:XN-Font-Set 134533468) +(define x:XN-Line-Space 134533490) +(define x:XN-Cursor 134533516) +(define x:XN-Query-IM-Values-List 134533535) +(define x:XN-Query-IC-Values-List 134533579) +(define x:XN-Visible-Position 134533623) +(define x:XNR6-Preedit-Callback 134533661) +(define x:XN-String-Conversion-Callback 134533703) +(define x:XN-String-Conversion 134533760) +(define x:XN-Reset-State 134533800) +(define x:XN-Hot-Key 134533828) +(define x:XN-Hot-Key-State 134533848) +(define x:XN-Preedit-State 134533879) +(define x:XN-Separatorof-Nested-List 134533911) (define x:X-Buffer-Overflow -1) (define x:X-Lookup-None 1) (define x:X-Lookup-Chars 2) @@ -43,21 +43,25 @@ ;;;; "xgen.scm", Convert C Event structs to xevent.h and xevent.scm. ;;; Author: Aubrey Jaffer. -(define (go-script) - (cond ;;((not *script*)) - ((>= 1 (- (length *argv*) *optind*)) +(define (xgen.scm args) + (cond ((= 1 (length args)) (xatoms) - (apply xgen.scm (list-tail *argv* *optind*))) - (else - (display "\ + (apply xgen args) + #t) + (else (xgen.usage)))) + +(define (xgen.usage) + (display "\ \ Usage: xgen.scm /usr/include/X11/Xlib.h \ Creates xevent.h and xevent.scm, from the `typedef struct's in /usr/include/X11/xlib.h. + +http://swissnet.ai.mit.edu/~jaffer/SCM " - (current-error-port)) - (exit #f)))) + (current-error-port)) + #f) (require 'common-list-functions) (require 'string-search) @@ -223,8 +227,7 @@ Usage: xgen.scm /usr/include/X11/Xlib.h (set! event-field-idx (+ 1 event-field-idx)) (+ -1 event-field-idx)))) -(define (xgen.scm . filename) - (set! filename (if (null? filename) "/usr/include/X11/Xlib.h" (car filename))) +(define (xgen filename) (let ((structs (remove-if-not (lambda (struct) (substring? "Event" (car struct))) (call-with-input-file filename extract-structs)))) @@ -314,8 +317,7 @@ Usage: xgen.scm /usr/include/X11/Xlib.h ((0 1) #f) (else (slib:error 'xcms.h 'line line))))))))) -(go-script) - ;;; Local Variables: ;;; mode:scheme ;;; End: +(exit (xgen.scm (list-tail *argv* *optind*))) ;(and *script* ) |