Move more math stuff to extra/, get compiler to work without ratios/complex numbers

core/alien/compiler/compiler.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays generator generator.registers generator.fixup
 hashtables kernel math namespaces sequences words
-inference.backend inference.dataflow system math.functions
+inference.backend inference.dataflow system
 math.parser classes alien.arrays alien.c-types alien.structs
 alien.syntax cpu.architecture alien inspector quotations assocs
 kernel.private threads continuations.private libc combinators ;

core/alien/structs/structs.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays generic hashtables kernel kernel.private math
 namespaces parser sequences strings words libc slots
-alien.c-types math.functions math.vectors cpu.architecture ;
+alien.c-types cpu.architecture ;
 IN: alien.structs
 
 : align-offset ( offset type -- offset )

core/arrays/arrays-tests.factor

@@ -1,6 +1,5 @@
 USING: arrays kernel sequences sequences.private growable
-tools.test vectors layouts system math math.functions
+tools.test vectors layouts system math vectors.private ;
-vectors.private ;
 IN: temporary
 
 [ -2 { "a" "b" "c" } nth ] unit-test-fails

core/bootstrap/compiler/compiler.factor

@@ -5,23 +5,22 @@ hashtables.private sequences.private math tuples.private
 growable namespaces.private alien.remote-control assocs
 words generator command-line vocabs io prettyprint libc ;
 
-"bootstrap.math" vocab [
+"cpu." cpu append require
-    "cpu." cpu append require
 
-    global [ { "compiler" } add-use ] bind
+global [ { "compiler" } add-use ] bind
 
-    "-no-stack-traces" cli-args member? [
+"-no-stack-traces" cli-args member? [
     f compiled-stack-traces set-global
-    ] when
+] when
 
-    ! Compile a set of words ahead of our general
+! Compile a set of words ahead of our general
-    ! compile-all. This set of words was determined
+! compile-all. This set of words was determined
-    ! semi-empirically using the profiler. It improves
+! semi-empirically using the profiler. It improves
-    ! bootstrap time significantly, because frequenly
+! bootstrap time significantly, because frequenly
-    ! called words which are also quick to compile
+! called words which are also quick to compile
-    ! are replaced by compiled definitions as soon as
+! are replaced by compiled definitions as soon as
-    ! possible.
+! possible.
-    {
+{
     roll -roll declare not
 
     tuple-class-eq? array? hashtable? vector?
@@ -46,7 +45,6 @@ words generator command-line vocabs io prettyprint libc ;
     . lines
 
     malloc free memcpy
-    } [ compile ] each
+} [ compile ] each
 
-    [ recompile ] parse-hook set-global
+[ recompile ] parse-hook set-global
-] when

core/bootstrap/image/image.factor

@@ -4,7 +4,7 @@ USING: alien arrays bit-arrays byte-arrays generic assocs
 hashtables assocs hashtables.private io kernel kernel.private
 math namespaces parser prettyprint sequences sequences.private
 strings sbufs vectors words quotations assocs system layouts
-splitting growable math.functions classes tuples words.private
+splitting growable classes tuples words.private
 io.binary io.files vocabs vocabs.loader source-files
 definitions debugger float-arrays quotations.private
 combinators.private combinators ;

core/bootstrap/stage1.factor

@@ -23,6 +23,7 @@ vocabs.loader system ;
     \ boot ,
 
     "math.integers" require
+    "math.floats" require
     "memory" require
     "io.streams.c" require
     "vocabs.loader" require

core/bootstrap/stage2.factor

@@ -19,11 +19,14 @@ IN: bootstrap.stage2
 
     parse-command-line
 
-    "Cross-referencing..." print flush
     H{ } clone changed-words set-global
+
+    "-no-crossref" cli-args member? [
+        "Cross-referencing..." print flush
         H{ } clone crossref set-global
         xref-words
         xref-sources
+    ] unless
 
     ! Set dll paths
     wince? [ "windows.ce" require ] when
@@ -34,6 +37,7 @@ IN: bootstrap.stage2
     ] [
         "listener" require
         "none" require
+        "listener" use+
     ] if
 
     [

core/bootstrap/syntax.factor

@@ -20,7 +20,6 @@ f swap set-vocab-source-loaded?
     "B{"
     "C:"
     "CHAR:"
-    "C{"
     "DEFER:"
     "F{"
     "FORGET:"

core/compiler/test/intrinsics.factor

@@ -2,10 +2,9 @@ IN: temporary
 USING: arrays compiler kernel kernel.private math
 math.private sequences strings tools.test words continuations
 sequences.private hashtables.private byte-arrays
-strings.private system random math.vectors layouts
+strings.private system random layouts
 vectors.private sbufs.private strings.private slots.private
-alien alien.c-types alien.syntax namespaces libc math.constants
+alien alien.c-types alien.syntax namespaces libc ;
-math.functions ;
 
 ! Make sure that intrinsic ops compile to correct code.
 [ ] [ 1 [ drop ] compile-1 ] unit-test

core/cpu/arm/allot/allot.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2006, 2007 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel cpu.architecture cpu.arm.assembler
-cpu.arm.architecture namespaces math math.functions sequences
+cpu.arm.architecture namespaces math sequences
 generator generator.registers generator.fixup system layouts
 alien ;
 IN: cpu.arm.allot

core/cpu/arm/architecture/architecture.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2007 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien alien.c-types arrays cpu.arm.assembler compiler
-kernel kernel.private math math.functions namespaces words
+kernel kernel.private math namespaces words
 words.private generator.registers generator.fixup generator
 cpu.architecture system layouts ;
 IN: cpu.arm.architecture

core/cpu/arm/bootstrap.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2007 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: bootstrap.image.private kernel namespaces system
-cpu.arm.assembler math math.functions layouts words vocabs ;
+cpu.arm.assembler math layouts words vocabs ;
 IN: bootstrap.arm
 
 4 \ cell set

core/cpu/arm/intrinsics/intrinsics.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien arrays cpu.architecture cpu.arm.assembler
 cpu.arm.architecture cpu.arm.allot kernel kernel.private math
-math.functions math.private namespaces sequences words
+math.private namespaces sequences words
 quotations byte-arrays hashtables.private hashtables generator
 generator.registers generator.fixup sequences.private sbufs
 sbufs.private vectors vectors.private system tuples.private

core/cpu/ppc/allot/allot.factor

@@ -3,7 +3,7 @@
 USING: kernel cpu.ppc.architecture cpu.ppc.assembler
 kernel.private namespaces math sequences generic arrays
 generator generator.registers generator.fixup system layouts
-math.functions cpu.architecture alien ;
+cpu.architecture alien ;
 IN: cpu.ppc.allot
 
 : load-zone-ptr ( reg -- )

core/cpu/ppc/architecture/architecture.factor

@@ -3,7 +3,7 @@
 USING: alien.c-types cpu.ppc.assembler cpu.architecture generic
 kernel kernel.private math memory namespaces sequences words
 assocs generator generator.registers generator.fixup system
-layouts math.functions classes words.private alien combinators ;
+layouts classes words.private alien combinators ;
 IN: cpu.ppc.architecture
 
 TUPLE: ppc-backend ;

core/cpu/ppc/assembler/assembler.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 IN: cpu.ppc.assembler
 USING: generator.fixup generic kernel math memory namespaces
-words math.bitfields math.functions io.binary ;
+words math.bitfields io.binary ;
 
 ! See the Motorola or IBM documentation for details. The opcode
 ! names are standard, and the operand order is the same as in

core/cpu/ppc/bootstrap.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2007 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: bootstrap.image.private kernel namespaces system
-cpu.ppc.assembler math math.functions layouts words vocabs ;
+cpu.ppc.assembler math layouts words vocabs ;
 IN: bootstrap.ppc
 
 4 \ cell set

core/cpu/ppc/intrinsics/intrinsics.factor

@@ -5,7 +5,7 @@ cpu.ppc.architecture cpu.ppc.allot cpu.architecture kernel
 kernel.private math math.private namespaces sequences words
 generic quotations byte-arrays hashtables hashtables.private
 generator generator.registers generator.fixup sequences.private
-sbufs vectors system layouts math.functions math.floats.private
+sbufs vectors system layouts math.floats.private
 classes tuples tuples.private sbufs.private vectors.private
 strings.private slots.private combinators bit-arrays
 float-arrays ;
@@ -374,14 +374,6 @@ IN: cpu.ppc.intrinsics
     { +output+ { "out" } }
 } define-intrinsic
 
-! \ fsqrt [
-!     "y" operand "x" operand FSQRT
-! ] H{
-!     { +input+ { { float "x" } } }
-!     { +scratch+ { { float "y" } } }
-!     { +output+ { "y" } }
-! } define-intrinsic
-
 \ tag [
     "out" operand "in" operand tag-mask get ANDI
     "out" operand dup %tag-fixnum

core/cpu/x86/32/32.factor

@@ -4,7 +4,7 @@ USING: alien.c-types arrays cpu.x86.assembler
 cpu.x86.architecture cpu.x86.intrinsics cpu.x86.allot
 cpu.architecture kernel kernel.private math namespaces sequences
 generator.registers generator.fixup generator system
-math.functions alien.compiler combinators command-line
+alien.compiler combinators command-line
 compiler io vocabs.loader ;
 IN: cpu.x86.32
 

core/cpu/x86/64/64.factor

@@ -4,7 +4,7 @@ USING: alien.c-types arrays cpu.x86.assembler
 cpu.x86.architecture cpu.x86.intrinsics cpu.x86.sse2
 cpu.x86.allot cpu.architecture kernel kernel.private math
 namespaces sequences generator.registers generator.fixup system
-alien alien.compiler alien.structs slots splitting math.functions ;
+alien alien.compiler alien.structs slots splitting ;
 IN: cpu.x86.64
 
 PREDICATE: x86-backend amd64-backend

core/cpu/x86/allot/allot.factor

@@ -2,8 +2,8 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel cpu.architecture cpu.x86.assembler
 cpu.x86.architecture kernel.private namespaces math
-math.functions sequences generic arrays generator
+sequences generic arrays generator generator.fixup
-generator.fixup generator.registers system layouts alien ;
+generator.registers system layouts alien ;
 IN: cpu.x86.allot
 
 : allot-reg

core/cpu/x86/architecture/architecture.factor

@@ -2,8 +2,8 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien alien.c-types alien.compiler arrays
 cpu.x86.assembler cpu.architecture kernel kernel.private math
-math.functions memory namespaces sequences words generator
+memory namespaces sequences words generator generator.registers
-generator.registers generator.fixup system layouts combinators ;
+generator.fixup system layouts combinators ;
 IN: cpu.x86.architecture
 
 TUPLE: x86-backend cell ;

core/cpu/x86/intrinsics/intrinsics.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien arrays cpu.x86.assembler cpu.x86.allot
 cpu.x86.architecture cpu.architecture kernel kernel.private math
-math.functions math.private namespaces quotations sequences
+math.private namespaces quotations sequences
 words generic byte-arrays hashtables hashtables.private
 generator generator.registers generator.fixup sequences.private
 sbufs sbufs.private vectors vectors.private layouts system

core/inference/backend/backend.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 IN: inference.backend
 USING: inference.dataflow arrays generic io io.streams.string
-kernel math math.vectors namespaces parser prettyprint sequences
+kernel math namespaces parser prettyprint sequences
 strings vectors words quotations effects classes continuations
 debugger assocs combinators ;
 

core/inference/class/class.factor

@@ -2,8 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays generic assocs hashtables inference kernel
 math namespaces sequences words parser math.intervals
-math.vectors effects classes inference.dataflow
+effects classes inference.dataflow inference.backend ;
-inference.backend ;
 IN: inference.class
 
 ! Class inference

core/io/utf16/utf16.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2006, 2007 Daniel Ehrenberg.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: math kernel sequences sbufs vectors namespaces io.binary
-io.encodings combinators splitting math.functions ;
+io.encodings combinators splitting ;
 IN: io.utf16
 
 SYMBOL: double

core/math/floats/floats-tests.factor

@@ -25,9 +25,6 @@ IN: temporary
 
 [ 2.1 ] [ -2.1 neg ] unit-test
 
-[ 1 ] [ 0.5 1/2 + ] unit-test
-[ 1 ] [ 1/2 0.5 + ] unit-test
-
 [ 3 ] [ 3.1415 >fixnum ] unit-test
 [ 3 ] [ 3.1415 >bignum ] unit-test
 
@@ -48,23 +45,6 @@ unit-test
 [ 2.0 ] [ 1.0 1+ ] unit-test
 [ 0.0 ] [ 1.0 1- ] unit-test
 
-[ 4.0 ] [ 4.5 truncate ] unit-test
-[ 4.0 ] [ 4.5 floor ] unit-test
-[ 5.0 ] [ 4.5 ceiling ] unit-test
-
-[ -4.0 ] [ -4.5 truncate ] unit-test
-[ -5.0 ] [ -4.5 floor ] unit-test
-[ -4.0 ] [ -4.5 ceiling ] unit-test
-
-[ -4.0 ] [ -4.0 truncate ] unit-test
-[ -4.0 ] [ -4.0 floor ] unit-test
-[ -4.0 ] [ -4.0 ceiling ] unit-test
-
-[ -5.0 ] [ -4.5 round ] unit-test
-[ -4.0 ] [ -4.4 round ] unit-test
-[ 5.0 ] [ 4.5 round ] unit-test
-[ 4.0 ] [ 4.4 round ] unit-test
-
 ! [ t ] [ -0.0 -0.0 = ] unit-test
 ! [ f ] [ 0.0 -0.0 = ] unit-test
 

core/math/floats/floats.factor

@@ -1,17 +1,11 @@
 ! Copyright (C) 2004, 2006 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel math math.functions math.private math.libm ;
+USING: kernel math math.private ;
 IN: math.floats.private
 
 M: fixnum >float fixnum>float ;
 M: bignum >float bignum>float ;
 
-M: real abs dup 0 < [ neg ] when ;
-M: real absq sq ;
-
-M: real hashcode* nip >fixnum ;
-M: real <=> - ;
-
 M: float zero? dup 0.0 float= swap -0.0 float= or ;
 
 M: float >fixnum float>fixnum ;
@@ -29,6 +23,3 @@ M: float - float- ;
 M: float * float* ;
 M: float / float/f ;
 M: float mod float-mod ;
-
-M: real sqrt
-    >float dup 0.0 < [ neg fsqrt 0.0 swap rect> ] [ fsqrt ] if ;

core/math/integers/integers-docs.factor

@@ -1,5 +1,4 @@
-USING: help.markup help.syntax math math.private math.functions
+USING: help.markup help.syntax math math.private ;
-math.ratios.private ;
 IN: math.integers
 
 ARTICLE: "integers" "Integers"

core/math/integers/integers-tests.factor

@@ -1,4 +1,4 @@
-USING: kernel math namespaces prettyprint math.functions
+USING: kernel math namespaces prettyprint
 math.private continuations tools.test sequences ;
 IN: temporary
 
@@ -57,15 +57,6 @@ IN: temporary
 [ 134217728 dup + dup + dup + dup + dup + dup + unparse ]
 unit-test
 
-[ t ] [ 0 0 ^ fp-nan? ] unit-test
-[ 1 ] [ 10 0 ^ ] unit-test
-[ 1/8 ] [ 1/2 3 ^ ] unit-test
-[ 1/8 ] [ 2 -3 ^ ] unit-test
-[ t ] [ 1 100 shift 2 100 ^ = ] unit-test
-
-[ t ] [ 256 power-of-2? ] unit-test
-[ f ] [ 123 power-of-2? ] unit-test
-
 [ 7 ] [ 255 log2 ] unit-test
 [ 8 ] [ 256 log2 ] unit-test
 [ 8 ] [ 257 log2 ] unit-test
@@ -100,11 +91,6 @@ unit-test
 [ f ] [ BIN: -1101 >bignum 3 bit? ] unit-test
 [ t ] [ BIN: -1101 >bignum 4 bit? ] unit-test
 
-[ 1 ] [ 7/8 ceiling ] unit-test
-[ 2 ] [ 3/2 ceiling ] unit-test
-[ 0 ] [ -7/8 ceiling ] unit-test
-[ -1 ] [ -3/2 ceiling ] unit-test
-
 [ 2 ] [ 0 next-power-of-2 ] unit-test
 [ 2 ] [ 1 next-power-of-2 ] unit-test
 [ 2 ] [ 2 next-power-of-2 ] unit-test
@@ -115,7 +101,6 @@ unit-test
 [ 268435456 ] [ -268435456 >fixnum -1 / ] unit-test
 [ 268435456 ] [ -268435456 >fixnum -1 /i ] unit-test
 [ 268435456 0 ] [ -268435456 >fixnum -1 /mod ] unit-test
-[ 1/268435456 ] [ -1 -268435456 >fixnum / ] unit-test
 [ 0 ] [ -1 -268435456 >fixnum /i ] unit-test
 [ 0 -1 ] [ -1 -268435456 >fixnum /mod ] unit-test
 [ 14355 ] [ 1591517158873146351817850880000000 32769 mod ] unit-test

core/math/integers/integers.factor

@@ -4,9 +4,6 @@ USING: kernel kernel.private sequences
 sequences.private math math.private combinators ;
 IN: math.integers.private
 
-M: integer hashcode* nip >fixnum ;
-M: integer <=> - ;
-
 M: integer numerator ;
 M: integer denominator drop 1 ;
 

core/math/intervals/intervals-tests.factor

@@ -39,11 +39,11 @@ IN: temporary
 ] unit-test
 
 [ t ] [
-    1 2 [a,b] -1/2 1/2 [a,b] interval* -1 1 [a,b] =
+    1 2 [a,b] -0.5 0.5 [a,b] interval* -1 1 [a,b] =
 ] unit-test
 
 [ t ] [
-    1 2 [a,b] -1/2 1/2 (a,b] interval* -1 1 (a,b] =
+    1 2 [a,b] -0.5 0.5 (a,b] interval* -1 1 (a,b] =
 ] unit-test
 
 [ t ] [
@@ -77,7 +77,7 @@ IN: temporary
 ] unit-test
 
 [ t ] [
-    1/2 0 1 (a,b) interval-contains?
+    0.5 0 1 (a,b) interval-contains?
 ] unit-test
 
 [ f ] [
@@ -89,7 +89,7 @@ IN: temporary
 [ f ] [ -1 1 (a,b) 0 1 (a,b) interval/ ] unit-test
 
 [ t ] [
-    -1 1 (a,b) 1/2 1 (a,b) interval/ -2 2 (a,b) =
+    -1 1 (a,b) 0.5 1 (a,b) interval/ -2 2 (a,b) =
 ] unit-test
 
 [ t ] [ 0 5 [a,b] 5 interval<= ] unit-test
@@ -125,12 +125,15 @@ IN: temporary
         { + interval+ }
         { - interval- }
         { * interval* }
-        { / interval/ }
         { /i interval/i }
         { shift interval-shift }
         { min interval-min }
         { max interval-max }
-    } random ;
+    }
+    "math.ratios.private" vocab [
+        { / interval/ } add
+    ] when
+    random ;
 
 : interval-test
     random-interval random-interval random-op

core/math/math-docs.factor

@@ -243,26 +243,6 @@ HELP: 1-
     { $code "1-" "1 -" }
 } ;
 
-HELP: truncate
-{ $values { "x" real } { "y" "a whole real number" } }
-{ $description "Outputs the number that results from subtracting the fractional component of " { $snippet "x" } "." }
-{ $notes "The result is not necessarily an integer." } ;
-
-HELP: floor
-{ $values { "x" real } { "y" "a whole real number" } }
-{ $description "Outputs the greatest whole number smaller than or equal to " { $snippet "x" } "." }
-{ $notes "The result is not necessarily an integer." } ;
-
-HELP: ceiling
-{ $values { "x" real } { "y" "a whole real number" } }
-{ $description "Outputs the least whole number greater than or equal to " { $snippet "x" } "." }
-{ $notes "The result is not necessarily an integer." } ;
-
-HELP: round
-{ $values { "x" real } { "y" "a whole real number" } }
-{ $description "Outputs the whole number closest to " { $snippet "x" } "." }
-{ $notes "The result is not necessarily an integer." } ;
-
 HELP: sq
 { $values { "x" number } { "y" number } }
 { $description "Multiplies a number by itself." } ;
@@ -351,22 +331,9 @@ HELP: imaginary ( z -- y )
 { $values { "z" number } { "y" real } }
 { $description "Outputs the imaginary part of a complex number. This outputs zero for real numbers." } ;
 
-HELP: (rect>)
-{ $values { "x" real } { "y" real } { "z" number } }
-{ $description "Creates a complex number from real and imaginary components." }
-{ $warning "This word does not check that the arguments are real numbers, which can have undefined consequences. Use the " { $link rect> } " word instead." } ;
-
 HELP: number
 { $class-description "The class of numbers." } ;
 
-HELP: rect>
-{ $values { "x" real } { "y" real } { "z" number } }
-{ $description "Creates a complex number from real and imaginary components." } ;
-
-HELP: >rect
-{ $values { "z" number } { "x" real } { "y" real } }
-{ $description "Extracts the real and imaginary components of a complex number." } ;
-
 HELP: next-power-of-2
 { $values { "m" "a non-negative integer" } { "n" "an integer" } }
 { $description "Outputs the smallest power of 2 greater than " { $snippet "m" } ". The output value is always at least 1." } ;

core/math/math.factor

@@ -8,6 +8,7 @@ GENERIC: >bignum ( x -- y ) foldable
 GENERIC: >float ( x -- y ) foldable
 
 MATH: number= ( x y -- ? ) foldable
+
 M: object number= 2drop f ;
 
 MATH: <  ( x y -- ? ) foldable
@@ -48,8 +49,6 @@ GENERIC: zero? ( x -- ? ) foldable
 
 M: object zero? drop f ;
 
-GENERIC: sqrt ( x -- y ) foldable
-
 : 1+ ( x -- y ) 1 + ; foldable
 : 1- ( x -- y ) 1 - ; foldable
 : 2/ ( x -- y ) -1 shift ; foldable
@@ -66,15 +65,8 @@ GENERIC: sqrt ( x -- y ) foldable
     pick >= [ >= ] [ 2drop f ] if ; inline
 
 : rem ( x y -- z ) tuck mod over + swap mod ; foldable
+
 : sgn ( x -- n ) dup 0 < -1 0 ? swap 0 > 1 0 ? bitor ; foldable
-: truncate ( x -- y ) dup 1 mod - ; inline
-: round ( x -- y ) dup sgn 2 / + truncate ; inline
-
-: floor ( x -- y )
-    dup 1 mod dup zero?
-    [ drop ] [ dup 0 < [ - 1- ] [ - ] if ] if ; foldable
-
-: ceiling ( x -- y ) neg floor neg ; foldable
 
 : [-] ( x y -- z ) - 0 max ; inline
 
@@ -84,9 +76,6 @@ GENERIC: sqrt ( x -- y ) foldable
 
 : odd? ( n -- ? ) 1 bitand 1 number= ;
 
-: >fraction ( a/b -- a b )
-    dup numerator swap denominator ; inline
-
 UNION: integer fixnum bignum ;
 
 UNION: rational integer ratio ;
@@ -95,6 +84,12 @@ UNION: real rational float ;
 
 UNION: number real complex ;
 
+M: number equal? number= ;
+
+M: real hashcode* nip >fixnum ;
+
+M: real <=> - ;
+
 GENERIC: fp-nan? ( x -- ? )
 
 M: object fp-nan?
@@ -104,25 +99,6 @@ M: float fp-nan?
     double>bits -51 shift BIN: 111111111111 [ bitand ] keep
     number= ;
 
-<PRIVATE
-
-: (rect>) ( x y -- z )
-    dup zero? [ drop ] [ <complex> ] if ; inline
-
-PRIVATE>
-
-: rect> ( x y -- z )
-    over real? over real? and [
-        (rect>)
-    ] [
-        "Complex number must have real components" throw
-    ] if ; inline
-
-: >rect ( z -- x y ) dup real swap imaginary ; inline
-
-: >float-rect ( z -- x y )
-    >rect swap >float swap >float ; inline
-
 : (next-power-of-2) ( i n -- n )
     2dup >= [
         drop
@@ -132,6 +108,8 @@ PRIVATE>
 
 : next-power-of-2 ( m -- n ) 2 swap (next-power-of-2) ; foldable
 
+: align ( m w -- n ) 1- [ + ] keep bitnot bitand ; inline
+
 <PRIVATE
 
 : iterate-prep 0 -rot ; inline

core/math/parser/parser-tests.factor

@@ -77,22 +77,6 @@ unit-test
 [ "-101.0e-2" string>number number>string ]
 unit-test
 
-[ 5 ]
-[ "10/2" string>number ]
-unit-test
-
-[ -5 ]
-[ "-10/2" string>number ]
-unit-test
-
-[ -5 ]
-[ "10/-2" string>number ]
-unit-test
-
-[ 5 ]
-[ "-10/-2" string>number ]
-unit-test
-
 [ 5.0 ]
 [ "10.0/2" string>number ]
 unit-test
@@ -105,10 +89,6 @@ unit-test
 [ "e/2" string>number ]
 unit-test
 
-[ "33/100" ]
-[ "66/200" string>number number>string ]
-unit-test
-
 [ f ] [ "12" bin> ] unit-test
 [ f ] [ "fdsf" bin> ] unit-test
 [ 3 ] [ "11" bin> ] unit-test

core/optimizer/known-words/known-words.factor

@@ -6,7 +6,7 @@ inference.class kernel assocs math math.private kernel.private
 sequences words parser vectors strings sbufs io namespaces
 assocs quotations sequences.private io.binary io.crc32
 io.buffers io.streams.string layouts splitting math.intervals
-math.floats.private math.vectors tuples tuples.private classes
+math.floats.private tuples tuples.private classes
 optimizer.def-use optimizer.backend optimizer.pattern-match
 float-arrays combinators.private ;
 
@@ -102,20 +102,6 @@ float-arrays combinators.private ;
     { number number } "specializer" set-word-prop
 ] each
 
-{ vneg norm-sq norm normalize } [
-    { { float-array array } } "specializer" set-word-prop
-] each
-
-\ n*v { * { float-array array } } "specializer" set-word-prop
-\ v*n { { float-array array } * } "specializer" set-word-prop
-\ n/v { * { float-array array } } "specializer" set-word-prop
-\ v/n { { float-array array } * } "specializer" set-word-prop
-
-{ v+ v- v* v/ vmax vmin v. } [
-    { { float-array array } { float-array array } }
-    "specializer" set-word-prop
-] each
-
 { first first2 first3 first4 }
 [ { array } "specializer" set-word-prop ] each
 

core/optimizer/math/math.factor

@@ -5,7 +5,7 @@ USING: alien arrays generic hashtables kernel assocs math
 math.private kernel.private sequences words parser
 inference.class inference.dataflow vectors strings sbufs io
 namespaces assocs quotations math.intervals sequences.private
-math.libm combinators splitting layouts math.parser classes
+combinators splitting layouts math.parser classes
 generic.math optimizer.pattern-match optimizer.backend
 optimizer.def-use generic.standard ;
 
@@ -439,17 +439,3 @@ most-negative-fixnum most-positive-fixnum [a,b]
         [ splice-quot ] curry ,
     ] { } make 1array define-optimizers
 ] assoc-each
-
-! This will go away when we have cross-word type inference
-{
-    facos fasin fatan
-    fcos fexp fcosh flog fpow
-    fsin fsinh fsqrt
-} [
-    [ drop { float } f ]
-    "output-classes" set-word-prop
-] each
-
-\ fatan2
-[ drop { float float } f ]
-"output-classes" set-word-prop

core/prettyprint/backend/backend.factor

@@ -155,7 +155,6 @@ GENERIC: >pprint-sequence ( obj -- seq )
 
 M: object >pprint-sequence ;
 
-M: complex >pprint-sequence >rect 2array ;
 M: hashtable >pprint-sequence >alist ;
 M: tuple >pprint-sequence tuple>array ;
 M: wrapper >pprint-sequence wrapped 1array ;

core/prettyprint/prettyprint-tests.factor

@@ -7,7 +7,6 @@ IN: temporary
 
 [ "4" ] [ 4 unparse ] unit-test
 [ "1.0" ] [ 1.0 unparse ] unit-test
-[ "C{ 1/2 2/3 }" ] [ C{ 1/2 2/3 } unparse ] unit-test
 [ "1267650600228229401496703205376" ] [ 1 100 shift unparse ] unit-test
 
 [ "+" ] [ \ + unparse ] unit-test

core/sequences/sequences-docs.factor

@@ -943,3 +943,21 @@ HELP: unclip
 HELP: unclip-slice
 { $values { "seq" sequence } { "rest" slice } { "first" object } }
 { $description "Outputs a tail sequence and the first element of " { $snippet "seq" } "; the tail sequence consists of all elements of " { $snippet "seq" } " but the first. Unlike " { $link unclip } ", this word does not make a copy of the input sequence, and runs in constant time." } ;
+
+HELP: sum
+{ $values { "seq" "a sequence of numbers" } { "n" "a number" } }
+{ $description "Outputs the sum of all elements of " { $snippet "seq" } ". Outputs zero given an empty sequence." } ;
+
+HELP: product
+{ $values { "seq" "a sequence of numbers" } { "n" "a number" } }
+{ $description "Outputs the product of all elements of " { $snippet "seq" } ". Outputs one given an empty sequence." } ;
+
+HELP: infimum
+{ $values { "seq" "a sequence of real numbers" } { "n" "a number" } }
+{ $description "Outputs the least element of " { $snippet "seq" } "." }
+{ $errors "Throws an error if the sequence is empty." } ;
+
+HELP: supremum
+{ $values { "seq" "a sequence of real numbers" } { "n" "a number" } }
+{ $description "Outputs the greatest element of " { $snippet "seq" } "." }
+{ $errors "Throws an error if the sequence is empty." } ;

core/sequences/sequences.factor

@@ -655,3 +655,9 @@ PRIVATE>
 
 : trim ( seq quot -- newseq )
     [ ltrim ] keep rtrim ; inline
+
+: sum ( seq -- n ) 0 [ + ] reduce ;
+: product ( seq -- n ) 1 [ * ] reduce ;
+
+: infimum ( seq -- n ) dup first [ min ] reduce ;
+: supremum ( seq -- n ) dup first [ max ] reduce ;

core/syntax/syntax.factor

@@ -77,7 +77,6 @@ IN: bootstrap.syntax
 "?{" [ \ } [ >bit-array ] parse-literal ] define-syntax
 "F{" [ \ } [ >float-array ] parse-literal ] define-syntax
 "H{" [ \ } [ >hashtable ] parse-literal ] define-syntax
-"C{" [ \ } [ first2 rect> ] parse-literal ] define-syntax
 "T{" [ \ } [ >tuple ] parse-literal ] define-syntax
 "W{" [ \ } [ first <wrapper> ] parse-literal ] define-syntax
 
@@ -165,5 +164,3 @@ IN: bootstrap.syntax
 ] define-syntax
 
 "MAIN:" [ scan-word in get vocab set-vocab-main ] define-syntax
-
-"bootstrap.syntax" forget-vocab

core/threads/threads-tests.factor

@@ -8,6 +8,6 @@ IN: temporary
 [ ] [ [ "Errors, errors" throw ] in-thread ] unit-test
 yield
 
-[ ] [ 1/2 sleep ] unit-test
+[ ] [ 1 2 / sleep ] unit-test
 [ ] [ 0.3 sleep ] unit-test
 [ "hey" sleep ] unit-test-fails

core/vectors/vectors-tests.factor

@@ -10,7 +10,7 @@ IN: temporary
 
 [ -3 V{ } nth ] unit-test-fails
 [ 3 V{ } nth ] unit-test-fails
-[ 3 C{ 1 2 } nth ] unit-test-fails
+[ 3 54.3 nth ] unit-test-fails
 
 [ "hey" [ 1 2 ] set-length ] unit-test-fails
 [ "hey" V{ 1 2 } set-length ] unit-test-fails

extra/math/complex/complex-tests.factor

@@ -1,4 +1,5 @@
-USING: kernel math math.constants math.functions tools.test ;
+USING: kernel math math.constants math.functions tools.test
+prettyprint ;
 IN: temporary
 
 [ 1 C{ 0 1 } rect> ] unit-test-fails
@@ -63,3 +64,5 @@ IN: temporary
 [ ] [ C{ 1 4 } tan drop ] unit-test
 [ ] [ C{ 1 4 } coth drop ] unit-test
 [ ] [ C{ 1 4 } cot drop ] unit-test
+
+[ "C{ 1/2 2/3 }" ] [ C{ 1/2 2/3 } unparse ] unit-test

extra/math/complex/complex.factor

@@ -2,13 +2,12 @@
 ! See http://factorcode.org/license.txt for BSD license.
 IN: math.complex.private
 USING: kernel kernel.private math math.private
-math.libm math.functions ;
+math.libm math.functions prettyprint.backend arrays
+math.functions.private sequences parser ;
 
 M: real real ;
 M: real imaginary drop 0 ;
 
-M: number equal? number= ;
-
 M: complex absq >rect [ sq ] 2apply + ;
 
 : 2>rect ( x y -- xr yr xi yi )
@@ -34,3 +33,9 @@ M: complex abs absq >float fsqrt ;
 M: complex sqrt >polar swap fsqrt swap 2.0 / polar> ;
 
 M: complex hashcode* nip >rect >fixnum swap >fixnum bitxor ;
+
+M: complex >pprint-sequence >rect 2array ;
+
+IN: syntax
+
+: C{ \ } [ first2 rect> ] parse-literal ; parsing

extra/math/constants/constants.factor

@@ -2,8 +2,6 @@
 ! See http://factorcode.org/license.txt for BSD license.
 IN: math.constants
 
-: i ( -- i ) C{ 0 1 } ; inline
-: -i ( -- -i ) C{ 0 -1 } ; inline
 : e ( -- e ) 2.7182818284590452354 ; inline
 : pi ( -- pi ) 3.14159265358979323846 ; inline
 : epsilon ( -- epsilon ) 2.2204460492503131e-16 ; inline

extra/math/functions/functions-docs.factor

@@ -94,6 +94,19 @@ ARTICLE: "math-functions" "Mathematical functions"
 
 ABOUT: "math-functions"
 
+HELP: (rect>)
+{ $values { "x" real } { "y" real } { "z" number } }
+{ $description "Creates a complex number from real and imaginary components." }
+{ $warning "This word does not check that the arguments are real numbers, which can have undefined consequences. Use the " { $link rect> } " word instead." } ;
+
+HELP: rect>
+{ $values { "x" real } { "y" real } { "z" number } }
+{ $description "Creates a complex number from real and imaginary components." } ;
+
+HELP: >rect
+{ $values { "z" number } { "x" real } { "y" real } }
+{ $description "Extracts the real and imaginary components of a complex number." } ;
+
 HELP: power-of-2?
 { $values { "n" integer } { "?" "a boolean" } }
 { $description "Tests if " { $snippet "n" } " is a power of 2." } ;
@@ -281,3 +294,24 @@ HELP: ~
         { { $snippet "epsilon" } " is negative: relative distance test." }
     }
 } ;
+
+
+HELP: truncate
+{ $values { "x" real } { "y" "a whole real number" } }
+{ $description "Outputs the number that results from subtracting the fractional component of " { $snippet "x" } "." }
+{ $notes "The result is not necessarily an integer." } ;
+
+HELP: floor
+{ $values { "x" real } { "y" "a whole real number" } }
+{ $description "Outputs the greatest whole number smaller than or equal to " { $snippet "x" } "." }
+{ $notes "The result is not necessarily an integer." } ;
+
+HELP: ceiling
+{ $values { "x" real } { "y" "a whole real number" } }
+{ $description "Outputs the least whole number greater than or equal to " { $snippet "x" } "." }
+{ $notes "The result is not necessarily an integer." } ;
+
+HELP: round
+{ $values { "x" real } { "y" "a whole real number" } }
+{ $description "Outputs the whole number closest to " { $snippet "x" } "." }
+{ $notes "The result is not necessarily an integer." } ;

extra/math/functions/functions-tests.factor

@@ -74,3 +74,34 @@ IN: temporary
 [ 78572682077 ] [ 234829342 342389423843 mod-inv ] unit-test
 
 [ 2 10 mod-inv ] unit-test-fails
+
+[ t ] [ 0 0 ^ fp-nan? ] unit-test
+[ 1 ] [ 10 0 ^ ] unit-test
+[ 1/8 ] [ 1/2 3 ^ ] unit-test
+[ 1/8 ] [ 2 -3 ^ ] unit-test
+[ t ] [ 1 100 shift 2 100 ^ = ] unit-test
+
+[ t ] [ 256 power-of-2? ] unit-test
+[ f ] [ 123 power-of-2? ] unit-test
+
+[ 1 ] [ 7/8 ceiling ] unit-test
+[ 2 ] [ 3/2 ceiling ] unit-test
+[ 0 ] [ -7/8 ceiling ] unit-test
+[ -1 ] [ -3/2 ceiling ] unit-test
+
+[ 4.0 ] [ 4.5 truncate ] unit-test
+[ 4.0 ] [ 4.5 floor ] unit-test
+[ 5.0 ] [ 4.5 ceiling ] unit-test
+
+[ -4.0 ] [ -4.5 truncate ] unit-test
+[ -5.0 ] [ -4.5 floor ] unit-test
+[ -4.0 ] [ -4.5 ceiling ] unit-test
+
+[ -4.0 ] [ -4.0 truncate ] unit-test
+[ -4.0 ] [ -4.0 floor ] unit-test
+[ -4.0 ] [ -4.0 ceiling ] unit-test
+
+[ -5.0 ] [ -4.5 round ] unit-test
+[ -4.0 ] [ -4.4 round ] unit-test
+[ 5.0 ] [ 4.5 round ] unit-test
+[ 4.0 ] [ 4.4 round ] unit-test

extra/math/functions/functions.factor

@@ -1,8 +1,28 @@
 ! Copyright (C) 2004, 2007 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: math kernel math.constants math.libm combinators ;
+USING: math kernel math.constants math.private
+math.libm combinators ;
 IN: math.functions
 
+<PRIVATE
+
+: (rect>) ( x y -- z )
+    dup zero? [ drop ] [ <complex> ] if ; inline
+
+PRIVATE>
+
+: rect> ( x y -- z )
+    over real? over real? and [
+        (rect>)
+    ] [
+        "Complex number must have real components" throw
+    ] if ; inline
+
+GENERIC: sqrt ( x -- y ) foldable
+
+M: real sqrt
+    >float dup 0.0 < [ neg fsqrt 0.0 swap rect> ] [ fsqrt ] if ;
+
 : each-bit ( n quot -- )
     over 0 number= pick -1 number= or [
         2drop
@@ -62,8 +82,12 @@ M: integer (^)
 
 GENERIC: abs ( x -- y ) foldable
 
+M: real abs dup 0 < [ neg ] when ;
+
 GENERIC: absq ( x -- y ) foldable
 
+M: real absq sq ;
+
 : ~abs ( x y epsilon -- ? )
     >r - abs r> < ;
 
@@ -81,10 +105,13 @@ GENERIC: absq ( x -- y ) foldable
 : power-of-2? ( n -- ? )
     dup 0 < [ drop f ] [ dup 1- bitand zero? ] if ; foldable
 
-: align ( m w -- n ) 1- [ + ] keep bitnot bitand ; inline
+: >rect ( z -- x y ) dup real swap imaginary ; inline
 
 : conjugate ( z -- z* ) >rect neg rect> ; inline
 
+: >float-rect ( z -- x y )
+    >rect swap >float swap >float ; inline
+
 : arg ( z -- arg ) >float-rect swap fatan2 ; inline
 
 : >polar ( z -- abs arg )
@@ -160,18 +187,32 @@ M: number (^)
 : [-1,1]? ( x -- ? )
     dup complex? [ drop f ] [ abs 1 <= ] if ; inline
 
+: i* ( x -- y ) >rect neg swap rect> ;
+
+: -i* ( x -- y ) >rect swap neg rect> ;
+
 : asin ( x -- y )
-    dup [-1,1]? [ >float fasin ] [ i * asinh -i * ] if ; inline
+    dup [-1,1]? [ >float fasin ] [ i* asinh -i* ] if ; inline
 
 : acos ( x -- y )
     dup [-1,1]? [ >float facos ] [ asin pi 2 / swap - ] if ;
     inline
 
 : atan ( x -- y )
-    dup [-1,1]? [ >float fatan ] [ i * atanh i * ] if ; inline
+    dup [-1,1]? [ >float fatan ] [ i* atanh i* ] if ; inline
 
 : asec ( x -- y ) recip acos ; inline
 
 : acosec ( x -- y ) recip asin ; inline
 
 : acot ( x -- y ) recip atan ; inline
+
+: truncate ( x -- y ) dup 1 mod - ; inline
+
+: round ( x -- y ) dup sgn 2 / + truncate ; inline
+
+: floor ( x -- y )
+    dup 1 mod dup zero?
+    [ drop ] [ dup 0 < [ - 1- ] [ - ] if ] if ; foldable
+
+: ceiling ( x -- y ) neg floor neg ; foldable

extra/math/ratios/ratios-tests.factor

@@ -1,4 +1,4 @@
-USING: kernel math tools.test ;
+USING: kernel math math.parser tools.test ;
 IN: temporary
 
 [ 1 2 ] [ 1/2 >fraction ] unit-test
@@ -79,3 +79,27 @@ unit-test
 
 [ -1/2 ] [ 1/2 1- ] unit-test
 [ 3/2 ] [ 1/2 1+ ] unit-test
+
+[ 1 ] [ 0.5 1/2 + ] unit-test
+[ 1 ] [ 1/2 0.5 + ] unit-test
+
+[ 1/268435456 ] [ -1 -268435456 >fixnum / ] unit-test
+
+[ 5 ]
+[ "10/2" string>number ]
+unit-test
+
+[ -5 ]
+[ "-10/2" string>number ]
+unit-test
+
+[ -5 ]
+[ "10/-2" string>number ]
+unit-test
+
+[ 5 ]
+[ "-10/-2" string>number ]
+unit-test
+[ "33/100" ]
+[ "66/200" string>number number>string ]
+unit-test

extra/math/ratios/ratios.factor

@@ -1,12 +1,27 @@
 ! Copyright (C) 2004, 2006 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-IN: math.ratios.private
+IN: math.ratios
-USING: kernel kernel.private math math.functions
+USING: kernel kernel.private math math.functions math.private ;
-math.private ;
+
+: >fraction ( a/b -- a b )
+    dup numerator swap denominator ; inline
+
+: 2>fraction ( a/b c/d -- a c b d )
+    [ >fraction ] 2apply swapd ; inline
+
+<PRIVATE
 
 : fraction> ( a b -- a/b )
     dup 1 number= [ drop ] [ <ratio> ] if ; inline
 
+: scale ( a/b c/d -- a*d b*c )
+    2>fraction >r * swap r> * swap ; inline
+
+: ratio+d ( a/b c/d -- b*d )
+    denominator swap denominator * ; inline
+
+PRIVATE>
+
 M: integer /
     dup zero? [
         /i
@@ -15,15 +30,6 @@ M: integer /
         2dup gcd nip tuck /i >r /i r> fraction>
     ] if ;
 
-: 2>fraction ( a/b c/d -- a c b d )
-    [ >fraction ] 2apply swapd ; inline
-
-: scale ( a/b c/d -- a*d b*c )
-    2>fraction >r * swap r> * swap ; inline
-
-: ratio+d ( a/b c/d -- b*d )
-    denominator swap denominator * ; inline
-
 M: ratio number=
     2>fraction number= [ number= ] [ 2drop f ] if ;
 

extra/math/vectors/vectors-docs.factor

@@ -21,12 +21,7 @@ $nl
 { $subsection v. }
 { $subsection norm }
 { $subsection norm-sq }
-{ $subsection normalize }
+{ $subsection normalize } ;
-"Combining all the values in a vector into a scalar with " { $link reduce } ":"
-{ $subsection sum }
-{ $subsection product }
-{ $subsection supremum }
-{ $subsection infimum } ;
 
 ABOUT: "math-vectors"
 
@@ -105,21 +100,3 @@ HELP: set-axis
 { $values { "u" "a sequence of numbers" } { "v" "a sequence of numbers" } { "axis" "a sequence of 0/1" } { "w" "a sequence of numbers" } }
 { $description "Using " { $snippet "w" } " as a template, creates a new sequence containing corresponding elements from " { $snippet "u" } " in place of 0, and corresponding elements from " { $snippet "v" } " in place of 1." }
 { $examples { $example "USE: math.vectors" "{ 1 2 3 } { 4 5 6 } { 0 1 0 } set-axis ." "{ 1 5 3 }" } } ;
-
-HELP: sum
-{ $values { "seq" "a sequence of numbers" } { "n" "a number" } }
-{ $description "Outputs the sum of all elements of " { $snippet "seq" } ". Outputs zero given an empty sequence." } ;
-
-HELP: product
-{ $values { "seq" "a sequence of numbers" } { "n" "a number" } }
-{ $description "Outputs the product of all elements of " { $snippet "seq" } ". Outputs one given an empty sequence." } ;
-
-HELP: infimum
-{ $values { "seq" "a sequence of real numbers" } { "n" "a number" } }
-{ $description "Outputs the least element of " { $snippet "seq" } "." }
-{ $errors "Throws an error if the sequence is empty." } ;
-
-HELP: supremum
-{ $values { "seq" "a sequence of real numbers" } { "n" "a number" } }
-{ $description "Outputs the greatest element of " { $snippet "seq" } "." }
-{ $errors "Throws an error if the sequence is empty." } ;

extra/math/vectors/vectors.factor

@@ -1,6 +1,7 @@
 ! Copyright (C) 2005, 2007 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays kernel sequences math math.functions ;
+USING: arrays kernel sequences math math.functions hints
+float-arrays ;
 IN: math.vectors
 
 : vneg ( u -- v ) [ neg ] map ;
@@ -26,8 +27,20 @@ IN: math.vectors
 : set-axis ( u v axis -- w )
     dup length [ >r zero? pick pick ? r> swap nth ] 2map 2nip ;
 
-: sum ( seq -- n ) 0 [ + ] reduce ;
+HINTS: vneg { float-array array } ;
-: product ( seq -- n ) 1 [ * ] reduce ;
+HINTS: norm-sq { float-array array } ;
+HINTS: norm { float-array array } ;
+HINTS: normalize { float-array array } ;
 
-: infimum ( seq -- n ) dup first [ min ] reduce ;
+HINTS: n*v * { float-array array } ;
-: supremum ( seq -- n ) dup first [ max ] reduce ;
+HINTS: v*n { float-array array } * ;
+HINTS: n/v * { float-array array } ;
+HINTS: v/n { float-array array } * ;
+
+HINTS: v+ { float-array array } { float-array array } ;
+HINTS: v- { float-array array } { float-array array } ;
+HINTS: v* { float-array array } { float-array array } ;
+HINTS: v/ { float-array array } { float-array array } ;
+HINTS: vmax { float-array array } { float-array array } ;
+HINTS: vmin { float-array array } { float-array array } ;
+HINTS: v. { float-array array } { float-array array } ;

extra/random/random.factor

@@ -4,7 +4,7 @@
 ! mersenne twister based on 
 ! http://www.math.sci.hiroshima-u.ac.jp/~m-mat/MT/MT2002/CODES/mt19937ar.c
 
-USING: arrays kernel math math.functions namespaces sequences
+USING: arrays kernel math namespaces sequences
 system init alien.c-types ;
 IN: random
 

vm/cpu-arm.S

@@ -48,7 +48,7 @@ DEF(void,c_to_factor,(CELL quot)):
         SAVE(r11,7)
 	SAVE(r0,8)           /* save quotation since we're about to mangle it */
 
-        mov r0,sp            /* pass call stack pointer as an argument */
+        sub r0,sp,#4         /* pass call stack pointer as an argument */
 	bl MANGLE(save_callstack_bottom)
 
 	RESTORE(r0,8)        /* restore quotation */
@@ -78,7 +78,7 @@ DEFER: foo
 And calls to non-primitives do not have this one-instruction prologue, so we
 set the XT of undefined words to this symbol. */
 DEF(void,undefined,(CELL word)):
-	mov r1,sp
+	sub r1,sp,#4
 	b MANGLE(undefined_error)
 
 DEF(void,dosym,(CELL word)):

vm/cpu-arm.h

@@ -20,12 +20,9 @@ typedef struct
 
 	/* Frame size in bytes */
 	CELL size;
-
-	/* Return address */
-	XT return_address;
 } F_STACK_FRAME;
 
-#define FRAME_RETURN_ADDRESS(frame) (frame)->return_address
+#define FRAME_RETURN_ADDRESS(frame) *(XT *)(frame_successor(frame) + 1)
 
 void c_to_factor(CELL quot);
 void dosym(CELL word);

vm/factor.c

@@ -3,21 +3,27 @@
 void default_parameters(F_PARAMETERS *p)
 {
 	p->image = NULL;
-	p->ds_size = 128;
-	p->rs_size = 128;
 
 	/* We make a wild guess here that if we're running on ARM, we don't
 	have a lot of memory. */
 #ifdef FACTOR_ARM
+	p->ds_size = 8 * CELLS;
+	p->rs_size = 8 * CELLS;
+
 	p->gen_count = 2;
-	p->code_size = 2 * CELLS;
+	p->code_size = 4;
+	p->young_size = 1;
+	p->aging_size = 4;
 #else
+	p->ds_size = 32 * CELLS;
+	p->rs_size = 32 * CELLS;
+
 	p->gen_count = 3;
 	p->code_size = 4 * CELLS;
-#endif
-
 	p->young_size = 2 * CELLS;
 	p->aging_size = 4 * CELLS;
+#endif
+
 	p->secure_gc = false;
 	p->fep = false;
 }
@@ -134,9 +140,7 @@ void init_factor_from_args(F_CHAR *image, int argc, F_CHAR **argv, bool embedded
 	if(p.fep)
 		factorbug();
 
-	printf("about to call boot\n");
+	c_to_factor_toplevel(userenv[BOOT_ENV]);
-	c_to_factor(userenv[BOOT_ENV]);
-	printf("return from call boot\n");
 	unnest_stacks();
 
 	for(i = 0; i < argc; i++)