From f692200547594e3a9f36f7896419490b4ea1867d Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Bj=C3=B6rn=20Lindqvist?= <bjourne@gmail.com>
Date: Mon, 2 Nov 2015 18:40:13 +0100
Subject: [PATCH] compiler.cfg.*: refactoring which removes spill-area-size and
 spill-area-align from cfg

This makes the code for building the stack frame simpler.
---
 .../build-stack-frame.factor                  | 14 ++++-----
 basis/compiler/cfg/cfg-docs.factor            | 10 +++++--
 basis/compiler/cfg/cfg-tests.factor           |  7 +++--
 basis/compiler/cfg/cfg.factor                 | 14 +++++----
 .../allocation/state/state-docs.factor        |  3 +-
 .../allocation/state/state-tests.factor       | 30 +++++++++++++++----
 .../linear-scan/allocation/state/state.factor | 16 +++++-----
 .../cfg/linear-scan/linear-scan-tests.factor  | 20 +++++--------
 .../linear-scan/resolve/resolve-tests.factor  | 10 +++----
 .../cfg/linear-scan/resolve/resolve.factor    |  2 +-
 .../cfg/stack-frame/stack-frame-docs.factor   |  4 ---
 .../cfg/stack-frame/stack-frame.factor        |  9 +-----
 basis/cpu/ppc/ppc.factor                      |  2 +-
 basis/cpu/x86/x86.factor                      | 25 +++++++---------
 14 files changed, 85 insertions(+), 81 deletions(-)

diff --git a/basis/compiler/cfg/build-stack-frame/build-stack-frame.factor b/basis/compiler/cfg/build-stack-frame/build-stack-frame.factor
index bb60d9d3ea..5c4474ad7d 100644
--- a/basis/compiler/cfg/build-stack-frame/build-stack-frame.factor
+++ b/basis/compiler/cfg/build-stack-frame/build-stack-frame.factor
@@ -53,18 +53,14 @@ M: insn compute-stack-frame* drop f ;
     dup calculate-spill-area-base >>spill-area-base
     dup stack-frame-size >>total-size ;
 
-: <stack-frame> ( cfg -- stack-frame )
-    stack-frame new
-        over spill-area-size>> >>spill-area-size
-        swap spill-area-align>> >>spill-area-align
+: compute-stack-frame ( cfg -- stack-frame/f )
+    dup cfg>insns f [ compute-stack-frame* or ] reduce [
+        stack-frame>>
         allot-area-size get >>allot-area-size
         allot-area-align get >>allot-area-align
         param-area-size get >>params
-        finalize-stack-frame ;
-
-: compute-stack-frame ( cfg -- stack-frame/f )
-    dup cfg>insns f [ compute-stack-frame* or ] reduce
-    [ <stack-frame> ] [ drop f ] if ;
+        finalize-stack-frame
+    ] [ drop f ] if ;
 
 : build-stack-frame ( cfg -- )
     0 param-area-size set
diff --git a/basis/compiler/cfg/cfg-docs.factor b/basis/compiler/cfg/cfg-docs.factor
index 0f20e4e611..1ec7a366ef 100644
--- a/basis/compiler/cfg/cfg-docs.factor
+++ b/basis/compiler/cfg/cfg-docs.factor
@@ -1,6 +1,6 @@
-USING: compiler.cfg compiler.cfg.instructions compiler.cfg.rpo
-compiler.cfg.stack-frame compiler.tree help.markup help.syntax namespaces
-sequences vectors words ;
+USING: compiler.cfg.instructions compiler.cfg.rpo
+compiler.cfg.stack-frame compiler.tree help.markup help.syntax math
+namespaces sequences vectors words ;
 IN: compiler.cfg
 
 HELP: basic-block
@@ -41,3 +41,7 @@ HELP: cfg-changed
 { $values { "cfg" cfg } }
 { $description "Resets all \"calculated\" slots in the cfg which forces them to be recalculated." }
 { $see-also predecessors-changed } ;
+
+HELP: spill-offset
+{ $values { "n" integer } { "offset" integer } }
+{ $description "Offset in the current " { $link stack-frame } " to byte at index 'n' in the spill area." } ;
diff --git a/basis/compiler/cfg/cfg-tests.factor b/basis/compiler/cfg/cfg-tests.factor
index 7da21290bc..2b55a4408f 100644
--- a/basis/compiler/cfg/cfg-tests.factor
+++ b/basis/compiler/cfg/cfg-tests.factor
@@ -11,7 +11,10 @@ IN: compiler.cfg.tests
     {
         [ word>> ]
         [ label>> ]
-        [ spill-area-size>> ]
-        [ spill-area-align>> cell = ]
+        [
+            stack-frame>>
+            [ spill-area-size>> ]
+            [ spill-area-align>> cell = ] bi
+        ]
     } cleave
 ] unit-test
diff --git a/basis/compiler/cfg/cfg.factor b/basis/compiler/cfg/cfg.factor
index cdfb41a4ed..83f003173b 100644
--- a/basis/compiler/cfg/cfg.factor
+++ b/basis/compiler/cfg/cfg.factor
@@ -1,6 +1,7 @@
 ! Copyright (C) 2008, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors kernel layouts math namespaces vectors ;
+USING: accessors compiler.cfg.stack-frame kernel layouts math
+namespaces vectors ;
 IN: compiler.cfg
 
 TUPLE: basic-block < identity-tuple
@@ -20,8 +21,6 @@ TUPLE: cfg
     { entry basic-block }
     word
     label
-    { spill-area-size integer }
-    { spill-area-align integer }
     stack-frame
     frame-pointer?
     post-order linear-order
@@ -32,8 +31,7 @@ TUPLE: cfg
         swap >>entry
         swap >>label
         swap >>word
-        0 >>spill-area-size
-        cell >>spill-area-align ;
+        stack-frame new cell >>spill-area-align >>stack-frame ;
 
 : cfg-changed ( cfg -- )
     f >>post-order
@@ -46,3 +44,9 @@ TUPLE: cfg
 
 : with-cfg ( ..a cfg quot: ( ..a cfg -- ..b ) -- ..b )
     [ dup cfg ] dip with-variable ; inline
+
+: local-allot-offset ( n -- offset )
+    cfg get stack-frame>> allot-area-base>> + ;
+
+: spill-offset ( n -- offset )
+    cfg get stack-frame>> spill-area-base>> + ;
diff --git a/basis/compiler/cfg/linear-scan/allocation/state/state-docs.factor b/basis/compiler/cfg/linear-scan/allocation/state/state-docs.factor
index 516147be49..121e05f664 100644
--- a/basis/compiler/cfg/linear-scan/allocation/state/state-docs.factor
+++ b/basis/compiler/cfg/linear-scan/allocation/state/state-docs.factor
@@ -27,7 +27,8 @@ HELP: assign-spill-slot
   { "rep" representation }
   { "spill-slot" spill-slot }
 }
-{ $description "Assigns a spill slot for the vreg." } ;
+{ $description "Assigns a spill slot for the vreg. The stack frames spill area align is updated so that it is at least as large as the vregs size. Then a " { $link spill-slot } " is assigned for the vreg/rep-size combination if one hasn't already been assigned and is put on the stack." }
+{ $see-also next-spill-slot } ;
 
 HELP: deactivate-intervals
 { $values { "n" integer } }
diff --git a/basis/compiler/cfg/linear-scan/allocation/state/state-tests.factor b/basis/compiler/cfg/linear-scan/allocation/state/state-tests.factor
index 2197ed7231..fa3204235d 100644
--- a/basis/compiler/cfg/linear-scan/allocation/state/state-tests.factor
+++ b/basis/compiler/cfg/linear-scan/allocation/state/state-tests.factor
@@ -2,8 +2,9 @@ USING: accessors assocs combinators.extras compiler.cfg
 compiler.cfg.instructions compiler.cfg.linear-scan.allocation
 compiler.cfg.linear-scan.allocation.state
 compiler.cfg.linear-scan.live-intervals compiler.cfg.registers
-compiler.cfg.utilities cpu.architecture cpu.x86.assembler.operands fry
-heaps kernel layouts literals namespaces sequences system tools.test ;
+compiler.cfg.stack-frame compiler.cfg.utilities cpu.architecture
+cpu.x86.assembler.operands fry heaps kernel layouts literals
+namespaces sequences system tools.test ;
 IN: compiler.cfg.linear-scan.allocation.state.tests
 
 ! active-intervals-for
@@ -91,10 +92,24 @@ ${
 
 { t } [
     H{ } clone spill-slots set
-    f f <basic-block> <cfg> cfg set
+    { } insns>cfg cfg set
     55 int-rep assign-spill-slot spill-slots get values first eq?
 ] unit-test
 
+{
+    H{
+        { { 55 8 } T{ spill-slot } }
+        { { 44 8 } T{ spill-slot { n 8 } } }
+    }
+} [
+    H{ } clone spill-slots set
+    { } insns>cfg cfg set
+    { { 55 int-rep } { 44 int-rep } { 55 int-rep } } [
+        assign-spill-slot drop
+    ] assoc-each
+    spill-slots get
+] unit-test
+
 ! check-handled
 { } [
     40 progress set
@@ -107,7 +122,7 @@ ${
 
 ! align-spill-area
 ${ cell } [
-    3 { } insns>cfg [ align-spill-area ] keep
+    3 { } insns>cfg stack-frame>> [ align-spill-area ] keep
     spill-area-align>>
 ] unit-test
 
@@ -128,11 +143,14 @@ ${ cell } [
 
 ! next-spill-slot
 {
-    T{ cfg { spill-area-size 16 } }
     T{ spill-slot f 0 }
     T{ spill-slot f 8 }
+    T{ stack-frame
+       { spill-area-size 16 }
+       { spill-area-align 8 }
+    }
 } [
-    T{ cfg { spill-area-size 0 } } dup '[ 8 _ next-spill-slot ] twice
+    { } insns>cfg stack-frame>> [ '[ 8 _ next-spill-slot ] twice ] keep
 ] unit-test
 
 ! >unhandled-min-heap
diff --git a/basis/compiler/cfg/linear-scan/allocation/state/state.factor b/basis/compiler/cfg/linear-scan/allocation/state/state.factor
index 2147febd7e..4f5e9de819 100644
--- a/basis/compiler/cfg/linear-scan/allocation/state/state.factor
+++ b/basis/compiler/cfg/linear-scan/allocation/state/state.factor
@@ -113,19 +113,19 @@ ERROR: register-already-used live-interval ;
 : reg-class-assoc ( quot -- assoc )
     [ reg-classes ] dip { } map>assoc ; inline
 
-: next-spill-slot ( size cfg -- spill-slot )
-    [ swap [ align dup ] [ + ] bi ] change-spill-area-size drop <spill-slot> ;
-
-: align-spill-area ( align cfg -- )
+: align-spill-area ( align stack-frame -- )
     [ max ] change-spill-area-align drop ;
 
+: next-spill-slot ( size stack-frame -- spill-slot )
+    [ swap [ align dup ] [ + ] bi ] change-spill-area-size drop <spill-slot> ;
+
 SYMBOL: spill-slots
 
 : assign-spill-slot ( coalesced-vreg rep -- spill-slot )
-    rep-size
-    [ cfg get align-spill-area ]
-    [ spill-slots get [ nip cfg get next-spill-slot ] 2cache ]
-    bi ;
+    rep-size spill-slots get [
+        nip cfg get stack-frame>>
+        [ align-spill-area ] [ next-spill-slot ] 2bi
+    ] 2cache ;
 
 : lookup-spill-slot ( coalesced-vreg rep -- spill-slot )
     rep-size 2array spill-slots get ?at [ ] [ bad-vreg ] if ;
diff --git a/basis/compiler/cfg/linear-scan/linear-scan-tests.factor b/basis/compiler/cfg/linear-scan/linear-scan-tests.factor
index e0992c0b29..e087dbfb6e 100644
--- a/basis/compiler/cfg/linear-scan/linear-scan-tests.factor
+++ b/basis/compiler/cfg/linear-scan/linear-scan-tests.factor
@@ -28,17 +28,14 @@ check-allocation? on
 check-numbering? on
 
 ! Live interval calculation
-
-! A value is defined and never used; make sure it has the right
-! live range
-V{
-    T{ ##load-integer f 1 0 }
-    T{ ##replace-imm f D: 0 "hi" }
-    T{ ##branch }
-} 0 test-bb
-
 : test-live-intervals ( -- )
-    0 get block>cfg
+    ! A value is defined and never used; make sure it has the right
+    ! live range
+    {
+        T{ ##load-integer f 1 0 }
+        T{ ##replace-imm f D: 0 "hi" }
+        T{ ##branch }
+    } insns>cfg
     [ cfg set ] [ number-instructions ] [ compute-live-intervals ] tri
     drop ;
 
@@ -57,8 +54,7 @@ V{
 ] unit-test
 
 ! Live interval splitting
-
-cfg new 0 >>spill-area-size 4 >>spill-area-align cfg set
+{ } insns>cfg [ stack-frame>> 4 >>spill-area-align drop ] keep cfg set
 H{ } spill-slots set
 
 H{
diff --git a/basis/compiler/cfg/linear-scan/resolve/resolve-tests.factor b/basis/compiler/cfg/linear-scan/resolve/resolve-tests.factor
index c72e286f0d..c86dd4be2c 100644
--- a/basis/compiler/cfg/linear-scan/resolve/resolve-tests.factor
+++ b/basis/compiler/cfg/linear-scan/resolve/resolve-tests.factor
@@ -1,8 +1,6 @@
-USING: compiler.cfg.linear-scan.resolve tools.test kernel namespaces
-accessors
-compiler.cfg
-compiler.cfg.instructions cpu.architecture make sequences
-compiler.cfg.linear-scan.allocation.state ;
+USING: accessors compiler.cfg compiler.cfg.instructions
+compiler.cfg.linear-scan.resolve compiler.cfg.utilities
+cpu.architecture kernel make namespaces sequences tools.test ;
 IN: compiler.cfg.linear-scan.resolve.tests
 
 {
@@ -106,7 +104,7 @@ IN: compiler.cfg.linear-scan.resolve.tests
     mapping-instructions
 ] unit-test
 
-cfg new 8 >>spill-area-size cfg set
+{ } insns>cfg [ stack-frame>> 8 >>spill-area-size drop ] [ cfg set ] bi
 init-resolve
 
 { t } [
diff --git a/basis/compiler/cfg/linear-scan/resolve/resolve.factor b/basis/compiler/cfg/linear-scan/resolve/resolve.factor
index f59fc734e7..01ab16a6b1 100644
--- a/basis/compiler/cfg/linear-scan/resolve/resolve.factor
+++ b/basis/compiler/cfg/linear-scan/resolve/resolve.factor
@@ -29,7 +29,7 @@ SYMBOL: temp-spills
 
 : temp-spill ( rep -- spill-slot )
     rep-size temp-spills get
-    [ cfg get next-spill-slot ] cache ;
+    [ cfg get stack-frame>> next-spill-slot ] cache ;
 
 SYMBOL: temp-locations
 
diff --git a/basis/compiler/cfg/stack-frame/stack-frame-docs.factor b/basis/compiler/cfg/stack-frame/stack-frame-docs.factor
index 7038cfd585..008a73eb3b 100644
--- a/basis/compiler/cfg/stack-frame/stack-frame-docs.factor
+++ b/basis/compiler/cfg/stack-frame/stack-frame-docs.factor
@@ -27,10 +27,6 @@ HELP: (stack-frame-size)
 { $values { "stack-frame" stack-frame } { "n" integer } }
 { $description "Base stack frame size, without padding and alignment. If the size is zero, then no " { $link ##epilogue } " and " { $link ##prologue } " needs to be emitted for the word." } ;
 
-HELP: spill-offset
-{ $values { "n" integer } { "offset" integer } }
-{ $description "Offset in the current " { $link stack-frame } " to byte at index 'n' in the spill area." } ;
-
 ARTICLE: "compiler.cfg.stack-frame" "Stack frames"
 "This vocab contains definitions for constructing stack frames." ;
 
diff --git a/basis/compiler/cfg/stack-frame/stack-frame.factor b/basis/compiler/cfg/stack-frame/stack-frame.factor
index da407b153b..88b90caefb 100644
--- a/basis/compiler/cfg/stack-frame/stack-frame.factor
+++ b/basis/compiler/cfg/stack-frame/stack-frame.factor
@@ -1,6 +1,6 @@
 ! Copyright (C) 2009, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors compiler.cfg kernel math namespaces ;
+USING: accessors kernel math namespaces ;
 IN: compiler.cfg.stack-frame
 
 TUPLE: stack-frame
@@ -9,16 +9,9 @@ TUPLE: stack-frame
 { allot-area-align integer }
 { spill-area-size integer }
 { spill-area-align integer }
-
 { total-size integer }
 { allot-area-base integer }
 { spill-area-base integer } ;
 
-: local-allot-offset ( n -- offset )
-    cfg get stack-frame>> allot-area-base>> + ;
-
-: spill-offset ( n -- offset )
-    cfg get stack-frame>> spill-area-base>> + ;
-
 : (stack-frame-size) ( stack-frame -- n )
     [ spill-area-base>> ] [ spill-area-size>> ] bi + ;
diff --git a/basis/cpu/ppc/ppc.factor b/basis/cpu/ppc/ppc.factor
index 13fda70342..eafd780c7f 100644
--- a/basis/cpu/ppc/ppc.factor
+++ b/basis/cpu/ppc/ppc.factor
@@ -5,7 +5,7 @@ classes.algebra byte-arrays make math math.order math.ranges
 system namespaces locals layouts words alien alien.accessors
 alien.c-types alien.complex alien.data alien.libraries
 literals cpu.architecture cpu.ppc.assembler
-compiler.cfg.registers compiler.cfg.instructions
+compiler.cfg compiler.cfg.registers compiler.cfg.instructions
 compiler.cfg.comparisons compiler.codegen.fixup
 compiler.cfg.intrinsics compiler.cfg.stack-frame
 compiler.cfg.build-stack-frame compiler.units compiler.constants
diff --git a/basis/cpu/x86/x86.factor b/basis/cpu/x86/x86.factor
index 5303aa14bf..c1d3e32350 100644
--- a/basis/cpu/x86/x86.factor
+++ b/basis/cpu/x86/x86.factor
@@ -1,20 +1,15 @@
 ! Copyright (C) 2005, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors assocs alien alien.c-types arrays strings
-cpu.x86.assembler cpu.x86.assembler.private cpu.x86.assembler.operands
-cpu.x86.features cpu.x86.features.private cpu.architecture kernel
-kernel.private math memory namespaces make sequences words system
-layouts combinators math.order math.vectors fry locals compiler.constants
-byte-arrays io macros quotations classes.algebra compiler
-compiler.units init vm vocabs
-compiler.cfg.registers
-compiler.cfg.instructions
-compiler.cfg.intrinsics
-compiler.cfg.comparisons
-compiler.cfg.stack-frame
-compiler.codegen.gc-maps
-compiler.codegen.labels
-compiler.codegen.relocation ;
+USING: accessors alien arrays assocs byte-arrays classes.algebra
+combinators compiler compiler.cfg compiler.cfg.comparisons
+compiler.cfg.instructions compiler.cfg.intrinsics
+compiler.cfg.registers compiler.cfg.stack-frame
+compiler.codegen.gc-maps compiler.codegen.labels
+compiler.codegen.relocation compiler.constants compiler.units
+cpu.architecture cpu.x86.assembler cpu.x86.assembler.operands
+cpu.x86.assembler.private cpu.x86.features cpu.x86.features.private
+fry io kernel layouts locals make math math.order memory namespaces
+sequences system vm vocabs ;
 QUALIFIED-WITH: alien.c-types c
 FROM: math => float ;
 IN: cpu.x86