From e45df2e89c006669e59bb7362c46556b46b2a5a0 Mon Sep 17 00:00:00 2001
From: unknown <Administrator@.(none)>
Date: Fri, 7 Nov 2008 20:25:31 -0600
Subject: [PATCH 1/4] 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 2/4] 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 3/4] 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 4/4] 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" }