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

basis/alien/c-types/c-types.factor

@@ -258,7 +258,7 @@ M: pointer c-type
         2 >>align
         2 >>align-first
         "from_signed_2" >>boxer
-        "to_fixnum" >>unboxer
+        "to_signed_2" >>unboxer
         [ >fixnum ] >>unboxer-quot
     \ short define-primitive-type
 
@@ -271,7 +271,7 @@ M: pointer c-type
         2 >>align
         2 >>align-first
         "from_unsigned_2" >>boxer
-        "to_cell" >>unboxer
+        "to_unsigned_2" >>unboxer
         [ >fixnum ] >>unboxer-quot
     \ ushort define-primitive-type
 
@@ -284,7 +284,7 @@ M: pointer c-type
         1 >>align
         1 >>align-first
         "from_signed_1" >>boxer
-        "to_fixnum" >>unboxer
+        "to_signed_1" >>unboxer
         [ >fixnum ] >>unboxer-quot
     \ char define-primitive-type
 
@@ -297,7 +297,7 @@ M: pointer c-type
         1 >>align
         1 >>align-first
         "from_unsigned_1" >>boxer
-        "to_cell" >>unboxer
+        "to_unsigned_1" >>unboxer
         [ >fixnum ] >>unboxer-quot
     \ uchar define-primitive-type
 
@@ -338,7 +338,7 @@ M: pointer c-type
             4 >>align
             4 >>align-first
             "from_signed_4" >>boxer
-            "to_fixnum" >>unboxer
+            "to_signed_4" >>unboxer
             [ >fixnum ] >>unboxer-quot
         \ int define-primitive-type
     
@@ -351,7 +351,7 @@ M: pointer c-type
             4 >>align
             4 >>align-first
             "from_unsigned_4" >>boxer
-            "to_cell" >>unboxer
+            "to_unsigned_4" >>unboxer
             [ >fixnum ] >>unboxer-quot
         \ uint define-primitive-type
 

basis/calendar/calendar-tests.factor

@@ -185,3 +185,6 @@ IN: calendar.tests
     2008 1 29 <date> 1 months time+
     2008 2 29 <date> =
 ] unit-test
+
+[ 0 ]
+[ gmt gmt-offset>> duration>seconds ] unit-test

basis/calendar/calendar.factor

@@ -532,7 +532,7 @@ M: integer end-of-year 12 31 <date> ;
     dup midnight time- ;
 
 : since-1970 ( duration -- timestamp )
-    unix-1970 time+ >local-time ;
+    unix-1970 time+ ;
 
 : timestamp>unix-time ( timestamp -- seconds )
     unix-1970 time- second>> ;

basis/calendar/unix/unix.factor

@@ -11,14 +11,14 @@ IN: calendar.unix
 : timeval>unix-time ( timeval -- timestamp )
     timeval>duration since-1970 ;
 
-: timespec>seconds ( timespec -- seconds )
+: timespec>duration ( timespec -- seconds )
     [ sec>> seconds ] [ nsec>> nanoseconds ] bi time+ ;
 
 : timespec>nanoseconds ( timespec -- seconds )
     [ sec>> 1000000000 * ] [ nsec>> ] bi + ;
 
 : timespec>unix-time ( timespec -- timestamp )
-    timespec>seconds since-1970 ;
+    timespec>duration since-1970 ;
 
 : get-time ( -- alien )
     f time <time_t> localtime ;

basis/compiler/cfg/alias-analysis/alias-analysis.factor

@@ -299,6 +299,7 @@ M: ##compare analyze-aliases
     \ ##alien-global set-new-ac ;
 
 M: factor-call-insn analyze-aliases
+    call-next-method
     heap-ac get ac>vregs [
         [ live-slots get at clear-assoc ]
         [ recent-stores get at clear-assoc ] bi

basis/compiler/cfg/builder/alien/boxing/boxing.factor

@@ -6,6 +6,7 @@ sequences sequences.generalizations system
 compiler.cfg.builder.alien.params compiler.cfg.hats
 compiler.cfg.registers compiler.cfg.instructions
 compiler.cfg.intrinsics.allot cpu.architecture ;
+QUALIFIED-WITH: alien.c-types c
 IN: compiler.cfg.builder.alien.boxing
 
 SYMBOL: struct-return-area
@@ -49,9 +50,15 @@ M: c-type unbox
     [ rep>> ] [ unboxer>> ] bi
     [
         {
-            ! { "to_float" [ drop ] }
+            { "to_float" [ drop ] }
-            ! { "to_double" [ drop ] }
+            { "to_double" [ drop ] }
-            ! { "alien_offset" [ drop ^^unbox-any-c-ptr ] }
+            { "to_signed_1" [ drop ] }
+            { "to_unsigned_1" [ drop ] }
+            { "to_signed_2" [ drop ] }
+            { "to_unsigned_2" [ drop ] }
+            { "to_signed_4" [ drop ] }
+            { "to_unsigned_4" [ drop ] }
+            { "alien_offset" [ drop ^^unbox-any-c-ptr ] }
             [ swap ^^unbox ]
         } case 1array
     ]
@@ -107,9 +114,15 @@ GENERIC: box ( vregs reps c-type -- dst )
 M: c-type box
     [ [ first ] bi@ ] [ boxer>> ] bi*
     {
-        ! { "from_float" [ drop ] }
+        { "from_float" [ drop ] }
-        ! { "from_double" [ drop ] }
+        { "from_double" [ drop ] }
-        ! { "allot_alien" [ drop ^^box-alien ] }
+        { "from_signed_1" [ drop c:char ^^convert-integer ] }
+        { "from_unsigned_1" [ drop c:uchar ^^convert-integer ] }
+        { "from_signed_2" [ drop c:short ^^convert-integer ] }
+        { "from_unsigned_2" [ drop c:ushort ^^convert-integer ] }
+        { "from_signed_4" [ drop c:int ^^convert-integer ] }
+        { "from_unsigned_4" [ drop c:uint ^^convert-integer ] }
+        { "allot_alien" [ drop ^^box-alien ] }
         [ swap <gc-map> ^^box ]
     } case ;
 

basis/compiler/cfg/def-use/def-use.factor

@@ -80,12 +80,9 @@ M: ##callback-outputs uses-vregs
     tri
 ] with-compilation-unit
 
-! Computing def-use chains.
+SYMBOLS: defs insns ;
-
-SYMBOLS: defs insns uses ;
 
 : def-of ( vreg -- node ) defs get at ;
-: uses-of ( vreg -- nodes ) uses get at ;
 : insn-of ( vreg -- insn ) insns get at ;
 
 : set-def-of ( obj insn assoc -- )
@@ -98,8 +95,7 @@ SYMBOLS: defs insns uses ;
                 _ set-def-of
             ] with each
         ] each-basic-block
-    ] keep
+    ] keep defs set ;
-    defs set ;
 
 : compute-insns ( cfg -- )
     H{ } clone [

basis/compiler/cfg/instructions/instructions.factor

@@ -591,6 +591,12 @@ FOLDABLE-INSN: ##unbox-alien
 def: dst/int-rep
 use: src/tagged-rep ;
 
+! Zero-extending and sign-extending integers
+FOLDABLE-INSN: ##convert-integer
+def: dst/int-rep
+use: src/int-rep
+literal: c-type ;
+
 ! Raw memory accessors
 FLUSHABLE-INSN: ##load-memory
 def: dst

basis/compiler/cfg/linear-scan/allocation/allocation.factor

@@ -48,52 +48,33 @@ IN: compiler.cfg.linear-scan.allocation
     2dup spill-at-sync-point?
     [ swap n>> spill f ] [ 2drop t ] if ;
 
-: handle-interval ( live-interval -- )
+GENERIC: handle ( obj -- )
+
+M: live-interval handle
     [ start>> deactivate-intervals ]
     [ start>> activate-intervals ]
     [ assign-register ]
     tri ;
 
-: (handle-sync-point) ( sync-point -- )
+: handle-sync-point ( sync-point -- )
     active-intervals get values
     [ [ spill-at-sync-point ] with filter! drop ] with each ;
 
-: handle-sync-point ( sync-point -- )
+M: sync-point handle ( sync-point -- )
     [ n>> deactivate-intervals ]
-    [ (handle-sync-point) ]
+    [ handle-sync-point ]
     [ n>> activate-intervals ]
     tri ;
 
+: smallest-heap ( heap1 heap2 -- heap )
+    [ [ heap-peek nip ] bi@ <= ] most ;
+
 :: (allocate-registers-step) ( unhandled-intervals unhandled-sync-points -- )
     {
-        {
+        { [ unhandled-intervals heap-empty? ] [ unhandled-sync-points ] }
-            [ unhandled-intervals heap-empty? ]
+        { [ unhandled-sync-points heap-empty? ] [ unhandled-intervals ] }
-            [ unhandled-sync-points heap-pop drop handle-sync-point ]
+        [ unhandled-intervals unhandled-sync-points smallest-heap ]
-        }
+    } cond heap-pop drop handle ;
-        {
-            [ unhandled-sync-points heap-empty? ]
-            [ unhandled-intervals heap-pop drop handle-interval ]
-        }
-        [
-            unhandled-intervals heap-peek :> ( i ik )
-            unhandled-sync-points heap-peek :> ( s sk )
-            {
-                {
-                    [ ik sk < ]
-                    [ unhandled-intervals heap-pop* i handle-interval ]
-                }
-                {
-                    [ ik sk > ]
-                    [ unhandled-sync-points heap-pop* s handle-sync-point ]
-                }
-                [
-                    unhandled-intervals heap-pop*
-                    i handle-interval
-                    s (handle-sync-point)
-                ]
-            } cond
-        ]
-    } cond ;
 
 : (allocate-registers) ( unhandled-intervals unhandled-sync-points -- )
     2dup [ heap-empty? ] both? [ 2drop ] [

basis/compiler/cfg/linear-scan/allocation/spilling/spilling.factor

@@ -79,12 +79,13 @@ ERROR: bad-live-ranges interval ;
 : split-for-spill ( live-interval n -- before after )
     split-interval [ spill-before ] [ spill-after ] bi* ;
 
-: find-use-position ( live-interval new -- n )
+: find-next-use ( live-interval new -- n )
-    [ uses>> ] [ start>> '[ n>> _ >= ] ] bi* find nip
+    [ uses>> ] [ start>> ] bi*
+    '[ [ spill-slot?>> not ] [ n>> ] bi _ >= and ] find nip
     [ n>> ] [ 1/0. ] if* ;
 
 : find-use-positions ( live-intervals new assoc -- )
-    '[ [ _ find-use-position ] [ reg>> ] bi _ add-use-position ] each ;
+    '[ [ _ find-next-use ] [ reg>> ] bi _ add-use-position ] each ;
 
 : active-positions ( new assoc -- )
     [ [ active-intervals-for ] keep ] dip

basis/compiler/cfg/linear-scan/live-intervals/live-intervals.factor

@@ -16,7 +16,7 @@ TUPLE: live-range from to ;
 
 C: <live-range> live-range
 
-TUPLE: vreg-use n def-rep use-rep ;
+TUPLE: vreg-use n def-rep use-rep spill-slot? ;
 
 : <vreg-use> ( n -- vreg-use ) vreg-use new swap >>n ;
 
@@ -36,8 +36,10 @@ reg-class ;
 : last-use? ( insn# uses -- use/f )
     [ drop f ] [ last [ n>> = ] keep and ] if-empty ;
 
-: (add-use) ( insn# live-interval -- use )
+:: (add-use) ( insn# live-interval spill-slot? -- use )
-    uses>> 2dup last-use? dup [ 2nip ] [ drop new-use ] if ;
+    live-interval uses>> :> uses
+    insn# uses last-use? [ insn# uses new-use ] unless*
+    spill-slot? [ t >>spill-slot? ] when ;
 
 GENERIC: covers? ( insn# obj -- ? )
 
@@ -105,28 +107,42 @@ GENERIC: compute-live-intervals* ( insn -- )
 
 M: insn compute-live-intervals* drop ;
 
-:: record-def ( vreg n -- )
+:: record-def ( vreg n spill-slot? -- )
     vreg live-interval :> live-interval
 
     n live-interval shorten-range
-    n live-interval (add-use) vreg rep-of >>def-rep drop ;
+    n live-interval spill-slot? (add-use) vreg rep-of >>def-rep drop ;
 
-:: record-use ( vreg n -- )
+:: record-use ( vreg n spill-slot? -- )
     vreg live-interval :> live-interval
 
     from get n live-interval add-range
-    n live-interval (add-use) vreg rep-of >>use-rep drop ;
+    n live-interval spill-slot? (add-use) vreg rep-of >>use-rep drop ;
 
 :: record-temp ( vreg n -- )
     vreg live-interval :> live-interval
 
     n n live-interval add-range
-    n live-interval (add-use) vreg rep-of >>def-rep drop ;
+    n live-interval f (add-use) vreg rep-of >>def-rep drop ;
 
 M: vreg-insn compute-live-intervals* ( insn -- )
     dup insn#>>
-    [ [ defs-vregs ] dip '[ _ record-def ] each ]
+    [ [ defs-vregs ] dip '[ _ f record-def ] each ]
-    [ [ uses-vregs ] dip '[ _ record-use ] each ]
+    [ [ uses-vregs ] dip '[ _ f record-use ] each ]
+    [ [ temp-vregs ] dip '[ _ record-temp ] each ]
+    2tri ;
+
+M: clobber-insn compute-live-intervals* ( insn -- )
+    dup insn#>>
+    [ [ defs-vregs ] dip '[ _ f record-def ] each ]
+    [ [ uses-vregs ] dip '[ _ t record-use ] each ]
+    [ [ temp-vregs ] dip '[ _ record-temp ] each ]
+    2tri ;
+
+M: hairy-clobber-insn compute-live-intervals* ( insn -- )
+    dup insn#>>
+    [ [ defs-vregs ] dip '[ _ t record-def ] each ]
+    [ [ uses-vregs ] dip '[ _ t record-use ] each ]
     [ [ temp-vregs ] dip '[ _ record-temp ] each ]
     2tri ;
 

basis/compiler/cfg/liveness/liveness-tests.factor

@@ -1,13 +1,19 @@
-USING: compiler.cfg.liveness compiler.cfg.debugger
+USING: compiler.cfg.liveness compiler.cfg.liveness.ssa
-compiler.cfg.instructions compiler.cfg.predecessors
+compiler.cfg.debugger compiler.cfg.instructions
-compiler.cfg.registers compiler.cfg cpu.architecture
+compiler.cfg.predecessors compiler.cfg.registers compiler.cfg
-accessors namespaces sequences kernel tools.test vectors ;
+cpu.architecture accessors namespaces sequences kernel
+tools.test vectors alien math compiler.cfg.comparisons
+cpu.x86.assembler.operands ;
 IN: compiler.cfg.liveness.tests
 
 : test-liveness ( -- )
     cfg new 1 get >>entry
     compute-live-sets ;
 
+: test-ssa-liveness ( -- )
+    cfg new 1 get >>entry
+    compute-ssa-live-sets ;
+
 ! Sanity check...
 
 V{
@@ -30,7 +36,7 @@ V{
 
 1 { 2 3 } edges
 
-test-liveness
+[ ] [ test-liveness ] unit-test
 
 [
     H{
@@ -56,6 +62,95 @@ V{
 
 1 2 edge
 
-test-liveness
+[ ] [ test-liveness ] unit-test
 
 [ H{ { 0 0 } } ] [ 2 get live-in ] unit-test
+
+! Regression
+V{
+    T{ ##prologue }
+    T{ ##branch }
+} 0 test-bb
+
+V{
+    T{ ##inc-r f 2 }
+    T{ ##inc-d f -2 }
+    T{ ##peek f 21 D -1 }
+    T{ ##peek f 22 D -2 }
+    T{ ##replace f 21 R 0 }
+    T{ ##replace f 22 R 1 }
+    T{ ##branch }
+} 1 test-bb
+
+V{
+    T{ ##call f >c-ptr }
+    T{ ##branch }
+} 2 test-bb
+
+V{
+    T{ ##inc-r f -1 }
+    T{ ##inc-d f 1 }
+    T{ ##peek f 25 R -1 }
+    T{ ##replace f 25 D 0 }
+    T{ ##branch }
+} 3 test-bb
+
+V{
+    T{ ##call f >float }
+    T{ ##branch }
+} 4 test-bb
+
+V{
+    T{ ##inc-r f -1 }
+    T{ ##inc-d f 2 }
+    T{ ##peek f 27 R -1 }
+    T{ ##peek f 28 D 2 }
+    T{ ##peek f 29 D 3 }
+    T{ ##load-integer f 30 1 }
+    T{ ##load-integer f 31 0 }
+    T{ ##compare-imm-branch f 27 f cc/= }
+} 5 test-bb
+
+V{
+    T{ ##inc-d f -1 }
+    T{ ##branch }
+} 6 test-bb
+
+V{
+    T{ ##inc-d f -1 }
+    T{ ##branch }
+} 7 test-bb
+
+V{
+    T{ ##phi f 36 H{ { 6 30 } { 7 31 } } }
+    T{ ##inc-d f -2 }
+    T{ ##unbox f 37 29 "alien_offset" int-rep }
+    T{ ##unbox f 38 28 "to_double" double-rep }
+    T{ ##unbox f 39 36 "to_cell" int-rep }
+    T{ ##alien-invoke f V{ } V{ { 37 int-rep 0 } { 38 double-rep 4 } { 39 int-rep 12 } } { { 40 int-rep EAX } } 0 16 "CFRunLoopRunInMode" f T{ gc-map } }
+    T{ ##box f 41 40 "from_signed_cell" int-rep T{ gc-map } }
+    T{ ##replace f 41 D 0 }
+    T{ ##branch }
+} 8 test-bb
+
+V{
+    T{ ##epilogue }
+    T{ ##return }
+} 9 test-bb
+
+0 1 edge
+1 2 edge
+2 3 edge
+3 4 edge
+4 5 edge
+5 { 6 7 } edges
+6 8 edge
+7 8 edge
+8 9 edge
+
+[ ] [ test-ssa-liveness ] unit-test
+
+[ H{ { 28 28 } { 29 29 } { 30 30 } { 31 31 } } ] [ 5 get live-out ] unit-test
+[ H{ { 28 28 } { 29 29 } { 30 30 } } ] [ 6 get live-in ] unit-test
+[ H{ { 28 28 } { 29 29 } { 31 31 } } ] [ 7 get live-in ] unit-test
+[ H{ { 30 30 } } ] [ 6 get 8 get edge-live-in ] unit-test

basis/compiler/cfg/save-contexts/save-contexts-tests.factor

@@ -62,3 +62,20 @@ V{
 ] [
     0 get instructions>>
 ] unit-test
+
+V{
+    T{ ##phi }
+    T{ ##box }
+} 0 test-bb
+
+0 get insert-save-context
+
+[
+    V{
+        T{ ##phi }
+        T{ ##save-context f 7 8 }
+        T{ ##box }
+    }
+] [
+    0 get instructions>>
+] unit-test

basis/compiler/cfg/save-contexts/save-contexts.factor

@@ -18,6 +18,7 @@ M: insn needs-save-context? drop f ;
 
 GENERIC: modifies-context? ( insn -- ? )
 
+M: ##phi modifies-context? drop t ;
 M: ##inc-d modifies-context? drop t ;
 M: ##inc-r modifies-context? drop t ;
 M: ##callback-inputs modifies-context? drop t ;

basis/compiler/codegen/codegen.factor

@@ -236,6 +236,7 @@ CODEGEN: ##box-alien %box-alien
 CODEGEN: ##box-displaced-alien %box-displaced-alien
 CODEGEN: ##unbox-alien %unbox-alien
 CODEGEN: ##unbox-any-c-ptr %unbox-any-c-ptr
+CODEGEN: ##convert-integer %convert-integer
 CODEGEN: ##load-memory %load-memory
 CODEGEN: ##load-memory-imm %load-memory-imm
 CODEGEN: ##store-memory %store-memory

basis/compiler/tests/alien.factor

@@ -6,7 +6,7 @@ math memory namespaces namespaces.private parser
 quotations sequences specialized-arrays stack-checker
 stack-checker.errors system threads tools.test words
 alien.complex concurrency.promises alien.data
-byte-arrays classes ;
+byte-arrays classes compiler.test ;
 FROM: alien.c-types => float short ;
 SPECIALIZED-ARRAY: float
 SPECIALIZED-ARRAY: char
@@ -804,3 +804,20 @@ mingw? [
     ] with-out-parameters ;
 
 [ 12 ] [ 6 out-param-callback out-param-indirect ] unit-test
+
+! Alias analysis regression
+: aa-callback-1 ( -- c )
+    double { } cdecl [ 5.0 ] alien-callback ;
+
+: aa-indirect-1 ( c -- x )
+    double { } cdecl alien-indirect ; inline
+
+TUPLE: some-tuple x ;
+
+[ T{ some-tuple f 5.0 } ] [
+    [
+        some-tuple new
+        aa-callback-1
+        aa-indirect-1 >>x
+    ] compile-call
+] unit-test

basis/compiler/tests/low-level-ir.factor

@@ -105,3 +105,24 @@ IN: compiler.tests.low-level-ir
         T{ ##add-imm f 0 0 -16 }
     } compile-test-bb
 ] unit-test
+
+[ -1 ] [
+    V{
+        T{ ##load-tagged f 1 $[ -1 tag-fixnum ] }
+        T{ ##convert-integer f 0 1 char }
+    } compile-test-bb
+] unit-test
+
+[ -1 ] [
+    V{
+        T{ ##load-tagged f 1 $[ -1 9 2^ bitxor tag-fixnum ] }
+        T{ ##convert-integer f 0 1 char }
+    } compile-test-bb
+] unit-test
+
+[ $[ 255 tag-bits get neg shift ] ] [
+    V{
+        T{ ##load-tagged f 1 $[ -1 9 2^ bitxor tag-fixnum ] }
+        T{ ##convert-integer f 0 1 uchar }
+    } compile-test-bb
+] unit-test

basis/compiler/tests/simple.factor

@@ -1,7 +1,7 @@
 USING: compiler.test compiler.units tools.test kernel kernel.private
 sequences.private math.private math combinators strings alien
 arrays memory vocabs parser eval quotations compiler.errors
-definitions ;
+definitions generic.single ;
 IN: compiler.tests.simple
 
 ! Test empty word
@@ -249,3 +249,6 @@ M: quotation bad-effect-test call ; inline
 
 ! Don't want compiler error to stick around
 [ ] [ [ M\ quotation bad-effect-test forget ] with-compilation-unit ] unit-test
+
+! Make sure time bombs literalize
+[ [ \ + call ] compile-call ] [ no-method? ] must-fail-with

basis/compiler/tests/tuples.factor

@@ -8,3 +8,9 @@ TUPLE: color red green blue ;
 
 [ T{ color f f f f } ]
 [ [ color new ] compile-call ] unit-test
+
+SYMBOL: foo
+
+[ [ foo new ] compile-call ] must-fail
+
+[ [ foo boa ] compile-call ] must-fail

basis/compiler/tree/finalization/finalization.factor

@@ -1,8 +1,9 @@
-! Copyright (C) 2008, 2009 Slava Pestov.
+! Copyright (C) 2008, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel accessors sequences words memoize combinators
 classes classes.builtin classes.tuple classes.singleton
 math.partial-dispatch fry assocs combinators.short-circuit
+stack-checker.dependencies
 compiler.tree
 compiler.tree.combinators
 compiler.tree.propagation.info
@@ -26,6 +27,9 @@ GENERIC: finalize* ( node -- nodes )
 
 : splice-final ( quot -- nodes ) splice-quot finalize ;
 
+: splice-predicate ( word -- nodes )
+    [ depends-on-definition ] [ def>> splice-final ] bi ;
+
 M: #copy finalize* drop f ;
 
 M: #shuffle finalize*
@@ -44,8 +48,8 @@ GENERIC: finalize-word ( #call word -- nodes )
 M: predicate finalize-word
     "predicating" word-prop {
         { [ dup builtin-class? ] [ drop word>> cached-expansion ] }
-        { [ dup tuple-class? ] [ drop word>> def>> splice-final ] }
+        { [ dup tuple-class? ] [ drop word>> splice-predicate ] }
-        { [ dup singleton-class? ] [ drop word>> def>> splice-final ] }
+        { [ dup singleton-class? ] [ drop word>> splice-predicate ] }
         [ drop ]
     } cond ;
 

basis/cpu/architecture/architecture.factor

@@ -473,6 +473,8 @@ HOOK: %unbox-any-c-ptr cpu ( dst src -- )
 HOOK: %box-alien cpu ( dst src temp -- )
 HOOK: %box-displaced-alien cpu ( dst displacement base temp base-class -- )
 
+HOOK: %convert-integer cpu ( dst src c-type -- )
+
 HOOK: %load-memory cpu ( dst base displacement scale offset rep c-type -- )
 HOOK: %load-memory-imm cpu ( dst base offset rep c-type -- )
 HOOK: %store-memory cpu ( value base displacement scale offset rep c-type -- )

basis/cpu/x86/32/32.factor

@@ -209,6 +209,8 @@ M:: x86.32 %binary-float-function ( dst src1 src2 func -- )
     #! MINGW ABI incompatibility disaster
     [ large-struct? ] [ mingw eq? os windows? not or ] bi* and ;
 
+M: x86.32 %prepare-var-args ( -- ) ;
+
 M:: x86.32 stack-cleanup ( stack-size return abi -- n )
     #! a) Functions which are stdcall/fastcall/thiscall have to
     #! clean up the caller's stack frame.

basis/cpu/x86/64/64.factor

@@ -140,6 +140,8 @@ M:: x86.64 %binary-float-function ( dst src1 src2 func -- )
     func "libm" load-library f %c-invoke
     dst double-rep %load-return ;
 
+M: x86.64 %prepare-var-args ( -- ) RAX RAX XOR ;
+
 M: x86.64 stack-cleanup 3drop 0 ;
 
 M: x86.64 %cleanup 0 assert= ;

basis/cpu/x86/x86.factor

@@ -345,6 +345,29 @@ M: x86.64 has-small-reg? 2drop t ;
         [ quot call ] with-save/restore
     ] if ; inline
 
+:: (%convert-integer) ( dst src bits quot -- )
+    dst { src } bits [| new-dst |
+        new-dst src int-rep %copy
+        new-dst dup bits n-bit-version-of quot call
+        dst new-dst int-rep %copy
+    ] with-small-register ; inline
+
+: %zero-extend ( dst src bits -- )
+    [ MOVZX ] (%convert-integer) ; inline
+
+: %sign-extend ( dst src bits -- )
+    [ MOVSX ] (%convert-integer) ; inline
+
+M: x86 %convert-integer ( dst src c-type -- )
+    {
+        { c:char   [ 8 %sign-extend ] }
+        { c:uchar  [ 8 %zero-extend ] }
+        { c:short  [ 16 %sign-extend ] }
+        { c:ushort [ 16 %zero-extend ] }
+        { c:int    [ 32 %sign-extend ] }
+        { c:uint   [ 32 [ 2drop ] (%convert-integer) ] }
+    } case ;
+
 :: %alien-integer-getter ( dst exclude address bits quot -- )
     dst exclude bits [| new-dst |
         new-dst dup bits n-bit-version-of dup address MOV
@@ -621,6 +644,7 @@ HOOK: %cleanup cpu ( n -- )
 :: emit-alien-insn ( reg-inputs stack-inputs reg-outputs cleanup stack-size quot -- )
     stack-inputs [ first3 %store-stack-param ] each
     reg-inputs [ first3 %store-reg-param ] each
+    %prepare-var-args
     quot call
     cleanup %cleanup
     reg-outputs [ first3 %load-reg-param ] each ; inline

basis/io/files/unix/unix-tests.factor

@@ -94,7 +94,7 @@ prepare-test-file
     test-file now
     [ set-file-access-time ] 2keep
     [ file-info accessed>> ]
-    [ [ [ truncate >integer ] change-second ] bi@ ] bi* =
+    [ [ [ truncate >integer ] change-second >gmt ] bi@ ] bi* =
 ] unit-test
 
 [ t ]
@@ -102,7 +102,7 @@ prepare-test-file
     test-file now
     [ set-file-modified-time ] 2keep
     [ file-info modified>> ]
-    [ [ [ truncate >integer ] change-second ] bi@ ] bi* =
+    [ [ [ truncate >integer ] change-second >gmt ] bi@ ] bi* =
 ] unit-test
 
 [ t ]
@@ -110,7 +110,7 @@ prepare-test-file
     test-file now [ dup 2array set-file-times ] 2keep
     [ file-info [ modified>> ] [ accessed>> ] bi ] dip
     3array
-    [ [ truncate >integer ] change-second ] map all-equal?
+    [ [ truncate >integer ] change-second >gmt ] map all-equal?
 ] unit-test
 
 [ ] [ test-file f now 2array set-file-times ] unit-test

basis/math/matrices/matrices-tests.factor

@@ -103,7 +103,7 @@ USING: math.matrices math.vectors tools.test math ;
 [ { 1 0 0 } ] [ { 0 1 0 } { 0 0 1 } cross ] unit-test
 [ { 0 1 0 } ] [ { 0 0 1 } { 1 0 0 } cross ] unit-test
 [ { 0.0 -0.707 0.707 } ] [ { 1.0 0.0 0.0 } { 0.0 0.707 0.707 } cross ] unit-test
-
+[ { 0 -2 2 } ] [ { -1 -1 -1 } { 1 -1 -1 } cross ] unit-test
 [ { 1 0 0 } ] [ { 1 1 0 } { 1 0 0 } proj ] unit-test
 
 [ { { 4181 6765 } { 6765 10946 } } ]

basis/math/matrices/matrices.factor

@@ -114,6 +114,9 @@ IN: math.matrices
     [ [ { 1 2 0 } vshuffle ] [ { 2 0 1 } vshuffle ] bi* v* ]
     [ [ { 2 0 1 } vshuffle ] [ { 1 2 0 } vshuffle ] bi* v* ] 2bi v- ; inline
 
+:: normal ( vec1 vec2 vec3 -- vec4 )
+    vec2 vec1 v- vec3 vec1 v- cross normalize ; inline
+
 : proj ( v u -- w )
     [ [ v. ] [ norm-sq ] bi / ] keep n*v ;
 

basis/math/vectors/simd/simd-tests.factor

@@ -616,10 +616,14 @@ STRUCT: simd-struct
 
 ! Test cross product
 [ float-4{ 0.0 0.0 1.0 0.0 } ] [ float-4{ 1.0 0.0 0.0 0.0 } float-4{ 0.0 1.0 0.0 0.0 } cross ] unit-test
+[ float-4{ 0.0 0.0 1.0 0.0 } ] [ float-4{ 1.0 0.0 0.0 0.0 } float-4{ 0.0 1.0 0.0 0.0 } [ { float-4 float-4 } declare cross ] compile-call ] unit-test
 [ float-4{ 0.0 -1.0 0.0 0.0 } ] [ float-4{ 1.0 0.0 0.0 0.0 } float-4{ 0.0 0.0 1.0 0.0 } cross ] unit-test
+[ float-4{ 0.0 -1.0 0.0 0.0 } ] [ float-4{ 1.0 0.0 0.0 0.0 } float-4{ 0.0 0.0 1.0 0.0 } [ { float-4 float-4 } declare cross ] compile-call ] unit-test
 
 [ double-4{ 0.0 0.0 1.0 0.0 } ] [ double-4{ 1.0 0.0 0.0 0.0 } double-4{ 0.0 1.0 0.0 0.0 } cross ] unit-test
+[ double-4{ 0.0 0.0 1.0 0.0 } ] [ double-4{ 1.0 0.0 0.0 0.0 } double-4{ 0.0 1.0 0.0 0.0 } [ { double-4 double-4 } declare cross ] compile-call ] unit-test
 [ double-4{ 0.0 -1.0 0.0 0.0 } ] [ double-4{ 1.0 0.0 0.0 0.0 } double-4{ 0.0 0.0 1.0 0.0 } cross ] unit-test
+[ double-4{ 0.0 -1.0 0.0 0.0 } ] [ double-4{ 1.0 0.0 0.0 0.0 } double-4{ 0.0 0.0 1.0 0.0 } [ { double-4 double-4 } declare cross ] compile-call ] unit-test
 
 ! CSSA bug
 [ 4000000 ] [

basis/regexp/regexp-tests.factor

@@ -1,7 +1,5 @@
-! Copyright (C) 2008, 2009 Doug Coleman, Daniel Ehrenberg
+USING: arrays regexp tools.test kernel sequences regexp.parser
-! See http://factorcode.org/license.txt for BSD license.
+regexp.private eval strings multiline accessors ;
-USING: regexp tools.test kernel sequences regexp.parser regexp.private
-eval strings multiline accessors ;
 IN: regexp-tests
 
 [ f ] [ "b" "a*" <regexp> matches? ] unit-test
@@ -241,6 +239,9 @@ IN: regexp-tests
 [ t ] [ 3 "xabc" R/ abc/r match-index-from >boolean ] unit-test
 [ t ] [ 3 "xabc" R/ a[bB][cC]/r match-index-from >boolean ] unit-test
 
+[ 2 ] [ 0 "llamallol" R/ ll/ match-index-from ] unit-test
+[ 5 ] [ 8 "lolmallol" R/ lol/r match-index-from ] unit-test
+
 [ t ] [ "s@f" "[a-z.-]@[a-z]" <regexp> matches? ] unit-test
 [ f ] [ "a" "[a-z.-]@[a-z]" <regexp> matches? ] unit-test
 [ t ] [ ".o" "\\.[a-z]" <regexp> matches? ] unit-test
@@ -272,6 +273,10 @@ IN: regexp-tests
 
 [ "b" ] [ "aaaaaaaaaaaaaaaaaaaaaaab" "((a*)*b)*b" <regexp> first-match >string ] unit-test
 
+[ T{ slice { from 5 } { to 10 } { seq "hellohello" } } ]
+[ "hellohello" R/ hello/r first-match ]
+unit-test
+
 [ { "1" "2" "3" "4" } ]
 [ "1ABC2DEF3GHI4" R/ [A-Z]+/ re-split [ >string ] map ] unit-test
 
@@ -282,18 +287,52 @@ IN: regexp-tests
 
 [ { "a" "" } ] [ "a=" R/ =/ re-split [ >string ] map ] unit-test
 
+[ { "he" "o" } ] [ "hello" R/ l+/ re-split [ >string ] map ] unit-test
+
+[ { "h" "llo" } ] [ "hello" R/ e+/ re-split [ >string ] map ] unit-test
+
+[ { "" "h" "" "l" "l" "o" "" } ] [ "hello" R/ e*/ re-split [ >string ] map ] unit-test
+
+[ { { 0 5 "hellohello" } { 5 10 "hellohello" } } ]
+[ "hellohello" R/ hello/ [ 3array ] map-matches ]
+unit-test
+
+[ { { 5 10 "hellohello" } { 0 5 "hellohello" } } ]
+[ "hellohello" R/ hello/r [ 3array ] map-matches ]
+unit-test
+
 [ { "ABC" "DEF" "GHI" } ]
 [ "1ABC2DEF3GHI4" R/ [A-Z]+/ all-matching-subseqs ] unit-test
 
-[ 3 ]
+[ { "ee" "e" } ] [ "heellohello" R/ e+/ all-matching-subseqs ] unit-test
-[ "1ABC2DEF3GHI4" R/ [A-Z]+/ count-matches ] unit-test
+[ { "e" "ee" } ] [ "heellohello" R/ e+/r all-matching-subseqs ] unit-test
 
-[ 0 ]
+[ 3 ] [ "1ABC2DEF3GHI4" R/ [A-Z]+/ count-matches ] unit-test
-[ "123" R/ [A-Z]+/ count-matches ] unit-test
 
-[ "1.2.3.4." ]
+[ 3 ] [ "1ABC2DEF3GHI4" R/ [A-Z]+/r count-matches ] unit-test
-[ "1ABC2DEF3GHI4JK" R/ [A-Z]+/ "." re-replace ] unit-test
 
+[ 1 ] [ "" R/ / count-matches ] unit-test
+
+[ 1 ] [ "" R/ /r count-matches ] unit-test
+
+[ 0 ] [ "123" R/ [A-Z]+/ count-matches ] unit-test
+
+[ 0 ] [ "123" R/ [A-Z]+/r count-matches ] unit-test
+
+[ 6 ] [ "hello" R/ e*/ count-matches ] unit-test
+
+[ 6 ] [ "hello" R/ e*/r count-matches ] unit-test
+
+[ 11 ] [ "hello world" R/ l*/ count-matches ] unit-test
+
+[ 11 ] [ "hello world" R/ l*/r count-matches ] unit-test
+
+[ 1 ] [ "hello" R/ e+/ count-matches ] unit-test
+
+[ 2 ] [ "hello world" R/ l+/r count-matches ] unit-test
+
+[ "1.2.3.4." ] [ "1ABC2DEF3GHI4JK" R/ [A-Z]+/ "." re-replace ] unit-test
+[ "XhXXlXlXoX XwXoXrXlXdX" ] [ "hello world" R/ e*/ "X" re-replace ] unit-test
 [ "-- title --" ] [ "== title ==" R/ =/ "-" re-replace ] unit-test
 
 [ "" ] [ "ab" "a(?!b)" <regexp> first-match >string ] unit-test

basis/regexp/regexp.factor

@@ -50,33 +50,49 @@ PRIVATE>
 
 <PRIVATE
 
-:: (next-match) ( i string regexp quot: ( i string regexp -- j ) reverse? -- i start end ? )
-    i string regexp quot call dup [| j |
-        j i j
-        reverse? [ swap [ 1 + ] bi@ ] when
-        string
-    ] [ drop f f f f ] if ; inline
-
 : search-range ( i string reverse? -- seq )
-    [ drop dup 1 + -1 ] [ length 1 ] if range boa ; inline
+    [ drop -1 ] [ length ] if [a,b] ; inline
 
-:: next-match ( i string regexp quot: ( i string regexp -- j ) reverse? -- i start end ? )
+:: (next-match) ( i string regexp quot: ( i string regexp -- j ) reverse? -- start end ? )
-    f f f f
+    i string regexp quot call dup
+    [| j | reverse? [ j i ] [ i j ] if string ] [ drop f f f ] if ; inline
+
+:: next-match ( i string regexp quot: ( i string regexp -- j ) reverse? -- start end ? )
+    f f f
     i string reverse? search-range
-    [ [ 2drop 2drop ] dip string regexp quot reverse? (next-match) dup ] find 2drop ; inline
+    [ [ 3drop ] dip string regexp quot reverse? (next-match) dup ] find 2drop ; inline
 
-: do-next-match ( i string regexp -- i start end ? )
+: do-next-match ( i string regexp -- start end ? )
     dup next-match>>
-    execute( i string regexp -- i start end ? ) ; inline
+    execute( i string regexp -- start end ? ) ; inline
 
-:: (each-match) ( ... i string regexp quot: ( ... start end string -- ... ) -- ... )
+:: (each-match-forward) ( ... i string regexp quot: ( ... start end string -- ... ) -- ... )
-    i string regexp do-next-match [| i' start end |
+    i string length <= [
+        i string regexp do-next-match [| start end |
             start end string quot call
-        i' string regexp quot (each-match)
+            start end eq? [ end 1 +  ] [ end ] if
-    ] [ 3drop ] if ; inline recursive
+            string regexp quot (each-match-forward)
+        ] [ 2drop ] if
+    ] when ; inline recursive
+
+:: (each-match-backward) ( ... i string regexp quot: ( ... start end string -- ... ) -- ... )
+    i -1 >= [
+        i string regexp do-next-match [| start end |
+            start 1 + end 1 + string quot call
+            start end eq? [ start 1 - ] [ start ] if
+            string regexp quot (each-match-backward)
+        ] [ 2drop ] if
+    ] when ; inline recursive
+
+: (each-match) ( ... i string regexp quot: ( ... start end string -- ... ) -- ... )
+    over reverse-regexp? [ (each-match-backward) ] [ (each-match-forward) ] if ; inline
+
+GENERIC: match-iterator-start ( string regexp -- start )
+M: regexp match-iterator-start 2drop 0 ;
+M: reverse-regexp match-iterator-start drop length ;
 
 : prepare-match-iterator ( string regexp -- i string regexp )
-    [ check-string ] dip [ end/start nip ] 2keep ; inline
+    [ check-string ] dip [ match-iterator-start ] 2keep ; inline
 
 PRIVATE>
 
@@ -107,12 +123,14 @@ PRIVATE>
 
 PRIVATE>
 
-: first-match ( string regexp -- slice/f )
+:: first-match ( string regexp -- slice/f )
-    [ prepare-match-iterator do-next-match ] [ drop ] 2bi
+    string regexp prepare-match-iterator do-next-match [
-    '[ _ slice boa nip ] [ 3drop f ] if ;
+        regexp reverse-regexp? [ [ 1 + ] bi@ ] when
+        string slice boa
+    ] [ 2drop f ] if ;
 
 : re-contains? ( string regexp -- ? )
-    prepare-match-iterator do-next-match [ 3drop ] dip >boolean ;
+    prepare-match-iterator do-next-match [ 2drop ] dip >boolean ;
 
 : re-split ( string regexp -- seq )
     [ slice boa ] (re-split) ;
@@ -141,7 +159,7 @@ M: reverse-regexp compile-regexp ( regexp -- regexp )
 
 DEFER: compile-next-match
 
-: next-initial-word ( i string regexp -- i start end string )
+: next-initial-word ( i string regexp -- start end string )
     [ compile-next-match ] with-compilation-unit do-next-match ;
 
 : compile-next-match ( regexp -- regexp )
@@ -149,7 +167,7 @@ DEFER: compile-next-match
         dup \ next-initial-word = [
             drop _ [ compile-regexp dfa>> def>> ] [ reverse-regexp? ] bi
             '[ { array-capacity string regexp } declare _ _ next-match ]
-            (( i string regexp -- i start end string )) define-temp
+            (( i string regexp -- start end string )) define-temp
         ] when
     ] change-next-match ;
 

basis/stack-checker/backend/backend.factor

@@ -110,13 +110,11 @@ M: object apply-object push-literal ;
         infer-quot-here
     ] dip recursive-state set ;
 
-: time-bomb ( error -- )
+: time-bomb-quot ( obj generic -- quot )
-    '[ _ throw ] infer-quot-here ;
+    [ literalize ] [ "default-method" word-prop ] bi* [ ] 2sequence ;
 
-ERROR: bad-call obj ;
+: time-bomb ( obj generic -- )
-
+    time-bomb-quot infer-quot-here ;
-M: bad-call summary
-    drop "call must be given a callable" ;
 
 : infer-literal-quot ( literal -- )
     dup recursive-quotation? [
@@ -127,7 +125,7 @@ M: bad-call summary
             [ [ recursion>> ] keep add-local-quotation ]
             bi infer-quot
         ] [
-            value>> \ bad-call boa time-bomb
+            value>> \ call time-bomb
         ] if
     ] if ;
 

basis/stack-checker/known-words/known-words.factor

@@ -156,17 +156,12 @@ M: object infer-call* \ call bad-macro-input ;
 
 \ compose [ infer-compose ] "special" set-word-prop
 
-ERROR: bad-executable obj ;
-
-M: bad-executable summary
-    drop "execute must be given a word" ;
-
 : infer-execute ( -- )
     pop-literal nip
     dup word? [
         apply-object
     ] [
-        \ bad-executable boa time-bomb
+        \ execute time-bomb
     ] if ;
 
 \ execute [ infer-execute ] "special" set-word-prop

basis/stack-checker/transforms/transforms.factor

@@ -145,7 +145,9 @@ IN: stack-checker.transforms
         [ depends-on-tuple-layout ]
         [ [ "boa-check" word-prop [ ] or ] dip ] 2bi
         '[ @ _ <tuple-boa> ]
-    ] [ drop f ] if
+    ] [
+        \ boa time-bomb
+    ] if
 ] 1 define-transform
 
 \ boa t "no-compile" set-word-prop

basis/ui/gadgets/labels/labels.factor

@@ -106,12 +106,12 @@ M: f >label drop <gadget> ;
         { 5 5 } >>gap ; inline
 PRIVATE>
 
-: label-on-left ( gadget label -- button )
+: label-on-left ( gadget label -- track )
     label-on-left/right
         swap >label f track-add
         swap 1 track-add ;
 
-: label-on-right ( label gadget -- button )
+: label-on-right ( label gadget -- track )
     label-on-left/right
         swap f track-add
         swap >label 1 track-add ;

basis/ui/gadgets/worlds/worlds.factor

@@ -129,6 +129,7 @@ M: world request-focus-on ( child gadget -- )
     [ T{ rgba f 1.0 1.0 1.0 1.0 } ] if ;
 
 GENERIC# apply-world-attributes 1 ( world attributes -- world )
+
 M: world apply-world-attributes
     {
         [ title>> >>title ]
@@ -166,15 +167,11 @@ flush-layout-cache-hook [ [ ] ] initialize
 
 GENERIC: begin-world ( world -- )
 GENERIC: end-world ( world -- )
-
 GENERIC: resize-world ( world -- )
 
-M: world begin-world
+M: world begin-world drop ;
-    drop ;
+M: world end-world drop ;
-M: world end-world
+M: world resize-world drop ;
-    drop ;
-M: world resize-world
-    drop ;
 
 M: world dim<<
     [ call-next-method ]

basis/ui/ui.factor

@@ -81,6 +81,9 @@ M: world graft*
         [ [ clean-up-broken-window ] [ ui-error ] bi* ] recover
     ] bi ;
 
+: dispose-window-resources ( world -- )
+    [ <reversed> [ [ dispose ] when* ] each V{ } clone ] change-window-resources drop ;
+
 M: world ungraft*
     {
         [ set-gl-context ]
@@ -89,9 +92,9 @@ M: world ungraft*
         [ hand-clicked close-global ]
         [ hand-gadget close-global ]
         [ end-world ]
-        [ [ <reversed> [ [ dispose ] when* ] each V{ } clone ] change-window-resources drop ]
+        [ dispose-window-resources ]
-        [ [ (close-window) f ] change-handle drop ]
         [ unfocus-world ]
+        [ [ (close-window) f ] change-handle drop ]
         [ promise>> t swap fulfill ]
     } cleave ;
 

core/classes/tuple/tuple-tests.factor

@@ -273,8 +273,14 @@ test-server-slot-values
 ! Dynamically changing inheritance hierarchy
 TUPLE: electronic-device ;
 
+: computer?' ( a -- b ) computer? ;
+
+[ t ] [ laptop new computer?' ] unit-test
+
 [ ] [ "IN: classes.tuple.tests TUPLE: computer < electronic-device cpu ram ; C: <computer> computer C: <laptop> laptop C: <server> server" eval( -- ) ] unit-test
 
+[ t ] [ laptop new computer?' ] unit-test
+
 [ f ] [ electronic-device laptop class<= ] unit-test
 [ t ] [ server electronic-device class<= ] unit-test
 [ t ] [ laptop server class-or electronic-device class<= ] unit-test

extra/gdbm/gdbm-tests.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2010 Dmitry Shubin.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays continuations gdbm io.directories
-io.files.temp kernel sequences sets tools.test ;
+io.files.temp kernel sequences sets system tools.test ;
 IN: gdbm.tests
 
 : db-path ( -- filename ) "test.db" temp-file ;
@@ -12,7 +12,7 @@ IN: gdbm.tests
 
 : with-test.db ( quot -- ) test.db swap with-gdbm ; inline
 
-
+os windows? cpu x86.64? and [
     CLEANUP
 
 
@@ -61,3 +61,4 @@ CLEANUP
 
 
     CLEANUP
+] unless

extra/gpu/demos/bunny/bunny.factor

@@ -119,10 +119,6 @@ UNIFORM-TUPLE: loading-uniforms
     100000 <uint-vector>
     (parse-bunny-model) ; inline
 
-:: normal ( a b c -- normal )
-    c a v-
-    b a v- cross normalize ; inline
-
 :: calc-bunny-normal ( a b c vertexes -- )
     a b c [ vertexes nth vertex>> ] tri@ normal :> n
     a b c [ vertexes nth [ n v+ ] change-normal drop ] tri@ ; inline

vm/alien.cpp

@@ -27,11 +27,6 @@ char *factor_vm::pinned_alien_offset(cell obj)
 	}
 }
 
-VM_C_API char *pinned_alien_offset(cell obj, factor_vm *parent)
-{
-	return parent->pinned_alien_offset(obj);
-}
-
 /* make an alien */
 cell factor_vm::allot_alien(cell delegate_, cell displacement)
 {
@@ -62,11 +57,6 @@ cell factor_vm::allot_alien(void *address)
 	return allot_alien(false_object,(cell)address);
 }
 
-VM_C_API cell allot_alien(void *address, factor_vm *vm)
-{
-	return vm->allot_alien(address);
-}
-
 /* make an alien pointing at an offset of another alien */
 void factor_vm::primitive_displaced_alien()
 {
@@ -90,7 +80,7 @@ void factor_vm::primitive_displaced_alien()
 if the object is a byte array, as a sanity check. */
 void factor_vm::primitive_alien_address()
 {
-	ctx->push(allot_cell((cell)pinned_alien_offset(ctx->pop())));
+	ctx->push(from_unsigned_cell((cell)pinned_alien_offset(ctx->pop())));
 }
 
 /* pop ( alien n ) from datastack, return alien's address plus n */
@@ -182,9 +172,4 @@ char *factor_vm::alien_offset(cell obj)
 	}
 }
 
-VM_C_API char *alien_offset(cell obj, factor_vm *parent)
-{
-	return parent->alien_offset(obj);
-}
-
 }

vm/alien.hpp

@@ -1,8 +1,4 @@
 namespace factor
 {
 
-VM_C_API char *alien_offset(cell object, factor_vm *vm);
-VM_C_API char *pinned_alien_offset(cell object, factor_vm *vm);
-VM_C_API cell allot_alien(void *address, factor_vm *vm);
-
 }

vm/code_heap.cpp

@@ -222,9 +222,10 @@ struct code_block_accumulator {
 
 		/* Note: the entry point is always a multiple of the heap
 		alignment (16 bytes). We cannot allocate while iterating
-		through the code heap, so it is not possible to call allot_cell()
+		through the code heap, so it is not possible to call
-		here. It is OK, however, to add it as if it were a fixnum, and
+		from_unsigned_cell() here. It is OK, however, to add it as
-		have library code shift it to the left by 4. */
+		if it were a fixnum, and have library code shift it to the
+		left by 4. */
 		cell entry_point = (cell)compiled->entry_point();
 		assert((entry_point & (data_alignment - 1)) == 0);
 		assert((entry_point & TAG_MASK) == FIXNUM_TYPE);

vm/errors.cpp

@@ -102,12 +102,12 @@ void factor_vm::memory_protection_error(cell addr, stack_frame *stack)
 	else if(ctx->callstack_seg->overflow_p(addr))
 		general_error(ERROR_CALLSTACK_UNDERFLOW,false_object,false_object,stack);
 	else
-		general_error(ERROR_MEMORY,allot_cell(addr),false_object,stack);
+		general_error(ERROR_MEMORY,from_unsigned_cell(addr),false_object,stack);
 }
 
 void factor_vm::signal_error(cell signal, stack_frame *stack)
 {
-	general_error(ERROR_SIGNAL,allot_cell(signal),false_object,stack);
+	general_error(ERROR_SIGNAL,from_unsigned_cell(signal),false_object,stack);
 }
 
 void factor_vm::divide_by_zero_error()

vm/math.cpp

@@ -21,7 +21,7 @@ void factor_vm::primitive_fixnum_divint()
 	fixnum x = untag_fixnum(ctx->peek());
 	fixnum result = x / y;
 	if(result == -fixnum_min)
-		ctx->replace(allot_integer(-fixnum_min));
+		ctx->replace(from_signed_cell(-fixnum_min));
 	else
 		ctx->replace(tag_fixnum(result));
 }
@@ -32,7 +32,7 @@ void factor_vm::primitive_fixnum_divmod()
 	cell x = ((cell *)ctx->datastack)[-1];
 	if(y == tag_fixnum(-1) && x == tag_fixnum(fixnum_min))
 	{
-		((cell *)ctx->datastack)[-1] = allot_integer(-fixnum_min);
+		((cell *)ctx->datastack)[-1] = from_signed_cell(-fixnum_min);
 		((cell *)ctx->datastack)[0] = tag_fixnum(0);
 	}
 	else
@@ -335,7 +335,7 @@ void factor_vm::primitive_float_greatereq()
 
 void factor_vm::primitive_float_bits()
 {
-	ctx->push(from_unsigned_4(float_bits((float)untag_float_check(ctx->pop()))));
+	ctx->push(from_unsigned_cell(float_bits((float)untag_float_check(ctx->pop()))));
 }
 
 void factor_vm::primitive_bits_float()
@@ -383,76 +383,6 @@ VM_C_API cell to_cell(cell tagged, factor_vm *parent)
 	return parent->to_cell(tagged);
 }
 
-cell factor_vm::from_signed_1(s8 n)
-{
-	return tag_fixnum(n);
-}
-
-VM_C_API cell from_signed_1(s8 n, factor_vm *parent)
-{
-	return parent->from_signed_1(n);
-}
-
-cell factor_vm::from_unsigned_1(u8 n)
-{
-	return tag_fixnum(n);
-}
-
-VM_C_API cell from_unsigned_1(u8 n, factor_vm *parent)
-{
-	return parent->from_unsigned_1(n);
-}
-
-cell factor_vm::from_signed_2(s16 n)
-{
-	return tag_fixnum(n);
-}
-
-VM_C_API cell from_signed_2(s16 n, factor_vm *parent)
-{
-	return parent->from_signed_2(n);
-}
-
-cell factor_vm::from_unsigned_2(u16 n)
-{
-	return tag_fixnum(n);
-}
-
-VM_C_API cell from_unsigned_2(u16 n, factor_vm *parent)
-{
-	return parent->from_unsigned_2(n);
-}
-
-cell factor_vm::from_signed_4(s32 n)
-{
-	return allot_integer(n);
-}
-
-VM_C_API cell from_signed_4(s32 n, factor_vm *parent)
-{
-	return parent->from_signed_4(n);
-}
-
-cell factor_vm::from_unsigned_4(u32 n)
-{
-	return allot_cell(n);
-}
-
-VM_C_API cell from_unsigned_4(u32 n, factor_vm *parent)
-{
-	return parent->from_unsigned_4(n);
-}
-
-cell factor_vm::from_signed_cell(fixnum integer)
-{
-	return allot_integer(integer);
-}
-
-cell factor_vm::from_unsigned_cell(cell integer)
-{
-	return allot_cell(integer);
-}
-
 VM_C_API cell from_signed_cell(fixnum integer, factor_vm *parent)
 {
 	return parent->from_signed_cell(integer);
@@ -529,38 +459,18 @@ VM_C_API u64 to_unsigned_8(cell obj, factor_vm *parent)
 	return parent->to_unsigned_8(obj);
 }
  
-VM_C_API cell from_float(float flo, factor_vm *parent)
-{
-	return parent->allot_float(flo);
-}
-
 /* Cannot allocate */
 float factor_vm::to_float(cell value)
 {
 	return (float)untag_float_check(value);
 }
 
-VM_C_API float to_float(cell value, factor_vm *parent)
-{
-	return parent->to_float(value);
-}
-
-VM_C_API cell from_double(double flo, factor_vm *parent)
-{
-	return parent->allot_float(flo);
-}
-
 /* Cannot allocate */
 double factor_vm::to_double(cell value)
 {
 	return untag_float_check(value);
 }
 
-VM_C_API double to_double(cell value, factor_vm *parent)
-{
-	return parent->to_double(value);
-}
-
 /* The fixnum+, fixnum- and fixnum* primitives are defined in cpu_*.S. On
 overflow, they call these functions. */
 inline void factor_vm::overflow_fixnum_add(fixnum x, fixnum y)

vm/math.hpp

@@ -5,7 +5,7 @@ static const fixnum fixnum_max = (((fixnum)1 << (WORD_SIZE - TAG_BITS - 1)) - 1)
 static const fixnum fixnum_min = (-((fixnum)1 << (WORD_SIZE - TAG_BITS - 1)));
 static const fixnum array_size_max = ((cell)1 << (WORD_SIZE - TAG_BITS - 2));
 
-inline cell factor_vm::allot_integer(fixnum x)
+inline cell factor_vm::from_signed_cell(fixnum x)
 {
 	if(x < fixnum_min || x > fixnum_max)
 		return tag<bignum>(fixnum_to_bignum(x));
@@ -13,7 +13,7 @@ inline cell factor_vm::allot_integer(fixnum x)
 		return tag_fixnum(x);
 }
 
-inline cell factor_vm::allot_cell(cell x)
+inline cell factor_vm::from_unsigned_cell(cell x)
 {
 	if(x > (cell)fixnum_max)
 		return tag<bignum>(cell_to_bignum(x));
@@ -74,17 +74,6 @@ inline cell factor_vm::unbox_array_size()
 	return unbox_array_size_slow();
 }
 
-VM_C_API cell from_float(float flo, factor_vm *vm);
-VM_C_API float to_float(cell value, factor_vm *vm);
-VM_C_API cell from_double(double flo, factor_vm *vm);
-VM_C_API double to_double(cell value, factor_vm *vm);
-
-VM_C_API cell from_signed_1(s8 n, factor_vm *vm);
-VM_C_API cell from_unsigned_1(u8 n, factor_vm *vm);
-VM_C_API cell from_signed_2(s16 n, factor_vm *vm);
-VM_C_API cell from_unsigned_2(u16 n, factor_vm *vm);
-VM_C_API cell from_signed_4(s32 n, factor_vm *vm);
-VM_C_API cell from_unsigned_4(u32 n, factor_vm *vm);
 VM_C_API cell from_signed_cell(fixnum integer, factor_vm *vm);
 VM_C_API cell from_unsigned_cell(cell integer, factor_vm *vm);
 VM_C_API cell from_signed_8(s64 n, factor_vm *vm);

vm/objects.cpp

@@ -79,7 +79,7 @@ cell factor_vm::object_size(cell tagged)
 
 void factor_vm::primitive_size()
 {
-	ctx->push(allot_cell(object_size(ctx->pop())));
+	ctx->push(from_unsigned_cell(object_size(ctx->pop())));
 }
 
 struct slot_become_fixup : no_fixup {

vm/primitives.hpp

@@ -138,12 +138,12 @@ namespace factor
 	_(unsigned_cell,cell,from_unsigned_cell,to_cell) \
 	_(signed_8,s64,from_signed_8,to_signed_8) \
 	_(unsigned_8,u64,from_unsigned_8,to_unsigned_8) \
-	_(signed_4,s32,from_signed_4,to_fixnum) \
+	_(signed_4,s32,from_signed_cell,to_fixnum) \
-	_(unsigned_4,u32,from_unsigned_4,to_cell) \
+	_(unsigned_4,u32,from_unsigned_cell,to_cell) \
-	_(signed_2,s16,from_signed_2,to_fixnum) \
+	_(signed_2,s16,from_signed_cell,to_fixnum) \
-	_(unsigned_2,u16,from_unsigned_2,to_cell) \
+	_(unsigned_2,u16,from_unsigned_cell,to_cell) \
-	_(signed_1,s8,from_signed_1,to_fixnum) \
+	_(signed_1,s8,from_signed_cell,to_fixnum) \
-	_(unsigned_1,u8,from_unsigned_1,to_cell) \
+	_(unsigned_1,u8,from_unsigned_cell,to_cell) \
 	_(float,float,allot_float,to_float) \
 	_(double,double,allot_float,to_double) \
 	_(cell,void *,allot_alien,pinned_alien_offset)

vm/quotations.cpp

@@ -328,8 +328,8 @@ void factor_vm::primitive_quotation_code()
 {
 	quotation *quot = untag_check<quotation>(ctx->pop());
 
-	ctx->push(allot_cell((cell)quot->code->entry_point()));
+	ctx->push(from_unsigned_cell((cell)quot->code->entry_point()));
-	ctx->push(allot_cell((cell)quot->code + quot->code->size()));
+	ctx->push(from_unsigned_cell((cell)quot->code + quot->code->size()));
 }
 
 /* Allocates memory */

vm/vm.hpp

@@ -475,14 +475,6 @@ struct factor_vm
 	void primitive_bits_double();
 	fixnum to_fixnum(cell tagged);
 	cell to_cell(cell tagged);
-	cell from_signed_1(s8 n);
-	cell from_unsigned_1(u8 n);
-	cell from_signed_2(s16 n);
-	cell from_unsigned_2(u16 n);
-	cell from_signed_4(s32 n);
-	cell from_unsigned_4(u32 n);
-	cell from_signed_cell(fixnum integer);
-	cell from_unsigned_cell(cell integer);
 	cell from_signed_8(s64 n);
 	s64 to_signed_8(cell obj);
 	cell from_unsigned_8(u64 n);
@@ -492,8 +484,8 @@ struct factor_vm
 	inline void overflow_fixnum_add(fixnum x, fixnum y);
 	inline void overflow_fixnum_subtract(fixnum x, fixnum y);
 	inline void overflow_fixnum_multiply(fixnum x, fixnum y);
-	inline cell allot_integer(fixnum x);
+	inline cell from_signed_cell(fixnum x);
-	inline cell allot_cell(cell x);
+	inline cell from_unsigned_cell(cell x);
 	inline cell allot_float(double n);
 	inline bignum *float_to_bignum(cell tagged);
 	inline double bignum_to_float(cell tagged);

vm/words.cpp

@@ -91,13 +91,13 @@ void factor_vm::primitive_word_code()
 
 	if(profiling_p)
 	{
-		ctx->push(allot_cell((cell)w->profiling->entry_point()));
+		ctx->push(from_unsigned_cell((cell)w->profiling->entry_point()));
-		ctx->push(allot_cell((cell)w->profiling + w->profiling->size()));
+		ctx->push(from_unsigned_cell((cell)w->profiling + w->profiling->size()));
 	}
 	else
 	{
-		ctx->push(allot_cell((cell)w->code->entry_point()));
+		ctx->push(from_unsigned_cell((cell)w->code->entry_point()));
-		ctx->push(allot_cell((cell)w->code + w->code->size()));
+		ctx->push(from_unsigned_cell((cell)w->code + w->code->size()));
 	}
 }