Expand allocations for simpler intrinsics
parent
543ad02658
commit
966ef323bc
|
@ -22,18 +22,6 @@ ERROR: not-a-tuple object ;
|
|||
|
||||
<PRIVATE
|
||||
|
||||
: (tuple) ( layout -- tuple )
|
||||
#! In non-optimized code, this word simply calls the
|
||||
#! <tuple> primitive. In optimized code, an intrinsic
|
||||
#! is generated which allocates a tuple but does not set
|
||||
#! any of its slots. This means that any code that uses
|
||||
#! (tuple) must fill in the slots before the next
|
||||
#! call to GC.
|
||||
#!
|
||||
#! This word is only used in the expansion of <tuple-boa>,
|
||||
#! where this invariant is guaranteed to hold.
|
||||
<tuple> ;
|
||||
|
||||
: tuple-layout ( class -- layout )
|
||||
"layout" word-prop ;
|
||||
|
||||
|
|
|
@ -162,8 +162,6 @@ PREDICATE: small-slot < integer cells small-enough? ;
|
|||
|
||||
PREDICATE: small-tagged < integer v>operand small-enough? ;
|
||||
|
||||
PREDICATE: inline-array < integer 32 < ;
|
||||
|
||||
: if-small-struct ( n size true false -- ? )
|
||||
>r >r over not over struct-small-enough? and
|
||||
[ nip r> call r> drop ] [ r> drop r> call ] if ;
|
||||
|
|
|
@ -450,33 +450,28 @@ IN: cpu.ppc.intrinsics
|
|||
{ +output+ { "tuple" } }
|
||||
} define-intrinsic
|
||||
|
||||
\ <array> [
|
||||
\ (array) [
|
||||
array "n" get 2 + cells %allot
|
||||
! Store length
|
||||
"n" operand 12 LI
|
||||
12 11 cell STW
|
||||
! Store initial element
|
||||
"n" get [ "initial" operand 11 rot 2 + cells STW ] each
|
||||
! Store tagged ptr in reg
|
||||
"array" get object %store-tagged
|
||||
] H{
|
||||
{ +input+ { { [ inline-array? ] "n" } { f "initial" } } }
|
||||
{ +input+ { { [ ] "n" } } }
|
||||
{ +scratch+ { { f "array" } } }
|
||||
{ +output+ { "array" } }
|
||||
} define-intrinsic
|
||||
|
||||
\ <byte-array> [
|
||||
\ (byte-array) [
|
||||
byte-array "n" get 2 cells + %allot
|
||||
! Store length
|
||||
"n" operand 12 LI
|
||||
12 11 cell STW
|
||||
! Store initial element
|
||||
0 12 LI
|
||||
"n" get cell align cell /i [ 12 11 rot 2 + cells STW ] each
|
||||
! Store tagged ptr in reg
|
||||
"array" get object %store-tagged
|
||||
] H{
|
||||
{ +input+ { { [ inline-array? ] "n" } } }
|
||||
{ +input+ { { [ ] "n" } } }
|
||||
{ +scratch+ { { f "array" } } }
|
||||
{ +output+ { "array" } }
|
||||
} define-intrinsic
|
||||
|
|
|
@ -6,8 +6,7 @@ kernel.private math math.private namespaces quotations sequences
|
|||
words generic byte-arrays hashtables hashtables.private
|
||||
generator generator.registers generator.fixup sequences.private
|
||||
sbufs sbufs.private vectors vectors.private layouts system
|
||||
classes.tuple.private strings.private slots.private
|
||||
compiler.constants ;
|
||||
strings.private slots.private compiler.constants optimizer.allot ;
|
||||
IN: cpu.x86.intrinsics
|
||||
|
||||
! Type checks
|
||||
|
@ -298,37 +297,33 @@ IN: cpu.x86.intrinsics
|
|||
"tuple" get tuple %store-tagged
|
||||
] %allot
|
||||
] H{
|
||||
{ +input+ { { [ tuple-layout? ] "layout" } } }
|
||||
{ +input+ { { [ ] "layout" } } }
|
||||
{ +scratch+ { { f "tuple" } { f "scratch" } } }
|
||||
{ +output+ { "tuple" } }
|
||||
} define-intrinsic
|
||||
|
||||
\ <array> [
|
||||
\ (array) [
|
||||
array "n" get 2 + cells [
|
||||
! Store length
|
||||
1 object@ "n" operand MOV
|
||||
! Zero out the rest of the tuple
|
||||
"n" get [ 2 + object@ "initial" operand MOV ] each
|
||||
! Store tagged ptr in reg
|
||||
"array" get object %store-tagged
|
||||
] %allot
|
||||
] H{
|
||||
{ +input+ { { [ inline-array? ] "n" } { f "initial" } } }
|
||||
{ +input+ { { [ ] "n" } } }
|
||||
{ +scratch+ { { f "array" } } }
|
||||
{ +output+ { "array" } }
|
||||
} define-intrinsic
|
||||
|
||||
\ <byte-array> [
|
||||
\ (byte-array) [
|
||||
byte-array "n" get 2 cells + [
|
||||
! Store length
|
||||
1 object@ "n" operand MOV
|
||||
! Store initial element
|
||||
"n" get cell align cell /i [ 2 + object@ 0 MOV ] each
|
||||
! Store tagged ptr in reg
|
||||
"array" get object %store-tagged
|
||||
] %allot
|
||||
] H{
|
||||
{ +input+ { { [ inline-array? ] "n" } } }
|
||||
{ +input+ { { [ ] "n" } } }
|
||||
{ +scratch+ { { f "array" } } }
|
||||
{ +output+ { "array" } }
|
||||
} define-intrinsic
|
||||
|
|
|
@ -540,9 +540,6 @@ set-primitive-effect
|
|||
\ <tuple> { tuple-layout } { tuple } <effect> set-primitive-effect
|
||||
\ <tuple> make-flushable
|
||||
|
||||
\ (tuple) { tuple-layout } { tuple } <effect> set-primitive-effect
|
||||
\ (tuple) make-flushable
|
||||
|
||||
\ <tuple-layout> { word fixnum array fixnum } { tuple-layout } <effect> set-primitive-effect
|
||||
\ <tuple-layout> make-foldable
|
||||
|
||||
|
|
|
@ -0,0 +1,96 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors sequences sequences.private classes.tuple
|
||||
classes.tuple.private kernel effects words quotations namespaces
|
||||
definitions math math.order layouts alien.accessors
|
||||
slots.private arrays byte-arrays inference.dataflow
|
||||
inference.known-words inference.state optimizer.inlining
|
||||
optimizer.backend ;
|
||||
IN: optimizer.allot
|
||||
|
||||
! Expand memory allocation primitives into simpler constructs
|
||||
! to simplify the backend.
|
||||
|
||||
: first-input ( #call -- obj ) dup in-d>> first node-literal ;
|
||||
|
||||
: (tuple) ( layout -- tuple ) "BUG: missing (tuple) intrinsic" throw ;
|
||||
|
||||
\ (tuple) { tuple-layout } { tuple } <effect> set-primitive-effect
|
||||
\ (tuple) make-flushable
|
||||
|
||||
! if the input to new is a literal tuple class, we can expand it
|
||||
: literal-new? ( #call -- ? )
|
||||
first-input tuple-class? ;
|
||||
|
||||
: new-quot ( class -- quot )
|
||||
dup all-slots 1 tail ! delegate slot
|
||||
[ [ initial>> literalize , ] each literalize , \ boa , ] [ ] make ;
|
||||
|
||||
: expand-new ( #call -- node )
|
||||
dup first-input
|
||||
[ +inlined+ depends-on ] [ new-quot ] bi
|
||||
f splice-quot ;
|
||||
|
||||
\ new {
|
||||
{ [ dup literal-new? ] [ expand-new ] }
|
||||
} define-optimizers
|
||||
|
||||
: tuple-boa-quot ( layout -- quot )
|
||||
[ (tuple) ]
|
||||
swap size>> 1 - [ 3 + ] map <reversed>
|
||||
[ [ set-slot ] curry [ keep ] curry ] map concat
|
||||
[ f over 2 set-slot ]
|
||||
3append ;
|
||||
|
||||
: expand-tuple-boa ( #call -- node )
|
||||
dup in-d>> peek value-literal tuple-boa-quot f splice-quot ;
|
||||
|
||||
\ <tuple-boa> {
|
||||
{ [ t ] [ expand-tuple-boa ] }
|
||||
} define-optimizers
|
||||
|
||||
: (array) ( n -- array ) "BUG: missing (array) intrinsic" throw ;
|
||||
|
||||
\ (array) { integer } { array } <effect> set-primitive-effect
|
||||
\ (array) make-flushable
|
||||
|
||||
: <array>-quot ( n -- quot )
|
||||
[
|
||||
[ swap (array) ] %
|
||||
[ \ 2dup , , [ swap set-array-nth ] % ] each
|
||||
\ nip ,
|
||||
] [ ] make ;
|
||||
|
||||
: literal-<array>? ( #call -- ? )
|
||||
first-input dup integer? [ 0 32 between? ] [ drop f ] if ;
|
||||
|
||||
: expand-<array> ( #call -- node )
|
||||
dup first-input <array>-quot f splice-quot ;
|
||||
|
||||
\ <array> {
|
||||
{ [ dup literal-<array>? ] [ expand-<array> ] }
|
||||
} define-optimizers
|
||||
|
||||
: (byte-array) ( n -- byte-array ) "BUG: missing (byte-array) intrinsic" throw ;
|
||||
|
||||
\ (byte-array) { integer } { byte-array } <effect> set-primitive-effect
|
||||
\ (byte-array) make-flushable
|
||||
|
||||
: bytes>cells ( m -- n ) cell align cell /i ;
|
||||
|
||||
: <byte-array>-quot ( n -- quot )
|
||||
[
|
||||
\ (byte-array) ,
|
||||
bytes>cells [ cell * ] map
|
||||
[ [ 0 over ] % , [ set-alien-unsigned-cell ] % ] each
|
||||
] [ ] make ;
|
||||
|
||||
: literal-<byte-array>? ( #call -- ? )
|
||||
first-input dup integer? [ 0 128 between? ] [ drop f ] if ;
|
||||
|
||||
: expand-<byte-array> ( #call -- node )
|
||||
dup first-input <byte-array>-quot f splice-quot ;
|
||||
|
||||
\ <byte-array> {
|
||||
{ [ dup literal-<byte-array>? ] [ expand-<byte-array> ] }
|
||||
} define-optimizers
|
|
@ -9,7 +9,7 @@ classes.tuple classes.predicate classes.tuple.private classes
|
|||
classes.algebra sequences.private combinators byte-arrays
|
||||
byte-vectors slots.private inference.dataflow inference.state
|
||||
inference.class optimizer.def-use optimizer.backend
|
||||
optimizer.pattern-match optimizer.inlining ;
|
||||
optimizer.pattern-match optimizer.inlining optimizer.allot ;
|
||||
IN: optimizer.known-words
|
||||
|
||||
{ <tuple> <tuple-boa> (tuple) } [
|
||||
|
@ -25,37 +25,6 @@ IN: optimizer.known-words
|
|||
dup class? [ drop tuple ] unless 1array f
|
||||
] "output-classes" set-word-prop
|
||||
|
||||
! if the input to new is a literal tuple class, we can expand it
|
||||
: literal-new? ( #call -- ? )
|
||||
dup in-d>> first node-literal tuple-class? ;
|
||||
|
||||
: new-quot ( class -- quot )
|
||||
dup all-slots 1 tail ! delegate slot
|
||||
[ [ initial>> literalize , ] each literalize , \ boa , ] [ ] make ;
|
||||
|
||||
: expand-new ( #call -- node )
|
||||
dup dup in-d>> first node-literal
|
||||
[ +inlined+ depends-on ] [ new-quot ] bi
|
||||
f splice-quot ;
|
||||
|
||||
\ new {
|
||||
{ [ dup literal-new? ] [ expand-new ] }
|
||||
} define-optimizers
|
||||
|
||||
: tuple-boa-quot ( layout -- quot )
|
||||
[ (tuple) ]
|
||||
swap size>> 1 - [ 3 + ] map <reversed>
|
||||
[ [ set-slot ] curry [ keep ] curry ] map concat
|
||||
[ f over 2 set-slot ]
|
||||
3append ;
|
||||
|
||||
: expand-tuple-boa ( #call -- node )
|
||||
dup in-d>> peek value-literal tuple-boa-quot f splice-quot ;
|
||||
|
||||
\ <tuple-boa> {
|
||||
{ [ t ] [ expand-tuple-boa ] }
|
||||
} define-optimizers
|
||||
|
||||
! the output of clone has the same type as the input
|
||||
{ clone (clone) } [
|
||||
[
|
||||
|
|
|
@ -1,8 +1,9 @@
|
|||
! Copyright (C) 2006, 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel namespaces optimizer.backend optimizer.def-use
|
||||
optimizer.known-words optimizer.math optimizer.control
|
||||
optimizer.collect optimizer.inlining inference.class ;
|
||||
optimizer.known-words optimizer.math optimizer.allot
|
||||
optimizer.control optimizer.collect optimizer.inlining
|
||||
inference.class ;
|
||||
IN: optimizer
|
||||
|
||||
: optimize-1 ( node -- newnode ? )
|
||||
|
|
|
@ -58,6 +58,7 @@ MATCH-VARS: ?a ?b ?c ;
|
|||
{ { { ?a ?b ?c } { ?a ?b ?c ?a ?b ?c } } [ 3dup ] }
|
||||
{ { { ?a ?b } { ?a ?b ?a } } [ over ] }
|
||||
{ { { ?b ?a } { ?a ?b } } [ swap ] }
|
||||
{ { { ?a ?b } { ?b ?a ?b } } [ tuck ] }
|
||||
{ { { ?a ?b ?c } { ?a ?b ?c ?a } } [ pick ] }
|
||||
{ { { ?a ?b ?c } { ?c ?a ?b } } [ -rot ] }
|
||||
{ { { ?a ?b ?c } { ?b ?c ?a } } [ rot ] }
|
||||
|
|
Loading…
Reference in New Issue