Analyze bfore mitting

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

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)

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: