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

Merge git://factorcode.org/git/factor

db4
Slava Pestov 2008-01-12 23:50:46 -05:00
parent 4fb8380578 36f31e784b
commit b71e07affe
2 changed files with 13 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
core/cpu/x86/64/64.factor
View File

@ -173,8 +173,8 @@ USE: cpu.x86.intrinsics
T{ x86-backend f 8 } compiler-backend set-global
! The ABI for passing structs by value is pretty messed up
"void*" c-type clone "__stack_value" define-primitive-type
T{ stack-params } "__stack_value" c-type set-c-type-reg-class
<< "void*" c-type clone "__stack_value" define-primitive-type
T{ stack-params } "__stack_value" c-type set-c-type-reg-class >>
: struct-types&offset ( struct-type -- pairs )
struct-type-fields [
@ -200,5 +200,3 @@ M: struct-type flatten-value-type ( type -- seq )
"void*" "double" ? c-type ,
] each
] if ;
12 profiler-prologue set-global

37
core/cpu/x86/intrinsics/intrinsics.factor
View File

@ -1,4 +1,4 @@
! Copyright (C) 2005, 2006 Slava Pestov.
! Copyright (C) 2005, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: alien arrays cpu.x86.assembler cpu.x86.allot
cpu.x86.architecture cpu.architecture kernel kernel.private math
@ -240,34 +240,19 @@ IN: cpu.x86.intrinsics
}
} define-intrinsics
\ fixnum-shift-fast {
{
[
"y" operand NEG
"y" operand %untag-fixnum
"x" operand "y" operand SAR
! Mask off low bits
"x" operand %untag
] H{
{ +input+ { { f "x" } { f "y" } } }
{ +output+ { "x" } }
{ +clobber+ { "y" } }
}
} {
[
"x" operand "y" get neg SAR
! Mask off low bits
"x" operand %untag
] H{
{ +input+ { { f "x" } { [ ] "y" } } }
{ +output+ { "x" } }
}
}
} define-intrinsics
: %untag-fixnums ( seq -- )
[ %untag-fixnum ] unique-operands ;
\ fixnum-shift-fast [
"x" operand "y" get
dup 0 < [ neg SAR ] [ SHL ] if
! Mask off low bits
"x" operand %untag
] H{
{ +input+ { { f "x" } { [ ] "y" } } }
{ +output+ { "x" } }
} define-intrinsic
: overflow-check ( word -- )
"end" define-label
"z" operand "x" operand MOV