Merge branch 'master' of git://factorcode.org/git/factor

2009-05-06 12:31:24 +00:00 · 2009-05-06 12:31:24 +00:00 · 8e1a82b9d9
parent 17f1d7f257 5a4270f777
commit 8e1a82b9d9
113 changed files with 872 additions and 432 deletions
--- a/README.txt
+++ b/README.txt
@ -20,25 +20,18 @@ implementation. It is not an introduction to the language itself.

 * Compiling the Factor VM

-The Factor runtime is written in GNU C++, and is built with GNU make and
-gcc.
-
 Factor supports various platforms. For an up-to-date list, see
 <http://factorcode.org>.

-Factor requires gcc 3.4 or later.
-
-On x86, Factor /will not/ build using gcc 3.3 or earlier.
-
-If you are using gcc 4.3, you might get an unusable Factor binary unless
-you add 'SITE_CFLAGS=-fno-forward-propagate' to the command-line
-arguments for make.
+The Factor VM is written in C++ and uses GNU extensions. When compiling
+with GCC 3.x, boost::unordered_map must be installed. On GCC 4.x, Factor
+uses std::tr1::unordered_map which is shipped as part of GCC.

 Run 'make' ('gmake' on *BSD) with no parameters to build the Factor VM.

 * Bootstrapping the Factor image

-Once you have compiled the Factor runtime, you must bootstrap the Factor
+Once you have compiled the Factor VM, you must bootstrap the Factor
 system using the image that corresponds to your CPU architecture.

 Boot images can be obtained from <http://factorcode.org/images/latest/>.
@ -97,7 +90,7 @@ When compiling Factor, pass the X11=1 parameter:

 Then bootstrap with the following switches:

-  ./factor -i=boot.<cpu>.image -ui-backend=x11 -ui-text-backend=pango
+  ./factor -i=boot.<cpu>.image -ui-backend=x11

 Now if $DISPLAY is set, running ./factor will start the UI.

@ -138,7 +131,7 @@ usage documentation, enter the following in the UI listener:
 The Factor source tree is organized as follows:

  build-support/ - scripts used for compiling Factor
-  vm/ - sources for the Factor VM, written in C++
+  vm/ - Factor VM
  core/ - Factor core library
  basis/ - Factor basis library, compiler, tools
  extra/ - more libraries and applications
--- a/basis/alien/c-types/c-types.factor
+++ b/basis/alien/c-types/c-types.factor
@ -409,10 +409,10 @@ CONSTANT: primitive-types
    "uchar" define-primitive-type

    <c-type>
-        [ alien-unsigned-4 zero? not ] >>getter
-        [ [ 1 0 ? ] 2dip set-alien-unsigned-4 ] >>setter
-        4 >>size
-        4 >>align
+        [ alien-unsigned-1 zero? not ] >>getter
+        [ [ 1 0 ? ] 2dip set-alien-unsigned-1 ] >>setter
+        1 >>size
+        1 >>align
        "box_boolean" >>boxer
        "to_boolean" >>unboxer
    "bool" define-primitive-type
--- a/basis/alien/libraries/libraries.factor
+++ b/basis/alien/libraries/libraries.factor
@ -5,7 +5,7 @@ IN: alien.libraries

 : dlopen ( path -- dll ) native-string>alien (dlopen) ;

-: dlsym ( name dll -- alien ) [ native-string>alien ] dip (dlsym) ;
+: dlsym ( name dll -- alien ) [ string>symbol ] dip (dlsym) ;

 SYMBOL: libraries

--- a/basis/bootstrap/compiler/compiler.factor
+++ b/basis/bootstrap/compiler/compiler.factor
@ -41,7 +41,7 @@ nl
 ! which are also quick to compile are replaced by
 ! compiled definitions as soon as possible.
 {
-    roll -roll declare not
+    not

    array? hashtable? vector?
    tuple? sbuf? tombstone?
--- a/basis/cocoa/cocoa.factor
+++ b/basis/cocoa/cocoa.factor
@ -1,4 +1,4 @@
-! Copyright (C) 2006 Slava Pestov
+! Copyright (C) 2006, 2009 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
 USING: compiler io kernel cocoa.runtime cocoa.subclassing
 cocoa.messages cocoa.types sequences words vocabs parser
@ -27,22 +27,16 @@ SYMBOL: frameworks

 frameworks [ V{ } clone ] initialize

-[ frameworks get [ load-framework ] each ] "cocoa.messages" add-init-hook
+[ frameworks get [ load-framework ] each ] "cocoa" add-init-hook

 SYNTAX: FRAMEWORK: scan [ load-framework ] [ frameworks get push ] bi ;

 SYNTAX: IMPORT: scan [ ] import-objc-class ;

-"Compiling Objective C bridge..." print
+"Importing Cocoa classes..." print

 "cocoa.classes" create-vocab drop

-{
-    "cocoa" "cocoa.runtime" "cocoa.messages" "cocoa.subclassing"
-} [ words ] map concat compile
-
-"Importing Cocoa classes..." print
-
 [
    {
        "NSApplication"
--- a/basis/compiler/compiler.factor
+++ b/basis/compiler/compiler.factor
@ -112,19 +112,18 @@ M: predicate-engine-word no-compile? "owner-generic" word-prop no-compile? ;
    } cond ;

 : optimize? ( word -- ? )
-    {
-        [ predicate-engine-word? ]
-        [ contains-breakpoints? ]
-        [ single-generic? ]
-    } 1|| not ;
+    { [ predicate-engine-word? ] [ single-generic? ] } 1|| not ;
+
+: contains-breakpoints? ( -- ? )
+    dependencies get keys [ "break?" word-prop ] any? ;

 : frontend ( word -- nodes )
    #! If the word contains breakpoints, don't optimize it, since
    #! the walker does not support this.
-    dup optimize?
-    [ [ build-tree ] [ deoptimize ] recover optimize-tree ]
-    [ dup def>> deoptimize-with ]
-    if ;
+    dup optimize? [
+        [ [ build-tree ] [ deoptimize ] recover optimize-tree ] keep
+        contains-breakpoints? [ nip dup def>> deoptimize-with ] [ drop ] if
+    ] [ dup def>> deoptimize-with ] if ;

 : compile-dependency ( word -- )
    #! If a word calls an unoptimized word, try to compile the callee.
--- a/basis/compiler/constants/constants.factor
+++ b/basis/compiler/constants/constants.factor
@ -23,7 +23,7 @@ CONSTANT: deck-bits 18
 : quot-xt-offset ( -- n ) 5 bootstrap-cells quotation tag-number - ; inline
 : word-code-offset ( -- n ) 10 bootstrap-cells \ word tag-number - ; inline
 : array-start-offset ( -- n ) 2 bootstrap-cells array tag-number - ; inline
-: compiled-header-size ( -- n ) 5 bootstrap-cells ; inline
+: compiled-header-size ( -- n ) 4 bootstrap-cells ; inline

 ! Relocation classes
 CONSTANT: rc-absolute-cell    0
--- a/basis/compiler/tests/alien.factor
+++ b/basis/compiler/tests/alien.factor
@ -588,3 +588,16 @@ FUNCTION: complex-float ffi_test_47 ( complex-float x, complex-double y ) ;
    C{ 1.0 2.0 }
    C{ 1.5 1.0 } ffi_test_47
 ] unit-test
+
+! Reported by jedahu
+C-STRUCT: bool-field-test
+   { "char*" "name" }
+   { "bool"  "on" }
+   { "short" "parents" } ;
+
+FUNCTION: short ffi_test_48 ( bool-field-test x ) ;
+
+[ 123 ] [
+    "bool-field-test" <c-object> 123 over set-bool-field-test-parents
+    ffi_test_48
+] unit-test
--- a/basis/compiler/tree/builder/builder.factor
+++ b/basis/compiler/tree/builder/builder.factor
@ -65,5 +65,3 @@ PRIVATE>
        ] [ dup inference-error? [ drop f ] [ rethrow ] if ] recover
    ] with-variable ;

-: contains-breakpoints? ( word -- ? )
-    def>> [ word? ] filter [ "break?" word-prop ] any? ;
--- a/basis/compiler/tree/propagation/inlining/inlining.factor
+++ b/basis/compiler/tree/propagation/inlining/inlining.factor
@ -157,11 +157,7 @@ DEFER: (flat-length)
    ] sum-outputs ;

 : should-inline? ( #call word -- ? )
-    {
-        { [ dup contains-breakpoints? ] [ 2drop f ] }
-        { [ dup "inline" word-prop ] [ 2drop t ] }
-        [ inlining-rank 5 >= ]
-    } cond ;
+    dup inline? [ 2drop t ] [ inlining-rank 5 >= ] if ;

 SYMBOL: history

--- a/basis/images/tiff/tiff.factor
+++ b/basis/images/tiff/tiff.factor
@ -5,7 +5,7 @@ compression.lzw constructors endian fry grouping images io
 io.binary io.encodings.ascii io.encodings.binary
 io.encodings.string io.encodings.utf8 io.files kernel math
 math.bitwise math.order math.parser pack prettyprint sequences
-strings math.vectors specialized-arrays.float ;
+strings math.vectors specialized-arrays.float locals ;
 IN: images.tiff

 TUPLE: tiff-image < image ;
@ -184,7 +184,7 @@ samples-per-pixel new-subfile-type subfile-type orientation
 software date-time photoshop exif-ifd sub-ifd inter-color-profile
 xmp iptc fill-order document-name page-number page-name
 x-position y-position host-computer copyright artist
-min-sample-value max-sample-value make model cell-width cell-length
+min-sample-value max-sample-value tiff-make tiff-model cell-width cell-length
 gray-response-unit gray-response-curve color-map threshholding
 image-description free-offsets free-byte-counts tile-width tile-length
 matteing data-type image-depth tile-depth
@ -243,10 +243,13 @@ ERROR: bad-tiff-magic bytes ;

 ERROR: no-tag class ;

-: find-tag ( idf class -- tag )
-    swap processed-tags>> ?at [ no-tag ] unless ;
+: find-tag* ( ifd class -- tag/class ? )
+    swap processed-tags>> ?at ;

-: tag? ( idf class -- tag )
+: find-tag ( ifd class -- tag )
+    find-tag* [ no-tag ] unless ;
+
+: tag? ( ifd class -- tag )
    swap processed-tags>> key? ;

 : read-strips ( ifd -- ifd )
@ -339,8 +342,8 @@ ERROR: bad-small-ifd-type n ;
        { 266 [ fill-order ] }
        { 269 [ ascii decode document-name ] }
        { 270 [ ascii decode image-description ] }
-        { 271 [ ascii decode make ] }
-        { 272 [ ascii decode model ] }
+        { 271 [ ascii decode tiff-make ] }
+        { 272 [ ascii decode tiff-model ] }
        { 273 [ strip-offsets ] }
        { 274 [ orientation ] }
        { 277 [ samples-per-pixel ] }
@ -350,7 +353,7 @@ ERROR: bad-small-ifd-type n ;
        { 281 [ max-sample-value ] }
        { 282 [ first x-resolution ] }
        { 283 [ first y-resolution ] }
-        { 284 [ planar-configuration ] }
+        { 284 [ lookup-planar-configuration planar-configuration ] }
        { 285 [ page-name ] }
        { 286 [ x-position ] }
        { 287 [ y-position ] }
@ -437,8 +440,8 @@ ERROR: unhandled-compression compression ;
    [ samples-per-pixel find-tag ] tri
    [ * ] keep
    '[
-        _ group [ _ group [ rest ] [ first ] bi
-        [ v+ ] accumulate swap suffix concat ] map
+        _ group
+        [ _ group unclip [ v+ ] accumulate swap suffix concat ] map
        concat >byte-array
    ] change-bitmap ;

@ -521,23 +524,39 @@ ERROR: unknown-component-order ifd ;
        ] with-tiff-endianness
    ] with-file-reader ;

-: process-tif-ifds ( parsed-tiff -- parsed-tiff )
-    dup ifds>> [
-        read-strips
-        uncompress-strips
-        strips>bitmap
-        fix-bitmap-endianness
-        strips-predictor
-        dup extra-samples tag? [ handle-alpha-data ] when
-        drop
-    ] each ;
+: process-chunky-ifd ( ifd -- )
+    read-strips
+    uncompress-strips
+    strips>bitmap
+    fix-bitmap-endianness
+    strips-predictor
+    dup extra-samples tag? [ handle-alpha-data ] when
+    drop ;
+
+: process-planar-ifd ( ifd -- )
+    "planar ifd not supported" throw ;
+
+: dispatch-planar-configuration ( ifd planar-configuration -- )
+    {
+        { planar-configuration-chunky [ process-chunky-ifd ] }
+        { planar-configuration-planar [ process-planar-ifd ] }
+    } case ;
+
+: process-ifd ( ifd -- )
+    dup planar-configuration find-tag* [
+        dispatch-planar-configuration
+    ] [
+        drop "no planar configuration" throw
+    ] if ;
+
+: process-tif-ifds ( parsed-tiff -- )
+    ifds>> [ process-ifd ] each ;

 : load-tiff ( path -- parsed-tiff )
-    [ load-tiff-ifds ] [
-        binary [
-            [ process-tif-ifds ] with-tiff-endianness
-        ] with-file-reader
-    ] bi ;
+    [ load-tiff-ifds dup ] keep
+    binary [
+        [ process-tif-ifds ] with-tiff-endianness
+    ] with-file-reader ;

 ! tiff files can store several images -- we just take the first for now
 M: tiff-image load-image* ( path tiff-image -- image )
--- a/basis/literals/literals-tests.factor
+++ b/basis/literals/literals-tests.factor
@ -20,8 +20,10 @@ IN: literals.tests

 [ { 1.0 { 0.5 1.5 } 4.0 } ] [ { 1.0 { $[ 1.0 2.0 / ] 1.5 } $[ 2.0 2.0 * ] } ] unit-test

-<<
 CONSTANT: constant-a 3
->>

 [ { 3 10 "ftw" } ] [ ${ constant-a 10 "ftw" } ] unit-test
+
+: sixty-nine ( -- a b ) 6 9 ;
+
+[ { 6 9 } ] [ ${ sixty-nine } ] unit-test
--- a/basis/literals/literals.factor
+++ b/basis/literals/literals.factor
@ -1,8 +1,21 @@
 ! (c) Joe Groff, see license for details
 USING: accessors continuations kernel parser words quotations
-combinators.smart vectors sequences ;
+combinators.smart vectors sequences fry ;
 IN: literals

-SYNTAX: $ scan-word [ def>> call ] curry with-datastack >vector ;
+<PRIVATE
+
+! Use def>> call so that CONSTANT:s defined in the same file can
+! be called
+
+: expand-literal ( seq obj -- seq' )
+    '[ _ dup word? [ def>> call ] when ] with-datastack ;
+
+: expand-literals ( seq -- seq' )
+    [ [ { } ] dip expand-literal ] map concat ;
+
+PRIVATE>
+
+SYNTAX: $ scan-word expand-literal >vector ;
 SYNTAX: $[ parse-quotation with-datastack >vector ;
-SYNTAX: ${ \ } [ [ ?execute ] { } map-as ] parse-literal ;
+SYNTAX: ${ \ } [ expand-literals ] parse-literal ;
--- a/basis/math/bits/bits.factor
+++ b/basis/math/bits/bits.factor
@ -7,7 +7,7 @@ TUPLE: bits { number read-only } { length read-only } ;
 C: <bits> bits

 : make-bits ( number -- bits )
-    dup zero? [ drop T{ bits f 0 0 } ] [ dup abs log2 1+ <bits> ] if ; inline
+    dup zero? [ drop T{ bits f 0 0 } ] [ dup abs log2 1 + <bits> ] if ; inline

 M: bits length length>> ;

--- a/basis/math/bitwise/bitwise.factor
+++ b/basis/math/bitwise/bitwise.factor
@ -13,10 +13,10 @@ IN: math.bitwise
 : unmask? ( x n -- ? ) unmask 0 > ; inline
 : mask ( x n -- ? ) bitand ; inline
 : mask? ( x n -- ? ) mask 0 > ; inline
-: wrap ( m n -- m' ) 1- bitand ; inline
+: wrap ( m n -- m' ) 1 - bitand ; inline
 : bits ( m n -- m' ) 2^ wrap ; inline
 : mask-bit ( m n -- m' ) 2^ mask ; inline
-: on-bits ( n -- m ) 2^ 1- ; inline
+: on-bits ( n -- m ) 2^ 1 - ; inline
 : toggle-bit ( m n -- m' ) 2^ bitxor ; inline

 : shift-mod ( n s w -- n )
@ -64,8 +64,8 @@ DEFER: byte-bit-count
 <<

 \ byte-bit-count
-256 [
-    8 <bits> 0 [ [ 1+ ] when ] reduce
+256 iota [
+    8 <bits> 0 [ [ 1 + ] when ] reduce
 ] B{ } map-as '[ HEX: ff bitand _ nth-unsafe ]
 (( byte -- table )) define-declared

@ -97,12 +97,12 @@ PRIVATE>

 ! Signed byte array to integer conversion
 : signed-le> ( bytes -- x )
-    [ le> ] [ length 8 * 1- on-bits ] bi
+    [ le> ] [ length 8 * 1 - on-bits ] bi
    2dup > [ bitnot bitor ] [ drop ] if ;

 : signed-be> ( bytes -- x )
    <reversed> signed-le> ;

 : >signed ( x n -- y )
-    2dup neg 1+ shift 1 = [ 2^ - ] [ drop ] if ;
+    2dup neg 1 + shift 1 = [ 2^ - ] [ drop ] if ;

--- a/basis/math/blas/vectors/vectors.factor
+++ b/basis/math/blas/vectors/vectors.factor
@ -164,7 +164,7 @@ M: VECTOR element-type
 M: VECTOR Vswap
    (prepare-swap) [ XSWAP ] 2dip ;
 M: VECTOR Viamax
-    (prepare-nrm2) IXAMAX 1- ;
+    (prepare-nrm2) IXAMAX 1 - ;

 M: VECTOR (blas-vector-like)
    drop <VECTOR> ;
--- a/basis/math/functions/functions-tests.factor
+++ b/basis/math/functions/functions-tests.factor
@ -157,3 +157,8 @@ IN: math.functions.tests
    2135623355842621559
    [ >bignum ] tri@ ^mod
 ] unit-test
+
+[ 1.0  ] [ 1.0 2.5 0.0 lerp ] unit-test
+[ 2.5  ] [ 1.0 2.5 1.0 lerp ] unit-test
+[ 1.75 ] [ 1.0 2.5 0.5 lerp ] unit-test
+
--- a/basis/math/functions/functions.factor
+++ b/basis/math/functions/functions.factor
@ -18,7 +18,7 @@ M: real sqrt
 : factor-2s ( n -- r s )
    #! factor an integer into 2^r * s
    dup 0 = [ 1 ] [
-        0 swap [ dup even? ] [ [ 1+ ] [ 2/ ] bi* ] while
+        0 swap [ dup even? ] [ [ 1 + ] [ 2/ ] bi* ] while
    ] if ; inline

 <PRIVATE
@ -216,17 +216,17 @@ M: real tanh ftanh ;
 : coth ( x -- y ) tanh recip ; inline

 : acosh ( x -- y )
-    dup sq 1- sqrt + log ; inline
+    dup sq 1 - sqrt + log ; inline

 : asech ( x -- y ) recip acosh ; inline

 : asinh ( x -- y )
-    dup sq 1+ sqrt + log ; inline
+    dup sq 1 + sqrt + log ; inline

 : acosech ( x -- y ) recip asinh ; inline

 : atanh ( x -- y )
-    [ 1+ ] [ 1- neg ] bi / log 2 / ; inline
+    [ 1 + ] [ 1 - neg ] bi / log 2 / ; inline

 : acoth ( x -- y ) recip atanh ; inline

@ -259,6 +259,9 @@ M: real atan fatan ;

 : floor ( x -- y )
    dup 1 mod dup zero?
-    [ drop ] [ dup 0 < [ - 1- ] [ - ] if ] if ; foldable
+    [ drop ] [ dup 0 < [ - 1 - ] [ - ] if ] if ; foldable

 : ceiling ( x -- y ) neg floor neg ; foldable
+
+: lerp ( a b t -- a_t ) [ over - ] dip * + ; inline
+
--- a/basis/math/intervals/intervals.factor
+++ b/basis/math/intervals/intervals.factor
@ -380,7 +380,7 @@ SYMBOL: incomparable
        [
            to>> first 1 max dup most-positive-fixnum >
            [ drop full-interval interval-log2 ]
-            [ 1+ >integer log2 0 swap [a,b] ]
+            [ 1 + >integer log2 0 swap [a,b] ]
            if
        ]
    } case ;
@ -407,7 +407,7 @@ SYMBOL: incomparable

 : integral-closure ( i1 -- i2 )
    dup special-interval? [
-        [ from>> first2 [ 1+ ] unless ]
-        [ to>> first2 [ 1- ] unless ]
+        [ from>> first2 [ 1 + ] unless ]
+        [ to>> first2 [ 1 - ] unless ]
        bi [a,b]
    ] unless ;
--- a/basis/math/miller-rabin/miller-rabin-tests.factor
+++ b/basis/math/miller-rabin/miller-rabin-tests.factor
@ -1,4 +1,4 @@
-USING: math.miller-rabin tools.test ;
+USING: math.miller-rabin tools.test kernel sequences ;
 IN: math.miller-rabin.tests

 [ f ] [ 473155932665450549999756893736999469773678960651272093993257221235459777950185377130233556540099119926369437865330559863 miller-rabin ] unit-test
@ -8,4 +8,12 @@ IN: math.miller-rabin.tests
 [ t ] [ 37 miller-rabin ] unit-test
 [ 101 ] [ 100 next-prime ] unit-test
 [ t ] [ 2135623355842621559 miller-rabin ] unit-test
-[ 100000000000031 ] [ 100000000000000 next-prime ] unit-test
+[ 100000000000031 ] [ 100000000000000 next-prime ] unit-test
+
+[ 863 ] [ 862 next-safe-prime ] unit-test
+[ f ] [ 862 safe-prime? ] unit-test
+[ t ] [ 7 safe-prime? ] unit-test
+[ f ] [ 31 safe-prime? ] unit-test
+[ t ] [ 863 safe-prime? ] unit-test
+
+[ f ] [ 1000 [ drop 15 miller-rabin ] any? ] unit-test
--- a/basis/math/miller-rabin/miller-rabin.factor
+++ b/basis/math/miller-rabin/miller-rabin.factor
@ -1,36 +1,32 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: combinators kernel locals math math.functions math.ranges
-random sequences sets ;
+random sequences sets combinators.short-circuit ;
 IN: math.miller-rabin

 <PRIVATE

-: >odd ( n -- int ) dup even? [ 1+ ] when ; foldable
+: >odd ( n -- int ) dup even? [ 1 + ] when ; foldable

 TUPLE: positive-even-expected n ;

 :: (miller-rabin) ( n trials -- ? )
-    [let | r [ n 1- factor-2s drop ]
-           s [ n 1- factor-2s nip ]
-           prime?! [ t ]
-           a! [ 0 ]
-           count! [ 0 ] |
-        trials [
-            n 1- [1,b] random a!
-            a s n ^mod 1 = [
-                0 count!
-                r [
-                    2^ s * a swap n ^mod n - -1 =
-                    [ count 1+ count! r + ] when
-                ] each
-                count zero? [ f prime?! trials + ] when
-            ] unless drop
-        ] each prime? ] ;
+    n 1 - :> n-1
+    n-1 factor-2s :> s :> r
+    0 :> a!
+    t :> prime?!
+    trials [
+        n 1 - [1,b] random a!
+        a s n ^mod 1 = [
+            r iota [
+                2^ s * a swap n ^mod n - -1 =
+            ] any? not [ f prime?! trials + ] when
+        ] unless drop
+    ] each prime? ;

 PRIVATE>

-: next-odd ( m -- n ) dup even? [ 1+ ] [ 2 + ] if ;
+: next-odd ( m -- n ) dup even? [ 1 + ] [ 2 + ] if ;

 : miller-rabin* ( n numtrials -- ? )
    over {
@ -74,3 +70,36 @@ ERROR: too-few-primes ;
    dup 5 < [ too-few-primes ] when
    2dup [ random-prime ] curry replicate
    dup all-unique? [ 2nip ] [ drop unique-primes ] if ;
+
+! Safe primes are of the form p = 2q + 1, p,q are prime
+! See http://en.wikipedia.org/wiki/Safe_prime
+
+<PRIVATE
+
+: >safe-prime-form ( q -- p ) 2 * 1 + ;
+
+: safe-prime-candidate? ( n -- ? )
+    >safe-prime-form
+    1 + 6 divisor? ;
+
+: next-safe-prime-candidate ( n -- candidate )
+    1 - 2/
+    next-prime dup safe-prime-candidate?
+    [ next-safe-prime-candidate ] unless ;
+
+PRIVATE>
+
+: safe-prime? ( q -- ? )
+    {
+        [ 1 - 2 / dup integer? [ miller-rabin ] [ drop f ] if ]
+        [ miller-rabin ]
+    } 1&& ;
+
+: next-safe-prime ( n -- q )
+    next-safe-prime-candidate
+    dup >safe-prime-form
+    dup miller-rabin
+    [ nip ] [ drop next-safe-prime ] if ;
+
+: random-safe-prime ( numbits -- p )
+    random-bits next-safe-prime ;
--- a/basis/math/polynomials/polynomials.factor
+++ b/basis/math/polynomials/polynomials.factor
@ -16,7 +16,7 @@ IN: math.polynomials
 PRIVATE>

 : powers ( n x -- seq )
-    <array> 1 [ * ] accumulate nip ;
+    <repetition> 1 [ * ] accumulate nip ;

 : p= ( p q -- ? ) pextend = ;

@ -29,7 +29,7 @@ PRIVATE>
 : n*p ( n p -- n*p ) n*v ;

 : pextend-conv ( p q -- p q )
-    2dup [ length ] bi@ + 1- 2pad-tail [ >vector ] bi@ ;
+    2dup [ length ] bi@ + 1 - 2pad-tail [ >vector ] bi@ ;

 : p* ( p q -- r )
    2unempty pextend-conv <reversed> dup length
@ -44,7 +44,7 @@ PRIVATE>
    2ptrim
    2dup [ length ] bi@ -
    dup 1 < [ drop 1 ] when
-    [ over length + 0 pad-head pextend ] keep 1+ ;
+    [ over length + 0 pad-head pextend ] keep 1 + ;

 : /-last ( seq seq -- a )
    #! divide the last two numbers in the sequences
--- a/basis/math/ranges/ranges.factor
+++ b/basis/math/ranges/ranges.factor
@ -10,7 +10,7 @@ TUPLE: range
 { step read-only } ;

 : <range> ( a b step -- range )
-    [ over - ] dip [ /i 1+ 0 max ] keep range boa ; inline
+    [ over - ] dip [ /i 1 + 0 max ] keep range boa ; inline

 M: range length ( seq -- n )
    length>> ;
--- a/basis/math/statistics/statistics.factor
+++ b/basis/math/statistics/statistics.factor
@ -15,7 +15,7 @@ IN: math.statistics

 : median ( seq -- n )
    natural-sort dup length even? [
-        [ midpoint@ dup 1- 2array ] keep nths mean
+        [ midpoint@ dup 1 - 2array ] keep nths mean
    ] [
        [ midpoint@ ] keep nth
    ] if ;
@ -33,7 +33,7 @@ IN: math.statistics
        drop 0
    ] [
        [ [ mean ] keep [ - sq ] with sigma ] keep
-        length 1- /
+        length 1 - /
    ] if ;

 : std ( seq -- x )
@ -47,7 +47,7 @@ IN: math.statistics
    0 [ [ [ pick ] dip swap - ] bi@ * + ] 2reduce 2nip ;

 : (r) ( mean(x) mean(y) {x} {y} sx sy -- r )
-    * recip [ [ ((r)) ] keep length 1- / ] dip * ;
+    * recip [ [ ((r)) ] keep length 1 - / ] dip * ;

 : [r] ( {{x,y}...} -- mean(x) mean(y) {x} {y} sx sy )
    first2 [ [ [ mean ] bi@ ] 2keep ] 2keep [ std ] bi@ ;
--- a/basis/math/vectors/vectors-tests.factor
+++ b/basis/math/vectors/vectors-tests.factor
@ -9,3 +9,8 @@ USING: math.vectors tools.test ;
 [ 5 ] [ { 1 2 } norm-sq ] unit-test
 [ 13 ] [ { 2 3 } norm-sq ] unit-test

+[ { 1.0  2.5  } ] [ { 1.0 2.5 } { 2.5 1.0 } 0.0 vnlerp ] unit-test 
+[ { 2.5  1.0  } ] [ { 1.0 2.5 } { 2.5 1.0 } 1.0 vnlerp ] unit-test 
+[ { 1.75 1.75 } ] [ { 1.0 2.5 } { 2.5 1.0 } 0.5 vnlerp ] unit-test 
+
+[ { 1.75 2.125 } ] [ { 1.0 2.5 } { 2.5 1.0 } { 0.5 0.25 } vlerp ] unit-test 
--- a/basis/math/vectors/vectors.factor
+++ b/basis/math/vectors/vectors.factor
@ -6,6 +6,11 @@ IN: math.vectors

 : vneg ( u -- v ) [ neg ] map ;

+: v+n ( u n -- v ) [ + ] curry map ;
+: n+v ( n u -- v ) [ + ] with map ;
+: v-n ( u n -- v ) [ - ] curry map ;
+: n-v ( n u -- v ) [ - ] with map ;
+
 : v*n ( u n -- v ) [ * ] curry map ;
 : n*v ( n u -- v ) [ * ] with map ;
 : v/n ( u n -- v ) [ / ] curry map ;
@ -19,6 +24,10 @@ IN: math.vectors
 : vmax ( u v -- w ) [ max ] 2map ;
 : vmin ( u v -- w ) [ min ] 2map ;

+: vfloor    ( v -- _v_ ) [ floor    ] map ;
+: vceiling  ( v -- ^v^ ) [ ceiling  ] map ;
+: vtruncate ( v -- -v- ) [ truncate ] map ;
+
 : vsupremum ( seq -- vmax ) [ ] [ vmax ] map-reduce ; 
 : vinfimum ( seq -- vmin ) [ ] [ vmin ] map-reduce ; 

@ -32,6 +41,12 @@ IN: math.vectors
 : set-axis ( u v axis -- w )
    [ [ zero? 2over ? ] dip swap nth ] map-index 2nip ;

+: vlerp ( a b t -- a_t )
+    [ lerp ] 3map ;
+
+: vnlerp ( a b t -- a_t )
+    [ lerp ] curry 2map ;
+
 HINTS: vneg { array } ;
 HINTS: norm-sq { array } ;
 HINTS: norm { array } ;
@ -50,3 +65,6 @@ HINTS: v/ { array array } ;
 HINTS: vmax { array array } ;
 HINTS: vmin { array array } ;
 HINTS: v. { array array } ;
+
+HINTS: vlerp { array array array } ;
+HINTS: vnlerp { array array object } ;
--- a/basis/stack-checker/known-words/known-words.factor
+++ b/basis/stack-checker/known-words/known-words.factor
@ -651,7 +651,7 @@ M: object infer-call*

 \ become { array array } { } define-primitive

-\ innermost-frame-quot { callstack } { quotation } define-primitive
+\ innermost-frame-executing { callstack } { object } define-primitive

 \ innermost-frame-scan { callstack } { fixnum } define-primitive

--- a/basis/tools/continuations/continuations.factor
+++ b/basis/tools/continuations/continuations.factor
@ -4,7 +4,7 @@ USING: threads kernel namespaces continuations combinators
 sequences math namespaces.private continuations.private
 concurrency.messaging quotations kernel.private words
 sequences.private assocs models models.arrow arrays accessors
-generic generic.single definitions make sbufs tools.crossref ;
+generic generic.single definitions make sbufs tools.crossref fry ;
 IN: tools.continuations

 <PRIVATE
@ -79,21 +79,18 @@ M: object add-breakpoint ;
    (step-into-call-next-method)
 } [ t "no-compile" set-word-prop ] each >>

+: >innermost-frame< ( callstack -- n quot )
+    [ innermost-frame-scan 1 + ] [ innermost-frame-executing ] bi ;
+
+: (change-frame) ( callstack quot -- callstack' )
+    [ dup innermost-frame-executing quotation? ] dip '[
+        clone [ >innermost-frame< @ ] [ set-innermost-frame-quot ] [ ] tri
+    ] when ; inline
+
 : change-frame ( continuation quot -- continuation' )
    #! Applies quot to innermost call frame of the
    #! continuation.
-    [ clone ] dip [
-        [ clone ] dip
-        [
-            [
-                [ innermost-frame-scan 1+ ]
-                [ innermost-frame-quot ] bi
-            ] dip call
-        ]
-        [ drop set-innermost-frame-quot ]
-        [ drop ]
-        2tri
-    ] curry change-call ; inline
+    [ clone ] dip '[ _ (change-frame) ] change-call ; inline

 PRIVATE>

@ -101,7 +98,7 @@ PRIVATE>
    [
        2dup length = [ nip [ break ] append ] [
            2dup nth \ break = [ nip ] [
-                swap 1+ cut [ break ] glue 
+                swap 1 + cut [ break ] glue 
            ] if
        ] if
    ] change-frame ;
@ -109,7 +106,6 @@ PRIVATE>
 : continuation-step-out ( continuation -- continuation' )
    [ nip \ break suffix ] change-frame ;

-
 {
    { call [ (step-into-quot) ] }
    { dip [ (step-into-dip) ] }
@ -124,7 +120,7 @@ PRIVATE>

 ! Never step into these words
 : don't-step-into ( word -- )
-    dup [ execute break ] curry "step-into" set-word-prop ;
+    dup '[ _ execute break ] "step-into" set-word-prop ;

 {
    >n ndrop >c c>
@ -151,6 +147,4 @@ PRIVATE>
    ] change-frame ;

 : continuation-current ( continuation -- obj )
-    call>>
-    [ innermost-frame-scan 1+ ]
-    [ innermost-frame-quot ] bi ?nth ;
+    call>> >innermost-frame< ?nth ;
--- a/basis/tools/deploy/shaker/shaker.factor
+++ b/basis/tools/deploy/shaker/shaker.factor
@ -346,13 +346,6 @@ IN: tools.deploy.shaker
 : compress-wrappers ( -- )
    [ wrapper? ] [ ] "wrappers" compress ;

-: finish-deploy ( final-image -- )
-    "Finishing up" show
-    V{ } set-namestack
-    V{ } set-catchstack
-    "Saving final image" show
-    save-image-and-exit ;
-
 SYMBOL: deploy-vocab

 : [:c] ( -- word ) ":c" "debugger" lookup ;
@ -437,7 +430,8 @@ SYMBOL: deploy-vocab
                "Vocabulary has no MAIN: word." print flush 1 exit
            ] unless
            strip
-            finish-deploy
+            "Saving final image" show
+            save-image-and-exit
        ] deploy-error-handler
    ] bind ;

--- a/basis/tools/disassembler/udis/udis-tests.factor
+++ b/basis/tools/disassembler/udis/udis-tests.factor
@ -0,0 +1,9 @@
+IN: tools.disassembler.udis.tests
+USING: tools.disassembler.udis tools.test alien.c-types system combinators kernel ;
+
+{
+    { [ os linux? cpu x86.64? and ] [ [ 656 ] [ "ud" heap-size ] unit-test ] }
+    { [ os macosx? cpu x86.32? and ] [ [ 592 ] [ "ud" heap-size ] unit-test ] }
+    { [ os macosx? cpu x86.64? and ] [ [ 656 ] [ "ud" heap-size ] unit-test ] }
+    [ ]
+} cond
--- a/basis/tools/disassembler/udis/udis.factor
+++ b/basis/tools/disassembler/udis/udis.factor
@ -16,7 +16,57 @@ IN: tools.disassembler.udis

 LIBRARY: libudis86

-TYPEDEF: char[592] ud
+C-STRUCT: ud_operand
+    { "int" "type" }
+    { "uchar" "size" }
+    { "ulonglong" "lval" }
+    { "int" "base" }
+    { "int" "index" }
+    { "uchar" "offset" }
+    { "uchar" "scale" } ;
+
+C-STRUCT: ud
+    { "void*" "inp_hook" }
+    { "uchar" "inp_curr" }
+    { "uchar" "inp_fill" }
+    { "FILE*" "inp_file" }
+    { "uchar" "inp_ctr" }
+    { "uchar*" "inp_buff" }
+    { "uchar*" "inp_buff_end" }
+    { "uchar" "inp_end" }
+    { "void*" "translator" }
+    { "ulonglong" "insn_offset" }
+    { "char[32]" "insn_hexcode" }
+    { "char[64]" "insn_buffer" }
+    { "uint" "insn_fill" }
+    { "uchar" "dis_mode" }
+    { "ulonglong" "pc" }
+    { "uchar" "vendor" }
+    { "struct map_entry*" "mapen" }
+    { "int" "mnemonic" }
+    { "ud_operand[3]" "operand" }
+    { "uchar" "error" }
+    { "uchar" "pfx_rex" }
+    { "uchar" "pfx_seg" }
+    { "uchar" "pfx_opr" }
+    { "uchar" "pfx_adr" }
+    { "uchar" "pfx_lock" }
+    { "uchar" "pfx_rep" }
+    { "uchar" "pfx_repe" }
+    { "uchar" "pfx_repne" }
+    { "uchar" "pfx_insn" }
+    { "uchar" "default64" }
+    { "uchar" "opr_mode" }
+    { "uchar" "adr_mode" }
+    { "uchar" "br_far" }
+    { "uchar" "br_near" }
+    { "uchar" "implicit_addr" }
+    { "uchar" "c1" }
+    { "uchar" "c2" }
+    { "uchar" "c3" }
+    { "uchar[256]" "inp_cache" }
+    { "uchar[64]" "inp_sess" }
+    { "ud_itab_entry*" "itab_entry" } ;

 FUNCTION: void ud_translate_intel ( ud* u ) ;
 FUNCTION: void ud_translate_att ( ud* u ) ;
--- a/basis/tools/walker/walker-tests.factor
+++ b/basis/tools/walker/walker-tests.factor
@ -2,7 +2,7 @@ USING: tools.walker io io.streams.string kernel math
 math.private namespaces prettyprint sequences tools.test
 continuations math.parser threads arrays tools.walker.debug
 generic.single sequences.private kernel.private
-tools.continuations accessors words ;
+tools.continuations accessors words combinators ;
 IN: tools.walker.tests

 [ { } ] [
@ -131,4 +131,18 @@ M: method-breakpoint-tuple method-breakpoint-test break drop 1 2 + ;
 \ method-breakpoint-test don't-step-into

 [ { 3 } ]
-[ [ T{ method-breakpoint-tuple } method-breakpoint-test ] test-walker ] unit-test
+[ [ T{ method-breakpoint-tuple } method-breakpoint-test ] test-walker ] unit-test
+
+: case-breakpoint-test ( -- x )
+    5 { [ break 1 + ] } case ;
+
+\ case-breakpoint-test don't-step-into
+
+[ { 6 } ] [ [ case-breakpoint-test ] test-walker ] unit-test
+
+: call(-breakpoint-test ( -- x )
+    [ break 1 ] call( -- x ) 2 + ;
+
+\ call(-breakpoint-test don't-step-into
+
+[ { 3 } ] [ [ call(-breakpoint-test ] test-walker ] unit-test
--- a/basis/windows/dinput/dinput.factor
+++ b/basis/windows/dinput/dinput.factor
@ -444,6 +444,18 @@ CONSTANT: DISCL_FOREGROUND    HEX: 00000004
 CONSTANT: DISCL_BACKGROUND    HEX: 00000008
 CONSTANT: DISCL_NOWINKEY      HEX: 00000010

+CONSTANT: DIMOFS_X        0
+CONSTANT: DIMOFS_Y        4
+CONSTANT: DIMOFS_Z        8
+CONSTANT: DIMOFS_BUTTON0 12
+CONSTANT: DIMOFS_BUTTON1 13
+CONSTANT: DIMOFS_BUTTON2 14
+CONSTANT: DIMOFS_BUTTON3 15
+CONSTANT: DIMOFS_BUTTON4 16
+CONSTANT: DIMOFS_BUTTON5 17
+CONSTANT: DIMOFS_BUTTON6 18
+CONSTANT: DIMOFS_BUTTON7 19
+
 CONSTANT: DIK_ESCAPE          HEX: 01
 CONSTANT: DIK_1               HEX: 02
 CONSTANT: DIK_2               HEX: 03
--- a/core/alien/strings/strings.factor
+++ b/core/alien/strings/strings.factor
@ -34,25 +34,32 @@ M: string string>alien

 HOOK: alien>native-string os ( alien -- string )

-HOOK: native-string>alien os ( string -- alien )
-
 M: windows alien>native-string utf16n alien>string ;

-M: wince native-string>alien utf16n string>alien ;
-
-M: winnt native-string>alien utf8 string>alien ;
-
 M: unix alien>native-string utf8 alien>string ;

+HOOK: native-string>alien os ( string -- alien )
+
+M: windows native-string>alien utf16n string>alien ;
+
 M: unix native-string>alien utf8 string>alien ;

 : dll-path ( dll -- string )
    path>> alien>native-string ;

-: string>symbol ( str -- alien )
-    dup string?
-    [ native-string>alien ]
-    [ [ native-string>alien ] map ] if ;
+HOOK: string>symbol* os ( str/seq -- alien )
+
+M: winnt string>symbol* utf8 string>alien ;
+
+M: wince string>symbol* utf16n string>alien ;
+
+M: unix string>symbol* utf8 string>alien ;
+
+GENERIC: string>symbol ( str -- alien )
+
+M: string string>symbol string>symbol* ;
+
+M: sequence string>symbol [ string>symbol* ] map ;

 [
    8 getenv utf8 alien>string string>cpu \ cpu set-global
--- a/core/bootstrap/primitives.factor
+++ b/core/bootstrap/primitives.factor
@ -493,7 +493,7 @@ tuple
    { "(sleep)" "threads.private" (( us -- )) }
    { "<tuple-boa>" "classes.tuple.private" (( ... layout -- tuple )) }
    { "callstack>array" "kernel" (( callstack -- array )) }
-    { "innermost-frame-quot" "kernel.private" (( callstack -- quot )) }
+    { "innermost-frame-executing" "kernel.private" (( callstack -- obj )) }
    { "innermost-frame-scan" "kernel.private" (( callstack -- n )) }
    { "set-innermost-frame-quot" "kernel.private" (( n callstack -- )) }
    { "call-clear" "kernel" (( quot -- )) }
--- a/core/continuations/continuations-tests.factor
+++ b/core/continuations/continuations-tests.factor
@ -64,7 +64,7 @@ IN: continuations.tests

 [ 1 2 ] [ bar ] unit-test

-[ t ] [ \ bar def>> "c" get innermost-frame-quot = ] unit-test
+[ t ] [ \ bar def>> "c" get innermost-frame-executing = ] unit-test

 [ 1 ] [ "c" get innermost-frame-scan ] unit-test

--- a/core/generic/standard/standard.factor
+++ b/core/generic/standard/standard.factor
@ -8,9 +8,7 @@ IN: generic.standard

 TUPLE: standard-combination < single-combination # ;

-: <standard-combination> ( n -- standard-combination )
-    dup 0 2 between? [ "Bad dispatch position" throw ] unless
-    standard-combination boa ;
+C: <standard-combination> standard-combination

 PREDICATE: standard-generic < generic
    "combination" word-prop standard-combination? ;
--- a/core/memory/memory.factor
+++ b/core/memory/memory.factor
@ -26,6 +26,6 @@ IN: memory
    normalize-path native-string>alien (save-image) ;

 : save-image-and-exit ( path -- )
-    normalize-path native-string>alien (save-image) ;
+    normalize-path native-string>alien (save-image-and-exit) ;

 : save ( -- ) image save-image ;
--- a/extra/game-input/dinput/dinput.factor
+++ b/extra/game-input/dinput/dinput.factor
@ -5,16 +5,20 @@ windows.user32 windows.messages sequences combinators locals
 math.rectangles accessors math alien alien.strings
 io.encodings.utf16 io.encodings.utf16n continuations
 byte-arrays game-input.dinput.keys-array game-input
-ui.backend.windows windows.errors ;
+ui.backend.windows windows.errors struct-arrays
+math.bitwise ;
 IN: game-input.dinput

+CONSTANT: MOUSE-BUFFER-SIZE 16
+
 SINGLETON: dinput-game-input-backend

 dinput-game-input-backend game-input-backend set-global

 SYMBOLS: +dinput+ +keyboard-device+ +keyboard-state+
    +controller-devices+ +controller-guids+
-    +device-change-window+ +device-change-handle+ ;
+    +device-change-window+ +device-change-handle+
+    +mouse-device+ +mouse-state+ +mouse-buffer+ ;

 : create-dinput ( -- )
    f GetModuleHandle DIRECTINPUT_VERSION IDirectInput8W-iid
@ -35,8 +39,24 @@ SYMBOLS: +dinput+ +keyboard-device+ +keyboard-state+
 : set-data-format ( device format-symbol -- )
    get IDirectInputDevice8W::SetDataFormat ole32-error ;

+: <buffer-size-diprop> ( size -- DIPROPDWORD )
+    "DIPROPDWORD" <c-object>
+        "DIPROPDWORD" heap-size over set-DIPROPHEADER-dwSize
+        "DIPROPHEADER" heap-size over set-DIPROPHEADER-dwHeaderSize
+        0 over set-DIPROPHEADER-dwObj
+        DIPH_DEVICE over set-DIPROPHEADER-dwHow
+        swap over set-DIPROPDWORD-dwData ;
+
+: set-buffer-size ( device size -- )
+    DIPROP_BUFFERSIZE swap <buffer-size-diprop>
+    IDirectInputDevice8W::SetProperty ole32-error ;
+
 : configure-keyboard ( keyboard -- )
    [ c_dfDIKeyboard_HID set-data-format ] [ set-coop-level ] bi ;
+: configure-mouse ( mouse -- )
+    [ c_dfDIMouse2 set-data-format ]
+    [ MOUSE-BUFFER-SIZE set-buffer-size ]
+    [ set-coop-level ] tri ;
 : configure-controller ( controller -- )
    [ c_dfDIJoystick2 set-data-format ] [ set-coop-level ] bi ;

@ -47,6 +67,15 @@ SYMBOLS: +dinput+ +keyboard-device+ +keyboard-state+
    256 <byte-array> <keys-array> keyboard-state boa
    +keyboard-state+ set-global ;

+: find-mouse ( -- )
+    GUID_SysMouse device-for-guid
+    [ configure-mouse ]
+    [ +mouse-device+ set-global ] bi
+    0 0 0 0 8 f <array> mouse-state boa
+    +mouse-state+ set-global
+    MOUSE-BUFFER-SIZE "DIDEVICEOBJECTDATA" <c-array>
+    +mouse-buffer+ set-global ;
+
 : device-info ( device -- DIDEVICEIMAGEINFOW )
    "DIDEVICEINSTANCEW" <c-object>
    "DIDEVICEINSTANCEW" heap-size over set-DIDEVICEINSTANCEW-dwSize
@ -190,16 +219,22 @@ TUPLE: window-rect < rect window-loc ;
    +keyboard-device+ [ com-release f ] change-global
    f +keyboard-state+ set-global ;

+: release-mouse ( -- )
+    +mouse-device+ [ com-release f ] change-global
+    f +mouse-state+ set-global ;
+
 M: dinput-game-input-backend (open-game-input)
    create-dinput
    create-device-change-window
    find-keyboard
+    find-mouse
    set-up-controllers
    add-wm-devicechange ;

 M: dinput-game-input-backend (close-game-input)
    remove-wm-devicechange
    release-controllers
+    release-mouse
    release-keyboard
    close-device-change-window
    delete-dinput ;
@ -263,6 +298,22 @@ CONSTANT: pov-values
        [ DIJOYSTATE2-rgbButtons over buttons>> length >buttons >>buttons ]
    } 2cleave ;

+: read-device-buffer ( device buffer count -- buffer count' )
+    [ "DIDEVICEOBJECTDATA" heap-size ] 2dip <uint>
+    [ 0 IDirectInputDevice8W::GetDeviceData ole32-error ] 2keep *uint ;
+
+: (fill-mouse-state) ( state DIDEVICEOBJECTDATA -- state )
+    [ DIDEVICEOBJECTDATA-dwData 32 >signed ] [ DIDEVICEOBJECTDATA-dwOfs ] bi {
+        { DIMOFS_X [ [ + ] curry change-dx ] }
+        { DIMOFS_Y [ [ + ] curry change-dy ] }
+        { DIMOFS_Z [ [ + ] curry change-scroll-dy ] }
+        [ [ c-bool> ] [ DIMOFS_BUTTON0 - ] bi* rot [ buttons>> set-nth ] keep ]
+    } case ;
+
+: fill-mouse-state ( buffer count -- state )
+    [ +mouse-state+ get ] 2dip swap
+    [ "DIDEVICEOBJECTDATA" byte-array>struct-array nth (fill-mouse-state) ] curry each ;
+
 : get-device-state ( device byte-array -- )
    [ dup IDirectInputDevice8W::Poll ole32-error ] dip
    [ length ] keep
@ -283,3 +334,17 @@ M: dinput-game-input-backend read-keyboard
    +keyboard-device+ get
    [ +keyboard-state+ get [ keys>> underlying>> get-device-state ] keep ]
    [ ] [ f ] with-acquisition ;
+
+M: dinput-game-input-backend read-mouse
+    +mouse-device+ get [ +mouse-buffer+ get MOUSE-BUFFER-SIZE read-device-buffer ]
+    [ fill-mouse-state ] [ f ] with-acquisition ;
+
+M: dinput-game-input-backend reset-mouse
+    +mouse-device+ get [ f MOUSE-BUFFER-SIZE read-device-buffer ]
+    [ 2drop ] [ ] with-acquisition
+    +mouse-state+ get
+        0 >>dx
+        0 >>dy
+        0 >>scroll-dx
+        0 >>scroll-dy
+        drop ;
--- a/extra/game-input/game-input-docs.factor
+++ b/extra/game-input/game-input-docs.factor
@ -3,7 +3,7 @@ sequences strings math ;
 IN: game-input

 ARTICLE: "game-input" "Game controller input"
-"The " { $vocab-link "game-input" } " vocabulary provides cross-platform access to game controller devices such as joysticks and gamepads. It also provides an interface for polling raw keyboard input." $nl
+"The " { $vocab-link "game-input" } " vocabulary provides cross-platform access to game controller devices such as joysticks and gamepads. It also provides an interface for polling raw keyboard and mouse input." $nl
 "The game input interface must be initialized before being used:"
 { $subsection open-game-input }
 { $subsection close-game-input }
@ -18,11 +18,13 @@ ARTICLE: "game-input" "Game controller input"
 { $subsection instance-id }
 "A hook is provided for invoking the system calibration tool:"
 { $subsection calibrate-controller }
-"The current state of a controller or the keyboard can be read:"
+"The current state of a controller, the keyboard, and the mouse can be read:"
 { $subsection read-controller }
 { $subsection read-keyboard }
+{ $subsection read-mouse }
 { $subsection controller-state }
-{ $subsection keyboard-state } ;
+{ $subsection keyboard-state }
+{ $subsection mouse-state } ;

 HELP: open-game-input
 { $description "Initializes the game input interface. An exception will be thrown if the initialization fails. If the game input interface is already opened, nothing happens." } ;
@ -86,6 +88,14 @@ HELP: read-keyboard
 { $warning "For efficiency, the implementation may reuse the returned " { $snippet "keyboard-state" } " object next time " { $snippet "read-keyboard" } " is called. You should " { $link clone } " any values from the returned tuple you need to preserve."
 $nl "The keyboard state returned by this word is unprocessed by any keymaps, modifier keys, key repeat settings, or other operating environment postprocessing. Because of this, " { $snippet "read-keyboard" } " should not be used for text entry purposes. The Factor UI's standard gesture mechanism should be used in cases where the logical meaning of keypresses is needed; see " { $link "keyboard-gestures" } "." } ;

+HELP: read-mouse
+{ $values { "mouse-state" mouse-state } }
+{ $description "Reads the current mouse state relative to either when the game input interface was opened with " { $link open-game-input } " or when the mouse state was reset with " { $link reset-mouse } "." }
+{ $warning "For efficiency, the implementation may reuse the returned " { $snippet "mouse-state" } " object for future " { $snippet "read-mouse" } " or " { $snippet "reset-mouse" } " calls. You should " { $link clone } " the " { $snippet "mouse-state" } " object if you need to preserve it." } ;
+
+HELP: reset-mouse
+{ $description "Resets the mouse state. Future " { $link read-mouse } " values will be relative to the time this word is called." } ;
+
 HELP: controller-state
 { $class-description "The " { $link read-controller } " word returns objects of this class. " { $snippet "controller-state" } " objects have the following slots:"
 { $list
@ -121,6 +131,19 @@ HELP: keyboard-state
 { $class-description "The " { $link read-keyboard } " word returns objects of this class. The " { $snippet "keys" } " slot of a " { $snippet "keyboard-state" } " object contains a " { $link sequence } " of 256 members representing the state of the keys on the keyboard. Each element is a boolean value indicating whether the corresponding key is pressed. The sequence is indexed by scancode as defined under usage page 7 of the USB HID standard. Named scancode constants are provided in the " { $vocab-link "game-input.scancodes" } " vocabulary." }
 { $warning "The scancodes used to index " { $snippet "keyboard-state" } " objects correspond to physical key positions on the keyboard--they are unaffected by keymaps, modifier keys, or other operating environment postprocessing. The face value of the constants in " { $vocab-link "game-input.scancodes" } " do not necessarily correspond to what the user expects the key to type. Because of this, " { $link read-keyboard } " should not be used for text entry purposes. The Factor UI's standard gesture mechanism should be used in cases where the logical meaning of keypresses is needed; see " { $link "keyboard-gestures" } "." } ;

+HELP: mouse-state
+{ $class-description "The " { $link read-mouse } " word returns objects of this class. " { $snippet "mouse-state" } " objects have the following slots:"
+{ $list
+    { { $snippet "dx" } " contains the mouse's X axis movement." }
+    { { $snippet "dy" } " contains the mouse's Y axis movement." }
+    { { $snippet "scroll-dx" } " contains the scroller's X axis movement." }
+    { { $snippet "scroll-dy" } " contains the scroller's Y axis movement." }
+    { { $snippet "buttons" } " contains a sequence of boolean values indicate the state of the mouse's buttons." }
+}
+"Mouse movement is recorded relative to when the game input interface was opened with " { $link open-game-input } " or the mouse state is reset with " { $link reset-mouse } "."
+} ;
+
+
 { keyboard-state read-keyboard } related-words

 ABOUT: "game-input"
--- a/extra/game-input/game-input.factor
+++ b/extra/game-input/game-input.factor
@ -73,6 +73,15 @@ M: keyboard-state clone

 HOOK: read-keyboard game-input-backend ( -- keyboard-state )

+TUPLE: mouse-state dx dy scroll-dx scroll-dy buttons ;
+
+M: mouse-state clone
+    call-next-method dup buttons>> clone >>buttons ;
+
+HOOK: read-mouse game-input-backend ( -- mouse-state )
+
+HOOK: reset-mouse game-input-backend ( -- )
+
 {
    { [ os windows? ] [ "game-input.dinput" require ] }
    { [ os macosx? ] [ "game-input.iokit" require ] }
--- a/extra/game-input/iokit/iokit.factor
+++ b/extra/game-input/iokit/iokit.factor
@ -3,7 +3,7 @@ kernel cocoa.enumeration destructors math.parser cocoa.application
 sequences locals combinators.short-circuit threads
 namespaces assocs vectors arrays combinators
 core-foundation.run-loop accessors sequences.private
-alien.c-types math parser game-input ;
+alien.c-types math parser game-input vectors ;
 IN: game-input.iokit

 SINGLETON: iokit-game-input-backend
@ -23,9 +23,13 @@ iokit-game-input-backend game-input-backend set-global

 CONSTANT: game-devices-matching-seq
    {
+        H{ { "DeviceUsage" 1 } { "DeviceUsagePage" 1 } } ! pointers
+        H{ { "DeviceUsage" 2 } { "DeviceUsagePage" 1 } } ! mouses
        H{ { "DeviceUsage" 4 } { "DeviceUsagePage" 1 } } ! joysticks
        H{ { "DeviceUsage" 5 } { "DeviceUsagePage" 1 } } ! gamepads
        H{ { "DeviceUsage" 6 } { "DeviceUsagePage" 1 } } ! keyboards
+        H{ { "DeviceUsage" 7 } { "DeviceUsagePage" 1 } } ! keypads
+        H{ { "DeviceUsage" 8 } { "DeviceUsagePage" 1 } } ! multiaxis controllers
    }

 CONSTANT: buttons-matching-hash
@ -46,6 +50,8 @@ CONSTANT: rz-axis-matching-hash
    H{ { "UsagePage" 1 } { "Usage" HEX: 35 } { "Type" 1 } }
 CONSTANT: slider-matching-hash
    H{ { "UsagePage" 1 } { "Usage" HEX: 36 } { "Type" 1 } }
+CONSTANT: wheel-matching-hash
+    H{ { "UsagePage" 1 } { "Usage" HEX: 38 } { "Type" 1 } }
 CONSTANT: hat-switch-matching-hash
    H{ { "UsagePage" 1 } { "Usage" HEX: 39 } { "Type" 1 } }

@ -90,10 +96,17 @@ CONSTANT: hat-switch-matching-hash
 : transfer-element-property ( element from-key to-key -- )
    [ dupd element-property ] dip swap set-element-property ;

+: mouse-device? ( device -- ? )
+    {
+        [ 1 1 IOHIDDeviceConformsTo ]
+        [ 1 2 IOHIDDeviceConformsTo ]
+    } 1|| ;
+
 : controller-device? ( device -- ? )
    {
        [ 1 4 IOHIDDeviceConformsTo ]
        [ 1 5 IOHIDDeviceConformsTo ]
+        [ 1 8 IOHIDDeviceConformsTo ]
    } 1|| ;

 : element-usage ( element -- {usage-page,usage} )
@ -118,6 +131,8 @@ CONSTANT: hat-switch-matching-hash
    { 1 HEX: 35 } = ; inline
 : slider? ( {usage-page,usage} -- ? )
    { 1 HEX: 36 } = ; inline
+: wheel? ( {usage-page,usage} -- ? )
+    { 1 HEX: 38 } = ; inline
 : hat-switch? ( {usage-page,usage} -- ? )
    { 1 HEX: 39 } = ; inline

@ -132,12 +147,17 @@ CONSTANT: pov-values
    IOHIDValueGetIntegerValue dup zero? [ drop f ] when ;
 : axis-value ( value -- [-1,1] )
    kIOHIDValueScaleTypeCalibrated IOHIDValueGetScaledValue ;
+: mouse-axis-value ( value -- n )
+    IOHIDValueGetIntegerValue ;
 : pov-value ( value -- pov-direction )
    IOHIDValueGetIntegerValue pov-values ?nth [ pov-neutral ] unless* ;

+: record-button ( hid-value usage state -- )
+    [ button-value ] [ second 1- ] [ buttons>> ] tri* set-nth ;
+
 : record-controller ( controller-state value -- )
    dup IOHIDValueGetElement element-usage {
-        { [ dup button? ] [ [ button-value ] [ second 1- ] bi* rot buttons>> set-nth ] } 
+        { [ dup button? ] [ rot record-button ] } 
        { [ dup x-axis? ] [ drop axis-value >>x drop ] }
        { [ dup y-axis? ] [ drop axis-value >>y drop ] }
        { [ dup z-axis? ] [ drop axis-value >>z drop ] }
@ -149,7 +169,7 @@ CONSTANT: pov-values
        [ 3drop ]
    } cond ;

-SYMBOLS: +hid-manager+ +keyboard-state+ +controller-states+ ;
+SYMBOLS: +hid-manager+ +keyboard-state+ +mouse-state+ +controller-states+ ;

 : ?set-nth ( value nth seq -- )
    2dup bounds-check? [ set-nth-unsafe ] [ 3drop ] if ;
@ -161,6 +181,27 @@ SYMBOLS: +hid-manager+ +keyboard-state+ +controller-states+ ;
        +keyboard-state+ get ?set-nth
    ] [ drop ] if ;

+: record-mouse ( value -- )
+    dup IOHIDValueGetElement element-usage {
+        { [ dup button? ] [ +mouse-state+ get record-button ] }
+        { [ dup x-axis? ] [ drop mouse-axis-value +mouse-state+ get [ + ] change-dx drop ] }
+        { [ dup y-axis? ] [ drop mouse-axis-value +mouse-state+ get [ + ] change-dy drop ] }
+        { [ dup wheel?  ] [ drop mouse-axis-value +mouse-state+ get [ + ] change-scroll-dx drop ] }
+        { [ dup z-axis? ] [ drop mouse-axis-value +mouse-state+ get [ + ] change-scroll-dy drop ] }
+        [ 2drop ]
+    } cond ;
+
+M: iokit-game-input-backend read-mouse
+    +mouse-state+ get ;
+
+M: iokit-game-input-backend reset-mouse
+    +mouse-state+ get
+        0 >>dx
+        0 >>dy
+        0 >>scroll-dx 
+        0 >>scroll-dy
+        drop ;
+
 : default-calibrate-saturation ( element -- )
    [ kIOHIDElementMinKey kIOHIDElementCalibrationSaturationMinKey transfer-element-property ]
    [ kIOHIDElementMaxKey kIOHIDElementCalibrationSaturationMaxKey transfer-element-property ]
@ -194,12 +235,21 @@ SYMBOLS: +hid-manager+ +keyboard-state+ +controller-states+ ;
        [ button-count f <array> ]
    } cleave controller-state boa ;

+: ?add-mouse-buttons ( device -- )
+    button-count +mouse-state+ get buttons>> 
+    2dup length >
+    [ set-length ] [ 2drop ] if ;
+
 : device-matched-callback ( -- alien )
    [| context result sender device |
-        device controller-device? [
-            device <device-controller-state>
-            device +controller-states+ get set-at
-        ] when
+        {
+            { [ device controller-device? ] [
+                device <device-controller-state>
+                device +controller-states+ get set-at
+            ] }
+            { [ device mouse-device? ] [ device ?add-mouse-buttons ] }
+            [ ]
+        } cond
    ] IOHIDDeviceCallback ;

 : device-removed-callback ( -- alien )
@ -209,15 +259,20 @@ SYMBOLS: +hid-manager+ +keyboard-state+ +controller-states+ ;

 : device-input-callback ( -- alien )
    [| context result sender value |
-        sender controller-device?
-        [ sender +controller-states+ get at value record-controller ]
-        [ value record-keyboard ]
-        if
+        {
+            { [ sender controller-device? ] [
+                sender +controller-states+ get at value record-controller
+            ] }
+            { [ sender mouse-device? ] [ value record-mouse ] }
+            [ value record-keyboard ]
+        } cond
    ] IOHIDValueCallback ;

 : initialize-variables ( manager -- )
    +hid-manager+ set-global
    4 <vector> +controller-states+ set-global
+    0 0 0 0 2 <vector> mouse-state boa
+        +mouse-state+ set-global
    256 f <array> +keyboard-state+ set-global ;

 M: iokit-game-input-backend (open-game-input)
--- a/extra/images/viewer/viewer.factor
+++ b/extra/images/viewer/viewer.factor
@ -5,23 +5,28 @@ opengl opengl.gl opengl.textures sequences strings ui ui.gadgets
 ui.gadgets.panes ui.render ui.images ;
 IN: images.viewer

-TUPLE: image-gadget < gadget image-name ;
+TUPLE: image-gadget < gadget image texture ;

-M: image-gadget pref-dim*
-    image-name>> image-dim ;
+M: image-gadget pref-dim* image>> dim>> ;
+
+: image-gadget-texture ( gadget -- texture )
+    dup texture>> [ ] [ dup image>> { 0 0 } <texture> >>texture texture>> ] ?if ;

 M: image-gadget draw-gadget* ( gadget -- )
-    image-name>> draw-image ;
+    [ dim>> ] [ image-gadget-texture ] bi draw-scaled-texture ;

-: <image-gadget> ( image-name -- gadget )
+! Todo: delete texture on ungraft
+
+GENERIC: <image-gadget> ( object -- gadget )
+
+M: image <image-gadget>
    \ image-gadget new
-        swap >>image-name ;
+        swap >>image ;

-: image-window ( path -- gadget )
-    [ <image-name> <image-gadget> dup ] [ open-window ] bi ;
+M: string <image-gadget> load-image <image-gadget> ;

-GENERIC: image. ( object -- )
+M: pathname <image-gadget> load-image <image-gadget> ;

-M: string image. ( image -- ) <image-name> <image-gadget> gadget. ;
+: image-window ( object -- ) <image-gadget> "Image" open-window ;

-M: pathname image. ( image -- ) <image-name> <image-gadget> gadget. ;
+: image. ( object -- ) <image-gadget> gadget. ;
--- a/extra/perlin-noise/perlin-noise.factor
+++ b/extra/perlin-noise/perlin-noise.factor
@ -0,0 +1,83 @@
+USING: byte-arrays combinators images kernel locals math
+math.functions math.polynomials math.vectors random sequences
+sequences.product ;
+IN: perlin-noise
+
+: <noise-table> ( -- table )
+    256 iota >byte-array randomize dup append ;
+
+: fade ( point -- point' )
+    { 0.0 0.0 0.0 10.0 -15.0 6.0 } swap [ polyval ] with map ;
+
+:: grad ( hash gradients -- gradient )
+    hash 8  bitand zero? [ gradients first ] [ gradients second ] if
+        :> u
+    hash 12 bitand zero?
+    [ gradients second ]
+    [ hash 13 bitand 12 = [ gradients first ] [ gradients third ] if ] if
+        :> v
+
+    hash 1 bitand zero? [ u ] [ u neg ] if
+    hash 2 bitand zero? [ v ] [ v neg ] if + ;
+
+: unit-cube ( point -- cube )
+    [ floor >fixnum 256 mod ] map ;
+
+:: hashes ( table cube -- aaa baa aba bba aab bab abb bbb )
+    cube first  :> x
+    cube second :> y
+    cube third  :> z
+    x     table nth y + :> a
+    x 1 + table nth y + :> b
+
+    a     table nth z + :> aa
+    b     table nth z + :> ba
+    a 1 + table nth z + :> ab
+    b 1 + table nth z + :> bb
+
+    aa     table nth 
+    ba     table nth 
+    ab     table nth 
+    bb     table nth 
+    aa 1 + table nth 
+    ba 1 + table nth 
+    ab 1 + table nth 
+    bb 1 + table nth ;
+
+:: 2tetra@ ( p q r s t u v w quot -- )
+    p q quot call
+    r s quot call
+    t u quot call
+    v w quot call
+    ; inline
+
+:: noise ( table point -- value )
+    point unit-cube :> cube
+    point dup vfloor v- :> gradients
+    gradients fade :> faded
+
+    table cube hashes {
+        [ gradients                       grad ]
+        [ gradients { -1.0  0.0  0.0 } v+ grad ]
+        [ gradients {  0.0 -1.0  0.0 } v+ grad ]
+        [ gradients { -1.0 -1.0  0.0 } v+ grad ]
+        [ gradients {  0.0  0.0 -1.0 } v+ grad ]
+        [ gradients { -1.0  0.0 -1.0 } v+ grad ]
+        [ gradients {  0.0 -1.0 -1.0 } v+ grad ]
+        [ gradients { -1.0 -1.0 -1.0 } v+ grad ]
+    } spread
+    [ faded first lerp ] 2tetra@
+    [ faded second lerp ] 2bi@
+    faded third lerp ;
+
+: noise-map ( table scale dim -- map ) 
+    [ iota ] map [ v* 0.0 suffix noise ] with with product-map ;
+
+: normalize ( sequence -- sequence' )
+    [ supremum ] [ infimum [ - ] keep ] [ ] tri
+    [ swap - ] with map [ swap / ] with map ;
+
+: noise-image ( table scale dim -- image )
+    [ noise-map normalize [ 255.0 * >fixnum ] B{ } map-as ]
+    [ swap [ L f ] dip image boa ] bi ;
+
--- a/vm/Config.windows
+++ b/vm/Config.windows
@ -6,5 +6,5 @@ EXE_EXTENSION=.exe
 CONSOLE_EXTENSION=.com
 DLL_EXTENSION=.dll
 SHARED_DLL_EXTENSION=.dll
-LINKER = $(CC) -shared -mno-cygwin -o 
+LINKER = $(CPP) -shared -mno-cygwin -o 
 LINK_WITH_ENGINE = -l$(DLL_PREFIX)factor$(DLL_SUFFIX)
--- a/vm/alien.cpp
+++ b/vm/alien.cpp
@ -77,7 +77,7 @@ PRIMITIVE(alien_address)
 }

 /* pop ( alien n ) from datastack, return alien's address plus n */
-static void *alien_pointer(void)
+static void *alien_pointer()
 {
 	fixnum offset = to_fixnum(dpop());
 	return unbox_alien() + offset;
@ -128,7 +128,7 @@ PRIMITIVE(dlsym)
 	gc_root<byte_array> name(dpop());
 	name.untag_check();

-	vm_char *sym = (vm_char *)(name.untagged() + 1);
+	symbol_char *sym = name->data<symbol_char>();

 	if(library.value() == F)
 		box_alien(ffi_dlsym(NULL,sym));
@ -182,7 +182,7 @@ VM_C_API char *alien_offset(cell obj)
 }

 /* pop an object representing a C pointer */
-VM_C_API char *unbox_alien(void)
+VM_C_API char *unbox_alien()
 {
 	return alien_offset(dpop());
 }
--- a/vm/alien.hpp
+++ b/vm/alien.hpp
@ -39,7 +39,7 @@ PRIMITIVE(dlclose);
 PRIMITIVE(dll_validp);

 VM_C_API char *alien_offset(cell object);
-VM_C_API char *unbox_alien(void);
+VM_C_API char *unbox_alien();
 VM_C_API void box_alien(void *ptr);
 VM_C_API void to_value_struct(cell src, void *dest, cell size);
 VM_C_API void box_value_struct(void *src, cell size);
--- a/vm/callstack.cpp
+++ b/vm/callstack.cpp
@ -54,7 +54,7 @@ This means that if 'callstack' is called in tail position, we
 will have popped a necessary frame... however this word is only
 called by continuation implementation, and user code shouldn't
 be calling it at all, so we leave it as it is for now. */
-stack_frame *capture_start(void)
+stack_frame *capture_start()
 {
 	stack_frame *frame = stack_chain->callstack_bottom - 1;
 	while(frame >= stack_chain->callstack_top
@ -100,7 +100,7 @@ code_block *frame_code(stack_frame *frame)

 cell frame_type(stack_frame *frame)
 {
-	return frame_code(frame)->block.type;
+	return frame_code(frame)->type;
 }

 cell frame_executing(stack_frame *frame)
@ -195,9 +195,9 @@ stack_frame *innermost_stack_frame_quot(callstack *callstack)

 /* Some primitives implementing a limited form of callstack mutation.
 Used by the single stepper. */
-PRIMITIVE(innermost_stack_frame_quot)
+PRIMITIVE(innermost_stack_frame_executing)
 {
-	dpush(frame_executing(innermost_stack_frame_quot(untag_check<callstack>(dpop()))));
+	dpush(frame_executing(innermost_stack_frame(untag_check<callstack>(dpop()))));
 }

 PRIMITIVE(innermost_stack_frame_scan)
--- a/vm/callstack.hpp
+++ b/vm/callstack.hpp
@ -22,7 +22,7 @@ cell frame_type(stack_frame *frame);
 PRIMITIVE(callstack);
 PRIMITIVE(set_callstack);
 PRIMITIVE(callstack_to_array);
-PRIMITIVE(innermost_stack_frame_quot);
+PRIMITIVE(innermost_stack_frame_executing);
 PRIMITIVE(innermost_stack_frame_scan);
 PRIMITIVE(set_innermost_stack_frame_quot);

--- a/vm/code_block.cpp
+++ b/vm/code_block.cpp
@ -5,7 +5,7 @@ namespace factor

 void flush_icache_for(code_block *block)
 {
-	flush_icache((cell)block,block->block.size);
+	flush_icache((cell)block,block->size);
 }

 void iterate_relocations(code_block *compiled, relocation_iterator iter)
@ -122,7 +122,7 @@ void update_literal_references_step(relocation_entry rel, cell index, code_block
 /* Update pointers to literals from compiled code. */
 void update_literal_references(code_block *compiled)
 {
-	if(!compiled->block.needs_fixup)
+	if(!compiled->needs_fixup)
 	{
 		iterate_relocations(compiled,update_literal_references_step);
 		flush_icache_for(compiled);
@ -133,12 +133,12 @@ void update_literal_references(code_block *compiled)
 aging and nursery collections */
 void copy_literal_references(code_block *compiled)
 {
-	if(collecting_gen >= compiled->block.last_scan)
+	if(collecting_gen >= compiled->last_scan)
 	{
 		if(collecting_accumulation_gen_p())
-			compiled->block.last_scan = collecting_gen;
+			compiled->last_scan = collecting_gen;
 		else
-			compiled->block.last_scan = collecting_gen + 1;
+			compiled->last_scan = collecting_gen + 1;

 		/* initialize chase pointer */
 		cell scan = newspace->here;
@ -208,7 +208,7 @@ to update references to other words, without worrying about literals
 or dlsyms. */
 void update_word_references(code_block *compiled)
 {
-	if(compiled->block.needs_fixup)
+	if(compiled->needs_fixup)
 		relocate_code_block(compiled);
 	/* update_word_references() is always applied to every block in
 	   the code heap. Since it resets all call sites to point to
@ -217,8 +217,8 @@ void update_word_references(code_block *compiled)
 	   are referenced after this is done. So instead of polluting
 	   the code heap with dead PICs that will be freed on the next
 	   GC, we add them to the free list immediately. */
-	else if(compiled->block.type == PIC_TYPE)
-		heap_free(&code,&compiled->block);
+	else if(compiled->type == PIC_TYPE)
+		heap_free(&code,compiled);
 	else
 	{
 		iterate_relocations(compiled,update_word_references_step);
@ -248,7 +248,7 @@ void mark_code_block(code_block *compiled)
 {
 	check_code_address((cell)compiled);

-	mark_block(&compiled->block);
+	mark_block(compiled);

 	copy_handle(&compiled->literals);
 	copy_handle(&compiled->relocation);
@ -302,7 +302,7 @@ void mark_object_code_block(object *object)

 /* References to undefined symbols are patched up to call this function on
 image load */
-void undefined_symbol(void)
+void undefined_symbol()
 {
 	general_error(ERROR_UNDEFINED_SYMBOL,F,F,NULL);
 }
@ -329,7 +329,6 @@ void *get_rel_symbol(array *literals, cell index)
 				return sym;
 			else
 			{
-				printf("%s\n",name);
 				return (void *)undefined_symbol;
 			}
 		}
@ -405,8 +404,8 @@ void relocate_code_block_step(relocation_entry rel, cell index, code_block *comp
 /* Perform all fixups on a code block */
 void relocate_code_block(code_block *compiled)
 {
-	compiled->block.last_scan = NURSERY;
-	compiled->block.needs_fixup = false;
+	compiled->last_scan = NURSERY;
+	compiled->needs_fixup = false;
 	iterate_relocations(compiled,relocate_code_block_step);
 	flush_icache_for(compiled);
 }
@ -474,9 +473,9 @@ code_block *add_code_block(
 	code_block *compiled = allot_code_block(code_length);

 	/* compiled header */
-	compiled->block.type = type;
-	compiled->block.last_scan = NURSERY;
-	compiled->block.needs_fixup = true;
+	compiled->type = type;
+	compiled->last_scan = NURSERY;
+	compiled->needs_fixup = true;
 	compiled->relocation = relocation.value();

 	/* slight space optimization */
--- a/vm/code_block.hpp
+++ b/vm/code_block.hpp
@ -82,7 +82,7 @@ void mark_object_code_block(object *scan);

 void relocate_code_block(code_block *relocating);

-inline static bool stack_traces_p(void)
+inline static bool stack_traces_p()
 {
 	return userenv[STACK_TRACES_ENV] != F;
 }
--- a/vm/code_gc.cpp
+++ b/vm/code_gc.cpp
@ -22,9 +22,9 @@ void new_heap(heap *heap, cell size)

 static void add_to_free_list(heap *heap, free_heap_block *block)
 {
-	if(block->block.size < FREE_LIST_COUNT * BLOCK_SIZE_INCREMENT)
+	if(block->size < FREE_LIST_COUNT * BLOCK_SIZE_INCREMENT)
 	{
-		int index = block->block.size / BLOCK_SIZE_INCREMENT;
+		int index = block->size / BLOCK_SIZE_INCREMENT;
 		block->next_free = heap->free.small_blocks[index];
 		heap->free.small_blocks[index] = block;
 	}
@ -73,8 +73,8 @@ void build_free_list(heap *heap, cell size)
 	branch is only taken after loading a new image, not after code GC */
 	if((cell)(end + 1) <= heap->seg->end)
 	{
-		end->block.status = B_FREE;
-		end->block.size = heap->seg->end - (cell)end;
+		end->status = B_FREE;
+		end->size = heap->seg->end - (cell)end;

 		/* add final free block */
 		add_to_free_list(heap,end);
@ -93,7 +93,7 @@ void build_free_list(heap *heap, cell size)

 static void assert_free_block(free_heap_block *block)
 {
-	if(block->block.status != B_FREE)
+	if(block->status != B_FREE)
 		critical_error("Invalid block in free list",(cell)block);
 }
 		
@ -121,7 +121,7 @@ static free_heap_block *find_free_block(heap *heap, cell size)
 	while(block)
 	{
 		assert_free_block(block);
-		if(block->block.size >= size)
+		if(block->size >= size)
 		{
 			if(prev)
 				prev->next_free = block->next_free;
@ -139,14 +139,14 @@ static free_heap_block *find_free_block(heap *heap, cell size)

 static free_heap_block *split_free_block(heap *heap, free_heap_block *block, cell size)
 {
-	if(block->block.size != size )
+	if(block->size != size )
 	{
 		/* split the block in two */
 		free_heap_block *split = (free_heap_block *)((cell)block + size);
-		split->block.status = B_FREE;
-		split->block.size = block->block.size - size;
+		split->status = B_FREE;
+		split->size = block->size - size;
 		split->next_free = block->next_free;
-		block->block.size = size;
+		block->size = size;
 		add_to_free_list(heap,split);
 	}

@ -163,8 +163,8 @@ heap_block *heap_allot(heap *heap, cell size)
 	{
 		block = split_free_block(heap,block,size);

-		block->block.status = B_ALLOCATED;
-		return &block->block;
+		block->status = B_ALLOCATED;
+		return block;
 	}
 	else
 		return NULL;
@ -303,16 +303,16 @@ cell heap_size(heap *heap)
 }

 /* Compute where each block is going to go, after compaction */
-cell compute_heap_forwarding(heap *heap)
+	cell compute_heap_forwarding(heap *heap, unordered_map<heap_block *,char *> &forwarding)
 {
 	heap_block *scan = first_block(heap);
-	cell address = (cell)first_block(heap);
+	char *address = (char *)first_block(heap);

 	while(scan)
 	{
 		if(scan->status == B_ALLOCATED)
 		{
-			scan->forwarding = (heap_block *)address;
+			forwarding[scan] = address;
 			address += scan->size;
 		}
 		else if(scan->status == B_MARKED)
@ -321,10 +321,10 @@ cell compute_heap_forwarding(heap *heap)
 		scan = next_block(heap,scan);
 	}

-	return address - heap->seg->start;
+	return (cell)address - heap->seg->start;
 }

-void compact_heap(heap *heap)
+	void compact_heap(heap *heap, unordered_map<heap_block *,char *> &forwarding)
 {
 	heap_block *scan = first_block(heap);

@ -332,8 +332,8 @@ void compact_heap(heap *heap)
 	{
 		heap_block *next = next_block(heap,scan);

-		if(scan->status == B_ALLOCATED && scan != scan->forwarding)
-			memcpy(scan->forwarding,scan,scan->size);
+		if(scan->status == B_ALLOCATED)
+			memmove(forwarding[scan],scan,scan->size);
 		scan = next;
 	}
 }
--- a/vm/code_gc.hpp
+++ b/vm/code_gc.hpp
@ -25,8 +25,8 @@ void unmark_marked(heap *heap);
 void free_unmarked(heap *heap, heap_iterator iter);
 void heap_usage(heap *h, cell *used, cell *total_free, cell *max_free);
 cell heap_size(heap *h);
-cell compute_heap_forwarding(heap *h);
-void compact_heap(heap *h);
+cell compute_heap_forwarding(heap *h, unordered_map<heap_block *,char *> &forwarding);
+void compact_heap(heap *h, unordered_map<heap_block *,char *> &forwarding);

 inline static heap_block *next_block(heap *h, heap_block *block)
 {
--- a/vm/code_heap.cpp
+++ b/vm/code_heap.cpp
@ -45,14 +45,14 @@ void iterate_code_heap(code_heap_iterator iter)

 /* Copy literals referenced from all code blocks to newspace. Only for
 aging and nursery collections */
-void copy_code_heap_roots(void)
+void copy_code_heap_roots()
 {
 	iterate_code_heap(copy_literal_references);
 }

 /* Update pointers to words referenced from all code blocks. Only after
 defining a new word. */
-void update_code_heap_words(void)
+void update_code_heap_words()
 {
 	iterate_code_heap(update_word_references);
 }
@ -119,9 +119,11 @@ PRIMITIVE(code_room)
 	dpush(tag_fixnum(max_free / 1024));
 }

+static unordered_map<heap_block *,char *> forwarding;
+
 code_block *forward_xt(code_block *compiled)
 {
-	return (code_block *)compiled->block.forwarding;
+	return (code_block *)forwarding[compiled];
 }

 void forward_frame_xt(stack_frame *frame)
@ -132,7 +134,7 @@ void forward_frame_xt(stack_frame *frame)
 	FRAME_RETURN_ADDRESS(frame) = (void *)((cell)forwarded + offset);
 }

-void forward_object_xts(void)
+void forward_object_xts()
 {
 	begin_scan();

@ -176,7 +178,7 @@ void forward_object_xts(void)
 }

 /* Set the XT fields now that the heap has been compacted */
-void fixup_object_xts(void)
+void fixup_object_xts()
 {
 	begin_scan();

@ -209,19 +211,19 @@ void fixup_object_xts(void)
 since it makes several passes over the code and data heaps, but we only ever
 do this before saving a deployed image and exiting, so performaance is not
 critical here */
-void compact_code_heap(void)
+void compact_code_heap()
 {
 	/* Free all unreachable code blocks */
 	gc();

 	/* Figure out where the code heap blocks are going to end up */
-	cell size = compute_heap_forwarding(&code);
+	cell size = compute_heap_forwarding(&code, forwarding);

 	/* Update word and quotation code pointers */
 	forward_object_xts();

 	/* Actually perform the compaction */
-	compact_heap(&code);
+	compact_heap(&code,forwarding);

 	/* Update word and quotation XTs */
 	fixup_object_xts();
--- a/vm/code_heap.hpp
+++ b/vm/code_heap.hpp
@ -14,13 +14,13 @@ typedef void (*code_heap_iterator)(code_block *compiled);

 void iterate_code_heap(code_heap_iterator iter);

-void copy_code_heap_roots(void);
+void copy_code_heap_roots();

 PRIMITIVE(modify_code_heap);

 PRIMITIVE(code_room);

-void compact_code_heap(void);
+void compact_code_heap();

 inline static void check_code_pointer(cell ptr)
 {
--- a/vm/contexts.cpp
+++ b/vm/contexts.cpp
@ -8,19 +8,19 @@ namespace factor
 cell ds_size, rs_size;
 context *unused_contexts;

-void reset_datastack(void)
+void reset_datastack()
 {
 	ds = ds_bot - sizeof(cell);
 }

-void reset_retainstack(void)
+void reset_retainstack()
 {
 	rs = rs_bot - sizeof(cell);
 }

 #define RESERVED (64 * sizeof(cell))

-void fix_stacks(void)
+void fix_stacks()
 {
 	if(ds + sizeof(cell) < ds_bot || ds + RESERVED >= ds_top) reset_datastack();
 	if(rs + sizeof(cell) < rs_bot || rs + RESERVED >= rs_top) reset_retainstack();
@ -28,7 +28,7 @@ void fix_stacks(void)

 /* called before entry into foreign C code. Note that ds and rs might
 be stored in registers, so callbacks must save and restore the correct values */
-void save_stacks(void)
+void save_stacks()
 {
 	if(stack_chain)
 	{
@ -37,7 +37,7 @@ void save_stacks(void)
 	}
 }

-context *alloc_context(void)
+context *alloc_context()
 {
 	context *new_context;

@ -63,7 +63,7 @@ void dealloc_context(context *old_context)
 }

 /* called on entry into a compiled callback */
-void nest_stacks(void)
+void nest_stacks()
 {
 	context *new_context = alloc_context();

@ -95,7 +95,7 @@ void nest_stacks(void)
 }

 /* called when leaving a compiled callback */
-void unnest_stacks(void)
+void unnest_stacks()
 {
 	ds = stack_chain->datastack_save;
 	rs = stack_chain->retainstack_save;
--- a/vm/contexts.hpp
+++ b/vm/contexts.hpp
@ -46,9 +46,9 @@ extern cell ds_size, rs_size;
 DEFPUSHPOP(d,ds)
 DEFPUSHPOP(r,rs)

-void reset_datastack(void);
-void reset_retainstack(void);
-void fix_stacks(void);
+void reset_datastack();
+void reset_retainstack();
+void fix_stacks();
 void init_stacks(cell ds_size, cell rs_size);

 PRIMITIVE(datastack);
@ -57,9 +57,9 @@ PRIMITIVE(set_datastack);
 PRIMITIVE(set_retainstack);
 PRIMITIVE(check_datastack);

-VM_C_API void save_stacks(void);
-VM_C_API void nest_stacks(void);
-VM_C_API void unnest_stacks(void);
+VM_C_API void save_stacks();
+VM_C_API void nest_stacks();
+VM_C_API void unnest_stacks();

 }

--- a/vm/cpu-x86.32.hpp
+++ b/vm/cpu-x86.32.hpp
@ -6,6 +6,6 @@ namespace factor
 register cell ds asm("esi");
 register cell rs asm("edi");

-#define VM_ASM_API extern "C" __attribute__ ((regparm (2)))
+#define VM_ASM_API VM_C_API __attribute__ ((regparm (2)))

 }
--- a/vm/cpu-x86.64.hpp
+++ b/vm/cpu-x86.64.hpp
@ -6,6 +6,6 @@ namespace factor
 register cell ds asm("r14");
 register cell rs asm("r15");

-#define VM_ASM_API extern "C"
+#define VM_ASM_API VM_C_API

 }
--- a/vm/data_gc.cpp
+++ b/vm/data_gc.cpp
@ -33,7 +33,7 @@ cell last_code_heap_scan;
 bool growing_data_heap;
 data_heap *old_data_heap;

-void init_data_gc(void)
+void init_data_gc()
 {
 	performing_gc = false;
 	last_code_heap_scan = NURSERY;
@ -244,7 +244,7 @@ static void copy_gen_cards(cell gen)

 /* Scan cards in all generations older than the one being collected, copying
 old->new references */
-static void copy_cards(void)
+static void copy_cards()
 {
 	u64 start = current_micros();

@ -264,7 +264,7 @@ static void copy_stack_elements(segment *region, cell top)
 		copy_handle((cell*)ptr);
 }

-static void copy_registered_locals(void)
+static void copy_registered_locals()
 {
 	cell scan = gc_locals_region->start;

@ -272,7 +272,7 @@ static void copy_registered_locals(void)
 		copy_handle(*(cell **)scan);
 }

-static void copy_registered_bignums(void)
+static void copy_registered_bignums()
 {
 	cell scan = gc_bignums_region->start;

@ -295,7 +295,7 @@ static void copy_registered_bignums(void)

 /* Copy roots over at the start of GC, namely various constants, stacks,
 the user environment and extra roots registered by local_roots.hpp */
-static void copy_roots(void)
+static void copy_roots()
 {
 	copy_handle(&T);
 	copy_handle(&bignum_zero);
@ -593,7 +593,7 @@ void garbage_collection(cell gen,
 	performing_gc = false;
 }

-void gc(void)
+void gc()
 {
 	garbage_collection(TENURED,false,0);
 }
@ -633,7 +633,7 @@ PRIMITIVE(gc_stats)
 	dpush(result.elements.value());
 }

-void clear_gc_stats(void)
+void clear_gc_stats()
 {
 	int i;
 	for(i = 0; i < MAX_GEN_COUNT; i++)
@ -681,7 +681,7 @@ PRIMITIVE(become)
 	compile_all_words();
 }

-VM_C_API void minor_gc(void)
+VM_C_API void minor_gc()
 {
 	garbage_collection(NURSERY,false,0);
 }
--- a/vm/data_gc.hpp
+++ b/vm/data_gc.hpp
@ -18,11 +18,11 @@ extern bool collecting_aging_again;

 extern cell last_code_heap_scan;

-void init_data_gc(void);
+void init_data_gc();

-void gc(void);
+void gc();

-inline static bool collecting_accumulation_gen_p(void)
+inline static bool collecting_accumulation_gen_p()
 {
 	return ((HAVE_AGING_P
 		&& collecting_gen == AGING
@ -114,7 +114,7 @@ void copy_reachable_objects(cell scan, cell *end);

 PRIMITIVE(gc);
 PRIMITIVE(gc_stats);
-void clear_gc_stats(void);
+void clear_gc_stats();
 PRIMITIVE(clear_gc_stats);
 PRIMITIVE(become);

@ -143,6 +143,6 @@ inline static void check_tagged_pointer(cell tagged)
 #endif
 }

-VM_C_API void minor_gc(void);
+VM_C_API void minor_gc();

 }
--- a/vm/data_heap.cpp
+++ b/vm/data_heap.cpp
@ -24,7 +24,7 @@ cell init_zone(zone *z, cell size, cell start)
 	return z->end;
 }

-void init_card_decks(void)
+void init_card_decks()
 {
 	cell start = align(data->seg->start,DECK_SIZE);
 	allot_markers_offset = (cell)data->allot_markers - (start >> CARD_BITS);
@ -241,7 +241,7 @@ cell unaligned_object_size(object *pointer)
 		return callstack_size(untag_fixnum(((callstack *)pointer)->length));
 	default:
 		critical_error("Invalid header",(cell)pointer);
-		return -1; /* can't happen */
+		return 0; /* can't happen */
 	}
 }

@ -283,7 +283,7 @@ cell binary_payload_start(object *pointer)
 		return sizeof(wrapper);
 	default:
 		critical_error("Invalid header",(cell)pointer);
-		return -1; /* can't happen */
+                return 0; /* can't happen */
 	}
 }

@ -312,7 +312,7 @@ references to an object for debugging purposes. */
 cell heap_scan_ptr;

 /* Disables GC and activates next-object ( -- obj ) primitive */
-void begin_scan(void)
+void begin_scan()
 {
 	heap_scan_ptr = data->generations[TENURED].start;
 	gc_off = true;
@ -323,7 +323,7 @@ PRIMITIVE(begin_scan)
 	begin_scan();
 }

-cell next_object(void)
+cell next_object()
 {
 	if(!gc_off)
 		general_error(ERROR_HEAP_SCAN,F,F,NULL);
@ -348,7 +348,7 @@ PRIMITIVE(end_scan)
 	gc_off = false;
 }

-cell find_all_words(void)
+cell find_all_words()
 {
 	growable_array words;

--- a/vm/data_heap.hpp
+++ b/vm/data_heap.hpp
@ -56,7 +56,7 @@ inline static bool in_zone(zone *z, object *pointer)

 cell init_zone(zone *z, cell size, cell base);

-void init_card_decks(void);
+void init_card_decks();

 data_heap *grow_data_heap(data_heap *data, cell requested_bytes);

@ -86,8 +86,8 @@ cell unaligned_object_size(object *pointer);
 cell binary_payload_start(object *pointer);
 cell object_size(cell tagged);

-void begin_scan(void);
-cell next_object(void);
+void begin_scan();
+cell next_object();

 PRIMITIVE(data_room);
 PRIMITIVE(size);
@ -99,7 +99,7 @@ PRIMITIVE(end_scan);
 /* GC is off during heap walking */
 extern bool gc_off;

-cell find_all_words(void);
+cell find_all_words();

 /* Every object has a regular representation in the runtime, which makes GC
 much simpler. Every slot of the object until binary_payload_start is a pointer
--- a/vm/debug.cpp
+++ b/vm/debug.cpp
@ -155,13 +155,13 @@ void print_objects(cell *start, cell *end)
 	}
 }

-void print_datastack(void)
+void print_datastack()
 {
 	print_string("==== DATA STACK:\n");
 	print_objects((cell *)ds_bot,(cell *)ds);
 }

-void print_retainstack(void)
+void print_retainstack()
 {
 	print_string("==== RETAIN STACK:\n");
 	print_objects((cell *)rs_bot,(cell *)rs);
@ -179,7 +179,7 @@ void print_stack_frame(stack_frame *frame)
 	print_string("\n");
 }

-void print_callstack(void)
+void print_callstack()
 {
 	print_string("==== CALL STACK:\n");
 	cell bottom = (cell)stack_chain->callstack_bottom;
@ -210,7 +210,7 @@ void dump_zone(zone *z)
 	print_string(", here="); print_cell(z->here - z->start); nl();
 }

-void dump_generations(void)
+void dump_generations()
 {
 	cell i;

@ -285,7 +285,7 @@ void find_data_references(cell look_for_)
 }

 /* Dump all code blocks for debugging */
-void dump_code_heap(void)
+void dump_code_heap()
 {
 	cell reloc_size = 0, literal_size = 0;

@ -325,7 +325,7 @@ void dump_code_heap(void)
 	print_cell(literal_size); print_string(" bytes of literal data\n");
 }

-void factorbug(void)
+void factorbug()
 {
 	if(fep_disabled)
 	{
--- a/vm/debug.hpp
+++ b/vm/debug.hpp
@ -3,8 +3,8 @@ namespace factor

 void print_obj(cell obj);
 void print_nested_obj(cell obj, fixnum nesting);
-void dump_generations(void);
-void factorbug(void);
+void dump_generations();
+void factorbug();
 void dump_zone(zone *z);

 PRIMITIVE(die);
--- a/vm/dispatch.cpp
+++ b/vm/dispatch.cpp
@ -103,7 +103,7 @@ static cell lookup_hairy_method(cell obj, cell methods)
 			break;
 		default:
 			critical_error("Bad methods array",methods);
-			return -1;
+			return 0;
 		}
 	}
 }
--- a/vm/errors.cpp
+++ b/vm/errors.cpp
@ -9,7 +9,7 @@ cell signal_number;
 cell signal_fault_addr;
 stack_frame *signal_callstack_top;

-void out_of_memory(void)
+void out_of_memory()
 {
 	print_string("Out of memory\n\n");
 	dump_generations();
@ -88,7 +88,7 @@ void type_error(cell type, cell tagged)
 	general_error(ERROR_TYPE,tag_fixnum(type),tagged,NULL);
 }

-void not_implemented_error(void)
+void not_implemented_error()
 {
 	general_error(ERROR_NOT_IMPLEMENTED,F,F,NULL);
 }
@ -125,7 +125,7 @@ void signal_error(int signal, stack_frame *native_stack)
 	general_error(ERROR_SIGNAL,tag_fixnum(signal),F,native_stack);
 }

-void divide_by_zero_error(void)
+void divide_by_zero_error()
 {
 	general_error(ERROR_DIVIDE_BY_ZERO,F,F,NULL);
 }
@ -141,12 +141,12 @@ PRIMITIVE(unimplemented)
 	not_implemented_error();
 }

-void memory_signal_handler_impl(void)
+void memory_signal_handler_impl()
 {
 	memory_protection_error(signal_fault_addr,signal_callstack_top);
 }

-void misc_signal_handler_impl(void)
+void misc_signal_handler_impl()
 {
 	signal_error(signal_number,signal_callstack_top);
 }
--- a/vm/errors.hpp
+++ b/vm/errors.hpp
@ -22,7 +22,7 @@ enum vm_error_type
 	ERROR_MEMORY,
 };

-void out_of_memory(void);
+void out_of_memory();
 void fatal_error(const char* msg, cell tagged);
 void critical_error(const char* msg, cell tagged);

@ -30,11 +30,11 @@ PRIMITIVE(die);

 void throw_error(cell error, stack_frame *native_stack);
 void general_error(vm_error_type error, cell arg1, cell arg2, stack_frame *native_stack);
-void divide_by_zero_error(void);
+void divide_by_zero_error();
 void memory_protection_error(cell addr, stack_frame *native_stack);
 void signal_error(int signal, stack_frame *native_stack);
 void type_error(cell type, cell tagged);
-void not_implemented_error(void);
+void not_implemented_error();

 PRIMITIVE(call_clear);
 PRIMITIVE(unimplemented);
@ -45,7 +45,7 @@ extern cell signal_number;
 extern cell signal_fault_addr;
 extern stack_frame *signal_callstack_top;

-void memory_signal_handler_impl(void);
-void misc_signal_handler_impl(void);
+void memory_signal_handler_impl();
+void misc_signal_handler_impl();

 }
--- a/vm/factor.cpp
+++ b/vm/factor.cpp
@ -81,7 +81,7 @@ VM_C_API void init_parameters_from_args(vm_parameters *p, int argc, vm_char **ar
 }

 /* Do some initialization that we do once only */
-static void do_stage1_init(void)
+static void do_stage1_init()
 {
 	print_string("*** Stage 2 early init... ");
 	fflush(stdout);
@ -134,7 +134,7 @@ VM_C_API void init_factor(vm_parameters *p)

 	userenv[CPU_ENV] = allot_alien(F,(cell)FACTOR_CPU_STRING);
 	userenv[OS_ENV] = allot_alien(F,(cell)FACTOR_OS_STRING);
-	userenv[cell_SIZE_ENV] = tag_fixnum(sizeof(cell));
+	userenv[CELL_SIZE_ENV] = tag_fixnum(sizeof(cell));
 	userenv[EXECUTABLE_ENV] = allot_alien(F,(cell)p->executable_path);
 	userenv[ARGS_ENV] = F;
 	userenv[EMBEDDED_ENV] = F;
@ -198,9 +198,9 @@ VM_C_API void factor_eval_free(char *result)
 	free(result);
 }

-VM_C_API void factor_yield(void)
+VM_C_API void factor_yield()
 {
-	void (*callback)(void) = (void (*)(void))alien_offset(userenv[YIELD_CALLBACK_ENV]);
+	void (*callback)() = (void (*)())alien_offset(userenv[YIELD_CALLBACK_ENV]);
 	callback();
 }

--- a/vm/factor.hpp
+++ b/vm/factor.hpp
@ -10,7 +10,7 @@ VM_C_API void start_standalone_factor(int argc, vm_char **argv);

 VM_C_API char *factor_eval_string(char *string);
 VM_C_API void factor_eval_free(char *result);
-VM_C_API void factor_yield(void);
+VM_C_API void factor_yield();
 VM_C_API void factor_sleep(long ms);

 }
--- a/vm/ffi_test.c
+++ b/vm/ffi_test.c
@ -319,3 +319,8 @@ _Complex float ffi_test_47(_Complex float x, _Complex double y)
 {
 	return x + 2 * y;
 }
+
+short ffi_test_48(struct bool_field_test x)
+{
+	return x.parents;
+}
--- a/vm/ffi_test.h
+++ b/vm/ffi_test.h
@ -1,3 +1,5 @@
+#include <stdbool.h>
+
 #if defined(i386) || defined(__i386) || defined(__i386__) || defined(WIN32)
 	#define F_STDCALL __attribute__((stdcall))
 #else
@ -102,3 +104,11 @@ F_EXPORT _Complex float ffi_test_45(int x);
 F_EXPORT _Complex double ffi_test_46(int x);

 F_EXPORT _Complex float ffi_test_47(_Complex float x, _Complex double y);
+
+struct bool_field_test {
+	char *name;
+	bool on;
+	short parents;
+};
+
+F_EXPORT short ffi_test_48(struct bool_field_test x);
--- a/vm/image.cpp
+++ b/vm/image.cpp
@ -106,14 +106,8 @@ bool save_image(const vm_char *filename)
 	h.bignum_pos_one = bignum_pos_one;
 	h.bignum_neg_one = bignum_neg_one;

-	cell i;
-	for(i = 0; i < USER_ENV; i++)
-	{
-		if(i < FIRST_SAVE_ENV)
-			h.userenv[i] = F;
-		else
-			h.userenv[i] = userenv[i];
-	}
+	for(cell i = 0; i < USER_ENV; i++)
+		h.userenv[i] = (save_env_p(i) ? userenv[i] : F);

 	bool ok = true;

@ -149,12 +143,10 @@ PRIMITIVE(save_image_and_exit)
 	path.untag_check();

 	/* strip out userenv data which is set on startup anyway */
-	cell i;
-	for(i = 0; i < FIRST_SAVE_ENV; i++)
-		userenv[i] = F;
-
-	for(i = LAST_SAVE_ENV + 1; i < STACK_TRACES_ENV; i++)
-		userenv[i] = F;
+	for(cell i = 0; i < USER_ENV; i++)
+	{
+		if(!save_env_p(i)) userenv[i] = F;
+	}

 	/* do a full GC + code heap compaction */
 	performing_compaction = true;
--- a/vm/inline_cache.cpp
+++ b/vm/inline_cache.cpp
@ -22,7 +22,7 @@ void deallocate_inline_cache(cell return_address)
 	/* Find the call target. */
 	void *old_xt = get_call_target(return_address);
 	code_block *old_block = (code_block *)old_xt - 1;
-	cell old_type = old_block->block.type;
+	cell old_type = old_block->type;

 #ifdef FACTOR_DEBUG
 	/* The call target was either another PIC,
@ -31,7 +31,7 @@ void deallocate_inline_cache(cell return_address)
 #endif

 	if(old_type == PIC_TYPE)
-		heap_free(&code,&old_block->block);
+		heap_free(&code,old_block);
 }

 /* Figure out what kind of type check the PIC needs based on the methods
@ -70,7 +70,7 @@ static cell determine_inline_cache_type(array *cache_entries)
 	if(!seen_hi_tag && !seen_tuple) return PIC_TAG;

 	critical_error("Oops",0);
-	return -1;
+	return 0;
 }

 static void update_pic_count(cell type)
--- a/vm/io.cpp
+++ b/vm/io.cpp
@ -14,14 +14,14 @@ The Factor library provides platform-specific code for Unix and Windows
 with many more capabilities so these words are not usually used in
 normal operation. */

-void init_c_io(void)
+void init_c_io()
 {
 	userenv[STDIN_ENV] = allot_alien(F,(cell)stdin);
 	userenv[STDOUT_ENV] = allot_alien(F,(cell)stdout);
 	userenv[STDERR_ENV] = allot_alien(F,(cell)stderr);
 }

-void io_error(void)
+void io_error()
 {
 #ifndef WINCE
 	if(errno == EINTR)
@ -216,12 +216,12 @@ PRIMITIVE(fclose)
 /* This function is used by FFI I/O. Accessing the errno global directly is
 not portable, since on some libc's errno is not a global but a funky macro that
 reads thread-local storage. */
-VM_C_API int err_no(void)
+VM_C_API int err_no()
 {
 	return errno;
 }

-VM_C_API void clear_err_no(void)
+VM_C_API void clear_err_no()
 {
 	errno = 0;
 }
--- a/vm/io.hpp
+++ b/vm/io.hpp
@ -1,8 +1,8 @@
 namespace factor
 {

-void init_c_io(void);
-void io_error(void);
+void init_c_io();
+void io_error();

 PRIMITIVE(fopen);
 PRIMITIVE(fgetc);
@ -18,7 +18,7 @@ PRIMITIVE(open_file);
 PRIMITIVE(existsp);
 PRIMITIVE(read_dir);

-VM_C_API int err_no(void);
-VM_C_API void clear_err_no(void);
+VM_C_API int err_no();
+VM_C_API void clear_err_no();

 }
--- a/vm/layouts.hpp
+++ b/vm/layouts.hpp
@ -93,6 +93,9 @@ class object;
 struct header {
 	cell value;

+        /* Default ctor to make gcc 3.x happy */
+        header() { abort(); }
+
 	header(cell value_) : value(value_ << TAG_BITS) {}

 	void check_header() {
@ -193,26 +196,19 @@ struct heap_block
 	unsigned char status; /* free or allocated? */
 	unsigned char type; /* this is WORD_TYPE or QUOTATION_TYPE */
 	unsigned char last_scan; /* the youngest generation in which this block's literals may live */
-	char needs_fixup; /* is this a new block that needs full fixup? */
+	unsigned char needs_fixup; /* is this a new block that needs full fixup? */

 	/* In bytes, includes this header */
 	cell size;
-
-	/* Used during compaction */
-	heap_block *forwarding;
 };

-struct free_heap_block
+struct free_heap_block : public heap_block
 {
-	heap_block block;
-
-	/* Filled in on image load */
        free_heap_block *next_free;
 };

-struct code_block
+struct code_block : public heap_block
 {
-	heap_block block;
 	cell literals; /* # bytes */
 	cell relocation; /* tagged pointer to byte-array or f */
 	
--- a/vm/mach_signal.cpp
+++ b/vm/mach_signal.cpp
@ -169,7 +169,7 @@ mach_exception_thread (void *arg)
 }

 /* Initialize the Mach exception handler thread. */
-void mach_initialize (void)
+void mach_initialize ()
 {
 	mach_port_t self;
 	exception_mask_t mask;
--- a/vm/mach_signal.hpp
+++ b/vm/mach_signal.hpp
@ -79,6 +79,6 @@ catch_exception_raise_state_identity (mach_port_t exception_port,
 namespace factor
 {

-void mach_initialize (void);
+void mach_initialize ();

 }
--- a/vm/master.hpp
+++ b/vm/master.hpp
@ -9,6 +9,7 @@
 #include <assert.h>
 #endif

+/* C headers */
 #include <fcntl.h>
 #include <limits.h>
 #include <math.h>
@ -20,6 +21,18 @@
 #include <time.h>
 #include <sys/param.h>

+/* C++ headers */
+#if __GNUC__ == 4
+        #include <tr1/unordered_map>
+        #define unordered_map std::tr1::unordered_map
+#elif __GNUC__ == 3
+        #include <boost/unordered_map.hpp>
+        #define unordered_map boost::unordered_map
+#else
+        #error Factor requires GCC 3.x or later
+#endif
+
+/* Factor headers */
 #include "layouts.hpp"
 #include "platform.hpp"
 #include "primitives.hpp"
--- a/vm/math.cpp
+++ b/vm/math.cpp
@ -219,7 +219,7 @@ PRIMITIVE(byte_array_to_bignum)
 	drepl(tag<bignum>(result));
 }

-cell unbox_array_size(void)
+cell unbox_array_size()
 {
 	switch(tagged<object>(dpeek()).type())
 	{
@ -377,7 +377,7 @@ VM_C_API fixnum to_fixnum(cell tagged)
 		return bignum_to_fixnum(untag<bignum>(tagged));
 	default:
 		type_error(FIXNUM_TYPE,tagged);
-		return -1; /* can't happen */
+		return 0; /* can't happen */
 	}
 }

@ -444,7 +444,7 @@ VM_C_API s64 to_signed_8(cell obj)
 		return bignum_to_long_long(untag<bignum>(obj));
 	default:
 		type_error(BIGNUM_TYPE,obj);
-		return -1;
+		return 0;
 	}
 }

@ -466,7 +466,7 @@ VM_C_API u64 to_unsigned_8(cell obj)
 		return bignum_to_ulong_long(untag<bignum>(obj));
 	default:
 		type_error(BIGNUM_TYPE,obj);
-		return -1;
+		return 0;
 	}
 }

--- a/vm/math.hpp
+++ b/vm/math.hpp
@ -59,7 +59,7 @@ inline static cell allot_cell(cell x)
 		return tag_fixnum(x);
 }

-cell unbox_array_size(void);
+cell unbox_array_size();

 inline static double untag_float(cell tagged)
 {
--- a/vm/os-freebsd.cpp
+++ b/vm/os-freebsd.cpp
@ -4,7 +4,7 @@ namespace factor
 {

 /* From SBCL */
-const char *vm_executable_path(void)
+const char *vm_executable_path()
 {
 	char path[PATH_MAX + 1];

--- a/vm/os-freebsd.hpp
+++ b/vm/os-freebsd.hpp
@ -1,7 +1,7 @@
 #include <osreldate.h>
 #include <sys/sysctl.h>

-extern "C" int getosreldate(void);
+extern "C" int getosreldate();

 #ifndef KERN_PROC_PATHNAME
 #define KERN_PROC_PATHNAME 12
--- a/vm/os-genunix.cpp
+++ b/vm/os-genunix.cpp
@ -8,17 +8,17 @@ void c_to_factor_toplevel(cell quot)
 	c_to_factor(quot);
 }

-void init_signals(void)
+void init_signals()
 {
 	unix_init_signals();
 }

-void early_init(void) { }
+void early_init() { }

 #define SUFFIX ".image"
 #define SUFFIX_LEN 6

-const char *default_image_path(void)
+const char *default_image_path()
 {
 	const char *path = vm_executable_path();

--- a/vm/os-genunix.hpp
+++ b/vm/os-genunix.hpp
@ -5,9 +5,9 @@ namespace factor
 #define NULL_DLL NULL

 void c_to_factor_toplevel(cell quot);
-void init_signals(void);
-void early_init(void);
-const char *vm_executable_path(void);
-const char *default_image_path(void);
+void init_signals();
+void early_init();
+const char *vm_executable_path();
+const char *default_image_path();

 }
--- a/vm/os-linux.cpp
+++ b/vm/os-linux.cpp
@ -4,7 +4,7 @@ namespace factor
 {

 /* Snarfed from SBCL linux-so.c. You must free() this yourself. */
-const char *vm_executable_path(void)
+const char *vm_executable_path()
 {
 	char *path = (char *)safe_malloc(PATH_MAX + 1);

@ -23,7 +23,7 @@ const char *vm_executable_path(void)

 #ifdef SYS_inotify_init

-int inotify_init(void)
+int inotify_init()
 {
 	return syscall(SYS_inotify_init);
 }
@ -40,7 +40,7 @@ int inotify_rm_watch(int fd, u32 wd)

 #else

-int inotify_init(void)
+int inotify_init()
 {
 	not_implemented_error();
 	return -1;
--- a/vm/os-linux.hpp
+++ b/vm/os-linux.hpp
@ -3,7 +3,7 @@
 namespace factor
 {

-int inotify_init(void);
+int inotify_init();
 int inotify_add_watch(int fd, const char *name, u32 mask);
 int inotify_rm_watch(int fd, u32 wd);

--- a/vm/os-macosx.hpp
+++ b/vm/os-macosx.hpp
@ -5,11 +5,11 @@ namespace factor
 #define FACTOR_OS_STRING "macosx"
 #define NULL_DLL "libfactor.dylib"

-void init_signals(void);
-void early_init(void);
+void init_signals();
+void early_init();

-const char *vm_executable_path(void);
-const char *default_image_path(void);
+const char *vm_executable_path();
+const char *default_image_path();

 inline static void *ucontext_stack_pointer(void *uap)
 {
--- a/vm/os-netbsd.cpp
+++ b/vm/os-netbsd.cpp
@ -5,7 +5,7 @@ namespace factor

 extern "C" int main();

-const char *vm_executable_path(void)
+const char *vm_executable_path()
 {
 	static Dl_info info = {0};
 	if (!info.dli_fname)
--- a/vm/os-openbsd.cpp
+++ b/vm/os-openbsd.cpp
@ -3,7 +3,7 @@
 namespace factor
 {

-const char *vm_executable_path(void)
+const char *vm_executable_path()
 {
 	return NULL;
 }
--- a/vm/os-solaris.cpp
+++ b/vm/os-solaris.cpp
@ -3,7 +3,7 @@
 namespace factor
 {

-const char *vm_executable_path(void)
+const char *vm_executable_path()
 {
 	return NULL;
 }
--- a/vm/os-unix.cpp
+++ b/vm/os-unix.cpp
@ -19,7 +19,7 @@ void start_thread(void *(*start_routine)(void *))

 static void *null_dll;

-s64 current_micros(void)
+s64 current_micros()
 {
 	struct timeval t;
 	gettimeofday(&t,NULL);
@ -31,7 +31,7 @@ void sleep_micros(cell usec)
 	usleep(usec);
 }

-void init_ffi(void)
+void init_ffi()
 {
 	/* NULL_DLL is "libfactor.dylib" for OS X and NULL for generic unix */
 	null_dll = dlopen(NULL_DLL,RTLD_LAZY);
@ -145,7 +145,7 @@ static void sigaction_safe(int signum, const struct sigaction *act, struct sigac
 		fatal_error("sigaction failed", 0);
 }

-void unix_init_signals(void)
+void unix_init_signals()
 {
 	struct sigaction memory_sigaction;
 	struct sigaction misc_sigaction;
@ -279,7 +279,7 @@ void *stdin_loop(void *arg)
 	return NULL;
 }

-void open_console(void)
+void open_console()
 {
 	int filedes[2];

@ -304,7 +304,7 @@ void open_console(void)
 	start_thread(stdin_loop);
 }

-VM_C_API void wait_for_stdin(void)
+VM_C_API void wait_for_stdin()
 {
 	if(write(control_write,"X",1) != 1)
 	{
--- a/vm/os-unix.hpp
+++ b/vm/os-unix.hpp
@ -42,18 +42,18 @@ typedef char symbol_char;

 void start_thread(void *(*start_routine)(void *));

-void init_ffi(void);
+void init_ffi();
 void ffi_dlopen(dll *dll);
 void *ffi_dlsym(dll *dll, symbol_char *symbol);
 void ffi_dlclose(dll *dll);

-void unix_init_signals(void);
+void unix_init_signals();
 void signal_handler(int signal, siginfo_t* siginfo, void* uap);
 void dump_stack_signal(int signal, siginfo_t* siginfo, void* uap);

-s64 current_micros(void);
+s64 current_micros();
 void sleep_micros(cell usec);

-void open_console(void);
+void open_console();

 }
--- a/vm/os-windows-ce.cpp
+++ b/vm/os-windows-ce.cpp
@ -3,7 +3,7 @@
 namespace factor
 {

-s64 current_micros(void)
+s64 current_micros()
 {
 	SYSTEMTIME st;
 	FILETIME ft;
@ -40,6 +40,6 @@ void c_to_factor_toplevel(cell quot)
 	c_to_factor(quot);
 }

-void open_console(void) { }
+void open_console() { }

 }
--- a/vm/os-windows-ce.hpp
+++ b/vm/os-windows-ce.hpp
@ -22,8 +22,8 @@ char *getenv(char *name);
 #define snprintf _snprintf
 #define snwprintf _snwprintf

-s64 current_micros(void);
+s64 current_micros();
 void c_to_factor_toplevel(cell quot);
-void open_console(void);
+void open_console();

 }
--- a/vm/os-windows-nt.cpp
+++ b/vm/os-windows-nt.cpp
@ -3,7 +3,7 @@
 namespace factor
 {

-s64 current_micros(void)
+s64 current_micros()
 {
 	FILETIME t;
 	GetSystemTimeAsFileTime(&t);
@ -11,13 +11,13 @@ s64 current_micros(void)
 		- EPOCH_OFFSET) / 10;
 }

-long exception_handler(PEXCEPTION_POINTERS pe)
+FACTOR_STDCALL LONG exception_handler(PEXCEPTION_POINTERS pe)
 {
 	PEXCEPTION_RECORD e = (PEXCEPTION_RECORD)pe->ExceptionRecord;
 	CONTEXT *c = (CONTEXT*)pe->ContextRecord;

 	if(in_code_heap_p(c->EIP))
-		signal_callstack_top = (void *)c->ESP;
+		signal_callstack_top = (stack_frame *)c->ESP;
 	else
 		signal_callstack_top = NULL;

@ -43,13 +43,13 @@ long exception_handler(PEXCEPTION_POINTERS pe)

 void c_to_factor_toplevel(cell quot)
 {
-	if(!AddVectoredExceptionHandler(0, (void*)exception_handler))
+	if(!AddVectoredExceptionHandler(0, (PVECTORED_EXCEPTION_HANDLER)exception_handler))
 		fatal_error("AddVectoredExceptionHandler failed", 0);
 	c_to_factor(quot);
-	RemoveVectoredExceptionHandler((void*)exception_handler);
+	RemoveVectoredExceptionHandler((void *)exception_handler);
 }

-void open_console(void)
+void open_console()
 {
 }

--- a/vm/os-windows-nt.hpp
+++ b/vm/os-windows-nt.hpp
@ -5,8 +5,8 @@
 #define UNICODE
 #endif

-#include <shellapi.h>
 #include <windows.h>
+#include <shellapi.h>

 namespace factor
 {
@ -17,8 +17,10 @@ typedef char symbol_char;
 #define FACTOR_DLL L"factor.dll"
 #define FACTOR_DLL_NAME "factor.dll"

+#define FACTOR_STDCALL __attribute__((stdcall))
+
 void c_to_factor_toplevel(cell quot);
-long exception_handler(PEXCEPTION_POINTERS pe);
-void open_console(void);
+FACTOR_STDCALL LONG exception_handler(PEXCEPTION_POINTERS pe);
+void open_console();

 }
--- a/vm/os-windows.cpp
+++ b/vm/os-windows.cpp
@ -5,7 +5,7 @@ namespace factor

 HMODULE hFactorDll;

-void init_ffi(void)
+void init_ffi()
 {
 	hFactorDll = GetModuleHandle(FACTOR_DLL);
 	if(!hFactorDll)
@ -14,12 +14,12 @@ void init_ffi(void)

 void ffi_dlopen(dll *dll)
 {
-	dll->dll = LoadLibraryEx(alien_offset(dll->path), NULL, 0);
+	dll->dll = LoadLibraryEx((WCHAR *)alien_offset(dll->path), NULL, 0);
 }

 void *ffi_dlsym(dll *dll, symbol_char *symbol)
 {
-	return GetProcAddress(dll ? (HMODULE)dll->dll : hFactorDll, symbol);
+	return (void *)GetProcAddress(dll ? (HMODULE)dll->dll : hFactorDll, symbol);
 }

 void ffi_dlclose(dll *dll)
@ -63,7 +63,7 @@ void windows_image_path(vm_char *full_path, vm_char *temp_path, unsigned int len
 }

 /* You must free() this yourself. */
-const vm_char *default_image_path(void)
+const vm_char *default_image_path()
 {
 	vm_char full_path[MAX_UNICODE_PATH];
 	vm_char *ptr;
@ -82,7 +82,7 @@ const vm_char *default_image_path(void)
 }

 /* You must free() this yourself. */
-const vm_char *vm_executable_path(void)
+const vm_char *vm_executable_path()
 {
 	vm_char full_path[MAX_UNICODE_PATH];
 	if(!GetModuleFileName(NULL, full_path, MAX_UNICODE_PATH))
@ -93,7 +93,7 @@ const vm_char *vm_executable_path(void)

 PRIMITIVE(existsp)
 {
-	vm_char *path = (vm_char *)(untag_check<byte_array>(dpop()) + 1);
+	vm_char *path = untag_check<byte_array>(dpop())->data<vm_char>();
 	box_boolean(windows_stat(path));
 }

@ -113,7 +113,7 @@ segment *alloc_segment(cell size)
 		getpagesize(), PAGE_NOACCESS, &ignore))
 		fatal_error("Cannot allocate high guard page", (cell)mem);

-	segment *block = safe_malloc(sizeof(segment));
+	segment *block = (segment *)safe_malloc(sizeof(segment));

 	block->start = (cell)mem + getpagesize();
 	block->size = size;
@ -131,7 +131,7 @@ void dealloc_segment(segment *block)
 	free(block);
 }

-long getpagesize(void)
+long getpagesize()
 {
 	static long g_pagesize = 0;
 	if (! g_pagesize)
--- a/vm/os-windows.hpp
+++ b/vm/os-windows.hpp
@ -41,19 +41,19 @@ typedef wchar_t vm_char;
 /* Difference between Jan 1 00:00:00 1601 and Jan 1 00:00:00 1970 */
 #define EPOCH_OFFSET 0x019db1ded53e8000LL

-void init_ffi(void);
+void init_ffi();
 void ffi_dlopen(dll *dll);
 void *ffi_dlsym(dll *dll, symbol_char *symbol);
 void ffi_dlclose(dll *dll);

 void sleep_micros(u64 msec);

-inline static void init_signals(void) {}
-inline static void early_init(void) {}
-const vm_char *vm_executable_path(void);
-const vm_char *default_image_path(void);
-long getpagesize (void);
+inline static void init_signals() {}
+inline static void early_init() {}
+const vm_char *vm_executable_path();
+const vm_char *default_image_path();
+long getpagesize ();

-s64 current_micros(void);
+s64 current_micros();

 }
--- a/Show More
+++ b/Show More