Move flatten-c-type to death row so that it can be executed in part 5

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 ]

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 <repetition> ; 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
+    stack-size ;
-    flatten-c-type ;
 
 CONSULT: c-type-protocol c-type-name
     c-type ;
@@ -185,9 +173,6 @@ TUPLE: long-long-type < c-type ;
 : <long-long-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 ;

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: object flatten-struct-type
-
+    stack-size cell /i { int-rep f } <repetition> ;
-M: struct-c-type flatten-c-type flatten-struct-type ;
 
 M: struct-c-type c-struct? drop t ;
 

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 |
+        [| pair i |
-            src i cells rep f ^^load-memory-imm
+            src i cells pair first f ^^load-memory-imm
-            rep struct-on-stack? 3array
+            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 ]

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 ( -- ? )
 

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 [ %unbox-struct-component ] each-struct-component ;
-        c-type flatten-struct-type
-        [ %unbox-struct-field ] each-index
-    ] with-return-regs ;
 
 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-component ( rep i -- )
-    box-struct-field@ swap reg-class-of {
+    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 [ %box-struct-component ] each-struct-component
-        c-type flatten-struct-type [ %box-struct-field ] each-index
+    param-reg-2 c-type heap-size MOV
-        param-reg-2 c-type heap-size MOV
+    param-reg-0 0 box-struct-component@ MOV
-        param-reg-0 0 box-struct-field@ MOV
+    param-reg-1 1 box-struct-component@ MOV
-        param-reg-1 1 box-struct-field@ MOV
+    param-reg-3 %mov-vm-ptr
-        param-reg-3 %mov-vm-ptr
+    "from_small_struct" f %alien-invoke
-        "from_small_struct" f %alien-invoke
+    dst RAX tagged-rep %copy ;
-        dst RAX tagged-rep %copy
-    ] with-return-regs ;
 
 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

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 } <repetition> ; ;
 
 M: x86.64 flatten-struct-type ( c-type -- seq )
     dup heap-size 16 >