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

compiler: new set-special-object intrinsic; more efficient special-object intrinsic

release
Slava Pestov 2010-04-01 20:06:18 -04:00
parent 1b4b1a180c
commit eceabbc57e
11 changed files with 72 additions and 48 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
basis/compiler/cfg/alias-analysis/alias-analysis.factor
View File

@ -202,14 +202,16 @@ M: ##slot-imm insn-slot# slot>> ;
M: ##set-slot insn-slot# slot>> constant ;
M: ##set-slot-imm insn-slot# slot>> ;
M: ##alien-global insn-slot# [ library>> ] [ symbol>> ] bi 2array ;
M: ##vm-field-ptr insn-slot# field-name>> ;
M: ##vm-field insn-slot# offset>> ;
M: ##set-vm-field insn-slot# offset>> ;
M: ##slot insn-object obj>> resolve ;
M: ##slot-imm insn-object obj>> resolve ;
M: ##set-slot insn-object obj>> resolve ;
M: ##set-slot-imm insn-object obj>> resolve ;
M: ##alien-global insn-object drop \ ##alien-global ;
M: ##vm-field-ptr insn-object drop \ ##vm-field-ptr ;
M: ##vm-field insn-object drop \ ##vm-field ;
M: ##set-vm-field insn-object drop \ ##vm-field ;
: init-alias-analysis ( insns -- insns' )
H{ } clone histories set
@ -222,7 +224,7 @@ M: ##vm-field-ptr insn-object drop \ ##vm-field-ptr ;
0 ac-counter set
next-ac heap-ac set
\ ##vm-field-ptr set-new-ac
\ ##vm-field set-new-ac
\ ##alien-global set-new-ac
dup local-live-in [ set-heap-ac ] each ;

14
basis/compiler/cfg/instructions/instructions.factor
View File

@ -660,13 +660,13 @@ INSN: ##alien-global
def: dst/int-rep
literal: symbol library ;
INSN: ##vm-field-ptr
def: dst/int-rep
literal: field-name ;
INSN: ##vm-field
def: dst/int-rep
literal: field-name ;
literal: offset ;
INSN: ##set-vm-field
use: src/int-rep
literal: offset ;
! FFI
INSN: ##alien-invoke
@ -835,8 +835,8 @@ UNION: ##allocation
##box-displaced-alien ;
! For alias analysis
UNION: ##read ##slot ##slot-imm ##vm-field-ptr ##alien-global ;
UNION: ##write ##set-slot ##set-slot-imm ;
UNION: ##read ##slot ##slot-imm ##vm-field ##alien-global ;
UNION: ##write ##set-slot ##set-slot-imm ##set-vm-field ;
! Instructions that kill all live vregs but cannot trigger GC
UNION: partial-sync-insn

1
basis/compiler/cfg/intrinsics/intrinsics.factor
View File

@ -32,6 +32,7 @@ IN: compiler.cfg.intrinsics
{ kernel.private:tag [ drop emit-tag ] }
{ kernel.private:context-object [ emit-context-object ] }
{ kernel.private:special-object [ emit-special-object ] }
{ kernel.private:set-special-object [ emit-set-special-object ] }
{ kernel.private:(identity-hashcode) [ drop emit-identity-hashcode ] }
{ math.private:both-fixnums? [ drop emit-both-fixnums? ] }
{ math.private:fixnum+ [ drop emit-fixnum+ ] }

25
basis/compiler/cfg/intrinsics/misc/misc.factor
View File

@ -1,30 +1,39 @@
! Copyright (C) 2008 Slava Pestov.
! Copyright (C) 2008, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: namespaces layouts sequences kernel math accessors
compiler.tree.propagation.info compiler.cfg.stacks
compiler.cfg.hats compiler.cfg.instructions
compiler.cfg.builder.blocks
compiler.cfg.utilities ;
FROM: vm => context-field-offset ;
FROM: vm => context-field-offset vm-field-offset ;
IN: compiler.cfg.intrinsics.misc
: emit-tag ( -- )
ds-pop tag-mask get ^^and-imm ^^tag-fixnum ds-push ;
: special-object-offset ( n -- offset )
cells "special-objects" vm-field-offset + ;
: emit-special-object ( node -- )
dup node-input-infos first literal>> [
"special-objects" ^^vm-field-ptr
ds-drop swap 0 ^^slot-imm
ds-drop
special-object-offset ^^vm-field
ds-push
] [ emit-primitive ] ?if ;
: context-object-offset ( -- n )
"context-objects" context-field-offset cell /i ;
: emit-set-special-object ( node -- )
dup node-input-infos second literal>> [
ds-drop
[ ds-pop ] dip special-object-offset ##set-vm-field
] [ emit-primitive ] ?if ;
: context-object-offset ( n -- n )
cells "context-objects" context-field-offset + ;
: emit-context-object ( node -- )
dup node-input-infos first literal>> [
"ctx" ^^vm-field
ds-drop swap context-object-offset + 0 ^^slot-imm ds-push
"ctx" vm-field-offset ^^vm-field
ds-drop swap context-object-offset cell /i 0 ^^slot-imm ds-push
] [ emit-primitive ] ?if ;
: emit-identity-hashcode ( -- )

2
basis/compiler/codegen/codegen.factor
View File

@ -210,8 +210,8 @@ CODEGEN: ##compare-imm %compare-imm
CODEGEN: ##compare-float-ordered %compare-float-ordered
CODEGEN: ##compare-float-unordered %compare-float-unordered
CODEGEN: ##save-context %save-context
CODEGEN: ##vm-field-ptr %vm-field-ptr
CODEGEN: ##vm-field %vm-field
CODEGEN: ##set-vm-field %set-vm-field
CODEGEN: _fixnum-add %fixnum-add
CODEGEN: _fixnum-sub %fixnum-sub

11
basis/compiler/tests/alien.factor
View File

@ -432,14 +432,17 @@ STRUCT: double-rect
void { void* void* double-rect } "cdecl"
[ "example" set-global 2drop ] alien-callback ;
: double-rect-test ( arg -- arg' )
f f rot
double-rect-callback
: double-rect-test ( arg callback -- arg' )
[ f f ] 2dip
void { void* void* double-rect } "cdecl" alien-indirect
"example" get-global ;
[ 1.0 2.0 3.0 4.0 ]
[ 1.0 2.0 3.0 4.0 <double-rect> double-rect-test >double-rect< ] unit-test
[
1.0 2.0 3.0 4.0 <double-rect>
double-rect-callback double-rect-test
>double-rect<
] unit-test
STRUCT: test_struct_14
{ x1 double }

6
basis/cpu/architecture/architecture.factor
View File

@ -447,8 +447,10 @@ HOOK: %set-alien-double cpu ( ptr offset value -- )
HOOK: %set-alien-vector cpu ( ptr offset value rep -- )
HOOK: %alien-global cpu ( dst symbol library -- )
HOOK: %vm-field cpu ( dst fieldname -- )
HOOK: %vm-field-ptr cpu ( dst fieldname -- )
HOOK: %vm-field cpu ( dst offset -- )
HOOK: %set-vm-field cpu ( src offset -- )
: %context ( dst -- ) 0 %vm-field ;
HOOK: %allot cpu ( dst size class temp -- )
HOOK: %write-barrier cpu ( src slot temp1 temp2 -- )

16
basis/cpu/ppc/ppc.factor
View File

@ -58,11 +58,7 @@ CONSTANT: vm-reg 15
: %load-vm-addr ( reg -- ) vm-reg MR ;
M: ppc %vm-field ( dst field -- )
[ vm-reg ] dip vm-field-offset LWZ ;
M: ppc %vm-field-ptr ( dst field -- )
[ vm-reg ] dip vm-field-offset ADDI ;
M: ppc %vm-field ( dst field -- ) [ vm-reg ] dip LWZ ;
GENERIC: loc-reg ( loc -- reg )
@ -385,7 +381,7 @@ M: ppc %set-alien-float -rot STFS ;
M: ppc %set-alien-double -rot STFD ;
: load-zone-ptr ( reg -- )
"nursery" %vm-field-ptr ;
vm-reg "nursery" vm-field-offset ADDI ;
: load-allot-ptr ( nursery-ptr allot-ptr -- )
[ drop load-zone-ptr ] [ swap 0 LWZ ] 2bi ;
@ -604,14 +600,14 @@ M: ppc %push-stack ( -- )
int-regs return-reg ds-reg 0 STW ;
M: ppc %push-context-stack ( -- )
11 "ctx" %vm-field
11 %context
12 11 "datastack" context-field-offset LWZ
12 12 4 ADDI
12 11 "datastack" context-field-offset STW
int-regs return-reg 12 0 STW ;
M: ppc %pop-context-stack ( -- )
11 "ctx" %vm-field
11 %context
12 11 "datastack" context-field-offset LWZ
int-regs return-reg 12 0 LWZ
12 12 4 SUBI
@ -677,12 +673,12 @@ M: ppc %box-large-struct ( n c-type -- )
"from_value_struct" f %alien-invoke ;
M:: ppc %restore-context ( temp1 temp2 -- )
temp1 "ctx" %vm-field
temp1 %context
ds-reg temp1 "datastack" context-field-offset LWZ
rs-reg temp1 "retainstack" context-field-offset LWZ ;
M:: ppc %save-context ( temp1 temp2 -- )
temp1 "ctx" %vm-field
temp1 %context
1 temp1 "callstack-top" context-field-offset STW
ds-reg temp1 "datastack" context-field-offset STW
rs-reg temp1 "retainstack" context-field-offset STW ;

9
basis/cpu/x86/32/32.factor
View File

@ -28,10 +28,13 @@ M: x86.32 %mov-vm-ptr ( reg -- )
0 MOV 0 rc-absolute-cell rel-vm ;
M: x86.32 %vm-field ( dst field -- )
[ 0 [] MOV ] dip vm-field-offset rc-absolute-cell rel-vm ;
[ 0 [] MOV ] dip rc-absolute-cell rel-vm ;
M: x86.32 %set-vm-field ( dst field -- )
[ 0 [] swap MOV ] dip rc-absolute-cell rel-vm ;
M: x86.32 %vm-field-ptr ( dst field -- )
[ 0 MOV ] dip vm-field-offset rc-absolute-cell rel-vm ;
[ 0 MOV ] dip rc-absolute-cell rel-vm ;
: local@ ( n -- op )
stack-frame get extra-stack-space dup 16 assert= + stack@ ;
@ -166,7 +169,7 @@ M: x86.32 %pop-stack ( n -- )
EAX swap ds-reg reg-stack MOV ;
M: x86.32 %pop-context-stack ( -- )
temp-reg "ctx" %vm-field
temp-reg %context
EAX temp-reg "datastack" context-field-offset [+] MOV
EAX EAX [] MOV
temp-reg "datastack" context-field-offset [+] bootstrap-cell SUB ;

13
basis/cpu/x86/64/64.factor
View File

@ -43,11 +43,14 @@ M: x86.64 machine-registers
M: x86.64 %mov-vm-ptr ( reg -- )
vm-reg MOV ;
M: x86.64 %vm-field ( dst field -- )
[ vm-reg ] dip vm-field-offset [+] MOV ;
M: x86.64 %vm-field ( dst offset -- )
[ vm-reg ] dip [+] MOV ;
M: x86.64 %vm-field-ptr ( dst field -- )
[ vm-reg ] dip vm-field-offset [+] LEA ;
M: x86.64 %set-vm-field ( src offset -- )
[ vm-reg ] dip [+] swap MOV ;
M: x86.64 %vm-field-ptr ( dst offset -- )
[ vm-reg ] dip [+] LEA ;
: param@ ( n -- op ) reserved-stack-space + stack@ ;
@ -111,7 +114,7 @@ M: x86.64 %pop-stack ( n -- )
param-reg-0 swap ds-reg reg-stack MOV ;
M: x86.64 %pop-context-stack ( -- )
temp-reg "ctx" %vm-field
temp-reg %context
param-reg-0 temp-reg "datastack" context-field-offset [+] MOV
param-reg-0 param-reg-0 [] MOV
temp-reg "datastack" context-field-offset [+] bootstrap-cell SUB ;

15
basis/cpu/x86/x86.factor
View File

@ -423,8 +423,13 @@ M: x86 %sar int-rep two-operand [ SAR ] emit-shift ;
HOOK: %mov-vm-ptr cpu ( reg -- )
HOOK: %vm-field-ptr cpu ( reg offset -- )
: load-zone-offset ( nursery-ptr -- )
"nursery" vm-field-offset %vm-field-ptr ;
: load-allot-ptr ( nursery-ptr allot-ptr -- )
[ drop "nursery" %vm-field-ptr ] [ swap [] MOV ] 2bi ;
[ drop load-zone-offset ] [ swap [] MOV ] 2bi ;
: inc-allot-ptr ( nursery-ptr n -- )
[ [] ] dip data-alignment get align ADD ;
@ -456,7 +461,7 @@ M: x86 %write-barrier ( src slot temp1 temp2 -- ) (%write-barrier) ;
M: x86 %write-barrier-imm ( src slot temp1 temp2 -- ) (%write-barrier) ;
M:: x86 %check-nursery ( label size temp1 temp2 -- )
temp1 "nursery" %vm-field-ptr
temp1 load-zone-offset
! Load 'here' into temp2
temp2 temp1 [] MOV
temp2 size ADD
@ -477,7 +482,7 @@ M: x86 %push-stack ( -- )
ds-reg [] int-regs return-reg MOV ;
M: x86 %push-context-stack ( -- )
temp-reg "ctx" %vm-field
temp-reg %context
temp-reg "datastack" context-field-offset [+] bootstrap-cell ADD
temp-reg temp-reg "datastack" context-field-offset [+] MOV
temp-reg [] int-regs return-reg MOV ;
@ -1403,7 +1408,7 @@ M: x86 %loop-entry 16 code-alignment [ NOP ] times ;
M:: x86 %restore-context ( temp1 temp2 -- )
#! Load Factor stack pointers on entry from C to Factor.
temp1 "ctx" %vm-field
temp1 %context
ds-reg temp1 "datastack" context-field-offset [+] MOV
rs-reg temp1 "retainstack" context-field-offset [+] MOV ;
@ -1411,7 +1416,7 @@ M:: x86 %save-context ( temp1 temp2 -- )
#! Save Factor stack pointers in case the C code calls a
#! callback which does a GC, which must reliably trace
#! all roots.
temp1 "ctx" %vm-field
temp1 %context
temp2 stack-reg cell neg [+] LEA
temp1 "callstack-top" context-field-offset [+] temp2 MOV
temp1 "datastack" context-field-offset [+] ds-reg MOV