From 811026ce4d7b61863e51144b284ec99e59c5e6cd Mon Sep 17 00:00:00 2001
From: Doug Coleman <erg@secrets.local>
Date: Thu, 6 Nov 2008 13:16:33 -0600
Subject: [PATCH 01/27] removing some uses of at* in favor of at, simplifying
 code

---
 basis/regexp/regexp-tests.factor        |  1 -
 basis/regexp/regexp.factor              |  2 --
 basis/regexp/traversal/traversal.factor | 11 +++++------
 3 files changed, 5 insertions(+), 9 deletions(-)

diff --git a/basis/regexp/regexp-tests.factor b/basis/regexp/regexp-tests.factor
index 46696c8c0f..2339628801 100644
--- a/basis/regexp/regexp-tests.factor
+++ b/basis/regexp/regexp-tests.factor
@@ -331,4 +331,3 @@ IN: regexp-tests
 [ { 0 3 } ] [ "abc" "(ab|a)(bc)?" <regexp> first-match ] unit-test
 
 [ { 23 24 } ] [ "aaaaaaaaaaaaaaaaaaaaaaab" "((a*)*b)*b" <regexp> first-match ] unit-test
-
diff --git a/basis/regexp/regexp.factor b/basis/regexp/regexp.factor
index 73555fe953..083a48a470 100644
--- a/basis/regexp/regexp.factor
+++ b/basis/regexp/regexp.factor
@@ -92,7 +92,6 @@ IN: regexp
     reversed-regexp initial-option
     construct-regexp ;
 
-
 : parsing-regexp ( accum end -- accum )
     lexer get dup skip-blank
     [ [ index-from dup 1+ swap ] 2keep swapd subseq swap ] change-lexer-column
@@ -112,7 +111,6 @@ IN: regexp
 : R{ CHAR: } parsing-regexp ; parsing
 : R| CHAR: | parsing-regexp ; parsing
 
-
 : find-regexp-syntax ( string -- prefix suffix )
     {
         { "R/ "  "/"  }
diff --git a/basis/regexp/traversal/traversal.factor b/basis/regexp/traversal/traversal.factor
index 346d77e918..91c7ce16dc 100644
--- a/basis/regexp/traversal/traversal.factor
+++ b/basis/regexp/traversal/traversal.factor
@@ -2,7 +2,8 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors assocs combinators kernel math math.ranges
 quotations sequences regexp.parser regexp.classes fry arrays
-combinators.short-circuit regexp.utils prettyprint regexp.nfa ;
+combinators.short-circuit regexp.utils prettyprint regexp.nfa
+shuffle ;
 IN: regexp.traversal
 
 TUPLE: dfa-traverser
@@ -23,8 +24,7 @@ TUPLE: dfa-traverser
     [ dfa-table>> ] [ dfa-traversal-flags>> ] bi
     dfa-traverser new
         swap >>traversal-flags
-        swap [ start-state>> >>current-state ] keep
-        >>dfa-table
+        swap [ start-state>> >>current-state ] [ >>dfa-table ] bi
         swap >>text
         t >>traverse-forward
         0 >>start-index
@@ -116,7 +116,7 @@ M: capture-group-off flag-action ( dfa-traverser flag -- )
     V{ } clone >>matches ;
 
 : match-literal ( transition from-state table -- to-state/f )
-    transitions>> at* [ at ] [ 2drop f ] if ;
+    transitions>> at at ;
 
 : match-class ( transition from-state table -- to-state/f )
     transitions>> at* [
@@ -124,8 +124,7 @@ M: capture-group-off flag-action ( dfa-traverser flag -- )
     ] [ drop ] if ;
 
 : match-default ( transition from-state table -- to-state/f )
-    [ nip ] dip transitions>> at*
-    [ t swap at* [ ] [ drop f ] if ] [ drop f ] if ;
+    nipd transitions>> at t swap at ;
 
 : match-transition ( obj from-state dfa -- to-state/f )
     { [ match-literal ] [ match-class ] [ match-default ] } 3|| ;

From 73f6691f759357a63171fcd40584bcdd350027a4 Mon Sep 17 00:00:00 2001
From: Doug Coleman <erg@secrets.local>
Date: Thu, 6 Nov 2008 15:48:08 -0600
Subject: [PATCH 02/27] print out clickable pathnames in project euler

---
 extra/project-euler/project-euler.factor | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/extra/project-euler/project-euler.factor b/extra/project-euler/project-euler.factor
index 5192e23a27..d85e7e206d 100644
--- a/extra/project-euler/project-euler.factor
+++ b/extra/project-euler/project-euler.factor
@@ -1,7 +1,7 @@
 ! Copyright (c) 2007, 2008 Aaron Schaefer, Samuel Tardieu.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: definitions io io.files kernel math math.parser project-euler.ave-time
-    sequences vocabs vocabs.loader
+    sequences vocabs vocabs.loader prettyprint
     project-euler.001 project-euler.002 project-euler.003 project-euler.004
     project-euler.005 project-euler.006 project-euler.007 project-euler.008
     project-euler.009 project-euler.010 project-euler.011 project-euler.012
@@ -33,7 +33,7 @@ IN: project-euler
 
 : solution-path ( n -- str/f )
     number>euler "project-euler." prepend
-    vocab where dup [ first ] when ;
+    vocab where dup [ first <pathname> ] when ;
 
 PRIVATE>
 
@@ -43,8 +43,8 @@ PRIVATE>
 : run-project-euler ( -- )
     problem-prompt dup problem-solved? [
         dup number>euler "project-euler." prepend run
-        "Answer: " swap dup number? [ number>string ] when append print
-        "Source: " swap solution-path append print
+        "Answer: " write dup number? [ number>string ] when print
+        "Source: " write solution-path .
     ] [
         drop "That problem has not been solved yet..." print
     ] if ;

From 46aa56730b4a5c79cc326813026862b5a6e69649 Mon Sep 17 00:00:00 2001
From: Doug Coleman <erg@secrets.local>
Date: Thu, 6 Nov 2008 16:53:00 -0600
Subject: [PATCH 03/27] better parsing for anchors

---
 basis/regexp/parser/parser.factor | 44 ++++++++++++++++++++-----------
 1 file changed, 29 insertions(+), 15 deletions(-)

diff --git a/basis/regexp/parser/parser.factor b/basis/regexp/parser/parser.factor
index d2ed346bf2..d04016b93a 100644
--- a/basis/regexp/parser/parser.factor
+++ b/basis/regexp/parser/parser.factor
@@ -233,15 +233,22 @@ ERROR: invalid-range a b ;
 SINGLETON: beginning-of-input
 SINGLETON: end-of-input
 
-! : beginning-of-input ( -- obj ) 
-: handle-front-anchor ( -- ) front-anchor push-stack ;
-: end-of-line ( -- obj )
-    end-of-input
+: newlines ( -- obj1 obj2 obj3 )
     CHAR: \r <constant>
     CHAR: \n <constant>
-    2dup 2array <concatenation> 4array <alternation> lookahead boa ;
+    2dup 2array <concatenation> ;
 
-: handle-back-anchor ( -- ) end-of-line push-stack ;
+: beginning-of-line ( -- obj )
+    beginning-of-input newlines 4array <alternation> lookbehind boa ;
+
+: end-of-line ( -- obj )
+    end-of-input newlines 4array <alternation> lookahead boa ;
+
+: handle-front-anchor ( -- )
+    get-multiline beginning-of-line beginning-of-input ? push-stack ;
+
+: handle-back-anchor ( -- )
+    get-multiline end-of-line end-of-input ? push-stack ;
 
 ERROR: bad-character-class obj ;
 ERROR: expected-posix-class ;
@@ -412,16 +419,11 @@ DEFER: handle-left-bracket
     [ [ push ] keep current-regexp get (>>stack) ]
     [ finish-regexp-parse push-stack ] bi* ;
 
-
 : parse-regexp-token ( token -- ? )
     {
-! todo: only match these at beginning/end of regexp
-        { CHAR: ^ [ handle-front-anchor t ] }
-        { CHAR: $ [ handle-back-anchor t ] }
-
-        { CHAR: . [ handle-dot t ] }
-        { CHAR: ( [ handle-left-parenthesis t ] }
+        { CHAR: ( [ handle-left-parenthesis t ] } ! handle (?..) at beginning?
         { CHAR: ) [ handle-right-parenthesis f ] }
+        { CHAR: . [ handle-dot t ] }
         { CHAR: | [ handle-pipe t ] }
         { CHAR: ? [ handle-question t ] }
         { CHAR: * [ handle-star t ] }
@@ -429,16 +431,28 @@ DEFER: handle-left-bracket
         { CHAR: { [ handle-left-brace t ] }
         { CHAR: [ [ handle-left-bracket t ] }
         { CHAR: \ [ handle-escape t ] }
-        [ <constant> push-stack t ]
+        [
+            dup CHAR: $ = peek1 f = and [
+                drop
+                handle-back-anchor f
+            ] [
+                <constant> push-stack t
+            ] if
+        ]
     } case ;
 
 : (parse-regexp) ( -- )
     read1 [ parse-regexp-token [ (parse-regexp) ] when ] when* ;
 
+: parse-regexp-beginning ( -- )
+    peek1 CHAR: ^ = [ drop1 handle-front-anchor ] when ;
+
 : parse-regexp ( regexp -- )
     dup current-regexp [
         raw>> [
-            <string-reader> [ (parse-regexp) ] with-input-stream
+            <string-reader> [
+                parse-regexp-beginning (parse-regexp)
+            ] with-input-stream
         ] unless-empty
         current-regexp get
         stack finish-regexp-parse

From d1f248dac67db2e6a6a68aa08301f1d384f039db Mon Sep 17 00:00:00 2001
From: sheeple <sheeple@oberon.local>
Date: Thu, 6 Nov 2008 19:00:56 -0600
Subject: [PATCH 04/27] Fixing PowerPC backend: prolog register clobberage,
 spilling, and general stack frame usage. Add some lame tests for spilling

---
 .../cfg/stack-frame/stack-frame.factor        |  18 +-
 basis/compiler/tests/spilling.factor          | 343 ++++++++++++++++++
 basis/compiler/tests/templates.factor         | 163 +--------
 basis/cpu/ppc/ppc.factor                      | 112 +++---
 4 files changed, 414 insertions(+), 222 deletions(-)
 create mode 100644 basis/compiler/tests/spilling.factor

diff --git a/basis/compiler/cfg/stack-frame/stack-frame.factor b/basis/compiler/cfg/stack-frame/stack-frame.factor
index 8d79a85b8f..ec9ffaba49 100644
--- a/basis/compiler/cfg/stack-frame/stack-frame.factor
+++ b/basis/compiler/cfg/stack-frame/stack-frame.factor
@@ -1,8 +1,8 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: namespaces accessors math.order assocs kernel sequences
-combinators make cpu.architecture compiler.cfg.instructions
-compiler.cfg.registers ;
+combinators make classes words cpu.architecture
+compiler.cfg.instructions compiler.cfg.registers ;
 IN: compiler.cfg.stack-frame
 
 SYMBOL: frame-required?
@@ -24,16 +24,16 @@ M: ##stack-frame compute-stack-frame*
 M: ##call compute-stack-frame*
     word>> sub-primitive>> [ frame-required? on ] unless ;
 
-M: _gc compute-stack-frame*
-    drop frame-required? on ;
-
-M: _spill compute-stack-frame*
-    drop frame-required? on ;
-
 M: _spill-counts compute-stack-frame*
     counts>> stack-frame get (>>spill-counts) ;
 
-M: insn compute-stack-frame* drop ;
+M: insn compute-stack-frame*
+    class frame-required? word-prop [
+        frame-required? on
+    ] when ;
+
+\ _gc t frame-required? set-word-prop
+\ _spill t frame-required? set-word-prop
 
 : compute-stack-frame ( insns -- )
     frame-required? off
diff --git a/basis/compiler/tests/spilling.factor b/basis/compiler/tests/spilling.factor
new file mode 100644
index 0000000000..156fdfff02
--- /dev/null
+++ b/basis/compiler/tests/spilling.factor
@@ -0,0 +1,343 @@
+USING: math.private kernel combinators accessors arrays
+generalizations float-arrays tools.test ;
+IN: compiler.tests
+
+: float-spill-bug ( a -- b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b )
+    {
+        [ dup float+ ]
+        [ dup float+ ]
+        [ dup float+ ]
+        [ dup float+ ]
+        [ dup float+ ]
+        [ dup float+ ]
+        [ dup float+ ]
+        [ dup float+ ]
+        [ dup float+ ]
+        [ dup float+ ]
+        [ dup float+ ]
+        [ dup float+ ]
+        [ dup float+ ]
+        [ dup float+ ]
+        [ dup float+ ]
+        [ dup float+ ]
+        [ dup float+ ]
+        [ dup float+ ]
+        [ dup float+ ]
+        [ dup float+ ]
+        [ dup float+ ]
+        [ dup float+ ]
+        [ dup float+ ]
+        [ dup float+ ]
+        [ dup float+ ]
+        [ dup float+ ]
+        [ dup float+ ]
+        [ dup float+ ]
+        [ dup float+ ]
+        [ dup float+ ]
+        [ dup float+ ]
+        [ dup float+ ]
+        [ dup float+ ]
+        [ dup float+ ]
+        [ dup float+ ]
+        [ dup float+ ]
+        [ dup float+ ]
+        [ dup float+ ]
+    } cleave ;
+
+[ 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 ]
+[ 1.0 float-spill-bug ] unit-test
+
+[ t ] [ \ float-spill-bug compiled>> ] unit-test
+
+: float-fixnum-spill-bug ( object -- object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object )
+    {
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+    } cleave ;
+
+[ 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 ]
+[ 1.0 float-fixnum-spill-bug ] unit-test
+
+[ t ] [ \ float-fixnum-spill-bug compiled>> ] unit-test
+
+: resolve-spill-bug ( a b -- c )
+    [ 1 fixnum+fast ] bi@ dup 10 fixnum< [
+        nip 2 fixnum+fast
+    ] [
+        drop {
+            [ dup fixnum+fast ]
+            [ dup fixnum+fast ]
+            [ dup fixnum+fast ]
+            [ dup fixnum+fast ]
+            [ dup fixnum+fast ]
+            [ dup fixnum+fast ]
+            [ dup fixnum+fast ]
+            [ dup fixnum+fast ]
+            [ dup fixnum+fast ]
+            [ dup fixnum+fast ]
+            [ dup fixnum+fast ]
+            [ dup fixnum+fast ]
+            [ dup fixnum+fast ]
+            [ dup fixnum+fast ]
+            [ dup fixnum+fast ]
+            [ dup fixnum+fast ]
+        } cleave
+        16 narray
+    ] if ;
+
+[ t ] [ \ resolve-spill-bug compiled>> ] unit-test
+
+[ 4 ] [ 1 1 resolve-spill-bug ] unit-test
+
+! The above don't really test spilling...
+: spill-test-1 ( a -- b )
+    dup 1 fixnum+fast
+    dup 1 fixnum+fast
+    dup 1 fixnum+fast
+    dup 1 fixnum+fast
+    dup 1 fixnum+fast
+    dup 1 fixnum+fast
+    dup 1 fixnum+fast
+    dup 1 fixnum+fast
+    dup 1 fixnum+fast
+    dup 1 fixnum+fast
+    dup 1 fixnum+fast
+    dup 1 fixnum+fast
+    dup 1 fixnum+fast
+    dup 1 fixnum+fast
+    dup 1 fixnum+fast
+    dup 1 fixnum+fast
+    dup 1 fixnum+fast
+    dup 1 fixnum+fast
+    dup 1 fixnum+fast
+    dup 1 fixnum+fast
+    dup 1 fixnum+fast
+    dup 1 fixnum+fast
+    dup 1 fixnum+fast
+    dup 1 fixnum+fast
+    dup 1 fixnum+fast
+    dup 1 fixnum+fast
+    dup 1 fixnum+fast
+    dup 1 fixnum+fast
+    dup 1 fixnum+fast fixnum>float
+    3array
+    3array [ 8 narray ] dip 2array
+    [ 8 narray [ 8 narray ] dip 2array ] dip 2array
+    2array ;
+
+[
+    {
+        1
+        {
+            { { 2 3 4 5 6 7 8 9 } { 10 11 12 13 14 15 16 17 } }
+            {
+                { 18 19 20 21 22 23 24 25 }
+                { 26 27 { 28 29 30.0 } }
+            }
+        }
+    }
+] [ 1 spill-test-1 ] unit-test
+
+: spill-test-2 ( a -- b )
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float* ;
+
+[ t ] [ 1.0 spill-test-2 1.0 \ spill-test-2 def>> call = ] unit-test
diff --git a/basis/compiler/tests/templates.factor b/basis/compiler/tests/templates.factor
index 675e0cbc0f..de87ad8c00 100644
--- a/basis/compiler/tests/templates.factor
+++ b/basis/compiler/tests/templates.factor
@@ -3,7 +3,7 @@ kernel.private math hashtables.private math.private namespaces
 sequences sequences.private tools.test namespaces.private
 slots.private sequences.private byte-arrays alien
 alien.accessors layouts words definitions compiler.units io
-combinators vectors ;
+combinators vectors float-arrays ;
 IN: compiler.tests
 
 ! Originally, this file did black box testing of templating
@@ -206,167 +206,6 @@ TUPLE: my-tuple ;
     ] compile-call
 ] unit-test
 
-: float-spill-bug ( a -- b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b )
-    {
-        [ dup float+ ]
-        [ dup float+ ]
-        [ dup float+ ]
-        [ dup float+ ]
-        [ dup float+ ]
-        [ dup float+ ]
-        [ dup float+ ]
-        [ dup float+ ]
-        [ dup float+ ]
-        [ dup float+ ]
-        [ dup float+ ]
-        [ dup float+ ]
-        [ dup float+ ]
-        [ dup float+ ]
-        [ dup float+ ]
-        [ dup float+ ]
-        [ dup float+ ]
-        [ dup float+ ]
-        [ dup float+ ]
-        [ dup float+ ]
-        [ dup float+ ]
-        [ dup float+ ]
-        [ dup float+ ]
-        [ dup float+ ]
-        [ dup float+ ]
-        [ dup float+ ]
-        [ dup float+ ]
-        [ dup float+ ]
-        [ dup float+ ]
-        [ dup float+ ]
-        [ dup float+ ]
-        [ dup float+ ]
-        [ dup float+ ]
-        [ dup float+ ]
-        [ dup float+ ]
-        [ dup float+ ]
-        [ dup float+ ]
-        [ dup float+ ]
-    } cleave ;
-
-[ 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 ]
-[ 1.0 float-spill-bug ] unit-test
-
-[ t ] [ \ float-spill-bug compiled>> ] unit-test
-
-: float-fixnum-spill-bug ( object -- object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object )
-    {
-        [ dup float+ ]
-        [ float>fixnum dup fixnum+fast ]
-        [ dup float+ ]
-        [ float>fixnum dup fixnum+fast ]
-        [ dup float+ ]
-        [ float>fixnum dup fixnum+fast ]
-        [ dup float+ ]
-        [ float>fixnum dup fixnum+fast ]
-        [ dup float+ ]
-        [ float>fixnum dup fixnum+fast ]
-        [ dup float+ ]
-        [ float>fixnum dup fixnum+fast ]
-        [ dup float+ ]
-        [ float>fixnum dup fixnum+fast ]
-        [ dup float+ ]
-        [ float>fixnum dup fixnum+fast ]
-        [ dup float+ ]
-        [ float>fixnum dup fixnum+fast ]
-        [ dup float+ ]
-        [ float>fixnum dup fixnum+fast ]
-        [ dup float+ ]
-        [ float>fixnum dup fixnum+fast ]
-        [ dup float+ ]
-        [ float>fixnum dup fixnum+fast ]
-        [ dup float+ ]
-        [ float>fixnum dup fixnum+fast ]
-        [ dup float+ ]
-        [ float>fixnum dup fixnum+fast ]
-        [ dup float+ ]
-        [ float>fixnum dup fixnum+fast ]
-        [ dup float+ ]
-        [ float>fixnum dup fixnum+fast ]
-        [ dup float+ ]
-        [ float>fixnum dup fixnum+fast ]
-        [ dup float+ ]
-        [ float>fixnum dup fixnum+fast ]
-        [ dup float+ ]
-        [ float>fixnum dup fixnum+fast ]
-        [ dup float+ ]
-        [ float>fixnum dup fixnum+fast ]
-        [ dup float+ ]
-        [ float>fixnum dup fixnum+fast ]
-        [ dup float+ ]
-        [ float>fixnum dup fixnum+fast ]
-        [ dup float+ ]
-        [ float>fixnum dup fixnum+fast ]
-        [ dup float+ ]
-        [ float>fixnum dup fixnum+fast ]
-        [ dup float+ ]
-        [ float>fixnum dup fixnum+fast ]
-        [ dup float+ ]
-        [ float>fixnum dup fixnum+fast ]
-        [ dup float+ ]
-        [ float>fixnum dup fixnum+fast ]
-        [ dup float+ ]
-        [ float>fixnum dup fixnum+fast ]
-        [ dup float+ ]
-        [ float>fixnum dup fixnum+fast ]
-        [ dup float+ ]
-        [ float>fixnum dup fixnum+fast ]
-        [ dup float+ ]
-        [ float>fixnum dup fixnum+fast ]
-        [ dup float+ ]
-        [ float>fixnum dup fixnum+fast ]
-        [ dup float+ ]
-        [ float>fixnum dup fixnum+fast ]
-        [ dup float+ ]
-        [ float>fixnum dup fixnum+fast ]
-        [ dup float+ ]
-        [ float>fixnum dup fixnum+fast ]
-        [ dup float+ ]
-        [ float>fixnum dup fixnum+fast ]
-        [ dup float+ ]
-        [ float>fixnum dup fixnum+fast ]
-        [ dup float+ ]
-        [ float>fixnum dup fixnum+fast ]
-    } cleave ;
-
-[ 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 ]
-[ 1.0 float-fixnum-spill-bug ] unit-test
-
-[ t ] [ \ float-fixnum-spill-bug compiled>> ] unit-test
-
-: resolve-spill-bug ( a b -- c )
-    [ 1 fixnum+fast ] bi@ dup 10 fixnum< [
-        nip 2 fixnum+fast
-    ] [
-        drop {
-            [ dup fixnum+fast ]
-            [ dup fixnum+fast ]
-            [ dup fixnum+fast ]
-            [ dup fixnum+fast ]
-            [ dup fixnum+fast ]
-            [ dup fixnum+fast ]
-            [ dup fixnum+fast ]
-            [ dup fixnum+fast ]
-            [ dup fixnum+fast ]
-            [ dup fixnum+fast ]
-            [ dup fixnum+fast ]
-            [ dup fixnum+fast ]
-            [ dup fixnum+fast ]
-            [ dup fixnum+fast ]
-            [ dup fixnum+fast ]
-            [ dup fixnum+fast ]
-        } cleave
-        16 narray
-    ] if ;
-
-[ t ] [ \ resolve-spill-bug compiled>> ] unit-test
-
-[ 4 ] [ 1 1 resolve-spill-bug ] unit-test
-
 ! Regression
 : dispatch-alignment-regression ( -- c )
     { tuple vector } 3 slot { word } declare
diff --git a/basis/cpu/ppc/ppc.factor b/basis/cpu/ppc/ppc.factor
index ad6c63b8c9..b60fd47b89 100644
--- a/basis/cpu/ppc/ppc.factor
+++ b/basis/cpu/ppc/ppc.factor
@@ -4,7 +4,8 @@ USING: accessors assocs sequences kernel combinators make math
 math.order math.ranges system namespaces locals layouts words
 alien alien.c-types cpu.architecture cpu.ppc.assembler
 compiler.cfg.registers compiler.cfg.instructions
-compiler.constants compiler.codegen compiler.codegen.fixup ;
+compiler.constants compiler.codegen compiler.codegen.fixup
+compiler.cfg.intrinsics compiler.cfg.stack-frame ;
 IN: cpu.ppc
 
 ! PowerPC register assignments:
@@ -25,17 +26,21 @@ IN: cpu.ppc
         t "longlong" c-type (>>stack-align?)
         t "ulonglong" c-type (>>stack-align?)
     ] }
-} cond >>
+} cond
+
+enable-float-intrinsics
+
+\ ##integer>float t frame-required? set-word-prop
+\ ##float>integer t frame-required? set-word-prop >>
 
 M: ppc machine-registers
     {
         { int-regs T{ range f 2 26 1 } }
-        { double-float-regs T{ range f 0 28 1 } }
+        { double-float-regs T{ range f 0 29 1 } }
     } ;
 
 : scratch-reg 28 ; inline
-: fp-scratch-reg-1 29 ; inline
-: fp-scratch-reg-2 30 ; inline
+: fp-scratch-reg 30 ; inline
 
 M: ppc two-operand? f ;
 
@@ -71,12 +76,15 @@ M: ppc %inc-r ( n -- ) rs-reg (%inc) ;
         { macosx [ 6 ] }
     } case cells ; foldable
 
-: lr-save ( -- n )
-    os {
-        { linux [ 1 ] }
-        { macosx [ 2 ] }
-    } case cells ; foldable
+! The start of the stack frame contains the size of this frame
+! as well as the currently executing XT
+: factor-area-size ( -- n ) 2 cells ; foldable
+: next-save ( n -- i ) cell - ;
+: xt-save ( n -- i ) 2 cells - ;
 
+! Next, we have the spill area as well as the FFI parameter area.
+! They overlap, since basic blocks with FFI calls will never
+! spill.
 : param@ ( n -- x ) reserved-area-size + ; inline
 
 : param-save-size ( -- n ) 8 cells ; foldable
@@ -84,19 +92,38 @@ M: ppc %inc-r ( n -- ) rs-reg (%inc) ;
 : local@ ( n -- x )
     reserved-area-size param-save-size + + ; inline
 
-: factor-area-size ( -- n ) 2 cells ; foldable
+: spill-integer-base ( -- n )
+    stack-frame get spill-counts>> double-float-regs swap at
+    double-float-regs reg-size * ;
 
-: next-save ( n -- i ) cell - ;
+: spill-integer@ ( n -- offset )
+    cells spill-integer-base + param@ ;
 
-: xt-save ( n -- i ) 2 cells - ;
+: spill-float@ ( n -- offset )
+    double-float-regs reg-size * param@ ;
+
+! Some FP intrinsics need a temporary scratch area in the stack
+! frame, 8 bytes in size
+: scratch@ ( n -- offset )
+   stack-frame get total-size>>
+   factor-area-size -
+   param-save-size -
+   + ;
+
+! Finally we have the linkage area
+: lr-save ( -- n )
+    os {
+        { linux [ 1 ] }
+        { macosx [ 2 ] }
+    } case cells ; foldable
 
 M: ppc stack-frame-size ( stack-frame -- i )
     [ spill-counts>> [ swap reg-size * ] { } assoc>map sum ]
     [ params>> ]
     [ return>> ]
     tri + +
-    reserved-area-size +
     param-save-size +
+    reserved-area-size +
     factor-area-size +
     4 cells align ;
 
@@ -219,19 +246,19 @@ M: ppc %div-float FDIV ;
 
 M:: ppc %integer>float ( dst src -- )
     HEX: 4330 scratch-reg LIS
-    scratch-reg 1 0 param@ STW
+    scratch-reg 1 0 scratch@ STW
     scratch-reg src MR
     scratch-reg dup HEX: 8000 XORIS
-    scratch-reg 1 cell param@ STW
-    fp-scratch-reg-2 1 0 param@ LFD
+    scratch-reg 1 4 scratch@ STW
+    dst 1 0 scratch@ LFD
     scratch-reg 4503601774854144.0 %load-indirect
-    fp-scratch-reg-2 scratch-reg float-offset LFD
-    fp-scratch-reg-2 fp-scratch-reg-2 fp-scratch-reg-2 FSUB ;
+    fp-scratch-reg scratch-reg float-offset LFD
+    dst dst fp-scratch-reg FSUB ;
 
 M:: ppc %float>integer ( dst src -- )
-    fp-scratch-reg-1 src FCTIWZ
-    fp-scratch-reg-2 1 0 param@ STFD
-    dst 1 4 param@ LWZ ;
+    fp-scratch-reg src FCTIWZ
+    fp-scratch-reg 1 0 scratch@ STFD
+    dst 1 4 scratch@ LWZ ;
 
 M: ppc %copy ( dst src -- ) MR ;
 
@@ -239,6 +266,10 @@ M: ppc %copy-float ( dst src -- ) FMR ;
 
 M: ppc %unbox-float ( dst src -- ) float-offset LFD ;
 
+M:: ppc %box-float ( dst src temp -- )
+    dst 16 float temp %allot
+    src dst float-offset STFD ;
+
 M:: ppc %unbox-any-c-ptr ( dst src temp -- )
     [
         { "is-byte-array" "end" "start" } [ define-label ] each
@@ -370,12 +401,12 @@ M: ppc %gc
     "end" resolve-label ;
 
 M: ppc %prologue ( n -- )
-    0 scratch-reg LOAD32 rc-absolute-ppc-2/2 rel-this
+    0 11 LOAD32 rc-absolute-ppc-2/2 rel-this
     0 MFLR
     1 1 pick neg ADDI
-    scratch-reg 1 pick xt-save STW
-    dup scratch-reg LI
-    scratch-reg 1 pick next-save STW
+    11 1 pick xt-save STW
+    dup 11 LI
+    11 1 pick next-save STW
     0 1 rot lr-save + STW ;
 
 M: ppc %epilogue ( n -- )
@@ -426,32 +457,11 @@ M: ppc %compare-branch (%compare) %branch ;
 M: ppc %compare-imm-branch (%compare-imm) %branch ;
 M: ppc %compare-float-branch (%compare-float) %branch ;
 
-: spill-integer-base ( stack-frame -- n )
-    [ params>> ] [ return>> ] bi + ;
+M: ppc %spill-integer ( src n -- ) spill-integer@ 1 swap STW ;
+M: ppc %reload-integer ( dst n -- ) spill-integer@ 1 swap LWZ ;
 
-: stack@ 1 swap ; inline
-
-: spill-integer@ ( n -- reg offset )
-    cells
-    stack-frame get spill-integer-base
-    + stack@ ;
-
-: spill-float-base ( stack-frame -- n )
-    [ spill-counts>> int-regs swap at int-regs reg-size * ]
-    [ params>> ]
-    [ return>> ]
-    tri + + ;
-
-: spill-float@ ( n -- reg offset )
-    double-float-regs reg-size *
-    stack-frame get spill-float-base
-    + stack@ ;
-
-M: ppc %spill-integer ( src n -- ) spill-integer@ STW ;
-M: ppc %reload-integer ( dst n -- ) spill-integer@ LWZ ;
-
-M: ppc %spill-float ( src n -- ) spill-float@ STFD ;
-M: ppc %reload-float ( dst n -- ) spill-float@ LFD ;
+M: ppc %spill-float ( src n -- ) spill-float@ 1 swap STFD ;
+M: ppc %reload-float ( dst n -- ) spill-float@ 1 swap LFD ;
 
 M: ppc %loop-entry ;
 

From e45df2e89c006669e59bb7362c46556b46b2a5a0 Mon Sep 17 00:00:00 2001
From: unknown <Administrator@.(none)>
Date: Fri, 7 Nov 2008 20:25:31 -0600
Subject: [PATCH 05/27] Fix bignums for Win64

---
 vm/bignum.c | 27 ++++++++++-----------------
 vm/bignum.h |  8 ++------
 2 files changed, 12 insertions(+), 23 deletions(-)

diff --git a/vm/bignum.c b/vm/bignum.c
index d92f665354..72616afbc5 100644
--- a/vm/bignum.c
+++ b/vm/bignum.c
@@ -1,7 +1,7 @@
 /* :tabSize=2:indentSize=2:noTabs=true:
 
 Copyright (C) 1989-94 Massachusetts Institute of Technology
-Portions copyright (C) 2004-2007 Slava Pestov
+Portions copyright (C) 2004-2008 Slava Pestov
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -45,6 +45,7 @@ MIT in each case. */
  *  - Remove unused functions
  *  - Add local variable GC root recording
  *  - Remove s48 prefix from function names
+ *  - Various fixes for Win64
  */
 
 #include "master.h"
@@ -366,8 +367,6 @@ bignum_remainder(bignum_type numerator, bignum_type denominator)
 /* all below allocate memory */
 FOO_TO_BIGNUM(cell,CELL,CELL)
 FOO_TO_BIGNUM(fixnum,F_FIXNUM,CELL)
-FOO_TO_BIGNUM(long,long,unsigned long)
-FOO_TO_BIGNUM(ulong,unsigned long,unsigned long)
 FOO_TO_BIGNUM(long_long,s64,u64)
 FOO_TO_BIGNUM(ulong_long,u64,u64)
 
@@ -389,8 +388,6 @@ FOO_TO_BIGNUM(ulong_long,u64,u64)
 /* all of the below allocate memory */
 BIGNUM_TO_FOO(cell,CELL,CELL);
 BIGNUM_TO_FOO(fixnum,F_FIXNUM,CELL);
-BIGNUM_TO_FOO(long,long,unsigned long)
-BIGNUM_TO_FOO(ulong,unsigned long,unsigned long)
 BIGNUM_TO_FOO(long_long,s64,u64)
 BIGNUM_TO_FOO(ulong_long,u64,u64)
 
@@ -435,7 +432,7 @@ double_to_bignum(double x)
     bignum_digit_type digit;
     int odd_bits = (exponent % BIGNUM_DIGIT_LENGTH);
     if (odd_bits > 0)
-      DTB_WRITE_DIGIT (1L << odd_bits);
+      DTB_WRITE_DIGIT ((F_FIXNUM)1 << odd_bits);
     while (start < scan)
       {
         if (significand == 0)
@@ -1117,7 +1114,7 @@ bignum_destructive_normalization(bignum_type source, bignum_type target,
   bignum_digit_type * end_source = (scan_source + (BIGNUM_LENGTH (source)));
   bignum_digit_type * end_target = (scan_target + (BIGNUM_LENGTH (target)));
   int shift_right = (BIGNUM_DIGIT_LENGTH - shift_left);
-  bignum_digit_type mask = ((1L << shift_right) - 1);
+  bignum_digit_type mask = (((CELL)1 << shift_right) - 1);
   while (scan_source < end_source)
     {
       digit = (*scan_source++);
@@ -1139,7 +1136,7 @@ bignum_destructive_unnormalization(bignum_type bignum, int shift_right)
   bignum_digit_type digit;
   bignum_digit_type carry = 0;
   int shift_left = (BIGNUM_DIGIT_LENGTH - shift_right);
-  bignum_digit_type mask = ((1L << shift_right) - 1);
+  bignum_digit_type mask = (((F_FIXNUM)1 << shift_right) - 1);
   while (start < scan)
     {
       digit = (*--scan);
@@ -1489,7 +1486,7 @@ bignum_bitwise_not(bignum_type x)
 
 /* allocates memory */
 bignum_type
-bignum_arithmetic_shift(bignum_type arg1, long n)
+bignum_arithmetic_shift(bignum_type arg1, F_FIXNUM n)
 {
   if (BIGNUM_NEGATIVE_P(arg1) && n < 0)
     return bignum_bitwise_not(bignum_magnitude_ash(bignum_bitwise_not(arg1), n));
@@ -1550,14 +1547,14 @@ bignum_bitwise_xor(bignum_type arg1, bignum_type arg2)
 /* ash for the magnitude */
 /* assume arg1 is a big number, n is a long */
 bignum_type
-bignum_magnitude_ash(bignum_type arg1, long n)
+bignum_magnitude_ash(bignum_type arg1, F_FIXNUM n)
 {
   bignum_type result = NULL;
   bignum_digit_type *scan1;
   bignum_digit_type *scanr;
   bignum_digit_type *end;
 
-  long digit_offset,bit_offset;
+  F_FIXNUM digit_offset,bit_offset;
 
   if (BIGNUM_ZERO_P (arg1)) return (arg1);
 
@@ -1642,10 +1639,6 @@ bignum_pospos_bitwise_op(int op, bignum_type arg1, bignum_type arg2)
   while (scanr < endr) {
     digit1 = (scan1 < end1) ? *scan1++ : 0;
     digit2 = (scan2 < end2) ? *scan2++ : 0;
-    /*
-    fprintf(stderr, "[pospos op = %d, i = %ld, d1 = %lx, d2 = %lx]\n",
-            op, endr - scanr, digit1, digit2);
-            */
     *scanr++ = (op == AND_OP) ? digit1 & digit2 :
                (op == IOR_OP) ? digit1 | digit2 :
                                 digit1 ^ digit2;
@@ -1856,8 +1849,8 @@ digit_stream_to_bignum(unsigned int n_digits,
     return (BIGNUM_ZERO ());
   if (n_digits == 1)
     {
-      long digit = ((long) ((*producer) (0)));
-      return (long_to_bignum (negative_p ? (- digit) : digit));
+      F_FIXNUM digit = ((F_FIXNUM) ((*producer) (0)));
+      return (fixnum_to_bignum (negative_p ? (- digit) : digit));
     }
   {
     bignum_length_type length;
diff --git a/vm/bignum.h b/vm/bignum.h
index 3e6fd9f3ec..02309cad34 100644
--- a/vm/bignum.h
+++ b/vm/bignum.h
@@ -55,14 +55,10 @@ bignum_type bignum_quotient(bignum_type, bignum_type);
 bignum_type bignum_remainder(bignum_type, bignum_type);
 DLLEXPORT bignum_type fixnum_to_bignum(F_FIXNUM);
 DLLEXPORT bignum_type cell_to_bignum(CELL);
-DLLEXPORT bignum_type long_to_bignum(long);
 DLLEXPORT bignum_type long_long_to_bignum(s64 n);
 DLLEXPORT bignum_type ulong_long_to_bignum(u64 n);
-DLLEXPORT bignum_type ulong_to_bignum(unsigned long);
 F_FIXNUM bignum_to_fixnum(bignum_type);
 CELL bignum_to_cell(bignum_type);
-long bignum_to_long(bignum_type);
-unsigned long bignum_to_ulong(bignum_type);
 s64 bignum_to_long_long(bignum_type);
 u64 bignum_to_ulong_long(bignum_type);
 bignum_type double_to_bignum(double);
@@ -71,7 +67,7 @@ double bignum_to_double(bignum_type);
 /* Added bitwise operators. */
 
 DLLEXPORT bignum_type bignum_bitwise_not(bignum_type),
-                   bignum_arithmetic_shift(bignum_type, long),
+                   bignum_arithmetic_shift(bignum_type, F_FIXNUM),
                    bignum_bitwise_and(bignum_type, bignum_type),
                    bignum_bitwise_ior(bignum_type, bignum_type),
                    bignum_bitwise_xor(bignum_type, bignum_type);
@@ -116,7 +112,7 @@ bignum_type bignum_maybe_new_sign(bignum_type, int);
 void bignum_destructive_copy(bignum_type, bignum_type);
 
 /* Added for bitwise operations. */
-bignum_type bignum_magnitude_ash(bignum_type arg1, long n);
+bignum_type bignum_magnitude_ash(bignum_type arg1, F_FIXNUM n);
 bignum_type bignum_pospos_bitwise_op(int op, bignum_type, bignum_type);
 bignum_type bignum_posneg_bitwise_op(int op, bignum_type, bignum_type);
 bignum_type bignum_negneg_bitwise_op(int op, bignum_type, bignum_type);

From 7365959f013ee1d9757e114283943732f6ceb5df Mon Sep 17 00:00:00 2001
From: unknown <Administrator@.(none)>
Date: Fri, 7 Nov 2008 20:33:32 -0600
Subject: [PATCH 06/27] Starting work on Win64 port

---
 Makefile                                |  2 +-
 basis/alien/c-types/c-types.factor      |  2 +-
 basis/bootstrap/image/image.factor      |  2 +-
 basis/cpu/x86/32/32.factor              |  2 +
 basis/cpu/x86/32/bootstrap.factor       |  1 +
 basis/cpu/x86/64/64.factor              | 47 ++++++++++---------
 basis/cpu/x86/64/bootstrap.factor       |  2 -
 basis/cpu/x86/64/unix/bootstrap.factor  | 12 +++++
 basis/cpu/x86/64/unix/unix.factor       | 12 +++++
 basis/cpu/x86/64/winnt/bootstrap.factor | 12 +++++
 basis/cpu/x86/64/winnt/winnt.factor     | 17 +++++++
 basis/cpu/x86/bootstrap.factor          | 14 +++---
 basis/cpu/x86/x86.factor                | 10 ++--
 vm/Config.windows.nt.x86.64             |  2 +-
 vm/callstack.c                          |  2 +
 vm/cpu-x86.32.S                         |  1 +
 vm/cpu-x86.64.S                         | 61 +++++++++++++++++++------
 vm/cpu-x86.S                            | 27 ++++++-----
 vm/data_gc.c                            |  6 +++
 vm/errors.c                             |  6 +--
 vm/factor.c                             |  1 -
 vm/factor.rs                            |  4 +-
 vm/math.c                               |  4 +-
 23 files changed, 175 insertions(+), 74 deletions(-)
 create mode 100644 basis/cpu/x86/64/unix/bootstrap.factor
 create mode 100644 basis/cpu/x86/64/unix/unix.factor
 create mode 100644 basis/cpu/x86/64/winnt/bootstrap.factor
 create mode 100644 basis/cpu/x86/64/winnt/winnt.factor

diff --git a/Makefile b/Makefile
index aa520063e3..973ba1f3d4 100644
--- a/Makefile
+++ b/Makefile
@@ -170,7 +170,7 @@ vm/resources.o:
 	$(CC) -c $(CFLAGS) -o $@ $<
 
 .S.o:
-	$(CC) -c $(CFLAGS) -o $@ $<
+	$(CC) -x assembler-with-cpp -c $(CFLAGS) -o $@ $<
 
 .m.o:
 	$(CC) -c $(CFLAGS) -o $@ $<
diff --git a/basis/alien/c-types/c-types.factor b/basis/alien/c-types/c-types.factor
index 6a88441be9..a93c87611d 100644
--- a/basis/alien/c-types/c-types.factor
+++ b/basis/alien/c-types/c-types.factor
@@ -435,7 +435,7 @@ M: long-long-type box-return ( type -- )
         [ >float ] >>unboxer-quot
     "double" define-primitive-type
 
-    os winnt? cpu x86.64? and "longlong" "long" ? "ptrdiff_t" typedef
+    "long" "ptrdiff_t" typedef
 
     "ulong" "size_t" typedef
 ] with-compilation-unit
diff --git a/basis/bootstrap/image/image.factor b/basis/bootstrap/image/image.factor
index 3816b930e0..ed12054bed 100644
--- a/basis/bootstrap/image/image.factor
+++ b/basis/bootstrap/image/image.factor
@@ -25,7 +25,7 @@ IN: bootstrap.image
 : images ( -- seq )
     {
         "x86.32"
-        "x86.64"
+        "winnt-x86.64" "unix-x86.64"
         "linux-ppc" "macosx-ppc"
     } ;
 
diff --git a/basis/cpu/x86/32/32.factor b/basis/cpu/x86/32/32.factor
index 890938c6b3..82fa7a012e 100644
--- a/basis/cpu/x86/32/32.factor
+++ b/basis/cpu/x86/32/32.factor
@@ -26,6 +26,8 @@ M: x86.32 stack-reg ESP ;
 M: x86.32 temp-reg-1 EAX ;
 M: x86.32 temp-reg-2 ECX ;
 
+M: x86.32 reserved-area-size 0 ;
+
 M: x86.32 %alien-global 0 [] MOV rc-absolute-cell rel-dlsym ;
 
 M: x86.32 %alien-invoke (CALL) rel-dlsym ;
diff --git a/basis/cpu/x86/32/bootstrap.factor b/basis/cpu/x86/32/bootstrap.factor
index 37f9b3ada0..44f840e66a 100644
--- a/basis/cpu/x86/32/bootstrap.factor
+++ b/basis/cpu/x86/32/bootstrap.factor
@@ -6,6 +6,7 @@ IN: bootstrap.x86
 
 4 \ cell set
 
+: stack-frame-size ( -- n ) 4 bootstrap-cells ;
 : shift-arg ( -- reg ) ECX ;
 : div-arg ( -- reg ) EAX ;
 : mod-arg ( -- reg ) EDX ;
diff --git a/basis/cpu/x86/64/64.factor b/basis/cpu/x86/64/64.factor
index 16e7319c03..d45dd098b8 100644
--- a/basis/cpu/x86/64/64.factor
+++ b/basis/cpu/x86/64/64.factor
@@ -24,14 +24,12 @@ M: x86.64 stack-reg RSP ;
 M: x86.64 temp-reg-1 RAX ;
 M: x86.64 temp-reg-2 RCX ;
 
+: param-reg-1 int-regs param-regs first ; inline
+: param-reg-2 int-regs param-regs second ; inline
+
 M: int-regs return-reg drop RAX ;
-M: int-regs param-regs drop { RDI RSI RDX RCX R8 R9 } ;
-
 M: float-regs return-reg drop XMM0 ;
 
-M: float-regs param-regs
-    drop { XMM0 XMM1 XMM2 XMM3 XMM4 XMM5 XMM6 XMM7 } ;
-
 M: x86.64 rel-literal-x86 rc-relative rel-literal ;
 
 M: x86.64 %prologue ( n -- )
@@ -90,7 +88,7 @@ M: struct-type flatten-value-type ( type -- seq )
 
 M: x86.64 %prepare-unbox ( -- )
     ! First parameter is top of stack
-    RDI R14 [] MOV
+    param-reg-1 R14 [] MOV
     R14 cell SUB ;
 
 M: x86.64 %unbox ( n reg-class func -- )
@@ -103,27 +101,27 @@ M: x86.64 %unbox-long-long ( n func -- )
     int-regs swap %unbox ;
 
 : %unbox-struct-field ( c-type i -- )
-    ! Alien must be in RDI.
-    RDI swap cells [+] swap reg-class>> {
+    ! Alien must be in param-reg-1.
+    param-reg-1 swap cells [+] swap reg-class>> {
         { int-regs [ int-regs get pop swap MOV ] }
         { double-float-regs [ float-regs get pop swap MOVSD ] }
     } case ;
 
 M: x86.64 %unbox-small-struct ( c-type -- )
-    ! Alien must be in RDI.
+    ! Alien must be in param-reg-1.
     "alien_offset" f %alien-invoke
-    ! Move alien_offset() return value to RDI so that we don't
+    ! Move alien_offset() return value to param-reg-1 so that we don't
     ! clobber it.
-    RDI RAX MOV
+    param-reg-1 RAX MOV
     [
         flatten-small-struct [ %unbox-struct-field ] each-index
     ] with-return-regs ;
 
 M: x86.64 %unbox-large-struct ( n c-type -- )
-    ! Source is in RDI
+    ! Source is in param-reg-1
     heap-size
     ! Load destination address
-    RSI rot stack@ LEA
+    param-reg-2 rot stack@ LEA
     ! Load structure size
     RDX swap MOV
     ! Copy the struct to the C stack
@@ -160,8 +158,8 @@ M: x86.64 %box-small-struct ( c-type -- )
     [
         [ flatten-small-struct [ %box-struct-field ] each-index ]
         [ RDX swap heap-size MOV ] bi
-        RDI 0 box-struct-field@ MOV
-        RSI 1 box-struct-field@ MOV
+        param-reg-1 0 box-struct-field@ MOV
+        param-reg-2 1 box-struct-field@ MOV
         "box_small_struct" f %alien-invoke
     ] with-return-regs ;
 
@@ -170,9 +168,9 @@ M: x86.64 %box-small-struct ( c-type -- )
 
 M: x86.64 %box-large-struct ( n c-type -- )
     ! Struct size is parameter 2
-    RSI swap heap-size MOV
+    param-reg-2 swap heap-size MOV
     ! Compute destination address
-    RDI swap struct-return@ LEA
+    param-reg-1 swap struct-return@ LEA
     ! Copy the struct from the C stack
     "box_value_struct" f %alien-invoke ;
 
@@ -200,7 +198,7 @@ M: x86.64 %alien-indirect ( -- )
     RBP CALL ;
 
 M: x86.64 %alien-callback ( quot -- )
-    RDI swap %load-indirect
+    param-reg-1 swap %load-indirect
     "c_to_factor" f %alien-invoke ;
 
 M: x86.64 %callback-value ( ctype -- )
@@ -208,11 +206,11 @@ M: x86.64 %callback-value ( ctype -- )
     %prepare-unbox
     ! Save top of data stack
     RSP 8 SUB
-    RDI PUSH
+    param-reg-1 PUSH
     ! Restore data/call/retain stacks
     "unnest_stacks" f %alien-invoke
-    ! Put former top of data stack in RDI
-    RDI POP
+    ! Put former top of data stack in param-reg-1
+    param-reg-1 POP
     RSP 8 ADD
     ! Unbox former top of data stack to return registers
     unbox-return ;
@@ -223,3 +221,10 @@ enable-alien-4-intrinsics
 
 ! SSE2 is always available on x86-64.
 enable-float-intrinsics
+
+USE: vocabs.loader
+
+{
+    { [ os unix? ] [ "cpu.x86.64.unix" require ] }
+    { [ os winnt? ] [ "cpu.x86.64.winnt" require ] }
+} cond
diff --git a/basis/cpu/x86/64/bootstrap.factor b/basis/cpu/x86/64/bootstrap.factor
index c1f5156178..acac8b55bc 100644
--- a/basis/cpu/x86/64/bootstrap.factor
+++ b/basis/cpu/x86/64/bootstrap.factor
@@ -9,8 +9,6 @@ IN: bootstrap.x86
 : shift-arg ( -- reg ) RCX ;
 : div-arg ( -- reg ) RAX ;
 : mod-arg ( -- reg ) RDX ;
-: arg0 ( -- reg ) RDI ;
-: arg1 ( -- reg ) RSI ;
 : temp-reg ( -- reg ) RBX ;
 : stack-reg ( -- reg ) RSP ;
 : ds-reg ( -- reg ) R14 ;
diff --git a/basis/cpu/x86/64/unix/bootstrap.factor b/basis/cpu/x86/64/unix/bootstrap.factor
new file mode 100644
index 0000000000..a42353fabd
--- /dev/null
+++ b/basis/cpu/x86/64/unix/bootstrap.factor
@@ -0,0 +1,12 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: bootstrap.image.private kernel namespaces system
+cpu.x86.assembler layouts vocabs parser ;
+IN: bootstrap.x86
+
+: stack-frame-size ( -- n ) 4 bootstrap-cells ;
+: arg0 ( -- reg ) RDI ;
+: arg1 ( -- reg ) RSI ;
+
+<< "resource:basis/cpu/x86/64/bootstrap.factor" parsed-file parsed >>
+call
diff --git a/basis/cpu/x86/64/unix/unix.factor b/basis/cpu/x86/64/unix/unix.factor
new file mode 100644
index 0000000000..9e70ada5d0
--- /dev/null
+++ b/basis/cpu/x86/64/unix/unix.factor
@@ -0,0 +1,12 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel layouts system compiler.cfg.registers
+cpu.architecture cpu.x86.assembler ;
+IN: cpu.x86.64.unix
+
+M: int-regs param-regs drop { RDI RSI RDX RCX R8 R9 } ;
+
+M: float-regs param-regs
+    drop { XMM0 XMM1 XMM2 XMM3 XMM4 XMM5 XMM6 XMM7 } ;
+
+M: x86.64 reserved-area-size 0 ;
diff --git a/basis/cpu/x86/64/winnt/bootstrap.factor b/basis/cpu/x86/64/winnt/bootstrap.factor
new file mode 100644
index 0000000000..a62b946e83
--- /dev/null
+++ b/basis/cpu/x86/64/winnt/bootstrap.factor
@@ -0,0 +1,12 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: bootstrap.image.private kernel namespaces system
+cpu.x86.assembler layouts vocabs parser ;
+IN: bootstrap.x86
+
+: stack-frame-size ( -- n ) 8 bootstrap-cells ;
+: arg0 ( -- reg ) RCX ;
+: arg1 ( -- reg ) RDX ;
+
+<< "resource:basis/cpu/x86/64/bootstrap.factor" parse-file parsed >>
+call
diff --git a/basis/cpu/x86/64/winnt/winnt.factor b/basis/cpu/x86/64/winnt/winnt.factor
new file mode 100644
index 0000000000..d4c092f63d
--- /dev/null
+++ b/basis/cpu/x86/64/winnt/winnt.factor
@@ -0,0 +1,17 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel layouts system alien.c-types compiler.cfg.registers
+cpu.architecture cpu.x86.assembler cpu.x86 ;
+IN: cpu.x86.64.winnt
+
+M: int-regs param-regs drop { RCX RDX R8 R9 } ;
+
+M: float-regs param-regs drop { XMM0 XMM1 XMM2 XMM3 } ;
+
+M: x86.64 reserved-area-size 4 cells ;
+
+<<
+"longlong" "ptrdiff_t" typedef
+"int" "long" typedef
+"uint" "ulong" typedef
+>>
diff --git a/basis/cpu/x86/bootstrap.factor b/basis/cpu/x86/bootstrap.factor
index d2ff9a5928..6dadbc096c 100644
--- a/basis/cpu/x86/bootstrap.factor
+++ b/basis/cpu/x86/bootstrap.factor
@@ -10,8 +10,6 @@ big-endian off
 
 1 jit-code-format set
 
-: stack-frame-size ( -- n ) 4 bootstrap-cells ;
-
 [
     ! Load word
     temp-reg 0 MOV
@@ -30,7 +28,7 @@ big-endian off
     temp-reg 0 MOV                             ! load XT
     stack-frame-size PUSH                      ! save stack frame size
     temp-reg PUSH                              ! push XT
-    arg1 PUSH                                  ! alignment
+    stack-reg stack-frame-size 3 bootstrap-cells - SUB   ! alignment
 ] rc-absolute-cell rt-label 1 rex-length + jit-prolog jit-define
 
 [
@@ -302,14 +300,14 @@ big-endian off
     shift-arg ds-reg [] MOV                    ! load shift count
     shift-arg tag-bits get SAR                 ! untag shift count
     ds-reg bootstrap-cell SUB                  ! adjust stack pointer
-    arg0 ds-reg [] MOV                         ! load value
-    arg1 arg0 MOV                              ! make a copy
+    temp-reg ds-reg [] MOV                     ! load value
+    arg1 temp-reg MOV                          ! make a copy
     arg1 CL SHL                                ! compute positive shift value in arg1
     shift-arg NEG                              ! compute negative shift value in arg0
-    arg0 CL SAR
-    arg0 tag-mask get bitnot AND
+    temp-reg CL SAR
+    temp-reg tag-mask get bitnot AND
     shift-arg 0 CMP                            ! if shift count was negative, move arg0 to arg1
-    arg1 arg0 CMOVGE
+    arg1 temp-reg CMOVGE
     ds-reg [] arg1 MOV                         ! push to stack
 ] f f f \ fixnum-shift-fast define-sub-primitive
 
diff --git a/basis/cpu/x86/x86.factor b/basis/cpu/x86/x86.factor
index 8ae3bddfaa..55675a5e42 100644
--- a/basis/cpu/x86/x86.factor
+++ b/basis/cpu/x86/x86.factor
@@ -39,12 +39,15 @@ M: x86 %inc-r ( n -- ) rs-reg (%inc) ;
 : align-stack ( n -- n' )
     os macosx? cpu x86.64? or [ 16 align ] when ;
 
+HOOK: reserved-area-size cpu ( -- n )
+
 M: x86 stack-frame-size ( stack-frame -- i )
     [ spill-counts>> [ swap reg-size * ] { } assoc>map sum ]
     [ params>> ]
     [ return>> ]
     tri + +
     3 cells +
+    reserved-area-size +
     align-stack ;
 
 M: x86 %call ( label -- ) CALL ;
@@ -465,7 +468,7 @@ M: x86 %compare-float-branch ( label cc src1 src2 -- )
 : stack@ ( n -- op ) stack-reg swap [+] ;
 
 : spill-integer-base ( stack-frame -- n )
-    [ params>> ] [ return>> ] bi + ;
+    [ params>> ] [ return>> ] bi + reserved-area-size + ;
 
 : spill-integer@ ( n -- op )
     cells
@@ -473,10 +476,9 @@ M: x86 %compare-float-branch ( label cc src1 src2 -- )
     + stack@ ;
 
 : spill-float-base ( stack-frame -- n )
+    [ spill-integer-base ]
     [ spill-counts>> int-regs swap at int-regs reg-size * ]
-    [ params>> ]
-    [ return>> ]
-    tri + + ;
+    bi + ;
 
 : spill-float@ ( n -- op )
     double-float-regs reg-size *
diff --git a/vm/Config.windows.nt.x86.64 b/vm/Config.windows.nt.x86.64
index 6d3865c2f4..3ede556171 100644
--- a/vm/Config.windows.nt.x86.64
+++ b/vm/Config.windows.nt.x86.64
@@ -1,5 +1,5 @@
 #WIN64_PATH=/k/MinGW/win64/bin
-WIN64_PATH=/cygdrive/k/MinGW/win64/bin/x86_64-pc-mingw32
+#WIN64_PATH=/cygdrive/k/MinGW/win64/bin/x86_64-pc-mingw32
 CC=$(WIN64_PATH)-gcc.exe
 WINDRES=$(WIN64_PATH)-windres.exe
 include vm/Config.windows.nt
diff --git a/vm/callstack.c b/vm/callstack.c
index df4063d149..c9466bbbb2 100755
--- a/vm/callstack.c
+++ b/vm/callstack.c
@@ -116,6 +116,8 @@ CELL frame_executing(F_STACK_FRAME *frame)
 
 F_STACK_FRAME *frame_successor(F_STACK_FRAME *frame)
 {
+	if(frame->size == 0)
+		critical_error("Stack frame has zero size",frame);
 	return (F_STACK_FRAME *)((CELL)frame - frame->size);
 }
 
diff --git a/vm/cpu-x86.32.S b/vm/cpu-x86.32.S
index d903f8013d..e0e674a7e2 100755
--- a/vm/cpu-x86.32.S
+++ b/vm/cpu-x86.32.S
@@ -11,6 +11,7 @@ and the callstack top is passed in EDX */
 #define RETURN_REG %eax
 
 #define CELL_SIZE 4
+#define STACK_PADDING 12
 
 #define PUSH_NONVOLATILE \
 	push %ebx ; \
diff --git a/vm/cpu-x86.64.S b/vm/cpu-x86.64.S
index 57bfcee87b..15a4eb8da3 100644
--- a/vm/cpu-x86.64.S
+++ b/vm/cpu-x86.64.S
@@ -1,24 +1,55 @@
 #include "asm.h"
 
-#define ARG0 %rdi
-#define ARG1 %rsi
 #define STACK_REG %rsp
 #define DS_REG %r14
 #define RETURN_REG %rax
 
 #define CELL_SIZE 8
+#define STACK_PADDING 56
 
-#define PUSH_NONVOLATILE \
-	push %rbx ; \
-	push %rbp ; \
-	push %r12 ; \
-	push %r13 ;
+#ifdef WINDOWS
 
-#define POP_NONVOLATILE \
-	pop %r13 ; \
-	pop %r12 ; \
-	pop %rbp ; \
-	pop %rbx
+	#define ARG0 %rcx
+	#define ARG1 %rdx
+	#define ARG2 %r8
+	#define ARG3 %r9
+
+	#define PUSH_NONVOLATILE \
+		push %r12 ; \
+		push %r13 ; \
+		push %rdi ; \
+		push %rsi ; \
+		push %rbx ; \
+		push %rbp
+
+	#define POP_NONVOLATILE \
+		pop %rbp ; \
+		pop %rbx ; \
+		pop %rsi ; \
+		pop %rdi ; \
+		pop %r13 ; \
+		pop %r12
+
+#else
+
+	#define ARG0 %rdi
+	#define ARG1 %rsi
+	#define ARG2 %rdx
+	#define ARG3 %rcx
+
+	#define PUSH_NONVOLATILE \
+		push %rbx ; \
+		push %rbp ; \
+		push %r12 ; \
+		push %r13
+
+	#define POP_NONVOLATILE \
+		pop %r13 ; \
+		pop %r12 ; \
+		pop %rbp ; \
+		pop %rbx
+
+#endif
 
 #define QUOT_XT_OFFSET 21
 
@@ -26,9 +57,9 @@
 ABI limitation which would otherwise require us to do a bizzaro PC-relative
 trampoline to retrieve the function address */
 DEF(void,set_callstack,(F_STACK_FRAME *to, F_STACK_FRAME *from, CELL length, void *memcpy)):
-	sub %rdx,%rdi                      /* compute new stack pointer */
-	mov %rdi,%rsp
-	call *%rcx                         /* call memcpy */
+	sub ARG2,ARG0                      /* compute new stack pointer */
+	mov ARG0,%rsp
+	call *ARG3                         /* call memcpy */
 	ret                                /* return _with new stack_ */
 
 #include "cpu-x86.S"
diff --git a/vm/cpu-x86.S b/vm/cpu-x86.S
index e8e2af7b25..3d6cacdebd 100755
--- a/vm/cpu-x86.S
+++ b/vm/cpu-x86.S
@@ -1,31 +1,34 @@
 DEF(F_FASTCALL void,c_to_factor,(CELL quot)):
 	PUSH_NONVOLATILE
-	push ARG0                             /* Save quot */
+	push ARG0
 
-	lea -CELL_SIZE(STACK_REG),ARG0        /* Save stack pointer */
+	/* Save stack pointer */
+	lea -CELL_SIZE(STACK_REG),ARG0      
+
+	/* Create register shadow area for Win64 */
+	sub $32,STACK_REG                    
 	call MANGLE(save_callstack_bottom)
+	add $32,STACK_REG
 
-	mov (STACK_REG),ARG0                  /* Pass quot as arg 1 */
-	call *QUOT_XT_OFFSET(ARG0)            /* Call quot-xt */
+	/* Call quot-xt */
+	mov (STACK_REG),ARG0
+	call *QUOT_XT_OFFSET(ARG0)
 
-	POP ARG0
+	pop ARG0
 	POP_NONVOLATILE
 	ret
 
 DEF(F_FASTCALL void,throw_impl,(CELL quot, F_STACK_FRAME *rewind_to)):
-	mov ARG1,STACK_REG                    /* rewind_to */
+	/* rewind_to */
+	mov ARG1,STACK_REG                    
 	jmp *QUOT_XT_OFFSET(ARG0)
 
 DEF(FASTCALL void,lazy_jit_compile,(CELL quot)):
 	mov STACK_REG,ARG1           /* Save stack pointer */
-	push ARG1                    /* Alignment */
-	push ARG1
-	push ARG1
+	sub $STACK_PADDING,STACK_REG
 	call MANGLE(primitive_jit_compile)
 	mov RETURN_REG,ARG0          /* No-op on 32-bit */
-	pop ARG1                     /* OK to clobber ARG1 here */
-	pop ARG1
-	pop ARG1
+	add $STACK_PADDING,STACK_REG
         jmp *QUOT_XT_OFFSET(ARG0)    /* Call the quotation */
 
 #ifdef WINDOWS
diff --git a/vm/data_gc.c b/vm/data_gc.c
index 9aa4f88de6..5342ff04d9 100755
--- a/vm/data_gc.c
+++ b/vm/data_gc.c
@@ -438,6 +438,8 @@ void collect_gen_cards(CELL gen)
 old->new references */
 void collect_cards(void)
 {
+	GC_PRINT("Collect cards\n");
+
 	int i;
 	for(i = collecting_gen + 1; i < data_heap->gen_count; i++)
 		collect_gen_cards(i);
@@ -465,7 +467,10 @@ void collect_callstack(F_CONTEXT *stacks)
 	{
 		CELL top = (CELL)stacks->callstack_top;
 		CELL bottom = (CELL)stacks->callstack_bottom;
+
+		GC_PRINT("Collect callstack %ld %ld\n",top,bottom);
 		iterate_callstack(top,bottom,collect_stack_frame);
+		GC_PRINT("Done\n");
 	}
 }
 
@@ -481,6 +486,7 @@ void collect_gc_locals(void)
 the user environment and extra roots registered with REGISTER_ROOT */
 void collect_roots(void)
 {
+	GC_PRINT("Collect roots\n");
 	copy_handle(&T);
 	copy_handle(&bignum_zero);
 	copy_handle(&bignum_pos_one);
diff --git a/vm/errors.c b/vm/errors.c
index 7a23e3e53f..36072920fe 100755
--- a/vm/errors.c
+++ b/vm/errors.c
@@ -129,17 +129,17 @@ void divide_by_zero_error(F_STACK_FRAME *native_stack)
 
 void memory_signal_handler_impl(void)
 {
-    memory_protection_error(signal_fault_addr,signal_callstack_top);
+	memory_protection_error(signal_fault_addr,signal_callstack_top);
 }
 
 void divide_by_zero_signal_handler_impl(void)
 {
-    divide_by_zero_error(signal_callstack_top);
+	divide_by_zero_error(signal_callstack_top);
 }
 
 void misc_signal_handler_impl(void)
 {
-    signal_error(signal_number,signal_callstack_top);
+	signal_error(signal_number,signal_callstack_top);
 }
 
 DEFINE_PRIMITIVE(throw)
diff --git a/vm/factor.c b/vm/factor.c
index e81152bd99..c8b07cba64 100755
--- a/vm/factor.c
+++ b/vm/factor.c
@@ -167,7 +167,6 @@ void init_factor_from_args(F_CHAR *image, int argc, F_CHAR **argv, bool embedded
 	}
 
 	init_factor(&p);
-
 	nest_stacks();
 
 	F_ARRAY *args = allot_array(ARRAY_TYPE,argc,F);
diff --git a/vm/factor.rs b/vm/factor.rs
index 5b983cacba..47f899fef6 100644
--- a/vm/factor.rs
+++ b/vm/factor.rs
@@ -1,2 +1,2 @@
-fraptor ICON "misc/icons/Factor.ico"
-
+fraptor ICON "misc/icons/Factor.ico"
+
diff --git a/vm/math.c b/vm/math.c
index c7c5dba5a4..7d3b64ed39 100644
--- a/vm/math.c
+++ b/vm/math.c
@@ -363,13 +363,13 @@ CELL unbox_array_size(void)
 	case BIGNUM_TYPE:
 		{
 			bignum_type zero = untag_object(bignum_zero);
-			bignum_type max = ulong_to_bignum(ARRAY_SIZE_MAX);
+			bignum_type max = cell_to_bignum(ARRAY_SIZE_MAX);
 			bignum_type n = untag_object(dpeek());
 			if(bignum_compare(n,zero) != bignum_comparison_less
 				&& bignum_compare(n,max) == bignum_comparison_less)
 			{
 				dpop();
-				return bignum_to_ulong(n);
+				return bignum_to_cell(n);
 			}
 			break;
 		}

From cc7ab1188104e36f48d0119df249f0b91fa5dac6 Mon Sep 17 00:00:00 2001
From: unknown <Administrator@.(none)>
Date: Fri, 7 Nov 2008 20:34:04 -0600
Subject: [PATCH 07/27] Add more unit tests

---
 basis/math/functions/functions-tests.factor | 19 +++++++++++++++++++
 core/math/integers/integers-tests.factor    |  5 +++++
 2 files changed, 24 insertions(+)

diff --git a/basis/math/functions/functions-tests.factor b/basis/math/functions/functions-tests.factor
index d5bdac761f..cbaf37daf8 100644
--- a/basis/math/functions/functions-tests.factor
+++ b/basis/math/functions/functions-tests.factor
@@ -76,6 +76,25 @@ IN: math.functions.tests
     gcd nip
 ] unit-test
 
+[ 11 ] [
+    13262642990609552931815424
+    159151715887314635181785
+    gcd nip
+] unit-test
+
+[ 3 ] [
+    13262642990609552931
+    1591517158873146351
+    gcd nip
+] unit-test
+
+[ 26525285981219 ] [
+    132626429906095
+    159151715887314
+    gcd nip
+] unit-test
+
+
 : verify-gcd ( a b -- ? )
     2dup gcd
     >r rot * swap rem r> = ; 
diff --git a/core/math/integers/integers-tests.factor b/core/math/integers/integers-tests.factor
index f428df33ae..5a649120a0 100644
--- a/core/math/integers/integers-tests.factor
+++ b/core/math/integers/integers-tests.factor
@@ -101,8 +101,13 @@ unit-test
 [ 268435456 ] [ -268435456 >fixnum -1 /i ] unit-test
 [ 268435456 0 ] [ -268435456 >fixnum -1 /mod ] unit-test
 [ 0 ] [ -1 -268435456 >fixnum /i ] unit-test
+[ 4420880996869850977 ] [ 13262642990609552931 3 /i ] unit-test
 [ 0 -1 ] [ -1 -268435456 >fixnum /mod ] unit-test
+[ 0 -1 ] [ -1 -268435456 >bignum /mod ] unit-test
 [ 14355 ] [ 1591517158873146351817850880000000 32769 mod ] unit-test
+[ 8 530505719624382123 ] [ 13262642990609552931 1591517158873146351 /mod ] unit-test
+[ 8 ] [ 13262642990609552931 1591517158873146351 /i ] unit-test
+[ 530505719624382123 ] [ 13262642990609552931 1591517158873146351 mod ] unit-test
 
 [ -351382792 ] [ -43922849 3 shift ] unit-test
 

From 78eeaddcf2e6071e439833f25552a20ec47f2a3d Mon Sep 17 00:00:00 2001
From: unknown <Administrator@.(none)>
Date: Fri, 7 Nov 2008 20:34:26 -0600
Subject: [PATCH 08/27] Add winnt-x86.64 boot image name

---
 core/bootstrap/primitives.factor | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/core/bootstrap/primitives.factor b/core/bootstrap/primitives.factor
index 3accb8a9b8..24faf81662 100644
--- a/core/bootstrap/primitives.factor
+++ b/core/bootstrap/primitives.factor
@@ -20,7 +20,8 @@ H{ } clone sub-primitives set
 
 "resource:basis/cpu/" architecture get {
     { "x86.32" "x86/32" }
-    { "x86.64" "x86/64" }
+    { "winnt-x86.64" "x86/64/winnt" }
+    { "unix-x86.64" "x86/64/unix" }
     { "linux-ppc" "ppc/linux" }
     { "macosx-ppc" "ppc/macosx" }
     { "arm" "arm" }

From 639da2d33541ae7b7ac0b49e5205d61e440e00be Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 7 Nov 2008 20:45:25 -0600
Subject: [PATCH 09/27] Refactor OS-specific parts of PowerPC backend

---
 basis/cpu/ppc/linux/linux.factor   |  19 ++++
 basis/cpu/ppc/linux/tags.txt       |   1 +
 basis/cpu/ppc/macosx/macosx.factor |  20 ++++
 basis/cpu/ppc/macosx/tags.txt      |   1 +
 basis/cpu/ppc/ppc.factor           | 144 +++++++++++------------------
 5 files changed, 95 insertions(+), 90 deletions(-)
 create mode 100644 basis/cpu/ppc/linux/linux.factor
 create mode 100644 basis/cpu/ppc/linux/tags.txt
 create mode 100644 basis/cpu/ppc/macosx/macosx.factor
 create mode 100644 basis/cpu/ppc/macosx/tags.txt

diff --git a/basis/cpu/ppc/linux/linux.factor b/basis/cpu/ppc/linux/linux.factor
new file mode 100644
index 0000000000..d92709a399
--- /dev/null
+++ b/basis/cpu/ppc/linux/linux.factor
@@ -0,0 +1,19 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors system kernel alien.c-types cpu.architecture cpu.ppc ;
+IN: cpu.ppc.linux
+
+<<
+t "longlong" c-type (>>stack-align?)
+t "ulonglong" c-type (>>stack-align?)
+>>
+
+M: linux reserved-area-size 2 ;
+
+M: linux lr-save 1 ;
+
+M: float-regs param-regs { 1 2 3 4 5 6 7 8 } ;
+
+M: ppc value-structs? drop f ;
+
+M: ppc fp-shadows-int? drop f ;
diff --git a/basis/cpu/ppc/linux/tags.txt b/basis/cpu/ppc/linux/tags.txt
new file mode 100644
index 0000000000..6bf68304bb
--- /dev/null
+++ b/basis/cpu/ppc/linux/tags.txt
@@ -0,0 +1 @@
+unportable
diff --git a/basis/cpu/ppc/macosx/macosx.factor b/basis/cpu/ppc/macosx/macosx.factor
new file mode 100644
index 0000000000..1e0a6caca0
--- /dev/null
+++ b/basis/cpu/ppc/macosx/macosx.factor
@@ -0,0 +1,20 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors system kernel alien.c-types cpu.architecture cpu.ppc ;
+IN: cpu.ppc.macosx
+
+<<
+4 "longlong" c-type (>>align)
+4 "ulonglong" c-type (>>align)
+4 "double" c-type (>>align)
+>>
+
+M: macosx reserved-area-size 6 ;
+
+M: macosx lr-save 2 ;
+
+M: float-regs param-regs { 1 2 3 4 5 6 7 8 9 10 11 12 13 } ;
+
+M: ppc value-structs? drop t ;
+
+M: ppc fp-shadows-int? drop t ;
diff --git a/basis/cpu/ppc/macosx/tags.txt b/basis/cpu/ppc/macosx/tags.txt
new file mode 100644
index 0000000000..6bf68304bb
--- /dev/null
+++ b/basis/cpu/ppc/macosx/tags.txt
@@ -0,0 +1 @@
+unportable
diff --git a/basis/cpu/ppc/ppc.factor b/basis/cpu/ppc/ppc.factor
index b60fd47b89..d2d1e26396 100644
--- a/basis/cpu/ppc/ppc.factor
+++ b/basis/cpu/ppc/ppc.factor
@@ -4,8 +4,7 @@ USING: accessors assocs sequences kernel combinators make math
 math.order math.ranges system namespaces locals layouts words
 alien alien.c-types cpu.architecture cpu.ppc.assembler
 compiler.cfg.registers compiler.cfg.instructions
-compiler.constants compiler.codegen compiler.codegen.fixup
-compiler.cfg.intrinsics compiler.cfg.stack-frame ;
+compiler.constants compiler.codegen compiler.codegen.fixup ;
 IN: cpu.ppc
 
 ! PowerPC register assignments:
@@ -16,31 +15,15 @@ IN: cpu.ppc
 ! f0-f29: float vregs
 ! f30, f31: float scratch
 
-<< {
-    { [ os macosx? ] [
-        4 "longlong" c-type (>>align)
-        4 "ulonglong" c-type (>>align)
-        4 "double" c-type (>>align)
-    ] }
-    { [ os linux? ] [
-        t "longlong" c-type (>>stack-align?)
-        t "ulonglong" c-type (>>stack-align?)
-    ] }
-} cond
-
-enable-float-intrinsics
-
-\ ##integer>float t frame-required? set-word-prop
-\ ##float>integer t frame-required? set-word-prop >>
-
 M: ppc machine-registers
     {
         { int-regs T{ range f 2 26 1 } }
-        { double-float-regs T{ range f 0 29 1 } }
+        { double-float-regs T{ range f 0 28 1 } }
     } ;
 
 : scratch-reg 28 ; inline
-: fp-scratch-reg 30 ; inline
+: fp-scratch-reg-1 29 ; inline
+: fp-scratch-reg-2 30 ; inline
 
 M: ppc two-operand? f ;
 
@@ -70,21 +53,9 @@ M: ppc %replace loc>operand STW ;
 M: ppc %inc-d ( n -- ) ds-reg (%inc) ;
 M: ppc %inc-r ( n -- ) rs-reg (%inc) ;
 
-: reserved-area-size ( -- n )
-    os {
-        { linux [ 2 ] }
-        { macosx [ 6 ] }
-    } case cells ; foldable
+HOOK: reserved-area-size os ( -- n )
+HOOK: lr-save os ( -- n )
 
-! The start of the stack frame contains the size of this frame
-! as well as the currently executing XT
-: factor-area-size ( -- n ) 2 cells ; foldable
-: next-save ( n -- i ) cell - ;
-: xt-save ( n -- i ) 2 cells - ;
-
-! Next, we have the spill area as well as the FFI parameter area.
-! They overlap, since basic blocks with FFI calls will never
-! spill.
 : param@ ( n -- x ) reserved-area-size + ; inline
 
 : param-save-size ( -- n ) 8 cells ; foldable
@@ -92,38 +63,19 @@ M: ppc %inc-r ( n -- ) rs-reg (%inc) ;
 : local@ ( n -- x )
     reserved-area-size param-save-size + + ; inline
 
-: spill-integer-base ( -- n )
-    stack-frame get spill-counts>> double-float-regs swap at
-    double-float-regs reg-size * ;
+: factor-area-size ( -- n ) 2 cells ; foldable
 
-: spill-integer@ ( n -- offset )
-    cells spill-integer-base + param@ ;
+: next-save ( n -- i ) cell - ;
 
-: spill-float@ ( n -- offset )
-    double-float-regs reg-size * param@ ;
-
-! Some FP intrinsics need a temporary scratch area in the stack
-! frame, 8 bytes in size
-: scratch@ ( n -- offset )
-   stack-frame get total-size>>
-   factor-area-size -
-   param-save-size -
-   + ;
-
-! Finally we have the linkage area
-: lr-save ( -- n )
-    os {
-        { linux [ 1 ] }
-        { macosx [ 2 ] }
-    } case cells ; foldable
+: xt-save ( n -- i ) 2 cells - ;
 
 M: ppc stack-frame-size ( stack-frame -- i )
     [ spill-counts>> [ swap reg-size * ] { } assoc>map sum ]
     [ params>> ]
     [ return>> ]
     tri + +
-    param-save-size +
     reserved-area-size +
+    param-save-size +
     factor-area-size +
     4 cells align ;
 
@@ -246,19 +198,19 @@ M: ppc %div-float FDIV ;
 
 M:: ppc %integer>float ( dst src -- )
     HEX: 4330 scratch-reg LIS
-    scratch-reg 1 0 scratch@ STW
+    scratch-reg 1 0 param@ STW
     scratch-reg src MR
     scratch-reg dup HEX: 8000 XORIS
-    scratch-reg 1 4 scratch@ STW
-    dst 1 0 scratch@ LFD
+    scratch-reg 1 cell param@ STW
+    fp-scratch-reg-2 1 0 param@ LFD
     scratch-reg 4503601774854144.0 %load-indirect
-    fp-scratch-reg scratch-reg float-offset LFD
-    dst dst fp-scratch-reg FSUB ;
+    fp-scratch-reg-2 scratch-reg float-offset LFD
+    fp-scratch-reg-2 fp-scratch-reg-2 fp-scratch-reg-2 FSUB ;
 
 M:: ppc %float>integer ( dst src -- )
-    fp-scratch-reg src FCTIWZ
-    fp-scratch-reg 1 0 scratch@ STFD
-    dst 1 4 scratch@ LWZ ;
+    fp-scratch-reg-1 src FCTIWZ
+    fp-scratch-reg-2 1 0 param@ STFD
+    dst 1 4 param@ LWZ ;
 
 M: ppc %copy ( dst src -- ) MR ;
 
@@ -266,10 +218,6 @@ M: ppc %copy-float ( dst src -- ) FMR ;
 
 M: ppc %unbox-float ( dst src -- ) float-offset LFD ;
 
-M:: ppc %box-float ( dst src temp -- )
-    dst 16 float temp %allot
-    src dst float-offset STFD ;
-
 M:: ppc %unbox-any-c-ptr ( dst src temp -- )
     [
         { "is-byte-array" "end" "start" } [ define-label ] each
@@ -401,12 +349,12 @@ M: ppc %gc
     "end" resolve-label ;
 
 M: ppc %prologue ( n -- )
-    0 11 LOAD32 rc-absolute-ppc-2/2 rel-this
+    0 scratch-reg LOAD32 rc-absolute-ppc-2/2 rel-this
     0 MFLR
     1 1 pick neg ADDI
-    11 1 pick xt-save STW
-    dup 11 LI
-    11 1 pick next-save STW
+    scratch-reg 1 pick xt-save STW
+    dup scratch-reg LI
+    scratch-reg 1 pick next-save STW
     0 1 rot lr-save + STW ;
 
 M: ppc %epilogue ( n -- )
@@ -457,22 +405,38 @@ M: ppc %compare-branch (%compare) %branch ;
 M: ppc %compare-imm-branch (%compare-imm) %branch ;
 M: ppc %compare-float-branch (%compare-float) %branch ;
 
-M: ppc %spill-integer ( src n -- ) spill-integer@ 1 swap STW ;
-M: ppc %reload-integer ( dst n -- ) spill-integer@ 1 swap LWZ ;
+: spill-integer-base ( stack-frame -- n )
+    [ params>> ] [ return>> ] bi + ;
 
-M: ppc %spill-float ( src n -- ) spill-float@ 1 swap STFD ;
-M: ppc %reload-float ( dst n -- ) spill-float@ 1 swap LFD ;
+: stack@ 1 swap ; inline
+
+: spill-integer@ ( n -- reg offset )
+    cells
+    stack-frame get spill-integer-base
+    + stack@ ;
+
+: spill-float-base ( stack-frame -- n )
+    [ spill-counts>> int-regs swap at int-regs reg-size * ]
+    [ params>> ]
+    [ return>> ]
+    tri + + ;
+
+: spill-float@ ( n -- reg offset )
+    double-float-regs reg-size *
+    stack-frame get spill-float-base
+    + stack@ ;
+
+M: ppc %spill-integer ( src n -- ) spill-integer@ STW ;
+M: ppc %reload-integer ( dst n -- ) spill-integer@ LWZ ;
+
+M: ppc %spill-float ( src n -- ) spill-float@ STFD ;
+M: ppc %reload-float ( dst n -- ) spill-float@ LFD ;
 
 M: ppc %loop-entry ;
 
 M: int-regs return-reg drop 3 ;
 M: int-regs param-regs drop { 3 4 5 6 7 8 9 10 } ;
 M: float-regs return-reg drop 1 ;
-M: float-regs param-regs 
-    drop os H{
-        { macosx { 1 2 3 4 5 6 7 8 9 10 11 12 13 } }
-        { linux { 1 2 3 4 5 6 7 8 } }
-    } at ;
 
 M: int-regs %save-param-reg drop 1 rot local@ STW ;
 M: int-regs %load-param-reg drop 1 rot local@ LWZ ;
@@ -595,13 +559,6 @@ M: ppc %callback-value ( ctype -- )
     ! Unbox former top of data stack to return registers
     unbox-return ;
 
-M: ppc value-structs?
-    #! On Linux/PPC, value structs are passed in the same way
-    #! as reference structs, we just have to make a copy first.
-    os linux? not ;
-
-M: ppc fp-shadows-int? ( -- ? ) os macosx? ;
-
 M: ppc small-enough? ( n -- ? ) -32768 32767 between? ;
 
 M: ppc struct-small-enough? ( size -- ? ) drop f ;
@@ -611,3 +568,10 @@ M: ppc %box-small-struct
 
 M: ppc %unbox-small-struct
     drop "No small structs" throw ;
+
+USE: vocabs.loader
+
+{
+    { [ os macosx? ] [ "cpu.ppc.macosx" require ] }
+    { [ os linux? ] [ "cpu.ppc.linux" require ] }
+} cond

From 1b744ab14b54f7be631e11b1daff300bb103d589 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 7 Nov 2008 21:09:42 -0600
Subject: [PATCH 10/27] Updating code for boot image renaming

---
 basis/bootstrap/image/image.factor   | 10 ++++++++--
 build-support/factor.sh              | 20 ++++++++++----------
 extra/mason/platform/platform.factor |  4 ++--
 3 files changed, 20 insertions(+), 14 deletions(-)

diff --git a/basis/bootstrap/image/image.factor b/basis/bootstrap/image/image.factor
index 3816b930e0..c556ee660f 100644
--- a/basis/bootstrap/image/image.factor
+++ b/basis/bootstrap/image/image.factor
@@ -12,9 +12,15 @@ io.encodings.binary math.order math.private accessors
 slots.private compiler.units ;
 IN: bootstrap.image
 
+: arch ( os cpu -- arch )
+    {
+        { "ppc" [ name>> "-ppc" append ] }
+        { "x86.64" [ name>> "winnt" = "winnt" "unix" ? "-x86.64" append ] }
+        [ nip ]
+    } case ;
+
 : my-arch ( -- arch )
-    cpu name>> 
-    dup "ppc" = [ >r os name>> "-" r> 3append ] when ;
+    os name>> cpu name>> arch ;
 
 : boot-image-name ( arch -- string )
     "boot." swap ".image" 3append ;
diff --git a/build-support/factor.sh b/build-support/factor.sh
index 5cbc1e96e3..07d05e29b5 100755
--- a/build-support/factor.sh
+++ b/build-support/factor.sh
@@ -271,18 +271,18 @@ check_os_arch_word() {
 set_build_info() {
     check_os_arch_word
     MAKE_TARGET=$OS-$ARCH-$WORD
-    MAKE_IMAGE_TARGET=$ARCH.$WORD
-    BOOT_IMAGE=boot.$ARCH.$WORD.image
     if [[ $OS == macosx && $ARCH == ppc ]] ; then
-        MAKE_IMAGE_TARGET=$OS-$ARCH
-        MAKE_TARGET=$OS-$ARCH
-        BOOT_IMAGE=boot.macosx-ppc.image
-    fi
-    if [[ $OS == linux && $ARCH == ppc ]] ; then
-        MAKE_IMAGE_TARGET=$OS-$ARCH
-        MAKE_TARGET=$OS-$ARCH
-        BOOT_IMAGE=boot.linux-ppc.image
+        MAKE_IMAGE_TARGET=macosx-ppc
+    elif [[ $OS == linux && $ARCH == ppc ]] ; then
+        MAKE_IMAGE_TARGET=linux-ppc
+    elif [[ $OS == winnt && $ARCH == x86 && $WORD == 64 ]] ; then
+        MAKE_IMAGE_TARGET=winnt-x86.64
+    elif [[ $ARCH == x86 && $WORD == 64 ]] ; then
+        MAKE_IMAGE_TARGET=unix-x86.64
+	else
+        MAKE_IMAGE_TARGET=$ARCH.$WORD
     fi
+    BOOT_IMAGE_NAME=boot.$MAKE_IMAGE_TARGET.image
 }
 
 parse_build_info() {
diff --git a/extra/mason/platform/platform.factor b/extra/mason/platform/platform.factor
index cd7d3f3836..59c525f5ea 100644
--- a/extra/mason/platform/platform.factor
+++ b/extra/mason/platform/platform.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Eduardo Cavazos, Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel system accessors namespaces splitting sequences
-mason.config ;
+mason.config bootstrap.image ;
 IN: mason.platform
 
 : platform ( -- string )
@@ -11,7 +11,7 @@ IN: mason.platform
     target-os get { "freebsd" "openbsd" "netbsd" } member? "gmake" "make" ? ;
 
 : boot-image-arch ( -- string )
-    target-cpu get dup "ppc" = [ target-os get "-" append prepend ] when ;
+    target-os get target-cpu get arch ;
 
 : boot-image-name ( -- string )
     "boot." boot-image-arch ".image" 3append ;

From eb83b542d6247c632807407433f20d2c3eef074e Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 7 Nov 2008 21:54:13 -0600
Subject: [PATCH 11/27] Fix unix x86.64 bootstrap

---
 basis/cpu/x86/64/unix/bootstrap.factor | 2 +-
 basis/cpu/x86/64/unix/unix.factor      | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/basis/cpu/x86/64/unix/bootstrap.factor b/basis/cpu/x86/64/unix/bootstrap.factor
index a42353fabd..29d48bd794 100644
--- a/basis/cpu/x86/64/unix/bootstrap.factor
+++ b/basis/cpu/x86/64/unix/bootstrap.factor
@@ -8,5 +8,5 @@ IN: bootstrap.x86
 : arg0 ( -- reg ) RDI ;
 : arg1 ( -- reg ) RSI ;
 
-<< "resource:basis/cpu/x86/64/bootstrap.factor" parsed-file parsed >>
+<< "resource:basis/cpu/x86/64/bootstrap.factor" parse-file parsed >>
 call
diff --git a/basis/cpu/x86/64/unix/unix.factor b/basis/cpu/x86/64/unix/unix.factor
index 9e70ada5d0..abbd0cf21b 100644
--- a/basis/cpu/x86/64/unix/unix.factor
+++ b/basis/cpu/x86/64/unix/unix.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel layouts system compiler.cfg.registers
-cpu.architecture cpu.x86.assembler ;
+cpu.architecture cpu.x86.assembler cpu.x86 ;
 IN: cpu.x86.64.unix
 
 M: int-regs param-regs drop { RDI RSI RDX RCX R8 R9 } ;

From c669040754d94077d17f88f38ee33840bca4f1be Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 7 Nov 2008 21:56:57 -0600
Subject: [PATCH 12/27] Pass -fno-forward-propagate on gcc 4.3

---
 build-support/factor.sh | 7 ++++---
 1 file changed, 4 insertions(+), 3 deletions(-)

diff --git a/build-support/factor.sh b/build-support/factor.sh
index 07d05e29b5..7fbb54a568 100755
--- a/build-support/factor.sh
+++ b/build-support/factor.sh
@@ -60,10 +60,11 @@ check_gcc_version() {
     GCC_VERSION=`$CC --version`
     check_ret gcc
     if [[ $GCC_VERSION == *3.3.* ]] ; then
-        $ECHO "bad!"
         $ECHO "You have a known buggy version of gcc (3.3)"
         $ECHO "Install gcc 3.4 or higher and try again."
         exit 3
+    elif [[ $GCC_VERSION == *4.3.* ]] ; then
+       MAKE_OPTS="$MAKE_OPTS SITE_CFLAGS=-fno-forward-propagate"
     fi
     $ECHO "ok."
 }
@@ -282,7 +283,7 @@ set_build_info() {
 	else
         MAKE_IMAGE_TARGET=$ARCH.$WORD
     fi
-    BOOT_IMAGE_NAME=boot.$MAKE_IMAGE_TARGET.image
+    BOOT_IMAGE=boot.$MAKE_IMAGE_TARGET.image
 }
 
 parse_build_info() {
@@ -335,7 +336,7 @@ cd_factor() {
 }
 
 invoke_make() {
-   $MAKE $*
+   $MAKE $MAKE_OPTS $*
    check_ret $MAKE
 }
 

From 6182a161dba6eead4fa91a11cafcbba1732a27d8 Mon Sep 17 00:00:00 2001
From: Doug Coleman <erg@secrets.local>
Date: Fri, 7 Nov 2008 22:03:27 -0600
Subject: [PATCH 13/27] support reading 8bit bitmaps, 4bit is blocking on
 bit-streams

---
 extra/graphics/bitmap/bitmap.factor | 34 +++++++++++++++++++----------
 1 file changed, 22 insertions(+), 12 deletions(-)

diff --git a/extra/graphics/bitmap/bitmap.factor b/extra/graphics/bitmap/bitmap.factor
index 651c5f7ca1..4d83300934 100755
--- a/extra/graphics/bitmap/bitmap.factor
+++ b/extra/graphics/bitmap/bitmap.factor
@@ -5,7 +5,7 @@ USING: alien arrays byte-arrays combinators summary
 io.backend graphics.viewer io io.binary io.files kernel libc
 math math.functions namespaces opengl opengl.gl prettyprint
 sequences strings ui ui.gadgets.panes io.encodings.binary
-accessors ;
+accessors grouping ;
 IN: graphics.bitmap
 
 ! Currently can only handle 24bit bitmaps.
@@ -23,16 +23,25 @@ TUPLE: bitmap magic size reserved offset header-length width
         swap [ >>array ] [ >>color-index ] bi
         24 >>bit-count ;
 
-: raw-bitmap>string ( str n -- str )
+: 8bit>array ( bitmap -- array )
+    [ rgb-quads>> 4 <sliced-groups> [ 3 head-slice ] map ]
+    [ color-index>> >array ] bi [ swap nth ] with map concat ;
+
+: 4bit>array ( bitmap -- array )
+    [ rgb-quads>> 4 <sliced-groups> [ 3 head-slice ] map ]
+    [ color-index>> >array ] bi [ swap nth ] with map concat ;
+
+: raw-bitmap>array ( bitmap -- array )
+    dup bit-count>>
     {
         { 32 [ "32bit" throw ] }
-        { 24 [ ] }
+        { 24 [ color-index>> ] }
         { 16 [ "16bit" throw ] }
-        { 8 [ "8bit" throw ] }
-        { 4 [ "4bit" throw ] }
+        { 8 [ 8bit>array ] }
+        { 4 [ 4bit>array ] }
         { 2 [ "2bit" throw ] }
         { 1 [ "1bit" throw ] }
-    } case ;
+    } case >byte-array ;
 
 ERROR: bitmap-magic ;
 
@@ -72,13 +81,12 @@ M: bitmap-magic summary
 
 : load-bitmap ( path -- bitmap )
     normalize-path binary [
-        T{ bitmap } clone
-        dup parse-file-header
-        dup parse-bitmap-header
-        dup parse-bitmap
+        bitmap new
+            dup parse-file-header
+            dup parse-bitmap-header
+            dup parse-bitmap
     ] with-file-reader
-    dup color-index>> over bit-count>>
-    raw-bitmap>string >byte-array >>array ;
+    dup raw-bitmap>array >>array ;
 
 : save-bitmap ( bitmap path -- )
     binary [
@@ -118,6 +126,8 @@ M: bitmap draw-image ( bitmap -- )
         bit-count>> {
             ! { 32 [ GL_BGRA GL_UNSIGNED_INT_8_8_8_8 ] } ! broken
             { 24 [ GL_BGR GL_UNSIGNED_BYTE ] }
+            { 8 [ GL_BGR GL_UNSIGNED_BYTE ] }
+            { 4 [ GL_BGR GL_UNSIGNED_BYTE ] }
         } case
     ] keep array>> glDrawPixels ;
 

From 9cc193ea5b40c4e856dc42fec39d2fb65873ed0f Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 7 Nov 2008 22:37:40 -0600
Subject: [PATCH 14/27] Add unportable tags and fix my-arch word

---
 basis/bootstrap/image/image.factor | 4 ++--
 basis/cpu/x86/64/unix/tags.txt     | 1 +
 basis/cpu/x86/64/winnt/tags.txt    | 1 +
 3 files changed, 4 insertions(+), 2 deletions(-)
 create mode 100644 basis/cpu/x86/64/unix/tags.txt
 create mode 100644 basis/cpu/x86/64/winnt/tags.txt

diff --git a/basis/bootstrap/image/image.factor b/basis/bootstrap/image/image.factor
index 3a3ae341d1..8b0051148f 100644
--- a/basis/bootstrap/image/image.factor
+++ b/basis/bootstrap/image/image.factor
@@ -14,8 +14,8 @@ IN: bootstrap.image
 
 : arch ( os cpu -- arch )
     {
-        { "ppc" [ name>> "-ppc" append ] }
-        { "x86.64" [ name>> "winnt" = "winnt" "unix" ? "-x86.64" append ] }
+        { "ppc" [ "-ppc" append ] }
+        { "x86.64" [ "winnt" = "winnt" "unix" ? "-x86.64" append ] }
         [ nip ]
     } case ;
 
diff --git a/basis/cpu/x86/64/unix/tags.txt b/basis/cpu/x86/64/unix/tags.txt
new file mode 100644
index 0000000000..6bf68304bb
--- /dev/null
+++ b/basis/cpu/x86/64/unix/tags.txt
@@ -0,0 +1 @@
+unportable
diff --git a/basis/cpu/x86/64/winnt/tags.txt b/basis/cpu/x86/64/winnt/tags.txt
new file mode 100644
index 0000000000..6bf68304bb
--- /dev/null
+++ b/basis/cpu/x86/64/winnt/tags.txt
@@ -0,0 +1 @@
+unportable

From 1280ed63fed27e0cbe5cd58592f35f8cfc4cb2cd Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 7 Nov 2008 22:40:21 -0600
Subject: [PATCH 15/27] Fix mason tests

---
 extra/mason/release/branch/branch-tests.factor | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/extra/mason/release/branch/branch-tests.factor b/extra/mason/release/branch/branch-tests.factor
index 68046f79cf..ae3ddb61fc 100644
--- a/extra/mason/release/branch/branch-tests.factor
+++ b/extra/mason/release/branch/branch-tests.factor
@@ -12,7 +12,7 @@ USING: mason.release.branch mason.config tools.test namespaces ;
     ] with-scope
 ] unit-test
 
-[ { "scp" "boot.x86.64.image" "joe@blah.com:/stuff/clean/netbsd-x86-64" } ] [
+[ { "scp" "boot.unix-x86.64.image" "joe@blah.com:/stuff/clean/netbsd-x86-64" } ] [
     [
         "joe" image-username set
         "blah.com" image-host set

From 8e44e783cf4efe4d7f39ddeba396c7b12ac5034f Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Sat, 8 Nov 2008 15:59:21 -0600
Subject: [PATCH 16/27] ui.gadgets.lists: minor tweak to 'select-gadget'

---
 basis/ui/gadgets/lists/lists.factor | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/basis/ui/gadgets/lists/lists.factor b/basis/ui/gadgets/lists/lists.factor
index 62e5b7d780..17fe68721d 100644
--- a/basis/ui/gadgets/lists/lists.factor
+++ b/basis/ui/gadgets/lists/lists.factor
@@ -97,7 +97,7 @@ M: list focusable-child* drop t ;
     ] if ;
 
 : select-gadget ( gadget list -- )
-    swap over children>> index
+    tuck children>> index
     [ swap select-index ] [ drop ] if* ;
 
 : clamp-loc ( point max -- point )

From 8262b50c87d89cebd807bd7eb41436e3ef211dfe Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Sat, 8 Nov 2008 16:23:06 -0600
Subject: [PATCH 17/27] ui.gadgets.scrollers: minor tweak in 'new-scroller'

---
 basis/ui/gadgets/scrollers/scrollers.factor | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/basis/ui/gadgets/scrollers/scrollers.factor b/basis/ui/gadgets/scrollers/scrollers.factor
index fefce8a040..633e3ad4a8 100644
--- a/basis/ui/gadgets/scrollers/scrollers.factor
+++ b/basis/ui/gadgets/scrollers/scrollers.factor
@@ -41,7 +41,7 @@ scroller H{
         dup model>> dependencies>> first  <x-slider> >>x dup x>> @bottom grid-add
         dup model>> dependencies>> second <y-slider> >>y dup y>> @right  grid-add
 
-        swap over model>> <viewport> >>viewport
+        tuck model>> <viewport> >>viewport
         dup viewport>> @center grid-add ;
 
 : <scroller> ( gadget -- scroller ) scroller new-scroller ;

From 313cdf4af02d547cff9e7d59d66ba7188f441526 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sat, 8 Nov 2008 18:29:05 -0600
Subject: [PATCH 18/27] Fix release.tidy bug

---
 extra/mason/release/tidy/tidy.factor | 11 +++++------
 1 file changed, 5 insertions(+), 6 deletions(-)

diff --git a/extra/mason/release/tidy/tidy.factor b/extra/mason/release/tidy/tidy.factor
index a456e6ff23..fb931650d4 100644
--- a/extra/mason/release/tidy/tidy.factor
+++ b/extra/mason/release/tidy/tidy.factor
@@ -1,16 +1,14 @@
 ! Copyright (C) 2008 Eduardo Cavazos, Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel namespaces continuations debugger sequences fry
-io.files io.launcher mason.common mason.platform
+io.files io.launcher bootstrap.image qualified mason.common
 mason.config ;
+FROM: mason.config => target-os ;
 IN: mason.release.tidy
 
 : common-files ( -- seq )
+    images [ boot-image-name ] map
     {
-        "boot.x86.32.image"
-        "boot.x86.64.image"
-        "boot.macosx-ppc.image"
-        "boot.linux-ppc.image"
         "vm"
         "temp"
         "logs"
@@ -20,7 +18,8 @@ IN: mason.release.tidy
         "unmaintained"
         "unfinished"
         "build-support"
-    } ;
+    }
+    append ;
 
 : remove-common-files ( -- )
     common-files [ delete-tree ] each ;

From 57242951b9ec01c676c673b0eabf0b63a760813d Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sat, 8 Nov 2008 19:33:15 -0600
Subject: [PATCH 19/27] Better error reporting in FROM: and RENAME: words

---
 basis/fry/fry.factor                   |  2 +-
 basis/qualified/qualified-docs.factor  | 11 +++++++++
 basis/qualified/qualified-tests.factor | 31 +++++++++++++++++---------
 basis/qualified/qualified.factor       | 30 ++++++++++++-------------
 core/parser/parser-docs.factor         |  2 +-
 core/parser/parser.factor              |  4 ++--
 6 files changed, 50 insertions(+), 30 deletions(-)

diff --git a/basis/fry/fry.factor b/basis/fry/fry.factor
index 395d5c3caf..87c59e18a0 100644
--- a/basis/fry/fry.factor
+++ b/basis/fry/fry.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Slava Pestov, Eduardo Cavazos.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel sequences combinators parser splitting math
-quotations arrays make qualified words ;
+quotations arrays make words ;
 IN: fry
 
 : _ ( -- * ) "Only valid inside a fry" throw ;
diff --git a/basis/qualified/qualified-docs.factor b/basis/qualified/qualified-docs.factor
index d62f696a74..067d221d2f 100644
--- a/basis/qualified/qualified-docs.factor
+++ b/basis/qualified/qualified-docs.factor
@@ -32,3 +32,14 @@ HELP: RENAME:
     "RENAME: + math => -"
     "2 3 - ! => 5" } } ;
 
+ARTICLE: "qualified" "Qualified word lookup"
+"The " { $vocab-link "qualified" } " vocabulary provides a handful of parsing words which give more control over word lookup than is offered by " { $link POSTPONE: USE: } " and " { $link POSTPONE: USING: } "."
+$nl
+"These words are useful when there is no way to avoid using two vocabularies with identical word names in the same source file."
+{ $subsection POSTPONE: QUALIFIED: }
+{ $subsection POSTPONE: QUALIFIED-WITH: }
+{ $subsection POSTPONE: FROM: }
+{ $subsection POSTPONE: EXCLUDE: }
+{ $subsection POSTPONE: RENAME: } ;
+
+ABOUT: "qualified"
diff --git a/basis/qualified/qualified-tests.factor b/basis/qualified/qualified-tests.factor
index 8f67ddf730..78efec4861 100644
--- a/basis/qualified/qualified-tests.factor
+++ b/basis/qualified/qualified-tests.factor
@@ -1,24 +1,33 @@
-USING: tools.test qualified ;
-IN: foo
+USING: tools.test qualified eval accessors parser ;
+IN: qualified.tests.foo
 : x 1 ;
-IN: bar
+: y 5 ;
+IN: qualified.tests.bar
 : x 2 ;
-IN: baz
+: y 4 ;
+IN: qualified.tests.baz
 : x 3 ;
 
-QUALIFIED: foo
-QUALIFIED: bar
-[ 1 2 3 ] [ foo:x bar:x x ] unit-test
+QUALIFIED: qualified.tests.foo
+QUALIFIED: qualified.tests.bar
+[ 1 2 3 ] [ qualified.tests.foo:x qualified.tests.bar:x x ] unit-test
 
-QUALIFIED-WITH: bar p
+QUALIFIED-WITH: qualified.tests.bar p
 [ 2 ] [ p:x ] unit-test
 
-RENAME: x baz => y
+RENAME: x qualified.tests.baz => y
 [ 3 ] [ y ] unit-test
 
-FROM: baz => x ;
+FROM: qualified.tests.baz => x ;
 [ 3 ] [ x ] unit-test
+[ 3 ] [ y ] unit-test
 
-EXCLUDE: bar => x ;
+EXCLUDE: qualified.tests.bar => x ;
 [ 3 ] [ x ] unit-test
+[ 4 ] [ y ] unit-test
 
+[ "USE: qualified IN: qualified.tests FROM: qualified.tests => doesnotexist ;" eval ]
+[ error>> no-word-error? ] must-fail-with
+
+[ "USE: qualified IN: qualified.tests RENAME: doesnotexist qualified.tests => blah" eval ]
+[ error>> no-word-error? ] must-fail-with
diff --git a/basis/qualified/qualified.factor b/basis/qualified/qualified.factor
index d636cc0152..d387ef4b0e 100644
--- a/basis/qualified/qualified.factor
+++ b/basis/qualified/qualified.factor
@@ -1,12 +1,12 @@
 ! Copyright (C) 2007, 2008 Daniel Ehrenberg.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel sequences assocs hashtables parser lexer
-vocabs words namespaces vocabs.loader debugger sets ;
+vocabs words namespaces vocabs.loader debugger sets fry ;
 IN: qualified
 
 : define-qualified ( vocab-name prefix-name -- )
     [ load-vocab vocab-words ] [ CHAR: : suffix ] bi*
-    [ -rot >r append r> ] curry assoc-map
+    '[ [ [ _ ] dip append ] dip ] assoc-map
     use get push ;
 
 : QUALIFIED:
@@ -19,27 +19,27 @@ IN: qualified
 
 : expect=> ( -- ) scan "=>" assert= ;
 
-: partial-vocab ( words name -- assoc )
-    dupd [
-        lookup [ "No such word: " swap append throw ] unless*
-    ] curry map zip ;
-
-: partial-vocab-ignoring ( words name -- assoc )
-    [ load-vocab vocab-words keys swap diff ] keep partial-vocab ;
-
-: EXCLUDE:
-    #! Syntax: EXCLUDE: vocab => words ... ;
-    scan expect=>
-    ";" parse-tokens swap partial-vocab-ignoring use get push ; parsing
+: partial-vocab ( words vocab -- assoc )
+    '[ dup _ lookup [ no-word-error ] unless* ]
+    { } map>assoc ;
 
 : FROM:
     #! Syntax: FROM: vocab => words... ;
     scan dup load-vocab drop expect=>
     ";" parse-tokens swap partial-vocab use get push ; parsing
 
+: partial-vocab-excluding ( words vocab -- assoc )
+    [ load-vocab vocab-words keys swap diff ] keep partial-vocab ;
+
+: EXCLUDE:
+    #! Syntax: EXCLUDE: vocab => words ... ;
+    scan expect=>
+    ";" parse-tokens swap partial-vocab-excluding use get push ; parsing
+
 : RENAME:
     #! Syntax: RENAME: word vocab => newname
-    scan scan dup load-vocab drop lookup [ "No such word" throw ] unless*
+    scan scan dup load-vocab drop
+    dupd lookup [ ] [ no-word-error ] ?if
     expect=>
     scan associate use get push ; parsing
 
diff --git a/core/parser/parser-docs.factor b/core/parser/parser-docs.factor
index 1d8d1f0714..d33f5cd6d9 100644
--- a/core/parser/parser-docs.factor
+++ b/core/parser/parser-docs.factor
@@ -69,7 +69,7 @@ $nl
 { $subsection POSTPONE: PRIVATE> }
 { $subsection "vocabulary-search-errors" }
 { $subsection "vocabulary-search-shadow" }
-{ $see-also "words" } ;
+{ $see-also "words" "qualified" } ;
 
 ARTICLE: "reading-ahead" "Reading ahead"
 "Parsing words can consume input:"
diff --git a/core/parser/parser.factor b/core/parser/parser.factor
index a86715b073..ed8fc4510b 100644
--- a/core/parser/parser.factor
+++ b/core/parser/parser.factor
@@ -71,10 +71,10 @@ ERROR: no-current-vocab ;
         ] keep
     ] { } map>assoc ;
 
-TUPLE: no-word-error name ;
+ERROR: no-word-error name ;
 
 : no-word ( name -- newword )
-    dup no-word-error boa
+    dup \ no-word-error boa
     swap words-named [ forward-reference? not ] filter
     word-restarts throw-restarts
     dup vocabulary>> (use+) ;

From 359fb6e5183f781dd0f76c0e0e85ac35de08e43c Mon Sep 17 00:00:00 2001
From: unknown <Administrator@.(none)>
Date: Sat, 8 Nov 2008 20:32:23 -0600
Subject: [PATCH 20/27] VM fixes for Win64 calling convention

---
 vm/cpu-x86.32.S |  4 ++++
 vm/cpu-x86.64.S |  6 ++++++
 vm/cpu-x86.S    | 17 +++++++++--------
 3 files changed, 19 insertions(+), 8 deletions(-)

diff --git a/vm/cpu-x86.32.S b/vm/cpu-x86.32.S
index e0e674a7e2..eec850dc9e 100755
--- a/vm/cpu-x86.32.S
+++ b/vm/cpu-x86.32.S
@@ -10,14 +10,18 @@ and the callstack top is passed in EDX */
 #define DS_REG %esi
 #define RETURN_REG %eax
 
+#define NV_TEMP_REG %rbx
+
 #define CELL_SIZE 4
 #define STACK_PADDING 12
 
 #define PUSH_NONVOLATILE \
 	push %ebx ; \
+	push %ebp ; \
 	push %ebp
 
 #define POP_NONVOLATILE \
+	pop %ebp ; \
 	pop %ebp ; \
 	pop %ebx
 
diff --git a/vm/cpu-x86.64.S b/vm/cpu-x86.64.S
index 15a4eb8da3..c981095d62 100644
--- a/vm/cpu-x86.64.S
+++ b/vm/cpu-x86.64.S
@@ -7,6 +7,8 @@
 #define CELL_SIZE 8
 #define STACK_PADDING 56
 
+#define NV_TEMP_REG %rbp
+
 #ifdef WINDOWS
 
 	#define ARG0 %rcx
@@ -20,9 +22,11 @@
 		push %rdi ; \
 		push %rsi ; \
 		push %rbx ; \
+		push %rbp ; \
 		push %rbp
 
 	#define POP_NONVOLATILE \
+		pop %rbp ; \
 		pop %rbp ; \
 		pop %rbx ; \
 		pop %rsi ; \
@@ -41,9 +45,11 @@
 		push %rbx ; \
 		push %rbp ; \
 		push %r12 ; \
+		push %r13 ; \
 		push %r13
 
 	#define POP_NONVOLATILE \
+		pop %r13 ; \
 		pop %r13 ; \
 		pop %r12 ; \
 		pop %rbp ; \
diff --git a/vm/cpu-x86.S b/vm/cpu-x86.S
index 3d6cacdebd..1857fb0ed8 100755
--- a/vm/cpu-x86.S
+++ b/vm/cpu-x86.S
@@ -1,20 +1,21 @@
 DEF(F_FASTCALL void,c_to_factor,(CELL quot)):
 	PUSH_NONVOLATILE
-	push ARG0
-
-	/* Save stack pointer */
-	lea -CELL_SIZE(STACK_REG),ARG0      
+	mov ARG0,NV_TEMP_REG
 
 	/* Create register shadow area for Win64 */
-	sub $32,STACK_REG                    
+	sub $32,STACK_REG
+
+	/* Save stack pointer */
+	lea -CELL_SIZE(STACK_REG),ARG0
 	call MANGLE(save_callstack_bottom)
-	add $32,STACK_REG
 
 	/* Call quot-xt */
-	mov (STACK_REG),ARG0
+	mov NV_TEMP_REG,ARG0
 	call *QUOT_XT_OFFSET(ARG0)
 
-	pop ARG0
+	/* Tear down register shadow area */
+	add $32,STACK_REG
+
 	POP_NONVOLATILE
 	ret
 

From b9ee92e484456d2103c6f5b3f9fa13ed36746774 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@oberon.local>
Date: Sat, 8 Nov 2008 20:36:05 -0600
Subject: [PATCH 21/27] factor.sh fixes

---
 build-support/factor.sh | 8 ++++++--
 1 file changed, 6 insertions(+), 2 deletions(-)

diff --git a/build-support/factor.sh b/build-support/factor.sh
index 7fbb54a568..bd234afb5f 100755
--- a/build-support/factor.sh
+++ b/build-support/factor.sh
@@ -271,17 +271,21 @@ check_os_arch_word() {
 
 set_build_info() {
     check_os_arch_word
-    MAKE_TARGET=$OS-$ARCH-$WORD
     if [[ $OS == macosx && $ARCH == ppc ]] ; then
         MAKE_IMAGE_TARGET=macosx-ppc
+        MAKE_TARGET=macosx-ppc
     elif [[ $OS == linux && $ARCH == ppc ]] ; then
         MAKE_IMAGE_TARGET=linux-ppc
+        MAKE_TARGET=linux-ppc
     elif [[ $OS == winnt && $ARCH == x86 && $WORD == 64 ]] ; then
         MAKE_IMAGE_TARGET=winnt-x86.64
+        MAKE_TARGET=winnt-x86-64
     elif [[ $ARCH == x86 && $WORD == 64 ]] ; then
         MAKE_IMAGE_TARGET=unix-x86.64
-	else
+        MAKE_TARGET=$OS-x86-64
+    else
         MAKE_IMAGE_TARGET=$ARCH.$WORD
+        MAKE_TARGET=$OS-$ARCH-$WORD
     fi
     BOOT_IMAGE=boot.$MAKE_IMAGE_TARGET.image
 }

From 65dea0aa26e233cddd29af5494ab085ea900c2fd Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@oberon.local>
Date: Sat, 8 Nov 2008 20:36:14 -0600
Subject: [PATCH 22/27] PowerPC backend fixes

---
 basis/cpu/ppc/linux/linux.factor   | 13 +++++++------
 basis/cpu/ppc/macosx/macosx.factor | 13 +++++++------
 basis/cpu/ppc/ppc.factor           | 13 +++++++++----
 3 files changed, 23 insertions(+), 16 deletions(-)

diff --git a/basis/cpu/ppc/linux/linux.factor b/basis/cpu/ppc/linux/linux.factor
index d92709a399..6f21aa74d5 100644
--- a/basis/cpu/ppc/linux/linux.factor
+++ b/basis/cpu/ppc/linux/linux.factor
@@ -1,6 +1,7 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors system kernel alien.c-types cpu.architecture cpu.ppc ;
+USING: accessors system kernel layouts
+alien.c-types cpu.architecture cpu.ppc ;
 IN: cpu.ppc.linux
 
 <<
@@ -8,12 +9,12 @@ t "longlong" c-type (>>stack-align?)
 t "ulonglong" c-type (>>stack-align?)
 >>
 
-M: linux reserved-area-size 2 ;
+M: linux reserved-area-size 2 cells ;
 
-M: linux lr-save 1 ;
+M: linux lr-save 1 cells ;
 
-M: float-regs param-regs { 1 2 3 4 5 6 7 8 } ;
+M: float-regs param-regs drop { 1 2 3 4 5 6 7 8 } ;
 
-M: ppc value-structs? drop f ;
+M: ppc value-structs? f ;
 
-M: ppc fp-shadows-int? drop f ;
+M: ppc fp-shadows-int? f ;
diff --git a/basis/cpu/ppc/macosx/macosx.factor b/basis/cpu/ppc/macosx/macosx.factor
index 1e0a6caca0..619b82a04b 100644
--- a/basis/cpu/ppc/macosx/macosx.factor
+++ b/basis/cpu/ppc/macosx/macosx.factor
@@ -1,6 +1,7 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors system kernel alien.c-types cpu.architecture cpu.ppc ;
+USING: accessors system kernel layouts
+alien.c-types cpu.architecture cpu.ppc ;
 IN: cpu.ppc.macosx
 
 <<
@@ -9,12 +10,12 @@ IN: cpu.ppc.macosx
 4 "double" c-type (>>align)
 >>
 
-M: macosx reserved-area-size 6 ;
+M: macosx reserved-area-size 6 cells ;
 
-M: macosx lr-save 2 ;
+M: macosx lr-save 2 cells ;
 
-M: float-regs param-regs { 1 2 3 4 5 6 7 8 9 10 11 12 13 } ;
+M: float-regs param-regs drop { 1 2 3 4 5 6 7 8 9 10 11 12 13 } ;
 
-M: ppc value-structs? drop t ;
+M: ppc value-structs? t ;
 
-M: ppc fp-shadows-int? drop t ;
+M: ppc fp-shadows-int? t ;
diff --git a/basis/cpu/ppc/ppc.factor b/basis/cpu/ppc/ppc.factor
index d2d1e26396..2be46d15ee 100644
--- a/basis/cpu/ppc/ppc.factor
+++ b/basis/cpu/ppc/ppc.factor
@@ -349,12 +349,17 @@ M: ppc %gc
     "end" resolve-label ;
 
 M: ppc %prologue ( n -- )
-    0 scratch-reg LOAD32 rc-absolute-ppc-2/2 rel-this
+    #! We use a volatile register (r11) here for scratch. Because
+    #! callback bodies have a prologue too, we cannot assume
+    #! that c_to_factor saved all non-volatile registers, so
+    #! we have to respect the C calling convention. Also, we
+    #! cannot touch any param-regs either.
+    0 11 LOAD32 rc-absolute-ppc-2/2 rel-this
     0 MFLR
     1 1 pick neg ADDI
-    scratch-reg 1 pick xt-save STW
-    dup scratch-reg LI
-    scratch-reg 1 pick next-save STW
+    11 1 pick xt-save STW
+    dup 11 LI
+    11 1 pick next-save STW
     0 1 rot lr-save + STW ;
 
 M: ppc %epilogue ( n -- )

From fdbea06e279f71892ecf2354790121d5cf8da559 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sat, 8 Nov 2008 20:40:09 -0600
Subject: [PATCH 23/27] Fix compile warning

---
 vm/callstack.c | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/vm/callstack.c b/vm/callstack.c
index c9466bbbb2..b7e99b418c 100755
--- a/vm/callstack.c
+++ b/vm/callstack.c
@@ -117,7 +117,7 @@ CELL frame_executing(F_STACK_FRAME *frame)
 F_STACK_FRAME *frame_successor(F_STACK_FRAME *frame)
 {
 	if(frame->size == 0)
-		critical_error("Stack frame has zero size",frame);
+		critical_error("Stack frame has zero size",(CELL)frame);
 	return (F_STACK_FRAME *)((CELL)frame - frame->size);
 }
 

From abc3915387c145215dd50f8923796c71c46fd2b3 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sat, 8 Nov 2008 21:06:51 -0600
Subject: [PATCH 24/27] Fix x86-32 VM compilation; was using a 64-bit reg on
 accident

---
 vm/cpu-x86.32.S | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/vm/cpu-x86.32.S b/vm/cpu-x86.32.S
index eec850dc9e..6ddbd52da2 100755
--- a/vm/cpu-x86.32.S
+++ b/vm/cpu-x86.32.S
@@ -10,7 +10,7 @@ and the callstack top is passed in EDX */
 #define DS_REG %esi
 #define RETURN_REG %eax
 
-#define NV_TEMP_REG %rbx
+#define NV_TEMP_REG %ebx
 
 #define CELL_SIZE 4
 #define STACK_PADDING 12

From f7fe84e5634a4f2c05b019479dfe072a8bb9f457 Mon Sep 17 00:00:00 2001
From: unknown <Administrator@.(none)>
Date: Sat, 8 Nov 2008 21:40:47 -0600
Subject: [PATCH 25/27] Working on Win64 FFI

---
 basis/compiler/codegen/codegen.factor      | 25 ++++++---
 basis/cpu/architecture/architecture.factor | 10 +++-
 basis/cpu/ppc/linux/linux.factor           |  8 ++-
 basis/cpu/ppc/macosx/macosx.factor         |  8 ++-
 basis/cpu/x86/32/32.factor                 |  6 +++
 basis/cpu/x86/64/64.factor                 | 63 ++++++----------------
 basis/cpu/x86/64/unix/unix.factor          | 40 ++++++++++++++
 basis/cpu/x86/64/winnt/winnt.factor        | 13 ++++-
 basis/cpu/x86/x86.factor                   | 12 ++---
 9 files changed, 117 insertions(+), 68 deletions(-)

diff --git a/basis/compiler/codegen/codegen.factor b/basis/compiler/codegen/codegen.factor
index cab86dcb54..35d4d59253 100644
--- a/basis/compiler/codegen/codegen.factor
+++ b/basis/compiler/codegen/codegen.factor
@@ -1,6 +1,6 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: namespaces make math math.parser sequences accessors
+USING: namespaces make math math.order math.parser sequences accessors
 kernel kernel.private layouts assocs words summary arrays
 combinators classes.algebra alien alien.c-types alien.structs
 alien.strings alien.arrays sets threads libc continuations.private
@@ -234,13 +234,26 @@ M: float-regs reg-class-variable drop float-regs ;
 
 GENERIC: inc-reg-class ( register-class -- )
 
-M: reg-class inc-reg-class
-    dup reg-class-variable inc
-    fp-shadows-int? [ reg-size stack-params +@ ] [ drop ] if ;
+: ?dummy-stack-params ( reg-class -- )
+    dummy-stack-params? [ reg-size stack-params +@ ] [ drop ] if ;
+
+: ?dummy-int-params ( reg-class -- )
+    dummy-int-params? [ reg-size cell /i 1 max int-regs +@ ] [ drop ] if ;
+
+: ?dummy-fp-params ( reg-class -- )
+    drop dummy-fp-params? [ float-regs inc ] when ;
+
+M: int-regs inc-reg-class
+    [ reg-class-variable inc ]
+    [ ?dummy-stack-params ]
+    [ ?dummy-fp-params ]
+    tri ;
 
 M: float-regs inc-reg-class
-    dup call-next-method
-    fp-shadows-int? [ reg-size cell /i int-regs +@ ] [ drop ] if ;
+    [ reg-class-variable inc ]
+    [ ?dummy-stack-params ]
+    [ ?dummy-int-params ]
+    tri ;
 
 GENERIC: reg-class-full? ( class -- ? )
 
diff --git a/basis/cpu/architecture/architecture.factor b/basis/cpu/architecture/architecture.factor
index e4fa9419f0..b0b5b048d9 100644
--- a/basis/cpu/architecture/architecture.factor
+++ b/basis/cpu/architecture/architecture.factor
@@ -146,8 +146,14 @@ HOOK: struct-small-enough? cpu ( heap-size -- ? )
 ! Do we pass value structs by value or hidden reference?
 HOOK: value-structs? cpu ( -- ? )
 
-! If t, fp parameters are shadowed by dummy int parameters
-HOOK: fp-shadows-int? cpu ( -- ? )
+! If t, all parameters are shadowed by dummy stack parameters
+HOOK: dummy-stack-params? cpu ( -- ? )
+
+! If t, all FP parameters are shadowed by dummy int parameters
+HOOK: dummy-int-params? cpu ( -- ? )
+
+! If t, all int parameters are shadowed by dummy FP parameters
+HOOK: dummy-fp-params? cpu ( -- ? )
 
 HOOK: %prepare-unbox cpu ( -- )
 
diff --git a/basis/cpu/ppc/linux/linux.factor b/basis/cpu/ppc/linux/linux.factor
index d92709a399..c6649c7ad2 100644
--- a/basis/cpu/ppc/linux/linux.factor
+++ b/basis/cpu/ppc/linux/linux.factor
@@ -14,6 +14,10 @@ M: linux lr-save 1 ;
 
 M: float-regs param-regs { 1 2 3 4 5 6 7 8 } ;
 
-M: ppc value-structs? drop f ;
+M: ppc value-structs? f ;
 
-M: ppc fp-shadows-int? drop f ;
+M: ppc dummy-stack-params? f ;
+
+M: ppc dummy-int-params? f ;
+
+M: ppc dummy-fp-params? f ;
diff --git a/basis/cpu/ppc/macosx/macosx.factor b/basis/cpu/ppc/macosx/macosx.factor
index 1e0a6caca0..bb607d0e44 100644
--- a/basis/cpu/ppc/macosx/macosx.factor
+++ b/basis/cpu/ppc/macosx/macosx.factor
@@ -15,6 +15,10 @@ M: macosx lr-save 2 ;
 
 M: float-regs param-regs { 1 2 3 4 5 6 7 8 9 10 11 12 13 } ;
 
-M: ppc value-structs? drop t ;
+M: ppc value-structs? t ;
 
-M: ppc fp-shadows-int? drop t ;
+M: ppc dummy-stack-params? t ;
+
+M: ppc dummy-int-params? t ;
+
+M: ppc dummy-fp-params? f ;
diff --git a/basis/cpu/x86/32/32.factor b/basis/cpu/x86/32/32.factor
index 82fa7a012e..f26d76551a 100644
--- a/basis/cpu/x86/32/32.factor
+++ b/basis/cpu/x86/32/32.factor
@@ -274,6 +274,12 @@ M: x86.32 %callback-return ( n -- )
         [ drop 0 ]
     } cond RET ;
 
+M: x86.32 dummy-stack-params? f ;
+
+M: x86.32 dummy-int-params? f ;
+
+M: x86.32 dummy-fp-params? f ;
+
 os windows? [
     cell "longlong" c-type (>>align)
     cell "ulonglong" c-type (>>align)
diff --git a/basis/cpu/x86/64/64.factor b/basis/cpu/x86/64/64.factor
index d45dd098b8..0d20660021 100644
--- a/basis/cpu/x86/64/64.factor
+++ b/basis/cpu/x86/64/64.factor
@@ -26,6 +26,7 @@ M: x86.64 temp-reg-2 RCX ;
 
 : param-reg-1 int-regs param-regs first ; inline
 : param-reg-2 int-regs param-regs second ; inline
+: param-reg-3 int-regs param-regs third ; inline
 
 M: int-regs return-reg drop RAX ;
 M: float-regs return-reg drop XMM0 ;
@@ -40,13 +41,13 @@ M: x86.64 %prologue ( n -- )
 
 M: stack-params %load-param-reg
     drop
-    >r R11 swap stack@ MOV
-    r> stack@ R11 MOV ;
+    >r R11 swap param@ MOV
+    r> param@ R11 MOV ;
 
 M: stack-params %save-param-reg
     drop
     R11 swap next-stack@ MOV
-    stack@ R11 MOV ;
+    param@ R11 MOV ;
 
 : with-return-regs ( quot -- )
     [
@@ -55,37 +56,6 @@ M: stack-params %save-param-reg
         call
     ] with-scope ; inline
 
-! The ABI for passing structs by value is pretty messed up
-<< "void*" c-type clone "__stack_value" define-primitive-type
-stack-params "__stack_value" c-type (>>reg-class) >>
-
-: struct-types&offset ( struct-type -- pairs )
-    fields>> [
-        [ type>> ] [ offset>> ] bi 2array
-    ] map ;
-
-: split-struct ( pairs -- seq )
-    [
-        [ 8 mod zero? [ t , ] when , ] assoc-each
-    ] { } make { t } split harvest ;
-
-: flatten-small-struct ( c-type -- seq )
-    struct-types&offset split-struct [
-        [ c-type c-type-reg-class ] map
-        int-regs swap member? "void*" "double" ? c-type
-    ] map ;
-
-: flatten-large-struct ( c-type -- seq )
-    heap-size cell align
-    cell /i "__stack_value" c-type <repetition> ;
-
-M: struct-type flatten-value-type ( type -- seq )
-    dup heap-size 16 > [
-        flatten-large-struct
-    ] [
-        flatten-small-struct
-    ] if ;
-
 M: x86.64 %prepare-unbox ( -- )
     ! First parameter is top of stack
     param-reg-1 R14 [] MOV
@@ -102,7 +72,7 @@ M: x86.64 %unbox-long-long ( n func -- )
 
 : %unbox-struct-field ( c-type i -- )
     ! Alien must be in param-reg-1.
-    param-reg-1 swap cells [+] swap reg-class>> {
+    R11 swap cells [+] swap reg-class>> {
         { int-regs [ int-regs get pop swap MOV ] }
         { double-float-regs [ float-regs get pop swap MOVSD ] }
     } case ;
@@ -110,20 +80,20 @@ M: x86.64 %unbox-long-long ( n func -- )
 M: x86.64 %unbox-small-struct ( c-type -- )
     ! Alien must be in param-reg-1.
     "alien_offset" f %alien-invoke
-    ! Move alien_offset() return value to param-reg-1 so that we don't
+    ! Move alien_offset() return value to R11 so that we don't
     ! clobber it.
-    param-reg-1 RAX MOV
+    R11 RAX MOV
     [
-        flatten-small-struct [ %unbox-struct-field ] each-index
+        flatten-value-type [ %unbox-struct-field ] each-index
     ] with-return-regs ;
 
 M: x86.64 %unbox-large-struct ( n c-type -- )
     ! Source is in param-reg-1
     heap-size
     ! Load destination address
-    param-reg-2 rot stack@ LEA
+    param-reg-2 rot param@ LEA
     ! Load structure size
-    RDX swap MOV
+    param-reg-3 swap MOV
     ! Copy the struct to the C stack
     "to_value_struct" f %alien-invoke ;
 
@@ -142,10 +112,7 @@ M: x86.64 %box ( n reg-class func -- )
 M: x86.64 %box-long-long ( n func -- )
     int-regs swap %box ;
 
-M: x86.64 struct-small-enough? ( size -- ? )
-    heap-size 2 cells <= ;
-
-: box-struct-field@ ( i -- operand ) 1+ cells stack@ ;
+: box-struct-field@ ( i -- operand ) 1+ cells param@ ;
 
 : %box-struct-field ( c-type i -- )
     box-struct-field@ swap reg-class>> {
@@ -156,15 +123,15 @@ M: x86.64 struct-small-enough? ( size -- ? )
 M: x86.64 %box-small-struct ( c-type -- )
     #! Box a <= 16-byte struct.
     [
-        [ flatten-small-struct [ %box-struct-field ] each-index ]
-        [ RDX swap heap-size MOV ] bi
+        [ flatten-value-type [ %box-struct-field ] each-index ]
+        [ param-reg-3 swap heap-size MOV ] bi
         param-reg-1 0 box-struct-field@ MOV
         param-reg-2 1 box-struct-field@ MOV
         "box_small_struct" f %alien-invoke
     ] with-return-regs ;
 
 : struct-return@ ( n -- operand )
-    [ stack-frame get params>> ] unless* stack@ ;
+    [ stack-frame get params>> ] unless* param@ ;
 
 M: x86.64 %box-large-struct ( n c-type -- )
     ! Struct size is parameter 2
@@ -178,7 +145,7 @@ M: x86.64 %prepare-box-struct ( -- )
     ! Compute target address for value struct return
     RAX f struct-return@ LEA
     ! Store it as the first parameter
-    0 stack@ RAX MOV ;
+    0 param@ RAX MOV ;
 
 M: x86.64 %prepare-var-args RAX RAX XOR ;
 
diff --git a/basis/cpu/x86/64/unix/unix.factor b/basis/cpu/x86/64/unix/unix.factor
index abbd0cf21b..1a65132fab 100644
--- a/basis/cpu/x86/64/unix/unix.factor
+++ b/basis/cpu/x86/64/unix/unix.factor
@@ -10,3 +10,43 @@ M: float-regs param-regs
     drop { XMM0 XMM1 XMM2 XMM3 XMM4 XMM5 XMM6 XMM7 } ;
 
 M: x86.64 reserved-area-size 0 ;
+
+! The ABI for passing structs by value is pretty messed up
+<< "void*" c-type clone "__stack_value" define-primitive-type
+stack-params "__stack_value" c-type (>>reg-class) >>
+
+: struct-types&offset ( struct-type -- pairs )
+    fields>> [
+        [ type>> ] [ offset>> ] bi 2array
+    ] map ;
+
+: split-struct ( pairs -- seq )
+    [
+        [ 8 mod zero? [ t , ] when , ] assoc-each
+    ] { } make { t } split harvest ;
+
+: flatten-small-struct ( c-type -- seq )
+    struct-types&offset split-struct [
+        [ c-type c-type-reg-class ] map
+        int-regs swap member? "void*" "double" ? c-type
+    ] map ;
+
+: flatten-large-struct ( c-type -- seq )
+    heap-size cell align
+    cell /i "__stack_value" c-type <repetition> ;
+
+M: struct-type flatten-value-type ( type -- seq )
+    dup heap-size 16 > [
+        flatten-large-struct
+    ] [
+        flatten-small-struct
+    ] if ;
+
+M: x86.64 struct-small-enough? ( size -- ? )
+    heap-size 2 cells <= ;
+
+M: x86.64 dummy-stack-params? f ;
+
+M: x86.64 dummy-int-params? f ;
+
+M: x86.64 dummy-fp-params? f ;
diff --git a/basis/cpu/x86/64/winnt/winnt.factor b/basis/cpu/x86/64/winnt/winnt.factor
index d4c092f63d..0124c40877 100644
--- a/basis/cpu/x86/64/winnt/winnt.factor
+++ b/basis/cpu/x86/64/winnt/winnt.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel layouts system alien.c-types compiler.cfg.registers
-cpu.architecture cpu.x86.assembler cpu.x86 ;
+USING: kernel layouts system math alien.c-types
+compiler.cfg.registers cpu.architecture cpu.x86.assembler cpu.x86 ;
 IN: cpu.x86.64.winnt
 
 M: int-regs param-regs drop { RCX RDX R8 R9 } ;
@@ -10,6 +10,15 @@ M: float-regs param-regs drop { XMM0 XMM1 XMM2 XMM3 } ;
 
 M: x86.64 reserved-area-size 4 cells ;
 
+M: x86.64 struct-small-enough? ( size -- ? )
+    heap-size cell <= ;
+
+M: x86.64 dummy-stack-params? f ;
+
+M: x86.64 dummy-int-params? t ;
+
+M: x86.64 dummy-fp-params? t ;
+
 <<
 "longlong" "ptrdiff_t" typedef
 "int" "long" typedef
diff --git a/basis/cpu/x86/x86.factor b/basis/cpu/x86/x86.factor
index 55675a5e42..4f72fe45e1 100644
--- a/basis/cpu/x86/x86.factor
+++ b/basis/cpu/x86/x86.factor
@@ -467,6 +467,8 @@ M: x86 %compare-float-branch ( label cc src1 src2 -- )
 
 : stack@ ( n -- op ) stack-reg swap [+] ;
 
+: param@ ( n -- op ) reserved-area-size + stack@ ;
+
 : spill-integer-base ( stack-frame -- n )
     [ params>> ] [ return>> ] bi + reserved-area-size + ;
 
@@ -493,16 +495,16 @@ M: x86 %reload-float ( dst n -- ) spill-float@ MOVSD ;
 
 M: x86 %loop-entry 16 code-alignment [ NOP ] times ;
 
-M: int-regs %save-param-reg drop >r stack@ r> MOV ;
-M: int-regs %load-param-reg drop swap stack@ MOV ;
+M: int-regs %save-param-reg drop >r param@ r> MOV ;
+M: int-regs %load-param-reg drop swap param@ MOV ;
 
 GENERIC: MOVSS/D ( dst src reg-class -- )
 
 M: single-float-regs MOVSS/D drop MOVSS ;
 M: double-float-regs MOVSS/D drop MOVSD ;
 
-M: float-regs %save-param-reg >r >r stack@ r> r> MOVSS/D ;
-M: float-regs %load-param-reg >r swap stack@ r> MOVSS/D ;
+M: float-regs %save-param-reg >r >r param@ r> r> MOVSS/D ;
+M: float-regs %load-param-reg >r swap param@ r> MOVSS/D ;
 
 GENERIC: push-return-reg ( reg-class -- )
 GENERIC: load-return-reg ( n reg-class -- )
@@ -518,8 +520,6 @@ M: x86 %prepare-alien-invoke
     temp-reg-1 2 cells [+] ds-reg MOV
     temp-reg-1 3 cells [+] rs-reg MOV ;
 
-M: x86 fp-shadows-int? ( -- ? ) f ;
-
 M: x86 value-structs? t ;
 
 M: x86 small-enough? ( n -- ? )

From 28e397420d257d4fbd3896b68f72e8b6bb8da8b8 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sat, 8 Nov 2008 21:43:55 -0600
Subject: [PATCH 26/27] Fix USING:

---
 basis/cpu/x86/64/unix/unix.factor | 6 ++++--
 1 file changed, 4 insertions(+), 2 deletions(-)

diff --git a/basis/cpu/x86/64/unix/unix.factor b/basis/cpu/x86/64/unix/unix.factor
index 1a65132fab..ddb412873a 100644
--- a/basis/cpu/x86/64/unix/unix.factor
+++ b/basis/cpu/x86/64/unix/unix.factor
@@ -1,7 +1,9 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel layouts system compiler.cfg.registers
-cpu.architecture cpu.x86.assembler cpu.x86 ;
+USING: accessors arrays sequences math splitting make assocs
+kernel layouts system alien.c-types alien.structs
+cpu.architecture cpu.x86.assembler cpu.x86
+compiler.codegen compiler.cfg.registers ;
 IN: cpu.x86.64.unix
 
 M: int-regs param-regs drop { RDI RSI RDX RCX R8 R9 } ;

From 70d7c0ca20ce976a976240e65ac97f84c32fdf09 Mon Sep 17 00:00:00 2001
From: Doug Coleman <erg@secrets.local>
Date: Sun, 9 Nov 2008 13:01:03 -0600
Subject: [PATCH 27/27] make hexdump work with byte-arrays

---
 extra/hexdump/hexdump-tests.factor | 3 +++
 extra/hexdump/hexdump.factor       | 4 ++--
 2 files changed, 5 insertions(+), 2 deletions(-)

diff --git a/extra/hexdump/hexdump-tests.factor b/extra/hexdump/hexdump-tests.factor
index 7fb26e10c5..b3c03196f5 100644
--- a/extra/hexdump/hexdump-tests.factor
+++ b/extra/hexdump/hexdump-tests.factor
@@ -6,3 +6,6 @@ USING: hexdump kernel sequences tools.test ;
 
 [ t ] [ 256 [ ] map hexdump "Length: 256, 100h\n00000000h: 00 01 02 03 04 05 06 07 08 09 0a 0b 0c 0d 0e 0f ................\n00000010h: 10 11 12 13 14 15 16 17 18 19 1a 1b 1c 1d 1e 1f ................\n00000020h: 20 21 22 23 24 25 26 27 28 29 2a 2b 2c 2d 2e 2f  !\"#$%&'()*+,-./\n00000030h: 30 31 32 33 34 35 36 37 38 39 3a 3b 3c 3d 3e 3f 0123456789:;<=>?\n00000040h: 40 41 42 43 44 45 46 47 48 49 4a 4b 4c 4d 4e 4f @ABCDEFGHIJKLMNO\n00000050h: 50 51 52 53 54 55 56 57 58 59 5a 5b 5c 5d 5e 5f PQRSTUVWXYZ[\\]^_\n00000060h: 60 61 62 63 64 65 66 67 68 69 6a 6b 6c 6d 6e 6f `abcdefghijklmno\n00000070h: 70 71 72 73 74 75 76 77 78 79 7a 7b 7c 7d 7e 7f pqrstuvwxyz{|}~.\n00000080h: 80 81 82 83 84 85 86 87 88 89 8a 8b 8c 8d 8e 8f ................\n00000090h: 90 91 92 93 94 95 96 97 98 99 9a 9b 9c 9d 9e 9f ................\n000000a0h: a0 a1 a2 a3 a4 a5 a6 a7 a8 a9 aa ab ac ad ae af ................\n000000b0h: b0 b1 b2 b3 b4 b5 b6 b7 b8 b9 ba bb bc bd be bf ................\n000000c0h: c0 c1 c2 c3 c4 c5 c6 c7 c8 c9 ca cb cc cd ce cf ................\n000000d0h: d0 d1 d2 d3 d4 d5 d6 d7 d8 d9 da db dc dd de df ................\n000000e0h: e0 e1 e2 e3 e4 e5 e6 e7 e8 e9 ea eb ec ed ee ef ................\n000000f0h: f0 f1 f2 f3 f4 f5 f6 f7 f8 f9 fa fb fc fd fe ff ................\n" = ] unit-test
 
+
+[
+    "Length: 3, 3h\n00000000h: 01 02 03                                        ...\n" ] [ B{ 1 2 3 } hexdump ] unit-test
diff --git a/extra/hexdump/hexdump.factor b/extra/hexdump/hexdump.factor
index b965fb41bb..ecbc2d6169 100644
--- a/extra/hexdump/hexdump.factor
+++ b/extra/hexdump/hexdump.factor
@@ -21,9 +21,9 @@ IN: hexdump
     [ >hex-digit ] { } map-as concat 48 CHAR: \s pad-right ;
 
 : >ascii ( bytes -- str )
-    [ [ printable? ] keep CHAR: . ? ] map ;
+    [ [ printable? ] keep CHAR: . ? ] "" map-as ;
 
-: write-hex-line ( str lineno -- )
+: write-hex-line ( bytes lineno -- )
     write-offset [ >hex-digits write ] [ >ascii write ] bi nl ;
 
 PRIVATE>