]> gitweb.factorcode.org Git - factor.git/commitdiff
Fix conflict
authorSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Thu, 12 Feb 2009 15:22:35 +0000 (09:22 -0600)
committerSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Thu, 12 Feb 2009 15:22:35 +0000 (09:22 -0600)
basis/alien/complex/complex.factor
basis/alien/structs/structs.factor
basis/compiler/alien/alien.factor
basis/cpu/architecture/architecture.factor
basis/cpu/ppc/ppc.factor
basis/cpu/x86/32/32.factor
basis/cpu/x86/64/unix/unix.factor
basis/cpu/x86/64/winnt/winnt.factor
extra/ui/render/test/test.factor

index 60a84b939433520a358ed2838405a88b78883899..079ad57aa56f5afbce61488273cd5acba809be93 100644 (file)
@@ -1,6 +1,13 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien.complex.functor sequences kernel ;
+USING: alien.c-types alien.complex.functor accessors
+sequences kernel ;
 IN: alien.complex
 
-<< { "float" "double" } [ dup "complex-" prepend define-complex-type ] each >>
\ No newline at end of file
+<<
+{ "float" "double" } [ dup "complex-" prepend define-complex-type ] each
+
+! This overrides the fact that small structures are never returned
+! in registers on NetBSD, Linux and Solaris running on 32-bit x86.
+"complex-float" c-type t >>return-in-registers? drop
+ >>
index 8ec694198da383b0b6126db4e17e9bf8be95a344..ec9080690a4e27368bf01cac7a8fc499ddcaa2fc 100755 (executable)
@@ -3,7 +3,7 @@
 USING: accessors arrays assocs generic hashtables kernel kernel.private
 math namespaces parser sequences strings words libc fry
 alien.c-types alien.structs.fields cpu.architecture math.order
-quotations ;
+quotations byte-arrays ;
 IN: alien.structs
 
 TUPLE: struct-type
@@ -13,11 +13,14 @@ fields
 { boxer-quot callable }
 { unboxer-quot callable }
 { getter callable }
-{ setter callable } ;
+{ setter callable }
+return-in-registers? ;
+
+M: struct-type c-type ;
 
 M: struct-type heap-size size>> ;
 
-M: struct-type c-type-class drop object ;
+M: struct-type c-type-class drop byte-array ;
 
 M: struct-type c-type-align align>> ;
 
@@ -37,7 +40,7 @@ M: struct-type box-parameter
     [ %box-large-struct ] [ box-parameter ] if-value-struct ;
 
 : if-small-struct ( c-type true false -- ? )
-    [ dup struct-small-enough? ] 2dip '[ f swap @ ] if ; inline
+    [ dup return-struct-in-registers? ] 2dip '[ f swap @ ] if ; inline
 
 M: struct-type unbox-return
     [ %unbox-small-struct ] [ %unbox-large-struct ] if-small-struct ;
index 4a41014ab2c9ac7bae447d4b757c5fe4cd243893..59901cf79a8f3c22a03131c0fcb1474ac609a2da 100644 (file)
@@ -5,7 +5,7 @@ alien.c-types alien.structs cpu.architecture ;
 IN: compiler.alien
 
 : large-struct? ( ctype -- ? )
-    dup c-struct? [ struct-small-enough? not ] [ drop f ] if ;
+    dup c-struct? [ return-struct-in-registers? not ] [ drop f ] if ;
 
 : alien-parameters ( params -- seq )
     dup parameters>>
index 5670110f04dbfc32a1f5037159145b7b7d899d31..2c9675426bc4a8ca6da82ef686b3ac8b97b90907 100644 (file)
@@ -152,7 +152,7 @@ HOOK: %loop-entry cpu ( -- )
 HOOK: small-enough? cpu ( n -- ? )
 
 ! Is this structure small enough to be returned in registers?
-HOOK: struct-small-enough? cpu ( c-type -- ? )
+HOOK: return-struct-in-registers? cpu ( c-type -- ? )
 
 ! Do we pass this struct by value or hidden reference?
 HOOK: value-struct? cpu ( c-type -- ? )
index b177c71d77cd04b9a03b605f5756b3b789a6b287..f245bcb7e12355364e0ec1ad964239a58e669711 100644 (file)
@@ -659,7 +659,7 @@ M: ppc %callback-value ( ctype -- )
 
 M: ppc small-enough? ( n -- ? ) -32768 32767 between? ;
 
-M: ppc struct-small-enough? ( size -- ? ) drop f ;
+M: ppc return-struct-in-registers? ( c-type -- ? ) drop f ;
 
 M: ppc %box-small-struct
     drop "No small structs" throw ;
index affd39ffc576297219e638a5b47738e66eabedec..f881792ac60007440f7815f9800f9c69e6e261b0 100755 (executable)
@@ -48,9 +48,12 @@ M: x86.32 %alien-invoke (CALL) rel-dlsym ;
 
 M: x86.32 %alien-invoke-tail (JMP) rel-dlsym ;
 
-M: x86.32 struct-small-enough? ( size -- ? )
-    heap-size { 1 2 4 8 } member?
-    os { linux netbsd solaris } member? not and ;
+M: x86.32 return-struct-in-registers? ( c-type -- ? )
+    c-type
+    [ return-in-registers?>> ]
+    [ heap-size { 1 2 4 8 } member? ] bi
+    os { linux netbsd solaris } member? not
+    and or ;
 
 : struct-return@ ( n -- operand )
     [ next-stack@ ] [ stack-frame get params>> stack@ ] if* ;
index f5fb5b9640c3f1eb16be0fd3428eda6dbf55dc80..eea960d03dba6fe2e851acfe8fb123c7af286234 100644 (file)
@@ -44,7 +44,7 @@ M: struct-type flatten-value-type ( type -- seq )
         flatten-small-struct
     ] if ;
 
-M: x86.64 struct-small-enough? ( size -- ? )
+M: x86.64 return-struct-in-registers? ( c-type -- ? )
     heap-size 2 cells <= ;
 
 M: x86.64 dummy-stack-params? f ;
index 4c6af6c1e71242074560fe7893bca715210f9e2c..8091be65ae49c31cef64b2cf2d098a56b3e99609 100644 (file)
@@ -10,7 +10,8 @@ M: float-regs param-regs drop { XMM0 XMM1 XMM2 XMM3 } ;
 
 M: x86.64 reserved-area-size 4 cells ;
 
-M: x86.64 struct-small-enough? heap-size { 1 2 4 8 } member? ;
+M: x86.64 return-struct-in-registers? ( c-type -- ? )
+    heap-size { 1 2 4 8 } member? ;
 
 M: x86.64 value-struct? heap-size { 1 2 4 8 } member? ;
 
index 412ce5a0a5c1782fc330b99e9f6817b8cb25c870..1aa892557f92cad6227c8c7a7f1465a01cc3fb0e 100755 (executable)
@@ -1,10 +1,10 @@
 ! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors colors arrays kernel sequences math byte-arrays
-namespaces grouping fry cap images.bitmap
-ui.gadgets ui.gadgets.packs ui.gadgets.borders ui.gadgets.grids
-ui.gadgets.grid-lines ui.gadgets.labels ui.gadgets.buttons
-ui.render ui opengl opengl.gl colors.constants images ;
+namespaces grouping fry cap images.bitmap ui.gadgets ui.gadgets.packs
+ui.gadgets.borders ui.gadgets.grids ui.gadgets.grid-lines
+ui.gadgets.labels ui.gadgets.buttons ui.pens ui.pens.solid ui.render
+ui opengl opengl.gl colors.constants images images.loader ;
 IN: ui.render.test
 
 SINGLETON: line-test
@@ -40,7 +40,7 @@ SYMBOL: render-output
     screenshot
     [ render-output set-global ]
     [
-        "resource:extra/ui/render/test/reference.bmp" <image>
+        "resource:extra/ui/render/test/reference.bmp" load-image
         bitmap= "is perfect" "needs work" ?
         "Your UI rendering " prepend
         message-window