Improve System V AMD64 ABI compliance

diff --git a/basis/compiler/cfg/builder/alien/alien.factor b/basis/compiler/cfg/builder/alien/alien.factor
index 57e96997f26cbb5e7028c741acbb618607246ce0..6fea1ec9023d15b6bf1039e1e8b690a714b237e2 100644 (file)
--- a/basis/compiler/cfg/builder/alien/alien.factor
+++ b/basis/compiler/cfg/builder/alien/alien.factor
@@ -15,6 +15,8 @@ IN: compiler.cfg.builder.alien
         0 stack-params set
         V{ } clone reg-values set
         V{ } clone stack-values set
+        0 int-reg-reps set
+        0 float-reg-reps set
         @
         reg-values get
         stack-values get
@@ -46,7 +48,7 @@ IN: compiler.cfg.builder.alien
 : caller-parameters ( params -- reg-inputs stack-inputs )
     [ abi>> ] [ parameters>> ] [ return>> ] tri
     '[
-        _ unbox-parameters
+        _ unbox-parameters 
         _ prepare-struct-caller struct-return-area set
         (caller-parameters)
     ] with-param-regs ;

diff --git a/basis/compiler/cfg/builder/alien/boxing/boxing.factor b/basis/compiler/cfg/builder/alien/boxing/boxing.factor
index e7713a09be679f2c907b63cfdebab20f6eded3be..689431a0e89d8545ccff1b97f042fe65c8088ae7 100644 (file)
--- a/basis/compiler/cfg/builder/alien/boxing/boxing.factor
+++ b/basis/compiler/cfg/builder/alien/boxing/boxing.factor
@@ -10,19 +10,39 @@ IN: compiler.cfg.builder.alien.boxing
 
 SYMBOL: struct-return-area
 
+SYMBOLS: int-reg-reps float-reg-reps ;
+
+: inc-not-f ( variable -- ) dup get [ inc ] [ drop ] if ; inline
+
+: dec-not-f ( variable -- ) dup get [ dec ] [ drop ] if ; inline
+
+: record-reg-reps ( seq -- seq )
+    dup [
+        dup second not [  ! on-stack?: f 
+            first int-rep? int-reg-reps float-reg-reps ? inc-not-f
+        ] [ drop ] if
+    ] each ;
+
+: unrecord-reg-reps ( seq -- seq )
+    dup [
+        dup second not [  ! on-stack?: f 
+            first int-rep? int-reg-reps float-reg-reps ? dec-not-f
+        ] [ drop ] if
+    ] each ;
+
 GENERIC: flatten-c-type ( c-type -- pairs )
 
 M: c-type flatten-c-type
-    rep>> f f 3array 1array ;
+    rep>> f f 3array 1array record-reg-reps ;
 
 M: long-long-type flatten-c-type
-    drop 2 [ int-rep long-long-on-stack? f 3array ] replicate ;
+    drop 2 [ int-rep long-long-on-stack? f 3array ] replicate record-reg-reps ;
 
 HOOK: flatten-struct-type cpu ( type -- pairs )
 HOOK: flatten-struct-type-return cpu ( type -- pairs )
 
 M: object flatten-struct-type
-    heap-size cell align cell /i { int-rep f f } <array> ;
+    heap-size cell align cell /i { int-rep f f } <array> record-reg-reps ;
 
 M: struct-c-type flatten-c-type
     flatten-struct-type ;
@@ -70,12 +90,12 @@ M: c-type unbox
             [ swap ^^unbox ]
         } case 1array
     ]
-    [ drop f f 3array 1array ] 2bi ;
+    [ drop f f 3array 1array ] 2bi record-reg-reps ;
 
 M: long-long-type unbox
     [ next-vreg next-vreg 2dup ] 2dip unboxer>> ##unbox-long-long, 2array
     int-rep long-long-on-stack? long-long-odd-register? 3array
-    int-rep long-long-on-stack? f 3array 2array ;
+    int-rep long-long-on-stack? f 3array 2array record-reg-reps ;
 
 M: struct-c-type unbox ( src c-type -- vregs reps )
     [ ^^unbox-any-c-ptr ] dip explode-struct ;

diff --git a/basis/cpu/x86/64/unix/unix.factor b/basis/cpu/x86/64/unix/unix.factor
index 6a605e9d0b741c1946b401d7485008300d490acc..5ebdb8b6d288c9a1daf49a76b8d4b362c06d3acc 100644 (file)
--- a/basis/cpu/x86/64/unix/unix.factor
+++ b/basis/cpu/x86/64/unix/unix.factor
@@ -2,8 +2,8 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors alien.c-types arrays assocs
 compiler.cfg.builder.alien.boxing cpu.architecture cpu.x86
-cpu.x86.assembler cpu.x86.assembler.operands kernel layouts make math
-math.order sequences splitting system ;
+cpu.x86.assembler cpu.x86.assembler.operands kernel layouts locals
+make math math.order namespaces sequences splitting system ;
 IN: cpu.x86.64.unix
 
 M: x86.64 param-regs
@@ -24,16 +24,33 @@ M: x86.64 reserved-stack-space 0 ;
         [ 8 mod zero? [ t , ] when , ] assoc-each
     ] { } make { t } split harvest ;
 
-: flatten-small-struct ( c-type -- seq )
-    struct-types&offset split-struct [
+:: flatten-small-struct ( c-type -- seq )
+    c-type struct-types&offset split-struct [
         [ lookup-c-type c-type-rep reg-class-of ] map
-        int-regs swap member? int-rep double-rep ?
-        f f 3array
-    ] map ;
+        int-regs swap member? int-rep double-rep ? f f 3array
+    ] map :> reps
+    int-reg-reps get float-reg-reps get and [
+        0 :> int-mems!
+        0 :> float-mems!
+        reps [
+            first int-rep? [
+                int-mems 1 + int-mems!
+            ] [
+                float-mems 1 + float-mems!
+            ] if
+        ] each
+        int-reg-reps get int-mems + 6 >
+        float-reg-reps get float-mems + 8 > or [
+            reps [ first t f 3array ] map
+        ] [ reps ] if
+    ] [ reps ] if ;
 
 M: x86.64 flatten-struct-type ( c-type -- seq )
     dup heap-size 16 <=
-    [ flatten-small-struct ] [ call-next-method [ first t f 3array ] map ] if ;
+    [ flatten-small-struct record-reg-reps ] [
+        call-next-method [ first t f 3array ] map
+        unrecord-reg-reps
+    ] if ;
 
 M: x86.64 return-struct-in-registers? ( c-type -- ? )
     heap-size 2 cells <= ;

diff --git a/basis/ui/backend/cocoa/views/views.factor b/basis/ui/backend/cocoa/views/views.factor
index eaa09b33519e2c444ac20eb3235a9b4abb804a09..6f412ce29a5727d221a6ae733ea94af952fca0e7 100644 (file)
--- a/basis/ui/backend/cocoa/views/views.factor
+++ b/basis/ui/backend/cocoa/views/views.factor
@@ -238,16 +238,15 @@ IMPORT: NSAttributedString
     ] [ underlines ] if ;
 
 :: update-marked-text ( gadget str selectedRange replacementRange -- )
-    replacementRange location>>  NSNotFound = not     ! [ 
-    replacementRange length>> NSNotFound = not and [  ! erase this line
+    replacementRange location>>  NSNotFound = not [ 
         gadget editor-caret first
         dup gadget editor-line
         [ 
-            replacementRange length>> ! location>>
+            replacementRange location>>
             >codepoint-index
             2array gadget set-caret
         ] [
-            replacementRange length>> 1 + ! [ location>> ] [ length>> ] bi +
+            replacementRange [ location>> ] [ length>> ] bi +
             >codepoint-index
             2array gadget set-mark
         ] 2bi