First cut at x86 inline allocators

TODO.FACTOR.txt

@@ -8,6 +8,8 @@
 - callback scheduling issue
 - sometimes fep when closing window
 - %allot-bignum-signed-2: handle carry in negation
+- x86: load-allot-ptr doesn't have a stack effect? why?
+- remove useless-coerce optimization
 
 + ui:
 

library/compiler/pentium4/intrinsics.factor

@@ -9,37 +9,8 @@ M: float-regs (%peek)
     fp-scratch swap %move-int>int
     fp-scratch %move-int>float ;
 
-: load-zone-ptr ( reg -- )
-    #! Load pointer to start of zone array
-    dup 0 MOV
-    "generations" f rel-absolute-cell rel-dlsym
-    dup [] MOV ;
-
-: load-allot-ptr ( vreg -- )
-    dup load-zone-ptr dup cell [+] MOV ;
-
-: inc-allot-ptr ( vreg n -- )
-    >r dup load-zone-ptr cell [+] r> ADD ;
-
-: with-inline-alloc ( prequot postquot spec -- )
-    #! both quotations are called with the vreg
-    [
-        alloc-tmp-reg PUSH
-        alloc-tmp-reg load-allot-ptr
-        alloc-tmp-reg [] \ tag-header get call tag-header MOV
-        >r call alloc-tmp-reg \ tag get call OR
-        r> call alloc-tmp-reg \ size get call inc-allot-ptr
-        alloc-tmp-reg POP
-    ] bind ; inline
-
 M: float-regs (%replace)
-    drop
+    drop swap %allot-float ;
-    [ alloc-tmp-reg 8 [+] rot v>operand MOVSD ]
-    [ v>operand alloc-tmp-reg MOV ] H{
-        { tag-header [ float-tag ] }
-        { tag [ float-tag ] }
-        { size [ 16 ] }
-    } with-inline-alloc ;
 
 ! Floats
 : define-float-op ( word op -- )

library/compiler/x86/allot.factor

@@ -0,0 +1,71 @@
+! Copyright (C) 2006 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+IN: compiler
+USING: kernel assembler kernel-internals namespaces math ;
+
+: load-zone-ptr ( reg -- )
+    #! Load pointer to start of zone array
+    dup 0 MOV
+    "generations" f rel-absolute-cell rel-dlsym
+    dup [] MOV ;
+
+: load-allot-ptr ( reg -- )
+    dup load-zone-ptr dup cell [+] MOV ;
+
+: inc-allot-ptr ( reg n -- )
+    >r dup load-zone-ptr cell [+] r> ADD ;
+
+: %allot ( header size quot -- )
+    swap >r >r
+    alloc-tmp-reg PUSH
+    alloc-tmp-reg load-allot-ptr
+    alloc-tmp-reg [] rot tag-header MOV
+    r> call
+    alloc-tmp-reg r> 8 align inc-allot-ptr
+    alloc-tmp-reg POP ; inline
+
+: %allot-float ( loc vreg -- )
+    #! Only called by pentium4 backend
+    float-tag 16 [
+        alloc-tmp-reg 8 [+] rot v>operand MOVSD
+        alloc-tmp-reg float-tag OR
+        v>operand alloc-tmp-reg MOV
+    ] %allot ;
+
+M: float-regs (%replace)
+    drop swap %allot-float ;
+
+: %allot-bignum ( #digits quot -- )
+    #! 1 cell header, 1 cell length, 1 cell sign, + digits
+    #! length is the # of digits + sign
+    bignum-tag pick 3 + cells [
+        >r alloc-tmp-reg cell [+] swap 1+ tag-bits shift MOV r>
+        call
+    ] %allot ; inline
+
+: %allot-bignum-signed-1 ( reg -- )
+    #! on entry, reg is a signed 32-bit quantity
+    #! exits with tagged ptr to bignum in reg
+    [
+        1 [
+            ! todo: neg
+            alloc-tmp-reg 2 cells [+] 0 MOV ! positive sign
+            alloc-tmp-reg 3 cells [+] over MOV
+            alloc-tmp-reg bignum-tag OR
+            MOV
+        ] %allot-bignum
+    ] with-scope ;
+
+: %allot-bignum-signed-2 ( reg1 reg2 -- )
+    #! on entry, reg1 and reg2 together form a signed 64-bit
+    #! quantity.
+    #! exits with tagged ptr to bignum in reg1
+    [
+        2 [
+            alloc-tmp-reg 2 cells [+] 0 MOV ! positive sign
+            alloc-tmp-reg 3 cells [+] swap MOV
+            alloc-tmp-reg 4 cells [+] over MOV
+            alloc-tmp-reg bignum-tag OR
+            MOV
+        ] %allot-bignum
+    ] with-scope ;

library/compiler/x86/intrinsics.factor

@@ -153,10 +153,7 @@ IN: compiler
     { +output+ { "out" } }
 } define-intrinsic
 
-: ?MOV ( dst src -- ) 2dup = [ 2drop ] [ MOV ] if ;
-
 : simple-overflow ( word -- )
-    finalize-contents
     "z" operand "x" operand MOV
     "z" operand "y" operand pick execute
     ! If the previous arithmetic operation overflowed, then we
@@ -166,10 +163,8 @@ IN: compiler
     ! There was an overflow. Recompute the original operand.
     { "y" "x" } [ tag-bits SAR ] unique-operands
     "x" operand "y" operand rot execute
-    "s48_long_to_bignum" f "x" operand 1array compile-c-call*
+    "x" operand %allot-bignum-signed-1
-    ! An untagged pointer to the bignum is now in EAX; tag it
+    "z" operand "x" operand MOV
-    T{ int-regs } return-reg bignum-tag OR
-    "z" operand T{ int-regs } return-reg ?MOV
     "end" resolve-label ; inline
 
 : simple-overflow-template ( word insn -- )
@@ -184,19 +179,11 @@ IN: compiler
 \ fixnum- \ SUB simple-overflow-template
 
 \ fixnum* [
-    finalize-contents
     "y" operand tag-bits SAR
     "y" operand IMUL
     "end" define-label
     "end" get JNO
-    "s48_fixnum_pair_to_bignum" f
+    "x" operand remainder-reg %allot-bignum-signed-2
-    "x" operand remainder-reg 2array compile-c-call*
-    ! now we have to shift it by three bits to remove the second
-    ! tag
-    "s48_bignum_arithmetic_shift" f
-    "x" operand tag-bits neg 2array compile-c-call*
-    ! an untagged pointer to the bignum is now in EAX; tag it
-    T{ int-regs } return-reg bignum-tag OR
     "end" resolve-label
 ] H{
     { +input+ { { 0 "x" } { 1 "y" } } }
@@ -217,19 +204,7 @@ IN: compiler
     "x" operand 1 tag-bits shift IMUL2
     ! Did it overflow?
     "end" get JNO
-    ! There was an overflow, so make ECX into a bignum. we must
+    "y" operand %allot-bignum-signed-1
-    ! save EDX since its volatile.
-    remainder-reg PUSH
-    ! Align the stack -- only needed on Mac OS X
-    stack-reg 16 cell - SUB
-    "s48_long_to_bignum" f
-    "y" operand 1array compile-c-call*
-    ! An untagged pointer to the bignum is now in EAX; tag it
-    T{ int-regs } return-reg bignum-tag OR
-    ! Align the stack -- only needed on Mac OS X
-    stack-reg 16 cell - ADD
-    ! the remainder is now in EDX
-    remainder-reg POP
     "end" resolve-label ;
 
 \ fixnum/i [ generate-fixnum/mod ] H{

library/compiler/x86/load.factor

@@ -2,5 +2,6 @@ PROVIDE: library/compiler/x86
 { +files+ {
     "assembler.factor"
     "architecture.factor"
+    "allot.factor"
     "intrinsics.factor"
 } } ;