compiler.cfg: generalize ##prepare-struct-caller instruction to alloca()-like ##local-allot

basis/compiler/cfg/build-stack-frame/build-stack-frame.factor

@@ -6,19 +6,25 @@ compiler.cfg.rpo compiler.cfg.instructions
 compiler.cfg.registers compiler.cfg.stack-frame ;
 IN: compiler.cfg.build-stack-frame
 
+SYMBOL: local-allot
+
 SYMBOL: frame-required?
 
 GENERIC: compute-stack-frame* ( insn -- )
 
+: frame-required ( -- ) frame-required? on ;
+
 : request-stack-frame ( stack-frame -- )
-    frame-required? on
+    frame-required
     stack-frame [ max-stack-frame ] change ;
 
+M: ##local-allot compute-stack-frame*
+    local-allot get >>offset
+    size>> local-allot +@ ;
+
 M: ##stack-frame compute-stack-frame*
     stack-frame>> request-stack-frame ;
 
-: frame-required ( -- ) frame-required? on ;
-
 : vm-frame-required ( -- )
     frame-required
     stack-frame new vm-stack-space >>params request-stack-frame ;
@@ -45,13 +51,18 @@ M: ##integer>float compute-stack-frame*
 
 M: insn compute-stack-frame* drop ;
 
-: initial-stack-frame ( -- stack-frame )
+: request-spill-area ( n -- )
-    stack-frame new cfg get spill-area-size>> >>spill-area-size ;
+    stack-frame new swap >>spill-area-size request-stack-frame ;
+
+: request-local-allot ( n -- )
+    stack-frame new swap >>local-allot request-stack-frame ;
 
 : compute-stack-frame ( cfg -- )
-    initial-stack-frame stack-frame set
+    0 local-allot set
-    [ spill-area-size>> 0 > frame-required? set ]
+    stack-frame new stack-frame set
+    [ spill-area-size>> [ request-spill-area ] unless-zero ]
     [ [ instructions>> [ compute-stack-frame* ] each ] each-basic-block ] bi
+    local-allot get [ request-local-allot ] unless-zero
     stack-frame get dup stack-frame-size >>total-size drop ;
 
 : build-stack-frame ( cfg -- cfg )

basis/compiler/cfg/builder/alien/alien.factor

@@ -21,11 +21,13 @@ IN: compiler.cfg.builder.alien
     ]
     [ length neg ##inc-d ] bi ;
 
-: prepare-struct-caller ( vregs reps return -- vregs' reps' )
+: prepare-struct-caller ( vregs reps return -- vregs' reps' return-vreg/f )
-    large-struct? [
+    dup large-struct? [
-        [ ^^prepare-struct-caller prefix ]
+        heap-size f ^^local-allot [
+            '[ _ prefix ]
             [ int-rep struct-return-on-stack? 2array prefix ] bi*
-    ] when ;
+        ] keep
+    ] [ drop f ] if ;
 
 : caller-parameter ( vreg rep on-stack? -- insn )
     [ dup reg-class-of reg-class-full? ] dip or
@@ -44,10 +46,12 @@ IN: compiler.cfg.builder.alien
     [ abi>> ] [ parameters>> ] [ return>> ] tri
     '[ 
         _ unbox-parameters
-        _ prepare-struct-caller
+        _ prepare-struct-caller struct-return-area set
         (caller-parameters)
         stack-params get
-    ] with-param-regs ;
+        struct-return-area get
+    ] with-param-regs
+    struct-return-area set ;
 
 : box-return* ( node -- )
     return>> [ ] [ base-type box-return 1 ##inc-d D 0 ##replace ] if-void ;
@@ -79,10 +83,6 @@ M: array dlsym-valid? '[ _ dlsym ] any? ;
     [ library>> load-library ]
     bi 2dup check-dlsym ;
 
-: return-size ( c-type -- n )
-    ! Amount of space we reserve for a return value.
-    dup large-struct? [ heap-size ] [ drop 0 ] if ;
-
 : alien-node-height ( params -- )
     [ out-d>> length ] [ in-d>> length ] bi - adjust-d ;
 
@@ -93,15 +93,13 @@ M: array dlsym-valid? '[ _ dlsym ] any? ;
         _ [ alien-node-height ] bi
     ] emit-trivial-block ; inline
 
-: <alien-stack-frame> ( stack-size return -- stack-frame )
+: <alien-stack-frame> ( stack-size -- stack-frame )
-    stack-frame new
+    stack-frame new swap >>params ;
-        swap return-size >>return
-        swap >>params ;
 
 : emit-stack-frame ( stack-size params -- )
-    [ return>> ] [ abi>> ] bi
+    [ [ return>> ] [ abi>> ] bi stack-cleanup ##cleanup ]
-    [ stack-cleanup ##cleanup ]
+    [ drop <alien-stack-frame> ##stack-frame ]
-    [ drop <alien-stack-frame> ##stack-frame ] 3bi ;
+    2bi ;
 
 M: #alien-invoke emit-node
     [

basis/compiler/cfg/builder/alien/boxing/boxing.factor

@@ -132,5 +132,5 @@ M: struct-c-type box-return
     [
         dup return-struct-in-registers?
         [ load-return ]
-        [ [ ^^prepare-struct-caller ] dip explode-struct keys ] if
+        [ [ struct-return-area get ] dip explode-struct keys ] if
     ] keep box ;

basis/compiler/cfg/instructions/instructions.factor

@@ -654,8 +654,9 @@ INSN: ##load-stack-param
 def: dst
 literal: n rep ;
 
-INSN: ##prepare-struct-caller
+INSN: ##local-allot
-def: dst/int-rep ;
+def: dst/int-rep
+literal: size offset ;
 
 INSN: ##box
 def: dst/tagged-rep

basis/compiler/cfg/stack-frame/stack-frame.factor

@@ -7,24 +7,24 @@ IN: compiler.cfg.stack-frame
 
 TUPLE: stack-frame
 { params integer }
-{ return integer }
+{ local-allot integer }
 { spill-area-size integer }
 { total-size integer } ;
 
 ! Stack frame utilities
-: return-offset ( -- offset )
+: local-allot-offset ( n -- offset )
-    stack-frame get params>> ;
+    stack-frame get params>> + ;
 
 : spill-offset ( n -- offset )
-    stack-frame get [ params>> ] [ return>> ] bi + + ;
+    stack-frame get [ params>> ] [ local-allot>> ] bi + + ;
 
 : (stack-frame-size) ( stack-frame -- n )
-    [ params>> ] [ return>> ] [ spill-area-size>> ] tri + + ;
+    [ params>> ] [ local-allot>> ] [ spill-area-size>> ] tri + + ;
 
 : max-stack-frame ( frame1 frame2 -- frame3 )
     [ stack-frame new ] 2dip
     {
         [ [ params>> ] bi@ max >>params ]
-        [ [ return>> ] bi@ max >>return ]
+        [ [ local-allot>> ] bi@ max >>local-allot ]
         [ [ spill-area-size>> ] bi@ max >>spill-area-size ]
     } 2cleave ;

basis/compiler/codegen/codegen.factor

@@ -290,7 +290,7 @@ CODEGEN: ##store-reg-param %store-reg-param
 CODEGEN: ##store-stack-param %store-stack-param
 CODEGEN: ##load-reg-param %load-reg-param
 CODEGEN: ##load-stack-param %load-stack-param
-CODEGEN: ##prepare-struct-caller %prepare-struct-caller
+CODEGEN: ##local-allot %local-allot
 CODEGEN: ##box %box
 CODEGEN: ##box-long-long %box-long-long
 CODEGEN: ##allot-byte-array %allot-byte-array

basis/cpu/architecture/architecture.factor

@@ -584,7 +584,7 @@ HOOK: %store-reg-param cpu ( src reg rep -- )
 
 HOOK: %store-stack-param cpu ( src n rep -- )
 
-HOOK: %prepare-struct-caller cpu ( dst -- )
+HOOK: %local-allot cpu ( dst size offset -- )
 
 ! Call a function to convert a value into a tagged pointer,
 ! possibly allocating a bignum, float, or alien instance,

basis/cpu/x86/sse/sse.factor

@@ -910,4 +910,7 @@ M: x86 %vector>scalar %copy ;
 
 M: x86 %scalar>vector %copy ;
 
+enable-float-intrinsics
+enable-float-functions
 enable-float-min/max
+enable-fsqrt

basis/cpu/x86/x86.factor

@@ -588,8 +588,8 @@ M:: x86 %store-stack-param ( src n rep -- )
 M:: x86 %load-stack-param ( dst n rep -- )
     dst n next-stack@ rep %copy ;
 
-M: x86 %prepare-struct-caller ( dst -- )
+M: x86 %local-allot ( dst size offset -- )
-    return-offset special-offset stack@ LEA ;
+    nip local-allot-offset special-offset stack@ LEA ;
 
 M: x86 %alien-indirect ( src -- )
     ?spill-slot CALL ;
@@ -693,10 +693,6 @@ M: x86 immediate-bitwise? ( n -- ? )
 enable-min/max
 enable-log2
 
-enable-float-intrinsics
-enable-float-functions
-enable-fsqrt
-
 : check-sse ( -- )
     "Checking for multimedia extensions... " write flush
     [ { (sse-version) } compile ] with-optimizer

basis/cpu/x86/x87/x87.factor

@@ -2,8 +2,9 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien.c-types combinators kernel locals system namespaces
 compiler.codegen.fixup compiler.constants
-compiler.cfg.comparisons cpu.architecture cpu.x86
+compiler.cfg.comparisons compiler.cfg.intrinsics
-cpu.x86.assembler cpu.x86.assembler.operands ;
+cpu.architecture cpu.x86 cpu.x86.assembler
+cpu.x86.assembler.operands ;
 IN: cpu.x86.x87
 
 ! x87 unit is only used if SSE2 is not available.
@@ -96,3 +97,7 @@ M: x86 %compare-float-ordered-branch ( label src1 src2 cc -- )
 
 M: x86 %compare-float-unordered-branch ( label src1 src2 cc -- )
     [ [ FUCOMI ] compare-op ] (%compare-float-branch) ;
+
+enable-float-intrinsics
+enable-float-functions
+enable-fsqrt