From 3ff96a03531336b54c91234850da546e57c2815f Mon Sep 17 00:00:00 2001
From: Cat's Eye Technologies <cpressey@catseye.tc>
Date: Fri, 4 Apr 2014 19:50:34 +0100
Subject: [PATCH] Fix (bodge?) and document my worries.

---
 doc/Analyzing.markdown     | 77 ++++++++++++++++++++++++++++++++++++++
 eg/demo.60p                |  1 -
 src/SixtyPical/Analyzer.hs | 12 +++++-
 src/SixtyPical/Context.hs  | 10 +++--
 4 files changed, 94 insertions(+), 6 deletions(-)

diff --git a/doc/Analyzing.markdown b/doc/Analyzing.markdown
index a847e97..a64f87a 100644
--- a/doc/Analyzing.markdown
+++ b/doc/Analyzing.markdown
@@ -196,6 +196,30 @@ after the `if`.
     | }
     ? routine 'main' does not preserve 'A'
 
+    | reserve byte score
+    | routine update_score
+    | {
+    |   ldx #4
+    |   stx score
+    | }
+    | routine main {
+    |   lda #4
+    |   if beq {
+    |      jsr update_score
+    |   } else {
+    |      ldx #4
+    |   }
+    |   sta score
+    | }
+    = main ([])
+    =   A: UpdatedWith (Immediate 4)
+    =   X: PoisonedWith (Immediate 4)
+    =   NamedLocation Nothing "score": UpdatedWith A
+    = 
+    = update_score ([])
+    =   X: UpdatedWith (Immediate 4)
+    =   NamedLocation Nothing "score": UpdatedWith X
+
 Poisoning a high byte or low byte of a word poisons the whole word.
 
     | reserve word score
@@ -211,3 +235,56 @@ Poisoning a high byte or low byte of a word poisons the whole word.
     |   sta temp
     | }
     ? routine 'main' does not preserve 'NamedLocation Nothing "score"'
+
+    | assign vector cinv 788
+    | reserve vector save_cinv
+    | 
+    | assign word position $fb
+    | 
+    | reserve byte value
+    | 
+    | routine reset_position {
+    |     lda #$00
+    |     sta <position
+    |     lda #$04
+    |     sta >position
+    | }
+    | 
+    | routine our_cinv {
+    |     inc value
+    |     lda value
+    |     ldy #0
+    |     sta (position), y
+    |     if beq {
+    |         jsr reset_position
+    |     } else {
+    |     }
+    |     jmp (save_cinv)
+    | }
+    | 
+    | routine main {
+    |     jsr reset_position
+    |     sei {
+    |         copy cinv save_cinv
+    |         copy routine our_cinv to cinv
+    |     }
+    |     clc
+    |     repeat bcc { }
+    | }
+    = main ([])
+    =   A: PoisonedWith (Immediate 4)
+    =   FlagC: UpdatedWith (Immediate 0)
+    =   NamedLocation Nothing "cinv": UpdatedWith (Immediate 7)
+    =   NamedLocation Nothing "position": PoisonedWith A
+    =   NamedLocation Nothing "save_cinv": UpdatedWith (NamedLocation Nothing "cinv")
+    = 
+    = our_cinv ([])
+    =   A: PoisonedWith (Immediate 4)
+    =   Y: UpdatedWith (Immediate 0)
+    =   IndirectIndexed (NamedLocation (Just Word) "position") Y: UpdatedWith A
+    =   NamedLocation Nothing "position": PoisonedWith A
+    =   NamedLocation Nothing "value": UpdatedWith (Immediate 1)
+    = 
+    = reset_position ([])
+    =   A: UpdatedWith (Immediate 4)
+    =   NamedLocation Nothing "position": UpdatedWith A
diff --git a/eg/demo.60p b/eg/demo.60p
index 1ae39a3..612bd04 100644
--- a/eg/demo.60p
+++ b/eg/demo.60p
@@ -87,7 +87,6 @@ routine our_cinv {
     sta (position), y
     jsr increment_pos
     jsr compare_pos
-    lda vic_border     ; WHY DOES THE FOLLOWING NOT ANALUZE
     if beq {
         jsr reset_position
     } else {
diff --git a/src/SixtyPical/Analyzer.hs b/src/SixtyPical/Analyzer.hs
index 32be289..184480d 100644
--- a/src/SixtyPical/Analyzer.hs
+++ b/src/SixtyPical/Analyzer.hs
@@ -63,8 +63,18 @@ analyzeProgram program@(Program decls routines) =
           routCtx
       checkInstr nm (IF _ branch b1 b2) progCtx routCtx =
           let
+              -- This works, but I worry about it.
+              -- It doesn't work if we pass routCtx to both blocks,
+              -- because when we go to merge them, there is apparently
+              -- too much information, and we end up checking things
+              -- we don't need to check.
+              -- Leaving the second one empty results in the right amount
+              -- of information.
+              -- But what are we depriving the else block context of?
+              -- More tests are needed.
+              -- Possibly the merge needs to be redone.
               routCtx1 = checkBlock nm b1 progCtx routCtx
-              routCtx2 = checkBlock nm b2 progCtx routCtx
+              routCtx2 = checkBlock nm b2 progCtx Map.empty
           in
               mergeAlternateRoutCtxs nm routCtx1 routCtx2
       checkInstr nm (REPEAT _ branch blk) progCtx routCtx =
diff --git a/src/SixtyPical/Context.hs b/src/SixtyPical/Context.hs
index 0ba5cc2..ffa5cc9 100644
--- a/src/SixtyPical/Context.hs
+++ b/src/SixtyPical/Context.hs
@@ -26,10 +26,12 @@ type RoutineContext = Map.Map StorageLocation Usage
 
 type ProgramContext = Map.Map RoutineName RoutineContext
 
-untypedLocation (HighByteOf (NamedLocation _ name)) =
-    NamedLocation Nothing name
-untypedLocation (LowByteOf (NamedLocation _ name)) =
-    NamedLocation Nothing name
+untypedLocation (HighByteOf x) =
+    untypedLocation x
+untypedLocation (LowByteOf x) =
+    untypedLocation x
+untypedLocation (Indexed table index) =
+    untypedLocation table
 untypedLocation (NamedLocation _ name) =
     NamedLocation Nothing name
 untypedLocation x = x