Poisoning high/low byte of word poisons the word.

README.markdown

@@ -122,4 +122,4 @@ TODO
 *   `outputs` on externals
 *   Routine is a kind of StorageLocation?  (Location)?
 *   remove DELTA -> ADD/SUB (requires carry be notated on ADD and SUB though)
-*   Poisoning the highbyte or lowbyte of a word should poison the word
+*   explicit `with` syntax

doc/Analyzing.markdown

@@ -16,7 +16,7 @@ routine.
     | }
     = main ([])
     =   A: UpdatedWith (Immediate 4)
-    =   NamedLocation (Just Byte) "score": UpdatedWith A
+    =   NamedLocation Nothing "score": UpdatedWith A
 
 A routine cannot expect registers which a called routine does not
 preserve, to be preserved.
@@ -53,16 +53,15 @@ But if it does it can.
     = main ([])
     =   A: UpdatedWith (Immediate 4)
     =   X: PoisonedWith (Immediate 1)
-    =   NamedLocation (Just Byte) "border_colour": UpdatedWith A
-    =   NamedLocation (Just Byte) "score": PoisonedWith X
+    =   NamedLocation Nothing "border_colour": UpdatedWith A
+    =   NamedLocation Nothing "score": PoisonedWith X
     = 
     = update_score ([])
     =   X: UpdatedWith (Immediate 1)
-    =   NamedLocation (Just Byte) "score": UpdatedWith X
+    =   NamedLocation Nothing "score": UpdatedWith X
 
 We can't expect to stay named variables to stay unmodified either.
 
-    | assign byte border_colour 4000
     | reserve byte score
     | routine update_score
     | {
@@ -71,9 +70,9 @@ We can't expect to stay named variables to stay unmodified either.
     | }
     | routine main {
     |   jsr update_score
-    |   ldx score
+    |   lda score
     | }
-    ? routine does not preserve 'NamedLocation (Just Byte) "score"'
+    ? routine does not preserve 'NamedLocation Nothing "score"'
 
 What the solution to the above is to notate `update_score` as intentionally
 modifying score, as an "output" of the routine.
@@ -92,12 +91,12 @@ modifying score, as an "output" of the routine.
     | }
     = main ([])
     =   A: PoisonedWith (Immediate 8)
-    =   X: UpdatedWith (NamedLocation (Just Byte) "score")
-    =   NamedLocation (Just Byte) "score": UpdatedWith A
+    =   X: UpdatedWith (NamedLocation Nothing "score")
+    =   NamedLocation Nothing "score": UpdatedWith A
     = 
     = update_score ([NamedLocation Nothing "score"])
     =   A: UpdatedWith (Immediate 8)
-    =   NamedLocation (Just Byte) "score": UpdatedWith A
+    =   NamedLocation Nothing "score": UpdatedWith A
 
 Routines can name registers as outputs.
 
@@ -123,7 +122,7 @@ Routines can name registers as outputs.
     | }
     = main ([])
     =   A: UpdatedWith (Immediate 8)
-    =   NamedLocation (Just Byte) "score": UpdatedWith A
+    =   NamedLocation Nothing "score": UpdatedWith A
     = 
     = update_score ([A])
     =   A: UpdatedWith (Immediate 8)
@@ -196,3 +195,19 @@ after the `if`.
     |   sta score
     | }
     ? routine does not preserve 'A'
+
+Poisoning a high byte or low byte of a word poisons the whole word.
+
+    | reserve word score
+    | reserve byte temp
+    | routine update_score
+    | {
+    |   ldx #4
+    |   stx <score
+    | }
+    | routine main {
+    |   jsr update_score
+    |   lda >score
+    |   sta temp
+    | }
+    ? routine does not preserve 'NamedLocation Nothing "score"'

src/SixtyPical/Analyzer.hs

@@ -34,31 +34,27 @@ analyzeProgram program@(Program decls routines) =
       -- -- -- -- -- -- -- -- -- -- -- --
       
       checkInstr (COPY src dst) progCtx routCtx =
-          case Map.lookup src routCtx of
-              Just (PoisonedWith _) ->
-                  error ("routine does not preserve '" ++ (show src) ++ "'")
-              _ ->
-                  Map.insert dst (UpdatedWith src) routCtx
+          updateRoutCtx dst (UpdatedWith src) routCtx
       checkInstr (DELTA dst val) progCtx routCtx =
           -- TODO check that dst is not poisoned
-          Map.insert dst (UpdatedWith (Immediate val)) routCtx
+          updateRoutCtx dst (UpdatedWith (Immediate val)) routCtx
 
       checkInstr (ADD dst src) progCtx routCtx =
           -- TODO check that dst is not poisoned
-          Map.insert dst (UpdatedWith src) routCtx
+          updateRoutCtx dst (UpdatedWith src) routCtx
       checkInstr (SUB dst src) progCtx routCtx =
           -- TODO check that dst is not poisoned
-          Map.insert dst (UpdatedWith src) routCtx
+          updateRoutCtx dst (UpdatedWith src) routCtx
 
       checkInstr (AND dst src) progCtx routCtx =
           -- TODO check that dst is not poisoned
-          Map.insert dst (UpdatedWith src) routCtx
+          updateRoutCtx dst (UpdatedWith src) routCtx
       checkInstr (OR dst src) progCtx routCtx =
           -- TODO check that dst is not poisoned
-          Map.insert dst (UpdatedWith src) routCtx
+          updateRoutCtx dst (UpdatedWith src) routCtx
       checkInstr (XOR dst src) progCtx routCtx =
           -- TODO check that dst is not poisoned
-          Map.insert dst (UpdatedWith src) routCtx
+          updateRoutCtx dst (UpdatedWith src) routCtx
 
       checkInstr (JSR name) progCtx routCtx =
           let
@@ -91,18 +87,18 @@ analyzeProgram program@(Program decls routines) =
 
       checkInstr (BIT dst) progCtx routCtx =
           -- TODO check that dst is not poisoned
-          Map.insert dst (UpdatedWith (Immediate 0)) routCtx
+          updateRoutCtx dst (UpdatedWith (Immediate 0)) routCtx
 
       checkInstr (SHR dst flg) progCtx routCtx =
           -- TODO check that dst is not poisoned
-          Map.insert dst (UpdatedWith flg) routCtx
+          updateRoutCtx dst (UpdatedWith flg) routCtx
       checkInstr (SHL dst flg) progCtx routCtx =
           -- TODO check that dst is not poisoned
-          Map.insert dst (UpdatedWith flg) routCtx
+          updateRoutCtx dst (UpdatedWith flg) routCtx
 
       checkInstr (COPYROUTINE name dst) progCtx routCtx =
           -- TODO check that dst is not poisoned
-          Map.insert dst (UpdatedWith (Immediate 7)) routCtx
+          updateRoutCtx dst (UpdatedWith (Immediate 7)) routCtx
 
       checkInstr (JMPVECTOR dst) progCtx routCtx =
           routCtx
@@ -127,20 +123,16 @@ mergeRoutCtxs routCtx calledRoutCtx calledRout@(Routine name outputs _) =
         poison location usage routCtxAccum =
             case usage of
                 UpdatedWith ulocation ->
-                    case (untypedLocation location) `elem` outputs of
+                    case location `elem` outputs of
                         True ->
-                            Map.insert location usage routCtxAccum
+                            updateRoutCtx location usage routCtxAccum
                         False ->
-                            Map.insert location (PoisonedWith ulocation) routCtxAccum
+                            updateRoutCtx location (PoisonedWith ulocation) routCtxAccum
                 PoisonedWith ulocation ->
-                    Map.insert location usage routCtxAccum
+                    updateRoutCtx location usage routCtxAccum
     in
         Map.foldrWithKey (poison) routCtx calledRoutCtx
 
-untypedLocation (NamedLocation (Just _) name) =
-    NamedLocation Nothing name
-untypedLocation x = x
-
 --
 -- Utility function:
 -- Take 2 routine contexts -- one from each branch of an `if` -- and merge
@@ -153,7 +145,7 @@ mergeAlternateRoutCtxs routCtx1 routCtx2 =
         poison location usage2 routCtxAccum =
             case Map.lookup location routCtx1 of
                 Nothing ->
-                    Map.insert location usage2 routCtxAccum
+                    updateRoutCtx location usage2 routCtxAccum
                 Just usage1 ->
                     -- it exists in both routCtxs.
                     -- if it is poisoned in either, it's poisoned here.
@@ -164,6 +156,6 @@ mergeAlternateRoutCtxs routCtx1 routCtx2 =
                             (_, PoisonedWith _) -> usage2
                             _ -> usage1  -- or 2.  doesn't matter.
                     in
-                        Map.insert location newUsage routCtxAccum
+                        updateRoutCtx location newUsage routCtxAccum
     in
         Map.foldrWithKey (poison) routCtx1 routCtx2

src/SixtyPical/Context.hs

@@ -26,6 +26,30 @@ 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 (NamedLocation _ name) =
+    NamedLocation Nothing name
+untypedLocation x = x
+
+updateRoutCtx :: StorageLocation -> Usage -> RoutineContext -> RoutineContext
+updateRoutCtx dst (UpdatedWith src) routCtx =
+    let
+        s = untypedLocation src
+        d = untypedLocation dst
+    in
+        case Map.lookup s routCtx of
+            Just (PoisonedWith _) ->
+                error ("routine does not preserve '" ++ (show s) ++ "'")
+            _ ->
+                Map.insert d (UpdatedWith s) routCtx
+updateRoutCtx dst (PoisonedWith src) routCtx =
+    Map.insert (untypedLocation dst) (PoisonedWith $ untypedLocation src) routCtx
+                  
+-- pretty printing
+
 ppAnalysis :: Program -> ProgramContext -> IO ()
 ppAnalysis program progCtx =
     let

src/SixtyPical/Parser.hs

@@ -440,17 +440,19 @@ sta = do
 
 stx :: Parser Instruction
 stx = do
-    string "stx"
-    spaces
-    l <- named_location
-    return (COPY X l)
+    addressing_mode "stx" gen
+    where
+       gen (Directly l) [] = COPY X (NamedLocation Nothing l)
+       gen (LowBytely l) [] = COPY X (LowByteOf (NamedLocation Nothing l))
+       gen (HighBytely l) [] = COPY X (HighByteOf (NamedLocation Nothing l))
 
 sty :: Parser Instruction
 sty = do
-    string "sty"
-    spaces
-    l <- named_location
-    return (COPY Y l)
+    addressing_mode "sty" gen
+    where
+       gen (Directly l) [] = COPY Y (NamedLocation Nothing l)
+       gen (LowBytely l) [] = COPY Y (LowByteOf (NamedLocation Nothing l))
+       gen (HighBytely l) [] = COPY Y (HighByteOf (NamedLocation Nothing l))
 
 txa :: Parser Instruction
 txa = do