]> gitweb.factorcode.org Git - factor.git/commitdiff
Add alien-assembly form for inline assembler, works like alien-invoke except calls...
authorSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Thu, 7 Jan 2010 04:39:22 +0000 (17:39 +1300)
committerSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Thu, 7 Jan 2010 04:39:22 +0000 (17:39 +1300)
21 files changed:
basis/compiler/cfg/build-stack-frame/build-stack-frame.factor
basis/compiler/cfg/builder/builder.factor
basis/compiler/cfg/instructions/instructions.factor
basis/compiler/cfg/save-contexts/save-contexts.factor
basis/compiler/codegen/codegen.factor
basis/compiler/tests/alien.factor
basis/compiler/tree/debugger/debugger.factor
basis/compiler/tree/tree.factor
basis/cpu/x86/assembler/assembler.factor
basis/cpu/x86/features/features.factor
basis/math/floats/env/x86/x86.factor
basis/stack-checker/alien/alien.factor
basis/stack-checker/known-words/known-words.factor
basis/stack-checker/visitor/dummy/dummy.factor
basis/stack-checker/visitor/visitor.factor
core/alien/alien.factor
vm/Config.x86.32
vm/Config.x86.64
vm/cpu-x86.32.S [deleted file]
vm/cpu-x86.64.S [deleted file]
vm/cpu-x86.S [deleted file]

index 6f45a51f552a5ca93cb36cb8ebdc64a01353789d..670e34e5f9b4282b6b82e75a263781d09c103b4b 100644 (file)
@@ -1,4 +1,4 @@
-! Copyright (C) 2008, 2009 Slava Pestov.
+! Copyright (C) 2008, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: namespaces accessors math.order assocs kernel sequences
 combinators make classes words cpu.architecture layouts
@@ -17,6 +17,7 @@ GENERIC: compute-stack-frame* ( insn -- )
 UNION: stack-frame-insn
     ##alien-invoke
     ##alien-indirect
+    ##alien-assembly
     ##alien-callback ;
 
 M: stack-frame-insn compute-stack-frame*
index e67b8e3737c49e83b7a3510f9c14cb54df66d46a..529c3b5ae6540c5357b2534944d918b289d1c054 100644 (file)
@@ -236,6 +236,9 @@ M: #alien-invoke emit-node
 M: #alien-indirect emit-node
     [ ##alien-indirect ] emit-alien-node ;
 
+M: #alien-assembly emit-node
+    [ ##alien-assembly ] emit-alien-node ;
+
 M: #alien-callback emit-node
     dup params>> xt>> dup
     [
index 20008ea85efcee54d712704f177012d67be8fcf1..68a8b8ce59d6fc376e2d6251a1be2f1c9cf12d06 100644 (file)
@@ -671,6 +671,9 @@ literal: params stack-frame ;
 INSN: ##alien-indirect
 literal: params stack-frame ;
 
+INSN: ##alien-assembly
+literal: params stack-frame ;
+
 INSN: ##alien-callback
 literal: params stack-frame ;
 
index 4296fb54f947bd764977d2562dd76dae46946918..c7b6db06715000941bc0255c73fd769d382ab4df 100644 (file)
@@ -1,4 +1,4 @@
-! Copyright (C) 2009 Slava Pestov.
+! Copyright (C) 2009, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors combinators.short-circuit
 compiler.cfg.instructions compiler.cfg.registers
@@ -14,6 +14,7 @@ IN: compiler.cfg.save-contexts
             [ ##binary-float-function? ]
             [ ##alien-invoke? ]
             [ ##alien-indirect? ]
+            [ ##alien-assembly? ]
         } 1||
     ] any? ;
 
index c67048cf0df1a9a8da491b47b03c43efe956bc58..cea6527259f146da6bfb0b22251f2b9f28f434d7 100644 (file)
@@ -436,6 +436,16 @@ M: ##alien-invoke generate-insn
     dup %cleanup
     box-return* ;
 
+M: ##alien-assembly generate-insn
+    params>>
+    ! Unbox parameters
+    dup objects>registers
+    %prepare-var-args
+    ! Generate assembly
+    dup quot>> call( -- )
+    ! Box return value
+    box-return* ;
+
 ! ##alien-indirect
 M: ##alien-indirect generate-insn
     params>>
index e6abab1267857dbf6ba8173cd98786a84c8fc70f..cb39c0dd162e48350a658864747aaf30639e234d 100644 (file)
@@ -591,3 +591,8 @@ FUNCTION: short ffi_test_48 ( bool-field-test x ) ;
 FUNCTION: void this_does_not_exist ( ) ;
 
 [ this_does_not_exist ] [ { "kernel-error" 9 f f } = ] must-fail-with
+
+! More alien-assembly tests are in cpu.* vocabs
+: assembly-test-1 ( -- ) void { } "cdecl" [ ] alien-assembly ;
+
+[ ] [ assembly-test-1 ] unit-test
index 63f145d752a24aaf53474647f9de6e7c22a2e4f4..62fc9cdb82d12038b249f8d53e1cc944bc63d895 100644 (file)
@@ -1,4 +1,4 @@
-! Copyright (C) 2006, 2009 Slava Pestov.
+! Copyright (C) 2006, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel assocs match fry accessors namespaces make effects
 sequences sequences.private quotations generic macros arrays
@@ -126,6 +126,8 @@ M: #alien-invoke node>quot params>> , \ #alien-invoke , ;
 
 M: #alien-indirect node>quot params>> , \ #alien-indirect , ;
 
+M: #alien-assembly node>quot params>> , \ #alien-assembly , ;
+
 M: #alien-callback node>quot params>> , \ #alien-callback , ;
 
 M: node node>quot drop ;
index 988c7293c342aeda60e151958f0f34aa6fda5073..a1d1b4db611f57f909a3cd30e51a2b29f739bed7 100644 (file)
@@ -1,4 +1,4 @@
-! Copyright (C) 2004, 2008 Slava Pestov.
+! Copyright (C) 2004, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: fry arrays generic assocs kernel math namespaces parser
 sequences words vectors math.intervals classes
@@ -149,6 +149,11 @@ TUPLE: #alien-indirect < #alien-node in-d out-d ;
 : #alien-indirect ( params -- node )
     \ #alien-indirect new-alien-node ;
 
+TUPLE: #alien-assembly < #alien-node in-d out-d ;
+
+: #alien-assembly ( params -- node )
+    \ #alien-assembly new-alien-node ;
+
 TUPLE: #alien-callback < node params ;
 
 : #alien-callback ( params -- node )
@@ -187,4 +192,5 @@ M: vector #recursive, #recursive node, ;
 M: vector #copy, #copy node, ;
 M: vector #alien-invoke, #alien-invoke node, ;
 M: vector #alien-indirect, #alien-indirect node, ;
+M: vector #alien-assembly, #alien-assembly node, ;
 M: vector #alien-callback, #alien-callback node, ;
index fc000ced23df399bf0a3e67a8792fdc84c92c528..b075b121a5c7c130f285af29ac3c3853c8ee1f31 100644 (file)
@@ -375,6 +375,7 @@ PRIVATE>
 : NOP ( -- ) HEX: 90 , ;
 : PAUSE ( -- ) HEX: f3 , HEX: 90 , ;
 
+: RDTSC ( -- ) HEX: 0f , HEX: 31 , ;
 : RDPMC ( -- ) HEX: 0f , HEX: 33 , ;
 
 ! x87 Floating Point Unit
@@ -386,8 +387,10 @@ PRIVATE>
 : FLDL ( operand -- ) { BIN: 000 f HEX: dd } 1-operand ;
 
 : FNSTCW ( operand -- ) { BIN: 111 f HEX: d9 } 1-operand ;
+: FNSTSW ( operand -- ) { BIN: 111 f HEX: dd } 1-operand ;
 : FLDCW ( operand -- ) { BIN: 101 f HEX: d9 } 1-operand ;
 
+: FNCLEX ( -- ) HEX: db , HEX: e2 , ;
 : FNINIT ( -- ) HEX: db , HEX: e3 , ;
 
 ! SSE multimedia instructions
index 38364805eb90215a362676f461ff34edd8384313..30b2ce3b57accf63cd05a6aaa80bbcd16f89e275 100644 (file)
@@ -1,21 +1,78 @@
-! Copyright (C) 2009 Slava Pestov.
+! Copyright (C) 2009, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: system kernel memoize math math.order math.parser
-namespaces alien.c-types alien.syntax combinators locals init io
-compiler compiler.units accessors ;
+USING: accessors alien alien.c-types combinators compiler
+compiler.codegen.fixup compiler.units cpu.architecture
+cpu.x86.assembler cpu.x86.assembler.operands init io kernel
+locals math math.order math.parser memoize namespaces system ;
 IN: cpu.x86.features
 
 <PRIVATE
 
-FUNCTION: int sse_version ( ) ;
+: (sse-version) ( -- n )
+    int { } "cdecl" [
+        "sse-42" define-label
+        "sse-41" define-label
+        "ssse-3" define-label
+        "sse-3" define-label
+        "sse-2" define-label
+        "sse-1" define-label
+        "end" define-label
 
-FUNCTION: longlong read_timestamp_counter ( ) ;
+        int-regs return-reg 1 MOV
+
+        CPUID
+
+        ECX HEX: 100000 TEST
+        "sse-42" get JNE
+
+        ECX HEX: 80000 TEST
+        "sse-41" get JNE
+
+        ECX HEX: 200 TEST
+        "ssse-3" get JNE
+
+        ECX HEX: 1 TEST
+        "sse-3" get JNE
+
+        EDX HEX: 4000000 TEST
+        "sse-2" get JNE
+
+        EDX HEX: 2000000 TEST
+        "sse-1" get JNE
+
+        int-regs return-reg 0 MOV
+        "end" get JMP
+
+        "sse-42" resolve-label
+        int-regs return-reg 42 MOV
+        "end" get JMP
+
+        "sse-41" resolve-label
+        int-regs return-reg 41 MOV
+        "end" get JMP
+
+        "ssse-3" resolve-label
+        int-regs return-reg 33 MOV
+        "end" get JMP
+
+        "sse-3" resolve-label
+        int-regs return-reg 30 MOV
+        "end" get JMP
+
+        "sse-2" resolve-label
+        int-regs return-reg 20 MOV
+        "end" get JMP
+
+        "sse-1" resolve-label
+        int-regs return-reg 10 MOV
+
+        "end" resolve-label
+    ] alien-assembly ;
 
 PRIVATE>
 
 MEMO: sse-version ( -- n )
-    sse_version
-    "sse-version" get string>number [ min ] when* ;
+    (sse-version) "sse-version" get string>number [ min ] when* ;
 
 [ \ sse-version reset-memoized ] "cpu.x86.features" add-startup-hook
 
@@ -39,7 +96,18 @@ MEMO: sse-version ( -- n )
 
 HOOK: instruction-count cpu ( -- n )
 
-M: x86 instruction-count read_timestamp_counter ;
+M: x86.32 instruction-count
+    longlong { } "cdecl" [
+        RDTSC
+    ] alien-assembly ;
+
+M: x86.64 instruction-count
+    longlong { } "cdecl" [
+        RAX 0 MOV
+        RDTSC
+        RDX 32 SHL
+        RAX RDX OR
+    ] alien-assembly ;
 
 : count-instructions ( quot -- n )
-    instruction-count [ call ] dip instruction-count swap - ; inline
+    instruction-count [ call instruction-count ] dip - ; inline
index 2b73628b4ce064b7c6074647d2ad801cd082fa8d..ed8e9b77953493fc763276940e8ad5a8d914dad0 100644 (file)
@@ -1,6 +1,7 @@
-USING: accessors alien.c-types alien.syntax arrays assocs
-biassocs classes.struct combinators cpu.x86.features kernel
-literals math math.bitwise math.floats.env
+USING: accessors alien alien.c-types alien.syntax arrays assocs
+biassocs classes.struct combinators cpu.x86.64
+cpu.x86.assembler cpu.x86.assembler.operands cpu.x86.features
+kernel literals math math.bitwise math.floats.env
 math.floats.env.private system ;
 IN: math.floats.env.x86
 
@@ -11,24 +12,73 @@ STRUCT: x87-env
     { status ushort }
     { control ushort } ;
 
-! defined in the vm, cpu-x86*.S
-FUNCTION: void get_sse_env ( sse-env* env ) ;
-FUNCTION: void set_sse_env ( sse-env* env ) ;
-
-FUNCTION: void get_x87_env ( x87-env* env ) ;
-FUNCTION: void set_x87_env ( x87-env* env ) ;
+HOOK: get-sse-env cpu ( sse-env -- )
+HOOK: set-sse-env cpu ( sse-env -- )
+
+HOOK: get-x87-env cpu ( x87-env -- )
+HOOK: set-x87-env cpu ( x87-env -- )
+
+! 32-bit
+M: x86.32 get-sse-env
+    void { void* } "cdecl" [
+        EAX ESP [] MOV
+        EAX [] STMXCSR
+    ] alien-assembly ;
+
+M: x86.32 set-sse-env
+    void { void* } "cdecl" [
+        EAX ESP [] MOV
+        EAX [] LDMXCSR
+    ] alien-assembly ;
+
+M: x86.32 get-x87-env
+    void { void* } "cdecl" [
+        EAX ESP [] MOV
+        EAX [] FNSTSW
+        EAX 2 [+] FNSTCW
+    ] alien-assembly ;
+
+M: x86.32 set-x87-env
+    void { void* } "cdecl" [
+        EAX ESP [] MOV
+        FNCLEX
+        EAX 2 [+] FLDCW
+    ] alien-assembly ;
+
+! 64-bit
+M: x86.64 get-sse-env
+    void { void* } "cdecl" [
+        param-reg-0 [] STMXCSR
+    ] alien-assembly ;
+
+M: x86.64 set-sse-env
+    void { void* } "cdecl" [
+        param-reg-0 [] LDMXCSR
+    ] alien-assembly ;
+
+M: x86.64 get-x87-env
+    void { void* } "cdecl" [
+        param-reg-0 [] FNSTSW
+        param-reg-0 2 [+] FNSTCW
+    ] alien-assembly ;
+
+M: x86.64 set-x87-env
+    void { void* } "cdecl" [
+        FNCLEX
+        param-reg-0 2 [+] FLDCW
+    ] alien-assembly ;
 
 : <sse-env> ( -- sse-env )
-    sse-env (struct) [ get_sse_env ] keep ;
+    sse-env (struct) [ get-sse-env ] keep ;
 
 M: sse-env (set-fp-env-register)
-    set_sse_env ;
+    set-sse-env ;
 
 : <x87-env> ( -- x87-env )
-    x87-env (struct) [ get_x87_env ] keep ;
+    x87-env (struct) [ get-x87-env ] keep ;
 
 M: x87-env (set-fp-env-register)
-    set_x87_env ;
+    set-x87-env ;
 
 M: x86 (fp-env-registers)
     sse2? [ <sse-env> <x87-env> 2array ] [ <x87-env> 1array ] if ;
index deeada373547223d2656e94f9b47eabf81986fb4..fdfda6dd9e37ba417346be7b3bf6c92b1b36b4c0 100644 (file)
@@ -12,6 +12,8 @@ TUPLE: alien-invoke-params < alien-node-params library function ;
 
 TUPLE: alien-indirect-params < alien-node-params ;
 
+TUPLE: alien-assembly-params < alien-node-params quot ;
+
 TUPLE: alien-callback-params < alien-node-params quot xt ;
 
 : param-prep-quot ( node -- quot )
@@ -58,6 +60,22 @@ TUPLE: alien-callback-params < alien-node-params quot xt ;
     ! Quotation which coerces return value to required type
     return-prep-quot infer-quot-here ;
 
+: infer-alien-assembly ( -- )
+    alien-assembly-params new
+    ! Compile-time parameters
+    pop-literal nip >>quot
+    pop-literal nip >>abi
+    pop-literal nip >>parameters
+    pop-literal nip >>return
+    ! Quotation which coerces parameters to required types
+    dup param-prep-quot infer-quot-here
+    ! Magic #: consume exactly the number of inputs
+    dup 0 alien-stack
+    ! Add node to IR
+    dup #alien-assembly,
+    ! Quotation which coerces return value to required type
+    return-prep-quot infer-quot-here ;
+
 : callback-xt ( word return-rewind -- alien )
     [ callbacks get ] dip '[ _ <callback> ] cache ;
 
index 316ae6ca2f086e778dc4da35bdcc3911ff6e4957..a95d110622f30ee08d86d54a5d0668ff39dc8e26 100644 (file)
@@ -1,4 +1,4 @@
-! Copyright (C) 2004, 2009 Slava Pestov, Daniel Ehrenberg.
+! Copyright (C) 2004, 2010 Slava Pestov, Daniel Ehrenberg.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: fry accessors alien alien.accessors arrays byte-arrays
 classes continuations.private effects generic hashtables
@@ -228,6 +228,7 @@ M: bad-executable summary
 
 \ alien-invoke [ infer-alien-invoke ] "special" set-word-prop
 \ alien-indirect [ infer-alien-indirect ] "special" set-word-prop
+\ alien-assembly [ infer-alien-assembly ] "special" set-word-prop
 \ alien-callback [ infer-alien-callback ] "special" set-word-prop
 
 : infer-special ( word -- )
index 5f05d97d1a4d1970f3eb75c736f61df467c77a28..871f79d320b949f4ea951e9ec243eb8db9ed76fa 100644 (file)
@@ -1,4 +1,4 @@
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: stack-checker.visitor kernel ;
 IN: stack-checker.visitor.dummy
@@ -24,4 +24,5 @@ M: f #copy, 2drop ;
 M: f #drop, drop ;
 M: f #alien-invoke, drop ;
 M: f #alien-indirect, drop ;
+M: f #alien-assembly, drop ;
 M: f #alien-callback, drop ;
index 6093cd008af0d077157283e51eae0bb6903cfc1e..d4207caf5bb5396da2d475d7b0f3a2043df8bf0a 100644 (file)
@@ -1,4 +1,4 @@
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel arrays namespaces ;
 IN: stack-checker.visitor
@@ -29,4 +29,5 @@ HOOK: #recursive, stack-visitor ( label inputs visitor -- )
 HOOK: #copy, stack-visitor ( inputs outputs -- )
 HOOK: #alien-invoke, stack-visitor ( params -- )
 HOOK: #alien-indirect, stack-visitor ( params -- )
+HOOK: #alien-assembly, stack-visitor ( params -- )
 HOOK: #alien-callback, stack-visitor ( params -- )
index 91dd150e8f14f0924754fb57ae64e640734bc763..10012ea3d0393091a4f53a832a72c1fea3eb9c9d 100644 (file)
@@ -1,4 +1,4 @@
-! Copyright (C) 2004, 2009 Slava Pestov.
+! Copyright (C) 2004, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors assocs kernel math namespaces sequences system
 kernel.private byte-arrays arrays init ;
@@ -49,7 +49,7 @@ ERROR: alien-callback-error ;
 
 ERROR: alien-indirect-error ;
 
-: alien-indirect ( ... funcptr return parameters abi -- )
+: alien-indirect ( ... funcptr return parameters abi -- ... )
     alien-indirect-error ;
 
 ERROR: alien-invoke-error library symbol ;
@@ -57,6 +57,11 @@ ERROR: alien-invoke-error library symbol ;
 : alien-invoke ( ... return library function parameters -- ... )
     2over alien-invoke-error ;
 
+ERROR: alien-assembly-error code ;
+
+: alien-assembly ( ... return library parameters abi quot -- ... )
+    dup alien-assembly-error ;
+
 ! Callbacks are registered in a global hashtable. Note that they
 ! are also pinned in a special callback area, so clearing this
 ! hashtable will not reclaim callbacks. It should only be
index b7f8bc65f0ec6ee3f3666677fc05cd1565d2780e..8b137891791fe96927ad78e64b0aad7bded08bdc 100644 (file)
@@ -1,2 +1 @@
-BOOT_ARCH = x86
-PLAF_DLL_OBJS += vm/cpu-x86.32.o
+
index 63f06d5a786337245463030ce0ee22f7f1be8d40..314c14fe05641dd620712fc056408135a654bc24 100644 (file)
@@ -1,2 +1 @@
-PLAF_DLL_OBJS += vm/cpu-x86.64.o
 CFLAGS += -DFACTOR_64
diff --git a/vm/cpu-x86.32.S b/vm/cpu-x86.32.S
deleted file mode 100644 (file)
index 2ebece6..0000000
+++ /dev/null
@@ -1,40 +0,0 @@
-#include "asm.h"
-
-#define RETURN_REG %eax
-
-DEF(long long,read_timestamp_counter,(void)):
-       rdtsc
-       ret
-
-DEF(void,get_sse_env,(void*)):
-       movl 4(%esp), %eax
-       stmxcsr (%eax)
-       ret
-
-DEF(void,set_sse_env,(const void*)):
-       movl 4(%esp), %eax
-       ldmxcsr (%eax)
-       ret
-
-DEF(void,get_x87_env,(void*)):
-       movl 4(%esp), %eax
-       fnstsw (%eax)
-       fnstcw 2(%eax)
-       ret
-
-DEF(void,set_x87_env,(const void*)):
-       movl 4(%esp), %eax
-       fnclex
-       fldcw 2(%eax)
-       ret
-
-#include "cpu-x86.S"
-
-#ifdef WINDOWS
-       .section .drectve
-       .ascii " -export:read_timestamp_counter"
-       .ascii " -export:get_sse_env"
-       .ascii " -export:set_sse_env"
-       .ascii " -export:get_x87_env"
-       .ascii " -export:set_x87_env"
-#endif
diff --git a/vm/cpu-x86.64.S b/vm/cpu-x86.64.S
deleted file mode 100644 (file)
index a65b0d6..0000000
+++ /dev/null
@@ -1,30 +0,0 @@
-#include "asm.h"
-
-DEF(long long,read_timestamp_counter,(void)):
-       mov $0,%rax
-       rdtsc
-       shl $32,%rdx
-       or %rdx,%rax
-       ret
-
-DEF(void,get_sse_env,(void*)):
-       stmxcsr (%rdi)
-       ret
-
-DEF(void,set_sse_env,(const void*)):
-       ldmxcsr (%rdi)
-       ret
-
-DEF(void,get_x87_env,(void*)):
-       fnstsw (%rdi)
-       fnstcw 2(%rdi)
-       ret
-
-DEF(void,set_x87_env,(const void*)):
-       fnclex
-       fldcw 2(%rdi)
-       ret
-
-#define RETURN_REG %rax
-       
-#include "cpu-x86.S"
diff --git a/vm/cpu-x86.S b/vm/cpu-x86.S
deleted file mode 100644 (file)
index dae775a..0000000
+++ /dev/null
@@ -1,41 +0,0 @@
-/* cpu.x86.features calls this */
-DEF(bool,sse_version,(void)):
-       mov $0x1,RETURN_REG
-       cpuid
-       test $0x100000,%ecx
-       jnz sse_42
-       test $0x80000,%ecx
-       jnz sse_41
-       test $0x200,%ecx
-       jnz ssse_3
-       test $0x1,%ecx
-       jnz sse_3
-       test $0x4000000,%edx
-       jnz sse_2
-       test $0x2000000,%edx
-       jnz sse_1
-       mov $0,%eax
-       ret
-sse_42:
-       mov $42,RETURN_REG
-       ret
-sse_41:
-       mov $41,RETURN_REG
-       ret
-ssse_3:
-       mov $33,RETURN_REG
-       ret
-sse_3:
-       mov $30,RETURN_REG
-       ret
-sse_2:
-       mov $20,RETURN_REG
-       ret
-sse_1:
-       mov $10,RETURN_REG
-       ret
-
-#ifdef WINDOWS
-       .section .drectve
-       .ascii " -export:sse_version"
-#endif