Changeset 13859 in project for chicken


Ignore:
Timestamp:
03/22/09 01:04:00 (11 years ago)
Author:
felix winkelmann
Message:

merged trunk rev. 13858 (not including srandom change)

Location:
chicken/branches/prerelease
Files:
5 deleted
89 edited
7 copied

Legend:

Unmodified
Added
Removed
  • chicken/branches/prerelease/Makefile.cross-linux-mingw

    r13240 r13859  
    8282TARGETS = libchicken$(A) libuchicken$(A) chicken$(EXE) csi$(EXE) \
    8383        chicken-profile$(EXE) csc$(EXE) libchicken$(SO) \
    84         libuchicken$(SO) chicken-setup$(EXE) chicken.info \
     84        libuchicken$(SO) chicken-setup$(EXE) \
    8585        libchickengui$(SO) chicken-bug$(EXE)
    8686else
     
    8888        chicken-profile$(EXE) csc$(EXE) libchicken$(SO) \
    8989        libuchicken$(SO) chicken-install$(EXE) chicken-uninstall$(EXE) \
    90         chicken-status$(EXE) chicken.info \
     90        chicken-status$(EXE) \
    9191        libchickengui$(SO) chicken-bug$(EXE)
    9292endif
  • chicken/branches/prerelease/Makefile.linux

    r13240 r13859  
    3434# options
    3535
    36 SONAME_VERSION = .$(BINARYVERSION)
    37 LIBCHICKEN_SO_LINKER_OPTIONS = -Wl,-soname,libchicken.so$(SONAME_VERSION)
    38 LIBUCHICKEN_SO_LINKER_OPTIONS = -Wl,-soname,libuchicken.so$(SONAME_VERSION)
    3936C_COMPILER_OPTIONS = -fno-strict-aliasing -DHAVE_CHICKEN_CONFIG_H
    4037ifdef DEBUGBUILD
  • chicken/branches/prerelease/Makefile.mingw

    r13414 r13859  
    8585        csc$(EXE) libchicken$(SO) \
    8686        libuchicken$(SO) libchickengui$(SO) libchickengui$(A) chicken-install$(EXE) \
    87         chicken-status$(EXE) chicken-uninstall$(EXE) chicken.info
     87        chicken-status$(EXE) chicken-uninstall$(EXE)
    8888
    8989chicken-config.h: chicken-defaults.h
  • chicken/branches/prerelease/Makefile.mingw-msys

    r13414 r13859  
    7878        csc$(EXE) libchicken$(SO) \
    7979        libuchicken$(SO) libchickengui$(SO) libchickengui$(A) chicken-install$(EXE) \
    80         chicken-uninstall$(EXE) chicken-status$(EXE) chicken.info
     80        chicken-uninstall$(EXE) chicken-status$(EXE)
    8181
    8282chicken-config.h: chicken-defaults.h
  • chicken/branches/prerelease/Makefile.msvc

    r13240 r13859  
    183183all: libchicken$(A) libuchicken$(A) chicken$(EXE) csi$(EXE) chicken-profile$(EXE) \
    184184        csc$(EXE) libchicken$(SO) \
    185         libuchicken$(SO) libchickengui$(SO) libchickengui$(A) chicken-setup$(EXE) \
    186         chicken.info
     185        libuchicken$(SO) libchickengui$(SO) libchickengui$(A) chicken-setup$(EXE)
    187186
    188187chicken-config.h: chicken-defaults.h
  • chicken/branches/prerelease/NEWS

    r13240 r13859  
    1 4.0.0x5
    2 
     14.0.0
     2
     3- removed `apropos' and `apropos-list' from the "utils" library unit;
     4  available as an extension
     5- removed texinfo and PDF documentation - this will possible be added back
     6  later
    37- replaced PCRE regex engine with Alex Shinn's "irregex" regular expression
    48  package
     
    812- added `CHICKEN_new_finalizable_gc_root()'
    913- `length' checks its argument for being cyclic
    10 
    11 4.0.0x3
    12 
    1314- removed custom declarations and "link-options" and "c-options" declarations
    1415- deprecated "-quiet" option to "chicken" program
    1516- added "-update-db" option to chicken-install
    1617- the compiler now suggests possibly required module-imports
    17 
    18 4.0.0x2
    19 
    2018- moved non-standard syntax-definitions into "chicken-syntax" library unit
    2119- the pretty-printer prints the end-of-file object readably now
     
    2523- expander handles syntax-reexports and makes unexported syntax available
    2624  for exported expanders in import libraries
    27 - added checks in some procedures in the the "tcp" library unit.
    28 
    29 4.0.0x1
    30 
     25- added checks in some procedures in the "tcp" library unit
    3126- the macro system has been completely overhauled and converted
    3227  to hygienic macros
     
    4641   set-file-position! set-user-id! set-group-id!
    4742   set-process-group-id!
     43   macro? undefine-macro!
    4844- the situation-identifiers "run-time" and "compile-time" have
    4945  been removed
     
    7672  specific repositories
    7773- extension-installation can be done directly from SVN repositories or a local
    78   file tree.
     74  file tree
    7975- enabled chicken mirror site as alternative download location
    8076
  • chicken/branches/prerelease/README

    r13249 r13859  
    44  (c) 2008-2009, The Chicken Team
    55
    6   version 4.0.0
     6  version 4.0.0x5
    77
    88
    99 1. Introduction:
    1010
    11         CHICKEN is a Scheme-to-C compiler supporting the language
    12         features as defined in the 'Revised^5 Report on
    13         Scheme'. Separate compilation is supported and full
    14         tail-recursion and efficient first-class continuations are
    15         available.
    16 
    17         Some things that CHICKEN has to offer:
    18 
    19         1. CHICKEN generates quite portable C code and compiled files
    20            generated by it (including itself) should work without any
    21            changes on DOS, Windows, most UNIX-like platforms, and with
    22            minor changes on other systems.
    23 
    24         2. The whole package is distributed under a BSD style license
    25            and as such is free to use and modify as long as you agree
    26            to its terms.
    27 
    28         3. Linkage to C modules and C library functions is
    29            straightforward. Compiled programs can easily be embedded
    30            into existing C code.
    31 
    32         4. Loads of extra libraries.
     11        CHICKEN is a Scheme-to-C compiler supporting the language
     12        features as defined in the 'Revised^5 Report on
     13        Scheme'. Separate compilation is supported and full
     14        tail-recursion and efficient first-class continuations are
     15        available.
     16
     17        Some things that CHICKEN has to offer:
     18
     19        1. CHICKEN generates quite portable C code and compiled files
     20           generated by it (including itself) should work without any
     21           changes on DOS, Windows, most UNIX-like platforms, and with
     22           minor changes on other systems.
     23
     24        2. The whole package is distributed under a BSD style license
     25           and as such is free to use and modify as long as you agree
     26           to its terms.
     27
     28        3. Linkage to C modules and C library functions is
     29           straightforward. Compiled programs can easily be embedded
     30           into existing C code.
     31
     32        4. Loads of extra libraries.
    3333
    3434        Note: Should you have any trouble in setting up and using
     
    4040 2. Installation:
    4141
    42         First unzip the package ("unzip chicken-<version>.zip" or "tar
     42        First unzip the package ("unzip chicken-<version>.zip" or "tar
    4343        xzf chicken-<version>.tar.gz" on UNIX or use your favorite
    4444        extraction program on Windows).
    4545
    46         Building CHICKEN requires GNU Make. Other "make" derivates are
    47         not supported. If you are using a Windows system and do not
    48         have GNU Make, see below for a link to a precompiled set of
    49         UNIX utilities, which among other useful tools contains "make".
    50 
    51         Configuration and customization of the build process is done by
    52         either setting makefile variables on the "make" command line or
    53         by editing the platform-specific makefile.
    54 
    55         Invoke "make" like this:
    56 
    57           make PLATFORM=<platform> PREFIX=<destination>
    58 
    59         where "PLATFORM" specifies on what kind of system CHICKEN
    60         shall be built and "PREFIX" specifies where the executables
    61         and libraries shall be installed. Out-of-directory builds are
    62         currently not supported, so you must be in the toplevel source
    63         directory to invoke "make".
    64 
    65         Enter "make" without any options to see a list of supported
    66         platforms.
    67 
    68         If you build CHICKEN directly from the development sources out
    69         of the subversion repository, you will need a "chicken"
    70         executable to generate the compiled C files from the Scheme
    71         library sources. If you have a recent version of CHICKEN
    72         installed, then pass "CHICKEN=<chicken-executable>" to the
    73         "make" invocation to override this setting. "CHICKEN" defaults
    74         to "$PREFIX/bin/chicken".
    75 
    76         If you do not have a "chicken" binary installed, enter
    77 
    78           make PLATFORM=<platform> PREFIX=<destination> bootstrap
    79 
    80         which will unpack a tarball containing precompiled C sources
    81         that are recent enough to generate the current version. After
    82         building a statically linked compiler executable (named
    83         "chicken-boot") all *.scm files are marked for rebuilt. By
    84         passing "CHICKEN=./chicken-boot" to "make", you can force
    85         using this bootstrapped compiler to build the system.
    86 
    87         The build may show errors when creating the info(1)
    88         documentation, if you do not have GNU texinfo installed.
    89         This is not fatal - the build should proceed.
    90 
    91         If CHICKEN is build successfully, you can install it on your
    92         system by entering
    93 
    94           make PLATFORM=<platform> PREFIX=<destination> install
    95 
    96         "PREFIX" defaults to "/usr/local". Note that the PREFIX is
    97         compiled into several CHICKEN tools and must be the same
    98         while building the system and during installation.
    99 
    100         To install CHICKEN for a particular PREFIX on a different
    101         location, set the "DESTDIR" variable in addition to "PREFIX":
    102         It designates the directory where the files are installed
    103         into.
    104 
    105         You can further enable various optional features by adding
    106         one or more of the following variables to the "make"
    107         invocation:
    108 
    109         DEBUGBUILD=1
    110           Disable optimizations in compiled C code and enable
    111           debug information.
    112 
    113         STATICBUILD=1
    114           Build only static versions of the runtime library, compiler
    115           and interpreter. `chicken-setup' will not be generated,
    116           as it is mostly useless unless compiled code can be loaded.
    117 
    118         SYMBOLGC=1
    119           Always enable garbage collection for unused symbols in the
    120           symbol table by default. This will result in slightly slower
    121           garbage collection, but minimizes the amount of garbage
    122           retained at runtime (which might be important for long
    123           running server applications). If you don't specify this
    124           option you can still enable symbol GC at runtime by passing
    125           the `-:w' runtime option when running the program.
    126 
    127         NOAPPLYHOOK=1
    128           For maximum performance this will disable support for
    129           breakpoints, but speed up procedure invocation in safe
    130           code. Smaller binaries can be obtained by also giving
    131           "NOPTABLES=1", but that means serialization (available
    132           as a separate package) of procedures will not be available.
    133 
    134         C_COMPILER_OPTIMIZATION_OPTIONS=...
    135           Override built-in C compiler optimization options. Available
     46        Building CHICKEN requires GNU Make. Other "make" derivates are
     47        not supported. If you are using a Windows system and do not
     48        have GNU Make, see below for a link to a precompiled set of
     49        UNIX utilities, which among other useful tools contains "make".
     50
     51        Configuration and customization of the build process is done by
     52        either setting makefile variables on the "make" command line or
     53        by editing the platform-specific makefile.
     54
     55        Invoke "make" like this:
     56
     57          make PLATFORM=<platform> PREFIX=<destination>
     58
     59        where "PLATFORM" specifies on what kind of system CHICKEN
     60        shall be built and "PREFIX" specifies where the executables
     61        and libraries shall be installed. Out-of-directory builds are
     62        currently not supported, so you must be in the toplevel source
     63        directory to invoke "make".
     64
     65        Enter "make" without any options to see a list of supported
     66        platforms.
     67
     68        If you build CHICKEN directly from the development sources out
     69        of the subversion repository, you will need a "chicken"
     70        executable to generate the compiled C files from the Scheme
     71        library sources. If you have a recent version of CHICKEN
     72        installed, then pass "CHICKEN=<chicken-executable>" to the
     73        "make" invocation to override this setting. "CHICKEN" defaults
     74        to "$PREFIX/bin/chicken".
     75
     76        If you do not have a "chicken" binary installed, enter
     77
     78          make PLATFORM=<platform> PREFIX=<destination> bootstrap
     79
     80        which will unpack a tarball containing precompiled C sources
     81        that are recent enough to generate the current version. After
     82        building a statically linked compiler executable (named
     83        "chicken-boot") all *.scm files are marked for rebuilt. By
     84        passing "CHICKEN=./chicken-boot" to "make", you can force
     85        using this bootstrapped compiler to build the system.
     86
     87        If CHICKEN is build successfully, you can install it on your
     88        system by entering
     89
     90          make PLATFORM=<platform> PREFIX=<destination> install
     91
     92        "PREFIX" defaults to "/usr/local". Note that the PREFIX is
     93        compiled into several CHICKEN tools and must be the same
     94        while building the system and during installation.
     95
     96        To install CHICKEN for a particular PREFIX on a different
     97        location, set the "DESTDIR" variable in addition to "PREFIX":
     98        It designates the directory where the files are installed
     99        into.
     100
     101        You can further enable various optional features by adding
     102        one or more of the following variables to the "make"
     103        invocation:
     104
     105        DEBUGBUILD=1
     106          Disable optimizations in compiled C code and enable
     107          debug information.
     108
     109        STATICBUILD=1
     110          Build only static versions of the runtime library, compiler
     111          and interpreter. `chicken-install', `chicken-uninstall' and
     112          `chicken-status' will not be generated, as it is mostly
     113          useless unless compiled code can be loaded.
     114
     115        SYMBOLGC=1
     116          Always enable garbage collection for unused symbols in the
     117          symbol table by default. This will result in slightly slower
     118          garbage collection, but minimizes the amount of garbage
     119          retained at runtime (which might be important for long
     120          running server applications). If you don't specify this
     121          option you can still enable symbol GC at runtime by passing
     122          the `-:w' runtime option when running the program.
     123
     124        NOAPPLYHOOK=1
     125          For maximum performance this will disable support for
     126          breakpoints, but speed up procedure invocation in safe
     127          code. Smaller binaries can be obtained by also giving
     128          "NOPTABLES=1", but that means serialization (available
     129          as a separate package) of procedures will not be available.
     130
     131        C_COMPILER_OPTIMIZATION_OPTIONS=...
     132          Override built-in C compiler optimization options. Available
    136133          for debug or release build.
    137134
    138         PROGRAM_PREFIX=
     135        PROGRAM_PREFIX=
    139136          A prefix to prepend to the names of all generated executables.
    140           This allows having multiple CHICKEN versions in your PATH
    141           (but note that they have to be installed at different locations).
    142 
    143         PROGRAM_SUFFIX=
     137          This allows having multiple CHICKEN versions in your PATH
     138          (but note that they have to be installed at different locations).
     139
     140        PROGRAM_SUFFIX=
    144141          A suffix to be appended to the names of all generated executables.
    145142
    146         HOSTSYSTEM=
    147           A "<machine>-<platform>" name prefix to use for the C compiler to to
    148           use to compile the runtime system and executables. Set this variable
    149           if you want to compile CHICKEN for a different architecture than
    150           the one on which you are building it.
    151 
    152         TARGETSYSTEM=
    153           Similar to "HOSTSYSTEM", but specifies the name
    154           prefix to use for compiling code with the "csc" compiler
    155           driver. This is required for creating a "cross chicken", a
    156           specially built CHICKEN that invokes a cross C compiler to
    157           build the final binaries. You will need a cross compiled
    158           runtime system by building a version of CHICKEN with the
    159           "HOST" option mentioned above. More information about this
    160           process and the variables that you should set are provided
    161           in the CHICKEN wiki at
    162           <http://chicken.wiki.br/cross-compilation>.
     143        HOSTSYSTEM=
     144          A "<machine>-<platform>" name prefix to use for the C compiler to to
     145          use to compile the runtime system and executables. Set this variable
     146          if you want to compile CHICKEN for a different architecture than
     147          the one on which you are building it.
     148
     149        TARGETSYSTEM=
     150          Similar to "HOSTSYSTEM", but specifies the name
     151          prefix to use for compiling code with the "csc" compiler
     152          driver. This is required for creating a "cross chicken", a
     153          specially built CHICKEN that invokes a cross C compiler to
     154          build the final binaries. You will need a cross compiled
     155          runtime system by building a version of CHICKEN with the
     156          "HOST" option mentioned above. More information about this
     157          process and the variables that you should set are provided
     158          in the CHICKEN wiki at
     159          <http://chicken.wiki.br/cross-compilation>.
    163160
    164161        SRCDIR=
     
    169166
    170167
    171         To remove CHICKEN from your file-system, enter (probably as
     168        To remove CHICKEN from your file-system, enter (probably as
    172169        root):
    173170
    174             make PLATFORM=<platform> PREFIX=<destination> uninstall
    175 
    176         (If you gave DESTDIR during installation, you have to pass
    177         the same setting to "make" when uninstalling)
    178 
    179         In case you invoke "make" with different configuration parameters,
    180         it is advisable to run
    181 
    182             make PLATFORM=<platform> confclean
    183 
    184         to remove old configuration files.
     171            make PLATFORM=<platform> PREFIX=<destination> uninstall
     172
     173        (If you gave DESTDIR during installation, you have to pass
     174        the same setting to "make" when uninstalling)
     175
     176        In case you invoke "make" with different configuration parameters,
     177        it is advisable to run
     178
     179            make PLATFORM=<platform> confclean
     180
     181        to remove old configuration files.
    185182
    186183
    187184 3. Usage:
    188185
    189         Documentation can be found in the directory
    190         PREFIX/share/chicken/doc. The HTML documentation (in
    191         "PREFIX/share/chicken/doc/html") is automatically generated
    192         from the Wiki pages at <http://chicken.wiki.br/>. Go there to
    193         read the most up to date documentation.
    194 
    195 
    196  4. Extension:
     186        Documentation can be found in the directory
     187        PREFIX/share/chicken/doc. The HTML documentation (in
     188        "PREFIX/share/chicken/doc/html") is automatically generated
     189        from the Wiki pages at <http://chicken.wiki.br/>. Go there to
     190        read the most up to date documentation.
     191
     192
     193 4. Extensions:
    197194
    198195        A large number of extension libraries for CHICKEN are
    199         available at
    200         <http://www.call-with-current-continuation.org/eggs/>. You can
    201         automatically download, compile and install extensions with
    202         the "chicken-setup" program. See the CHICKEN User's Manual for
    203         more information.
    204 
    205         Windows users: Note that you must have "tar" and "gunzip"
    206         programs installed and available through the "PATH"
    207         environment variable to extract extensions. If you don't
    208         download and extract the extensions ("eggs") manually using a
    209         browser and the decompression program of your choice and run
    210         "chicken-setup" in the directory where you extracted the
    211         extension archive.
    212 
    213         Windows binaries for common UNIX utilities (most notably "tar"
    214         and "gunzip") are available here:
    215         <http://www.call-with-current-continuation.org/tarballs/UnxUtils.zip>.
    216 
    217         A selection of 3rd party libraries, together with source and
    218         binary packages for tools helpful for development with CHICKEN
    219         are also available at:
    220         <http://www.call-with-current-continuation.org/tarballs/>.
    221 
    222        
     196        available at
     197        <http://www.call-with-current-continuation.org/eggs/>. You can
     198        automatically download, compile and install extensions with
     199        the "chicken-install" program. See the CHICKEN User's Manual for
     200        more information.
     201
     202        A selection of 3rd party libraries, together with source and
     203        binary packages for tools helpful for development with CHICKEN
     204        are also available at:
     205        <http://www.call-with-current-continuation.org/tarballs/>.
     206
     207       
    223208 5. Platform issues:
    224209
    225         - *BSD system users *must* use GNU make ("gmake") - the makefiles
    226           can not be processed by BSD make.
    227 
    228         - Some old Linux distributions ship with a buggy version of
    229           the GNU C compiler (2.96). If the system is configured for
    230           kernel recompilation, then an alternative GCC version is
    231           available under the name `kgcc' (GCC 2.96 can not recompile
    232           the kernel). CHICKEN's configuration script should normally
    233           be able to handle this problem, but you have to remember to
    234           compile your translated Scheme files with `kgcc' instead of
    235           `gcc'.
    236 
    237         - Older versions of Solaris have a bug in ld.so that causes
    238           trouble with dynamic loading. Patching Solaris fixes the
    239           problem. Solaris 7 needs patch 106950-18. Solaris 8 has an
    240           equivalent patch, 109147-16.
    241 
    242           You can find out if you have these patches installed by
    243           running:
    244 
    245           % showrev -p | grep 106950    # solaris 7
    246           % showrev -p | grep 109147    # solaris 8
    247 
    248         - On NetBSD it might be possible that compilation fails with a
    249           "virtual memory exhausted error".  Try the following:
    250 
    251           % unlimit datasize
    252 
    253         - For Mac OS X, Chicken requires libdl, for loading compiled
    254           code dynamically. This library is available on Mac OS X 10.4
    255           (Tiger) by default. For older versions you can find it here:
    256 
    257             http://www.opendarwin.org/projects/dlcompat
    258 
    259         - On Mac OS X, Chicken and its eggs can be built as universal
    260           binaries which will work on either Intel or PowerPC.
    261           To build on Tiger (10.4):
    262 
    263             make PLATFORM=macosx ARCH=universal
    264 
    265           On Leopard (10.5), an extra step is required before `make':
    266 
    267             export MACOSX_DEPLOYMENT_TARGET=10.4
    268             make PLATFORM=macosx ARCH=universal
    269 
    270         - On Mac OS X, Chicken can be built in 64-bit mode on Intel
    271           Core 2 Duo systems--basically, most recent machines.  The default
    272           is 32-bit mode.  To enable 64-bit mode, invoke `make' thusly:
    273 
    274             make PLATFORM=macosx ARCH=x86-64
    275 
    276         - On Windows, mingw32, <http://mingw.sourceforge.net/>,
    277           Cygwin, and Visual C/C++ (PLATFORM=msvc) are supported.
    278           Makefiles for mingw under MSYS and Windows shell are provided
    279           (`Makefile.mingw-msys' and `Makefile.mingw').
     210        - *BSD system users *must* use GNU make ("gmake") - the makefiles
     211          can not be processed by BSD make.
     212
     213        - Some old Linux distributions ship with a buggy version of
     214          the GNU C compiler (2.96). If the system is configured for
     215          kernel recompilation, then an alternative GCC version is
     216          available under the name `kgcc' (GCC 2.96 can not recompile
     217          the kernel). CHICKEN's configuration script should normally
     218          be able to handle this problem, but you have to remember to
     219          compile your translated Scheme files with `kgcc' instead of
     220          `gcc'.
     221
     222        - Older versions of Solaris have a bug in ld.so that causes
     223          trouble with dynamic loading. Patching Solaris fixes the
     224          problem. Solaris 7 needs patch 106950-18. Solaris 8 has an
     225          equivalent patch, 109147-16.
     226
     227          You can find out if you have these patches installed by
     228          running:
     229
     230          % showrev -p | grep 106950    # solaris 7
     231          % showrev -p | grep 109147    # solaris 8
     232
     233        - On NetBSD it might be possible that compilation fails with a
     234          "virtual memory exhausted error".  Try the following:
     235
     236          % unlimit datasize
     237
     238        - For Mac OS X, Chicken requires libdl, for loading compiled
     239          code dynamically. This library is available on Mac OS X 10.4
     240          (Tiger) by default. For older versions you can find it here:
     241
     242            http://www.opendarwin.org/projects/dlcompat
     243
     244        - On Mac OS X, Chicken and its eggs can be built as universal
     245          binaries which will work on either Intel or PowerPC.
     246          To build on Tiger (10.4):
     247
     248            make PLATFORM=macosx ARCH=universal
     249
     250          On Leopard (10.5), an extra step is required before `make':
     251
     252            export MACOSX_DEPLOYMENT_TARGET=10.4
     253            make PLATFORM=macosx ARCH=universal
     254
     255        - On Mac OS X, Chicken can be built in 64-bit mode on Intel
     256          Core 2 Duo systems--basically, most recent machines.  The default
     257          is 32-bit mode.  To enable 64-bit mode, invoke `make' thusly:
     258
     259            make PLATFORM=macosx ARCH=x86-64
     260
     261        - On Windows, mingw32, <http://mingw.sourceforge.net/>,
     262          Cygwin, and Visual C/C++ (PLATFORM=msvc) are supported.
     263          Makefiles for mingw under MSYS and Windows shell are provided
     264          (`Makefile.mingw-msys' and `Makefile.mingw').
    280265
    281266        - When installing under the mingw-msys platform, PREFIX must be an
    282267          absolute path name (i.e. it must include the drive letter).
    283268
    284         - When installing under mingw, with a windows shell ("cmd.exe"),
    285           pass an absolute pathname as PREFIX and use forward slashes.
    286 
    287         - Cygwin will not be able to find the chicken shared libraries
     269        - When installing under mingw, with a windows shell ("cmd.exe"),
     270          pass an absolute pathname as PREFIX and use forward slashes.
     271
     272        - Cygwin will not be able to find the chicken shared libraries
    288273          until Windows is rebooted.
    289274
    290         - gcc 3.4 shows sometimes warnings of the form
    291 
    292             easyffi.c: In function `f_11735':
    293             easyffi.c:18697: warning: `noreturn' function does return
    294        
    295           when compiling the system or compiled Scheme files. These
    296           warnings are bogus and can be ignored.
    297 
    298         - The Visual C build requires GNU make and other POSIX
    299           utilities.  Both cygwin and msys (with the Developer's
    300           Toolkit) have the necessary utilities. When setting PREFIX,
    301           use forward slashes:
    302 
    303           make PLATFORM=msvc PREFIX=c:/development/chicken
    304 
    305           The build has been tested with Visual Studio 2003 and 2008.  If
    306           you are able to build Chicken with other versions, please let
    307           us know.
    308 
    309           The following additional issues apply when using Chicken with
    310           Visual C:
    311 
    312           - Add the /DPIC flag when compiling your source files.  Otherwise
    313             you will encounter undefined symbols when linking.  Note that csc
    314             does this automatically for dlls but NOT for programs.
    315 
    316           - csc generates dynamics libraries with a .so extension, not .dll.
     275        - gcc 3.4 shows sometimes warnings of the form
     276
     277            easyffi.c: In function `f_11735':
     278            easyffi.c:18697: warning: `noreturn' function does return
     279       
     280          when compiling the system or compiled Scheme files. These
     281          warnings are bogus and can be ignored.
     282
     283        - The Visual C build requires GNU make and other POSIX
     284          utilities.  Both cygwin and msys (with the Developer's
     285          Toolkit) have the necessary utilities. When setting PREFIX,
     286          use forward slashes:
     287
     288          make PLATFORM=msvc PREFIX=c:/development/chicken
     289
     290          The build has been tested with Visual Studio 2003 and 2008.  If
     291          you are able to build Chicken with other versions, please let
     292          us know.
     293
     294          The following additional issues apply when using Chicken with
     295          Visual C:
     296
     297          - Add the /DPIC flag when compiling your source files.  Otherwise
     298            you will encounter undefined symbols when linking.  Note that csc
     299            does this automatically for dlls but NOT for programs.
     300
     301          - csc generates dynamics libraries with a .so extension, not .dll.
    317302
    318303 6. Emacs support:
    319304
    320         An emacs mode is provided in the file `hen.el'. To use it,
    321         copy it somewhere into a location you normally use for emacs
    322         extensions. If you want to add a specific location permanently
    323         to the list of paths emacs should search for extensions, add
    324         the following line to your `.emacs' file:
    325 
    326           (setq load-path
    327             (cons
    328               "<directory-where-your-emacs-lisp-files-live>"
    329               load-path))
    330 
    331         Add
    332 
    333           (require 'hen)
    334        
    335         To make "hen-mode" available, and enter it by issuing the
    336         command M-x hen-mode.
    337 
    338         A copy of Alex Shinn's highly useful tab-completion code is
    339         also included in `scheme-complete.el'. Install it like `hen.el'
    340         and add this code to your `.emacs':
    341 
    342           (autoload 'scheme-smart-complete "scheme-complete" nil t)
    343           (eval-after-load 'scheme
    344             '(progn (define-key scheme-mode-map "\e\t" 'scheme-smart-complete)))
    345 
    346         Or:
    347 
    348           (eval-after-load 'scheme
    349             '(progn (define-key scheme-mode-map "\t" 'scheme-complete-or-indent)))
    350 
    351         If you use eldoc-mode (included in Emacs), you can also get live
    352         scheme documentation with:
    353 
    354         (add-hook 'scheme-mode-hook
    355           (lambda ()
    356               (setq eldoc-info-function 'scheme-get-current-symbol-info)
    357                   (eldoc-mode)))
    358 
    359         Replace "'scheme" in the elisp expressions above with "'hen", if
    360         you want to add tab-completion to CHICKEN's own emacs mode.
    361 
    362 
    363  7. What's next?
    364 
    365         If you find any bugs, or want to report a problem, please consider
    366         using the "chicken-bug" tool to create a detailed bug report.
    367 
    368         If you have any more questions or problems (even the slightest
     305        An emacs mode is provided in the file `hen.el'. To use it,
     306        copy it somewhere into a location you normally use for emacs
     307        extensions. If you want to add a specific location permanently
     308        to the list of paths emacs should search for extensions, add
     309        the following line to your `.emacs' file:
     310
     311          (setq load-path
     312            (cons
     313              "<directory-where-your-emacs-lisp-files-live>"
     314              load-path))
     315
     316        Add
     317
     318          (require 'hen)
     319       
     320        To make "hen-mode" available, and enter it by issuing the
     321        command M-x hen-mode.
     322
     323        A copy of Alex Shinn's highly useful tab-completion code is
     324        also included in `scheme-complete.el'. Install it like `hen.el'
     325        and add this code to your `.emacs':
     326
     327          (autoload 'scheme-smart-complete "scheme-complete" nil t)
     328          (eval-after-load 'scheme
     329            '(progn (define-key scheme-mode-map "\e\t" 'scheme-smart-complete)))
     330
     331        Or:
     332
     333          (eval-after-load 'scheme
     334            '(progn (define-key scheme-mode-map "\t" 'scheme-complete-or-indent)))
     335
     336        If you use eldoc-mode (included in Emacs), you can also get live
     337        scheme documentation with:
     338
     339        (add-hook 'scheme-mode-hook
     340          (lambda ()
     341              (setq eldoc-info-function 'scheme-get-current-symbol-info)
     342                  (eldoc-mode)))
     343
     344        Replace "'scheme" in the elisp expressions above with "'hen", if
     345        you want to add tab-completion to CHICKEN's own emacs mode.
     346
     347
     348 7. Compatibility notes
     349
     350        CHICKEN 4 uses a completely reimplemented hygienic macro and
     351        module system, which has considerably more felixbility and power,
     352        but will require rewriting macros in code that previously was
     353        used with CHICKEN 3. Notably, `define-macro' is not available
     354        anymore. See the manual on how to translate such macros to
     355        low-level hygienic macros or ask on the CHICKEN mailing list.
     356
     357
     358 8. What's next?
     359
     360        If you find any bugs, or want to report a problem, please consider
     361        using the "chicken-bug" tool to create a detailed bug report.
     362
     363        If you have any more questions or problems (even the slightest
    369364        problems, or the most stupid questions), then please subscribe
    370         to the "chicken-users" mailing list and ask for help. It will
    371         be answered.
    372 
    373 
    374         Have fun!
     365        to the "chicken-users" mailing list and ask for help. It will
     366        be answered.
     367
     368
     369        Have fun!
  • chicken/branches/prerelease/TODO

    r13414 r13859  
    2323    possibly due to unrenamed special forms
    2424*** extended lambda-lists refer to `optional' and `let-optionals[*]'
    25     this will break, when these macros are renamed on import
     25    this will break, when these macros are renamed on import or not imported
     26    at all
     27**** a possible solution is to use internal forms, provided by the "scheme" module.
    2628
    2729** modules
     
    3436*** mark import-source (module) on plist of imported symbols and use in re-import warning
    3537    doesn't work that easily, try to find another solution
     38*** DSSSL lambda-lists need imports of `chicken' module ("optional", "let-optionals", ...)
     39**** should probably use internal aliases
    3640
    3741** libraries
     
    4145    reported by Jim Ursetto
    4246    reverted original patch, see patches/finalizer-closures.diff
    43 *** Use record-descriptors instead of symbols as 1st slot in structure objects?
    4447
    4548
    4649* tasks
    47 
    48 ** Convert this file to org mode
    4950
    5051** branches
     
    6465*** import-for-syntax imports value bindings into import-env
    6566    should actually be a distinct meta-import-env.
    66     (does it work at all?)
    6767    example: we need `(import-for-syntax chicken)' to have access to
    6868    `receive' in a procedural syntax definition.
    69 **** could be tested with xlib egg
    7069*** curried define performs expansion in empty se - problem?
    7170    (as comment in expand.scm indicated (##sys#register-export))
    7271*** check phase separation and module access
    7372**** see "expander" above
    74 **** interaction for define-for-syntax, begin-for-syntax, and macros
    75 ***** check for different execution modes (compile-time, run-time, csi, ...)
    76 ***** figure out visibility
    7773
    7874** compiler
     
    8480**** use "HTTP_PROXY"/"http_proxy" env. var
    8581**** handle redirects in http-fetch
     82**** option in chicken-install to list available eggs
    8683*** automatically update db after extension installation?
    8784*** test sudo
     
    9188*** ports should have indicator slot about exact type (tcp, file, ...)
    9289*** normalize-pathname: return short name on windows? (mingw/msvc)
     90*** Use record-descriptors instead of symbols as 1st slot in structure objects?
     91**** see Kon's proposal for new record-descriptors in "misc/Chicken Runtime Data Type Proposal"
    9392
    9493** syntax-error
     
    104103    .SECONDARY help?
    105104*** using "touch" with WINDOWS_SHELL won't work (need alternative)
     105*** script for guessing PLATFORM
    106106
    107107** documentation
    108108*** document qs, normalize-pathname
     109*** compatibility notes for `define-macro' in FAQ, manual
    109110
    110111
     
    115116*** fully compiled ec-tests
    116117** 3-stage bootstrap with compiler-output comparison
     118** distribution-test script
    117119
    118120
     
    138140   looping lambda + dispatch (static variable can be used), otherwise similar to
    139141   a conditional
    140 *** new forms (after optimization, prepared language)
    141     [##core#dispatch LAMBDABODY1 ... BODY]
    142     [##core#goto {INDEX} ARGUMENT1 ...}
    143142
    144143** lazy gensyms (see "lazy-gensyms" branch)
  • chicken/branches/prerelease/batch-driver.scm

    r13240 r13859  
    280280              [(string=? "suffix" val) (keyword-style #:suffix)]
    281281              [else (quit "invalid argument to `-keyword-style' option")] ) ) )
     282    (when (memq 'no-parenthesis-synonyms options)
     283      (dribble "Disabled support for parenthesis synonyms")
     284      (parenthesis-synonyms #f) )
     285    (when (memq 'no-symbol-escape options)
     286      (dribble "Disabled support for escaped symbols")
     287      (symbol-escape #f) )
     288    (when (memq '("-r5rs-syntax") options)
     289      (dribble "Disabled the Chicken extensions to R5RS syntax")
     290      (case-sensitive #f)
     291      (keyword-style #:none)
     292      (parentheses-synonyms #f)
     293      (symbol-escape #f) )
    282294    (set! verbose-mode verbose)
    283295    (set! ##sys#read-error-with-line-number #t)
  • chicken/branches/prerelease/c-platform.scm

    r13240 r13859  
    123123    disable-stack-overflow-checks disable-c-syntax-checks unsafe-libraries raw
    124124    emit-external-prototypes-first release local inline-global
    125     analyze-only dynamic) )
     125    analyze-only dynamic
     126    no-parentheses-synonyms no-symbol-escape r5rs-syntax) )
    126127
    127128(define valid-compiler-options-with-argument
    128129  '(debug output-file include-path heap-size stack-size unit uses keyword-style require-extension
    129           inline-limit profile-name disable-warning
     130          inline-limit profile-name disable-warning parenthesis-synonyms
    130131    prelude postlude prologue epilogue nursery extend feature
    131132    emit-import-library emit-inline-file static-extension
  • chicken/branches/prerelease/chicken-install.scm

    r13240 r13859  
    88;
    99;   Redistributions of source code must retain the above copyright notice, this list of conditions and the following
    10 ;     disclaimer. 
     10;     disclaimer.
    1111;   Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following
    12 ;     disclaimer in the documentation and/or other materials provided with the distribution. 
     12;     disclaimer in the documentation and/or other materials provided with the distribution.
    1313;   Neither the name of the author nor the names of its contributors may be used to endorse or promote
    14 ;     products derived from this software without specific prior written permission. 
     14;     products derived from this software without specific prior written permission.
    1515;
    1616; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS
     
    2727(require-library setup-download setup-api)
    2828(require-library srfi-1 posix data-structures utils regex ports extras
    29                 srfi-13 files)
     29                srfi-13 files)
    3030
    3131
    3232(module main ()
    33  
     33
    3434  (import scheme chicken srfi-1 posix data-structures utils regex ports extras
    35           srfi-13 files)
     35          srfi-13 files)
    3636  (import setup-download setup-api)
    37  
     37
    3838  (import foreign)
    3939
     
    6666  (define *program-path*
    6767    (or (and-let* ((p (getenv "CHICKEN_PREFIX")))
    68           (make-pathname p "bin") )
    69         (foreign-value "C_INSTALL_BIN_HOME" c-string) ) )
     68          (make-pathname p "bin") )
     69        (foreign-value "C_INSTALL_BIN_HOME" c-string) ) )
    7070
    7171  (define *keep* #f)
     
    8787
    8888  (define (load-defaults)
    89     (let ((deff (make-pathname (chicken-home) +defaults-file+)))
    90       (cond ((not (file-exists? deff)) '())
    91             (else
    92              (set! *default-sources* (read-file deff))
    93              (pair? *default-sources*)))))
     89    (let ([deff (make-pathname (chicken-home) +defaults-file+)])
     90      (cond [(not (file-exists? deff))
     91             '() ]
     92            [else
     93             (set! *default-sources* (read-file deff))
     94             (pair? *default-sources*) ] ) ) )
     95
     96  (define (known-default-sources)
     97    (if (and *default-location* *default-transport*)
     98        `(((location ,*default-location*)
     99           (transport ,*default-transport*)))
     100        *default-sources* ) )
     101
     102  (define (invalidate-default-source! def)
     103    (set! *default-sources* (delete def *default-sources* eq?)) )
    94104
    95105  (define (deps key meta)
    96106    (or (and-let* ((d (assq key meta)))
    97           (cdr d))
    98         '()))
     107          (cdr d))
     108        '()))
    99109
    100110  (define (init-repository dir)
    101111    (let ((src (repository-path))
    102           (copy (if *windows-shell*
    103                     "copy"
    104                     "cp -r")))
     112          (copy (if *windows-shell*
     113                    "copy"
     114                    "cp -r")))
    105115      (print "copying required files to " dir " ...")
    106116      (for-each
    107117       (lambda (f)
    108         ($system (sprintf "~a ~a ~a" copy (shellpath (make-pathname src f)) (shellpath dir))))
     118        ($system (sprintf "~a ~a ~a" copy (shellpath (make-pathname src f)) (shellpath dir))))
    109119       +default-repository-files+)))
    110  
     120
    111121  (define (ext-version x)
    112122    (cond ((or (eq? x 'chicken)
    113                (equal? x "chicken")
    114                (member (->string x) ##sys#core-library-modules))
    115            (chicken-version) )
    116           ((extension-information x) =>
    117            (lambda (info)
    118              (let ((a (assq 'version info)))
    119                (if a
    120                    (->string (cadr a))
    121                    "1.0.0"))))
    122           (else #f)))
     123               (equal? x "chicken")
     124               (member (->string x) ##sys#core-library-modules))
     125           (chicken-version) )
     126          ((extension-information x) =>
     127           (lambda (info)
     128             (let ((a (assq 'version info)))
     129               (if a
     130                   (->string (cadr a))
     131                   "1.0.0"))))
     132          (else #f)))
    123133
    124134  (define (outdated-dependencies meta)
    125     (let ((ds (append 
    126                (deps 'depends meta)
    127                (deps 'needs meta)
    128                (if *run-tests* (deps 'test-depends meta) '()))))
     135    (let ((ds (append
     136               (deps 'depends meta)
     137               (deps 'needs meta)
     138               (if *run-tests* (deps 'test-depends meta) '()))))
    129139      (let loop ((deps ds) (missing '()) (upgrade '()))
    130         (if (null? deps)
    131             (values (reverse missing) (reverse upgrade))
    132             (let ((dep (car deps))
    133                   (rest (cdr deps)))
    134               (cond ((or (symbol? dep) (string? dep))
    135                      (loop rest
    136                            (if (ext-version dep)
    137                                missing
    138                                (cons (->string dep) missing))
    139                            upgrade))
    140                     ((and (list? dep) (= 2 (length dep))
    141                           (or (string? (car dep)) (symbol? (car dep))))
    142                      (let ((v (ext-version (car dep))))
    143                        (cond ((not v)
    144                               (warning
    145                                "installed extension has unknown version - assuming it is outdated"
    146                                (car dep))
    147                               (loop rest missing
    148                                     (alist-cons
    149                                      (->string (car dep))
    150                                      (->string (cadr dep))
    151                                      upgrade)))
    152                              ((version>=? (->string (cadr dep)) v)
    153                               (loop rest missing
    154                                     (alist-cons
    155                                      (->string (car dep)) (->string (cadr dep))
    156                                      upgrade)))
    157                              (else (loop rest missing upgrade)))))
    158                     (else
    159                      (warning
    160                       "invalid dependency syntax in extension meta information"
    161                       dep)
    162                      (loop rest missing upgrade))))))))
    163 
    164     (define *eggs+dirs* '())
    165     (define *checked* '())
    166     (define *csi* (shellpath (make-pathname *program-path* "csi")))
    167 
    168     (define (try name version)
    169       (let loop ((defs (if (and *default-location* *default-transport*)
    170                            `(((location ,*default-location*)
    171                               (transport ,*default-transport*)))
    172                            *default-sources*)))
    173         (and (pair? defs)
    174              (let* ((def (car defs))
    175                     (loc (cadr (or (assq 'location def)
    176                                    (error "missing location entry" def))))
    177                     (trans (cadr (or (assq 'transport def)
    178                                      (error "missing transport entry" def)))))
    179                (or (condition-case
    180                        (retrieve-extension
    181                         name trans loc
    182                         version: version
    183                         destination: (and *retrieve-only* (current-directory))
    184                         tests: *run-tests*
    185                         username: *username*
    186                         password: *password*)
    187                      ((exn net)
    188                       (print "TCP connect timeout")
    189                       #f)
    190                      ((exn http-fetch)
    191                       (print "HTTP protocol error")
    192                       #f)
    193                      (e () (abort e)))
    194                    (begin
    195                      (set! *default-sources* (delete def *default-sources* eq?))
    196                      (loop (cdr defs))))))))
    197 
    198     (define (retrieve eggs)
    199       (print "retrieving ...")
     140        (if (null? deps)
     141            (values (reverse missing) (reverse upgrade))
     142            (let ((dep (car deps))
     143                  (rest (cdr deps)))
     144              (cond ((or (symbol? dep) (string? dep))
     145                     (loop rest
     146                           (if (ext-version dep)
     147                               missing
     148                               (cons (->string dep) missing))
     149                           upgrade))
     150                    ((and (list? dep) (= 2 (length dep))
     151                          (or (string? (car dep)) (symbol? (car dep))))
     152                     (let ((v (ext-version (car dep))))
     153                       (cond ((not v)
     154                              (warning
     155                               "installed extension has unknown version - assuming it is outdated"
     156                               (car dep))
     157                              (loop rest missing
     158                                    (alist-cons
     159                                     (->string (car dep))
     160                                     (->string (cadr dep))
     161                                     upgrade)))
     162                             ((version>=? (->string (cadr dep)) v)
     163                              (loop rest missing
     164                                    (alist-cons
     165                                     (->string (car dep)) (->string (cadr dep))
     166                                     upgrade)))
     167                             (else (loop rest missing upgrade)))))
     168                    (else
     169                     (warning
     170                      "invalid dependency syntax in extension meta information"
     171                      dep)
     172                     (loop rest missing upgrade))))))))
     173
     174  (define *eggs+dirs+vers* '())
     175  (define *checked* '())
     176  (define *csi* (shellpath (make-pathname *program-path* "csi")))
     177 
     178  (define (try-extension name version trans locn)
     179    (condition-case
     180        (retrieve-extension
     181         name trans locn
     182         version: version
     183         destination: (and *retrieve-only* (current-directory))
     184         tests: *run-tests*
     185         username: *username*
     186         password: *password*)
     187      [(exn net)
     188       (print "TCP connect timeout")
     189       (values #f "") ]
     190      [(exn http-fetch)
     191       (print "HTTP protocol error")
     192       (values #f "") ]
     193      [e ()
     194       (abort e) ] ) )
     195
     196  (define (try-default-sources name version)
     197    (let trying-sources ([defs (known-default-sources)])
     198      (if (null? defs)
     199          (values #f "")
     200          (let* ([def (car defs)]
     201                 [locn (cadr (or (assq 'location def)
     202                                 (error "missing location entry" def)))]
     203                 [trans (cadr (or (assq 'transport def)
     204                                  (error "missing transport entry" def)))])
     205            (let-values ([(dir ver) (try-extension name version trans locn)])
     206              (if dir
     207                  (values dir ver)
     208                  (begin
     209                    (invalidate-default-source! def)
     210                    (trying-sources (cdr defs)) ) ) ) ) ) ) )
     211
     212  (define (make-replace-extension-question e+d+v upgrade)
     213    (string-concatenate
     214     (append
     215      (list "The following installed extensions are outdated, because `"
     216            (car e+d+v)
     217            "' requires later versions:\n")
     218      (map
     219       (lambda (e)
     220         (conc
     221          "  " (car e)
     222          " (" (let ([v (assq 'version (extension-information (car e)))]) (if v (cadr v) "???"))
     223               " -> " (cdr e) ")"
     224          #\newline) )
     225       upgrade)
     226      '("\nDo you want to replace the existing extensions?"))) )
     227
     228  (define (retrieve eggs)
     229    (print "retrieving ...")
     230    (for-each
     231     (lambda (egg)
     232       (cond [(assoc egg *eggs+dirs+vers*) =>
     233              (lambda (a)
     234                ;; push to front
     235                (set! *eggs+dirs+vers* (cons a (delete a *eggs+dirs+vers* eq?))) ) ]
     236             [else
     237              (let ([name (if (pair? egg) (car egg) egg)]
     238                    [version (and (pair? egg) (cdr egg))])
     239                (let-values ([(dir ver) (try-default-sources name version)])
     240                  (unless dir (error "extension or version not found"))
     241                  (print " " name " located at " dir)
     242                  (set! *eggs+dirs+vers* (alist-cons name (list dir ver) *eggs+dirs+vers*)) ) ) ] ) )
     243     eggs)
     244    (unless *retrieve-only*
    200245      (for-each
    201        (lambda (egg)
    202          (cond ((assoc egg *eggs+dirs*) =>
    203                 (lambda (a)
    204                   ;; push to front
    205                   (set! *eggs+dirs* (cons a (delete a *eggs+dirs* eq?))) ) )
    206                (else
    207                 (let* ((name (if (pair? egg) (car egg) egg))
    208                        (version (and (pair? egg) (cdr egg)))
    209                        (dir (try name version)))
    210                   (unless dir
    211                     (error "extension or version not found"))
    212                   (print " " name " located at " dir)
    213                   (set! *eggs+dirs* (alist-cons name dir *eggs+dirs*))))) )
    214        eggs)
    215       (unless *retrieve-only*
    216         (for-each
    217          (lambda (e+d)
    218            (unless (member (car e+d) *checked*)
    219              (set! *checked* (cons (car e+d) *checked*))
    220              (let ((mfile (make-pathname (cdr e+d) (car e+d) "meta")))
    221                (cond ((file-exists? mfile)
    222                       (let ((meta (with-input-from-file mfile read)))
    223                         (print "checking dependencies for `" (car e+d) "' ...")
    224                         (let-values (((missing upgrade) (outdated-dependencies meta)))
    225                           (when (pair? missing)
    226                             (print " missing: " (string-intersperse missing ", "))
    227                             (retrieve missing))
    228                           (when (and (pair? upgrade)
    229                                      (or *force*
    230                                          (yes-or-no?
    231                                           (string-concatenate
    232                                            (append
    233                                             (list "The following installed extensions are outdated, because `"
    234                                                   (car e+d) "' requires later versions:\n")
    235                                             (map (lambda (e)
    236                                                    (sprintf
    237                                                     "  ~a (~a -> ~a)~%"
    238                                                     (car e)
    239                                                     (let ((v (assq 'version (extension-information (car e)))))
    240                                                       (if v (cadr v) "???"))
    241                                                     (cdr e)))
    242                                                  upgrade)
    243                                             '("\nDo you want to replace the existing extensions?")))
    244                                           "no") ) )
    245                             (let ((ueggs (unzip1 upgrade)))
    246                               (print " upgrade: " (string-intersperse ueggs ", "))
    247                               (for-each
    248                                (lambda (e)
    249                                  (print "removing previously installed extension `" e "' ...")
    250                                  (remove-extension e) )
    251                                ueggs)
    252                               (retrieve ueggs))))))
    253                      (else
    254                       (warning
    255                        (string-append
    256                         "extension `" (car e+d) "' has no .meta file "
    257                         "- assuming it has no dependencies")))))))
    258          *eggs+dirs*)))
    259 
    260     (define (install eggs)
    261       (retrieve eggs)
    262       (unless *retrieve-only*
    263         (for-each ; we assume the order reflects the dependency tree...
    264          (lambda (e+d)
    265            (print "installing " (car e+d) " ...")
    266            (print "changing current directory to " (cdr e+d))
    267            (parameterize ((current-directory (cdr e+d)))
    268              (let ((cmd (sprintf
    269                          "~a -bnq -e \"(require-library setup-api)\" -e \"(import setup-api)\" ~a ~a ~a ~a ~a ~a"
    270                          *csi*
    271                          (if (sudo-install) "-e \"(sudo-install #t)\"" "")
    272                          (if *keep* "-e \"(keep-intermediates #t)\"" "")
    273                          (if *no-install* "-e \"(setup-install-flag #f)\"" "")
    274                          (if *host-extension* "-e \"(host-extension #t)\"" "")
    275                          (if *prefix*
    276                              (sprintf "-e \"(installation-prefix \\\"~a\\\")\"" *prefix*)
    277                              "")
    278                          (shellpath (make-pathname (cdr e+d) (car e+d) "setup")))))
    279                (print "  " cmd)
    280                ($system cmd))
    281              (when (and *run-tests*
    282                         (file-exists? "tests")
    283                         (directory? "tests")
    284                         (file-exists? "tests/run.scm") )
    285                (current-directory "tests")
    286                (let ((cmd (sprintf "~a -s run.scm ~a" *csi* (car e+d))))
    287                  (print "  " cmd)
    288                  ($system cmd)))))
    289          *eggs+dirs*)))
     246       (lambda (e+d+v)
     247         (unless (member (car e+d+v) *checked*)
     248           (set! *checked* (cons (car e+d+v) *checked*))
     249           (let ([mfile (make-pathname (cadr e+d+v) (car e+d+v) "meta")])
     250             (cond [(file-exists? mfile)
     251                    (let ([meta (with-input-from-file mfile read)])
     252                      (print "checking dependencies for `" (car e+d+v) "' ...")
     253                      (let-values ([(missing upgrade) (outdated-dependencies meta)])
     254                        (when (pair? missing)
     255                          (print " missing: " (string-intersperse missing ", "))
     256                          (retrieve missing))
     257                        (when (and (pair? upgrade)
     258                                   (or *force*
     259                                       (yes-or-no?
     260                                        (make-replace-extension-question e+d+v upgrade)
     261                                        "no") ) )
     262                          (let ([ueggs (unzip1 upgrade)])
     263                            (print " upgrade: " (string-intersperse ueggs ", "))
     264                            (for-each
     265                             (lambda (e)
     266                               (print "removing previously installed extension `" e "' ...")
     267                               (remove-extension e) )
     268                             ueggs)
     269                            (retrieve ueggs) ) ) ) ) ]
     270                   [else
     271                    (warning
     272                     (string-append
     273                      "extension `" (car e+d+v) "' has no .meta file "
     274                      "- assuming it has no dependencies")) ] ) ) ) )
     275       *eggs+dirs+vers*) ) )
     276
     277  (define (make-install-command e+d+v)
     278    (conc
     279     *csi*
     280     " -bnq -e \"(require-library setup-api)\" -e \"(import setup-api)\""
     281     (sprintf " -e \"(extension-name-and-version '(\\\"~a\\\" \\\"~a\\\"))\"" (car e+d+v) (caddr e+d+v))
     282     (if (sudo-install) " -e \"(sudo-install #t)\"" "")
     283     (if *keep* " -e \"(keep-intermediates #t)\"" "")
     284     (if *no-install* " -e \"(setup-install-flag #f)\"" "")
     285     (if *host-extension* " -e \"(host-extension #t)\"" "")
     286     (if *prefix* (sprintf " -e \"(installation-prefix \\\"~a\\\")\"" *prefix*) "")
     287     #\space (shellpath (make-pathname (cadr e+d+v) (car e+d+v) "setup"))) )
     288
     289  (define (install eggs)
     290    (retrieve eggs)
     291    (unless *retrieve-only*
     292      (for-each ; we assume the order reflects the dependency tree...
     293       (lambda (e+d+v)
     294         (print "installing " (car e+d+v) #\: (caddr e+d+v) " ...")
     295         (print "changing current directory to " (cadr e+d+v))
     296         (parameterize ((current-directory (cadr e+d+v)))
     297           (let ([cmd (make-install-command e+d+v)])
     298             (print "  " cmd)
     299             ($system cmd))
     300           (when (and *run-tests*
     301                      (file-exists? "tests")
     302                      (directory? "tests")
     303                      (file-exists? "tests/run.scm") )
     304             (current-directory "tests")
     305             (let ((cmd (sprintf "~a -s run.scm ~a" *csi* (car e+d+v))))
     306               (print "  " cmd)
     307               ($system cmd)))))
     308       *eggs+dirs+vers*)))
    290309
    291310  (define (cleanup)
    292311    (unless *keep*
    293312      (and-let* ((tmpdir (temporary-directory)))
    294         (remove-directory tmpdir))))
     313        (remove-directory tmpdir))))
    295314
    296315  (define (update-db)
    297316    (let* ((files (glob (make-pathname (repository-path) "*.import.*")))
    298            (tmpdir (create-temporary-directory))
    299            (dbfile (make-pathname tmpdir +module-db+))
    300            (rx (regexp ".*/([^/]+)\\.import\\.(scm|so)")))
     317           (tmpdir (create-temporary-directory))
     318           (dbfile (make-pathname tmpdir +module-db+))
     319           (rx (regexp ".*/([^/]+)\\.import\\.(scm|so)")))
    301320      (fluid-let ((##sys#warnings-enabled #f))
    302         (for-each
    303         (lambda (f)
    304            (let ((m (string-match rx f)))
    305              (eval `(import ,(string->symbol (cadr m))))))
    306         files))
     321        (for-each
     322        (lambda (f)
     323           (let ((m (string-match rx f)))
     324             (eval `(import ,(string->symbol (cadr m))))))
     325        files))
    307326      (print "generating database")
    308327      (let ((db
    309              (sort
    310               (append-map
    311                (lambda (m)
    312                 (let* ((mod (cdr m))
    313                         (mname (##sys#module-name mod)))
    314                    (print* " " mname)
    315                    (let-values (((_ ve se) (##sys#module-exports mod)))
    316                      (append
    317                       (map (lambda (se) (list (car se) 'syntax mname)) se)
    318                       (map (lambda (ve) (list (car ve) 'value mname)) ve)))))
    319                ##sys#module-table)
    320               (lambda (e1 e2)
    321                 (string<? (symbol->string (car e1)) (symbol->string (car e2)))))))
    322         (newline)
    323         (with-output-to-file dbfile
    324           (lambda ()
    325             (for-each (lambda (x) (write x) (newline)) db)))
    326         (copy-file dbfile (make-pathname (repository-path) +module-db+))
    327         (remove-directory tmpdir))))
     328             (sort
     329              (append-map
     330               (lambda (m)
     331                (let* ((mod (cdr m))
     332                        (mname (##sys#module-name mod)))
     333                   (print* " " mname)
     334                   (let-values (((_ ve se) (##sys#module-exports mod)))
     335                     (append
     336                      (map (lambda (se) (list (car se) 'syntax mname)) se)
     337                      (map (lambda (ve) (list (car ve) 'value mname)) ve)))))
     338               ##sys#module-table)
     339              (lambda (e1 e2)
     340                (string<? (symbol->string (car e1)) (symbol->string (car e2)))))))
     341        (newline)
     342        (with-output-to-file dbfile
     343          (lambda ()
     344            (for-each (lambda (x) (write x) (newline)) db)))
     345        (copy-file dbfile (make-pathname (repository-path) +module-db+))
     346        (remove-directory tmpdir))))
    328347
    329348  (define ($system str)
    330349    (let ((r (system
    331               (if *windows-shell*
    332                   (string-append "\"" str "\"")
    333                   str))))
     350              (if *windows-shell*
     351                  (string-append "\"" str "\"")
     352                  str))))
    334353      (unless (zero? r)
    335         (error "shell command terminated with nonzero exit code" r str))))
     354        (error "shell command terminated with nonzero exit code" r str))))
    336355
    337356  (define (usage code)
     
    363382  (define (main args)
    364383    (let ((defaults (load-defaults))
    365           (update #f)
    366           (rx "([^:]+):(.+)"))
     384          (update #f)
     385          (rx "([^:]+):(.+)"))
    367386      (let loop ((args args) (eggs '()))
    368         (cond ((null? args)
    369                (cond (update (update-db))
    370                      (else
    371                       (when (null? eggs)
    372                         (let ((setups (glob "*.setup")))
    373                           (cond ((pair? setups)
    374                                  (set! *eggs+dirs*
    375                                    (append
    376                                     (map (lambda (s) (cons (pathname-file s) ".")) setups)
    377                                     *eggs+dirs*)))
    378                                 (else
    379                                  (print "no setup-scripts to process")
    380                                  (exit 1))) ) )
    381                       (unless defaults
    382                         (unless *default-transport*
    383                           (error "no default transport defined - please use `-transport' option"))
    384                         (unless *default-location*
    385                           (error "no default location defined - please use `-location' option")))
    386                       (install (reverse eggs)))))
    387               (else
    388                (let ((arg (car args)))
    389                  (cond ((or (string=? arg "-help")
    390                             (string=? arg "-h")
    391                             (string=? arg "--help"))
    392                         (usage 0))
    393                        ((string=? arg "-force")
    394                         (set! *force* #t)
    395                         (loop (cdr args) eggs))
    396                        ((or (string=? arg "-k") (string=? arg "-keep"))
    397                         (set! *keep* #t)
    398                         (loop (cdr args) eggs))
    399                        ((or (string=? arg "-s") (string=? arg "-sudo"))
    400                         (sudo-install #t)
    401                         (loop (cdr args) eggs))
    402                        ((or (string=? arg "-r") (string=? arg "-retrieve"))
    403                         (set! *retrieve-only* #t)
    404                         (loop (cdr args) eggs))
    405                        ((or (string=? arg "-l") (string=? arg "-location"))
    406                         (unless (pair? (cdr args)) (usage 1))
    407                         (set! *default-location* (cadr args))
    408                         (loop (cddr args) eggs))
    409                        ((or (string=? arg "-t") (string=? arg "-transport"))
    410                         (unless (pair? (cdr args)) (usage 1))
    411                         (set! *default-transport* (string->symbol (cadr args)))
    412                         (loop (cddr args) eggs))
    413                        ((or (string=? arg "-p") (string=? arg "-prefix"))
    414                         (unless (pair? (cdr args)) (usage 1))
    415                         (set! *prefix* (cadr args))
    416                         (loop (cddr args) eggs))
    417                        ((or (string=? arg "-n") (string=? arg "-no-install"))
    418                         (set! *keep* #t)
    419                         (set! *no-install* #t)
    420                         (loop (cdr args) eggs))
    421                        ((or (string=? arg "-v") (string=? arg "-version"))
    422                         (print (chicken-version))
    423                         (exit 0))
    424                        ((or (string=? arg "-u") (string=? arg "-update-db"))
    425                         (set! update #t)
    426                         (loop (cdr args) eggs))
    427                        ((or (string=? arg "-i") (string=? arg "-init"))
    428                         (unless (pair? (cdr args)) (usage 1))
    429                         (init-repository (cadr args))
    430                         (exit 0))
    431                        ((string=? "-test" arg)
    432                         (set! *run-tests* #t)
    433                         (loop (cdr args) eggs))
    434                        ((string=? "-host-extension" arg)
    435                         (set! *host-extension* #t)
    436                         (loop (cdr args) eggs))
    437                        ((string=? "-username" arg)
    438                         (unless (pair? (cdr args)) (usage 1))
    439                         (set! *username* (cadr args))
    440                         (loop (cddr args) eggs))
    441                        ((string=? "-password" arg)
    442                         (unless (pair? (cdr args)) (usage 1))
    443                         (set! *password* (cadr args))
    444                         (loop (cddr args) eggs))
    445                        ((and (positive? (string-length arg))
    446                              (char=? #\- (string-ref arg 0)))
    447                         (if (> (string-length arg) 2)
    448                             (let ((sos (string->list (substring arg 1))))
    449                               (if (null? (lset-intersection eq? *short-options* sos))
    450                                   (loop (append (map (cut string #\- <>) sos) (cdr args)) eggs)
    451                                   (usage 1)))
    452                             (usage 1)))
    453                        ((equal? "setup" (pathname-extension arg))
    454                         (let ((egg (pathname-file arg)))
    455                           (set! *eggs+dirs*
    456                             (alist-cons
    457                              egg
    458                              (let ((dir (pathname-directory arg)))
    459                                (if dir
    460                                    (if (absolute-pathname? dir)
    461                                        dir
    462                                        (make-pathname (current-directory) dir) )
    463                                    (current-directory)))
    464                              *eggs+dirs*))
    465                           (loop (cdr args) (cons egg eggs))))
    466                        ((string-match rx arg) =>
    467                         (lambda (m)
    468                           (loop (cdr args) (alist-cons (cadr m) (caddr m) eggs))))
    469                        (else (loop (cdr args) (cons arg eggs))))))))))
     387        (cond ((null? args)
     388               (cond (update (update-db))
     389                     (else
     390                      (when (null? eggs)
     391                        (let ((setups (glob "*.setup")))
     392                          (cond ((pair? setups)
     393                                 (set! *eggs+dirs+vers*
     394                                       (append
     395                                        (map
     396                                         (lambda (s) (cons (pathname-file s) (list "." "")))
     397                                         setups)
     398                                        *eggs+dirs+vers*)))
     399                                (else
     400                                 (print "no setup-scripts to process")
     401                                 (exit 1))) ) )
     402                      (unless defaults
     403                        (unless *default-transport*
     404                          (error "no default transport defined - please use `-transport' option"))
     405                        (unless *default-location*
     406                          (error "no default location defined - please use `-location' option")))
     407                      (install (reverse eggs)))))
     408              (else
     409               (let ((arg (car args)))
     410                 (cond ((or (string=? arg "-help")
     411                            (string=? arg "-h")
     412                            (string=? arg "--help"))
     413                        (usage 0))
     414                       ((string=? arg "-force")
     415                        (set! *force* #t)
     416                        (loop (cdr args) eggs))
     417                       ((or (string=? arg "-k") (string=? arg "-keep"))
     418                        (set! *keep* #t)
     419                        (loop (cdr args) eggs))
     420                       ((or (string=? arg "-s") (string=? arg "-sudo"))
     421                        (sudo-install #t)
     422                        (loop (cdr args) eggs))
     423                       ((or (string=? arg "-r") (string=? arg "-retrieve"))
     424                        (set! *retrieve-only* #t)
     425                        (loop (cdr args) eggs))
     426                       ((or (string=? arg "-l") (string=? arg "-location"))
     427                        (unless (pair? (cdr args)) (usage 1))
     428                        (set! *default-location* (cadr args))
     429                        (loop (cddr args) eggs))
     430                       ((or (string=? arg "-t") (string=? arg "-transport"))
     431                        (unless (pair? (cdr args)) (usage 1))
     432                        (set! *default-transport* (string->symbol (cadr args)))
     433                        (loop (cddr args) eggs))
     434                       ((or (string=? arg "-p") (string=? arg "-prefix"))
     435                        (unless (pair? (cdr args)) (usage 1))
     436                        (set! *prefix* (cadr args))
     437                        (loop (cddr args) eggs))
     438                       ((or (string=? arg "-n") (string=? arg "-no-install"))
     439                        (set! *keep* #t)
     440                        (set! *no-install* #t)
     441                        (loop (cdr args) eggs))
     442                       ((or (string=? arg "-v") (string=? arg "-version"))
     443                        (print (chicken-version))
     444                        (exit 0))
     445                       ((or (string=? arg "-u") (string=? arg "-update-db"))
     446                        (set! update #t)
     447                        (loop (cdr args) eggs))
     448                       ((or (string=? arg "-i") (string=? arg "-init"))
     449                        (unless (pair? (cdr args)) (usage 1))
     450                        (init-repository (cadr args))
     451                        (exit 0))
     452                       ((string=? "-test" arg)
     453                        (set! *run-tests* #t)
     454                        (loop (cdr args) eggs))
     455                       ((string=? "-host-extension" arg)
     456                        (set! *host-extension* #t)
     457                        (loop (cdr args) eggs))
     458                       ((string=? "-username" arg)
     459                        (unless (pair? (cdr args)) (usage 1))
     460                        (set! *username* (cadr args))
     461                        (loop (cddr args) eggs))
     462                       ((string=? "-password" arg)
     463                        (unless (pair? (cdr args)) (usage 1))
     464                        (set! *password* (cadr args))
     465                        (loop (cddr args) eggs))
     466                       ((and (positive? (string-length arg))
     467                             (char=? #\- (string-ref arg 0)))
     468                        (if (> (string-length arg) 2)
     469                            (let ((sos (string->list (substring arg 1))))
     470                              (if (null? (lset-intersection eq? *short-options* sos))
     471                                  (loop (append (map (cut string #\- <>) sos) (cdr args)) eggs)
     472                                  (usage 1)))
     473                            (usage 1)))
     474                       ((equal? "setup" (pathname-extension arg))
     475                        (let ((egg (pathname-file arg)))
     476                          (set! *eggs+dirs+vers*
     477                            (alist-cons
     478                             egg
     479                             (list
     480                              (let ((dir (pathname-directory arg)))
     481                                (if dir
     482                                    (if (absolute-pathname? dir)
     483                                        dir
     484                                        (make-pathname (current-directory) dir) )
     485                                    (current-directory)))
     486                              "")
     487                             *eggs+dirs+vers*))
     488                          (loop (cdr args) (cons egg eggs))))
     489                       ((string-match rx arg) =>
     490                        (lambda (m)
     491                          (loop (cdr args) (alist-cons (cadr m) (caddr m) eggs))))
     492                       (else (loop (cdr args) (cons arg eggs))))))))))
    470493
    471494  (register-feature! 'chicken-install)
     
    474497  (handle-exceptions ex
    475498      (begin
    476         (print-error-message ex (current-error-port))
    477         (cleanup)
    478         (exit 1))
     499        (print-error-message ex (current-error-port))
     500        (cleanup)
     501        (exit 1))
    479502    (main (command-line-arguments))
    480503    (cleanup))
    481  
    482 )
     504
     505) ;module main
  • chicken/branches/prerelease/chicken-primitive-object-inlines.scm

    r13240 r13859  
    33;;;; (Was chicken-sys-macros.scm)
    44
     5; ***** SHOULD RENAME SAFE ROUTINES AS '*foo', KEEPING '%foo' FOR UNSAFE *****
     6
    57; Usage
    68;
     
    810
    911;; Notes
    10 ;
    11 ; Provides inlines & macros for primitive procedures. Use of these procedures
    12 ; by non-core & non-core-extensions is highly suspect. Many of these routines
    13 ; are unsafe.
    14 ;
    15 ; In fact, any use is suspect ;-)
    16 ;
    17 ; A ##core#Inline is just what it says - literal inclusion in the compiled C
    18 ; code of the C macro/function and the arguments taken literally, i.e. as the
    19 ; C_word value.
    20 ;
    21 ; These are much faster than a lambda, but very dangerous since the arguments and
    22 ; the return value are not converted. The C code must perform any such conversions.
    23 ;
    24 ; ##core#inline cannot be used with a runtime C function which is coded in the
    25 ;CPS style.
    26 ;
    27 ; A ##core#primitive creates a lambda for a C function which is coded in the
    28 ; CPS style.
    29 ;
    30 ; These have a stereotypical argument list which begins the 3 arguments C_word
    31 ; c, C_word closure, and C_word k. Any actual arguments follow.
    32 ;
    33 ; c - number of arguments, not including 'c', but including 'closure' & 'k'
    34 ; closure - caller
    35 ; k - continuation
    36 
    37 
    38 ;;; Type Predicates
    39 
    40 ;; Argument is a 'C_word'
    41 
    42 
    43 ;; Immediate
    44 
    45 (define-inline (%immediate? ?x) (##core#inline "C_immp" x))
    46 
     12;;
     13;; Provides inlines for primitive procedures. Use of these procedures
     14;; by non-core is highly suspect. Many of these routines are unsafe.
     15;;
     16;; In fact, any use is suspect ;-)
     17;;
     18;; A ##core#Inline is just what it says - literal inclusion in the compiled C
     19;; code of the C macro/function and the arguments taken literally, i.e. as the
     20;; C_word value.
     21;;
     22;; These are much faster than a lambda, but very dangerous since the arguments and
     23;; the return value are not converted. The C code must perform any such conversions.
     24;;
     25;; ##core#inline cannot be used with a runtime C function which is coded in the
     26;; CPS style.
     27;;
     28;; A ##core#primitive creates a lambda for a C function which is coded in the
     29;; CPS style.
     30;;
     31;; These have a stereotypical argument list which begins the 3 arguments C_word
     32;; c, C_word closure, and C_word k. Any actual arguments follow.
     33;;
     34;; c       - number of arguments, not including 'c', but including 'closure' & 'k'
     35;; closure - caller
     36;; k       - continuation
     37
     38;;; Unsafe Type Predicates
    4739
    4840;; Fixnum
    4941
    50 (define-inline (%fixnum? x) (##core#inline "C_fixnump" x))
    51 
     42(define-inline (%fixnum-type? x) (##core#inline "C_fixnump" x))
    5243
    5344;; Character
    5445
    55 (define-inline (%char? x) (##core#inline "C_charp" x))
    56 
     46(define-inline (%char-type? x) (##core#inline "C_charp" x))
    5747
    5848;; Boolean
    5949
    60 (define-inline (%boolean? x) (##core#inline "C_booleanp" x))
    61 
     50(define-inline (%boolean-type? x) (##core#inline "C_booleanp" x))
    6251
    6352;; EOF
    6453
    65 (define-inline (%eof-object? x) (##core#inline "C_eofp" x))
    66 
     54(define-inline (%eof-object-type? x) (##core#inline "C_eofp" x))
    6755
    6856;; Null (the end-of-list value)
    6957
    70 (define-inline (%null? x) (##core#inline "C_i_nullp" x))
    71 
     58(define-inline (%eol-object-type? x) (##core#inline "C_i_nullp" x))
    7259
    7360;; Undefined (void)
    7461
    75 (define-inline (%undefined? x) (##core#inline "C_undefinedp" x))
    76 
     62(define-inline (%undefined-type? x) (##core#inline "C_undefinedp" x))
    7763
    7864;; Unbound (the unbound value, not 'is a symbol unbound')
    7965
    80 (define-inline (%unbound? x) (##core#inline "C_unboundvaluep" x))
    81 
    82 
    83 ;; Block (anything not immediate)
    84 
    85 (define-inline (%block? x) (##core#inline "C_blockp" x))
    86 
     66(define-inline (%unbound-type? x) (##core#inline "C_unboundvaluep" x))
     67
     68;; Byteblock
     69
     70(define-inline (%byteblock-type? x) (##core#inline "C_byteblockp" x))
     71
     72;; Bytevector
     73
     74(define-inline (%bytevector-type? x) (##core#inline "C_bytevectorp" x))
     75
     76;; String
     77
     78(define-inline (%string-type? x) (##core#inline "C_stringp" x))
     79
     80;; Flonum
     81
     82(define-inline (%flonum-type? x) (##core#inline "C_flonump" x))
     83
     84;; Lambda-info
     85
     86(define-inline (%lambda-info-type? x) (##core#inline "C_lambdainfop" x))
    8787
    8888;; Vector
     
    9090(define-inline (%vector-type? x) (##core#inline "C_vectorp" x))
    9191
    92 
    93 ;; Bytevector (isa vector so be careful; refers to how allocated, not what stored)
    94 
    95 (define-inline (%bytevector-type? x) (##core#inline "C_bytevectorp" x))
    96 
    97 
    9892;; Pair
    9993
    10094(define-inline (%pair-type? x) (##core#inline "C_pairp" x))
    101 
    10295
    10396;; Bucket
     
    10699; "seen" by Scheme code.
    107100
    108 
    109101;; Structure
    110102
    111103(define-inline (%structure-type? x) (##core#inline "C_structurep" x))
    112104
    113 
    114105;; Symbol
    115106
    116107(define-inline (%symbol-type? x) (##core#inline "C_symbolp" x))
    117108
     109;; Closure
     110
     111(define-inline (%closure-type? x) (##core#inline "C_closurep" x))
     112
     113;; Port
     114
     115(define-inline (%port-type? x) (##core#inline "C_portp" x))
     116
     117;; Any-pointer
     118
     119(define-inline (%any-pointer-type? x) (##core#inline "C_anypointerp" x))
     120
     121;; Simple-pointer
     122
     123(define-inline (%simple-pointer-type? x) (##core#inline "C_pointerp" x))
     124
     125;; Tagged-Pointer
     126
     127(define-inline (%tagged-pointer-type? x) (##core#inline "C_taggedpointerp" x))
     128
     129;; Swig-Pointer
     130
     131(define-inline (%swig-pointer-type? x) (##core#inline "C_swigpointerp" x))
     132
     133;; Locative
     134
     135(define-inline (%locative-type? x) (##core#inline "C_locativep" x))
     136
     137;;; Safe Type Predicates
     138
     139;; Immediate
     140
     141(define-inline (%immediate? x) (##core#inline "C_immp" x))
     142
     143;; Fixnum
     144
     145(define-inline (%fixnum? x) (and (%immediate? x) (%fixnum-type? x)))
     146
     147;; Character
     148
     149(define-inline (%char? x) (and (%immediate? x) (%char-type? x)))
     150
     151;; Boolean
     152
     153(define-inline (%boolean? x) (and (%immediate? x) (%boolean-type? x)))
     154
     155(define-inline (%true-value? x) (and (%boolean? x) (##core#inline "C_and" x #t)))
     156(define-inline (%false-value? x) (not (%true-value? x)))
     157
     158;; EOF
     159
     160(define-inline (%eof-object? x) (and (%immediate? x) (%eof-object-type? x)))
     161
     162;; Null (the end-of-list value)
     163
     164(define-inline (%eol-object? x) (and (%immediate? x) (%eol-object-type? x)))
     165
     166;; Undefined (void)
     167
     168(define-inline (%undefined-value? x) (and (%immediate? x) (%undefined-type? x)))
     169
     170(define-inline (%undefined-value) (##core#undefined))
     171
     172;; Unbound (the unbound value, not 'is a symbol unbound')
     173
     174(define-inline (%unbound-value? x) (and (%immediate? x) (%unbound-type? x)))
     175
     176;; Block (anything not immediate)
     177
     178(define-inline (%block? x) (##core#inline "C_blockp" x))
     179
     180;; Special
     181
     182(define-inline (%special? x) (##core#inline "C_specialp" x))
    118183
    119184;; Byteblock
    120185
    121 (define-inline (%byteblock? x) (##core#inline "C_byteblockp" x))
    122 
     186(define-inline (%byteblock? x) (and (%block? x) (%byteblock-type? x)))
     187
     188;; Bytevector
     189
     190(define-inline (%bytevector? x) (and (%block? x) (%bytevector-type? x)))
    123191
    124192;; String
    125193
    126 (define-inline (%string-type? x) (##core#inline "C_stringp" x))
    127 
     194(define-inline (%string? x) (and (%block? x) (%string-type? x)))
    128195
    129196;; Flonum
    130197
    131 (define-inline (%flonum-type? x) (##core#inline "C_flonump" x))
    132 
     198(define-inline (%flonum? x) (and (%block? x) (%flonum-type? x)))
    133199
    134200;; Lambda-info
    135201
    136 (define-inline (%lambda-info-type? x) (##core#inline "C_lambdainfop" x))
    137 
    138 
    139 ;; Special
    140 
    141 (define-inline (%special? x) (##core#inline "C_specialp" x))
    142 
     202(define-inline (%lambda-info? x) (and (%block? x) (%lambda-info-type? x)))
     203
     204;; Wordblock (special block)
     205
     206(define-inline (%wordblock? x) (and (%block? x) (%special? x)))
     207
     208;; Vector
     209
     210(define-inline (%vector? x) (and (%block? x) (%vector-type? x)))
     211
     212;; Pair
     213
     214(define-inline (%pair? x) (and (%block? x) (%pair-type? x)))
     215
     216;; Bucket
     217
     218; A bucket is used by the runtime for the symbol-table. The bucket type is not
     219; "seen" by Scheme code.
     220
     221;; Structure
     222
     223(define-inline (%structure? x) (and (%block? x) (%structure-type? x)))
     224
     225;; Symbol
     226
     227(define-inline (%symbol? x) (and (%block? x) (%symbol-type? x)))
    143228
    144229;; Closure
    145230
    146 (define-inline (%closure-type? x) (##core#inline "C_closurep" x))
    147 
     231(define-inline (%closure? x) (and (%block? x) (%closure-type? x)))
    148232
    149233;; Port
    150234
    151 (define-inline (%port-type? x) (##core#inline "C_portp" x))
    152 
     235(define-inline (%port? x) (and (%block? x) (%port-type? x)))
     236
     237;; Any-pointer
     238
     239(define-inline (%pointer? x) (and (%block? x) (%any-pointer-type? x)))
    153240
    154241;; Simple-pointer
    155242
    156 (define-inline (%simple-pointer-type? x) (##core#inline "C_pointerp" x))
    157 
     243(define-inline (%simple-pointer? x) (and (%block? x) (%simple-pointer-type? x)))
    158244
    159245;; Tagged-Pointer
    160246
    161 (define-inline (%tagged-pointer-type? x) (##core#inline "C_taggedpointerp" x))
    162 
     247(define-inline (%tagged-pointer? x) (and (%block? x) (%tagged-pointer-type? x)))
    163248
    164249;; Swig-Pointer
    165250
    166 (define-inline (%swig-pointer-type? x) (##core#inline "C_swigpointerp" x))
    167 
    168 
    169 ;; Any-pointer
    170 
    171 (define-inline (%any-pointer-type? x) (##core#inline "C_anypointerp" x))
    172 
     251(define-inline (%swig-pointer? x) (and (%block? x) (%swig-pointer-type? x)))
    173252
    174253;; Locative
    175254
    176 (define-inline (%locative-type? x) (##core#inline "C_locativep" x))
    177 
     255(define-inline (%locative? x) (and (%block? x) (%locative-type? x)))
    178256
    179257;; Forwarded (block object moved to new address, forwarding pointer)
     
    181259(define-inline (%forwarded? x) (##core#inline "C_forwardedp" x))
    182260
    183 
    184 
    185 ;;; Values
    186 
    187 
    188 
    189261;;; Operations
    190262
     263;Safe
     264
    191265(define-inline (%eq? x y) (##core#inline "C_eqp" x y))
    192266
    193 ; (%peek-signed-integer BLOCK INDEX)
    194 ;
    195 (define-inline %peek-signed-integer (##core#primitive "C_peek_signed_integer"))
    196 
    197 ; (%peek-unsigned-integer BLOCK INDEX)
    198 ;
    199 (define-inline %peek-unsigned-integer (##core#primitive "C_peek_unsigned_integer"))
    200 
    201 (define-inline (%poke-integer b i n) (##core#inline "C_poke_integer" b i n))
    202 
    203 
    204267;; Fixnum
    205268
    206 (define-inline (%fx+ x y) (##core#inline "C_fixnum_plus" x y))
    207 (define-inline (%fx- x y) (##core#inline "C_fixnum_difference" x y))
    208 (define-inline (%fx* x y) (##core#inline "C_fixnum_times" x y))
     269;Safe
     270
     271(define-inline (%fxrandom x) (##core#inline "C_random_fixnum" x))
     272
     273;Unsafe
     274
    209275(define-inline (%fx= x y) (%eq? x y))
    210276(define-inline (%fx> x y) (##core#inline "C_fixnum_greaterp" x y))
     
    212278(define-inline (%fx>= x y) (##core#inline "C_fixnum_greater_or_equal_p" x y))
    213279(define-inline (%fx<= x y) (##core#inline "C_fixnum_less_or_equal_p" x y))
    214 (define-inline (%fxmin x y) (##core#inline "C_i_fixnum_min" x y))
    215 (define-inline (%fxmax x y) (##core#inline "C_i_fixnum_max" x y))
     280
     281(define-inline (%fxclosed-right? l x h) (and (fx%< l x) (%fx<= x h)))
     282(define-inline (%fxclosed? l x h) (and (%fx<= l x) (%fx<= x h)))
     283(define-inline (%fxclosed-left? l x h) (and (%fx<= l x) (%fx< x h)))
     284
     285(define-inline (%fxzero? fx) (%fx= 0 fx))
     286(define-inline (%fxpositive? fx) (%fx< 0 fx))
     287(define-inline (%fxnegative? fx) (%fx< fx 0))
     288(define-inline (%fxcardinal? fx) (%fx<= 0 fx))
     289(define-inline (%fxodd? fx) (%fx= 1 (%fxand fx 1)))
     290(define-inline (%fxeven? fx) (%fx= 0 (%fxand fx 1)))
     291
     292(define-inline (%fxmin x y) (if (%fx< x y) x y))
     293(define-inline (%fxmax x y) (if (%fx< x y) y x))
     294
     295(define-inline (%fx+ x y) (##core#inline "C_fixnum_plus" x y))
     296(define-inline (%fx- x y) (##core#inline "C_fixnum_difference" x y))
     297(define-inline (%fx* x y) (##core#inline "C_fixnum_times" x y))
     298(define-inline (%fx/ x y) (##core#inline "C_fixnum_divide" x y))
     299(define-inline (%fxmod x y) (##core#inline "C_fixnum_modulo" x y))
     300
     301(define-inline (%fxadd1 fx) (##core#inline "C_fixnum_increase" fx))
     302(define-inline (%fxsub1 fx) (##core#inline "C_fixnum_decrease" fx))
     303
     304(define-inline (%fxshl x y) (##core#inline "C_fixnum_shift_left" x y))
     305(define-inline (%fxshr x y) (##core#inline "C_fixnum_shift_right" x y))
     306
    216307(define-inline (%fxneg x) (##core#inline "C_fixnum_negate" x))
     308(define-inline (%fxabs fx) (if (%fxnegative? fx) (%fxneg fx) fx))
     309
    217310(define-inline (%fxand x y) (##core#inline "C_fixnum_and" x y))
    218311(define-inline (%fxior x y) (##core#inline "C_fixnum_or" x y))
    219312(define-inline (%fxxor x y) (##core#inline "C_fixnum_xor" x y))
    220313(define-inline (%fxnot x) (##core#inline "C_fixnum_not" x))
    221 (define-inline (%fxshl x y) (##core#inline "C_fixnum_shift_left" x y))
    222 (define-inline (%fxshr x y) (##core#inline "C_fixnum_shift_right" x y))
    223 
    224 ; These are very unsafe, no check for division-by-zero
    225 (define-inline (%fx/ x y) (##core#inline "C_fixnum_divide" x y))
    226 (define-inline (%fxmod x y) (##core#inline "C_fixnum_modulo" x y))
    227 
    228 
    229 ;;; Block
    230 
     314
     315;; Block
     316
     317(define-inline (%peek-signed-integer b i) ((##core#primitive "C_peek_signed_integer") b i))
     318(define-inline (%peek-unsigned-integer b i) ((##core#primitive "C_peek_unsigned_integer") b i))
     319(define-inline (%poke-integer b i n) (##core#inline "C_poke_integer" b i n))
     320
     321;Safe
     322
     323(define-inline (%block-address b) (##core#inline_allocate ("C_block_address" 4) b))
    231324
    232325;; Size of object in units of sub-object.
    233326
    234 ; byteblock is # of bytes, otherwise # of words.
     327; (%block-allocate size byteblock? fill aligned-8-byte-boundry?)
    235328;
    236 (define-inline (%block-size x) (##core#inline "C_block_size" x))
    237 
    238 
    239 ;; (%block-allocate size byteblock? fill aligned-8-byte-boundry?)
    240 ;
    241 ; Creates & returns a string when 'byteblock?', otherwise a vector.
    242 ;
    243 ; Size is # of bytes when 'byteblock?', otherwise # of words.
    244 ; Fill is a character when 'byteblock?', otherwise any.
    245 ;
    246 (define-inline %block-allocate (##core#primitive "C_allocate_vector"))
    247 
    248 (define-inline (%block-address x) (##core#inline_allocate ("C_block_address" 4) x))
    249 
    250 
    251 ;; Byte access
    252 
    253 (define-inline (%make-block-byte n f a?) (%block-allocate n #t f a?))
    254 
    255 (define-inline (%block-byte-ref x i) (##core#inline "C_subbyte" x i))
    256 (define-inline (%block-byte-set! x i n) (##core#inline "C_setsubbyte" x i n))
    257 
    258 
    259 ;; Word access
    260 
    261 (define-inline (%make-block-word n f a?) (%block-allocate n #f f a?))
    262 
    263 (define-inline (%block-word-ref x i) (##core#inline "C_slot" x i))
    264 
    265 (define-inline (%block-word-set! x i y) (##core#inline "C_i_setslot" x i y))
    266 (define-inline (%block-word-set!/immediate x i y) (##core#inline "C_i_set_i_slot" x i y))
    267 
    268 
    269 
    270 ;;;
    271 
     329; byteblock? #t - size is # of bytes, fill is-a character  -> "string"
     330; byteblock? #f - size is # of words, fill is-a any        -> "vector"
     331
     332(define-inline (%block-allocate n bb? f a?) ((##core#primitive "C_allocate_vector") n bb? f a?))
     333
     334;Unsafe
     335
     336; Byteblock -> # of bytes
     337; Wordblock -> # of words.
     338
     339(define-inline (%block-size b) (##core#inline "C_block_size" b))
     340
     341;;
     342
     343;; Byteblock
     344
     345;Safe
     346
     347(define-inline (%make-byteblock n f a?) (%block-allocate n #t f a?))
     348
     349;Unsafe
     350
     351(define-inline (%byteblock-length bb) (%block-size bb))
     352
     353(define-inline (%byteblock-ref bb i) (##core#inline "C_subbyte" bb i))
     354
     355(define-inline (%byteblock-set! bb i v) (##core#inline "C_setsubbyte" bb i v))
    272356
    273357;; Generic-byteblock
    274358
    275 ; generic-byteblock isa string, flonum, or lambda-info
    276 ;
    277 (define-inline (%generic-byteblock? x) (and (%block? x) (%byteblock? x)))
    278 
    279 
    280 ;; String (byteblock)
    281 
    282 (define-inline (%make-string size fill) (%make-block-byte size fill #f))
    283 
    284 (define-inline (%string? x) (and (%block? x) (%string-type? x)))
    285 
    286 (define-inline (%string-ref s i) (##core#inline "C_subchar" s i))
    287 
    288 (define-inline (%string-set! s i c) (##core#inline "C_setsubchar" s i c))
    289 
    290 (define-inline (%string-length s) (%block-size s))
    291 
    292 ;%bytevector->string - see Bytevector
    293 
    294 
    295 ;; Flonum (byteblock)
    296 
    297 (define-inline (%flonum? x) (and (%block? x) (%flonum-type? x)))
    298 
    299 
    300 ;; Lambda-info (byteblock)
    301 
    302 (define-inline (%lambda-info? x) (and (%block? x) (%lambda-info-type? x)))
    303 
    304 
    305 ;; Generic-vector
    306 
    307 ; generic-vector isa vector, pair, structure, symbol, or keyword
    308 ;
    309 (define-inline (%generic-vector? x)
    310   (and (%block? x)
    311        (not (or (%special? x) (%byteblock? x)))) )
    312 
    313 
    314 ;; Vector (wordblock)
    315 
    316 (define-inline (%make-vector size fill) (%make-word-block size fill #f))
    317 
    318 (define-inline (%vector? x) (and (%block? x) (%vector-type? x)))
    319 
    320 (define-inline (%vector-ref v i) (%block-word-ref v i))
    321 
    322 (define-inline (%vector-set! v i x) (%block-word-set! v i x))
    323 (define-inline (%vector-set!/immediate v i x) (%block-word-set!/immediate v i x))
    324 
    325 (define-inline (%vector-length v) (%block-size v))
    326 
    327 
    328 ;; Bytevector (wordblock, but byte referenced)
     359;Safe
     360
     361; generic-byteblock isa bytevector, string, flonum, or lambda-info
     362(define-inline (%generic-byteblock? x)
     363  (or (%bytevector? x) (%string? x) (%flonum? x) (%lambda-info? x)) )
     364
     365;; Bytevector (byteblock)
     366
     367;Safe
    329368
    330369(define-inline (%make-bytevector sz)
    331   (let ([bv (%make-string sz #f #t)])
     370  (let ((bv (%make-byteblock sz #f #t)))
    332371    (##core#inline "C_string_to_bytevector" bv)
    333372    bv ) )
    334373
    335 (define-inline (%bytevector? x) (and (%block? x) (%bytevector-type? x)))
    336 
    337 (define-inline (%bytevector-ref bv i) (%block-byte-ref bv i))
    338 
    339 (define-inline (%bytevector-set! bv i x) (%block-byte-set! bv i x))
    340 
    341 (define-inline (%bytevector-length bv) (%block-size bv))
    342 
    343 (define-inline (%bytevector=? v1 v2)
    344   (let ([ln (%bytevector-length v1)])
    345     (and (%eq? n %bytevector-length v2))
    346          (fx=? 0 (##core#inline "C_string_compare" v1 v2 n)) ) )
    347 
    348374(define-inline (%string->bytevector s)
    349   (let* ([n (%string-length s)]
    350                [bv (%make-bytevector sz)] )
    351     (##core#inline "C_copy_memory" bv s n) 
     375  (let* ((n (%byteblock-length s) #;(%string-size s))
     376               (bv (%make-bytevector sz)) )
     377    (##core#inline "C_copy_memory" bv s n)
    352378    bv ) )
    353379
     380;Unsafe
     381
     382(define-inline (%bytevector-length bv) (%byteblock-length bv))
     383
     384(define-inline (%bytevector=? bv1 bv2)
     385  (let ((n (%bytevector-length bv1)))
     386    (and (%fx= n (%bytevector-length bv2))
     387         (%fx= 0 (##core#inline "C_string_compare" bv1 bv2 n)) ) ) )
     388
     389(define-inline (%bytevector-ref bv i) (%byteblock-ref bv i))
     390
     391(define-inline (%bytevector-set! bv i x) (%byteblock-set! bv i x))
     392
     393;; Blob (isa bytevector w/o accessors)
     394
     395(define-inline (%make-blob sz) (%make-bytevector sz))
     396
     397(define-inline (%string->blob s) (%string->bytevector s))
     398
     399(define-inline (%blob? x) (%bytevector? x))
     400
     401(define-inline (%blob-size b) (%bytevector-length b))
     402
     403(define-inline (%blob=? b1 b2) (%bytevector=? b1 b2))
     404
     405;; String (byteblock)
     406
     407;Safe
     408
     409(define-inline (%make-string size fill) (%make-byteblock size fill #f))
     410
     411;Unsafe
     412
    354413(define-inline (%bytevector->string bv)
    355   (let* ([n (%bytevector-length bv)]
    356                [s (%make-string n #\space)] )
    357     (##core#inline "C_copy_memory" s bv n) 
     414  (let* ((n (%bytevector-length bv))
     415               (s (%make-string n #\space)) )
     416    (##core#inline "C_copy_memory" s bv n)
    358417    s ) )
    359418
    360 
    361 ;; Blob (isa bytevector w/o accessors)
    362 
    363 (define-inline (%make-blob sz) (%make-bytevector sz))
    364 
    365 (define-inline (%blob? x) (%bytevector? x))
    366 
    367 (define-inline (%blob-size b) (%bytevector-length b))
    368 
    369 (define-inline (%blob=? b1 b2) (%bytevector=? b1 b2))
    370 
    371 (define-inline (%string->blob s) (%string->bytevector s))
    372 
    373419(define-inline (%blob->string bv) (%bytevector->string bv))
    374420
     421(define-inline (%lambda-info->string li)
     422  (let* ((sz (%byteblock-length li) #;(%lambda-info-length li))
     423         (s (%make-string sz #\space)) )
     424    (##core#inline "C_copy_memory" s li sz)
     425    s ) )
     426
     427(define-inline (%string-size s) (%byteblock-length s))
     428(define-inline (%string-length s) (%byteblock-length s))
     429
     430(define-inline (%string-ref s i) (##core#inline "C_subchar" s i))
     431
     432(define-inline (%string-set! s i c) (##core#inline "C_setsubchar" s i c))
     433
     434(define-inline (%string-compare/length s1 s2 l) (##core#inline "C_string_compare" s1 s2 l))
     435
     436(define-inline (%string-compare s1 s2)
     437  (let* ((l1 (%string-length s1))
     438         (l2 (%string-length s2))
     439         (d (%fx- l1 l2))
     440         (r (%string-compare/length s1 s2 (if (%fxpositive? d) l2 l1))) )
     441    (if (%fxzero? r) d
     442        r ) ) )
     443
     444(define-inline (%string=? s1 s2) (%fxzero? (%string-compare s1 s2)))
     445(define-inline (%string<? s1 s2) (%fxnegative? (%string-compare s1 s2)))
     446(define-inline (%string>? s1 s2) (%fxpositive? (%string-compare s1 s2)))
     447(define-inline (%string<=? s1 s2) (%fx<= 0 (%string-compare s1 s2)))
     448(define-inline (%string>=? s1 s2) (%fx>= 0 (%string-compare s1 s2)))
     449
     450(define-inline (%string-ci-compare/length s1 s2 l) (##core#inline "C_string_compare_case_insensitive" s1 s2 l))
     451
     452(define-inline (%string-ci-compare s1 s2)
     453  (let* ((l1 (%string-length s1))
     454         (l2 (%string-length s2))
     455         (d (%fx- l1 l2))
     456         (r (%string-ci-compare/length s1 s2 (if (%fxpositive? d) l2 l1))) )
     457    (if (%fxzero? r) d
     458        r ) ) )
     459
     460(define-inline (%string-ci=? s1 s2) (%fxzero? (%string-ci-compare s1 s2)))
     461(define-inline (%string-ci<? s1 s2) (%fxnegative? (%string-ci-compare s1 s2)))
     462(define-inline (%string-ci>? s1 s2) (%fxpositive? (%string-ci-compare s1 s2)))
     463(define-inline (%string-ci<=? s1 s2) (%fx<= 0 (%string-ci-compare s1 s2)))
     464(define-inline (%string-ci>=? s1 s2) (%fx>= 0 (%string-ci-compare s1 s2)))
     465
     466;; Flonum (byteblock)
     467
     468;Unsafe
     469
     470(define-inline (%fp= x y) (##core#inline "C_flonum_equalp" x y))
     471(define-inline (%fp< x y) (##core#inline "C_flonum_lessp" x y))
     472(define-inline (%fp<= x y) (##core#inline "C_flonum_less_or_equal_p" x y))
     473(define-inline (%fp> x y) (##core#inline "C_flonum_greaterp" x y))
     474(define-inline (%fp>= x y) (##core#inline "C_flonum_greater_or_equal_p" x y))
     475
     476(define-inline (%fpmax x y) (##core#inline "C_i_flonum_max" x y))
     477(define-inline (%fpmin x y) (##core#inline "C_i_flonum_min" x y))
     478
     479(define-inline (%finite? x) (##core#inline "C_i_finitep" x))
     480
     481(define-inline (%fp- x y) (##core#inline_allocate ("C_a_i_flonum_difference" 4) x y))
     482(define-inline (%fp* x y) (##core#inline_allocate ("C_a_i_flonum_times" 4) x y))
     483(define-inline (%fp/ x y) (##core#inline_allocate ("C_a_i_flonum_quotient" 4) x y))
     484(define-inline (%fp+ x y) (##core#inline_allocate ("C_a_i_flonum_plus" 4) x y))
     485
     486(define-inline (%fpfraction x) ((##core#primitive "C_flonum_fraction") x))
     487
     488(define-inline (%fpnegate x) (##core#inline_allocate ("C_a_i_flonum_negate" 4) x))
     489
     490(define-inline (%fpfloor x) ((##core#primitive "C_flonum_floor") x))
     491(define-inline (%fpceiling x) ((##core#primitive "C_flonum_ceiling") x))
     492(define-inline (%fpround x) ((##core#primitive "C_flonum_round") x))
     493(define-inline (%fptruncate x) ((##core#primitive "C_flonum_truncate") x))
     494
     495;Safe
     496
     497(define-inline (%exact->inexact x) ((##core#primitive "C_exact_to_inexact") x))
     498
     499; Actually 'number' operations
     500(define-inline (%fpabs x) (##core#inline_allocate ("C_a_i_abs" 4) x))
     501(define-inline (%fpacos x) (##core#inline_allocate ("C_a_i_acos" 4) x))
     502(define-inline (%fpasin x) (##core#inline_allocate ("C_a_i_asin" 4) x))
     503(define-inline (%fpatan x) (##core#inline_allocate ("C_a_i_atan" 4) x))
     504(define-inline (%fpatan2 x y) (##core#inline_allocate ("C_a_i_atan2" 4) x y))
     505(define-inline (%fpcos x) (##core#inline_allocate ("C_a_i_cos" 4) x))
     506(define-inline (%fpexp x) (##core#inline_allocate ("C_a_i_exp" 4) x))
     507(define-inline (%fplog x) (##core#inline_allocate ("C_a_i_log" 4) x))
     508(define-inline (%fpsin x) (##core#inline_allocate ("C_a_i_sin" 4) x))
     509(define-inline (%fpsqrt x) (##core#inline_allocate ("C_a_i_sqrt" 4) x))
     510(define-inline (%fptan x) (##core#inline_allocate ("C_a_i_tan" 4) x))
     511
     512;; Lambda-info (byteblock)
     513
     514;Unsafe
     515
     516(define-inline (%string->lambda-info s)
     517  (let* ((n (%string-size s))
     518               (li (%make-string n)) )
     519    (##core#inline "C_copy_memory" li s n)
     520    (##core#inline "C_string_to_lambdainfo" li)
     521    li ) )
     522
     523(define-inline (%lambda-info-length li) (%byteblock-length s))
     524
     525;; Wordblock
     526
     527;Safe
     528
     529(define-inline (%make-wordblock n f a?) (%block-allocate n #f f a?))
     530
     531;Unsafe
     532
     533(define-inline (%wordblock-length wb) (%block-size wb))
     534
     535(define-inline (%wordblock-ref wb i) (##core#inline "C_slot" wb i))
     536
     537(define-inline (%wordblock-set!/mutate wb i v) (##core#inline "C_i_setslot" wb i v))
     538(define-inline (%wordblock-set!/immediate wb i v) (##core#inline "C_i_set_i_slot" wb i v))
     539(define-inline (%wordblock-set! wb i v)
     540  (if (%immediate? v) (%wordblock-set!/immediate wb i v)
     541      (%wordblock-set!/mutate wb i v) ) )
     542
     543;; Generic-vector (wordblock)
     544
     545; generic-vector isa vector, pair, structure, symbol, or keyword
     546(define-inline (%generic-vector? x) (and (%block? x) (not (or (%special? x) (%byteblock? x)))))
     547
     548;; Vector (wordblock)
     549
     550;Safe
     551
     552(define-inline (%make-vector size fill) (%make-wordblock size fill #f))
     553
     554;Unsafe
     555
     556(define-inline (%vector-length v) (%wordblock-length v))
     557
     558(define-inline (%vector-ref v i) (%wordblock-ref v i))
     559
     560(define-inline (%vector-set!/mutate v i x) (%wordblock-set!/mutate v i x))
     561(define-inline (%vector-set!/immediate v i x) (%wordblock-set!/immediate v i x))
     562(define-inline (%vector-set! v i x) (%wordblock-set! v i x))
    375563
    376564;; Pair (wordblock)
    377565
    378 (define-inline (%pair? x) (and (%block? x) (%pair-type? x)))
     566;Safe
     567
     568(define-inline (%null? x) (%eol-object? x))
    379569
    380570(define-inline (%list? x) (or (%null? x) (%pair? x)))
     
    382572(define-inline (%cons x y) (##core#inline_allocate ("C_a_i_cons" 3) x y) )
    383573
    384 (define-inline (%length l) (##core#inline "C_i_length" l))
    385 
    386 (define-inline (%car p) (%block-word-ref p 0))
    387 (define-inline (%cdr p) (%block-word-ref p 1))
    388 
    389 (define-inline (%caar p) (%car (%car p)))
    390 (define-inline (%cadr p) (%car (%cdr p)))
    391 (define-inline (%cdar p) (%cdr (%car p)))
    392 (define-inline (%cddr p) (%cdr (%cdr p)))
    393 
    394 (define-inline (%caaar p) (%car (%caar p)))
    395 (define-inline (%caadr p) (%car (%cadr p)))
    396 (define-inline (%cadar p) (%car (%cdar p)))
    397 (define-inline (%caddr p) (%car (%cddr p)))
    398 (define-inline (%cdaar p) (%cdr (%caar p)))
    399 (define-inline (%cdadr p) (%cdr (%cadr p)))
    400 (define-inline (%cddar p) (%cdr (%cdar p)))
    401 (define-inline (%cdddr p) (%cdr (%cddr p)))
    402 
    403 (define-inline (%set-car! p x) (%block-word-set! p 0 x))
    404 (define-inline (%set-cdr! p x) (%block-word-set! p 1 x))
    405 (define-inline (%set-car/immediate! p x) (%block-word-set!/immediate p 0 x))
    406 (define-inline (%set-cdr/immediate! p x) (%block-word-set!/immediate p 1 x))
    407 
    408 ;; l0 must be a proper-list
    409 
    410 (define-inline (%list-ref l0 i0)
    411   (let loop ([l l0] [i i0])
    412     (cond [(null? l)
    413            '() ]
    414                 [(%fx= 0 i)
    415                  (%car l) ]
    416                 [else
    417                  (loop (%cdr l) (%fx- i 1)) ] ) ) )
    418 
    419 ; l0 cannot be null
    420 (define-inline (%last-pair l0)
    421   (do ([l l0 (%cdr l)])
    422       [(%null? (%cdr l)) l]) )
    423 
    424 (define-inline (%delq! x l0)
    425   (let loop ([l l0] [pp #f])
    426     (cond [(null? l)
    427            l0 ]
    428                 [(%eq? x (%car l))
    429                  (cond [pp
    430                         (%set-cdr! pp (%cdr l))
    431                         l0 ]
    432                        [else
    433                         (%cdr l) ] ) ]
    434                 [else
    435                  (loop (%cdr l) l) ] ) ) )
    436 
    437 ;; These are safe
    438 
    439 (define-inline (%memq x l) (##core#inline "C_i_memq" x l))
    440 (define-inline (%memv x l) (##core#inline "C_i_memv" x l))
    441 (define-inline (%member x l) (##core#inline "C_i_member" x l))
    442 
    443 (define-inline (%assq x l) (##core#inline "C_i_assq" x l))
    444 (define-inline (%assv x l) (##core#inline "C_i_assv" x l))
    445 (define-inline (%assoc x l) (##core#inline "C_i_assoc" x l))
    446 
     574(define-inline (%length ls) (##core#inline "C_i_length" ls))
     575
     576;Unsafe
     577
     578(define-inline (%car pr) (%wordblock-ref pr 0))
     579
     580(define-inline (%set-car!/mutate pr x) (%wordblock-set!/mutate pr 0 x))
     581(define-inline (%set-car!/immediate pr x) (%wordblock-set!/immediate pr 0 x))
     582(define-inline (%set-car! pr x) (%wordblock-set! pr 0 x))
     583
     584(define-inline (%cdr pr) (%wordblock-ref pr 1))
     585
     586(define-inline (%set-cdr!/mutate pr x) (%wordblock-set!/mutate pr 1 x))
     587(define-inline (%set-cdr!/immediate pr x) (%wordblock-set!/immediate pr 1 x))
     588(define-inline (%set-cdr! pr x) (%wordblock-set! pr 1 x))
     589
     590(define-inline (%caar pr) (%car (%car pr)))
     591(define-inline (%cadr pr) (%car (%cdr pr)))
     592(define-inline (%cdar pr) (%cdr (%car pr)))
     593(define-inline (%cddr pr) (%cdr (%cdr pr)))
     594
     595(define-inline (%caaar pr) (%car (%caar pr)))
     596(define-inline (%caadr pr) (%car (%cadr pr)))
     597(define-inline (%cadar pr) (%car (%cdar pr)))
     598(define-inline (%caddr pr) (%car (%cddr pr)))
     599(define-inline (%cdaar pr) (%cdr (%caar pr)))
     600(define-inline (%cdadr pr) (%cdr (%cadr pr)))
     601(define-inline (%cddar pr) (%cdr (%cdar pr)))
     602(define-inline (%cdddr pr) (%cdr (%cddr pr)))
     603
     604;Safe
     605
     606(define-inline (%memq x ls) (##core#inline "C_i_memq" x ls))
     607(define-inline (%memv x ls) (##core#inline "C_i_memv" x ls))
     608(define-inline (%member x ls) (##core#inline "C_i_member" x ls))
     609
     610(define-inline (%assq x ls) (##core#inline "C_i_assq" x ls))
     611(define-inline (%assv x ls) (##core#inline "C_i_assv" x ls))
     612(define-inline (%assoc x ls) (##core#inline "C_i_assoc" x ls))
     613
     614;Unsafe
     615
     616(define-inline (%list-ref ls0 i0)
     617  ;(assert (and (proper-list? ls0) (exact? i0) (<= 0 i0 (sub1 (length ls0)))))
     618  (let loop ((ls ls0) (i i0))
     619    (cond ((%null? ls)  '() )
     620                ((%fx= 0 i)   (%car ls) )
     621                (else         (loop (%cdr ls) (%fx- i 1)) ) ) ) )
     622
     623(define-inline (%list-pair-ref ls0 i0)
     624  ;(assert (and (proper-list? ls0) (exact? i0) (<= 0 i0 (sub1 (length ls0)))))
     625  (let loop ((ls ls0) (i i0))
     626    (cond ((%null? ls)  '() )
     627                ((%fx= 0 i)   ls )
     628                (else         (loop (%cdr ls) (%fx- i 1)) ) ) ) )
     629
     630(define-inline (%last-pair ls0)
     631  ;(assert (and (proper-list? ls0) (pair? ls0)))
     632  (do ((ls ls0 (%cdr ls)))
     633      ((%null? (%cdr ls)) ls)) )
     634
     635(define-inline (%list-copy ls0)
     636  ;(assert (proper-list? ls0))
     637  (let copy-rest ((ls ls0))
     638    (if (%null? ls) '()
     639        (%cons (%car ls) (copy-rest (%cdr ls))) ) ) )
     640
     641(define-inline (%append! . lss)
     642  ;(assert (and (proper-list? lss) (for-each (cut proper-list? <>) lss)))
     643  (let ((lss (let position-at-first-pair ((lss lss))
     644               (cond ((%null? lss)        '() )
     645                     ((%null? (%car lss))  (position-at-first-pair (%cdr lss)) )
     646                     (else                 lss ) ) ) ) )
     647    (if (%null? lss) '()
     648        (let ((ls0 (%car lss)))
     649          ;(assert (pair? ls0))
     650          (let append!-rest ((lss (%cdr lss)) (pls ls0))
     651            (if (%null? lss) ls0
     652                (let ((ls (%car lss)))
     653                  (cond ((%null? ls)
     654                         (append!-rest (%cdr lss) pls) )
     655                        (else
     656                         (%set-cdr!/mutate (%last-pair pls) ls)
     657                         (append!-rest (%cdr lss) ls) ) ) ) ) ) ) ) ) )
     658
     659(define-inline (%delq! x ls0)
     660  ;(assert (proper-list? ls0))
     661  (let find-elm ((ls ls0) (ppr #f))
     662    (cond ((%null? ls)
     663           ls0 )
     664                ((%eq? x (%car ls))
     665                 (cond (ppr
     666                        (%set-cdr! ppr (%cdr ls))
     667                        ls0 )
     668                       (else
     669                        (%cdr ls) ) ) )
     670                (else
     671                 (find-elm (%cdr ls) ls) ) ) ) )
     672
     673(define-inline (%list-fold-1 func init ls0)
     674  ;(assert (and (proper-list? ls0) (procedure? func)))
     675  (let loop ((ls ls0) (acc init))
     676    (if (%null? ls) acc
     677        (loop (%cdr ls) (func (%car ls) acc)) ) ) )
     678
     679(define-inline (%list-map-1 func ls0)
     680  ;(assert (and (proper-list? ls0) (procedure? func)))
     681  (let loop ((ls ls0))
     682    (if (%null? ls) '()
     683        (%cons (func (%car ls)) (loop (%cdr ls))) ) ) )
     684
     685(define-inline (%list-for-each-1 proc ls0)
     686  ;(assert (and (proper-list? ls0) (procedure? proc)))
     687  (let loop ((ls ls0))
     688    (unless (%null? ls)
     689      (proc (%car ls))
     690      (loop (%cdr ls)) ) ) )
    447691
    448692;; Structure (wordblock)
    449693
    450 ;; (%make-structure tag fill)
    451 ;;
    452 
    453 ; (%make-structure TAG [SLOT ...])
    454 (define-inline %make-structure (##core#primitive "C_make_structure"))
    455 
    456 (define-inline (%generic-structure? x) (and (%block? x) (%structure-type? x)))
     694(define-inline (%make-structure t . s) (apply (##core#primitive "C_make_structure") t s))
    457695
    458696(define-inline (%structure-instance? x s) (##core#inline "C_i_structurep" x s))
    459697
    460 (cond-expand
    461   [hygienic-macros
    462     (define-syntax %structure?
    463       (syntax-rules ()
    464         [(_ ?x)     (%generic-structure? ?x)]
    465         [(_ ?x ?t)  (%structure-instance? ?x ?t)] ) ) ]
    466   [else
    467     (define-macro (%structure? ?x . ?t)
    468       (if (%null? ?t)
    469           `(%generic-structure? ,?x)
    470           `(%structure-instance? ,?x ,(car ?t)) ) ) ] )
    471 
    472 (define-inline (%structure-ref r i) (%block-word-ref r i))
    473 
    474 (define-inline (%structure-set! r i x) (%block-word-set! r i x))
    475 (define-inline (%structure-set!/immediate r i x) (%block-word-set!/immediate r i x))
    476 
    477 (define-inline (%structure-length r) (%block-size r))
    478 
    479 (define-inline (%structure-tag r) (%block-word-ref r 0))
    480 
    481 
    482 ;; Special-block (wordblock)
    483 
    484 (define-inline (%special-block? x) (and (%block? x) (%special? x)))
    485 
     698(define-inline (%structure-length r) (%wordblock-length r))
     699
     700(define-inline (%structure-tag r) (%wordblock-ref r 0))
     701
     702(define-inline (%structure-ref r i) (%wordblock-ref r i))
     703
     704(define-inline (%structure-set!/mutate r i x) (%wordblock-set!/mutate r i x))
     705(define-inline (%structure-set!/immediate r i x) (%wordblock-set!/immediate r i x))
     706(define-inline (%structure-set! r i x) (%wordblock-set! r i x))
    486707
    487708;; Port (wordblock)
     
    489710; Port layout:
    490711;
    491 ; 0       FP (special - C FILE *)
     712; 0       FP (special - FILE *)
    492713; 1       input/output (bool)
    493714; 2       class (vector, see Port-class)
     
    501722; 10-15  reserved, port class specific
    502723
    503 ; port is 16 slots + a block-header word
    504 ;
    505 ;(define-inline (%make-port n) (##core#inline_allocate ("C_a_i_port" 17)))
    506 
    507 (define-inline (%port? x) (and (%block? x) (%port-type? x)))
    508 
    509724(define-inline (%port-filep port) (%peek-unsigned-integer port 0))
    510 (define-inline (%port-input-mode? port) (%block-word-ref? port 1))
    511 (define-inline (%port-class port) (%block-word-ref? port 2))
    512 (define-inline (%port-name port) (%block-word-ref? port 3))
    513 (define-inline (%port-row port) (%block-word-ref? port 4))
    514 (define-inline (%port-column port) (%block-word-ref? port 5))
    515 (define-inline (%port-eof? port) (%block-word-ref? port 6))
    516 (define-inline (%port-type port) (%block-word-ref? port 7))
    517 (define-inline (%port-closed? port) (%block-word-ref? port 8))
    518 (define-inline (%port-data port) (%block-word-ref? port 9))
     725(define-inline (%port-input-mode? port) (%wordblock-ref? port 1))
     726(define-inline (%port-class port) (%wordblock-ref? port 2))
     727(define-inline (%port-name port) (%wordblock-ref? port 3))
     728(define-inline (%port-row port) (%wordblock-ref? port 4))
     729(define-inline (%port-column port) (%wordblock-ref? port 5))
     730(define-inline (%port-eof? port) (%wordblock-ref? port 6))
     731(define-inline (%port-type port) (%wordblock-ref? port 7))
     732(define-inline (%port-closed? port) (%wordblock-ref? port 8))
     733(define-inline (%port-data port) (%wordblock-ref? port 9))
    519734
    520735(define-inline (%port-filep-set! port fp) (%poke-integer port 0 fp))
    521 (define-inline (%port-input-mode-set! port f) (%block-word-set!/immediate port 1 f))
    522 (define-inline (%port-class port v) (%block-word-set! port 2 v))
    523 (define-inline (%port-name-set! port s) (%block-word-set! port 3 s))
    524 (define-inline (%port-row-set! port n) (%block-word-set!/immediate port 4 n))
    525 (define-inline (%port-column-set! port n) (%block-word-set!/immediate port 5 n))
    526 (define-inline (%port-eof-set! port f) (%block-word-set!/immediate port 6 f))
    527 (define-inline (%port-type-set! port s) (%block-word-set! port 7 s))
    528 (define-inline (%port-closed-set! port f) (%block-word-set!/immediate port 8 f))
    529 (define-inline (%port-data-set! port port) (%block-word-set! port 9 x))
    530 
    531 ; Port-class layout     
     736(define-inline (%port-input-mode-set! port f) (%wordblock-set!/immediate port 1 f))
     737(define-inline (%port-class-set! port v) (%wordblock-set!/mutate port 2 v))
     738(define-inline (%port-name-set! port s) (%wordblock-set!/mutate port 3 s))
     739(define-inline (%port-row-set! port n) (%wordblock-set!/immediate port 4 n))
     740(define-inline (%port-column-set! port n) (%wordblock-set!/immediate port 5 n))
     741(define-inline (%port-eof-set! port f) (%wordblock-set!/immediate port 6 f))
     742(define-inline (%port-type-set! port s) (%wordblock-set!/mutate port 7 s))
     743(define-inline (%port-closed-set! port f) (%wordblock-set!/immediate port 8 f))
     744(define-inline (%port-data-set! port x) (%wordblock-set!/mutate port 9 x))
     745
     746(define-inline (%make-port i/o class name type)
     747  ; port is 16 slots + a block-header word
     748  (let ((port (##core#inline_allocate ("C_a_i_port" 17))))
     749    (%port-input-mode-set! port i/o)
     750    (%port-class-set! port class)
     751    (%port-name-set! port name)
     752    (%port-row-set! port 1)
     753    (%port-column-set! port 0)
     754    (%port-type-set! port type)
     755    port ) )
     756
     757; Port-class layout
    532758;
    533759; 0       (read-char PORT) -> CHAR | EOF
     
    541767; 8       (read-line PORT LIMIT) -> STRING | EOF
    542768
     769(define-inline (%make-port-class rc pc wc ws cl fl cr rs rl)
     770  (let ((class (%make-vector 9 #f)))
     771    (%vector-set! class 0 rc)
     772    (%vector-set! class 1 pc)
     773    (%vector-set! class 2 wc)
     774    (%vector-set! class 3 ws)
     775    (%vector-set! class 4 cl)
     776    (%vector-set! class 5 fl)
     777    (%vector-set! class 6 cr)
     778    (%vector-set! class 7 rs)
     779    (%vector-set! class 8 rl)
     780    class ) )
     781
     782(define-inline (%port-class-read-char-ref c) (%vector-ref c 0))
     783(define-inline (%port-class-peek-char-ref c) (%vector-ref c 1))
     784(define-inline (%port-class-write-char-ref c) (%vector-ref c 2))
     785(define-inline (%port-class-write-string-ref c) (%vector-ref c 3))
     786(define-inline (%port-class-close-ref c) (%vector-ref c 4))
     787(define-inline (%port-class-flush-output-ref c) (%vector-ref c 5))
     788(define-inline (%port-class-char-ready-ref c) (%vector-ref c 6))
     789(define-inline (%port-class-read-string-ref c) (%vector-ref c 7))
     790(define-inline (%port-class-read-line-ref c) (%vector-ref c 8))
     791
     792(define-inline (%port-class-read-char c p) ((%port-class-read-char-ref c) p) )
     793(define-inline (%port-class-peek-char c p) ((%port-class-peek-char-ref c) p))
     794(define-inline (%port-class-write-char c p c) ((%port-class-write-char-ref c) p c))
     795(define-inline (%port-class-write-string c p s) ((%port-class-write-string-ref c) p s))
     796(define-inline (%port-class-close c p) ((%port-class-close-ref c) p))
     797(define-inline (%port-class-flush-output c p) ((%port-class-flush-output-ref c) p))
     798(define-inline (%port-class-char-ready? c p) ((%port-class-char-ready-ref c) p))
     799(define-inline (%port-class-read-string! c p n d s) ((%port-class-read-string-ref c) p n d s))
     800(define-inline (%port-class-read-line c p l) ((%port-class-read-line-ref c) p l))
     801
     802(define-inline (%port-read-char p) ((%port-class-read-char-ref (%port-class p)) p) )
     803(define-inline (%port-peek-char p) ((%port-class-peek-char-ref (%port-class p)) p))
     804(define-inline (%port-write-char p c) ((%port-class-write-char-ref (%port-class p)) p c))
     805(define-inline (%port-write-string p s) ((%port-class-write-string-ref (%port-class p)) p s))
     806(define-inline (%port-close p) ((%port-class-close-ref (%port-class p)) p))
     807(define-inline (%port-flush-output p) ((%port-class-flush-output-ref (%port-class p)) p))
     808(define-inline (%port-char-ready? p) ((%port-class-char-ready-ref (%port-class p)) p))
     809(define-inline (%port-read-string! p n d s) ((%port-class-read-string-ref (%port-class p)) p n d s))
     810(define-inline (%port-read-line p l) ((%port-class-read-line-ref (%port-class p)) p l))
    543811
    544812;; Closure (wordblock)
    545813
    546 (define-inline (%closure? x) (and (%block? x) (%closure-type? x)))
    547 
    548 (define-inline (%closure-size c) (%block-size? c))
     814;Unsafe
     815
     816(define-inline (%make-closure! n)
     817  (let ((v (%make-vector n)))
     818    (##core#inline "C_vector_to_closure" v)
     819    v ) )
    549820
    550821(define-inline (%vector->closure! v a)
     
    552823  (##core#inline "C_update_pointer" a v) )
    553824
     825(define-inline (%closure-length c) (%wordblock-length? c))
     826
     827(define-inline (%closure-ref c i) (%wordblock-ref c i))
     828
     829(define-inline (%closure-set! c i v) (%wordblock-set! c i v))
     830
     831(define-inline (%closure-copy tc fc l)
     832  (do ((i 1 (%fxadd1 i)))
     833      ((%fx>= i l))
     834    (%closure-set! tc i (%closure-ref fc i)) ) )
     835
     836(define-inline (%closure-decoration c test)
     837  (let find-decor ((i (%fxsub1 (%closure-length c))))
     838    (and (%fxpositive? i)
     839         (let ((x (%closure-ref c i)))
     840           (if (test x) x
     841               (find-decor (%fxsub1 i)) ) ) ) ) )
     842
     843(define-inline (%closure-decorate! c test dcor)
     844  (let ((l (%closure-length c)))
     845    (let find-decor ((i (%fxsub l)))
     846      (cond ((%fxzero? i)
     847             (let ((nc (%make-closure (%fxadd1 l))))
     848               (%closure-copy nc c l)
     849               (##core#inline "C_copy_pointer" c nc)
     850               (dcor nc i) ) )
     851            (else
     852             (let ((x (%closure-ref c i)))
     853               (if (test x) (dcor c i)
     854                   (find-decor (%fxsub i)) ) ) ) ) ) ) )
     855
     856(define-inline (%closure-lambda-info c)
     857  (%closure-decoration c (lambda (x) (%lambda-info? x))) )
    554858
    555859;; Symbol (wordblock)
    556860
    557 (define-inline (%symbol? x) (and (%block? x) (%symbol-type? x)))
    558 
    559 (define-inline (%symbol-binding s) (%block-word-ref s 0))
    560 (define-inline (%symbol-string s) (%block-word-ref s 1))
    561 (define-inline (%symbol-bucket s) (%block-word-ref s 2))
    562 
    563 (define-inline %string->symbol-interned (##core#primitive "C_string_to_symbol"))
    564 
    565 ;(define-inline (%symbol-intern! s) (%string->symbol (%symbol-string s)))
     861;Unsafe
     862
     863(define-inline (%symbol-binding s) (%wordblock-ref s 0))
     864(define-inline (%symbol-string s) (%wordblock-ref s 1))
     865(define-inline (%symbol-bucket s) (%wordblock-ref s 2))
     866
     867(define-constant NAMESPACE-MAX-ID-LEN 31)
     868
     869(define-inline (%qualified-symbol? s)
     870  (let ((str (%symbol-string s)))
     871    (and (%fxpositive? (%string-size str))
     872         (%fx<= (%byteblock-ref str 0) NAMESPACE-MAX-ID-LEN) ) ) )
     873
     874;Safe
     875
     876(define-inline (%string->symbol-interned s) ((##core#primitive "C_string_to_symbol") s))
    566877
    567878(define-inline (%symbol-interned? x) (##core#inline "C_lookup_symbol" x))
     
    569880(define-inline (%symbol-bound? s) (##core#inline "C_boundp" s))
    570881
    571 
    572882;; Keyword (wordblock)
    573883
    574 (define-inline (%keyword? x)
    575   (and (%symbol? x)
    576        (%eq? 0 (%block-byte-ref (%symbol-string x) 0)) ) )
    577 
     884(define-inline (%keyword? x) (and (%symbol? x) (%fxzero? (%byteblock-ref (%symbol-string x) 0))))
     885
     886;; Pointer (wordblock)
     887
     888; simple-pointer, tagged-pointer, swig-pointer, locative
     889(define-inline (%generic-pointer? x) (or (%pointer? x) (%locative? x)))
     890
     891; simple-pointer, tagged-pointer, swig-pointer, locative, closure, port, symbol, keyword
     892(define-inline (%pointer-like? x) (%wordblock? x))
     893
     894; These operate on pointer-like objects
     895
     896(define-inline (%pointer-null? ptr) (##core#inline "C_null_pointerp" ptr))
     897
     898(define-inline (%pointer-ref ptr) (%wordblock-ref ptr 0))
     899(define-inline (%pointer-set! ptr y) (%wordblock-set!/mutate ptr 0 y))
     900
     901(define-inline (%peek-byte ptr i) (##core#inline "C_peek_byte" ptr i))
     902
     903(define-inline (%pointer->address ptr)
     904  ; Pack pointer address value into Chicken words; '4' is platform dependent!
     905  (##core#inline_allocate ("C_block_address" 4) (%generic-pointer-ref ptr)) )
     906
     907;; Simple-pointer (wordblock)
     908
     909(define-inline (%make-simple-pointer) ((##core#primitive "C_make_pointer")))
     910
     911(define-inline (%make-pointer-null)
     912  (let ((ptr (%make-simple-pointer)))
     913    (##core#inline "C_update_pointer" 0 ptr)
     914    ptr ) )
     915
     916(define-inline (%address->pointer a)
     917  (let ((ptr (%make-simple-pointer)))
     918    (##core#inline "C_update_pointer" a ptr)
     919    ptr ) )
     920
     921(define-inline (%make-block-pointer b)
     922  (let ((ptr (%make-simple-pointer)))
     923    (##core#inline "C_pointer_to_block" ptr b)
     924    ptr ) )
     925
     926;; Tagged-pointer (wordblock)
     927
     928(define-inline (%make-tagged-pointer t) ((##core#primitive "C_make_tagged_pointer") t))
     929
     930;; Swig-pointer (wordblock)
    578931
    579932;; Locative (wordblock)
     
    581934(define-inline (%make-locative typ obj idx weak?)
    582935  (##core#inline_allocate ("C_a_i_make_locative" 5) typ obj idx weak?))
    583 
    584 (define-inline (%locative? x) (and (%block? x) (%locative-type? x)))
    585936
    586937; Locative layout:
     
    601952; 3     Object or #f, if weak (C_word)
    602953
    603 ;%locative-address - see Pointer
    604 (define-inline (%locative-offset lv) (%block-word-ref lv 1))
    605 (define-inline (%locative-type lv) (%block-word-ref lv 2))
    606 (define-inline (%locative-weak? lv) (not (%block-word-ref lv 3)))
    607 (define-inline (%locative-object lv) (%block-word-ref lv 3))
    608 
    609 
    610 ;; Pointer (wordblock)
    611 
    612 (define-inline (%pointer? x) (and (%block? x) (%any-pointer-type? x)))
    613 
    614 ; simple-pointer, tagged-pointer, swig-pointer, locative
    615 (define-inline (%generic-pointer? x) (or (%pointer? x) (%locative? x)))
    616 
    617 ; simple-pointer, tagged-pointer, swig-pointer, locative, closure, port, symbol, keyword
    618 (define-inline (%pointer-like? x) (%special-block? x))
    619 
    620 ; These operate on pointer-like objects
    621 
    622 (define-inline (%pointer-ref ptr) (%block-word-ref ptr 0))
    623 (define-inline (%pointer-set! ptr y) (%block-word-set! ptr 0 y))
    624 
    625 (define-inline (%peek-byte ptr i) (##core#inline "C_peek_byte" ptr i))
    626 
    627 (define-inline (%pointer-null? ptr) (##core#inline "C_null_pointerp" ptr))
    628 
    629 (define-inline (%pointer->address ptr)
    630   ; Pack pointer address value into Chicken words; '4' is platform dependent!
    631   (##core#inline_allocate ("C_block_address" 4) (%generic-pointer-ref x)) )
    632 
    633954(define-inline (%locative-address lv) (%pointer->address lv))
    634955
    635 
    636 ;; Simple-pointer (wordblock)
    637 
    638 (define-inline %make-simple-pointer (##core#primitive "C_make_pointer"))
    639 
    640 (define-inline (%simple-pointer? x) (and (%block? x) (%simple-pointer-type? x)))
    641 
    642 (define-inline (%make-pointer-null)
    643   (let ([ptr (%make-simple-pointer)])
    644     (##core#inline "C_update_pointer" 0 ptr)
    645     ptr ) )
    646 
    647 (define-inline (%address->pointer a)
    648   (let ([ptr (%make-simple-pointer)])
    649     (##core#inline "C_update_pointer" a ptr)
    650     ptr ) )
    651 
    652 (define-inline (%make-pointer-block b)
    653   (let ([ptr (%make-simple-pointer)])
    654     (##core#inline "C_pointer_to_block" ptr b)
    655     ptr ) )
    656 
    657 
    658 ;; Tagged-pointer (wordblock)
    659 
    660 (define-inline %make-tagged-pointer (##core#primitive "C_make_tagged_pointer"))
    661 
    662 (define-inline (%tagged-pointer? x) (and (%block? x) (%tagged-pointer-type? x)))
    663 
    664 
    665 ;; Swig-pointer (wordblock)
    666 
    667 (define-inline (%swig-pointer? x) (and (%block? x) (%swig-pointer-type? x)))
    668 
    669 
    670 
    671 ;;; Values
    672 
    673 
     956(define-inline (%locative-offset lv) (%wordblock-ref lv 1))
     957(define-inline (%locative-type lv) (%wordblock-ref lv 2))
     958(define-inline (%locative-weak? lv) (not (%wordblock-ref lv 3)))
     959(define-inline (%locative-object lv) (%wordblock-ref lv 3))
     960
     961;; Numbers
     962
     963;Safe
     964
     965(define-inline (%number? x) (or (%fixnum? x) (%flonum? x)))
     966(define-inline (%integer? x) (##core#inline "C_i_integerp" x))
     967
     968(define-inline (%= x y) ((##core#primitive "C_i_eqvp") x y))
     969(define-inline (%< x y) ((##core#primitive "C_i_lessp") x y))
     970(define-inline (%<= x y) ((##core#primitive "C_i_less_or_equalp") x y))
     971(define-inline (%> x y) ((##core#primitive "C_i_greaterp") x y))
     972(define-inline (%>= x y) ((##core#primitive "C_i_greater_or_equalp") x y))
     973
     974(define-inline (%zero? n) (##core#inline "C_i_zerop" n))
     975(define-inline (%positive? n) (##core#inline "C_i_positivep" n))
     976(define-inline (%negative? n) (##core#inline "C_i_negativep" n))
     977(define-inline (%cardinal? n) (and (%integer? n) (%<= 0 n)))
     978(define-inline (%odd? n) (##core#inline "C_i_oddp" n))
     979(define-inline (%even? n) (##core#inline "C_i_evenp" n))
     980
     981(define-inline (%+ x y) ((##core#primitive "C_plus") x y))
     982(define-inline (%- x y) ((##core#primitive "C_minus") x y))
     983(define-inline (%* x y) ((##core#primitive "C_times") x y))
     984(define-inline (%/ x y) ((##core#primitive "C_divide") x y))
     985
     986(define-inline (%add1 x) (%+ x 1))
     987(define-inline (%sub1 x) (%- x 1))
     988
     989(define-inline (%quotient x y) ((##core#primitive "C_quotient") x y))
     990(define-inline (%remainder x y) (let ((quo (%quotient x y))) (%- x (%* quo y))))
     991
     992(define-inline (%expt x y) ((##core#primitive "C_expt") x y))
     993(define-inline (%abs x) (##core#inline_allocate ("C_a_i_abs" 4) x))
     994(define-inline (%acos x) (##core#inline_allocate ("C_a_i_acos" 4) x))
     995(define-inline (%asin x) (##core#inline_allocate ("C_a_i_asin" 4) x))
     996(define-inline (%atan x) (##core#inline_allocate ("C_a_i_atan" 4) x))
     997(define-inline (%atan2 x y) (##core#inline_allocate ("C_a_i_atan2" 4) x y))
     998(define-inline (%cos x) (##core#inline_allocate ("C_a_i_cos" 4) x))
     999(define-inline (%exp x) (##core#inline_allocate ("C_a_i_exp" 4) x))
     1000(define-inline (%log x) (##core#inline_allocate ("C_a_i_log" 4) x))
     1001(define-inline (%sin x) (##core#inline_allocate ("C_a_i_sin" 4) x))
     1002(define-inline (%sqrt x) (##core#inline_allocate ("C_a_i_sqrt" 4) x))
     1003(define-inline (%tan x) (##core#inline_allocate ("C_a_i_tan" 4) x))
     1004
     1005(define-inline (%bitwise-and x y) (##core#inline_allocate ("C_a_i_bitwise_and" 4) x y))
     1006(define-inline (%bitwise-xor x y) (##core#inline_allocate ("C_a_i_bitwise_xor" 4) x y))
     1007(define-inline (%bitwise-ior x y) (##core#inline_allocate ("C_a_i_bitwise_ior" 4) x y))
     1008(define-inline (%bitwise-not x) (##core#inline_allocate ("C_a_i_bitwise_not" 4) x))
     1009
     1010(define-inline (%arithmetic-shift x d) (##core#inline_allocate ("C_a_i_arithmetic_shift" 4) x d))
     1011
     1012(define-inline (%bit-set? n i) (##core#inline "C_i_bit_setp" n i))
     1013
     1014(define-inline (%randomize n) (##core#inline "C_randomize" n))
    6741015
    6751016;;; Operations
    6761017
    677 
    678 ;; Random
    679 
    680 (define-inline (%random-fixnum x) (##core#inline "C_random_fixnum" x))
     1018;Safe
     1019
     1020(define-inline (%->boolean obj) (and obj #t))
     1021
     1022(define-inline (%make-unique-object #!optional id) (if id (%make-vector 1 id) '#()))
  • chicken/branches/prerelease/chicken-thread-object-inlines.scm

    r13240 r13859  
    2929
    3030(define-inline (%mutex? x)
    31   (%structure? x 'mutex) )
     31  (%structure-instance? x 'mutex) )
    3232
    3333(define-inline (%mutex-name mx)
     
    3838
    3939(define-inline (%mutex-thread-set! mx th)
    40   (%structure-set! mx 2 th) )
     40  (%structure-set!/mutate mx 2 th) )
    4141
    4242(define-inline (%mutex-thread-clear! mx)
     
    4747
    4848(define-inline (%mutex-waiters-set! mx wt)
    49   (%structure-set! mx 3 wt) )
     49  (%structure-set!/mutate mx 3 wt) )
    5050
    5151(define-inline (%mutex-waiters-empty? mx)
     
    5656
    5757(define-inline (%mutex-waiters-add! mx th)
    58   (%mutex-waiters-set! mx (%append-item (%mutex-waiters mx) th)) )
     58  (%mutex-waiters-set! mx (%append! (%mutex-waiters mx) (%cons th '()))) )
    5959
    6060(define-inline (%mutex-waiters-delete! mx th)
     
    8383
    8484(define-inline (%mutex-specific-set! mx x)
    85   (%structure-set! mx 6 x) )
     85  (%structure-set!/mutate mx 6 x) )
    8686
    8787
     
    112112
    113113(define-inline (%thread? x)
    114   (%structure? x 'thread) )
     114  (%structure-instance? x 'thread) )
    115115
    116116(define-inline (%thread-thunk th)
     
    118118
    119119(define-inline (%thread-thunk-set! th tk)
    120   (%structure-set! th 1 tk) )
     120  (%structure-set!/mutate th 1 tk) )
    121121
    122122(define-inline (%thread-results th)
     
    124124
    125125(define-inline (%thread-results-set! th rs)
    126   (%structure-set! th 2 rs) )
     126  (%structure-set!/mutate th 2 rs) )
    127127
    128128(define-inline (%thread-state th)
     
    130130
    131131(define-inline (%thread-state-set! th st)
    132   (%structure-set! th 3 st) )
     132  (%structure-set!/mutate th 3 st) )
    133133
    134134(define-inline (%thread-block-timeout th)
     
    145145
    146146(define-inline (%thread-state-buffer-set! th v)
    147   (%structure-set! th 5 v) )
     147  (%structure-set!/mutate th 5 v) )
    148148
    149149(define-inline (%thread-name th)
     
    154154
    155155(define-inline (%thread-reason-set! th cd)
    156   (%structure-set! th 7 cd) )
     156  (%structure-set!/mutate th 7 cd) )
    157157
    158158(define-inline (%thread-mutexes th)
     
    160160
    161161(define-inline (%thread-mutexes-set! th wt)
    162   (%structure-set! th 8 wx) )
     162  (%structure-set!/mutate th 8 wx) )
    163163
    164164(define-inline (%thread-mutexes-empty? th)
     
    184184
    185185(define-inline (%thread-specific-set! th x)
    186   (%structure-set! th 10 x) )
     186  (%structure-set!/mutate th 10 x) )
    187187
    188188(define-inline (%thread-block-object th)
     
    190190
    191191(define-inline (%thread-block-object-set! th x)
    192   (%structure-set! th 11 x) )
     192  (%structure-set!/mutate th 11 x) )
    193193
    194194(define-inline (%thread-block-object-clear! th)
     
    199199
    200200(define-inline (%thread-recipients-set! th x)
    201   (%structure-set! th 12 x) )
     201  (%structure-set!/mutate th 12 x) )
    202202
    203203(define-inline (%thread-recipients-empty? th)
     
    213213  (let ([rs (%thread-recipients t)])
    214214    (unless (%null? rs) (for-each tk rs) ) )
    215   (thread-recipients-empty! t) )
     215  (%thread-recipients-empty! t) )
    216216
    217217(define-inline (%thread-unblocked-by-timeout? th)
     
    220220(define-inline (%thread-unblocked-by-timeout-set! th f)
    221221  (%structure-set!/immediate th 13 f) )
     222
     223(define-inline (%thread-blocked-for-timeout? th)
     224  (and (%thread-block-timeout th)
     225       (not (%thread-block-object th))) )
     226
     227(define-inline (%thread-blocked? th)
     228  (%eq? 'blocked (%thread-state th)) )
     229
     230(define-inline (%thread-created? th)
     231  (%eq? 'created (%thread-state th)) )
     232
     233(define-inline (%thread-ready? th)
     234  (%eq? 'ready (%thread-state th)) )
     235
     236(define-inline (%thread-sleeping? th)
     237  (%eq? 'sleeping (%thread-state th)) )
     238
     239(define-inline (%thread-suspended? th)
     240  (%eq? 'suspended (%thread-state th)) )
     241
     242(define-inline (%thread-terminated? th)
     243  (%eq? 'terminated (%thread-state th)) )
     244
     245(define-inline (%thread-dead? th)
     246  (%eq? 'dead (%thread-state th)) )
     247
     248;; Synonyms
     249
     250(define-inline (%current-thread)
     251  ##sys#current-thread )
    222252
    223253
     
    232262
    233263(define-inline (%condition-variable? x)
    234   (%structure? x 'condition-variable) )
     264  (%structure-instance? x 'condition-variable) )
    235265
    236266(define-inline (%condition-variable-name cv)
     
    241271
    242272(define-inline (%condition-variable-waiters-set! cv x)
    243   (%structure-set! cv 2 x) )
     273  (%structure-set!/mutate cv 2 x) )
    244274
    245275(define-inline (%condition-variable-waiters-empty? cv)
     
    250280
    251281(define-inline (%condition-variable-waiters-add! cv th)
    252   (%condition-variable-waiters-set! cv (%append-item (%condition-variable-waiters cv) th)) )
     282  (%condition-variable-waiters-set! cv (%append! (%condition-variable-waiters cv) (%cons th '()))) )
    253283
    254284(define-inline (%condition-variable-waiters-delete! cv th)
     
    265295
    266296(define-inline (%condition-variable-specific-set! cv x)
    267   (%structure-set! cv 3 x) )
     297  (%structure-set!/mutate cv 3 x) )
  • chicken/branches/prerelease/chicken.import.scm

    r13240 r13859  
    88;
    99;   Redistributions of source code must retain the above copyright notice, this list of conditions and the following
    10 ;     disclaimer. 
     10;     disclaimer.
    1111;   Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following
    12 ;     disclaimer in the documentation and/or other materials provided with the distribution. 
     12;     disclaimer in the documentation and/or other materials provided with the distribution.
    1313;   Neither the name of the author nor the names of its contributors may be used to endorse or promote
    14 ;     products derived from this software without specific prior written permission. 
     14;     products derived from this software without specific prior written permission.
    1515;
    1616; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS
     
    2727(##sys#register-primitive-module
    2828 'chicken
    29  '(abort add1 argc+argv argv
    30          bit-set?
    31          arithmetic-shift
    32          bitwise-and
    33          bitwise-ior
    34          bitwise-not
    35          bitwise-xor
    36          blob->string
    37          blob-size
    38          blob=?
    39          blob?
    40          breakpoint
    41          build-platform
    42          c-runtime
    43          call/cc
    44          case-sensitive
    45          char-name
    46          chicken-version
    47          command-line-arguments
    48          condition-predicate
    49          condition-property-accessor
    50          condition?
    51          continuation-capture
    52          continuation-graft
    53          continuation-return
    54          continuation?
    55          copy-read-table
    56          cpu-time
    57          current-error-port
    58          current-exception-handler
    59          current-gc-milliseconds
    60          current-milliseconds
    61          current-read-table
    62          current-seconds
    63          delete-file
    64          enable-warnings
    65          errno
    66          error
    67          exit
    68          exit-handler
    69          feature?
    70          features
    71          file-exists?
    72          fixnum?
    73          flonum-print-precision
    74          flonum?
    75          flush-output
    76          force-finalizers
    77          fp*
    78          fp+
    79          fp-
    80          fp/
    81          fp<
    82          fp<=
    83          fp=
    84          fp>
    85          fp>=
    86          fpmax
    87          fpmin
    88          fpneg
    89          fx*
    90          fx+
    91          fx-
    92          fx/
    93          fx<
    94          fx<=
    95          fx=
    96          fx>
    97          fx>=
    98          fxand
    99          fxior
    100          fxmax
    101          fxmin
    102          fxmod
    103          fxneg
    104          fxnot
    105          fxshl
    106          fxshr
    107          fxxor
    108          gc
    109          gensym
    110          get
    111          get-call-chain
    112          get-keyword
    113          get-output-string
    114          get-properties
    115          getenv                       
    116          get-environment-variable
    117          getter-with-setter
    118          implicit-exit-handler
    119          keyword->string
    120          keyword-style
    121          keyword?
    122          load-relative
    123          load-library
    124          load-verbose
    125          machine-byte-order
    126          machine-type
    127          make-blob
    128          make-composite-condition
    129          make-parameter
    130          make-property-condition
    131          memory-statistics
    132          on-exit
    133          open-input-string
    134          open-output-string
    135          port-name
    136          port-position
    137          port?
    138          print
    139          print*
    140          print-call-chain
    141          print-error-message
    142          procedure-information
    143          program-name
    144          promise?
    145          put!
    146          register-feature!
    147          remprop!
    148          require
    149          rename-file
    150          reset
    151          reset-handler
    152          return-to-host
    153          reverse-list->string
    154          set-finalizer!
    155          set-gc-report!
    156          set-parameterized-read-syntax!
    157          set-port-name!
    158          set-read-syntax!
    159          set-sharp-read-syntax!
    160          syntax-error
    161          setter
    162          signal
    163          signum
    164          singlestep
    165          software-type
    166          software-version
    167          string->blob
    168          string->keyword
    169          string->uninterned-symbol
    170          sub1
    171          symbol-plist
    172          system
    173          unregister-feature!
    174          vector-resize
    175          void
    176          warning
    177          expand
    178          extension-information
    179          repository-path
    180          chicken-home
    181          with-exception-handler
    182          strip-syntax)
    183  ##sys#chicken-macro-environment)       ;*** incorrect - won't work in compiled executable
     29 '(abort
     30   add1
     31   argc+argv
     32   argv
     33   arithmetic-shift
     34   bit-set?
     35   bitwise-and
     36   bitwise-ior
     37   bitwise-not
     38   bitwise-xor
     39   blob->string
     40   blob-size
     41   blob?
     42   blob=?
     43   breakpoint
     44   build-platform
     45   c-runtime
     46   call/cc
     47   case-sensitive
     48   char-name
     49   chicken-home
     50   chicken-version
     51   command-line-arguments
     52   condition-predicate
     53   condition-property-accessor
     54   condition?
     55   continuation-capture
     56   continuation-graft
     57   continuation-return
     58   continuation?
     59   copy-read-table
     60   cpu-time
     61   current-error-port
     62   current-exception-handler
     63   current-gc-milliseconds
     64   current-milliseconds
     65   current-read-table
     66   current-seconds
     67   define-reader-ctor
     68   delete-file
     69   enable-warnings
     70   errno
     71   error
     72   exit
     73   exit-handler
     74   expand
     75   extension-information
     76   feature?
     77   features
     78   file-exists?
     79   fixnum-bits
     80   fixnum-precision
     81   fixnum?
     82   flonum-decimal-precision
     83   flonum-epsilon
     84   flonum-maximum-decimal-exponent
     85   flonum-maximum-exponent
     86   flonum-minimum-decimal-exponent
     87   flonum-minimum-exponent
     88   flonum-precision
     89   flonum-print-precision
     90   flonum-radix
     91   flonum?
     92   flush-output
     93   force-finalizers
     94   fp-
     95   fp*
     96   fp/
     97   fp+
     98   fp<
     99   fp<=
     100   fp=
     101   fp>
     102   fp>=
     103   fpmax
     104   fpmin
     105   fpneg
     106   fx-
     107   fx*
     108   fx/
     109   fx+
     110   fx<
     111   fx<=
     112   fx=
     113   fx>
     114   fx>=
     115   fxand
     116   fxior
     117   fxmax
     118   fxmin
     119   fxmod
     120   fxneg
     121   fxnot
     122   fxshl
     123   fxshr
     124   fxxor
     125   gc
     126   gensym
     127   get
     128   get-call-chain
     129   get-environment-variable
     130   get-keyword
     131   get-output-string
     132   get-properties
     133   getenv
     134   getter-with-setter
     135   implicit-exit-handler
     136   keyword->string
     137   keyword-style
     138   keyword?
     139   load-library
     140   load-relative
     141   load-verbose
     142   machine-byte-order
     143   machine-type
     144   make-blob
     145   make-composite-condition
     146   make-parameter
     147   make-property-condition
     148   maximum-flonum
     149   memory-statistics
     150   minimum-flonum
     151   most-negative-fixnum
     152   most-positive-fixnum
     153   on-exit
     154   open-input-string
     155   open-output-string
     156   parentheses-synonyms
     157   port-name
     158   port-position
     159   port?
     160   print
     161   print-call-chain
     162   print-error-message
     163   print*
     164   procedure-information
     165   program-name
     166   promise?
     167   put!
     168   register-feature!
     169   remprop!
     170   rename-file
     171   repository-path
     172   require
     173   reset
     174   reset-handler
     175   return-to-host
     176   reverse-list->string
     177   set-finalizer!
     178   set-gc-report!
     179   set-parameterized-read-syntax!
     180   set-port-name!
     181   set-read-syntax!
     182   set-sharp-read-syntax!
     183   setter
     184   signal
     185   signum
     186   singlestep
     187   software-type
     188   software-version
     189   string->blob
     190   string->keyword
     191   string->uninterned-symbol
     192   strip-syntax
     193   sub1
     194   symbol-escape
     195   symbol-plist
     196   syntax-error
     197   system
     198   unregister-feature!
     199   vector-resize
     200   void
     201   warning
     202   with-exception-handler)
     203 ##sys#chicken-macro-environment)       ;*** incorrect - won't work in compiled executable
  • chicken/branches/prerelease/compiler.scm

    r13240 r13859  
    916916                                      (mark-variable var '##compiler#always-bound-to-procedure)
    917917                                      (mark-variable var '##compiler#always-bound))
    918                                     (when (macro? var)
     918                                    (when (##sys#macro? var)
    919919                                      (compiler-warning
    920920                                       'var "assigned global variable `~S' is a macro ~A"
    921921                                       var
    922922                                       (if ln (sprintf "in line ~S" ln) "") )
    923                                       (when undefine-shadowed-macros (undefine-macro! var) ) ) )
     923                                      (when undefine-shadowed-macros (##sys#undefine-macro! var) ) ) )
    924924                                  (when (keyword? var)
    925925                                    (compiler-warning 'syntax "assignment to keyword `~S'" var) )
     
    12161216          ((and (pair? (car x))
    12171217                (symbol? (caar x))
    1218                 (eq? 'lambda (or (lookup (caar x) se) (caar x))))
     1218                (memq (or (lookup (caar x) se) (caar x)) '(lambda ##core#lambda)))
    12191219           (let ([lexp (car x)]
    12201220                 [args (cdr x)] )
    12211221             (emit-syntax-trace-info x #f)
    1222              (##sys#check-syntax 'lambda lexp '(lambda lambda-list . #(_ 1)) #f se)
     1222             (##sys#check-syntax 'lambda lexp '(_ lambda-list . #(_ 1)) #f se)
    12231223             (let ([llist (cadr lexp)])
    12241224               (if (and (proper-list? llist) (= (llist-length llist) (length args)))
  • chicken/branches/prerelease/csc.scm

    r13240 r13859  
    127127    -check-syntax -case-insensitive -benchmark-mode -shared -compile-syntax -no-lambda-info
    128128    -lambda-lift -dynamic -disable-stack-overflow-checks -local
    129     -emit-external-prototypes-first -inline -extension -release
    130     -analyze-only -keep-shadowed-macros -inline-global) -ignore-repository)
     129    -emit-external-prototypes-first -inline -release
     130    -analyze-only -keep-shadowed-macros -inline-global -ignore-repository
     131    -no-symbol-escape -no-parentheses-synonyms -r5rs-syntax))
    131132
    132133(define-constant complex-options
     
    140141  '((-h "-help")
    141142    (-s "-shared")
    142     (|-E| "-extension")
    143143    (|-P| "-check-syntax")
    144144    (|-V| "-version")
     
    264264
    265265(define (usage)
    266   (display
    267 "Usage: csc FILENAME | OPTION ...
    268 
    269   `csc' is a driver program for the CHICKEN compiler. Any Scheme, C or object
    270   files and all libraries given on the command line are translated, compiled or
    271   linked as needed.
     266  (display #<<EOF
     267Usage: csc FILENAME | OPTION ...
     268
     269  `csc' is a driver program for the CHICKEN compiler. Files given on the
     270  command line are translated, compiled or linked as needed.
     271
     272  FILENAME is a Scheme source file name with optional extension or a
     273  C/C++/Objective-C source, object or library file name with extension. OPTION
     274  may be one of the following:
    272275
    273276  General options:
    274277
    275     -h  -help                   display this text and exit
    276     -v                          show intermediate compilation stages
    277     -v2  -verbose               display information about translation progress
    278     -v3                         display information about all compilation stages
    279     -V  -version                display Scheme compiler version and exit
    280     -release                    display release number and exit
     278    -h  -help                      display this text and exit
     279    -v                             show intermediate compilation stages
     280    -v2  -verbose                  display information about translation
     281                                    progress
     282    -v3                            display information about all compilation
     283                                    stages
     284    -V  -version                   display Scheme compiler version and exit
     285    -release                       display release number and exit
    281286
    282287  File and pathname options:
    283288
    284     -o -output-file FILENAME    specifies target executable name
    285     -I -include-path PATHNAME   specifies alternative path for included files
    286     -to-stdout                  write compiler to stdout (implies -t)
    287     -s -shared -dynamic         generate dynamically loadable shared object file
     289    -o -output-file FILENAME       specifies target executable name
     290    -I -include-path PATHNAME      specifies alternative path for included
     291                                    files
     292    -to-stdout                     write compiler to stdout (implies -t)
     293    -s -shared -dynamic            generate dynamically loadable shared object
     294                                    file
    288295
    289296  Language options:
    290297
    291     -D  -DSYMBOL  -feature SYMBOL
    292                                 register feature identifier
    293     -c++                        Compile via a C++ source file (.cpp)
    294     -objc                       Compile via Objective-C source file (.m)
     298    -D  -DSYMBOL  -feature SYMBOL  register feature identifier
     299    -c++                           compile via a C++ source file (.cpp)
     300    -objc                          compile via Objective-C source file (.m)
    295301
    296302  Syntax related options:
    297303
    298     -i -case-insensitive        don't preserve case of read symbols   
    299     -K -keyword-style STYLE     allow alternative keyword syntax (prefix, suffix or none)
    300     -compile-syntax             macros are made available at run-time
    301     -j -emit-import-library MODULE
    302                                 write compile-time module information into separate file
     304    -i -case-insensitive           don't preserve case of read symbols   
     305    -k  -keyword-style STYLE       enable alternative keyword-syntax
     306                                    (prefix, suffix or none)
     307        -no-parentheses-synonyms   disables list delimiter synonyms
     308        -no-symbol-escape          disables support for escaped symbols
     309        -r5rs-syntax               disables the Chicken extensions to
     310                                    R5RS syntax
     311    -compile-syntax                macros are made available at run-time
     312    -j -emit-import-library MODULE write compile-time module information into
     313                                    separate file
    303314
    304315  Translation options:
    305316
    306     -x  -explicit-use           do not use units `library' and `eval' by default
    307     -P  -check-syntax           stop compilation after macro-expansion
    308     -A  -analyze-only           stop compilation after first analysis pass
     317    -x  -explicit-use              do not use units `library' and `eval' by
     318                                    default
     319    -P  -check-syntax              stop compilation after macro-expansion
     320    -A  -analyze-only              stop compilation after first analysis pass
    309321
    310322  Debugging options:
    311323
    312     -w  -no-warnings            disable warnings
    313     -disable-warning CLASS      disable specific class of warnings
     324    -w  -no-warnings               disable warnings
     325    -disable-warning CLASS         disable specific class of warnings
    314326    -d0 -d1 -d2 -debug-level NUMBER
    315                                 set level of available debugging information
    316     -no-trace                   disable rudimentary debugging information
    317     -profile                    executable emits profiling information
    318     -accumulate-profile         executable emits profiling information in append mode
    319     -profile-name FILENAME      name of the generated profile information file
     327                                   set level of available debugging information
     328    -no-trace                      disable rudimentary debugging information
     329    -profile                       executable emits profiling information
     330    -accumulate-profile            executable emits profiling information in
     331                                    append mode
     332    -profile-name FILENAME         name of the generated profile information
     333                                    file
    320334
    321335  Optimization options:
    322336
    323337    -O -O1 -O2 -O3 -O4 -optimize-level NUMBER
    324                                 enable certain sets of optimization options
    325     -optimize-leaf-routines     enable leaf routine optimization
    326     -N  -no-usual-integrations  standard procedures may be redefined
    327     -u  -unsafe                 disable safety checks
    328     -local                      assume globals are only modified in current file
    329     -b  -block                  enable block-compilation
    330     -disable-interrupts         disable interrupts in compiled code
    331     -f  -fixnum-arithmetic      assume all numbers are fixnums
    332     -Ob  -benchmark-mode        equivalent to '-block -optimize-level 4
    333                                  -debug-level 0 -fixnum-arithmetic -lambda-lift
    334                                  -disable-interrupts -inline'
    335     -lambda-lift                perform lambda-lifting
    336     -unsafe-libraries           link with unsafe runtime system
    337     -disable-stack-overflow-checks  disables detection of stack-overflows
    338     -inline                     enable inlining
    339     -inline-limit               set inlining threshold
    340     -inline-global              enable cross-module inlining
    341     -n -emit-inline-file FILENAME 
    342                                 generate file with globally inlinable procedures
    343                                 (implies -inline -local)
     338                                   enable certain sets of optimization options
     339    -optimize-leaf-routines        enable leaf routine optimization
     340    -N  -no-usual-integrations     standard procedures may be redefined
     341    -u  -unsafe                    disable safety checks
     342    -local                         assume globals are only modified in current
     343                                    file
     344    -b  -block                     enable block-compilation
     345    -disable-interrupts            disable interrupts in compiled code
     346    -f  -fixnum-arithmetic         assume all numbers are fixnums
     347    -Ob  -benchmark-mode           equivalent to '-block -optimize-level 4
     348                                    -debug-level 0 -fixnum-arithmetic
     349                                    -lambda-lift -inline -disable-interrupts'
     350    -lambda-lift                   perform lambda-lifting
     351    -unsafe-libraries              link with unsafe runtime system
     352    -disable-stack-overflow-checks disables detection of stack-overflows
     353    -inline                        enable inlining
     354    -inline-limit                  set inlining threshold
     355    -inline-global                 enable cross-module inlining
     356    -n -emit-inline-file FILENAME  generate file with globally inlinable
     357                                    procedures (implies -inline -local)
    344358
    345359  Configuration options:
    346360
    347     -unit NAME                  compile file as a library unit
    348     -uses NAME                  declare library unit as used.
    349     -heap-size NUMBER           specifies heap-size of compiled executable
    350     -heap-initial-size NUMBER   specifies heap-size at startup time
    351     -heap-growth PERCENTAGE     specifies growth-rate of expanding heap
    352     -heap-shrinkage PERCENTAGE  specifies shrink-rate of contracting heap
     361    -unit NAME                     compile file as a library unit
     362    -uses NAME                     declare library unit as used.
     363    -heap-size NUMBER              specifies heap-size of compiled executable
     364    -heap-initial-size NUMBER      specifies heap-size at startup time
     365    -heap-growth PERCENTAGE        specifies growth-rate of expanding heap
     366    -heap-shrinkage PERCENTAGE     specifies shrink-rate of contracting heap
    353367    -nursery NUMBER  -stack-size NUMBER
    354                                 specifies nursery size of compiled executable
    355     -X -extend FILENAME         load file before compilation commences
    356     -prelude EXPRESSION         add expression to beginning of source file
    357     -postlude EXPRESSION        add expression to end of source file
    358     -prologue FILENAME          include file before main source file
    359     -epilogue FILENAME          include file after main source file
    360     -ignore-repository          do not refer to repository for extensions
    361 
    362     -e  -embedded               compile as embedded (don't generate `main()')
    363     -W  -windows                compile as Windows GUI application (MSVC only)
    364     -R  -require-extension NAME require extension and import in compiled code
    365     -E  -extension              compile as extension (dynamic or static)
    366     -dll -library               compile multiple units into a dynamic library
     368                                   specifies nursery size of compiled
     369                                   executable
     370    -X -extend FILENAME            load file before compilation commences
     371    -prelude EXPRESSION            add expression to beginning of source file
     372    -postlude EXPRESSION           add expression to end of source file
     373    -prologue FILENAME             include file before main source file
     374    -epilogue FILENAME             include file after main source file
     375
     376    -e  -embedded                  compile as embedded
     377                                    (don't generate `main()')
     378    -W  -windows                   compile as Windows GUI application
     379                                    (MSVC only)
     380    -R  -require-extension NAME    require extension and import in compiled
     381                                    code
     382    -E  -extension                 compile as extension (dynamic or static)
     383    -dll -library                  compile multiple units into a dynamic
     384                                    library
    367385
    368386  Options to other passes:
    369387
    370     -C OPTION                   pass option to C compiler
    371     -L OPTION                   pass option to linker
    372     -I<DIR>                     pass \"-I<DIR>\" to C compiler (add include path)
    373     -L<DIR>                     pass \"-L<DIR>\" to linker (add library path)
    374     -k                          keep intermediate files
    375     -c                          stop after compilation to object files
    376     -t                          stop after translation to C
    377     -cc COMPILER                select other C compiler than the default one
    378     -cxx COMPILER               select other C++ compiler than the default one
    379     -ld COMPILER                select other linker than the default one
    380     -lLIBNAME                   link with given library (`libLIBNAME' on UNIX,
    381                                  `LIBNAME.lib' on Windows)                               
    382     -static-libs                link with static CHICKEN libraries
    383     -static                     generate completely statically linked executable
    384     -static-extension NAME      link extension NAME statically (if available)
    385     -F<DIR>                     pass \"-F<DIR>\" to C compiler (add framework
    386                                  header path on Mac OS X)
    387     -framework NAME             passed to linker on Mac OS X
    388     -rpath PATHNAME             add directory to runtime library search path
    389     -Wl,...                     pass linker options
    390     -strip                      strip resulting binary
     388    -C OPTION                      pass option to C compiler
     389    -L OPTION                      pass option to linker
     390    -I<DIR>                        pass \"-I<DIR>\" to C compiler
     391                                    (add include path)
     392    -L<DIR>                        pass \"-L<DIR>\" to linker
     393                                    (add library path)
     394    -k                             keep intermediate files
     395    -c                             stop after compilation to object files
     396    -t                             stop after translation to C
     397    -cc COMPILER                   select other C compiler than the default one
     398    -cxx COMPILER                  select other C++ compiler than the default one
     399    -ld COMPILER                   select other linker than the default one
     400    -lLIBNAME                      link with given library
     401                                    (`libLIBNAME' on UNIX,
     402                                     `LIBNAME.lib' on Windows)
     403    -static-libs                   link with static CHICKEN libraries
     404    -static                        generate completely statically linked
     405                                    executable
     406    -static-extension NAME         link extension NAME statically
     407                                    (if available)
     408    -F<DIR>                        pass \"-F<DIR>\" to C compiler
     409                                    (add framework header path on Mac OS X)
     410    -framework NAME                passed to linker on Mac OS X
     411    -rpath PATHNAME                add directory to runtime library search path
     412    -Wl,...                        pass linker options
     413    -strip                         strip resulting binary
    391414
    392415  Inquiry options:
    393416
    394     -home                       show home-directory (where support files go)
    395     -cflags                     show required C-compiler flags and exit
    396     -ldflags                    show required linker flags and exit
    397     -libs                       show required libraries and exit
    398     -cc-name                    show name of default C compiler used
    399     -cxx-name                   show name of default C++ compiler used
    400     -ld-name                    show name of default linker used
    401     -dry-run                    just show commands executed, don't run them
    402                                  (implies `-v')
     417    -home                          show home-directory (where support files go)
     418    -cflags                        show required C-compiler flags and exit
     419    -ldflags                       show required linker flags and exit
     420    -libs                          show required libraries and exit
     421    -cc-name                       show name of default C compiler used
     422    -cxx-name                      show name of default C++ compiler used
     423    -ld-name                       show name of default linker used
     424    -dry-run                       just show commands executed, don't run them
     425                                    (implies `-v')
    403426
    404427  Obscure options:
    405428
    406     -debug MODES                display debugging output for the given modes
    407     -compiler PATHNAME          use other compiler than default `chicken'
    408     -disable-c-syntax-checks    disable syntax checks of C code fragments
    409     -raw                        do not generate implicit init- and exit code                           
    410     -emit-external-prototypes-first  emit protoypes for callbacks before foreign
    411                                  declarations
    412     -keep-shadowed-macros       do not remove shadowed macro
    413     -host                       compile for host when configured for cross-compiling
     429    -debug MODES                   display debugging output for the given modes
     430    -compiler PATHNAME             use other compiler than default `chicken'
     431    -disable-c-syntax-checks       disable syntax checks of C code fragments
     432    -raw                           do not generate implicit init- and exit code
     433    -emit-external-prototypes-first
     434                                   emit protoypes for callbacks before foreign
     435                                    declarations
     436    -ignore-repository             do not refer to repository for extensions
     437    -keep-shadowed-macros          do not remove shadowed macro
     438    -host                          compile for host when configured for
     439                                    cross-compiling
    414440
    415441  Options can be collapsed if unambiguous, so
     
    421447    -v -k -fixnum-arithmetic -optimize
    422448
    423   The contents of the environment variable CSC_OPTIONS are implicitly
    424   passed to every invocation of `csc'.
    425 "
     449  The contents of the environment variable CSC_OPTIONS are implicitly passed to
     450  every invocation of `csc'.
     451
     452EOF
    426453) )
    427454
     
    460487             (newline)
    461488             (exit) )
    462            #;(when (null? scheme-files)
     489           #; ;UNUSED
     490           (when (null? scheme-files)
    463491             (set! scheme-files c-files)
    464492             (set! c-files '()) )
     
    880908          (system str)))
    881909    (unless (zero? last-exit-code)
    882       (printf "Error: shell command terminated with non-zero exit status ~S: ~A~%" last-exit-code str) )
     910      (printf "\nError: shell command terminated with non-zero exit status ~S: ~A~%" last-exit-code str) )
    883911    last-exit-code))
    884912
  • chicken/branches/prerelease/csi.scm

    r13240 r13859  
    7171
    7272(define (print-usage)
    73   (display
    74 "usage: csi [FILENAME | OPTION ...]
    75 
    76   where OPTION may be one of the following:
    77 
    78     -h  -help  --help           display this text and exit
    79     -v  -version                display version and exit
    80         -release                print release number and exit
    81     -i  -case-insensitive       enable case-insensitive reading
    82     -e  -eval EXPRESSION        evaluate given expression
    83     -p  -print EXPRESSION       evaluate and print result(s)
     73  (display #<<EOF
     74usage: csi [FILENAME | OPTION ...]
     75
     76  `csi' is the CHICKEN interpreter.
     77 
     78  FILENAME is a Scheme source file name with optional extension. OPTION may be
     79  one of the following:
     80
     81    -h  -help  --help             display this text and exit
     82    -v  -version                  display version and exit
     83        -release                  print release number and exit
     84    -i  -case-insensitive         enable case-insensitive reading
     85    -e  -eval EXPRESSION          evaluate given expression
     86    -p  -print EXPRESSION         evaluate and print result(s)
    8487    -P  -pretty-print EXPRESSION  evaluate and print result(s) prettily
    85     -D  -feature SYMBOL         register feature identifier
    86     -q  -quiet                  do not print banner
    87     -n  -no-init                do not load initialization file `")
    88   (display init-file)
    89   (display
    90 "'
    91     -b  -batch                  terminate after command-line processing
    92     -w  -no-warnings            disable all warnings
    93     -k  -keyword-style STYLE    enable alternative keyword-syntax (none, prefix or suffix)
    94     -s  -script PATHNAME        use interpreter for shell scripts
    95         -ss PATHNAME            shell script with `main' procedure
    96         -sx PATHNAME            same as `-s', but print each expression as it is evaluated
    97     -R  -require-extension NAME require extension and import before executing code
    98     -I  -include-path PATHNAME  add PATHNAME to include path
    99     --                          ignore all following options
    100 
    101 ") )
     88    -D  -feature SYMBOL           register feature identifier
     89    -q  -quiet                    do not print banner
     90
     91EOF
     92)
     93  (display #<#EOF
     94    -n  -no-init                  do not load initialization file #{#\`} #{init-file} #{#\'}
     95
     96EOF
     97)
     98  (display  #<<EOF
     99    -b  -batch                    terminate after command-line processing
     100    -w  -no-warnings              disable all warnings
     101    -k  -keyword-style STYLE      enable alternative keyword-syntax
     102                                   (prefix, suffix or none)
     103        -no-parentheses-synonyms  disables list delimiter synonyms
     104        -no-symbol-escape         disables support for escaped symbols
     105        -r5rs-syntax              disables the Chicken extensions to
     106                                   R5RS syntax
     107    -s  -script PATHNAME          use interpreter for shell scripts
     108        -ss PATHNAME              shell script with `main' procedure
     109        -sx PATHNAME              same as `-s', but print each expression
     110                                   as it is evaluated
     111    -R  -require-extension NAME   require extension and import before
     112                                   executing code
     113    -I  -include-path PATHNAME    add PATHNAME to include path
     114    --                            ignore all following options
     115
     116EOF
     117) )
    102118
    103119(define (print-banner)
    104120  (newline)
    105   #;(when (and (tty-input?) (##sys#fudge 11))
     121  #; ;UNUSED
     122  (when (and (tty-input?) (##sys#fudge 11))
    106123    (let* ((t (string-copy +product+))
    107124           (len (string-length t))
     
    817834
    818835(define-constant long-options
    819   '("-keyword-style" "-script" "-version" "-help" "--help" "--" "-feature"
    820     "-eval" "-case-insensitive"
     836  '("-ss" "-sx" "-script" "-version" "-help" "--help" "-feature" "-eval"
     837    "-case-insensitive" "-keyword-style" "-no-parentheses-synonyms" "-no-symbol-escape"
     838    "-r5rs-syntax"
    821839    "-require-extension" "-batch" "-quiet" "-no-warnings" "-no-init"
    822     "-include-path" "-release" "-ss" "-sx"
    823     "-print" "-pretty-print") )
     840    "-include-path" "-release" "-print" "-pretty-print" "--") )
    824841
    825842(define (canonicalize-args args)
     
    828845        '()
    829846        (let ((x (car args)))
    830           (cond
    831            ((member x '("-s" "-ss" "-script" "--")) args)
    832            ((and (fx> (##sys#size x) 2)
    833                  (char=? #\- (##core#inline "C_subchar" x 0))
    834                  (not (member x long-options)) )
    835             (if (char=? #\: (##core#inline "C_subchar" x 1))
    836                 (loop (cdr args))
    837                 (let ((cs (string->list (substring x 1))))
    838                   (if (findall cs short-options)
    839                       (append (map (cut string #\- <>) cs) (loop (cdr args)))
    840                       (##sys#error "invalid option" x) ) ) ) )
    841            (else (cons x (loop (cdr args)))))))))
     847          (cond ((member x '("-s" "-ss" "-script" "--")) args)
     848                ((and (fx> (##sys#size x) 2)
     849                       (char=? #\- (##core#inline "C_subchar" x 0))
     850                       (not (member x long-options)) )
     851                 (if (char=? #\: (##core#inline "C_subchar" x 1))
     852                     (loop (cdr args))
     853                     (let ((cs (string->list (substring x 1))))
     854                       (if (findall cs short-options)
     855                           (append (map (cut string #\- <>) cs) (loop (cdr args)))
     856                           (##sys#error "invalid option" x) ) ) ) )
     857                (else (cons x (loop (cdr args)))))))))
    842858
    843859(define (findall chars clist)
     
    847863             (loop (cdr chars))))))
    848864
     865(define-constant simple-options
     866  '("--" "-b" "-batch" "-q" "-quiet" "-n" "-no-init" "-w" "-no-warnings" "-i" "-case-insensitive"
     867    "-no-parentheses-synonyms" "-no-symbol-escape" "-r5rs-syntax"
     868    ; Not "simple" but processed early
     869    "-ss" "-sx" "-s" "-script") )
     870
     871(define-constant complex-options
     872  '("-D" "-feature" "-I" "-include-path" "-k" "-keyword-style") )
     873
    849874(define (run)
    850875  (let* ([extraopts (parse-option-string (or (getenv "CSI_OPTIONS") ""))]
    851876         [args (canonicalize-args (command-line-arguments))]
     877         ; Check for these before 'args' is updated by any 'extraopts'
    852878         [kwstyle (member* '("-k" "-keyword-style") args)]
    853          [script (member* '("-s" "-ss" "-sx" "-script") args)])
     879         [script (member* '("-ss" "-sx" "-s" "-script") args)])
    854880    (cond [script
    855881           (when (or (not (pair? (cdr script)))
     
    932958              [(string=? "suffix" (cadr kwstyle))
    933959               (keyword-style #:suffix) ] ) )
     960      (when (member* '("-no-parentheses-synonyms") args)
     961        (unless quiet (display "Disabled support for parentheses synonyms\n"))
     962        (parentheses-synonyms #f) )
     963      (when (member* '("-no-symbol-escape") args)
     964        (unless quiet (display "Disabled support for escaped symbols\n"))
     965        (symbol-escape #f) )
     966      (when (member* '("-r5rs-syntax") args)
     967        (unless quiet (display "Disabled the Chicken extensions to R5RS syntax\n"))
     968        (case-sensitive #f)
     969        (keyword-style #:none)
     970        (parentheses-synonyms #f)
     971        (symbol-escape #f) )
    934972      (unless (or (member* '("-n" "-no-init") args) script) (loadinit))
    935973      (do ([args args (cdr args)])
     
    939977             (##sys#write-char-0 #\newline ##sys#standard-output) ) )
    940978        (let* ([arg (car args)]
    941                [len (string-length arg)] )
    942           (cond ((member
    943                   arg
    944                   '("--" "-batch" "-quiet" "-no-init" "-no-warnings" "-script"
    945                     "-b" "-q" "-n" "-w" "-s" "-i"
    946                     "-case-insensitive" "-ss" "-sx") ) )
    947                 ((member arg '("-feature" "-include-path" "-keyword-style"
    948                                "-D" "-I" "-k"))
     979               #;[len (string-length arg)] )
     980          (cond ((member arg simple-options) )
     981                ((member arg complex-options)
    949982                 (set! args (cdr args)) )
    950983                ((or (string=? "-R" arg) (string=? "-require-extension" arg))
     
    955988                 (set! args (cdr args)) )
    956989                ((or (string=? "-p" arg) (string=? "-print" arg))
    957                  (evalstring
    958                   (cadr args)
    959                   (cut for-each print <...>) )
     990                 (evalstring (cadr args) (cut for-each print <...>))
    960991                 (set! args (cdr args)) )
    961992                ((or (string=? "-P" arg) (string=? "-pretty-print" arg))
    962                  (evalstring
    963                   (cadr args)
    964                   (cut for-each pretty-print <...>) )
     993                 (evalstring (cadr args) (cut for-each pretty-print <...>) )
    965994                 (set! args (cdr args)) )
    966995                (else
     
    9741003                           (eval x)))
    9751004                    #f)
    976                    (when (equal? scr "-ss")
     1005                   (when (equal? "-ss" scr)
    9771006                     (call-with-values (cut main (command-line-arguments))
    9781007                       (lambda results
  • chicken/branches/prerelease/data-structures.scm

    r13240 r13859  
    6363(private data-structures
    6464  reverse-string-append
    65   fprintf0 generic-write
    66    )
     65  fprintf0 generic-write )
    6766
    6867(declare
  • chicken/branches/prerelease/defaults.make

    r13240 r13859  
    5151TOPMANDIR = $(SHAREDIR)/man
    5252MANDIR = $(TOPMANDIR)/man1
    53 INFODIR = $(SHAREDIR)/info
    5453INCDIR = $(PREFIX)/include
    5554DOCDIR = $(DATADIR)/doc
     
    6564ITOPMANDIR = $(ISHAREDIR)$(SEP)man
    6665IMANDIR = $(ITOPMANDIR)$(SEP)man1
    67 IINFODIR = $(ISHAREDIR)$(SEP)info
    6866IINCDIR = $(SPREFIX)$(SEP)include
    6967IDOCDIR = $(IDATADIR)$(SEP)doc
     
    7876ITOPMANDIR = $(TOPMANDIR)
    7977IMANDIR = $(MANDIR)
    80 IINFODIR = $(INFODIR)
    8178IINCDIR = $(INCDIR)
    8279IDOCDIR = $(DOCDIR)
     
    105102endif
    106103ASSEMBLER ?= $(C_COMPILER)
    107 MAKEINFO_PROGRAM ?= -makeinfo
    108 ifdef WINDOWS_SHELL
    109 INSTALL_PROGRAM ?= copy
     104ifdef WINDOWS_SHELL
     105INSTALL_PROGRAM ?= xcopy
    110106MAKEDIR_COMMAND ?= -mkdir
    111107else
     
    115111POSTINSTALL_STATIC_LIBRARY ?= true
    116112POSTINSTALL_PROGRAM ?= true
    117 INSTALLINFO_PROGRAM ?= -install-info
    118 UNINSTALLINFO_PROGRAM ?= -install-info
    119113
    120114# cross tools
     
    192186MAKE_WRITABLE_COMMAND ?= chmod 0755
    193187endif
    194 MAKEINFO_PROGRAM_OPTIONS ?= --no-split
    195188ifndef WINDOWS_SHELL
    196189INSTALL_PROGRAM_SHARED_LIBRARY_OPTIONS ?= -m755
     
    213206LIBCHICKENGUI_SO_FILE ?=
    214207else
    215 PRIMARY_LIBCHICKEN ?= libchicken$(SO)$(SONAME_VERSION)
    216 LIBCHICKEN_SO_FILE ?= libchicken$(SO)$(SONAME_VERSION)
    217 LIBUCHICKEN_SO_FILE ?= libuchicken$(SO)$(SONAME_VERSION)
     208PRIMARY_LIBCHICKEN ?= libchicken$(SO)
     209LIBCHICKEN_SO_FILE ?= libchicken$(SO)
     210LIBUCHICKEN_SO_FILE ?= libuchicken$(SO)
    218211LIBCHICKENGUI_SO_FILE ?=
    219212endif
    220213endif
    221 UNINSTALLINFO_PROGRAM_OPTIONS ?= --delete
    222214LIBCHICKEN_SO_LIBRARIES ?= $(LIBRARIES)
    223215LIBUCHICKEN_SO_LIBRARIES ?= $(LIBRARIES)
     
    323315        $(CSI_STATIC_EXECUTABLE) $(CHICKEN_PROFILE_PROGRAM)$(EXE) \
    324316        $(CSC_PROGRAM)$(EXE) \
    325         chicken.info $(CHICKEN_BUG_PROGRAM)$(EXE)
     317        $(CHICKEN_BUG_PROGRAM)$(EXE)
    326318else
    327319CHICKEN_STATIC_EXECUTABLE = $(CHICKEN_PROGRAM)-static$(EXE)
     
    335327        $(CSC_PROGRAM)$(EXE) $(CHICKEN_INSTALL_PROGRAM)$(EXE) $(CHICKEN_UNINSTALL_PROGRAM)$(EXE) \
    336328        $(CHICKEN_STATUS_PROGRAM)$(EXE) setup-download.so setup-api.so \
    337         chicken.info $(CHICKEN_BUG_PROGRAM)$(EXE) \
     329        $(CHICKEN_BUG_PROGRAM)$(EXE) \
    338330        $(IMPORT_LIBRARIES:%=%.import.so)
    339331endif
  • chicken/branches/prerelease/distribution/manifest

    r13240 r13859  
    129129hen.el
    130130scheme-complete.el
    131 html/accessing-external-objects.html
    132 html/acknowledgements.html
    133 html/basic-mode-of-operation.html
    134 html/bibliography.html
    135 html/bugs-and-limitations.html
    136 html/c-interface.html
    137 html/callbacks.html
    138 html/data-representation.html
    139 html/declarations.html
    140 html/modules-and-macros.html
    141 html/deviations-from-the-standard.html
    142 html/embedding.html
    143 html/extensions-to-the-standard.html
     131html/Accessing external objects.html
     132html/Acknowledgements.html
     133html/Basic mode of operation.html
     134html/Bibliography.html
     135html/Bugs and limitations.html
     136html/C interface.html
     137html/Callbacks.html
     138html/Data representation.html
     139html/Declarations.html
     140html/Deviations from the standard.html
     141html/Embedding.html
     142html/Extensions to the standard.html
     143html/Extensions.html
     144html/Foreign type specifiers.html
     145html/Getting started.html
     146html/Interface to external functions and variables.html
     147html/Locations.html
     148html/Modules and macros.html
     149html/Non-standard macros and special forms.html
     150html/Non-standard read syntax.html
     151html/Other support procedures.html
     152html/Getting Started.html
     153html/Parameters.html
     154html/Supported language.html
     155html/The User's Manual.html
     156html/Unit data-structures.html
     157html/Unit eval.html
     158html/Unit expand.html
     159html/Unit extras.html
     160html/Unit files.html
     161html/Unit library.html
     162html/Unit lolevel.html
     163html/Unit ports.html
     164html/Unit posix.html
     165html/Unit regex.html
     166html/Unit srfi-1.html
     167html/Unit srfi-13.html
     168html/Unit srfi-14.html
     169html/Unit srfi-18.html
     170html/Unit srfi-4.html
     171html/Unit tcp.html
     172html/Unit utils.html
     173html/Using the compiler.html
     174html/Using the interpreter.html
    144175html/faq.html
    145 html/foreign-type-specifiers.html
    146 html/getting-started.html
    147 html/index.html
    148 html/interface-to-external-functions-and-variables.html
    149 html/locations.html
    150 html/non-standard-macros-and-special-forms.html
    151 html/non-standard-read-syntax.html
    152 html/other-support-procedures.html
    153 html/parameters.html
    154 html/supported-language.html
    155 html/unit-data-structures.html
    156 html/unit-ports.html
    157 html/unit-files.html
    158 html/unit-eval.html
    159 html/unit-extras.html
    160 html/unit-library.html
    161 html/unit-lolevel.html
    162 html/unit-posix.html
    163 html/unit-regex.html
    164 html/unit-srfi-1.html
    165 html/unit-srfi-13.html
    166 html/unit-srfi-14.html
    167 html/unit-srfi-18.html
    168 html/unit-srfi-4.html
    169 html/unit-srfi-69.html
    170 html/unit-tcp.html
    171 html/unit-utils.html
    172 html/using-the-compiler.html
    173 html/using-the-interpreter.html
     176html/manual.css
    174177library.scm
    175178lolevel.scm
     
    206209tests/r4rstest.out
    207210tests/port-tests.scm
    208 tests/test-gc-hook.scm
     211tests/test-gc-hooks.scm
    209212tests/matchable.scm
    210213tests/match-tests.scm
    211214tests/module-tests.scm
    212215tests/test-finalizers.scm
     216tests/test-finalizers-2.scm
    213217tests/module-tests-compiled.scm
    214218tests/syntax-tests.scm
     
    228232tests/re-tests.txt
    229233tests/lolevel-tests.scm
     234tests/feeley-dynwind.scm
    230235tweaks.scm
    231236utils.scm
     
    235240apply-hack.ppc.sysv.s
    236241apply-hack.sparc64.s
    237 chicken.texi
    238242chicken.pdf
    239243Makefile
     
    250254defaults.make
    251255private-namespace.scm
    252 scripts/makedist.scm
    253 scripts/makehtml.scm
    254 scripts/maketexi.scm
    255 scripts/enscript-texinfo.scm
    256 scripts/dpkg-eggs.scm
    257256scripts/scheme
    258257svnrevision.sh
  • chicken/branches/prerelease/eval.scm

    r13240 r13859  
    134134                  (##sys#string-append
    135135                   p
    136                    (if (memq (string-ref p (fx- (##sys#size p) 1)) '(#\\ #\/))
    137                        "" "/") ) ) ) )
     136                   (if (memq (string-ref p (fx- (##sys#size p) 1)) '(#\\ #\/)) "" "/")) ) ) )
    138137    (lambda (#!optional dir)
    139138      (and prefix
     
    157156          (##core#inline "C_fixnum_modulo" cache-h n)
    158157          (begin
    159               (set! cache-s s)
    160               (set! cache-h (##core#inline "C_hash_string" (##sys#slot s 1)))
    161               (##core#inline "C_fixnum_modulo" cache-h n))))))
     158            (set! cache-s s)
     159            (set! cache-h (##core#inline "C_hash_string" (##sys#slot s 1)))
     160            (##core#inline "C_fixnum_modulo" cache-h n))))))
    162161
    163162(define (##sys#hash-table-ref ht key)
    164163  (let loop ((bucket (##sys#slot ht (##sys#hash-symbol key (##core#inline "C_block_size" ht)))))
    165       (if (eq? '() bucket)
    166           #f
    167           (if (eq? key (##sys#slot (##sys#slot bucket 0) 0))
    168               (##sys#slot (##sys#slot bucket 0) 1)
    169               (loop (##sys#slot bucket 1))))))
     164      (and (not (eq? '() bucket))
     165           (if (eq? key (##sys#slot (##sys#slot bucket 0) 0))
     166               (##sys#slot (##sys#slot bucket 0) 1)
     167               (loop (##sys#slot bucket 1))))))
    170168
    171169(define (##sys#hash-table-set! ht key val)
     
    186184    (do ((i 0 (fx+ i 1)))
    187185        ((fx>= i len))
    188       (##sys#for-each (lambda (bucket)
    189                    (p (##sys#slot bucket 0)
    190                       (##sys#slot bucket 1) ) )
    191                  (##sys#slot ht i) ) ) ) )
     186      (##sys#for-each (lambda (bucket) (p (##sys#slot bucket 0) (##sys#slot bucket 1)))
     187                      (##sys#slot ht i) ) ) ) )
    192188
    193189(define ##sys#hash-table-location
     
    13451341(define ##sys#interaction-environment (##sys#make-structure 'environment #f #t))
    13461342
     1343(define (##sys#environment? obj)
     1344  (and (##sys#structure? obj 'environment) (fx= 3 (##sys#size obj))) )
     1345
    13471346(define ##sys#copy-env-table
    13481347  (lambda (e mff mf . args)
     
    15871586            (lambda (msg . args)
    15881587              (resetports)
    1589               (##sys#print "Error" #f ##sys#standard-error)
     1588              (##sys#print "\nError" #f ##sys#standard-error)
    15901589              (when msg
    15911590                (##sys#print ": " #f ##sys#standard-error)
  • chicken/branches/prerelease/expand.scm

    r13414 r13859  
    126126(define ##sys#chicken-ffi-macro-environment '()) ; used later in foreign.import.scm
    127127
     128; Workalike of '##sys#environment?' for syntactic environments
     129(define (##sys#syntactic-environment? obj)
     130
     131  (define (simple-environment? obj)
     132    (and (list? obj)
     133         (or (null? obj)
     134             (simple-environment-entry? (car obj))
     135             #; ;enough already
     136             (call-with-current-continuation
     137               (lambda (return)
     138                 (##sys#for-each
     139                  (lambda (x) (unless (simple-environment-entry? x) (return #f) ) )
     140                  obj)
     141               #t ) ) ) ) )
     142
     143  (define (simple-environment-entry? obj)
     144    (and (pair? obj)
     145         (symbol? (car obj))
     146         (symbol? (cdr obj)) ) )
     147
     148  (define (macro-environment? obj)
     149    (and (list? obj)
     150         (or (null? obj)
     151             (macro-environment-entry? (car obj))
     152             #; ;enough already
     153             (call-with-current-continuation
     154               (lambda (return)
     155                 (##sys#for-each
     156                  (lambda (x) (unless (macro-environment-entry? x) (return #f) ) )
     157                  obj)
     158               #t ) ) ) ) )
     159
     160  (define (macro-environment-entry? obj)
     161    (and (pair? obj) (= 3 (length obj))
     162         (symbol? (car obj))
     163         (list? (cadr obj))
     164         #;(##sys#syntactic-environment? (cadr x)) ;enough already
     165         (procedure? (caddr obj)) ) )
     166
     167  (or (simple-environment? obj)
     168      (macro-environment? obj) ) )
     169
     170; Workalike of '##sys#environment-symbols' for syntactic environments
     171; (I think :-)
     172(define (##sys#syntactic-environment-symbols env pred)
     173  (define (try-alias id)
     174    (or (##sys#get id '##core#real-name)
     175        (let ((alias (##sys#get id '##core#macro-alias)))
     176          (cond ((not alias) id)
     177                ((pair? alias) id)
     178                (else alias) ) ) ) )
     179  (let ((syms '()))
     180    (##sys#for-each
     181     (lambda (cell)
     182       (let ((id (car cell)))
     183         (cond ((pred id)
     184                (set! syms (cons id syms)) )
     185               ((try-alias id) =>
     186                (lambda (name)
     187                  (when (pred name) (set! syms (cons name syms))) ) ) ) ) )
     188     env)
     189   syms ) )
     190
    128191(define (##sys#extend-macro-environment name se handler)
    129192  (let ((me (##sys#macro-environment)))
     
    141204    (apply ##sys#extend-macro-environment new def) ) )
    142205
    143 (define (macro? sym #!optional (senv (##sys#current-environment)))
    144   (##sys#check-symbol sym 'macro?)
    145   (##sys#check-list senv 'macro?)
     206(define (##sys#macro? sym #!optional (senv (##sys#current-environment)))
    146207  (or (let ((l (lookup sym senv)))
    147208        (pair? l))
     
    157218            (else (cons (car me) (loop (cdr me))))))))
    158219
    159 (define (undefine-macro! name)
    160   (##sys#check-symbol name 'undefine-macro!)
     220(define (##sys#undefine-macro! name)
    161221  (##sys#unregister-macro name) )
    162222
  • chicken/branches/prerelease/extras.scm

    r13240 r13859  
    3030 (uses data-structures ports)
    3131 (usual-integrations)
    32  (disable-warning redef)
    33  (foreign-declare #<<EOF
    34 #define C_hashptr(x)   C_fix(x & C_MOST_POSITIVE_FIXNUM)
    35 #define C_mem_compare(to, from, n)   C_fix(C_memcmp(C_c_string(to), C_c_string(from), C_unfix(n)))
    36 EOF
    37 ) )
     32 (disable-warning redef) )
    3833
    3934(cond-expand
     
    6560(declare
    6661  (hide
    67     fprintf0 generic-write
    68     unbound-value-thunk reverse-string-append
    69     %object-uid-hash %eq?-hash %eqv?-hash %equal?-hash
    70     %hash-table-copy %hash-table-ref %hash-table-update! %hash-table-merge!
    71     %hash-table-for-each %hash-table-fold
    72     hash-table-canonical-length hash-table-rehash) )
     62    fprintf0 generic-write reverse-string-append) )
    7363
    7464(include "unsafe-declarations.scm")
  • chicken/branches/prerelease/files.scm

    r13240 r13859  
    5050      ##sys#windows-platform)
    5151    (bound-to-procedure
    52       string-search string-match regexp regexp-escape
    53       ##sys#symbol-has-toplevel-binding? ##sys#environment-symbols
    54       ##sys#hash-table-for-each ##sys#macro-environment
    55       ##sys#string-append reverse port? read-string with-input-from-file command-line-arguments
    56       for-each-line ##sys#check-port read-line getenv make-pathname file-exists? call-with-output-file
    57       decompose-pathname absolute-pathname? string-append ##sys#substring
    58       delete-file system)
     52      string-match regexp
     53      ##sys#string-append ##sys#substring  string-append
     54      getenv
     55      file-exists? delete-file
     56      call-with-output-file read-string)
    5957    (no-procedure-checks-for-usual-bindings)
    6058    (no-bound-checks))] )
  • chicken/branches/prerelease/library.scm

    r13414 r13859  
    4141#include <errno.h>
    4242#include <time.h>
     43#include <float.h>
    4344
    4445#ifdef HAVE_SYSEXITS_H
     
    733734;;; Numeric routines:
    734735
     736(define most-positive-fixnum (foreign-value "C_MOST_POSITIVE_FIXNUM" int))
     737(define most-negative-fixnum (foreign-value "C_MOST_NEGATIVE_FIXNUM" int))
     738(define fixnum-bits (foreign-value "(C_WORD_SIZE - 1)" int))
     739(define fixnum-precision (foreign-value "(C_WORD_SIZE - (1 + 1))" int))
     740
    735741(define (fixnum? x) (##core#inline "C_fixnump" x))
    736742(define (fx+ x y) (##core#inline "C_fixnum_plus" x y))
     
    769775    (fx-check-divison-by-zero x y 'fxmod)
    770776    (##core#inline "C_fixnum_modulo" x y) ] ) )
     777
     778(define maximum-flonum (foreign-value "DBL_MAX" double))
     779(define minimum-flonum (foreign-value "DBL_MIN" double))
     780(define flonum-radix (foreign-value "FLT_RADIX" int))
     781(define flonum-epsilon (foreign-value "DBL_EPSILON" double))
     782(define flonum-precision (foreign-value "DBL_MANT_DIG" int))
     783(define flonum-decimal-precision (foreign-value "DBL_DIG" int))
     784(define flonum-maximum-exponent (foreign-value "DBL_MAX_EXP" int))
     785(define flonum-minimum-exponent (foreign-value "DBL_MIN_EXP" int))
     786(define flonum-maximum-decimal-exponent (foreign-value "DBL_MAX_10_EXP" int))
     787(define flonum-minimum-decimal-exponent (foreign-value "DBL_MIN_10_EXP" int))
    771788
    772789(define (flonum? x) (##core#inline "C_i_flonump" x))
     
    20942111(define case-sensitive (make-parameter #t))
    20952112(define keyword-style (make-parameter #:suffix))
     2113(define parentheses-synonyms (make-parameter #t))
     2114(define symbol-escape (make-parameter #t))
     2115
    20962116(define current-read-table (make-parameter (##sys#make-structure 'read-table #f #f #f)))
    20972117
     
    21272147        [csp case-sensitive]
    21282148        [ksp keyword-style]
     2149        [psp parentheses-synonyms]
     2150        [sep symbol-escape]
    21292151        [crt current-read-table]
    2130         [kwprefix (string (integer->char 0))] )
     2152        [kwprefix (string (integer->char 0))])
    21312153    (lambda (port infohandler)
    2132       (let ([terminating-characters '(#\, #\; #\( #\) #\[ #\] #\{ #\} #\' #\")]
    2133             [csp (csp)]
     2154      (let ([csp (csp)]
    21342155            [ksp (ksp)]
     2156            [psp (psp)]
     2157            [sep (sep)]
    21352158            [crt (crt)]
    2136             [rat-flag #f] )
     2159            [rat-flag #f]
     2160            ; set below - needs more state to make a decision
     2161            [terminating-characters #f]
     2162            [reserved-characters #f] )
    21372163
    21382164        (define (container c)
    2139           (##sys#read-error port "unexpected list terminator" c))
     2165          (##sys#read-error port "unexpected list terminator" c) )
    21402166
    21412167        (define (info class data val)
     
    21482174            (if (and (not (##core#inline "C_eofp" c)) (not (eq? #\newline c)))
    21492175                (skip (##sys#read-char-0 port)) ) ) )
     2176
     2177        (define (reserved-character c)
     2178          (##sys#read-char-0 port)
     2179          (##sys#read-error port "reserved character" c) )
     2180
     2181        (define (read-unreserved-char-0 port)
     2182          (let ((c (##sys#read-char-0 port)))
     2183            (if (memq c reserved-characters)
     2184                (reserved-character c)
     2185                c) ) )
    21502186
    21512187        (define (readrec)
     
    23352371                    [else
    23362372                     (when (char=? c #\/) (set! rat-flag #t))
    2337                      (##sys#read-char-0 port)
     2373                     (read-unreserved-char-0 port)
    23382374                     (loop (##sys#peek-char-0 port)
    2339                        (cons (if csp
    2340                                  c
    2341                                  (char-downcase c) )
    2342                              lst) ) ] ) ) )
     2375                           (cons (if csp c (char-downcase c)) lst) ) ] ) ) )
    23432376
    23442377          (define (r-digits)
     
    23622395
    23632396          (define (r-xtoken)
    2364             (if (char=? #\| (##sys#read-char-0 port))
     2397            (if (char=? #\| (read-unreserved-char-0 port))
    23652398                (let loop ((c (##sys#read-char-0 port)) (lst '()))
    23662399                  (cond ((eof-object? c) (##sys#read-error port "unexpected end of `| ... |' symbol"))
     
    24582491            (##sys#intern-symbol (##sys#string-append kwprefix tok)) )
    24592492
     2493          ; now have the state to make a decision.
     2494          (set! terminating-characters '(#\, #\; #\( #\) #\' #\" #\[ #\] #\{ #\})
     2495          (set! reserved-characters
     2496                (if psp
     2497                    (if sep
     2498                        '()
     2499                        '(#\[ #\] #\{ #\}) )
     2500                    (if sep
     2501                        '(#\|)
     2502                        '(#\[ #\] #\{ #\} #\|))))
     2503
    24602504          (r-spaces)
    24612505          (let* ([c (##sys#peek-char-0 port)]
     
    24632507                 [h (and srst (##sys#slot srst (char->integer c)) ) ] )
    24642508            (if h
     2509                ;then handled by read-table entry
    24652510                (h c port)
     2511                ;otherwise chicken extended r5rs syntax
    24662512                (case c
    24672513                  ((#\')
     
    24852531                                (spdrst (##sys#slot crt 3))
    24862532                                (h (and spdrst (##sys#slot spdrst (char->integer dchar)) ) ) )
     2533                                 ;#<num> handled by parameterized # read-table entry?
    24872534                           (cond (h (h dchar port n))
     2535                                 ;#<num>?
    24882536                                 ((or (eq? dchar #\)) (char-whitespace? dchar)) (##sys#sharp-number-hook port n))
    24892537                                 (else (##sys#read-error port "invalid parameterized read syntax" dchar n) ) ) )
     
    24912539                                (h (and sdrst (##sys#slot sdrst (char->integer dchar)) ) ) )
    24922540                           (if h
     2541                               ;then handled by # read-table entry
    24932542                               (h dchar port)
     2543                               ;otherwise chicken extended r5rs syntax
    24942544                               (case (char-downcase dchar)
    24952545                                 ((#\x) (##sys#read-char-0 port) (r-number-with-exactness 16))
     
    25592609                                                          (##sys#read-error port "invalid `#!' token" tok) ) ) ] ) ) ) ) ) )
    25602610                                 (else (##sys#user-read-hook dchar port)) ) ) ) ) ) )
    2561                   ((#\() (r-list #\( #\)))
    2562                   ((#\{) (r-list #\{ #\}))
    2563                   ((#\[)
    2564                    (r-list #\[ #\]) )
    2565                   ((#\) #\] #\})
    2566                    (##sys#read-char-0 port)
    2567                    (container c) )
     2611                  ((#\( #;#\)) (r-list #\( #\)))
     2612                  ((#;#\( #\)) (##sys#read-char-0 port) (container c))
    25682613                  ((#\") (r-string #\"))
    25692614                  ((#\.) (r-number #f))
    25702615                  ((#\- #\+) (r-number #f))
    2571                   (else (cond [(eof-object? c) c]
    2572                               [(char-numeric? c) (r-number #f)]
    2573                               [else (r-symbol)] ) ) ) ) ) )
    2574 
     2616                  (else
     2617                   (cond [(eof-object? c) c]
     2618                         [(char-numeric? c) (r-number #f)]
     2619                         ((memq c reserved-characters)
     2620                          (reserved-character c))
     2621                         (else
     2622                          (case c
     2623                            ((#\[ #;#\]) (r-list #\[ #\]))
     2624                            ((#\{ #;#\}) (r-list #\{ #\}))
     2625                            ((#;#\[ #\] #;#\{ #\}) (##sys#read-char-0 port) (container c))
     2626                            (else (r-symbol) ) ) ) ] ) ) ) ) ) )
     2627       
    25752628        (readrec) ) ) ) )
    25762629
     
    27402793        [ksp keyword-style]
    27412794        [cpp current-print-length]
    2742         [string-append string-append] )
     2795        [string-append string-append])
    27432796    (lambda (x readable port)
    27442797      (##sys#check-port-mode port #f)
    27452798      (let ([csp (csp)]
    27462799            [ksp (ksp)]
    2747             [length-limit (print-length-limit)])
     2800            [length-limit (print-length-limit)]
     2801            [special-characters '(#\( #\) #\, #\[ #\] #\{ #\} #\' #\" #\; #\ #\` #\|)] )
    27482802
    27492803        (define (outstr port str)
     
    27772831            (or (fx<= c 32)
    27782832                (fx>= c 128)
    2779                 (memq chr '(#\( #\) #\| #\, #\[ #\] #\{ #\} #\' #\" #\; #\\ #\`)) ) ) )
     2833                (memq chr special-characters) ) ) )
    27802834
    27812835        (define (outreadablesym port str)
     
    34983552       (##sys#error-handler (lambda args (##core#inline "C_halt" "error in error")))
    34993553       (cond ((##sys#fudge 4)
    3500               (##sys#print "Error" #f ##sys#standard-error)
     3554              (##sys#print "\nError" #f ##sys#standard-error)
    35013555              (when msg
    35023556                (##sys#print ": " #f ##sys#standard-error)
     
    35773631       '(user-interrupt) ) ) ]
    35783632    [(#:warning)
    3579      (##sys#print "Warning: " #f ##sys#standard-error)
     3633     (##sys#print "\nWarning: " #f ##sys#standard-error)
    35803634     (##sys#print msg #f ##sys#standard-error)
    35813635     (if (or (null? args) (fx> (length args) 1))
     
    36643718                   ((##sys#reset-handler)) ) ]
    36653719                [(eq? 'user-interrupt (##sys#slot kinds 0))
    3666                  (##sys#print "*** user interrupt ***\n" #f ##sys#standard-error)
     3720                 (##sys#print "\n*** user interrupt ***\n" #f ##sys#standard-error)
    36673721                 ((##sys#reset-handler)) ]
    36683722                [(eq? 'uncaught-exception (##sys#slot kinds 0))
  • chicken/branches/prerelease/lolevel.scm

    r13240 r13859  
    2828(declare
    2929  (unit lolevel)
     30  (uses srfi-69)
    3031  (usual-integrations)
    3132  (disable-warning var redef)
     
    5960     ##sys#error ##sys#signal-hook
    6061     ##sys#error-not-a-proper-list
    61      ##sys#hash-table-ref ##sys#hash-table-set!
     62     make-hash-table hash-table-ref/default hash-table-set!
    6263     ##sys#make-pointer ##sys#make-tagged-pointer ##sys#make-locative ##sys#locative?
    6364     ##sys#become!
     
    181182      ;
    182183      (define (sizerr . args)
    183         (apply ##sys#error 'move-memory! "number of bytes to move too large" from to args)
     184        (apply ##sys#error 'move-memory! "number of bytes to move too large" from to args))
    184185      ;
    185186      (define (checkn1 n nmax off)
     
    221222                        (typerr to)] ) ) ]
    222223              [else
    223                (typerr from)] ) ) ) ) ) )
     224               (typerr from)] ) ) ) ) )
    224225
    225226
     
    513514  (let ([allocator
    514515         (if (pair? allocator) (car allocator) (foreign-lambda c-pointer "C_malloc" int) ) ]
    515         [tab (##sys#make-vector evict-table-size '())] )
     516        [tab (make-hash-table eq?)] )
    516517    (##sys#check-closure allocator 'object-evict)
    517518    (let evict ([x x])
    518519      (cond [(not (##core#inline "C_blockp" x)) x ]
    519             [(##sys#hash-table-ref tab x) ]
     520            [(hash-table-ref/default tab x #f) ]
    520521            [else
    521522             (let* ([n (##sys#size x)]
     
    523524                    [y (##core#inline "C_evict_block" x (allocator (fx+ bytes (##core#inline "C_bytes" 1))))] )
    524525               (when (symbol? x) (##sys#setislot y 0 (void)))
    525                (##sys#hash-table-set! tab x y)
     526               (hash-table-set! tab x y)
    526527               (unless (##core#inline "C_byteblockp" x)
    527528                 (do ([i (if (or (##core#inline "C_specialp" x) (symbol? x)) 1 0) (fx+ i 1)])
     
    538539                       limit)) ]
    539540         [ptr2 (##sys#address->pointer (##sys#pointer->address ptr))]
    540          [tab (##sys#make-vector evict-table-size '())]
     541         [tab (make-hash-table eq?)]
    541542         [x2
    542543          (let evict ([x x])
    543544            (cond [(not (##core#inline "C_blockp" x)) x ]
    544                   [(##sys#hash-table-ref tab x) ]
     545                  [(hash-table-ref/default tab x #f) ]
    545546                  [else
    546547                   (let* ([n (##sys#size x)]
     
    561562                     (when (symbol? x) (##sys#setislot y 0 (void)))
    562563                     (##sys#set-pointer-address! ptr2 (+ (##sys#pointer->address ptr2) bytes))
    563                      (##sys#hash-table-set! tab x y)
     564                     (hash-table-set! tab x y)
    564565                     (unless (##core#inline "C_byteblockp" x)
    565566                       (do ([i (if (or (##core#inline "C_specialp" x) (symbol? x)) 1 0) (fx+ i 1)] )
     
    588589
    589590(define (object-size x)
    590   (let ([tab (##sys#make-vector evict-table-size '())])
     591  (let ([tab (make-hash-table eq?)])
    591592    (let evict ([x x])
    592593      (cond [(not (##core#inline "C_blockp" x)) 0 ]
    593             [(##sys#hash-table-ref tab x) 0 ]
     594            [(hash-table-ref/default tab x #f) 0 ]
    594595            [else
    595596             (let* ([n (##sys#size x)]
     
    597598                     (fx+ (if (##core#inline "C_byteblockp" x) (align-to-word n) (##core#inline "C_bytes" n))
    598599                          (##core#inline "C_bytes" 1) ) ] )
    599                (##sys#hash-table-set! tab x #t)
     600               (hash-table-set! tab x #t)
    600601               (unless (##core#inline "C_byteblockp" x)
    601602                 (do ([i (if (or (##core#inline "C_specialp" x) (symbol? x)) 1 0) (fx+ i 1)])
     
    605606
    606607(define (object-unevict x #!optional full)
    607   (let ([tab (##sys#make-vector evict-table-size '())])
     608  (let ([tab (make-hash-table eq?)])
    608609    (let copy ([x x])
    609610    (cond [(not (##core#inline "C_blockp" x)) x ]
    610611          [(not (##core#inline "C_permanentp" x)) x ]
    611           [(##sys#hash-table-ref tab x) ]
     612          [(hash-table-ref/default tab x #f) ]
    612613          [(##core#inline "C_byteblockp" x)
    613614           (if full
    614615               (let ([y (##core#inline "C_copy_block" x (##sys#make-string (##sys#size x)))])
    615                  (##sys#hash-table-set! tab x y)
     616                 (hash-table-set! tab x y)
    616617                 y)
    617618               x) ]
    618619          [(symbol? x)
    619620           (let ([y (##sys#intern-symbol (##sys#slot x 1))])
    620              (##sys#hash-table-set! tab x y)
     621             (hash-table-set! tab x y)
    621622             y) ]
    622623          [else
    623624           (let* ([words (##sys#size x)]
    624625                  [y (##core#inline "C_copy_block" x (##sys#make-vector words))] )
    625              (##sys#hash-table-set! tab x y)
     626             (hash-table-set! tab x y)
    626627             (do ([i (if (##core#inline "C_specialp" x) 1 0) (fx+ i 1)])
    627628                 ((fx>= i words))
  • chicken/branches/prerelease/manual/Accessing external objects

    r13240 r13859  
    8686even have to specify an lvalue.
    8787
    88 <enscript highlight=scheme>
    89 #>
    90 enum { abc=3, def, ghi };
    91 <#
    92 
    93 (define-macro (define-simple-foreign-enum . items)
    94   `(begin
    95      ,@(map (match-lambda
    96               [(name realname) `(define-foreign-variable ,name int ,realname)]
    97               [name `(define-foreign-variable ,name int)] )
    98      items) ) )
    99 
    100 (define-simple-foreign-enum abc def ghi)
    101 
    102 ghi                               ==> 5
    103 </enscript>
    104 
    10588
    10689=== foreign-lambda
     
    173156return-type should be omitted.
    174157
    175 
     158---
    176159Previous: [[Interface to external functions and variables]]
    177160
  • chicken/branches/prerelease/manual/Acknowledgements

    r13240 r13859  
    1010Category 5, Taylor Campbell, Naruto Canada, Esteban U. Caamano Castro,
    1111Franklin Chen, Thomas Chust, Gian Paolo Ciceri, John Cowan, Grzegorz
    12 Chrupa&#322;a, James Crippen, Tollef Fog Heen, Alejandro Forero
    13 Cuervo, Linh Dang, Brian Denheyer, dgym, Don, Chris Double, Brown
    14 Dragon, Jarod Eells, Petter Egesund, Steve Elkins, Daniel B. Faken,
    15 Will Farr, Graham Fawcett, Marc Feeley, Fizzie, Matthew Flatt, Kimura
    16 Fuyuki, Tony Garnock-Jones, Martin Gasbichler, Joey Gibson, Stephen
    17 C. Gilardi, Joshua Griffith, Johannes Groedem, Damian Gryski, Mario
    18 Domenech Goulart, Andreas Gustafsson, Sven Hartrumpf, Jun-ichiro
    19 itojun Hagino, Ahdi Hargo, Matthias Heiler, Karl M. Hegbloom, William
    20 P. Heinemann, Bill Hoffman, Bruce Hoult, Hans Huebner, Markus
    21 Huelsmann, Goetz Isenmann, Paulo Jabardo, Wietse Jacobs, David
    22 Janssens, Christian Jaeger, Dale Jordan, Valentin Kamyshenko, Daishi
    23 Kato, Peter Keller, Brad Kind, Ron Kneusel, Matthias Koeppe, Krysztof
    24 Kowa&#322;czyk, Andre Kuehne, Todd R. Kueny Sr, Goran Krampe, David
    25 Krentzlin, Ben Kurtz, Micky Latowicki, John Lenz, Kirill Lisovsky,
    26 Juergen Lorenz, Kon Lovett, Dennis Marti, Charles Martin, Bob McIsaac,
    27 Alain Mellan, Eric Merrit, Perry Metzger, Scott G. Miller, Mikael,
    28 Bruce Mitchener, Chris Moline, Eric E. Moore, Julian Morrison, Dan
    29 Muresan, Lars Nilsson, Ian Oversby, o.t., Gene Pavlovsky, Levi
    30 Pearson, Nicolas Pelletier, Carlos Pita, Robin Lee Powell, Pupeno,
    31 Davide Puricelli, Doug Quale, Eric Raible, Ivan Raikov, Joel Reymont,
    32 Eric Rochester, Andreas Rottman, David Rush, Lars Rustemeier, Daniel
    33 Sadilek, Oskar Schirmer, Burton Samograd, Reed Sheridan, Ronald
    34 Schroeder, Spencer Schumann, Ivan Shcheklein, Alex Shinn, Ivan
    35 Shmakov, Shmul, Tony Sidaway, Jeffrey B. Siegal, Andrey Sidorenko,
    36 Michele Simionato, Volker Stolz, Jon Strait, Dorai Sitaram, Robert
    37 Skeels, Jason Songhurst, Clifford Stein, Sunnan, Zbigniew Szadkowski,
    38 Rick Taube, Nathan Thern, Mike Thomas, Minh Thu, Christian Tismer,
    39 Andre van Tonder, John Tobey, Henrik Tramberend, Vladimir Tsichevsky,
    40 Neil van Dyke, Sander Vesik, Jaques Vidrine, Panagiotis Vossos, Shawn
    41 Wagner, Peter Wang, Ed Watkeys, Brad Watson, Thomas Weidner, Goeran
    42 Weinholt, Matthew Welland, Drake Wilson, Joerg Wittenberger, Peter
    43 Wright, Mark Wutka, Richard Zidlicky and Houman Zolfaghari for
    44 bug-fixes, tips and suggestions.
     12Chrupa&#322;a, James Crippen, Tollef Fog Heen, Drew Hess, Alejandro
     13Forero Cuervo, Linh Dang, Brian Denheyer, dgym, Don, Chris Double,
     14Brown Dragon, Jarod Eells, Petter Egesund, Steve Elkins, Daniel
     15B. Faken, Will Farr, Graham Fawcett, Marc Feeley, Fizzie, Matthew
     16Flatt, Kimura Fuyuki, Tony Garnock-Jones, Martin Gasbichler, Joey
     17Gibson, Stephen C. Gilardi, Joshua Griffith, Johannes Groedem, Damian
     18Gryski, Mario Domenech Goulart, Andreas Gustafsson, Sven Hartrumpf,
     19Jun-ichiro itojun Hagino, Ahdi Hargo, Matthias Heiler, Karl
     20M. Hegbloom, William P. Heinemann, Bill Hoffman, Bruce Hoult, Hans
     21Huebner, Markus Huelsmann, Goetz Isenmann, Paulo Jabardo, Wietse
     22Jacobs, David Janssens, Christian Jaeger, Dale Jordan, Valentin
     23Kamyshenko, Daishi Kato, Peter Keller, Brad Kind, Ron Kneusel,
     24Matthias Koeppe, Krysztof Kowa&#322;czyk, Andre Kuehne, Todd R. Kueny
     25Sr, Goran Krampe, David Krentzlin, Ben Kurtz, Micky Latowicki, John
     26Lenz, Kirill Lisovsky, Juergen Lorenz, Kon Lovett, Dennis Marti,
     27Charles Martin, Bob McIsaac, Alain Mellan, Eric Merrit, Perry Metzger,
     28Scott G. Miller, Mikael, Bruce Mitchener, Chris Moline, Eric E. Moore,
     29Julian Morrison, Dan Muresan, Lars Nilsson, Ian Oversby, o.t., Gene
     30Pavlovsky, Levi Pearson, Nicolas Pelletier, Carlos Pita, Robin Lee
     31Powell, Pupeno, Davide Puricelli, Doug Quale, Eric Raible, Ivan
     32Raikov, Joel Reymont, Eric Rochester, Andreas Rottman, David Rush,
     33Lars Rustemeier, Daniel Sadilek, Oskar Schirmer, Burton Samograd, Reed
     34Sheridan, Ronald Schroeder, Spencer Schumann, Ivan Shcheklein, Alex
     35Shinn, Ivan Shmakov, Shmul, Tony Sidaway, Jeffrey B. Siegal, Andrey
     36Sidorenko, Michele Simionato, Volker Stolz, Jon Strait, Dorai Sitaram,
     37Robert Skeels, Jason Songhurst, Clifford Stein, Sunnan, Zbigniew
     38Szadkowski, Rick Taube, Nathan Thern, Mike Thomas, Minh Thu, Christian
     39Tismer, Andre van Tonder, John Tobey, Henrik Tramberend, Vladimir
     40Tsichevsky, Neil van Dyke, Sander Vesik, Jaques Vidrine, Panagiotis
     41Vossos, Shawn Wagner, Peter Wang, Ed Watkeys, Brad Watson, Thomas
     42Weidner, Goeran Weinholt, Matthew Welland, Drake Wilson, Joerg
     43Wittenberger, Peter Wright, Mark Wutka, Richard Zidlicky and Houman
     44Zolfaghari for bug-fixes, tips and suggestions.
    4545
    4646CHICKEN uses the "irregex" regular expression package written by Alex Shinn.
     
    7373Lisp Pointers. IV(4). December 1991.
    7474
     75---
    7576Previous: [[FAQ]]
    7677
  • chicken/branches/prerelease/manual/Basic mode of operation

    r13240 r13859  
    5454dynamically into a running application.
    5555
    56 Previous: [[The User's Manual]]
     56---
     57Previous: [[Getting started]]
     58
    5759Next: [[Using the compiler]]
  • chicken/branches/prerelease/manual/Bibliography

    r13240 r13859  
    77''Revised^5 Report on the Algorithmic Language Scheme'' [[http://www.schemers.org/Documents/Standards/R5RS]]
    88
     9---
    910Previous: [[Acknowledgements]]
  • chicken/branches/prerelease/manual/Bugs and limitations

    r5945 r13859  
    1111* Leaf routine optimization can theoretically result in code that thrashes, if tight loops perform excessively many mutations.
    1212
     13---
    1314Previous: [[Data representation]]
    1415
  • chicken/branches/prerelease/manual/C interface

    r7036 r13859  
    321321 extern int callout(int, int, int);
    322322 <#
    323 
     323 
    324324 (define callout (foreign-safe-lambda int "callout" int int int))
    325 
     325 
    326326 (define-external (callin (scheme-object xyz)) int
    327327   (print "This is 'callin': " xyz)
    328328   123)
    329 
     329 
    330330 (print (callout 1 2 3))
    331331
     
    333333 #include <stdio.h>
    334334 #include "chicken.h"
    335 
     335 
    336336 extern int callout(int, int, int);
    337337 extern int callin(C_word x);
    338 
     338 
    339339 int callout(int x, int y, int z)
    340340 {
    341341   C_word *ptr = C_alloc(C_SIZEOF_LIST(3));
    342342   C_word lst;
    343 
     343 
    344344   printf("This is 'callout': %d, %d, %d\n", x, y, z);
    345345   lst = C_list(&ptr, 3, C_fix(x), C_fix(y), C_fix(z));
     
    356356=== Notes:
    357357
    358 Scheme procedures can call C functions, and C functions can call
    359 Scheme procedures, but for every pending C stack frame, the available
    360 size of the first heap generation (the ''nursery'') will be decreased,
    361 because the C stack is identical to the nursery. On systems with a small
    362 nursery this might result in thrashing, since the C code between the
    363 invocation of C from Scheme and the actual calling back to Scheme might
    364 build up several stack-frames or allocates large amounts of stack data.
    365 To prevent this it is advisable to increase the default nursery size,
    366 either when compiling the file (using the {{-nursery}} option)
    367 or when running the executable (using the {{-:s}} runtime option).
    368 
    369 Calls to Scheme/C may be nested arbitrarily, and Scheme
    370 continuations can be invoked as usual, but keep in mind that C stack
    371 frames will not be recovered, when a Scheme procedure call from C does
    372 not return normally.
    373 
    374 When multiple threads are running concurrently, and control switches
    375 from one thread to another, then the continuation of the current thread
    376 is captured and saved. Any pending C stack frame still active from a
    377 callback will remain on the stack until the threads is re-activated
    378 again. This means that in a multithreading situation, when C callbacks
    379 are involved, the available nursery space can be smaller than expected.
    380 So doing many nested Scheme->C->Scheme calls can reduce the available
    381 memory up to the point of thrashing. It is advisable to have only a
    382 single thread with pending C stack-frames at any given time.
    383 
    384 Pointers to Scheme data objects should not be stored in local or
    385 global variables while calling back to Scheme.  Any Scheme object not
    386 passed back to Scheme will be reclaimed or moved by the garbage collector.
    387 
    388 Calls from C to Scheme are never tail-recursive.
    389 
    390 Continuations captured via {{call-with-current-continuation}}
    391 and passed to C code can be invoked like any other Scheme procedure.
    392 
    393 
    394 
     358* Scheme procedures can call C functions, and C functions can call
     359  Scheme procedures, but for every pending C stack frame, the available
     360  size of the first heap generation (the ''nursery'') will be decreased,
     361  because the C stack is identical to the nursery. On systems with a small
     362  nursery this might result in thrashing, since the C code between the
     363  invocation of C from Scheme and the actual calling back to Scheme might
     364  build up several stack-frames or allocates large amounts of stack data.
     365  To prevent this it is advisable to increase the default nursery size,
     366  either when compiling the file (using the {{-nursery}} option)
     367  or when running the executable (using the {{-:s}} runtime option).
     368* Calls to Scheme/C may be nested arbitrarily, and Scheme
     369  continuations can be invoked as usual, but keep in mind that C stack
     370  frames will not be recovered, when a Scheme procedure call from C does
     371  not return normally.
     372* When multiple threads are running concurrently, and control switches
     373  from one thread to another, then the continuation of the current thread
     374  is captured and saved. Any pending C stack frame still active from a
     375  callback will remain on the stack until the threads is re-activated
     376  again. This means that in a multithreading situation, when C callbacks
     377  are involved, the available nursery space can be smaller than expected.
     378  So doing many nested Scheme->C->Scheme calls can reduce the available
     379  memory up to the point of thrashing. It is advisable to have only a
     380  single thread with pending C stack-frames at any given time.
     381* Pointers to Scheme data objects should not be stored in local or
     382  global variables while calling back to Scheme.  Any Scheme object not
     383  passed back to Scheme will be reclaimed or moved by the garbage collector.
     384* Calls from C to Scheme are never tail-recursive.
     385* Continuations captured via {{call-with-current-continuation}}
     386  and passed to C code can be invoked like any other Scheme procedure.
     387
     388
     389---
    395390Previous: [[Other support procedures]]
    396391
    397 Next: [[chicken-setup]]
     392Next: [[Extensions]]
  • chicken/branches/prerelease/manual/Callbacks

    r7078 r13859  
    2323Non-local exits leaving the scope of the invocation of a callback from Scheme into C
    2424will not remove the C call-frame from the stack (and will result in a memory
    25 leak).
    26 
     25leak).  '''Note:''' The same applies to
     26SRFI-18 threading, which is implemented with {{call/cc}};
     27additionally, if you enter one callback, switch threads and then exit
     28a different callback, your program is likely to crash.
    2729
    2830
     
    9294that the value pointed to by {{ptr}} is located in the stack.
    9395
     96---
    9497Previous: [[Embedding]]
    9598
  • chicken/branches/prerelease/manual/Data representation

    r13240 r13859  
    113113For more information see the header file {{chicken.h}}.
    114114
     115---
    115116Previous: [[Extensions]]
    116117
  • chicken/branches/prerelease/manual/Declarations

    r13240 r13859  
    322322knows about them.
    323323
     324---
    324325Previous: [[Modules and macros]]
    325326
  • chicken/branches/prerelease/manual/Deviations from the standard

    r10911 r13859  
    44
    55Identifiers are by default case-sensitive (see
    6 [[http://galinha.ucpel.tche.br:8080/Using%20the%20compiler#Compiler%20command%20line%20format|Compiler
    7 command line format]]).
     6[[http://galinha.ucpel.tche.br:8080/Using%20the%20compiler#Compiler%20command%20line%20format|Compiler command line format]]).
    87
    98[4.1.3] The maximal number of arguments that may be passed to a
     
    7170not implemented.
    7271
     72---
    7373Previous: [[Supported language]]
    7474
  • chicken/branches/prerelease/manual/Embedding

    r13240 r13859  
    335335Sets the value of the global variable referenced by the GC root {{global}} to {{value}}.
    336336
     337---
    337338Previous: [[Foreign type specifiers]]
    338339
  • chicken/branches/prerelease/manual/Extensions

    </
    r13240 r13859  
    7272Extensions can be created by creating an (optionally gzipped) {{tar}}
    7373archive named {{EXTENSION.egg}} containing all needed files plus a
    74 {{.setup}} script in the root directory.  After {{chicken-setup}} has
     74{{.setup}} script in the root directory.  After {{chicken-install}} has
    7575extracted the files, the setup script will be invoked. There are no
    7676additional constraints on the structure of the archive, but the setup
     
    267267 [parameter] (setup-root-directory [PATH])
    268268
    269 Contains the path of the directory where {{chicken-setup}} was invoked.
     269Contains the path of the directory where {{chicken-install}} was invoked.
    270270
    271271
     
    526526
    527527<enscript highlight=scheme>
    528 (compile -s -O2 -d1 my-ext.scm)   ; dynamically loadable "normal" version
    529 (compile -c -O2 -d1 my-ext -unit my-ext)  ; statically linkable version
    530 (install-extension
    531   'my-ext
    532   '("my-ext.so" "my-ext.o")
    533   '((static "my-ext.o")) )
     528 (compile -s -O2 -d1 my-ext.scm)   ; dynamically loadable "normal" version
     529 (compile -c -O2 -d1 my-ext -unit my-ext)  ; statically linkable version
     530 (install-extension
     531   'my-ext
     532   '("my-ext.so" "my-ext.o")
     533   '((static "my-ext.o")) )
    534534</enscript>
    535535
     
    550550mailing list.
    551551
    552 
     552---
    553553Previous: [[Interface to external functions and variables]]
    554554