steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Add alien-assembly form for inline assembler, works like alien-invoke except calls a user-supplied quotation instead of generating a subroutine call. Replaces FPU status control, SSE detection and read timestamp routines in vm/cpu-x86.*S

db4
Slava Pestov 2010-01-07 17:39:22 +13:00
parent 44a604fdbe
commit 235f3238f5
21 changed files with 210 additions and 145 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
basis/compiler/cfg/build-stack-frame/build-stack-frame.factor
View 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*

3
basis/compiler/cfg/builder/builder.factor
View 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
[

3
basis/compiler/cfg/instructions/instructions.factor
View 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 ;

3
basis/compiler/cfg/save-contexts/save-contexts.factor
View 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? ;

10
basis/compiler/codegen/codegen.factor
View 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>>

5
basis/compiler/tests/alien.factor
View 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

4
basis/compiler/tree/debugger/debugger.factor
View 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 ;

8
basis/compiler/tree/tree.factor
View 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, ;

3
basis/cpu/x86/assembler/assembler.factor
View 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

88
basis/cpu/x86/features/features.factor
View 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

74
basis/math/floats/env/x86/x86.factor vendored
View 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 ) ;
HOOK: get-sse-env cpu ( sse-env -- )
HOOK: set-sse-env cpu ( sse-env -- )
FUNCTION: void get_x87_env ( x87-env* env ) ;
FUNCTION: void set_x87_env ( x87-env* 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 ;

18
basis/stack-checker/alien/alien.factor
View 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 ;

3
basis/stack-checker/known-words/known-words.factor
View 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 -- )

3
basis/stack-checker/visitor/dummy/dummy.factor
View 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 ;

3
basis/stack-checker/visitor/visitor.factor
View 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 -- )

9
core/alien/alien.factor
View 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

3
vm/Config.x86.32
View File

@ -1,2 +1 @@
BOOT_ARCH = x86
PLAF_DLL_OBJS += vm/cpu-x86.32.o

1
vm/Config.x86.64
View File

@ -1,2 +1 @@
PLAF_DLL_OBJS += vm/cpu-x86.64.o
CFLAGS += -DFACTOR_64

40
vm/cpu-x86.32.S
View File

@ -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

30
vm/cpu-x86.64.S
View File

@ -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"

41
vm/cpu-x86.S
View File

@ -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