compiler.cfg: nuke ##allot-byte-array instruction

db4
Slava Pestov 2010-07-16 19:57:45 -04:00
parent 446ee6896d
commit e5dd21b0b9
11 changed files with 38 additions and 33 deletions

View File

@ -4,7 +4,8 @@ USING: accessors alien.c-types arrays assocs combinators
classes.struct fry kernel layouts locals math namespaces classes.struct fry kernel layouts locals math namespaces
sequences sequences.generalizations system sequences sequences.generalizations system
compiler.cfg.builder.alien.params compiler.cfg.hats compiler.cfg.builder.alien.params compiler.cfg.hats
compiler.cfg.registers compiler.cfg.instructions cpu.architecture ; compiler.cfg.registers compiler.cfg.instructions
compiler.cfg.intrinsics.allot cpu.architecture ;
IN: compiler.cfg.builder.alien.boxing IN: compiler.cfg.builder.alien.boxing
SYMBOL: struct-return-area SYMBOL: struct-return-area
@ -117,7 +118,7 @@ M: long-long-type box
<gc-map> ^^box-long-long ; <gc-map> ^^box-long-long ;
M: struct-c-type box M: struct-c-type box
'[ _ heap-size <gc-map> ^^allot-byte-array dup ^^unbox-byte-array ] 2dip '[ _ heap-size emit-allot-byte-array dup ^^unbox-byte-array ] 2dip
implode-struct ; implode-struct ;
GENERIC: box-parameter ( vregs reps c-type -- dst ) GENERIC: box-parameter ( vregs reps c-type -- dst )

View File

@ -31,6 +31,7 @@ GENERIC# gc-check-offsets* 1 ( call-index seen-allocation? insn n -- call-index
seen-allocation? [ call-index , ] when seen-allocation? [ call-index , ] when
insn-index 1 + f ; insn-index 1 + f ;
M: ##callback-inputs gc-check-offsets* gc-check-here ;
M: ##phi gc-check-offsets* gc-check-here ; M: ##phi gc-check-offsets* gc-check-here ;
M: gc-map-insn gc-check-offsets* gc-check-here ; M: gc-map-insn gc-check-offsets* gc-check-here ;
M: ##allocation gc-check-offsets* 3drop t ; M: ##allocation gc-check-offsets* 3drop t ;

View File

@ -663,10 +663,6 @@ def: dst/tagged-rep
use: src1/int-rep src2/int-rep use: src1/int-rep src2/int-rep
literal: boxer gc-map ; literal: boxer gc-map ;
FLUSHABLE-INSN: ##allot-byte-array
def: dst/tagged-rep
literal: size gc-map ;
! Alien call inputs and outputs are arrays of triples with shape ! Alien call inputs and outputs are arrays of triples with shape
! { vreg rep stack#/reg } ! { vreg rep stack#/reg }
@ -855,7 +851,6 @@ UNION: gc-map-insn
##call-gc ##call-gc
##box ##box
##box-long-long ##box-long-long
##allot-byte-array
factor-call-insn ; factor-call-insn ;
M: gc-map-insn clone call-next-method [ clone ] change-gc-map ; M: gc-map-insn clone call-next-method [ clone ] change-gc-map ;
@ -889,8 +884,7 @@ hairy-clobber-insn
##binary-float-function ##binary-float-function
##unbox ##unbox
##box ##box
##box-long-long ##box-long-long ;
##allot-byte-array ;
! Instructions that have complex expansions and require that the ! Instructions that have complex expansions and require that the
! output registers are not equal to any of the input registers ! output registers are not equal to any of the input registers

View File

@ -66,13 +66,12 @@ IN: compiler.cfg.intrinsics.allot
16 + byte-array ^^allot ; 16 + byte-array ^^allot ;
: emit-allot-byte-array ( len -- dst ) : emit-allot-byte-array ( len -- dst )
ds-drop
dup ^^allot-byte-array dup ^^allot-byte-array
[ byte-array store-length ] [ ds-push ] [ ] tri ; [ byte-array store-length ] [ ds-push ] [ ] tri ;
: emit-(byte-array) ( node -- ) : emit-(byte-array) ( node -- )
dup node-input-infos first literal>> dup expand-(byte-array)? dup node-input-infos first literal>> dup expand-(byte-array)?
[ nip emit-allot-byte-array drop ] [ drop emit-primitive ] if ; [ nip ds-drop emit-allot-byte-array drop ] [ drop emit-primitive ] if ;
:: zero-byte-array ( len reg -- ) :: zero-byte-array ( len reg -- )
0 ^^load-literal :> elt 0 ^^load-literal :> elt
@ -84,6 +83,7 @@ IN: compiler.cfg.intrinsics.allot
:: emit-<byte-array> ( node -- ) :: emit-<byte-array> ( node -- )
node node-input-infos first literal>> dup expand-<byte-array>? [ node node-input-infos first literal>> dup expand-<byte-array>? [
:> len :> len
ds-drop
len emit-allot-byte-array :> reg len emit-allot-byte-array :> reg
len reg zero-byte-array len reg zero-byte-array
] [ drop node emit-primitive ] if ; ] [ drop node emit-primitive ] if ;

View File

@ -11,6 +11,7 @@ compiler.cfg.rpo
compiler.cfg.debugger compiler.cfg.debugger
compiler.cfg.def-use compiler.cfg.def-use
compiler.cfg.comparisons compiler.cfg.comparisons
compiler.cfg.ssa.destruction
compiler.cfg.linear-scan compiler.cfg.linear-scan
compiler.cfg.linear-scan.numbering compiler.cfg.linear-scan.numbering
compiler.cfg.linear-scan.live-intervals compiler.cfg.linear-scan.live-intervals
@ -25,6 +26,36 @@ IN: compiler.cfg.linear-scan.tests
check-allocation? on check-allocation? on
check-numbering? on check-numbering? on
! Live interval calculation
! A value is defined and never used; make sure it has the right
! live range
V{
T{ ##load-integer f 1 0 }
T{ ##replace-imm f D 0 "hi" }
T{ ##branch }
} 0 test-bb
: test-live-intervals ( -- )
cfg new 0 get >>entry
[ cfg set ] [ number-instructions ] [ compute-live-intervals ] tri
2drop ;
[ ] [
H{
{ 1 int-rep }
} representations set
H{
{ 1 1 }
} leader-map set
test-live-intervals
] unit-test
[ 0 0 ] [
1 live-intervals get at [ start>> ] [ end>> ] bi
] unit-test
! Live range and interval splitting
[ [
{ T{ live-range f 1 10 } T{ live-range f 15 15 } } { T{ live-range f 1 10 } T{ live-range f 15 15 } }
{ T{ live-range f 16 20 } } { T{ live-range f 16 20 } }

View File

@ -288,7 +288,6 @@ CODEGEN: ##unbox-long-long %unbox-long-long
CODEGEN: ##local-allot %local-allot CODEGEN: ##local-allot %local-allot
CODEGEN: ##box %box CODEGEN: ##box %box
CODEGEN: ##box-long-long %box-long-long CODEGEN: ##box-long-long %box-long-long
CODEGEN: ##allot-byte-array %allot-byte-array
CODEGEN: ##alien-invoke %alien-invoke CODEGEN: ##alien-invoke %alien-invoke
CODEGEN: ##alien-indirect %alien-indirect CODEGEN: ##alien-indirect %alien-indirect
CODEGEN: ##alien-assembly %alien-assembly CODEGEN: ##alien-assembly %alien-assembly

View File

@ -596,8 +596,6 @@ HOOK: %box cpu ( dst src func rep gc-map -- )
HOOK: %box-long-long cpu ( dst src1 src2 func gc-map -- ) HOOK: %box-long-long cpu ( dst src1 src2 func gc-map -- )
HOOK: %allot-byte-array cpu ( dst size gc-map -- )
HOOK: %save-context cpu ( temp1 temp2 -- ) HOOK: %save-context cpu ( temp1 temp2 -- )
HOOK: %c-invoke cpu ( symbols dll gc-map -- ) HOOK: %c-invoke cpu ( symbols dll gc-map -- )

View File

@ -178,12 +178,6 @@ M:: x86.32 %box-long-long ( dst src1 src2 func gc-map -- )
func f gc-map %c-invoke func f gc-map %c-invoke
dst EAX tagged-rep %copy ; dst EAX tagged-rep %copy ;
M:: x86.32 %allot-byte-array ( dst size gc-map -- )
4 save-vm-ptr
0 stack@ size MOV
"allot_byte_array" f gc-map %c-invoke
dst EAX tagged-rep %copy ;
M: x86.32 %c-invoke M: x86.32 %c-invoke
[ 0 CALL rc-relative rel-dlsym ] dip gc-map-here ; [ 0 CALL rc-relative rel-dlsym ] dip gc-map-here ;

View File

@ -107,12 +107,6 @@ M:: x86.64 %box ( dst src func rep gc-map -- )
func f gc-map %c-invoke func f gc-map %c-invoke
dst int-rep %load-return ; dst int-rep %load-return ;
M:: x86.64 %allot-byte-array ( dst size gc-map -- )
param-reg-0 size MOV
param-reg-1 %mov-vm-ptr
"allot_byte_array" f gc-map %c-invoke
dst int-rep %load-return ;
M: x86.64 %c-invoke M: x86.64 %c-invoke
[ R11 0 MOV rc-absolute-cell rel-dlsym R11 CALL ] dip [ R11 0 MOV rc-absolute-cell rel-dlsym R11 CALL ] dip
gc-map-here ; gc-map-here ;

View File

@ -10,11 +10,6 @@ byte_array *factor_vm::allot_byte_array(cell size)
return array; return array;
} }
VM_C_API cell allot_byte_array(cell size, factor_vm *parent)
{
return tag<byte_array>(parent->allot_byte_array(size));
}
void factor_vm::primitive_byte_array() void factor_vm::primitive_byte_array()
{ {
cell size = unbox_array_size(); cell size = unbox_array_size();

View File

@ -21,6 +21,4 @@ template<typename Type> byte_array *factor_vm::byte_array_from_value(Type *value
return data; return data;
} }
VM_C_API cell allot_byte_array(cell size, factor_vm *parent);
} }