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
+USING: alien alien.c-types assocs combinators compiler.cfg.intrinsics
-compiler.cfg.intrinsics compiler.codegen.gc-maps
+compiler.codegen.gc-maps compiler.codegen.labels
-compiler.codegen.labels compiler.codegen.relocation
+compiler.codegen.relocation compiler.constants cpu.architecture
-compiler.constants cpu.architecture cpu.x86 cpu.x86.assembler
+cpu.x86 cpu.x86.assembler cpu.x86.assembler.operands cpu.x86.features
-cpu.x86.assembler.operands cpu.x86.features kernel layouts locals
+kernel locals math sequences specialized-arrays system vocabs ;
-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
+USING: accessors alien.c-types arrays assocs
-kernel layouts system alien.c-types classes.struct
+compiler.cfg.builder.alien.boxing cpu.architecture cpu.x86
-cpu.architecture cpu.x86.assembler cpu.x86.assembler.operands
+cpu.x86.assembler cpu.x86.assembler.operands kernel layouts make math
-cpu.x86 cpu.x86.64 compiler.cfg.builder.alien
+math.order sequences splitting system ;
-compiler.cfg.builder.alien.boxing compiler.cfg.registers ;
 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
+cpu.x86.assembler.operands cpu.x86.assembler.operands.private
-math ;
+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
+                          stack-inputs
-                         reg-outputs
+                          reg-outputs
-                         dead-outputs
+                          dead-outputs
-                         cleanup
+                          cleanup
-                         stack-size
+                          stack-size
-                         quot -- )
+                          quot -- )
     stack-inputs [ first3 %store-stack-param ] each
-    reg-inputs [ first3 %store-reg-param ] each
+    reg-inputs [ [ first3 %store-reg-param ] each ] [ %prepare-var-args ] bi
-    %prepare-var-args
     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