From b455709ef1bd8a21400a71708a693814b9b740b3 Mon Sep 17 00:00:00 2001
From: Cat's Eye Technologies <cpressey@catseye.tc>
Date: Fri, 4 Apr 2014 15:45:49 +0100
Subject: [PATCH] Analyze bfore mitting

---
 eg/demo.60p                |  4 ++--
 src/Main.hs                |  4 ++--
 src/SixtyPical/Analyzer.hs | 49 +++++++++++++++++++++++++++++++++++++-
 3 files changed, 52 insertions(+), 5 deletions(-)

diff --git a/eg/demo.60p b/eg/demo.60p
index dda336c..7b55f3f 100644
--- a/eg/demo.60p
+++ b/eg/demo.60p
@@ -1,4 +1,4 @@
-assign byte table screen $0400
+ assign byte table screen $0400
 assign byte table screen2 1274
 assign byte table screen3 1524
 assign byte table screen4 1774
@@ -29,7 +29,7 @@ routine main {
     jsr reset_position
     jsr clear_screen
     sei {
-        copy vector cinv to save_cinv
+        copy cinv save_cinv
         copy routine our_cinv to cinv
     }
     clc
diff --git a/src/Main.hs b/src/Main.hs
index 2c4466d..4459c67 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -38,8 +38,8 @@ main = do
                 ("emit", Right program) ->
                     case checkAndTransformProgram program of
                         Just newprog ->
-                            case analyzeProgram newprog of
-                                _ ->
+                            case (length (show (analyzeProgram newprog)) < 9999999) of
+                                True ->
                                     putStr $ emitProgram newprog
                 (_, Left problem) -> do
                     hPutStrLn stderr (show problem)
diff --git a/src/SixtyPical/Analyzer.hs b/src/SixtyPical/Analyzer.hs
index 58ecc71..4e6cc64 100644
--- a/src/SixtyPical/Analyzer.hs
+++ b/src/SixtyPical/Analyzer.hs
@@ -31,6 +31,8 @@ analyzeProgram program@(Program decls routines) =
           in
               checkBlock instrs progCtx routCtx'
       
+      -- -- -- -- -- -- -- -- -- -- -- --
+      
       checkInstr (COPY src dst) progCtx routCtx =
           case Map.lookup src routCtx of
               Just (PoisonedWith _) ->
@@ -40,6 +42,24 @@ analyzeProgram program@(Program decls routines) =
       checkInstr (DELTA dst val) progCtx routCtx =
           -- TODO check that dst is not poisoned
           Map.insert dst (UpdatedWith (Immediate val)) routCtx
+
+      checkInstr (ADD dst src) progCtx routCtx =
+          -- TODO check that dst is not poisoned
+          Map.insert dst (UpdatedWith src) routCtx
+      checkInstr (SUB dst src) progCtx routCtx =
+          -- TODO check that dst is not poisoned
+          Map.insert dst (UpdatedWith src) routCtx
+
+      checkInstr (AND dst src) progCtx routCtx =
+          -- TODO check that dst is not poisoned
+          Map.insert dst (UpdatedWith src) routCtx
+      checkInstr (OR dst src) progCtx routCtx =
+          -- TODO check that dst is not poisoned
+          Map.insert dst (UpdatedWith src) routCtx
+      checkInstr (XOR dst src) progCtx routCtx =
+          -- TODO check that dst is not poisoned
+          Map.insert dst (UpdatedWith src) routCtx
+
       checkInstr (JSR name) progCtx routCtx =
           let
               Just calledRout = lookupRoutine program name
@@ -61,12 +81,39 @@ analyzeProgram program@(Program decls routines) =
           -- TODO: oooh, this one's gonna be fun too
           --checkBlock blk progCtx routCtx
           routCtx
+
+      -- TODO -- THESE ARE WEAK --
+      checkInstr (SEI blk) progCtx routCtx =
+          checkBlock blk progCtx routCtx
+      checkInstr (PUSH _ blk) progCtx routCtx =
+          checkBlock blk progCtx routCtx
+
+      checkInstr (BIT dst) progCtx routCtx =
+          -- TODO check that dst is not poisoned
+          Map.insert dst (UpdatedWith (Immediate 0)) routCtx
+
+      checkInstr (SHR dst flg) progCtx routCtx =
+          -- TODO check that dst is not poisoned
+          Map.insert dst (UpdatedWith flg) routCtx
+      checkInstr (SHL dst flg) progCtx routCtx =
+          -- TODO check that dst is not poisoned
+          Map.insert dst (UpdatedWith flg) routCtx
+
+      checkInstr (COPYROUTINE name dst) progCtx routCtx =
+          -- TODO check that dst is not poisoned
+          Map.insert dst (UpdatedWith (Immediate 7)) routCtx
+
+      checkInstr (JMPVECTOR dst) progCtx routCtx =
+          routCtx
+
       checkInstr NOP progCtx routCtx =
           routCtx
-      
+
+      {-      
       checkInstr instr _ _ = error (
           "Internal error: sixtypical doesn't know how to " ++
           "analyze '" ++ (show instr) ++ "'")
+      -}
 
 --
 -- Utility function: