compiler.cfg: more flexible addressing for ##slot and ##set-slot
parent
6d41d2277f
commit
2475699736
basis
compiler
cfg
instructions
intrinsics/slots
tests
cpu
architecture
x86
|
@ -73,7 +73,8 @@ temp: temp/int-rep ;
|
|||
! Slot access
|
||||
INSN: ##slot
|
||||
def: dst/tagged-rep
|
||||
use: obj/tagged-rep slot/int-rep ;
|
||||
use: obj/tagged-rep slot/int-rep
|
||||
literal: scale tag ;
|
||||
|
||||
INSN: ##slot-imm
|
||||
def: dst/tagged-rep
|
||||
|
@ -81,7 +82,8 @@ use: obj/tagged-rep
|
|||
literal: slot tag ;
|
||||
|
||||
INSN: ##set-slot
|
||||
use: src/tagged-rep obj/tagged-rep slot/int-rep ;
|
||||
use: src/tagged-rep obj/tagged-rep slot/int-rep
|
||||
literal: scale tag ;
|
||||
|
||||
INSN: ##set-slot-imm
|
||||
use: src/tagged-rep obj/tagged-rep
|
||||
|
@ -568,11 +570,12 @@ temp: temp/int-rep ;
|
|||
|
||||
INSN: ##write-barrier
|
||||
use: src/tagged-rep slot/int-rep
|
||||
literal: scale tag
|
||||
temp: temp1/int-rep temp2/int-rep ;
|
||||
|
||||
INSN: ##write-barrier-imm
|
||||
use: src/tagged-rep
|
||||
literal: slot
|
||||
literal: slot tag
|
||||
temp: temp1/int-rep temp2/int-rep ;
|
||||
|
||||
INSN: ##alien-global
|
||||
|
|
|
@ -1,9 +1,10 @@
|
|||
! Copyright (C) 2008, 2009 Slava Pestov.
|
||||
! Copyright (C) 2008, 2010 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: layouts namespaces kernel accessors sequences math
|
||||
classes.algebra classes.builtin locals combinators
|
||||
cpu.architecture compiler.tree.propagation.info
|
||||
compiler.cfg.stacks compiler.cfg.hats compiler.cfg.registers
|
||||
combinators.short-circuit cpu.architecture
|
||||
compiler.tree.propagation.info compiler.cfg.stacks
|
||||
compiler.cfg.hats compiler.cfg.registers
|
||||
compiler.cfg.instructions compiler.cfg.utilities
|
||||
compiler.cfg.builder.blocks compiler.constants ;
|
||||
IN: compiler.cfg.intrinsics.slots
|
||||
|
@ -13,12 +14,13 @@ IN: compiler.cfg.intrinsics.slots
|
|||
|
||||
: value-tag ( info -- n ) class>> class-tag ;
|
||||
|
||||
: ^^tag-offset>slot ( slot tag -- vreg' )
|
||||
[ ^^offset>slot ] dip ^^sub-imm ;
|
||||
: slot-indexing ( slot tag -- slot scale tag )
|
||||
complex-addressing?
|
||||
[ [ cell log2 ] dip ] [ [ ^^offset>slot ] dip ^^sub-imm 0 0 ] if ;
|
||||
|
||||
: (emit-slot) ( infos -- dst )
|
||||
[ 2inputs ] [ first value-tag ] bi*
|
||||
^^tag-offset>slot ^^slot ;
|
||||
slot-indexing ^^slot ;
|
||||
|
||||
: (emit-slot-imm) ( infos -- dst )
|
||||
ds-drop
|
||||
|
@ -28,9 +30,9 @@ IN: compiler.cfg.intrinsics.slots
|
|||
|
||||
: immediate-slot-offset? ( value-info -- ? )
|
||||
literal>> {
|
||||
{ [ dup fixnum? ] [ tag-fixnum immediate-arithmetic? ] }
|
||||
[ drop f ]
|
||||
} cond ;
|
||||
[ fixnum? ]
|
||||
[ cell * immediate-arithmetic? ]
|
||||
} 1&& ;
|
||||
|
||||
: emit-slot ( node -- )
|
||||
dup node-input-infos
|
||||
|
@ -47,12 +49,13 @@ IN: compiler.cfg.intrinsics.slots
|
|||
:: (emit-set-slot) ( infos -- )
|
||||
3inputs :> ( src obj slot )
|
||||
|
||||
slot infos second value-tag ^^tag-offset>slot :> slot
|
||||
infos second value-tag :> tag
|
||||
|
||||
src obj slot ##set-slot
|
||||
slot tag slot-indexing :> ( slot scale tag )
|
||||
src obj slot scale tag ##set-slot
|
||||
|
||||
infos emit-write-barrier?
|
||||
[ obj slot next-vreg next-vreg ##write-barrier ] when ;
|
||||
[ obj slot scale tag next-vreg next-vreg ##write-barrier ] when ;
|
||||
|
||||
:: (emit-set-slot-imm) ( infos -- )
|
||||
ds-drop
|
||||
|
@ -65,7 +68,7 @@ IN: compiler.cfg.intrinsics.slots
|
|||
src obj slot tag ##set-slot-imm
|
||||
|
||||
infos emit-write-barrier?
|
||||
[ obj slot tag slot-offset next-vreg next-vreg ##write-barrier-imm ] when ;
|
||||
[ obj slot tag next-vreg next-vreg ##write-barrier-imm ] when ;
|
||||
|
||||
: emit-set-slot ( node -- )
|
||||
dup node-input-infos
|
||||
|
|
|
@ -46,7 +46,7 @@ IN: compiler.tests.low-level-ir
|
|||
V{
|
||||
T{ ##load-tagged f 1 $[ 2 cell log2 shift array type-number - ] }
|
||||
T{ ##load-reference f 0 { t f t } }
|
||||
T{ ##slot f 0 0 1 }
|
||||
T{ ##slot f 0 0 1 0 0 }
|
||||
} compile-test-bb
|
||||
] unit-test
|
||||
|
||||
|
@ -61,7 +61,7 @@ IN: compiler.tests.low-level-ir
|
|||
V{
|
||||
T{ ##load-tagged f 1 $[ 2 cell log2 shift array type-number - ] }
|
||||
T{ ##load-reference f 0 { t f t } }
|
||||
T{ ##set-slot f 0 0 1 }
|
||||
T{ ##set-slot f 0 0 1 0 0 }
|
||||
} compile-test-bb
|
||||
dup first eq?
|
||||
] unit-test
|
||||
|
|
|
@ -203,6 +203,11 @@ M: ulonglong-2-rep scalar-rep-of drop ulonglong-scalar-rep ;
|
|||
! Mapping from register class to machine registers
|
||||
HOOK: machine-registers cpu ( -- assoc )
|
||||
|
||||
! Specifies if %slot, %set-slot and %write-barrier accept the
|
||||
! 'scale' and 'tag' parameters, and if %load-memory and
|
||||
! %store-memory work
|
||||
HOOK: complex-addressing? cpu ( -- ? )
|
||||
|
||||
HOOK: %load-immediate cpu ( reg val -- )
|
||||
HOOK: %load-reference cpu ( reg obj -- )
|
||||
HOOK: %load-double cpu ( reg val -- )
|
||||
|
@ -220,9 +225,9 @@ HOOK: %return cpu ( -- )
|
|||
|
||||
HOOK: %dispatch cpu ( src temp -- )
|
||||
|
||||
HOOK: %slot cpu ( dst obj slot -- )
|
||||
HOOK: %slot cpu ( dst obj slot scale tag -- )
|
||||
HOOK: %slot-imm cpu ( dst obj slot tag -- )
|
||||
HOOK: %set-slot cpu ( src obj slot -- )
|
||||
HOOK: %set-slot cpu ( src obj slot scale tag -- )
|
||||
HOOK: %set-slot-imm cpu ( src obj slot tag -- )
|
||||
|
||||
HOOK: %string-nth cpu ( dst obj index temp -- )
|
||||
|
@ -440,8 +445,8 @@ 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 -- )
|
||||
HOOK: %write-barrier-imm cpu ( src slot temp1 temp2 -- )
|
||||
HOOK: %write-barrier cpu ( src slot scale tag temp1 temp2 -- )
|
||||
HOOK: %write-barrier-imm cpu ( src slot tag temp1 temp2 -- )
|
||||
|
||||
! GC checks
|
||||
HOOK: %check-nursery cpu ( label size temp1 temp2 -- )
|
||||
|
|
|
@ -65,6 +65,8 @@ HOOK: temp-reg cpu ( -- reg )
|
|||
|
||||
HOOK: pic-tail-reg cpu ( -- reg )
|
||||
|
||||
M: x86 complex-addressing? t ;
|
||||
|
||||
M: x86 %load-immediate dup 0 = [ drop dup XOR ] [ MOV ] if ;
|
||||
|
||||
M: x86 %load-reference
|
||||
|
@ -110,12 +112,12 @@ M: x86 %return ( -- ) 0 RET ;
|
|||
: align-code ( n -- )
|
||||
0 <repetition> % ;
|
||||
|
||||
:: (%slot-imm) ( obj slot tag -- op )
|
||||
obj slot tag slot-offset [+] ; inline
|
||||
: (%slot) ( obj slot scale tag -- op ) neg <indirect> ; inline
|
||||
: (%slot-imm) ( obj slot tag -- op ) slot-offset [+] ; inline
|
||||
|
||||
M: x86 %slot ( dst obj slot -- ) [+] MOV ;
|
||||
M: x86 %slot ( dst obj slot scale tag -- ) (%slot) MOV ;
|
||||
M: x86 %slot-imm ( dst obj slot tag -- ) (%slot-imm) MOV ;
|
||||
M: x86 %set-slot ( src obj slot -- ) [+] swap MOV ;
|
||||
M: x86 %set-slot ( src obj slot scale tag -- ) (%slot) swap MOV ;
|
||||
M: x86 %set-slot-imm ( src obj slot tag -- ) (%slot-imm) swap MOV ;
|
||||
|
||||
:: two-operand ( dst src1 src2 rep -- dst src )
|
||||
|
@ -283,7 +285,7 @@ M:: x86 %box-displaced-alien ( dst displacement base temp base-class -- )
|
|||
|
||||
dst 1 alien@ base MOV
|
||||
dst 3 alien@ displacement MOV
|
||||
temp base displacement byte-array-offset [++] MOV
|
||||
temp base displacement byte-array-offset [++] LEA
|
||||
dst 4 alien@ temp MOV
|
||||
|
||||
"end" resolve-label
|
||||
|
@ -445,16 +447,19 @@ M:: x86 %allot ( dst size class nursery-ptr -- )
|
|||
HOOK: %mark-card cpu ( card temp -- )
|
||||
HOOK: %mark-deck cpu ( card temp -- )
|
||||
|
||||
:: (%write-barrier) ( src slot temp1 temp2 -- )
|
||||
temp1 src slot [+] LEA
|
||||
:: (%write-barrier) ( temp1 temp2 -- )
|
||||
temp1 card-bits SHR
|
||||
temp1 temp2 %mark-card
|
||||
temp1 deck-bits card-bits - SHR
|
||||
temp1 temp2 %mark-deck ;
|
||||
|
||||
M: x86 %write-barrier ( src slot temp1 temp2 -- ) (%write-barrier) ;
|
||||
M:: x86 %write-barrier ( src slot scale tag temp1 temp2 -- )
|
||||
temp1 src slot scale tag (%slot) LEA
|
||||
temp1 temp2 (%write-barrier) ;
|
||||
|
||||
M: x86 %write-barrier-imm ( src slot temp1 temp2 -- ) (%write-barrier) ;
|
||||
M:: x86 %write-barrier-imm ( src slot tag temp1 temp2 -- )
|
||||
temp1 src slot tag (%slot-imm) LEA
|
||||
temp1 temp2 (%write-barrier) ;
|
||||
|
||||
M:: x86 %check-nursery ( label size temp1 temp2 -- )
|
||||
temp1 load-zone-offset
|
||||
|
|
Loading…
Reference in New Issue