From 3595d3c75503158e4eedaedbac8e81cbbe5ae54b Mon Sep 17 00:00:00 2001
From: tomsmeding <tom.smeding@gmail.com>
Date: Fri, 13 Dec 2019 13:39:35 +0100
Subject: Follow caller-save convention using stack, not full state restore

---
 Main.hs | 77 ++++++++++++++++++++++++++---------------------------------------
 1 file changed, 31 insertions(+), 46 deletions(-)

(limited to 'Main.hs')

diff --git a/Main.hs b/Main.hs
index 2173653..e3ed454 100644
--- a/Main.hs
+++ b/Main.hs
@@ -1,17 +1,14 @@
 module Main where
 
 import Control.Monad
-import qualified Data.Map.Strict as Map
-import qualified Data.Set as Set
 import System.Environment
 import System.Exit
 
 import Compiler
 import CompilerMacros
-import Intermediate
-import Liveness
 import Optimiser
 import Parser
+import Stackify
 import VM
 
 
@@ -20,57 +17,26 @@ usage = do
     progname <- getProgName
     putStrLn $ "Usage: " ++ progname ++ " [-h] [-ast] [-ir] [filename.lisp]"
     putStrLn $ "When no filename is given, will read from stdin."
-    putStrLn $ "  -h     Show this help"
-    putStrLn $ "  -ast   Print AST after compiler macro's"
-    putStrLn $ "  -ir    Print IR after optimisation"
+    putStrLn $ "  -h      Show this help"
+    putStrLn $ "  -ast    Print AST after compiler macro's"
+    putStrLn $ "  -irpre  Print IR after optimisation, before stackification"
+    putStrLn $ "  -ir     Print IR after optimisation and stackification"
 
-data Options = Options { optAST :: Bool, optIR :: Bool }
+data Options = Options { optAST :: Bool, optIRPre :: Bool, optIR :: Bool }
 
+-- TODO: clean this function up
 parseOptions' :: (Options, Maybe FilePath) -> [String] -> IO (Options, Maybe FilePath)
 parseOptions' pair [] = return pair
 parseOptions' _ ("-h":_) = usage >> exitSuccess
 parseOptions' (opt, fp) ("-ast":as) = parseOptions' (opt { optAST = True }, fp) as
+parseOptions' (opt, fp) ("-irpre":as) = parseOptions' (opt { optIRPre = True }, fp) as
 parseOptions' (opt, fp) ("-ir":as) = parseOptions' (opt { optIR = True }, fp) as
 parseOptions' _ (('-':a):_) = putStrLn ("Unknown option '" ++ a ++ "'") >> usage >> exitFailure
 parseOptions' (opt, Nothing) (f:as) = parseOptions' (opt, Just f) as
 parseOptions' (_, Just _) (_:_) = putStrLn "At most one filename argument expected" >> usage >> exitFailure
 
 parseOptions :: [String] -> IO (Options, Maybe FilePath)
-parseOptions = parseOptions' (Options False False, Nothing)
-
--- TODO: Note about stackification. Temporaries need to be pushed before
--- a call if they're live after it and they could, conceivably, be wrongly
--- mutated by the called function otherwise. This has a couple of
--- interesting consequences:
--- 1. No temporaries ever need to be pushed from the global context, or
---    "main function", since they can never be wrongly mutated: that
---    requires re-entering the function in which they were defined, but one
---    can never re-enter the "main function".
--- 2. No temporaries ever need to be pushed before a tail call; since no
---    local variables are live after it (obviously). (Global variables are
---    covered by point (1.).)
-liveness :: IRProgram -> Map.Map Int [Set.Set Int]
-liveness (IRProgram bbs _ _) =
-    let sets = livenessAnalysis bbs bidOf itemsOf outEdges fread fwrite
-    in Map.fromList (zip (map bidOf bbs) sets)
-  where
-    itemsOf (BB _ inss term) = map Right inss ++ [Left term]
-    fread (Right (_, IAssign r)) = collect [r]
-    fread (Right (_, IParam _)) = []
-    fread (Right (_, IClosure _)) = []
-    fread (Right (_, IData _)) = []
-    fread (Right (_, ICallC r rs)) = collect (r : rs)
-    fread (Right (_, IAllocClo _ rs)) = collect rs
-    fread (Right (_, IDiscard r)) = collect [r]
-    fread (Left (IBr r _ _)) = collect [r]
-    fread (Left (IJmp _)) = []
-    fread (Left (IRet r)) = collect [r]
-    fread (Left (ITailC r rs)) = collect (r : rs)
-    fread (Left IExit) = []
-    fread (Left IUnknown) = []
-    fwrite (Right (r, _)) = collect [r]
-    fwrite (Left _) = []
-    collect rs = [i | RTemp i <- rs]
+parseOptions = parseOptions' (Options False False False, Nothing)
 
 main :: IO ()
 main = do
@@ -78,10 +44,29 @@ main = do
     source <- maybe getContents readFile mfname
 
     prog <- parseProgram mfname source >>= either (die . show) return
+
     let prog' = compilerMacros prog
     when (optAST opts) $ print prog'
+
     irprog <- either die return (compileProgram prog')
+
     let opt = optimise irprog
-    when (optIR opts) $ print opt
-    print (liveness opt)
-    vmRun opt
+    when (optIRPre opts) $ print opt
+
+    let optS = stackify opt
+    when (optIR opts) $ print optS
+
+    -- TODO: do we want to run the optimiser again now? In a situation as
+    -- follows, stuff might be inlined still:
+    --   t2 <- assign t1
+    --   push [t2]        ; could've been push [t1]
+    --   callc ...
+    --   pop [t2]
+    --   ... use t2 again ...
+
+    -- TODO: this raises the question of using liveness for optimisation.
+    -- In the example above, the pop instruction writes to t2, breaking up
+    -- its lifetime, so that the assignment becomes dead. The current
+    -- optimiser would not be able to catch this.
+
+    vmRun optS
-- 
cgit v1.2.3-70-g09d2