diff --git a/basis/alien/arrays/arrays.factor b/basis/alien/arrays/arrays.factor index bf87cfd9f1..a58549627c 100644 --- a/basis/alien/arrays/arrays.factor +++ b/basis/alien/arrays/arrays.factor @@ -26,8 +26,6 @@ M: array base-type drop void* base-type ; M: array stack-size drop void* stack-size ; -M: array flatten-c-type drop void* flatten-c-type ; - PREDICATE: string-type < pair first2 [ c-string = ] [ word? ] bi* and ; @@ -49,8 +47,6 @@ M: string-type stack-size drop void* stack-size ; M: string-type c-type-rep drop int-rep ; -M: string-type flatten-c-type drop void* flatten-c-type ; - M: string-type c-type-boxer-quot second dup binary = [ drop void* c-type-boxer-quot ] diff --git a/basis/alien/c-types/c-types.factor b/basis/alien/c-types/c-types.factor index d916ce9dec..af9ef4dc16 100644 --- a/basis/alien/c-types/c-types.factor +++ b/basis/alien/c-types/c-types.factor @@ -127,17 +127,6 @@ GENERIC: stack-size ( name -- size ) M: c-type stack-size size>> cell align ; -: (flatten-c-type) ( type rep -- seq ) - [ stack-size cell /i ] dip ; inline - -GENERIC: flatten-c-type ( type -- reps ) - -M: c-type flatten-c-type rep>> 1array ; -M: c-type-name flatten-c-type c-type flatten-c-type ; - -: flatten-c-types ( types -- reps ) - [ flatten-c-type ] map concat ; - MIXIN: value-type : c-getter ( name -- quot ) @@ -165,8 +154,7 @@ PROTOCOL: c-type-protocol c-type-align-first base-type heap-size - stack-size - flatten-c-type ; + stack-size ; CONSULT: c-type-protocol c-type-name c-type ; @@ -185,9 +173,6 @@ TUPLE: long-long-type < c-type ; : ( -- c-type ) long-long-type new ; -M: long-long-type flatten-c-type - int-rep (flatten-c-type) ; - : define-deref ( c-type -- ) [ name>> CHAR: * prefix "alien.c-types" create ] [ c-getter 0 prefix ] bi (( c-ptr -- value )) define-inline ; diff --git a/basis/classes/struct/struct.factor b/basis/classes/struct/struct.factor index e0a168cb7d..d8835c1dca 100644 --- a/basis/classes/struct/struct.factor +++ b/basis/classes/struct/struct.factor @@ -171,11 +171,10 @@ M: struct-c-type base-type ; M: struct-c-type stack-size dup value-struct? [ heap-size cell align ] [ drop cell ] if ; -HOOK: flatten-struct-type cpu ( type -- reps ) +HOOK: flatten-struct-type cpu ( type -- pairs ) -M: object flatten-struct-type int-rep (flatten-c-type) ; - -M: struct-c-type flatten-c-type flatten-struct-type ; +M: object flatten-struct-type + stack-size cell /i { int-rep f } ; M: struct-c-type c-struct? drop t ; diff --git a/basis/compiler/cfg/builder/alien/alien.factor b/basis/compiler/cfg/builder/alien/alien.factor index 6544d656fa..6f12a390d4 100644 --- a/basis/compiler/cfg/builder/alien/alien.factor +++ b/basis/compiler/cfg/builder/alien/alien.factor @@ -37,9 +37,9 @@ M:: struct-c-type unbox-parameter ( src c-type -- ) src ^^unbox-any-c-ptr :> src c-type value-struct? [ c-type flatten-struct-type - [| rep i | - src i cells rep f ^^load-memory-imm - rep struct-on-stack? 3array + [| pair i | + src i cells pair first f ^^load-memory-imm + pair first2 3array ] map-index ] [ { { src int-rep f } } ] if ; @@ -222,6 +222,17 @@ M: struct-c-type box-parameter rep dup reg-class-of reg-class-full? [ alloc-stack-param stack-params ] [ [ next-reg-param ] keep ] if ; +GENERIC: flatten-c-type ( type -- reps ) + +M: struct-c-type flatten-c-type + flatten-struct-type [ first2 [ drop stack-params ] when ] map ; +M: long-long-type flatten-c-type drop { int-rep int-rep } ; +M: c-type flatten-c-type rep>> 1array ; +M: object flatten-c-type base-type flatten-c-type ; + +: flatten-c-types ( types -- reps ) + [ flatten-c-type ] map concat ; + : (registers>objects) ( params -- ) [ 0 ] dip alien-parameters flatten-c-types [ [ alloc-parameter ##save-param-reg ] diff --git a/basis/cpu/architecture/architecture.factor b/basis/cpu/architecture/architecture.factor index e485cfcb1e..2d9f845c57 100644 --- a/basis/cpu/architecture/architecture.factor +++ b/basis/cpu/architecture/architecture.factor @@ -552,9 +552,6 @@ HOOK: dummy-fp-params? cpu ( -- ? ) ! If t, long longs are never passed in param regs HOOK: long-long-on-stack? cpu ( -- ? ) -! If t, structs are never passed in param regs -HOOK: struct-on-stack? cpu ( -- ? ) - ! If t, the struct return pointer is never passed in a param reg HOOK: struct-return-on-stack? cpu ( -- ? ) diff --git a/basis/cpu/x86/64/64.factor b/basis/cpu/x86/64/64.factor index 9c42a99096..3721c17cf4 100644 --- a/basis/cpu/x86/64/64.factor +++ b/basis/cpu/x86/64/64.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays kernel math namespaces make sequences system layouts alien alien.c-types alien.accessors alien.libraries -slots splitting assocs combinators locals compiler.constants +slots splitting assocs combinators fry locals compiler.constants classes.struct compiler.codegen compiler.codegen.fixup compiler.cfg.instructions compiler.cfg.builder compiler.cfg.intrinsics compiler.cfg.stack-frame @@ -112,7 +112,13 @@ M:: x86.64 %unbox ( dst src func rep -- ) call ] with-scope ; inline -: %unbox-struct-field ( rep i -- ) +: each-struct-component ( c-type quot -- ) + '[ + flatten-struct-type + [ [ first ] dip @ ] each-index + ] with-return-regs ; inline + +: %unbox-struct-component ( rep i -- ) R11 swap cells [+] swap reg-class-of { { int-regs [ int-regs get pop swap MOV ] } { float-regs [ float-regs get pop swap MOVSD ] } @@ -121,10 +127,7 @@ M:: x86.64 %unbox ( dst src func rep -- ) M:: x86.64 %store-struct-return ( src c-type -- ) ! Move src to R11 so that we don't clobber it. R11 src int-rep %copy - [ - c-type flatten-struct-type - [ %unbox-struct-field ] each-index - ] with-return-regs ; + c-type [ %unbox-struct-component ] each-struct-component ; M: stack-params copy-register* drop @@ -142,25 +145,23 @@ M:: x86.64 %box ( dst n rep func -- ) func f %alien-invoke dst RAX tagged-rep %copy ; -: box-struct-field@ ( i -- operand ) 1 + cells param@ ; +: box-struct-component@ ( i -- operand ) 1 + cells param@ ; -: %box-struct-field ( rep i -- ) - box-struct-field@ swap reg-class-of { +: %box-struct-component ( rep i -- ) + box-struct-component@ swap reg-class-of { { int-regs [ int-regs get pop MOV ] } { float-regs [ float-regs get pop MOVSD ] } } case ; M:: x86.64 %box-small-struct ( dst c-type -- ) #! Box a <= 16-byte struct. - [ - c-type flatten-struct-type [ %box-struct-field ] each-index - param-reg-2 c-type heap-size MOV - param-reg-0 0 box-struct-field@ MOV - param-reg-1 1 box-struct-field@ MOV - param-reg-3 %mov-vm-ptr - "from_small_struct" f %alien-invoke - dst RAX tagged-rep %copy - ] with-return-regs ; + c-type [ %box-struct-component ] each-struct-component + param-reg-2 c-type heap-size MOV + param-reg-0 0 box-struct-component@ MOV + param-reg-1 1 box-struct-component@ MOV + param-reg-3 %mov-vm-ptr + "from_small_struct" f %alien-invoke + dst RAX tagged-rep %copy ; M: x86.64 struct-return@ ( n -- operand ) [ stack-frame get params>> ] unless* param@ ; @@ -219,8 +220,6 @@ M:: x86.64 %call-gc ( gc-roots -- ) M: x86.64 long-long-on-stack? f ; -M: x86.64 struct-on-stack? f ; - M: x86.64 struct-return-on-stack? f ; ! The result of reading 4 bytes from memory is a fixnum on diff --git a/basis/cpu/x86/64/unix/unix.factor b/basis/cpu/x86/64/unix/unix.factor index 4e81e8ce13..a5a1cbcc50 100644 --- a/basis/cpu/x86/64/unix/unix.factor +++ b/basis/cpu/x86/64/unix/unix.factor @@ -28,10 +28,11 @@ M: x86.64 reserved-stack-space 0 ; struct-types&offset split-struct [ [ c-type c-type-rep reg-class-of ] map int-regs swap member? int-rep double-rep ? + f 2array ] map ; : flatten-large-struct ( c-type -- seq ) - stack-params (flatten-c-type) ; + stack-size cell /i { int-rep t } ; ; M: x86.64 flatten-struct-type ( c-type -- seq ) dup heap-size 16 >