cpu.x86.*: improved varargs support

Now on the x86.64 platform, we set the AL register to contain the nr of
floating point values passed to the function as required by the abi.

basis/cpu/x86/32/32.factor

@@ -192,7 +192,7 @@ M: x86.32 %end-callback ( -- )
     ! MINGW ABI incompatibility disaster
     [ large-struct? ] [ mingw eq? os windows? not or ] bi* and ;
 
-M: x86.32 %prepare-var-args ( -- ) ;
+M: x86.32 %prepare-var-args ( reg-inputs -- ) drop ;
 
 M:: x86.32 stack-cleanup ( stack-size return abi -- n )
     ! a) Functions which are stdcall/fastcall/thiscall have to

basis/cpu/x86/64/64.factor

@@ -1,11 +1,10 @@
 ! Copyright (C) 2005, 2011 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.c-types assocs combinators
-compiler.cfg.intrinsics compiler.codegen.gc-maps
-compiler.codegen.labels compiler.codegen.relocation
-compiler.constants cpu.architecture cpu.x86 cpu.x86.assembler
-cpu.x86.assembler.operands cpu.x86.features kernel layouts locals
-math sequences specialized-arrays system vocabs ;
+USING: alien alien.c-types assocs combinators compiler.cfg.intrinsics
+compiler.codegen.gc-maps compiler.codegen.labels
+compiler.codegen.relocation compiler.constants cpu.architecture
+cpu.x86 cpu.x86.assembler cpu.x86.assembler.operands cpu.x86.features
+kernel locals math sequences specialized-arrays system vocabs ;
 SPECIALIZED-ARRAY: uint
 IN: cpu.x86.64
 
@@ -112,8 +111,6 @@ M: x86.64 %end-callback ( -- )
     param-reg-0 vm-reg MOV
     "end_callback" f f %c-invoke ;
 
-M: x86.64 %prepare-var-args ( -- ) EAX EAX XOR ;
-
 M: x86.64 stack-cleanup 3drop 0 ;
 
 M: x86.64 %cleanup 0 assert= ;

basis/cpu/x86/64/unix/unix.factor

@@ -1,10 +1,9 @@
 ! Copyright (C) 2008, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays sequences math splitting make assocs
-kernel layouts system alien.c-types classes.struct
-cpu.architecture cpu.x86.assembler cpu.x86.assembler.operands
-cpu.x86 cpu.x86.64 compiler.cfg.builder.alien
-compiler.cfg.builder.alien.boxing compiler.cfg.registers ;
+USING: accessors alien.c-types arrays assocs
+compiler.cfg.builder.alien.boxing cpu.architecture cpu.x86
+cpu.x86.assembler cpu.x86.assembler.operands kernel layouts make math
+math.order sequences splitting system ;
 IN: cpu.x86.64.unix
 
 M: x86.64 param-regs
@@ -44,3 +43,7 @@ M: x86.64 dummy-stack-params? f ;
 M: x86.64 dummy-int-params? f ;
 
 M: x86.64 dummy-fp-params? f ;
+
+M: x86.64 %prepare-var-args ( reg-inputs -- )
+    [ second reg-class-of float-regs? ] count 8 min
+    [ EAX EAX XOR ] [ <byte> AL swap MOV ] if-zero ;

basis/cpu/x86/64/windows/windows.factor

@@ -23,3 +23,6 @@ M: x86.64 dummy-stack-params? f ;
 M: x86.64 dummy-int-params? t ;
 
 M: x86.64 dummy-fp-params? t ;
+
+M: x86.64 %prepare-var-args ( reg-inputs -- )
+    drop ;

basis/cpu/x86/x86-docs.factor

@@ -1,6 +1,6 @@
 USING: compiler.cfg.registers cpu.x86.assembler
-cpu.x86.assembler.operands.private help.markup help.syntax layouts
-math ;
+cpu.x86.assembler.operands cpu.x86.assembler.operands.private
+help.markup help.syntax layouts math sequences system ;
 IN: cpu.x86
 
 HELP: %boolean
@@ -12,6 +12,10 @@ HELP: %boolean
 { $description "Helper word for emitting conditional move instructions." }
 { $see-also CMOVL CMOVLE CMOVG CMOVGE CMOVE CMOVNE } ;
 
+HELP: %prepare-var-args
+{ $values { "reg-inputs" sequence } }
+{ $description "Emits code needed for calling variadic functions. On " { $link unix } " " { $link x86.64 } ", the " { $link AL } " register must contain the number of float registers used. " } ;
+
 HELP: JLE
 { $values { "dst" "destination offset (relative to the instruction pointer register)" } }
 { $description "Emits a 'jle' instruction." } ;

basis/cpu/x86/x86-tests.factor

@@ -82,9 +82,19 @@ cpu x86.64? [
 
 ! %prepare-varargs
 ${
-    cpu x86.64? B{ 49 192 } B{ } ?
+    ! xor eax, eax
+    cpu x86.64? os unix? and B{ 49 192 } B{ } ?
+    ! mov al, 2
+    cpu x86.64? os unix? and B{ 176 2 } B{ } ?
 } [
-    [ %prepare-var-args ] B{ } make
+    [ { } %prepare-var-args ] B{ } make
+    [
+        {
+            { T{ spill-slot } int-rep RDI }
+            { T{ spill-slot { n 0 } } float-rep XMM0 }
+            { T{ spill-slot { n 8 } } double-rep XMM1 }
+        } %prepare-var-args
+    ] B{ } make
 ] unit-test
 
 ! %prologue

basis/cpu/x86/x86.factor

@@ -645,20 +645,19 @@ HOOK: %discard-reg-param cpu ( rep reg -- )
 : %store-return ( dst rep -- )
     dup return-reg %store-reg-param ;
 
-HOOK: %prepare-var-args cpu ( -- )
+HOOK: %prepare-var-args cpu ( reg-inputs -- )
 
 HOOK: %cleanup cpu ( n -- )
 
 M:: x86 %alien-assembly ( reg-inputs
-                         stack-inputs
-                         reg-outputs
-                         dead-outputs
-                         cleanup
-                         stack-size
-                         quot -- )
+                          stack-inputs
+                          reg-outputs
+                          dead-outputs
+                          cleanup
+                          stack-size
+                          quot -- )
     stack-inputs [ first3 %store-stack-param ] each
-    reg-inputs [ first3 %store-reg-param ] each
-    %prepare-var-args
+    reg-inputs [ [ first3 %store-reg-param ] each ] [ %prepare-var-args ] bi
     quot call( -- )
     cleanup %cleanup
     reg-outputs [ first3 %load-reg-param ] each
@@ -671,7 +670,10 @@ M: x86 %alien-invoke ( reg-inputs stack-inputs
                        symbols dll gc-map -- )
                        '[ _ _ _ %c-invoke ] %alien-assembly ;
 
-M:: x86 %alien-indirect ( src reg-inputs stack-inputs reg-outputs dead-outputs cleanup stack-size gc-map -- )
+M:: x86 %alien-indirect ( src
+                          reg-inputs stack-inputs
+                          reg-outputs dead-outputs
+                          cleanup stack-size gc-map -- )
     reg-inputs stack-inputs reg-outputs dead-outputs cleanup stack-size [
         src ?spill-slot CALL
         gc-map gc-map-here