From 627dfd1ff5e5b66d6231115f4e222a7022ab4262 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 17 Oct 2008 20:03:59 -0500
Subject: [PATCH] Finish vreg simplification
---
basis/compiler/cfg/instructions/instructions.factor | 2 +-
basis/compiler/cfg/registers/registers.factor | 4 +++-
basis/compiler/cfg/templates/templates.factor | 7 ++++---
3 files changed, 8 insertions(+), 5 deletions(-)
diff --git a/basis/compiler/cfg/instructions/instructions.factor b/basis/compiler/cfg/instructions/instructions.factor
index fd7d071518..1335a082bf 100644
--- a/basis/compiler/cfg/instructions/instructions.factor
+++ b/basis/compiler/cfg/instructions/instructions.factor
@@ -82,7 +82,7 @@ M: ##dispatch uses-vregs src>> 1array ;
M: insn uses-vregs drop f ;
: intrinsic-vregs ( assoc -- seq' )
- values sift ;
+ [ nip dup vreg? swap and ] { } assoc>map sift ;
: intrinsic-defs-vregs ( insn -- seq )
defs-vregs>> intrinsic-vregs ;
diff --git a/basis/compiler/cfg/registers/registers.factor b/basis/compiler/cfg/registers/registers.factor
index dc109cf62e..64712297e2 100644
--- a/basis/compiler/cfg/registers/registers.factor
+++ b/basis/compiler/cfg/registers/registers.factor
@@ -13,7 +13,6 @@ GENERIC: value-class* ( operand -- class )
: value-class ( operand -- class ) value-class* object or ;
-M: value >vreg drop f ;
M: value set-value-class 2drop ;
M: value value-class* drop f ;
@@ -29,6 +28,8 @@ INSTANCE: vreg value
! Stack locations
TUPLE: loc n class ;
+M: loc >vreg drop f ;
+
! A data stack location.
TUPLE: ds-loc < loc ;
: <ds-loc> ( n -- loc ) f ds-loc boa ;
@@ -85,5 +86,6 @@ TUPLE: constant value ;
C: <constant> constant
M: constant value-class* value>> class ;
+M: constant >vreg ;
INSTANCE: constant value
diff --git a/basis/compiler/cfg/templates/templates.factor b/basis/compiler/cfg/templates/templates.factor
index 9446d66683..289c420f8f 100644
--- a/basis/compiler/cfg/templates/templates.factor
+++ b/basis/compiler/cfg/templates/templates.factor
@@ -33,7 +33,7 @@ TUPLE: template input output scratch clobber gc ;
] with-scope ;
: alloc-scratch ( template -- assoc )
- scratch>> [ swap alloc-vreg >vreg ] assoc-map ;
+ scratch>> [ swap alloc-vreg ] assoc-map ;
: do-template-inputs ( template -- defs uses )
#! Load input values into registers and allocates scratch
@@ -44,12 +44,13 @@ TUPLE: template input output scratch clobber gc ;
[ output>> ] 2dip assoc-union '[ _ at ] map
phantom-datastack get phantom-append ;
-: apply-template ( pair quot -- vregs )
+: apply-template ( pair quot -- )
[
first2
dup gc>> [ t fresh-object ] when
dup do-template-inputs
- [ do-template-outputs ] 2keep
+ [ do-template-outputs ]
+ [ [ [ >vreg ] assoc-map ] dip ] 2bi
] dip call ; inline
: phantom&spec ( phantom specs -- phantom' specs' )