Merge branch 'master' of git://factorcode.org/git/factor
commit
215127e9f6
|
@ -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 >>
|
||||
<<
|
||||
{ "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
|
||||
>>
|
||||
|
|
|
@ -13,7 +13,10 @@ 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>> ;
|
||||
|
||||
|
@ -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 ;
|
||||
|
|
|
@ -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>>
|
||||
|
|
|
@ -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 -- ? )
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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* ;
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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? ;
|
||||
|
||||
|
|
|
@ -4,7 +4,7 @@ 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 images ;
|
||||
ui.render ui opengl opengl.gl images images.loader ;
|
||||
IN: ui.render.test
|
||||
|
||||
SINGLETON: line-test
|
||||
|
@ -38,7 +38,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
|
||||
|
|
Loading…
Reference in New Issue