From 6df17f0a7cd8dad0bca46554d41e27bb53cb29ef Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 9 May 2005 00:30:38 +0000 Subject: [PATCH] alien-invoke compiles with VOPs --- library/alien/c-types.factor | 16 ++-- library/alien/compiler.factor | 51 +++---------- library/alien/dataflow.factor | 24 ------ library/bootstrap/boot-stage2.factor | 1 - library/compiler/intrinsics.factor | 2 +- library/compiler/vops.factor | 45 ++++++++++-- library/compiler/x86/alien.factor | 105 ++++++++++++++++----------- 7 files changed, 124 insertions(+), 120 deletions(-) delete mode 100644 library/alien/dataflow.factor diff --git a/library/alien/c-types.factor b/library/alien/c-types.factor index fb20ddef09..8d2efe0363 100644 --- a/library/alien/c-types.factor +++ b/library/alien/c-types.factor @@ -1,17 +1,17 @@ ! Copyright (C) 2004, 2005 Slava Pestov. ! See http://factor.sf.net/license.txt for BSD license. IN: alien -USING: assembler errors generic hashtables kernel lists math -namespaces parser sequences strings words ; +USING: assembler compiler errors generic hashtables kernel lists +math namespaces parser sequences strings words ; : ( -- type ) [ [ "No setter" throw ] "setter" set [ "No getter" throw ] "getter" set "no boxer" "boxer" set - #box "box-op" set + \ %box "box-op" set "no unboxer" "unboxer" set - #unbox "unbox-op" set + \ %unbox "unbox-op" set 0 "width" set ] extend ; @@ -170,9 +170,9 @@ global [ c-types nest drop ] bind cell "width" set cell "align" set "box_float" "boxer" set - #box-float "box-op" set + \ %box-float "box-op" set "unbox_float" "unboxer" set - #unbox-float "unbox-op" set + \ %unbox-float "unbox-op" set ] "float" define-primitive-type [ @@ -181,9 +181,9 @@ global [ c-types nest drop ] bind cell 2 * "width" set cell 2 * "align" set "box_double" "boxer" set - #box-double "box-op" set + \ %box-double "box-op" set "unbox_double" "unboxer" set - #unbox-double "unbox-op" set + \ %unbox-double "unbox-op" set ] "double" define-primitive-type : alias-c-type ( old new -- ) diff --git a/library/alien/compiler.factor b/library/alien/compiler.factor index 52c5419aad..42f477a1c5 100644 --- a/library/alien/compiler.factor +++ b/library/alien/compiler.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2004, 2005 Slava Pestov. ! See http://factor.sf.net/license.txt for BSD license. IN: alien -USING: assembler errors generic inference kernel lists math -namespaces sequences stdio strings unparser words ; +USING: assembler compiler errors generic inference kernel lists +math namespaces sequences stdio strings unparser words ; ! ! ! WARNING ! ! ! ! Reloading this file into a running Factor instance on Win32 @@ -48,11 +48,9 @@ M: alien-error error. ( error -- ) #! namespace. drop throw ; -: alien-global ( type library name -- value ) - #! Fetch the value of C global variable. - #! 'type' is a type spec. 'library' is an entry in the - #! "libraries" namespace. - throw ; +! These are set in the alien-invoke dataflow IR node. +SYMBOL: alien-returns +SYMBOL: alien-parameters : set-alien-returns ( returns node -- ) [ dup alien-returns set ] bind @@ -76,8 +74,6 @@ M: alien-error error. ( error -- ) [ set-alien-parameters ] keep set-alien-returns ; -DEFER: alien-invoke - : infer-alien-invoke ( -- ) \ alien-invoke "infer-effect" word-prop car ensure-d pop-literal @@ -86,27 +82,13 @@ DEFER: alien-invoke pop-literal -rot r> swap alien-invoke-node ; -: alien-global-node ( type name library -- ) - 2dup ensure-dlsym - cons \ alien-global dataflow, - set-alien-returns ; - -DEFER: alien-global - -: infer-alien-global ( -- ) - \ alien-global "infer-effect" word-prop car ensure-d - pop-literal - pop-literal - pop-literal -rot - alien-global-node ; - : parameters [ alien-parameters get reverse ] bind ; : stack-space ( parameters -- n ) 0 swap [ c-size cell align + ] each ; : unbox-parameter ( n parameter -- ) - c-type [ "unboxer" get cons "unbox-op" get ] bind swons , ; + c-type [ "unboxer" get cons "unbox-op" get ] bind execute , ; : linearize-parameters ( node -- count ) #! Generate code for boxing a list of C types, then generate @@ -117,42 +99,31 @@ DEFER: alien-global #! Return amount stack must be unwound by. parameters dup stack-space - dup #parameters swons , >r + dup %parameters , >r dup dup length swap [ >r 1 - dup r> unbox-parameter ] each drop - length [ #parameter swons ] project % r> ; + length [ %parameter ] project % r> ; : linearize-returns ( returns -- ) [ alien-returns get ] bind dup "void" = [ drop ] [ - c-type [ "boxer" get "box-op" get ] bind swons , + c-type [ "boxer" get "box-op" get ] bind execute , ] ifte ; : linearize-alien-invoke ( node -- ) dup linearize-parameters >r - dup [ node-param get ] bind \ alien-invoke swons , + dup [ node-param get ] bind %alien-invoke , dup [ node-param get cdr library-abi "stdcall" = ] bind - r> swap [ drop ] [ #cleanup swons , ] ifte + r> swap [ drop ] [ %cleanup , ] ifte linearize-returns ; \ alien-invoke [ linearize-alien-invoke ] "linearizer" set-word-prop -: linearize-alien-global ( node -- ) - dup [ node-param get ] bind \ alien-global swons , - linearize-returns ; - -\ alien-global [ linearize-alien-global ] "linearizer" set-word-prop - \ alien-invoke [ [ string string string general-list ] [ ] ] "infer-effect" set-word-prop \ alien-invoke [ infer-alien-invoke ] "infer" set-word-prop -\ alien-global [ [ string string string ] [ object ] ] -"infer-effect" set-word-prop - -\ alien-global [ infer-alien-global ] "infer" set-word-prop - global [ "libraries" get [ "libraries" set ] unless ] bind diff --git a/library/alien/dataflow.factor b/library/alien/dataflow.factor deleted file mode 100644 index 7e44a3db4f..0000000000 --- a/library/alien/dataflow.factor +++ /dev/null @@ -1,24 +0,0 @@ -IN: alien - -! Linear IR nodes - -SYMBOL: #cleanup ( unwind stack by parameter ) - -SYMBOL: #unbox ( move top of datastack to C stack ) -SYMBOL: #unbox-float -SYMBOL: #unbox-double - -! for register parameter passing; move top of C stack to a -! register. no-op on x86, generates code on PowerPC. -SYMBOL: #parameter - -! for increasing stack space on PowerPC; unused on x86. -SYMBOL: #parameters - -SYMBOL: #box ( move EAX to datastack ) -SYMBOL: #box-float -SYMBOL: #box-double - -! These are set in the alien-invoke dataflow IR node. -SYMBOL: alien-returns -SYMBOL: alien-parameters diff --git a/library/bootstrap/boot-stage2.factor b/library/bootstrap/boot-stage2.factor index 26723ea22e..29b545ffb6 100644 --- a/library/bootstrap/boot-stage2.factor +++ b/library/bootstrap/boot-stage2.factor @@ -46,7 +46,6 @@ t [ "/library/compiler/generator.factor" "/library/compiler/compiler.factor" - "/library/alien/dataflow.factor" "/library/alien/c-types.factor" "/library/alien/enums.factor" "/library/alien/structs.factor" diff --git a/library/compiler/intrinsics.factor b/library/compiler/intrinsics.factor index b0e6c7c3a1..29986cb7bb 100644 --- a/library/compiler/intrinsics.factor +++ b/library/compiler/intrinsics.factor @@ -143,8 +143,8 @@ words ; : binary-op-reg ( op out -- ) >r in-2 - 1 0 rot execute , 1 %dec-d , + 1 0 rot execute , r> 0 %replace-d , ; : binary-op ( node op out -- ) diff --git a/library/compiler/vops.factor b/library/compiler/vops.factor index 9ab66649fb..1c659cd7a6 100644 --- a/library/compiler/vops.factor +++ b/library/compiler/vops.factor @@ -7,6 +7,9 @@ USING: errors generic kernel namespaces parser ; ! representations used by Factor. It is basically a high-level ! assembly language. Linear IR operations are called VOPs. +! This file defines all the types of VOPs. A linear IR program +! is then just a list of VOPs. + ! A virtual register TUPLE: vreg n ; @@ -30,6 +33,7 @@ GENERIC: generate-node ( vop -- ) : src-vop ( src) f f f ; : dest-vop ( dest) f swap f f ; : src/dest-vop ( src dest) f f ; +: literal-vop ( literal) >r f f r> f ; ! miscellanea VOP: %prologue @@ -67,22 +71,22 @@ VOP: %end-dispatch VOP: %peek-d : %peek-d ( vreg n -- ) >r >r f r> r> f <%peek-d> ; VOP: %dec-d -: %dec-d ( n -- ) >r f f r> f <%dec-d> ; +: %dec-d ( n -- ) literal-vop <%dec-d> ; VOP: %replace-d : %replace-d ( vreg n -- ) >r f r> f <%replace-d> ; VOP: %inc-d -: %inc-d ( n -- ) >r f f r> f <%inc-d> ; +: %inc-d ( n -- ) literal-vop <%inc-d> ; VOP: %immediate VOP: %immediate-d -: %immediate-d ( obj -- ) >r f f r> f <%immediate-d> ; +: %immediate-d ( obj -- ) literal-vop <%immediate-d> ; VOP: %peek-r : %peek-r ( vreg n -- ) >r >r f r> r> f <%peek-r> ; VOP: %dec-r -: %dec-r ( n -- ) >r f f r> f <%dec-r> ; +: %dec-r ( n -- ) literal-vop <%dec-r> ; VOP: %replace-r : %replace-r ( vreg n -- ) >r f r> f <%replace-r> ; VOP: %inc-r -: %inc-r ( n -- ) >r f f r> f <%inc-r> ; +: %inc-r ( n -- ) literal-vop <%inc-r> ; : in-1 0 0 %peek-d , ; : in-2 0 1 %peek-d , 1 0 %peek-d , ; @@ -146,3 +150,34 @@ VOP: %untag-fixnum : check-dest ( vop reg -- ) swap vop-dest = [ "invalid VOP destination" throw ] unless ; + +! alien operations +VOP: %parameters +: %parameters ( n -- vop ) literal-vop <%parameters> ; + +VOP: %parameter +: %parameter ( n -- vop ) literal-vop <%parameter> ; + +VOP: %cleanup +: %cleanup ( n -- vop ) literal-vop <%cleanup> ; + +VOP: %unbox +: %unbox ( [[ n func ]] -- vop ) literal-vop <%unbox> ; + +VOP: %unbox-float +: %unbox-float ( [[ n func ]] -- vop ) literal-vop <%unbox-float> ; + +VOP: %unbox-double +: %unbox-double ( [[ n func ]] -- vop ) literal-vop <%unbox-double> ; + +VOP: %box +: %box ( func -- vop ) literal-vop <%box> ; + +VOP: %box-float +: %box-float ( func -- vop ) literal-vop <%box-float> ; + +VOP: %box-double +: %box-double ( [[ n func ]] -- vop ) literal-vop <%box-double> ; + +VOP: %alien-invoke +: %alien-invoke ( func -- vop ) literal-vop <%alien-invoke> ; diff --git a/library/compiler/x86/alien.factor b/library/compiler/x86/alien.factor index 931bf7972c..635b0a0a6a 100644 --- a/library/compiler/x86/alien.factor +++ b/library/compiler/x86/alien.factor @@ -4,51 +4,74 @@ IN: compiler USING: alien assembler inference kernel kernel-internals lists math memory namespaces words ; -\ alien-invoke [ - uncons load-library compile-c-call -] "generator" set-word-prop +M: %alien-invoke generate-node + #! call a C function. + vop-literal uncons load-library compile-c-call ; -\ alien-global [ - uncons load-library 2dup dlsym EAX swap unit MOV f rel-dlsym -] "generator" set-word-prop - -#parameters [ - drop -] "generator" set-word-prop - -: UNBOX cdr dup f dlsym CALL f t rel-dlsym ; - -#unbox [ - UNBOX EAX PUSH -] "generator" set-word-prop - -#unbox-float [ - UNBOX ESP 4 SUB [ ESP ] FSTPS -] "generator" set-word-prop - -#unbox-double [ - UNBOX ESP 8 SUB [ ESP ] FSTPL -] "generator" set-word-prop - -#parameter [ +M: %parameters generate-node #! x86 does not pass parameters in registers - drop -] "generator" set-word-prop + drop ; -: BOX dup f dlsym CALL f t rel-dlsym EAX POP ; +M: %parameter generate-node + #! x86 does not pass parameters in registers + drop ; -#box [ - EAX PUSH BOX -] "generator" set-word-prop +: UNBOX ( vop -- ) + #! An unboxer function takes a value from the data stack and + #! converts it into a C value. + vop-literal cdr f compile-c-call ; -#box-float [ - ESP 4 SUB [ ESP ] FSTPS BOX -] "generator" set-word-prop +M: %unbox generate-node + #! C functions return integers in EAX. + UNBOX + #! Push integer on C stack. + EAX PUSH ; -#box-double [ - ESP 8 SUB [ ESP ] FSTPL BOX ECX POP -] "generator" set-word-prop +M: %unbox-float generate-node + #! C functions return floats on the FP stack. + UNBOX + #! Push float on C stack. + ESP 4 SUB + [ ESP ] FSTPS ; -#cleanup [ - dup 0 = [ drop ] [ ESP swap ADD ] ifte -] "generator" set-word-prop +M: %unbox-double generate-node + #! C functions return doubles on the FP stack. + UNBOX + #! Push double on C stack. + ESP 8 SUB + [ ESP ] FSTPL ; + +: BOX ( vop -- ) + #! A boxer function takes a C value as a parameter and + #! converts into a Factor value, and pushes it on the data + #! stack. + vop-literal f compile-c-call ; + +M: %box generate-node + #! C functions return integers in EAX. + EAX PUSH + #! Push integer on data stack. + BOX + ESP 4 ADD ; + +M: %box-float generate-node + #! C functions return floats on the FP stack. + ESP 4 SUB + [ ESP ] FSTPS + #! Push float on data stack. + BOX + ESP 4 ADD ; + +M: %box-double generate-node + #! C functions return doubles on the FP stack. + ESP 8 SUB + [ ESP ] FSTPL + #! Push double on data stack. + BOX + ESP 8 ADD ; + +M: %cleanup generate-node + #! In the cdecl ABI, the caller must pop input parameters + #! off the C stack. In stdcall, the callee does it, so + #! this node is not used in that case. + vop-literal dup 0 = [ drop ] [ ESP swap ADD ] ifte ;