Using fry in cpu.x86, working on alien intrinsics

db4
Slava Pestov 2008-10-13 16:43:58 -05:00
parent 740b6ef3f2
commit f2c6f8de5b
5 changed files with 53 additions and 40 deletions

View File

@ -1,7 +1,7 @@
! Copyright (C) 2006, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel words kernel.private namespaces math math.private
sequences generic arrays system layouts alien locals
sequences generic arrays system layouts alien locals fry
cpu.architecture cpu.x86.assembler cpu.x86.architecture
compiler.constants compiler.cfg.templates compiler.cfg.builder
compiler.codegen compiler.codegen.fixup ;
@ -118,7 +118,7 @@ M:: x86 %box-alien ( dst src temp -- )
"end" resolve-label ; inline
: overflow-template ( word insn -- )
[ overflow-check ] curry T{ template
'[ _ overflow-check ] T{ template
{ input { { f "x" } { f "y" } } }
{ scratch { { f "z" } } }
{ output { "z" } }

View File

@ -49,7 +49,6 @@ HOOK: temp-reg-1 cpu ( -- reg )
HOOK: temp-reg-2 cpu ( -- reg )
HOOK: fixnum>slot@ cpu ( op -- )
HOOK: prepare-division cpu ( -- )
M: f load-literal

View File

@ -1,6 +1,6 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel words sequences lexer parser ;
USING: kernel words sequences lexer parser fry ;
IN: cpu.x86.assembler.syntax
: define-register ( name num size -- )
@ -9,7 +9,7 @@ IN: cpu.x86.assembler.syntax
"register-size" set-word-prop ;
: define-registers ( names size -- )
>r dup length r> [ define-register ] curry 2each ;
'[ _ define-register ] each-index ;
: REGISTERS: ( -- )
scan-word ";" parse-tokens swap define-registers ; parsing

View File

@ -3,7 +3,7 @@
USING: accessors arrays byte-arrays alien.accessors kernel
kernel.private math memory namespaces make sequences words
system layouts combinators math.order math.private alien
alien.c-types slots.private locals cpu.architecture
alien.c-types slots.private locals fry cpu.architecture
cpu.x86.assembler cpu.x86.assembler.private cpu.x86.architecture
compiler.codegen.fixup compiler.constants compiler.intrinsics
compiler.cfg.builder compiler.cfg.registers compiler.cfg.stacks
@ -51,7 +51,6 @@ IN: cpu.x86.intrinsics
{
[ %constant-slot "val" operand MOV ] T{ template
{ input { { f "val" } { f "obj" } { small-slot "n" } { small-slot "tag" } } }
{ clobber { "obj" } }
}
}
{
@ -62,16 +61,6 @@ IN: cpu.x86.intrinsics
}
} define-intrinsics
! Sometimes, we need to do stuff with operands which are
! less than the word size. Instead of teaching the register
! allocator about the different sized registers, with all
! the complexity this entails, we just push/pop a register
! which is guaranteed to be unused (the tempreg)
: small-reg cell 8 = RBX EBX ? ; inline
: small-reg-8 BL ; inline
: small-reg-16 BX ; inline
: small-reg-32 EBX ; inline
! Fixnums
: fixnum-op ( op hash -- pair )
>r [ "x" operand "y" operand ] swap suffix r> 2array ;
@ -219,17 +208,38 @@ IN: cpu.x86.intrinsics
} define-intrinsic
! Alien intrinsics
: %alien-accessor ( quot -- )
! Sometimes, we need to do stuff with operands which are
! less than the word size. Instead of teaching the register
! allocator about the different sized registers, with all
! the complexity this entails, we just push/pop a register
! which is guaranteed to be unused (the tempreg)
: small-reg cell 8 = RAX EAX ? ; inline
: small-reg-8 AL ; inline
: small-reg-16 AX ; inline
: small-reg-32 EAX ; inline
: %prepare-alien-accessor ( -- )
"offset" operand %untag-fixnum
"offset" operand "alien" operand ADD
"offset" operand "alien" operand ADD ;
: (%alien-accessor) ( quot -- )
"offset" operand [] swap call ; inline
: %alien-integer-get ( quot reg -- )
small-reg PUSH
swap %alien-accessor
"value" operand small-reg MOV
"value" operand %tag-fixnum
small-reg POP ; inline
: %alien-accessor ( quot -- )
%prepare-alien-accessor (%alien-accessor) ; inline
: %alien-integer-get ( reg quot -- )
%prepare-alien-accessor
"value" operand small-reg = [
(%alien-accessor)
] [
small-reg PUSH
(%alien-accessor)
"value" operand small-reg MOV
small-reg POP
] if
"value" operand %tag-fixnum ; inline
: alien-integer-get-template
T{ template
@ -242,23 +252,28 @@ IN: cpu.x86.intrinsics
{ clobber { "offset" } }
} ;
: define-getter ( word quot reg -- )
[ %alien-integer-get ] 2curry
: define-getter ( word reg quot -- )
'[ _ _ %alien-integer-get ]
alien-integer-get-template
define-intrinsic ;
: define-unsigned-getter ( word reg -- )
[ small-reg dup XOR MOV ] swap define-getter ;
[ small-reg dup XOR MOV ] define-getter ;
: define-signed-getter ( word reg -- )
[ [ >r MOV small-reg r> MOVSX ] curry ] keep define-getter ;
dup '[ MOV small-reg _ MOVSX ] define-getter ;
: %alien-integer-set ( quot reg -- )
small-reg PUSH
small-reg "value" operand MOV
small-reg %untag-fixnum
swap %alien-accessor
small-reg POP ; inline
: %alien-integer-set ( reg quot -- )
"value" operand %untag-fixnum
%prepare-alien-accessor
small-reg "value" operand = [
(%alien-accessor)
] [
small-reg PUSH
small-reg "value" operand MOV
(%alien-accessor)
small-reg POP
] if ; inline
: alien-integer-set-template
T{ template
@ -271,8 +286,7 @@ IN: cpu.x86.intrinsics
} ;
: define-setter ( word reg -- )
[ swap MOV ] swap
[ %alien-integer-set ] 2curry
'[ _ [ swap MOV ] %alien-integer-set ]
alien-integer-set-template
define-intrinsic ;

View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.accessors arrays generic kernel
kernel.private math math.private memory namespaces sequences
words math.floats.private layouts quotations locals
words math.floats.private layouts quotations locals fry
system compiler.constants compiler.codegen compiler.cfg.templates
compiler.cfg.registers compiler.cfg.builder cpu.architecture
cpu.x86.assembler cpu.x86.architecture cpu.x86.intrinsics ;
@ -87,10 +87,10 @@ M: x86 %unbox-float ( dst src -- )
} ;
: define-alien-float-intrinsics ( word get-quot word set-quot -- )
[ "value" operand swap %alien-accessor ] curry
'[ "value" operand _ %alien-accessor ]
alien-float-set-template
define-intrinsic
[ "value" operand swap %alien-accessor ] curry
'[ "value" operand _ %alien-accessor ]
alien-float-get-template
define-intrinsic ;