some alien call cleanups

library/alien/compiler.factor

@@ -5,12 +5,6 @@ USING: assembler compiler compiler-backend compiler-frontend
 errors generic hashtables inference io kernel kernel-internals
 lists math namespaces prettyprint sequences strings words parser ;
 
-! ! ! WARNING ! ! !
-! Reloading this file into a running Factor instance on Win32
-! or Unix with FFI I/O will bomb the runtime, since I/O words
-! would become uncompiled, and FFI calls can only be made from
-! compiled code.
-
 ! USAGE:
 ! 
 ! Command line parameters given to the runtime specify libraries
@@ -72,7 +66,7 @@ C: alien-node make-node ;
 : stack-space ( parameters -- n )
     0 [ c-aligned + ] reduce ;
 
-: unbox-parameter ( n parameter -- node )
+: unbox-parameter ( stack# type -- node )
     c-type [ "unboxer" get "reg-class" get ] bind %unbox ;
 
 : unbox-parameters ( params -- )

library/compiler/amd64/alien.factor

@@ -1,15 +1,38 @@
 ! Copyright (C) 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: compiler-backend
-USING: alien assembler compiler inference kernel
+USING: alien assembler kernel math ;
-kernel-internals lists math memory namespaces words ;
 
-M: %alien-invoke generate-node drop ;
+GENERIC: store-insn ( from to offset reg-class -- )
 
-M: %parameter generate-node drop ;
+GENERIC: load-insn ( elt parameter reg-class -- )
 
-M: %unbox generate-node drop ;
+M: int-regs store-insn drop 1 swap stack@ STW ;
 
-M: %box generate-node drop ;
+M: int-regs load-insn drop 3 + 1 rot stack@ LWZ ;
 
-M: %cleanup generate-node drop ;
+M: float-regs store-insn
+    >r 1 swap stack@ r>
+    float-regs-size 4 = [ STFS ] [ STFD ] if ;
+
+M: float-regs load-insn
+    >r 1+ 1 rot stack@ r> 
+    float-regs-size 4 = [ LFS ] [ LFD ] if ;
+
+M: stack-params load-insn
+    drop >r 0 1 rot stack@ LWZ 0 1 r> stack@ STW ;
+
+M: %unbox generate-node ( vop -- )
+    drop
+    ! Call the unboxer
+    1 input f compile-c-call
+    ! Store the return value on the C stack
+    2 input return-reg 0 input 2 input store-insn ;
+
+M: %parameter generate-node ( vop -- )
+    ! Move a value from the C stack into the fastcall register
+    drop 0 input 1 input 2 input load-insn ;
+
+M: %box generate-node ( vop -- ) drop 0 input f compile-c-call ;
+
+M: %cleanup generate-node ( vop -- ) drop ;

library/compiler/amd64/architecture.factor

@@ -1,6 +1,6 @@
 IN: compiler-backend
 USING: alien arrays assembler compiler compiler-backend kernel
-math sequences ;
+kernel-internals math sequences ;
 
 ! AMD64 register assignments
 ! RAX RCX RDX RSI RDI R8 R9 R10 R11 vregs
@@ -13,11 +13,12 @@ math sequences ;
 
 : ds-reg R14 ; inline
 : cs-reg R15 ; inline
-: return-reg RAX ; inline
 : remainder-reg RDX ; inline
 
 : vregs { RAX RCX RDX RSI RDI R8 R9 R10 R11 } ; inline
 
+: alien-regs { RDI RSI RDX RCX R8 R9 } ; inline
+
 : param-regs { RDI RSI RDX RCX R8 R9 } ; inline
 
 : compile-c-call ( symbol dll -- )
@@ -27,9 +28,9 @@ math sequences ;
 : compile-c-call* ( symbol dll -- operands )
     param-regs swap [ MOV ] 2each compile-c-call ;
 
-! FIXME
+M: int-regs return-reg drop RAX ;
-M: int-regs fastcall-regs drop 0 ;
+M: int-regs fastcall-regs drop alien-regs length ;
-M: int-regs reg-class-size drop 4 ;
+
 M: float-regs fastcall-regs drop 0 ;
 
 : dual-fp/int-regs? f ;

library/compiler/architecture.factor

@@ -10,3 +10,5 @@ DEFER: vregs ( -- regs )
 DEFER: dual-fp/int-regs? ( -- ? )
 #! Should fp parameters to fastcalls be loaded in integer
 #! registers too? Only for PowerPC.
+
+DEFER: compile-c-call ( library function -- )

library/compiler/generator.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2004, 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: compiler-backend
-USING: assembler compiler errors inference kernel
+USING: alien assembler compiler errors inference kernel
 kernel-internals lists math memory namespaces sequences strings
 vectors words ;
 
@@ -60,6 +60,12 @@ M: %target-label generate-node ( vop -- )
 
 M: %parameters generate-node ( vop -- ) drop ;
 
+M: %parameter generate-node ( vop -- ) drop ;
+
+M: %alien-invoke generate-node
+    #! call a C function.
+    drop 0 input 1 input load-library compile-c-call ;
+
 : dest/src ( -- dest src ) 0 output-operand 0 input-operand ;
 
 ! These constants must match native/card.h

library/compiler/ppc/alien.factor

@@ -3,27 +3,18 @@
 IN: compiler-backend
 USING: alien assembler kernel math ;
 
-M: %alien-invoke generate-node ( vop -- )
-    drop 0 input 1 input load-library compile-c-call ;
-
 GENERIC: store-insn ( from to offset reg-class -- )
 
 GENERIC: load-insn ( elt parameter reg-class -- )
 
-GENERIC: return-reg ( reg-class -- reg )
-
 M: int-regs store-insn drop 1 swap stack@ STW ;
 
-M: int-regs return-reg drop 3 ;
-
 M: int-regs load-insn drop 3 + 1 rot stack@ LWZ ;
 
 M: float-regs store-insn
     >r 1 swap stack@ r>
     float-regs-size 4 = [ STFS ] [ STFD ] if ;
 
-M: float-regs return-reg drop 1 ;
-
 M: float-regs load-insn
     >r 1+ 1 rot stack@ r> 
     float-regs-size 4 = [ LFS ] [ LFD ] if ;
@@ -33,10 +24,13 @@ M: stack-params load-insn
 
 M: %unbox generate-node ( vop -- )
     drop
+    ! Call the unboxer
     1 input f compile-c-call
+    ! Store the return value on the C stack
     2 input return-reg 0 input 2 input store-insn ;
 
 M: %parameter generate-node ( vop -- )
+    ! Move a value from the C stack into the fastcall register
     drop 0 input 1 input 2 input load-insn ;
 
 M: %box generate-node ( vop -- ) drop 0 input f compile-c-call ;

library/compiler/ppc/architecture.factor

@@ -1,5 +1,5 @@
 IN: compiler-backend
-USING: assembler compiler-backend kernel math ;
+USING: assembler compiler-backend kernel kernel-internals math ;
 
 ! PowerPC register assignments
 ! r3-r10 vregs
@@ -12,8 +12,10 @@ USING: assembler compiler-backend kernel math ;
 
 : vregs { 3 4 5 6 7 8 9 10 } ; inline
 
+M: int-regs return-reg drop 3 ;
 M: int-regs fastcall-regs drop 8 ;
-M: int-regs reg-class-size drop 4 ;
+
+M: float-regs return-reg drop 1 ;
 M: float-regs fastcall-regs drop 8 ;
 
 ! Mach-O -vs- Linux/PPC

library/compiler/vops.factor

@@ -25,10 +25,14 @@ TUPLE: vreg n ;
 TUPLE: int-regs ;
 TUPLE: float-regs size ;
 
+GENERIC: return-reg ( register-class -- reg )
+
 GENERIC: fastcall-regs ( register-class -- n )
 
 GENERIC: reg-class-size ( register-class -- n )
 
+M: int-regs reg-class-size cell ;
+
 M: float-regs reg-class-size float-regs-size ;
 
 ! A data stack location.

library/compiler/x86/alien.factor

@@ -4,14 +4,6 @@ IN: compiler-backend
 USING: alien assembler compiler inference kernel
 kernel-internals lists math memory namespaces words ;
 
-M: %alien-invoke generate-node
-    #! call a C function.
-    drop 0 input 1 input load-library compile-c-call ;
-
-M: %parameter generate-node
-    #! x86 does not pass parameters in registers
-    drop ;
-
 GENERIC: reg-size ( reg-class -- n )
 GENERIC: push-reg ( reg-class -- )
 

library/compiler/x86/architecture.factor

@@ -1,6 +1,6 @@
 IN: compiler-backend
 USING: alien arrays assembler compiler compiler-backend kernel
-sequences ;
+kernel-internals sequences ;
 
 ! x86 register assignments
 ! EAX, ECX, EDX vregs
@@ -27,8 +27,9 @@ sequences ;
     [ drop EDX POP ] each ;
 
 ! On x86, parameters are never passed in registers.
+M: int-regs return-reg drop EAX ;
 M: int-regs fastcall-regs drop 0 ;
-M: int-regs reg-class-size drop 4 ;
+
 M: float-regs fastcall-regs drop 0 ;
 
 : dual-fp/int-regs? f ;

library/compiler/x86/fixnum.factor

@@ -27,7 +27,7 @@ math math-internals memory namespaces words ;
     ! Create a bignum.
     "s48_long_to_bignum" f 0 output-operand 1array compile-c-call*
     ! An untagged pointer to the bignum is now in EAX; tag it
-    return-reg bignum-tag OR
+    T{ int-regs } return-reg bignum-tag OR
     "end" get save-xt ; inline
 
 M: %fixnum+ generate-node ( vop -- )
@@ -51,7 +51,7 @@ M: %fixnum* generate-node ( vop -- )
     "s48_bignum_arithmetic_shift" f
     1 input-operand tag-bits neg 2array compile-c-call*
     ! an untagged pointer to the bignum is now in EAX; tag it
-    return-reg bignum-tag OR
+    T{ int-regs } return-reg bignum-tag OR
     "end" get save-xt ;
 
 M: %fixnum-mod generate-node ( vop -- )
@@ -81,7 +81,7 @@ M: %fixnum-mod generate-node ( vop -- )
     "s48_long_to_bignum" f
     0 input-operand 1array compile-c-call*
     ! An untagged pointer to the bignum is now in EAX; tag it
-    return-reg bignum-tag OR
+    T{ int-regs } return-reg bignum-tag OR
     ! the remainder is now in EDX
     remainder-reg POP
     "end" get save-xt ;