From 8a7699e42cdbb68947d495ee9590164eff65d32c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Lindqvist?= Date: Tue, 24 Mar 2015 16:38:42 +0000 Subject: [PATCH] compiler.cfg.*: refactoring to remove the initial-basic-block word --- .../compiler/cfg/builder/blocks/blocks-docs.factor | 14 +++++++------- .../cfg/builder/blocks/blocks-tests.factor | 10 ++++++++-- basis/compiler/cfg/builder/blocks/blocks.factor | 11 +++-------- basis/compiler/cfg/builder/builder-docs.factor | 3 ++- basis/compiler/cfg/builder/builder-tests.factor | 7 +++++++ basis/compiler/cfg/builder/builder.factor | 3 +-- basis/compiler/cfg/cfg-docs.factor | 4 ++++ basis/compiler/cfg/cfg-tests.factor | 10 ++++++++++ basis/compiler/cfg/cfg.factor | 6 +++--- 9 files changed, 45 insertions(+), 23 deletions(-) create mode 100644 basis/compiler/cfg/cfg-tests.factor diff --git a/basis/compiler/cfg/builder/blocks/blocks-docs.factor b/basis/compiler/cfg/builder/blocks/blocks-docs.factor index 69186836a6..b96f7969af 100644 --- a/basis/compiler/cfg/builder/blocks/blocks-docs.factor +++ b/basis/compiler/cfg/builder/blocks/blocks-docs.factor @@ -1,12 +1,11 @@ USING: compiler.cfg compiler.cfg.stacks.local compiler.tree help.markup -help.syntax literals math multiline quotations sequences ; +help.syntax literals make math multiline quotations sequences ; IN: compiler.cfg.builder.blocks << STRING: ex-emit-trivial-block -USING: compiler.cfg.builder.blocks prettyprint ; -initial-basic-block [ [ gensym ##call, ] emit-trivial-block ] { } make drop -basic-block get . +USING: compiler.cfg.builder.blocks make prettyprint ; + set-basic-block [ [ gensym ##call, ] emit-trivial-block ] { } make drop basic-block get . T{ basic-block { id 2040412 } { successors @@ -52,12 +51,13 @@ HELP: end-branch { $values { "pair/f" "two-tuple" } } { $description "pair is { final-bb final-height }" } ; -HELP: initial-basic-block -{ $description "Creates an initial empty " { $link basic-block } " and stores it in the basic-block dynamic variable." } ; - HELP: make-kill-block { $description "Marks the current " { $link basic-block } " being processed as a kill block." } ; +HELP: set-basic-block +{ $values { "basic-block" basic-block } } +{ $description "Sets the given blocks as the current one by storing it in the basic-block dynamic variable. If it has any " { $slot "instructions" } " the current " { $link building } " is set to those." } ; + HELP: set-successors { $values { "successor" basic-block } { "blocks" sequence } } { $description "Set the successor of each block to " { $slot "successor" } "." } ; diff --git a/basis/compiler/cfg/builder/blocks/blocks-tests.factor b/basis/compiler/cfg/builder/blocks/blocks-tests.factor index 6784796d81..032802f488 100644 --- a/basis/compiler/cfg/builder/blocks/blocks-tests.factor +++ b/basis/compiler/cfg/builder/blocks/blocks-tests.factor @@ -1,5 +1,5 @@ -USING: accessors compiler.cfg compiler.cfg.builder.blocks kernel sequences -tools.test ; +USING: accessors compiler.cfg compiler.cfg.builder.blocks compiler.cfg.stacks +kernel namespaces sequences tools.test ; IN: compiler.cfg.builder.blocks.tests { @@ -9,3 +9,9 @@ IN: compiler.cfg.builder.blocks.tests [ set-successors ] keep [ successors>> first number>> ] map ] unit-test + +{ 33 } [ + begin-stack-analysis 33 >>number basic-block set + (begin-basic-block) + basic-block get predecessors>> first number>> +] unit-test diff --git a/basis/compiler/cfg/builder/blocks/blocks.factor b/basis/compiler/cfg/builder/blocks/blocks.factor index f59a92cf27..972695ae74 100644 --- a/basis/compiler/cfg/builder/blocks/blocks.factor +++ b/basis/compiler/cfg/builder/blocks/blocks.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2009, 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays compiler.cfg compiler.cfg.instructions -compiler.cfg.stacks compiler.cfg.stacks.local kernel make math -namespaces sequences ; +compiler.cfg.stacks compiler.cfg.stacks.local compiler.cfg.utilities kernel +make math namespaces sequences ; SLOT: in-d SLOT: out-d IN: compiler.cfg.builder.blocks @@ -11,18 +11,13 @@ IN: compiler.cfg.builder.blocks [ basic-block set ] [ instructions>> building set ] bi begin-local-analysis ; -: initial-basic-block ( -- ) - set-basic-block ; - : end-basic-block ( -- ) basic-block get [ end-local-analysis ] when building off basic-block off ; : (begin-basic-block) ( -- ) - - basic-block get [ dupd successors>> push ] when* - set-basic-block ; + basic-block get [ over connect-bbs ] when* set-basic-block ; : begin-basic-block ( -- ) basic-block get [ end-local-analysis ] when diff --git a/basis/compiler/cfg/builder/builder-docs.factor b/basis/compiler/cfg/builder/builder-docs.factor index 596600743a..fde3973bbe 100644 --- a/basis/compiler/cfg/builder/builder-docs.factor +++ b/basis/compiler/cfg/builder/builder-docs.factor @@ -7,7 +7,8 @@ IN: compiler.cfg.builder STRING: ex-emit-call USING: compiler.cfg.builder compiler.cfg.builder.blocks compiler.cfg.stacks kernel make prettyprint ; -begin-stack-analysis initial-basic-block \ dummy 3 [ emit-call ] { } make drop +begin-stack-analysis set-basic-block +\ dummy 3 [ emit-call ] { } make drop height-state basic-block [ get . ] bi@ { { 3 0 } { 0 0 } } T{ basic-block diff --git a/basis/compiler/cfg/builder/builder-tests.factor b/basis/compiler/cfg/builder/builder-tests.factor index 4dfbadee41..8d3e5b6490 100644 --- a/basis/compiler/cfg/builder/builder-tests.factor +++ b/basis/compiler/cfg/builder/builder-tests.factor @@ -280,6 +280,13 @@ IN: compiler.cfg.builder.tests basic-block get successors>> length ] unit-test +! begin-cfg +SYMBOL: foo + +{ foo } [ + begin-stack-analysis \ foo f begin-cfg word>> +] unit-test + ! store-shuffle { H{ { D 2 1 } } diff --git a/basis/compiler/cfg/builder/builder.factor b/basis/compiler/cfg/builder/builder.factor index b656ddb0b3..8f4752bc16 100644 --- a/basis/compiler/cfg/builder/builder.factor +++ b/basis/compiler/cfg/builder/builder.factor @@ -12,9 +12,8 @@ SYMBOL: procedures SYMBOL: loops : begin-cfg ( word label -- cfg ) - initial-basic-block H{ } clone loops set - [ basic-block get ] 2dip dup cfg set ; + dup set-basic-block dup cfg set ; : begin-procedure ( word label -- ) begin-cfg procedures get push ; diff --git a/basis/compiler/cfg/cfg-docs.factor b/basis/compiler/cfg/cfg-docs.factor index 8fd27be9df..0dd93f3775 100644 --- a/basis/compiler/cfg/cfg-docs.factor +++ b/basis/compiler/cfg/cfg-docs.factor @@ -17,6 +17,10 @@ HELP: { $values { "bb" basic-block } } { $description "Creates a new empty basic block. The " { $slot "id" } " slot is initialized with the value of the basic-block " { $link counter } "." } ; +HELP: +{ $values { "entry" basic-block } { "word" word } { "label" "label" } { "cfg" cfg } } +{ $description "Constructor for " { $link cfg } "." } ; + HELP: cfg { $class-description "Call flow graph. It has the following slots:" diff --git a/basis/compiler/cfg/cfg-tests.factor b/basis/compiler/cfg/cfg-tests.factor new file mode 100644 index 0000000000..c99f1a7274 --- /dev/null +++ b/basis/compiler/cfg/cfg-tests.factor @@ -0,0 +1,10 @@ +USING: accessors compiler.cfg kernel tools.test ; +IN: compiler.cfg.tests + +{ + "word" + "label" +} [ + "word" "label" + [ word>> ] [ label>> ] bi +] unit-test diff --git a/basis/compiler/cfg/cfg.factor b/basis/compiler/cfg/cfg.factor index 6628ce0aae..a5e056d455 100644 --- a/basis/compiler/cfg/cfg.factor +++ b/basis/compiler/cfg/cfg.factor @@ -27,11 +27,11 @@ frame-pointer? post-order linear-order predecessors-valid? dominance-valid? loops-valid? ; -: ( entry word label -- cfg ) +: ( word label entry -- cfg ) cfg new + swap >>entry swap >>label - swap >>word - swap >>entry ; + swap >>word ; : cfg-changed ( cfg -- ) f >>post-order