From 88fbcba0676ca4370aa6422f14051012dc46889b Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Thu, 1 Apr 2010 20:56:43 -0700
Subject: [PATCH] flatten non-integral types to (stack-value) on x86.32

---
 basis/compiler/alien/alien.factor          |  2 +-
 basis/compiler/codegen/codegen.factor      | 11 ++++++++++-
 basis/cpu/architecture/architecture.factor |  3 +++
 basis/cpu/ppc/ppc.factor                   |  2 ++
 basis/cpu/x86/32/32.factor                 | 12 +++++++++---
 basis/cpu/x86/64/64.factor                 |  2 ++
 basis/cpu/x86/64/unix/unix.factor          |  8 +-------
 7 files changed, 28 insertions(+), 12 deletions(-)

diff --git a/basis/compiler/alien/alien.factor b/basis/compiler/alien/alien.factor
index 7426d7e940..63df85be05 100644
--- a/basis/compiler/alien/alien.factor
+++ b/basis/compiler/alien/alien.factor
@@ -9,7 +9,7 @@ IN: compiler.alien
 
 : alien-parameters ( params -- seq )
     dup parameters>>
-    swap return>> large-struct? [ void* prefix ] when ;
+    swap return>> large-struct? [ struct-return-pointer-type prefix ] when ;
 
 : alien-return ( params -- type )
     return>> dup large-struct? [ drop void ] when ;
diff --git a/basis/compiler/codegen/codegen.factor b/basis/compiler/codegen/codegen.factor
index 12e263a3f4..4ffe062090 100755
--- a/basis/compiler/codegen/codegen.factor
+++ b/basis/compiler/codegen/codegen.factor
@@ -320,8 +320,17 @@ M: reg-class reg-class-full?
     [ alloc-stack-param ] [ alloc-fastcall-param ] if
     [ abi param-reg ] dip ;
 
+SYMBOL: (stack-value)
+<< void* c-type clone \ (stack-value) define-primitive-type
+stack-params \ (stack-value) c-type (>>rep) >>
+
+: ((flatten-type)) ( type to-type -- seq )
+    [ stack-size cell align cell /i ] dip c-type <repetition> ; inline
+
 : (flatten-int-type) ( type -- seq )
-    stack-size cell align cell /i void* c-type <repetition> ;
+    void* ((flatten-type)) ;
+: (flatten-stack-type) ( type -- seq )
+    (stack-value) ((flatten-type)) ;
 
 GENERIC: flatten-value-type ( type -- types )
 
diff --git a/basis/cpu/architecture/architecture.factor b/basis/cpu/architecture/architecture.factor
index 9a50b0a2e2..6f3865497b 100644
--- a/basis/cpu/architecture/architecture.factor
+++ b/basis/cpu/architecture/architecture.factor
@@ -502,6 +502,9 @@ HOOK: immediate-arithmetic? cpu ( n -- ? )
 ! %and-imm, %or-imm, and %xor-imm?
 HOOK: immediate-bitwise? cpu ( n -- ? )
 
+! What c-type describes the implicit struct return pointer for large structs?
+HOOK: struct-return-pointer-type cpu ( -- c-type )
+
 ! Is this structure small enough to be returned in registers?
 HOOK: return-struct-in-registers? cpu ( c-type -- ? )
 
diff --git a/basis/cpu/ppc/ppc.factor b/basis/cpu/ppc/ppc.factor
index f81d8705bf..dd9252129a 100644
--- a/basis/cpu/ppc/ppc.factor
+++ b/basis/cpu/ppc/ppc.factor
@@ -704,6 +704,8 @@ M: ppc immediate-arithmetic? ( n -- ? ) -32768 32767 between? ;
 
 M: ppc immediate-bitwise? ( n -- ? ) 0 65535 between? ;
 
+M: ppc struct-return-pointer-type void* ;
+
 M: ppc return-struct-in-registers? ( c-type -- ? )
     c-type return-in-registers?>> ;
 
diff --git a/basis/cpu/x86/32/32.factor b/basis/cpu/x86/32/32.factor
index e346f8ab8c..71439373c0 100755
--- a/basis/cpu/x86/32/32.factor
+++ b/basis/cpu/x86/32/32.factor
@@ -2,8 +2,8 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: locals alien alien.c-types alien.libraries alien.syntax
 arrays kernel fry math namespaces sequences system layouts io
-vocabs.loader accessors init combinators command-line make
-compiler compiler.units compiler.constants compiler.alien
+vocabs.loader accessors init classes.struct combinators command-line
+make compiler compiler.units compiler.constants compiler.alien
 compiler.codegen compiler.codegen.fixup
 compiler.cfg.instructions compiler.cfg.builder
 compiler.cfg.intrinsics compiler.cfg.stack-frame
@@ -357,6 +357,12 @@ M: x86.32 callback-return-rewind ( params -- n )
     } cond ;
 
 ! Dreadful
-M: object flatten-value-type (flatten-int-type) ;
+M: object flatten-value-type (flatten-stack-type) ;
+M: struct-c-type flatten-value-type (flatten-stack-type) ;
+M: long-long-type flatten-value-type (flatten-stack-type) ;
+M: c-type flatten-value-type
+    dup rep>> int-rep? [ (flatten-int-type) ] [ (flatten-stack-type) ] if ;
+
+M: x86.64 struct-return-pointer-type (stack-value) ;
 
 check-sse
diff --git a/basis/cpu/x86/64/64.factor b/basis/cpu/x86/64/64.factor
index ab75dbf00b..87578dd8db 100644
--- a/basis/cpu/x86/64/64.factor
+++ b/basis/cpu/x86/64/64.factor
@@ -275,6 +275,8 @@ M:: x86.64 %call-gc ( gc-root-count temp -- )
     ! Call GC
     "inline_gc" f %alien-invoke ;
 
+M: x86.64 struct-return-pointer-type void* ;
+
 ! The result of reading 4 bytes from memory is a fixnum on
 ! x86-64.
 enable-alien-4-intrinsics
diff --git a/basis/cpu/x86/64/unix/unix.factor b/basis/cpu/x86/64/unix/unix.factor
index 01e02d274d..a1868a3bc8 100644
--- a/basis/cpu/x86/64/unix/unix.factor
+++ b/basis/cpu/x86/64/unix/unix.factor
@@ -14,11 +14,6 @@ M: float-regs param-regs
 
 M: x86.64 reserved-stack-space 0 ;
 
-SYMBOL: (stack-value)
-! The ABI for passing structs by value is pretty great
-<< void* c-type clone \ (stack-value) define-primitive-type
-stack-params \ (stack-value) c-type (>>rep) >>
-
 : struct-types&offset ( struct-type -- pairs )
     fields>> [
         [ type>> ] [ offset>> ] bi 2array
@@ -36,8 +31,7 @@ stack-params \ (stack-value) c-type (>>rep) >>
     ] map ;
 
 : flatten-large-struct ( c-type -- seq )
-    heap-size cell align
-    cell /i \ (stack-value) c-type <repetition> ;
+    (flatten-stack-type) ;
 
 : flatten-struct ( c-type -- seq )
     dup heap-size 16 > [