From 63fd4d25cfd7abf3937124fcd3a4d7db86a9e6a6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Lindqvist?= Date: Sun, 22 Nov 2015 01:06:11 +0100 Subject: [PATCH] compiler.cfg.*: more fixes to pass basic-block on the stack than in a dynamic variable --- basis/compiler/cfg/builder/alien/alien.factor | 4 +-- .../cfg/builder/blocks/blocks-docs.factor | 2 +- .../cfg/builder/blocks/blocks-tests.factor | 13 +++++++-- .../compiler/cfg/builder/blocks/blocks.factor | 17 +++++------ .../compiler/cfg/builder/builder-docs.factor | 14 +++++---- basis/compiler/cfg/builder/builder.factor | 29 +++++++++---------- .../cfg/intrinsics/fixnum/fixnum.factor | 17 ++++++----- .../compiler/cfg/intrinsics/misc/misc.factor | 2 +- 8 files changed, 54 insertions(+), 44 deletions(-) diff --git a/basis/compiler/cfg/builder/alien/alien.factor b/basis/compiler/cfg/builder/alien/alien.factor index 3515f01f03..c8a9b749a0 100644 --- a/basis/compiler/cfg/builder/alien/alien.factor +++ b/basis/compiler/cfg/builder/alien/alien.factor @@ -169,7 +169,7 @@ M: #alien-assembly emit-node ( node -- ) M: #alien-callback emit-node dup params>> xt>> dup [ - needs-frame-pointer basic-block get begin-word + needs-frame-pointer begin-word { [ params>> callee-parameters ##callback-inputs, ] [ params>> box-parameters ] @@ -177,5 +177,5 @@ M: #alien-callback emit-node [ params>> emit-callback-return ] [ params>> callback-stack-cleanup ] } cleave - basic-block get [ end-word ] when + basic-block get [ end-word ] when* ] with-cfg-builder ; diff --git a/basis/compiler/cfg/builder/blocks/blocks-docs.factor b/basis/compiler/cfg/builder/blocks/blocks-docs.factor index 301d80113c..9432af5670 100644 --- a/basis/compiler/cfg/builder/blocks/blocks-docs.factor +++ b/basis/compiler/cfg/builder/blocks/blocks-docs.factor @@ -45,7 +45,7 @@ HELP: call-height HELP: emit-trivial-block { $values { "quot" quotation } } -{ $description "Combinator that emits a trivial block, constructed by calling the supplied quotation." } +{ $description "Combinator that emits a new trivial block, constructed by calling the supplied quotation. The quotation should not end the current block -- only add instructions to it." } { $examples { $unchecked-example $[ ex-emit-trivial-block ] } } ; HELP: end-branch diff --git a/basis/compiler/cfg/builder/blocks/blocks-tests.factor b/basis/compiler/cfg/builder/blocks/blocks-tests.factor index 1717064738..814dde12d8 100644 --- a/basis/compiler/cfg/builder/blocks/blocks-tests.factor +++ b/basis/compiler/cfg/builder/blocks/blocks-tests.factor @@ -1,6 +1,7 @@ USING: accessors compiler.cfg compiler.cfg.builder.blocks -compiler.cfg.stacks.local compiler.cfg.utilities compiler.test kernel -namespaces sequences tools.test ; +compiler.cfg.instructions compiler.cfg.stacks.local +compiler.cfg.utilities compiler.test kernel make namespaces sequences +tools.test ; IN: compiler.cfg.builder.blocks.tests ! (begin-basic-block) @@ -14,6 +15,14 @@ IN: compiler.cfg.builder.blocks.tests height-state get begin-branch height-state get eq? ] cfg-unit-test +! emit-trivial-block +{ + V{ T{ ##no-tco } T{ ##branch } } +} [ + [ [ drop ##no-tco, ] emit-trivial-block ] V{ } make drop + basic-block get successors>> first instructions>> +] cfg-unit-test + ! make-kill-block { t } [ [ make-kill-block ] keep kill-block?>> diff --git a/basis/compiler/cfg/builder/blocks/blocks.factor b/basis/compiler/cfg/builder/blocks/blocks.factor index 75a1e29a36..39682f80a1 100644 --- a/basis/compiler/cfg/builder/blocks/blocks.factor +++ b/basis/compiler/cfg/builder/blocks/blocks.factor @@ -23,8 +23,8 @@ IN: compiler.cfg.builder.blocks : emit-trivial-block ( quot -- ) ##branch, basic-block get begin-basic-block - call - ##branch, basic-block get begin-basic-block ; inline + basic-block get [ swap call ] keep + ##branch, begin-basic-block ; inline : make-kill-block ( block -- ) t swap kill-block?<< ; @@ -32,13 +32,12 @@ IN: compiler.cfg.builder.blocks : call-height ( #call -- n ) [ out-d>> length ] [ in-d>> length ] bi - ; -: emit-call-block ( word height -- ) - adjust-d ##call, basic-block get make-kill-block ; +: emit-call-block ( word height block -- ) + make-kill-block adjust-d ##call, ; : emit-primitive ( node -- ) - [ - [ word>> ] [ call-height ] bi emit-call-block - ] emit-trivial-block ; + [ word>> ] [ call-height ] bi + [ emit-call-block ] emit-trivial-block ; : begin-branch ( block -- ) height-state [ clone-height-state ] change (begin-basic-block) ; @@ -57,9 +56,9 @@ IN: compiler.cfg.builder.blocks basic-block get end-branch ] with-scope ; inline -: emit-conditional ( branches -- ) +: emit-conditional ( branches block -- ) ! branches is a sequence of pairs as above - basic-block get end-basic-block + end-basic-block sift [ dup first second height-state set basic-block get begin-basic-block diff --git a/basis/compiler/cfg/builder/builder-docs.factor b/basis/compiler/cfg/builder/builder-docs.factor index 3ebb301197..2f9b0a22b8 100644 --- a/basis/compiler/cfg/builder/builder-docs.factor +++ b/basis/compiler/cfg/builder/builder-docs.factor @@ -1,6 +1,6 @@ USING: assocs compiler.cfg compiler.cfg.builder.blocks -compiler.cfg.stacks.local compiler.tree help.markup help.syntax -kernel literals math multiline sequences vectors words ; +compiler.cfg.stacks.local compiler.tree help.markup help.syntax kernel +literals math multiline quotations sequences vectors words ; IN: compiler.cfg.builder << @@ -44,6 +44,10 @@ H{ ; >> +HELP: build-cfg +{ $values { "nodes" sequence } { "word" word } { "procedures" sequence } } +{ $description "Builds one or more cfgs from the given word." } ; + HELP: procedures { $var-description "A " { $link vector } " used as temporary storage during cfg construction for all procedures being built." } ; @@ -84,9 +88,9 @@ HELP: trivial-branch? } } ; -HELP: build-cfg -{ $values { "nodes" sequence } { "word" word } { "procedures" sequence } } -{ $description "Builds one or more cfgs from the given word." } ; +HELP: with-cfg-builder +{ $values { "nodes" sequence } { "word" word } { "label" word } { "quot" quotation } } +{ $description "Combinator used to begin and end stack analysis so that the given quotation can build the cfg. The quotation is passed the initial basic block on the stack." } ; ARTICLE: "compiler.cfg.builder" "Final stage of compilation generates machine code from dataflow IR" diff --git a/basis/compiler/cfg/builder/builder.factor b/basis/compiler/cfg/builder/builder.factor index 150b9baea5..ed6732064d 100644 --- a/basis/compiler/cfg/builder/builder.factor +++ b/basis/compiler/cfg/builder/builder.factor @@ -23,14 +23,14 @@ SYMBOL: loops '[ begin-stack-analysis begin-procedure - @ + basic-block get @ end-stack-analysis ] with-scope ; inline : with-dummy-cfg-builder ( node quot -- ) [ [ V{ } clone procedures ] 2dip - '[ _ t t [ _ call( node -- ) ] with-cfg-builder ] with-variable + '[ _ t t [ drop _ call( node -- ) ] with-cfg-builder ] with-variable ] { } make drop ; GENERIC: emit-node ( node -- ) @@ -44,11 +44,7 @@ GENERIC: emit-node ( node -- ) begin-basic-block ; : (build-cfg) ( nodes word label -- ) - [ - - basic-block get begin-word - emit-nodes - ] with-cfg-builder ; + [ begin-word emit-nodes ] with-cfg-builder ; : build-cfg ( nodes word -- procedures ) V{ } clone [ @@ -93,7 +89,7 @@ M: #recursive emit-node [ emit-nodes ] with-branch ; : emit-if ( node -- ) - children>> [ emit-branch ] map emit-conditional ; + children>> [ emit-branch ] map basic-block get emit-conditional ; : trivial-branch? ( nodes -- value ? ) dup length 1 = [ @@ -136,11 +132,12 @@ M: #dispatch emit-node ! though. ds-pop ^^offset>slot next-vreg ##dispatch, emit-if ; -M: #call emit-node +M: #call emit-node ( node -- ) dup word>> dup "intrinsic" word-prop [ emit-intrinsic ] [ swap call-height emit-call ] if ; -M: #call-recursive emit-node [ label>> id>> ] [ call-height ] bi emit-call ; +M: #call-recursive emit-node ( node -- ) + [ label>> id>> ] [ call-height ] bi emit-call ; M: #push emit-node literal>> ^^load-literal ds-push ; @@ -173,18 +170,18 @@ M: #shuffle emit-node ( node -- ) [ out-vregs/stack ] keep store-height-changes [ first2 store-vregs ] each ; ! #return -: end-word ( -- ) - ##branch, - basic-block get begin-basic-block +: end-word ( block -- ) + ##branch, begin-basic-block basic-block get make-kill-block ##safepoint, ##epilogue, ##return, ; -M: #return emit-node drop end-word ; +M: #return emit-node ( node -- ) + drop basic-block get end-word ; -M: #return-recursive emit-node - label>> id>> loops get key? [ end-word ] unless ; +M: #return-recursive emit-node ( node -- ) + label>> id>> loops get key? [ basic-block get end-word ] unless ; ! #terminate M: #terminate emit-node ( node -- ) diff --git a/basis/compiler/cfg/intrinsics/fixnum/fixnum.factor b/basis/compiler/cfg/intrinsics/fixnum/fixnum.factor index 0fcfc84471..eff5749b4f 100644 --- a/basis/compiler/cfg/intrinsics/fixnum/fixnum.factor +++ b/basis/compiler/cfg/intrinsics/fixnum/fixnum.factor @@ -1,10 +1,11 @@ ! Copyright (C) 2008, 2010 Slava Pestov, Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors arrays combinators compiler.cfg.builder.blocks -compiler.cfg.comparisons compiler.cfg.hats -compiler.cfg.instructions compiler.cfg.stacks.local compiler.cfg.registers -compiler.cfg.stacks compiler.tree.propagation.info cpu.architecture fry kernel -layouts math math.intervals namespaces sequences ; +USING: accessors arrays combinators compiler.cfg +compiler.cfg.builder.blocks compiler.cfg.comparisons compiler.cfg.hats +compiler.cfg.instructions compiler.cfg.registers compiler.cfg.stacks +compiler.cfg.stacks.local compiler.tree.propagation.info +cpu.architecture fry kernel layouts math math.intervals namespaces +sequences ; IN: compiler.cfg.intrinsics.fixnum : emit-both-fixnums? ( -- ) @@ -28,7 +29,7 @@ IN: compiler.cfg.intrinsics.fixnum ds-peek 0 cc> ##compare-integer-imm-branch, [ emit-fixnum-left-shift ] with-branch [ emit-fixnum-right-shift ] with-branch - 2array emit-conditional ; + 2array basic-block get emit-conditional ; : emit-fixnum-shift-fast ( node -- ) node-input-infos second interval>> { @@ -45,7 +46,7 @@ IN: compiler.cfg.intrinsics.fixnum : emit-overflow-case ( word -- final-bb ) [ - -1 emit-call-block + -1 basic-block get emit-call-block ] with-branch ; : emit-fixnum-overflow-op ( quot word -- ) @@ -53,7 +54,7 @@ IN: compiler.cfg.intrinsics.fixnum ! of loc>vreg sync [ [ (2inputs) [ any-rep ^^copy ] bi@ cc/o ] dip call ] dip [ emit-no-overflow-case ] [ emit-overflow-case ] bi* 2array - emit-conditional ; inline + basic-block get emit-conditional ; inline : fixnum+overflow ( x y -- z ) [ >bignum ] bi@ + ; diff --git a/basis/compiler/cfg/intrinsics/misc/misc.factor b/basis/compiler/cfg/intrinsics/misc/misc.factor index 293733e809..92319327ea 100644 --- a/basis/compiler/cfg/intrinsics/misc/misc.factor +++ b/basis/compiler/cfg/intrinsics/misc/misc.factor @@ -51,4 +51,4 @@ IN: compiler.cfg.intrinsics.misc if ; : emit-cleanup-allot ( -- ) - [ ##no-tco, ] emit-trivial-block ; + [ drop ##no-tco, ] emit-trivial-block ;