From 1f693b50b325822e49e0ebe1ec5390e42cf29b79 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Wed, 22 Oct 2008 18:39:41 -0500
Subject: [PATCH] Massive focused action
---
basis/compiler/cfg/debugger/debugger.factor | 4 ++-
.../cfg/linearization/linearization.factor | 5 +++-
basis/compiler/cfg/registers/registers.factor | 4 +--
basis/compiler/cfg/rpo/rpo.factor | 28 +++++++++++++------
basis/compiler/cfg/utilities/utilities.factor | 5 ++--
basis/compiler/compiler.factor | 6 ++--
6 files changed, 36 insertions(+), 16 deletions(-)
diff --git a/basis/compiler/cfg/debugger/debugger.factor b/basis/compiler/cfg/debugger/debugger.factor
index 294238fbbf..47935c193c 100644
--- a/basis/compiler/cfg/debugger/debugger.factor
+++ b/basis/compiler/cfg/debugger/debugger.factor
@@ -4,7 +4,8 @@ USING: kernel words sequences quotations namespaces io
classes.tuple accessors prettyprint prettyprint.config
compiler.tree.builder compiler.tree.optimizer
compiler.cfg.builder compiler.cfg.linearization
-compiler.cfg.stack-frame compiler.cfg.linear-scan ;
+compiler.cfg.stack-frame compiler.cfg.linear-scan
+compiler.cfg.optimizer ;
IN: compiler.cfg.debugger
GENERIC: test-cfg ( quot -- cfgs )
@@ -19,6 +20,7 @@ SYMBOL: allocate-registers?
: test-mr ( quot -- mrs )
test-cfg [
+ optimize-cfg
build-mr
allocate-registers? get
[ linear-scan build-stack-frame ] when
diff --git a/basis/compiler/cfg/linearization/linearization.factor b/basis/compiler/cfg/linearization/linearization.factor
index a906e77103..06c58ec938 100644
--- a/basis/compiler/cfg/linearization/linearization.factor
+++ b/basis/compiler/cfg/linearization/linearization.factor
@@ -53,7 +53,10 @@ M: ##compare-float-branch linearize-insn
binary-conditional _compare-float-branch emit-branch ;
: linearize-basic-block ( bb -- )
- [ number>> _label ] [ linearize-insns ] bi ;
+ [ number>> _label ]
+ [ gc>> [ _gc ] when ]
+ [ linearize-insns ]
+ tri ;
: linearize-basic-blocks ( rpo -- insns )
[ [ linearize-basic-block ] each ] { } make ;
diff --git a/basis/compiler/cfg/registers/registers.factor b/basis/compiler/cfg/registers/registers.factor
index 09d2feba6d..21572ec615 100644
--- a/basis/compiler/cfg/registers/registers.factor
+++ b/basis/compiler/cfg/registers/registers.factor
@@ -5,12 +5,12 @@ parser prettyprint.backend prettyprint.sections ;
IN: compiler.cfg.registers
! Virtual registers, used by CFG and machine IRs
-TUPLE: vreg reg-class n ;
+TUPLE: vreg { reg-class read-only } { n read-only } ;
SYMBOL: vreg-counter
: next-vreg ( reg-class -- vreg ) \ vreg-counter counter vreg boa ;
! Stack locations
-TUPLE: loc n ;
+TUPLE: loc { n read-only } ;
TUPLE: ds-loc < loc ;
C: <ds-loc> ds-loc
diff --git a/basis/compiler/cfg/rpo/rpo.factor b/basis/compiler/cfg/rpo/rpo.factor
index 9fe6d3c90a..7f4b09e68f 100644
--- a/basis/compiler/cfg/rpo/rpo.factor
+++ b/basis/compiler/cfg/rpo/rpo.factor
@@ -1,20 +1,32 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: kernel accessors namespaces make math sequences
-compiler.cfg.instructions ;
+USING: kernel accessors namespaces make math sequences sets
+assocs fry compiler.cfg.instructions ;
IN: compiler.cfg.rpo
-: post-order-traversal ( basic-block -- )
- dup visited>> [ drop ] [
- t >>visited
+SYMBOL: visited
+
+: post-order-traversal ( bb -- )
+ dup id>> visited get key? [ drop ] [
+ dup id>> visited get conjoin
[ successors>> [ post-order-traversal ] each ] [ , ] bi
] if ;
-: post-order ( procedure -- blocks )
+: post-order ( bb -- blocks )
[ post-order-traversal ] { } make ;
: number-blocks ( blocks -- )
[ >>number drop ] each-index ;
-: reverse-post-order ( procedure -- blocks )
- post-order <reversed> dup number-blocks ; inline
+: reverse-post-order ( bb -- blocks )
+ H{ } clone visited [
+ post-order <reversed> dup number-blocks
+ ] with-variable ; inline
+
+: each-basic-block ( cfg quot -- )
+ [ entry>> reverse-post-order ] dip each ; inline
+
+: change-basic-blocks ( cfg quot -- cfg' )
+ [ '[ _ change-instructions drop ] each-basic-block ]
+ [ drop ]
+ 2bi ; inline
diff --git a/basis/compiler/cfg/utilities/utilities.factor b/basis/compiler/cfg/utilities/utilities.factor
index 0c452f8f3c..4afe7a590a 100644
--- a/basis/compiler/cfg/utilities/utilities.factor
+++ b/basis/compiler/cfg/utilities/utilities.factor
@@ -1,7 +1,8 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors kernel math layouts namespaces cpu.architecture
-namespaces compiler.cfg compiler.cfg.instructions ;
+USING: accessors kernel math layouts make sequences
+cpu.architecture namespaces compiler.cfg
+compiler.cfg.instructions ;
IN: compiler.cfg.utilities
: value-info-small-tagged? ( value-info -- ? )
diff --git a/basis/compiler/compiler.factor b/basis/compiler/compiler.factor
index c02c1e8fda..f3767ec688 100644
--- a/basis/compiler/compiler.factor
+++ b/basis/compiler/compiler.factor
@@ -6,8 +6,9 @@ threads graphs generic combinators deques search-deques
stack-checker stack-checker.state stack-checker.inlining
compiler.errors compiler.units compiler.tree.builder
compiler.tree.optimizer compiler.cfg.builder
-compiler.cfg.linearization compiler.cfg.linear-scan
-compiler.cfg.stack-frame compiler.codegen ;
+compiler.cfg.optimizer compiler.cfg.linearization
+compiler.cfg.linear-scan compiler.cfg.stack-frame
+compiler.codegen ;
IN: compiler
SYMBOL: compile-queue
@@ -73,6 +74,7 @@ t compile-dependencies? set-global
: backend ( nodes word -- )
build-cfg [
+ optimize-cfg
build-mr
linear-scan
build-stack-frame