Changeset 13965 in project


Ignore:
Timestamp:
03/27/09 13:10:53 (11 years ago)
Author:
felix winkelmann
Message:

merged trunk rev. 13953

Location:
chicken/branches/scrutiny
Files:
7 deleted
96 edited
12 copied

Legend:

Unmodified
Added
Removed
  • chicken/branches/scrutiny

  • chicken/branches/scrutiny/Makefile.cross-linux-mingw

    r12937 r13965  
    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/scrutiny/Makefile.linux

    r12935 r13965  
    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/scrutiny/Makefile.macosx

    r12937 r13965  
    5858APPLY_HACK_OBJECT = apply-hack.$(ARCH)$(O)
    5959
     60# architectures
     61
     62ifeq ($(ARCH),x86-64)
     63C_COMPILER_OPTIONS += -m64
     64LINKER_OPTIONS += -m64
     65else
     66
     67ifeq ($(ARCH),universal)
     68C_COMPILER_OPTIONS += -arch ppc -arch i386 -isysroot /Developer/SDKs/MacOSX10.4u.sdk
     69LINKER_OPTIONS += -arch ppc -arch i386 -isysroot /Developer/SDKs/MacOSX10.4u.sdk
     70
     71ifneq ($(HACKED_APPLY),)
     72# We undefine HACKED_APPLY in order to override rules.make.
     73HACKED_APPLY=
     74apply-hack.ppc.darwin$(O): apply-hack.ppc.darwin.s
     75        as -arch ppc -o $@ $<
     76apply-hack.x86$(O): apply-hack.x86.s
     77        as -arch i386 -o $@ $<
     78$(APPLY_HACK_OBJECT): apply-hack.x86$(O) apply-hack.ppc.darwin$(O)
     79        lipo -create -output $(APPLY_HACK_OBJECT) $^
     80endif
     81endif
     82endif
     83
    6084# select default and internal settings
    6185
     
    103127        cat chicken-defaults.h >>$@
    104128
    105 # architectures
    106 
    107 ifeq ($(ARCH),x86-64)
    108 C_COMPILER_OPTIONS += -m64
    109 LINKER_OPTIONS += -m64
    110 else
    111 
    112 ifeq ($(ARCH),universal)
    113 C_COMPILER_OPTIONS += -arch ppc -arch i386 -isysroot /Developer/SDKs/MacOSX10.4u.sdk
    114 LINKER_OPTIONS += -arch ppc -arch i386 -isysroot /Developer/SDKs/MacOSX10.4u.sdk
    115 
    116 ifneq ($(HACKED_APPLY),)
    117 # We undefine HACKED_APPLY in order to override rules.make.
    118 HACKED_APPLY=
    119 apply-hack.ppc.darwin$(O): apply-hack.ppc.darwin.s
    120         as -arch ppc -o $@ $<
    121 apply-hack.x86$(O): apply-hack.x86.s
    122         as -arch i386 -o $@ $<
    123 $(APPLY_HACK_OBJECT): apply-hack.x86$(O) apply-hack.ppc.darwin$(O)
    124         lipo -create -output $(APPLY_HACK_OBJECT) $^
    125 endif
    126 
    127 endif
    128 endif
    129 
    130129include $(SRCDIR)/rules.make
  • chicken/branches/scrutiny/Makefile.mingw

    r13246 r13965  
    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/scrutiny/Makefile.mingw-msys

    r13246 r13965  
    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/scrutiny/Makefile.msvc

    r13141 r13965  
    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/scrutiny/NEWS

    r12940 r13965  
    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/scrutiny/README

    r12957 r13965  
    44  (c) 2008-2009, The Chicken Team
    55
    6   version 4.0.0x5
     6  version 4.0.1x1
    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/scrutiny/TODO

    r13964 r13965  
    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*** extend scripts/guess-platforms.sh for more platforms
    106106
    107107** documentation
     
    143143   looping lambda + dispatch (static variable can be used), otherwise similar to
    144144   a conditional
    145 *** new forms (after optimization, prepared language)
    146     [##core#dispatch LAMBDABODY1 ... BODY]
    147     [##core#goto {INDEX} ARGUMENT1 ...}
    148145
    149146** lazy gensyms (see "lazy-gensyms" branch)
  • chicken/branches/scrutiny/batch-driver.scm

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

    r12920 r13965  
    1 4.0.0x5
     14.0.1x1
  • chicken/branches/scrutiny/c-platform.scm

    r13755 r13965  
    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 scrutinize) )
     125    analyze-only dynamic scrutinize
     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/scrutiny/chicken-bug.scm

    r12956 r13965  
    3535(define-constant +destination+ "chicken-janitors@nongnu.org")
    3636(define-constant +mxservers+ (list "mx10.gnu.org" "mx20.gnu.org"))
     37(define-constant +send-tries+ 3)
    3738
    3839(define-foreign-variable +cc+ c-string "C_TARGET_CC")
     
    4041(define-foreign-variable +c-include-path+ c-string "C_INSTALL_INCLUDE_HOME")
    4142
     43(define (user-id)
     44  (cond-expand
     45   ((or mingw32 msvc) "<not available>")
     46   (else (user-information (current-user-id)))))
    4247
    4348(define (collect-info)
     
    4550  (print "This is a bug report generated by chicken-bug(1).\n")
    4651  (print "Date:\t" (seconds->string (current-seconds)) "\n\n")
    47   (printf "User information:\t~s~%~%" (user-information (current-user-id)))
     52  (printf "User information:\t~s~%~%" (user-id))
    4853  (print "Host information:\n")
    4954  (print "\tmachine type:\t" (machine-type))
     
    235240
    236241(define (send-mail serv msg hdrs fname)
    237   (print "connecting to " serv " ...")
    238     (receive (i o)
    239         (tcp-connect serv 25)
    240         (call-with-current-continuation
    241             (lambda (k)
    242                 (mail-check i o (mail-read i o) 220 k)
    243                 (mail-check i o (mail-write i o "HELO callcc.org\r\n") 250 k)
    244                 (mail-check i o (mail-write i o "MAIL FROM:<chicken-bug-command@callcc.org>\r\n") 250 k)
    245                 (mail-check i o (mail-write i o "RCPT TO:<chicken-janitors@nongnu.org>\r\n") 250 k)
    246                 (mail-check i o (mail-write i o "DATA\r\n") 354 k)
    247                 (mail-check i o (mail-write i o (string-append hdrs fname "\r\n\r\n" msg "\r\n.\r\n")) 250 k)
    248                 (display "QUIT" o)
    249                 (close-input-port i)
    250                 (close-output-port o)
    251                 (print "Bug report successfully mailed to the Chicken maintainers.\nThank you very much!\n\n")
    252                 #t))))
     242  (call/cc
     243   (lambda (return)
     244     (do ((try 1 (add1 try)))
     245         ((> try +send-tries+))
     246       (print* "connecting to " serv ", try #" try " ...")
     247       (receive (i o)
     248           (tcp-connect serv 25)
     249         (call-with-current-continuation
     250          (lambda (k)
     251            (mail-check i o (mail-read i o) 220 k)
     252            (mail-check i o (mail-write i o "HELO callcc.org\r\n") 250 k)
     253            (mail-check i o (mail-write i o "MAIL FROM:<chicken-bug-command@callcc.org>\r\n") 250 k)
     254            (mail-check i o (mail-write i o "RCPT TO:<chicken-janitors@nongnu.org>\r\n") 250 k)
     255            (mail-check i o (mail-write i o "DATA\r\n") 354 k)
     256            (mail-check i o (mail-write i o (string-append hdrs fname "\r\n\r\n" msg "\r\n.\r\n")) 250 k)
     257            (display "QUIT" o)
     258            (close-input-port i)
     259            (close-output-port o)
     260            (print "ok.\n\nBug report successfully mailed to the Chicken maintainers.\nThank you very much!\n\n")
     261            (return #t))))
     262       (print " failed.")))))
    253263
    254264(main (command-line-arguments))
  • chicken/branches/scrutiny/chicken-install.scm

    r13023 r13965  
    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/scrutiny/chicken-primitive-object-inlines.scm

    r13168 r13965  
    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/scrutiny/chicken-thread-object-inlines.scm

    r13167 r13965  
    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/scrutiny/chicken.h

    r13328 r13965  
    10381038#define C_words(n)                      C_fix(C_bytestowords(C_unfix(n)))
    10391039#define C_bytes(n)                      C_fix(C_wordstobytes(C_unfix(n)))
    1040 #define C_random_fixnum(n)              C_fix(rand() % C_unfix(n))
     1040#define C_random_fixnum(n)              C_fix((int)(((double)rand())/(RAND_MAX + 1.0) * C_unfix(n)))
    10411041#define C_randomize(n)                  (srand(C_unfix(n)), C_SCHEME_UNDEFINED)
    10421042#define C_block_size(x)                 C_fix(C_header_size(x))
  • chicken/branches/scrutiny/chicken.import.scm

    r12937 r13965  
    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/scrutiny/compiler.scm

    r13964 r13965  
    919919                                      (mark-variable var '##compiler#always-bound-to-procedure)
    920920                                      (mark-variable var '##compiler#always-bound))
    921                                     (when (macro? var)
     921                                    (when (##sys#macro? var)
    922922                                      (compiler-warning
    923923                                       'var "assigned global variable `~S' is a macro ~A"
    924924                                       var
    925925                                       (if ln (sprintf "in line ~S" ln) "") )
    926                                       (when undefine-shadowed-macros (undefine-macro! var) ) ) )
     926                                      (when undefine-shadowed-macros (##sys#undefine-macro! var) ) ) )
    927927                                  (when (keyword? var)
    928928                                    (compiler-warning 'syntax "assignment to keyword `~S'" var) )
     
    12191219          ((and (pair? (car x))
    12201220                (symbol? (caar x))
    1221                 (eq? 'lambda (or (lookup (caar x) se) (caar x))))
     1221                (memq (or (lookup (caar x) se) (caar x)) '(lambda ##core#lambda)))
    12221222           (let ([lexp (car x)]
    12231223                 [args (cdr x)] )
    12241224             (emit-syntax-trace-info x #f)
    1225              (##sys#check-syntax 'lambda lexp '(lambda lambda-list . #(_ 1)) #f se)
     1225             (##sys#check-syntax 'lambda lexp '(_ lambda-list . #(_ 1)) #f se)
    12261226             (let ([llist (cadr lexp)])
    12271227               (if (and (proper-list? llist) (= (llist-length llist) (length args)))
  • chicken/branches/scrutiny/csc.scm

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

    r13138 r13965  
    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/scrutiny/data-structures.scm

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

    r13911 r13965  
    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
     
    139133TARGET_LIBRARIES ?= $(LIBRARIES)
    140134TARGET_LINKER_OPTIONS ?= $(LINKER_OPTIONS)
     135TARGET_LINKER_OPTIMIZATION_OPTIONS ?= $(LINKER_OPTIMIZATION_OPTIONS)
    141136
    142137ifneq ($(TARGET_C_COMPILER),$(C_COMPILER))
     
    192187MAKE_WRITABLE_COMMAND ?= chmod 0755
    193188endif
    194 MAKEINFO_PROGRAM_OPTIONS ?= --no-split
    195189ifndef WINDOWS_SHELL
    196190INSTALL_PROGRAM_SHARED_LIBRARY_OPTIONS ?= -m755
     
    213207LIBCHICKENGUI_SO_FILE ?=
    214208else
    215 PRIMARY_LIBCHICKEN ?= libchicken$(SO)$(SONAME_VERSION)
    216 LIBCHICKEN_SO_FILE ?= libchicken$(SO)$(SONAME_VERSION)
    217 LIBUCHICKEN_SO_FILE ?= libuchicken$(SO)$(SONAME_VERSION)
     209PRIMARY_LIBCHICKEN ?= libchicken$(SO)
     210LIBCHICKEN_SO_FILE ?= libchicken$(SO)
     211LIBUCHICKEN_SO_FILE ?= libuchicken$(SO)
    218212LIBCHICKENGUI_SO_FILE ?=
    219213endif
    220214endif
    221 UNINSTALLINFO_PROGRAM_OPTIONS ?= --delete
    222215LIBCHICKEN_SO_LIBRARIES ?= $(LIBRARIES)
    223216LIBUCHICKEN_SO_LIBRARIES ?= $(LIBRARIES)
     
    322315        $(CSI_STATIC_EXECUTABLE) $(CHICKEN_PROFILE_PROGRAM)$(EXE) \
    323316        $(CSC_PROGRAM)$(EXE) \
    324         chicken.info $(CHICKEN_BUG_PROGRAM)$(EXE)
     317        $(CHICKEN_BUG_PROGRAM)$(EXE)
    325318else
    326319CHICKEN_STATIC_EXECUTABLE = $(CHICKEN_PROGRAM)-static$(EXE)
     
    334327        $(CSC_PROGRAM)$(EXE) $(CHICKEN_INSTALL_PROGRAM)$(EXE) $(CHICKEN_UNINSTALL_PROGRAM)$(EXE) \
    335328        $(CHICKEN_STATUS_PROGRAM)$(EXE) setup-download.so setup-api.so \
    336         chicken.info $(CHICKEN_BUG_PROGRAM)$(EXE) \
     329        $(CHICKEN_BUG_PROGRAM)$(EXE) \
    337330        $(IMPORT_LIBRARIES:%=%.import.so)
    338331endif
  • chicken/branches/scrutiny/distribution/manifest

    r13755 r13965  
    130130hen.el
    131131scheme-complete.el
    132 html/accessing-external-objects.html
    133 html/acknowledgements.html
    134 html/basic-mode-of-operation.html
    135 html/bibliography.html
    136 html/bugs-and-limitations.html
    137 html/c-interface.html
    138 html/callbacks.html
    139 html/data-representation.html
    140 html/declarations.html
    141 html/modules-and-macros.html
    142 html/deviations-from-the-standard.html
    143 html/embedding.html
    144 html/extensions-to-the-standard.html
     132html/Accessing external objects.html
     133html/Acknowledgements.html
     134html/Basic mode of operation.html
     135html/Bibliography.html
     136html/Bugs and limitations.html
     137html/C interface.html
     138html/Callbacks.html
     139html/Data representation.html
     140html/Declarations.html
     141html/Deviations from the standard.html
     142html/Embedding.html
     143html/Extensions to the standard.html
     144html/Extensions.html
     145html/Foreign type specifiers.html
     146html/Getting started.html
     147html/Interface to external functions and variables.html
     148html/Locations.html
     149html/Modules and macros.html
     150html/Non-standard macros and special forms.html
     151html/Non-standard read syntax.html
     152html/Other support procedures.html
     153html/Getting Started.html
     154html/Parameters.html
     155html/Supported language.html
     156html/The User's Manual.html
     157html/Unit data-structures.html
     158html/Unit eval.html
     159html/Unit expand.html
     160html/Unit extras.html
     161html/Unit files.html
     162html/Unit library.html
     163html/Unit lolevel.html
     164html/Unit ports.html
     165html/Unit posix.html
     166html/Unit regex.html
     167html/Unit srfi-1.html
     168html/Unit srfi-13.html
     169html/Unit srfi-14.html
     170html/Unit srfi-18.html
     171html/Unit srfi-4.html
     172html/Unit tcp.html
     173html/Unit utils.html
     174html/Using the compiler.html
     175html/Using the interpreter.html
    145176html/faq.html
    146 html/foreign-type-specifiers.html
    147 html/getting-started.html
    148 html/index.html
    149 html/interface-to-external-functions-and-variables.html
    150 html/locations.html
    151 html/non-standard-macros-and-special-forms.html
    152 html/non-standard-read-syntax.html
    153 html/other-support-procedures.html
    154 html/parameters.html
    155 html/supported-language.html
    156 html/unit-data-structures.html
    157 html/unit-ports.html
    158 html/unit-files.html
    159 html/unit-eval.html
    160 html/unit-extras.html
    161 html/unit-library.html
    162 html/unit-lolevel.html
    163 html/unit-posix.html
    164 html/unit-regex.html
    165 html/unit-srfi-1.html
    166 html/unit-srfi-13.html
    167 html/unit-srfi-14.html
    168 html/unit-srfi-18.html
    169 html/unit-srfi-4.html
    170 html/unit-srfi-69.html
    171 html/unit-tcp.html
    172 html/unit-utils.html
    173 html/using-the-compiler.html
    174 html/using-the-interpreter.html
     177html/manual.css
    175178library.scm
    176179lolevel.scm
     
    208211tests/r4rstest.out
    209212tests/port-tests.scm
    210 tests/test-gc-hook.scm
     213tests/test-gc-hooks.scm
    211214tests/matchable.scm
    212215tests/match-tests.scm
    213216tests/module-tests.scm
    214217tests/test-finalizers.scm
     218tests/test-finalizers-2.scm
    215219tests/module-tests-compiled.scm
    216220tests/syntax-tests.scm
     
    230234tests/re-tests.txt
    231235tests/lolevel-tests.scm
     236tests/feeley-dynwind.scm
    232237tweaks.scm
    233238utils.scm
     
    237242apply-hack.ppc.sysv.s
    238243apply-hack.sparc64.s
    239 chicken.texi
    240244chicken.pdf
    241245Makefile
     
    252256defaults.make
    253257private-namespace.scm
     258scripts/scheme
     259scripts/tools.scm
     260scripts/test-dist.sh
     261scripts/wiki2html.scm
     262scripts/make-egg-index.scm
    254263scripts/makedist.scm
    255 scripts/makehtml.scm
    256 scripts/maketexi.scm
    257 scripts/enscript-texinfo.scm
    258 scripts/dpkg-eggs.scm
    259 scripts/scheme
     264scripts/README
     265scripts/henrietta.scm
     266scripts/henrietta.cgi
    260267svnrevision.sh
    261268synrules.scm
  • chicken/branches/scrutiny/eval.scm

    r13140 r13965  
    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/scrutiny/expand.scm

    r13351 r13965  
    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/scrutiny/extras.scm

    r13140 r13965  
    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")
     
    9686;;; Random numbers:
    9787
    98 (define random-seed
    99     (let ((srand   (foreign-lambda void "srand" unsigned-integer)))
     88(cond-expand
     89  (unix
     90
     91    (define random-seed)
     92    (define randomize)
     93
     94    (let ((srandom (foreign-lambda void "srandom" unsigned-integer)))
     95
     96      (set! random-seed
     97        (lambda (#!optional (seed (current-seconds)))
     98          (##sys#check-integer seed 'random-seed)
     99          (srandom seed) ) )
     100
     101      (set! randomize
     102        (lambda (#!optional (seed (##sys#fudge 2)))
     103          (##sys#check-exact seed 'randomize)
     104          (srandom seed) ) ) )
     105
     106    (define (random n)
     107      (##sys#check-integer n 'random)
     108      (if (eq? 0 n)
     109          0
     110          ((foreign-lambda* long ((integer64 n)) "return( random() % ((uint64_t) n) );") n) ) ) )
     111  (else
     112
     113    (define random-seed
     114      (let ((srand (foreign-lambda void "srand" unsigned-integer)))
    100115        (lambda n
    101             (and (> (length n) 1)
    102                  (##sys#error 'random-seed "too many arguments" (length n) 1))
    103             (let ((t   (if (null? n)
    104                            (current-seconds)
    105                            (car n))))
    106                 (##sys#check-integer t 'random-seed)
    107                 (srand t)))))
    108 
    109 (define (random n)
    110   (##sys#check-exact n 'random)
    111   (if (eq? n 0)
    112       0
    113       (##core#inline "C_random_fixnum" n) ) )
    114 
    115 (define (randomize . n)
    116   (##core#inline
    117    "C_randomize"
    118    (if (##core#inline "C_eqp" n '())
    119        (##sys#fudge 2)
    120        (let ((nn (##sys#slot n 0)))
    121          (##sys#check-exact nn 'randomize)
    122          nn) ) ) )
     116          (let ((t (if (null? n) (current-seconds) (car n))))
     117            (##sys#check-integer t 'random-seed)
     118            (srand t) ) ) ) )
     119
     120    (define (randomize . n)
     121      (let ((nn (if (null? n) (##sys#fudge 2) (car n))))
     122        (##sys#check-exact nn 'randomize)
     123        (##core#inline "C_randomize" nn) ) )
     124
     125    (define (random n)
     126      (##sys#check-exact n 'random)
     127      (if (eq? n 0)
     128          0
     129          (##core#inline "C_random_fixnum" n) ) ) ) )
    123130
    124131
  • chicken/branches/scrutiny/files.scm

    r12937 r13965  
    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/scrutiny/library.scm

    r13304 r13965  
    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 '(#\, #\; #\( #\) #\' #\" #\[ #\] #\{ #\}))
     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! reserved-characters
     2495                (if psp
     2496                    (if sep
     2497                        '()
     2498                        '(#\[ #\] #\{ #\}) )
     2499                    (if sep
     2500                        '(#\|)
     2501                        '(#\[ #\] #\{ #\} #\|))))
     2502
    24602503          (r-spaces)
    24612504          (let* ([c (##sys#peek-char-0 port)]
     
    24632506                 [h (and srst (##sys#slot srst (char->integer c)) ) ] )
    24642507            (if h
     2508                ;then handled by read-table entry
    24652509                (h c port)
     2510                ;otherwise chicken extended r5rs syntax
    24662511                (case c
    24672512                  ((#\')
     
    24852530                                (spdrst (##sys#slot crt 3))
    24862531                                (h (and spdrst (##sys#slot spdrst (char->integer dchar)) ) ) )
     2532                                 ;#<num> handled by parameterized # read-table entry?
    24872533                           (cond (h (h dchar port n))
     2534                                 ;#<num>?
    24882535                                 ((or (eq? dchar #\)) (char-whitespace? dchar)) (##sys#sharp-number-hook port n))
    24892536                                 (else (##sys#read-error port "invalid parameterized read syntax" dchar n) ) ) )
     
    24912538                                (h (and sdrst (##sys#slot sdrst (char->integer dchar)) ) ) )
    24922539                           (if h
     2540                               ;then handled by # read-table entry
    24932541                               (h dchar port)
     2542                               ;otherwise chicken extended r5rs syntax
    24942543                               (case (char-downcase dchar)
    24952544                                 ((#\x) (##sys#read-char-0 port) (r-number-with-exactness 16))
     
    25592608                                                          (##sys#read-error port "invalid `#!' token" tok) ) ) ] ) ) ) ) ) )
    25602609                                 (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) )
     2610                  ((#\( #;#\)) (r-list #\( #\)))
     2611                  ((#;#\( #\)) (##sys#read-char-0 port) (container c))
    25682612                  ((#\") (r-string #\"))
    25692613                  ((#\.) (r-number #f))
    25702614                  ((#\- #\+) (r-number #f))
    2571                   (else (cond [(eof-object? c) c]
    2572                               [(char-numeric? c) (r-number #f)]
    2573                               [else (r-symbol)] ) ) ) ) ) )
    2574 
     2615                  (else
     2616                   (cond [(eof-object? c) c]
     2617                         [(char-numeric? c) (r-number #f)]
     2618                         ((memq c reserved-characters)
     2619                          (reserved-character c))
     2620                         (else
     2621                          (case c
     2622                            ((#\[ #;#\]) (r-list #\[ #\]))
     2623                            ((#\{ #;#\}) (r-list #\{ #\}))
     2624                            ((#;#\[ #\] #;#\{ #\}) (##sys#read-char-0 port) (container c))
     2625                            (else (r-symbol) ) ) ) ) ) ) ) ) )
     2626       
    25752627        (readrec) ) ) ) )
    25762628
     
    27402792        [ksp keyword-style]
    27412793        [cpp current-print-length]
    2742         [string-append string-append] )
     2794        [string-append string-append])
    27432795    (lambda (x readable port)
    27442796      (##sys#check-port-mode port #f)
    27452797      (let ([csp (csp)]
    27462798            [ksp (ksp)]
    2747             [length-limit (print-length-limit)])
     2799            [length-limit (print-length-limit)]
     2800            [special-characters '(#\( #\) #\, #\[ #\] #\{ #\} #\' #\" #\; #\ #\` #\|)] )
    27482801
    27492802        (define (outstr port str)
     
    27772830            (or (fx<= c 32)
    27782831                (fx>= c 128)
    2779                 (memq chr '(#\( #\) #\| #\, #\[ #\] #\{ #\} #\' #\" #\; #\\ #\`)) ) ) )
     2832                (memq chr special-characters) ) ) )
    27802833
    27812834        (define (outreadablesym port str)
     
    34983551       (##sys#error-handler (lambda args (##core#inline "C_halt" "error in error")))
    34993552       (cond ((##sys#fudge 4)
    3500               (##sys#print "Error" #f ##sys#standard-error)
     3553              (##sys#print "\nError" #f ##sys#standard-error)
    35013554              (when msg
    35023555                (##sys#print ": " #f ##sys#standard-error)
     
    35773630       '(user-interrupt) ) ) ]
    35783631    [(#:warning)
    3579      (##sys#print "Warning: " #f ##sys#standard-error)
     3632     (##sys#print "\nWarning: " #f ##sys#standard-error)
    35803633     (##sys#print msg #f ##sys#standard-error)
    35813634     (if (or (null? args) (fx> (length args) 1))
     
    36643717                   ((##sys#reset-handler)) ) ]
    36653718                [(eq? 'user-interrupt (##sys#slot kinds 0))
    3666                  (##sys#print "*** user interrupt ***\n" #f ##sys#standard-error)
     3719                 (##sys#print "\n*** user interrupt ***\n" #f ##sys#standard-error)
    36673720                 ((##sys#reset-handler)) ]
    36683721                [(eq? 'uncaught-exception (##sys#slot kinds 0))
     
    42664319(define ##sys#vector->list vector->list)
    42674320(define ##sys#vector-length vector-length)
    4268 (define ##sys#vector-ref vector-length)
    4269 (define ##sys#vector-length vector-length)
     4321(define ##sys#vector-ref vector-ref)
    42704322(define ##sys#>= >=)
    42714323(define ##sys#= =)
  • chicken/branches/scrutiny/lolevel.scm

    r13167 r13965  
    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/scrutiny/manual/Accessing external objects

    r10398 r13965  
    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/scrutiny/manual/Acknowledgements

    r12956 r13965  
    99Boucher, Terence Brannon, Roy Bryant, Adam Buchbinder, Hans Bulfone,
    1010Category 5, Taylor Campbell, Naruto Canada, Esteban U. Caamano Castro,
    11 Franklin 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
     11Franklin Chen, Thomas Chust, Gian Paolo Ciceri, Tobia Conforto, John
     12Cowan, Grzegorz Chrupa&#322;a, James Crippen, Tollef Fog Heen, Drew
     13Hess, Alejandro Forero Cuervo, Linh Dang, Brian Denheyer, dgym, Don,
     14Chris Double, Brown Dragon, Jarod Eells, Petter Egesund, Steve Elkins,
     15Daniel B. Faken, Will Farr, Graham Fawcett, Marc Feeley, Fizzie,
     16Matthew Flatt, Kimura Fuyuki, Tony Garnock-Jones, Martin Gasbichler,
     17Joey Gibson, Stephen C. Gilardi, Joshua Griffith, Johannes Groedem,
     18Damian Gryski, Mario Domenech Goulart, Andreas Gustafsson, Sven
     19Hartrumpf, Jun-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, Lam Luu, Leonardo
     27Valeri Manera, Dennis Marti, Charles Martin, Bob McIsaac, Alain
     28Mellan, Eric Merrit, Perry Metzger, Scott G. Miller, Mikael, Bruce
     29Mitchener, Chris Moline, Eric E. Moore, Julian Morrison, Dan Muresan,
     30Lars Nilsson, Ian Oversby, o.t., Gene Pavlovsky, Levi Pearson, Nicolas
     31Pelletier, Carlos Pita, Robin Lee Powell, Pupeno, Davide Puricelli,
     32Doug Quale, Eric Raible, Ivan Raikov, Joel Reymont, Eric Rochester,
     33Andreas Rottman, David Rush, Lars Rustemeier, Daniel Sadilek, Oskar
     34Schirmer, Burton Samograd, Reed Sheridan, Ronald Schroeder, Spencer
     35Schumann, Ivan Shcheklein, Alex Shinn, Ivan Shmakov, Shmul, Tony
     36Sidaway, Jeffrey B. Siegal, Andrey Sidorenko, Michele Simionato,
     37Volker Stolz, Jon Strait, Dorai Sitaram, Robert Skeels, Jason
     38Songhurst, Clifford Stein, Sunnan, Zbigniew Szadkowski, Rick Taube,
     39Nathan Thern, Mike Thomas, Minh Thu, Christian Tismer, Andre van
     40Tonder, John Tobey, Henrik Tramberend, Vladimir Tsichevsky, Neil van
     41Dyke, Taylor Venable, Sander Vesik, Jaques Vidrine, Panagiotis Vossos,
     42Shawn Wagner, Peter Wang, Ed Watkeys, Brad Watson, Thomas Weidner,
     43Goeran Weinholt, Matthew Welland, Drake Wilson, Joerg Wittenberger,
     44Peter Wright, Mark Wutka, Richard Zidlicky and Houman Zolfaghari for
    4445bug-fixes, tips and suggestions.
    4546
     
    7374Lisp Pointers. IV(4). December 1991.
    7475
     76---
    7577Previous: [[FAQ]]
    7678
  • chicken/branches/scrutiny/manual/Basic mode of operation

    r11013 r13965  
    5454dynamically into a running application.
    5555
    56 Previous: [[The User's Manual]]