diff --git a/library/alien/compiler.factor b/library/alien/compiler.factor index f8f0996c88..995b334a88 100644 --- a/library/alien/compiler.factor +++ b/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 -- ) diff --git a/library/compiler/amd64/alien.factor b/library/compiler/amd64/alien.factor index 72986b9104..410883fc7c 100644 --- a/library/compiler/amd64/alien.factor +++ b/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 -kernel-internals lists math memory namespaces words ; +USING: alien assembler kernel math ; -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 ; diff --git a/library/compiler/amd64/architecture.factor b/library/compiler/amd64/architecture.factor index ff9e5276a1..325d2394e2 100644 --- a/library/compiler/amd64/architecture.factor +++ b/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 fastcall-regs drop 0 ; -M: int-regs reg-class-size drop 4 ; +M: int-regs return-reg drop RAX ; +M: int-regs fastcall-regs drop alien-regs length ; + M: float-regs fastcall-regs drop 0 ; : dual-fp/int-regs? f ; diff --git a/library/compiler/architecture.factor b/library/compiler/architecture.factor index f481809bb5..ab5aeeaaef 100644 --- a/library/compiler/architecture.factor +++ b/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 -- ) diff --git a/library/compiler/generator.factor b/library/compiler/generator.factor index c517f0fe1b..dd314d9a1f 100644 --- a/library/compiler/generator.factor +++ b/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 diff --git a/library/compiler/ppc/alien.factor b/library/compiler/ppc/alien.factor index 46e9c88f74..410883fc7c 100644 --- a/library/compiler/ppc/alien.factor +++ b/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 ; diff --git a/library/compiler/ppc/architecture.factor b/library/compiler/ppc/architecture.factor index 88a83d7734..8e0d7af8be 100644 --- a/library/compiler/ppc/architecture.factor +++ b/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 diff --git a/library/compiler/vops.factor b/library/compiler/vops.factor index b269d5cd6a..2242145db7 100644 --- a/library/compiler/vops.factor +++ b/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. diff --git a/library/compiler/x86/alien.factor b/library/compiler/x86/alien.factor index f5c5372ea6..0b230f9681 100644 --- a/library/compiler/x86/alien.factor +++ b/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 -- ) diff --git a/library/compiler/x86/architecture.factor b/library/compiler/x86/architecture.factor index d1a5cee1f4..39e23b2535 100644 --- a/library/compiler/x86/architecture.factor +++ b/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 ; diff --git a/library/compiler/x86/fixnum.factor b/library/compiler/x86/fixnum.factor index 498a896da7..f2927bf681 100644 --- a/library/compiler/x86/fixnum.factor +++ b/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 ;