diff --git a/README.markdown b/README.markdown index c3c5f78..6636e4e 100644 --- a/README.markdown +++ b/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 diff --git a/doc/Analyzing.markdown b/doc/Analyzing.markdown index c609775..6d1f20d 100644 --- a/doc/Analyzing.markdown +++ b/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 + | sta temp + | } + ? routine does not preserve 'NamedLocation Nothing "score"' diff --git a/src/SixtyPical/Analyzer.hs b/src/SixtyPical/Analyzer.hs index a4e4539..57fa651 100644 --- a/src/SixtyPical/Analyzer.hs +++ b/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 diff --git a/src/SixtyPical/Context.hs b/src/SixtyPical/Context.hs index fab7078..5dc66f3 100644 --- a/src/SixtyPical/Context.hs +++ b/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 diff --git a/src/SixtyPical/Parser.hs b/src/SixtyPical/Parser.hs index 357925d..9a268bc 100644 --- a/src/SixtyPical/Parser.hs +++ b/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