From fb8723bce1062dad67aaa6cc9349d7eb367270cf Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 30 Jun 2008 03:10:43 -0500 Subject: [PATCH] Better optimizers for new, boa --- core/classes/tuple/tuple-tests.factor | 12 ++++++- core/classes/tuple/tuple.factor | 35 ++++++++++++++++--- core/cpu/ppc/intrinsics/intrinsics.factor | 5 +-- core/cpu/x86/intrinsics/intrinsics.factor | 6 +--- core/inference/known-words/known-words.factor | 3 ++ core/inference/transforms/transforms.factor | 7 ++-- core/mirrors/mirrors-docs.factor | 4 --- core/optimizer/known-words/known-words.factor | 32 +++++++++-------- 8 files changed, 68 insertions(+), 36 deletions(-) diff --git a/core/classes/tuple/tuple-tests.factor b/core/classes/tuple/tuple-tests.factor index bab2b0f53d..af04501209 100755 --- a/core/classes/tuple/tuple-tests.factor +++ b/core/classes/tuple/tuple-tests.factor @@ -477,7 +477,9 @@ USE: vocabs ] with-compilation-unit ] unit-test -[ "USE: words T{ word }" eval ] [ error>> T{ no-method f word new } = ] must-fail-with +[ "USE: words T{ word }" eval ] +[ error>> T{ no-method f word slots>tuple } = ] +must-fail-with ! Accessors not being forgotten... [ [ ] ] [ @@ -621,3 +623,11 @@ must-fail-with [ 0 { } foo ] [ T{ bad-slot-value f { } string } = ] must-fail-with + +[ T{ declared-types f 0 "" } ] [ declared-types new ] unit-test + +: blah ( -- vec ) vector new ; + +\ blah must-infer + +[ V{ } ] [ blah ] unit-test diff --git a/core/classes/tuple/tuple.factor b/core/classes/tuple/tuple.factor index 41e139f4c3..58b0acbd83 100755 --- a/core/classes/tuple/tuple.factor +++ b/core/classes/tuple/tuple.factor @@ -16,6 +16,18 @@ ERROR: not-a-tuple object ; 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 , + #! where this invariant is guaranteed to hold. + ; + : tuple-layout ( class -- layout ) "layout" word-prop ; @@ -52,9 +64,11 @@ PRIVATE> ] 2each ] if-bootstrapping ; inline -: slots>tuple ( seq class -- tuple ) +GENERIC: slots>tuple ( seq class -- tuple ) + +M: tuple-class slots>tuple check-slots - new [ + tuple-layout [ [ tuple-size ] [ [ set-array-nth ] curry ] bi 2each @@ -119,6 +133,12 @@ ERROR: bad-superclass class ; : define-boa-check ( class -- ) dup boa-check-quot "boa-check" set-word-prop ; +: tuple-prototype ( class -- prototype ) + [ all-slots [ initial>> ] map ] keep slots>tuple ; + +: define-tuple-prototype ( class -- ) + dup tuple-prototype "prototype" set-word-prop ; + : generate-tuple-slots ( class slots -- slot-specs ) over superclass-size 2 + make-slots deprecated-slots ; @@ -172,6 +192,7 @@ M: tuple-class update-class [ define-tuple-layout ] [ define-tuple-slots ] [ define-tuple-predicate ] + [ define-tuple-prototype ] [ define-boa-check ] } cleave ; @@ -235,8 +256,11 @@ M: tuple-class reset-class ] with each ] [ [ call-next-method ] - [ { "layout" "slots" "slot-names" } reset-props ] - bi + [ + { + "layout" "slots" "slot-names" "boa-check" "prototype" + } reset-props + ] bi ] bi ; M: tuple-class rank-class drop 0 ; @@ -258,7 +282,8 @@ M: tuple hashcode* ] 2curry each ] recursive-hashcode ; -M: tuple-class new tuple-layout ; +M: tuple-class new + "prototype" word-prop (clone) ; M: tuple-class boa [ "boa-check" word-prop call ] diff --git a/core/cpu/ppc/intrinsics/intrinsics.factor b/core/cpu/ppc/intrinsics/intrinsics.factor index 61a27ec88f..2d4b5fad3b 100755 --- a/core/cpu/ppc/intrinsics/intrinsics.factor +++ b/core/cpu/ppc/intrinsics/intrinsics.factor @@ -437,14 +437,11 @@ IN: cpu.ppc.intrinsics { +clobber+ { "n" } } } define-intrinsic -\ [ +\ (tuple) [ tuple "layout" get size>> 2 + cells %allot ! Store layout "layout" get 12 load-indirect 12 11 cell STW - ! Zero out the rest of the tuple - f v>operand 12 LI - "layout" get size>> [ 12 11 rot 2 + cells STW ] each ! Store tagged ptr in reg "tuple" get tuple %store-tagged ] H{ diff --git a/core/cpu/x86/intrinsics/intrinsics.factor b/core/cpu/x86/intrinsics/intrinsics.factor index 5d1825872a..03668cea3d 100755 --- a/core/cpu/x86/intrinsics/intrinsics.factor +++ b/core/cpu/x86/intrinsics/intrinsics.factor @@ -291,15 +291,11 @@ IN: cpu.x86.intrinsics { +clobber+ { "n" } } } define-intrinsic -\ [ +\ (tuple) [ tuple "layout" get size>> 2 + cells [ ! Store layout "layout" get "scratch" get load-literal 1 object@ "scratch" operand MOV - ! Zero out the rest of the tuple - "layout" get size>> [ - 2 + object@ f v>operand MOV - ] each ! Store tagged ptr in reg "tuple" get tuple %store-tagged ] %allot diff --git a/core/inference/known-words/known-words.factor b/core/inference/known-words/known-words.factor index 3a54ccf975..a90e7cc6da 100755 --- a/core/inference/known-words/known-words.factor +++ b/core/inference/known-words/known-words.factor @@ -550,6 +550,9 @@ set-primitive-effect \ { tuple-layout } { tuple } set-primitive-effect \ make-flushable +\ (tuple) { tuple-layout } { tuple } set-primitive-effect +\ (tuple) make-flushable + \ { word fixnum array fixnum } { tuple-layout } set-primitive-effect \ make-foldable diff --git a/core/inference/transforms/transforms.factor b/core/inference/transforms/transforms.factor index 78860ab895..7bae8f5abd 100755 --- a/core/inference/transforms/transforms.factor +++ b/core/inference/transforms/transforms.factor @@ -95,12 +95,13 @@ M: duplicated-slots-error summary ] 1 define-transform : [tuple-boa] ( layout -- quot ) - [ [ ] curry ] + [ [ (tuple) ] curry ] [ size>> 1 - [ 3 + ] map [ [ set-slot ] curry [ keep ] curry ] map concat - ] - bi append ; + ] bi + [ f over 2 set-slot ] + 3append ; \ [ [tuple-boa] ] 1 define-transform diff --git a/core/mirrors/mirrors-docs.factor b/core/mirrors/mirrors-docs.factor index 60de841568..b7fbb7b0a6 100755 --- a/core/mirrors/mirrors-docs.factor +++ b/core/mirrors/mirrors-docs.factor @@ -13,10 +13,6 @@ $nl ABOUT: "mirrors" -HELP: object-slots -{ $values { "obj" object } { "seq" "a sequence of " { $link slot-spec } " instances" } } -{ $description "Outputs a sequence of slot specifiers for the object." } ; - HELP: mirror { $class-description "An associative structure which wraps an object and presents itself as a mapping from slot names to the object's slot values. Mirrors are used to build reflective developer tools." $nl diff --git a/core/optimizer/known-words/known-words.factor b/core/optimizer/known-words/known-words.factor index 93d19d0b20..52330ebdd6 100755 --- a/core/optimizer/known-words/known-words.factor +++ b/core/optimizer/known-words/known-words.factor @@ -12,7 +12,7 @@ optimizer.backend optimizer.pattern-match optimizer.inlining float-arrays sequences.private combinators byte-arrays byte-vectors ; -{ } [ +{ (tuple) } [ [ dup node-in-d peek node-literal dup tuple-layout? [ class>> ] [ drop tuple ] if @@ -25,6 +25,23 @@ byte-vectors ; 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 + ! the output of clone has the same type as the input { clone (clone) } [ [ @@ -128,19 +145,6 @@ byte-vectors ; ] if ] "constraints" 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? ; - -: expand-new ( #call -- node ) - dup dup in-d>> first node-literal - [ +inlined+ depends-on ] [ tuple-layout [ nip ] curry ] bi - f splice-quot ; - -\ new { - { [ dup literal-new? ] [ expand-new ] } -} define-optimizers - ! open-code instance? checks on predicate classes : literal-predicate-class? ( #call -- ? ) dup in-d>> second node-literal predicate-class? ;