git @ Cat's Eye Technologies SixtyPical / 81526ec
Poisoning high/low byte of word poisons the word. Cat's Eye Technologies 7 years ago
5 changed file(s) with 87 addition(s) and 54 deletion(s). Raw diff Collapse all Expand all
121121 * `outputs` on externals
122122 * Routine is a kind of StorageLocation? (Location)?
123123 * remove DELTA -> ADD/SUB (requires carry be notated on ADD and SUB though)
124 * Poisoning the highbyte or lowbyte of a word should poison the word
124 * explicit `with` syntax
1515 | }
1616 = main ([])
1717 = A: UpdatedWith (Immediate 4)
18 = NamedLocation (Just Byte) "score": UpdatedWith A
18 = NamedLocation Nothing "score": UpdatedWith A
1919
2020 A routine cannot expect registers which a called routine does not
2121 preserve, to be preserved.
5252 = main ([])
5353 = A: UpdatedWith (Immediate 4)
5454 = X: PoisonedWith (Immediate 1)
55 = NamedLocation (Just Byte) "border_colour": UpdatedWith A
56 = NamedLocation (Just Byte) "score": PoisonedWith X
55 = NamedLocation Nothing "border_colour": UpdatedWith A
56 = NamedLocation Nothing "score": PoisonedWith X
5757 =
5858 = update_score ([])
5959 = X: UpdatedWith (Immediate 1)
60 = NamedLocation (Just Byte) "score": UpdatedWith X
60 = NamedLocation Nothing "score": UpdatedWith X
6161
6262 We can't expect to stay named variables to stay unmodified either.
6363
64 | assign byte border_colour 4000
65 | reserve byte score
66 | routine update_score
67 | {
68 | lda #8
69 | sta score
70 | }
71 | routine main {
72 | jsr update_score
73 | ldx score
74 | }
75 ? routine does not preserve 'NamedLocation (Just Byte) "score"'
64 | reserve byte score
65 | routine update_score
66 | {
67 | lda #8
68 | sta score
69 | }
70 | routine main {
71 | jsr update_score
72 | lda score
73 | }
74 ? routine does not preserve 'NamedLocation Nothing "score"'
7675
7776 What the solution to the above is to notate `update_score` as intentionally
7877 modifying score, as an "output" of the routine.
9190 | }
9291 = main ([])
9392 = A: PoisonedWith (Immediate 8)
94 = X: UpdatedWith (NamedLocation (Just Byte) "score")
95 = NamedLocation (Just Byte) "score": UpdatedWith A
93 = X: UpdatedWith (NamedLocation Nothing "score")
94 = NamedLocation Nothing "score": UpdatedWith A
9695 =
9796 = update_score ([NamedLocation Nothing "score"])
9897 = A: UpdatedWith (Immediate 8)
99 = NamedLocation (Just Byte) "score": UpdatedWith A
98 = NamedLocation Nothing "score": UpdatedWith A
10099
101100 Routines can name registers as outputs.
102101
122121 | }
123122 = main ([])
124123 = A: UpdatedWith (Immediate 8)
125 = NamedLocation (Just Byte) "score": UpdatedWith A
124 = NamedLocation Nothing "score": UpdatedWith A
126125 =
127126 = update_score ([A])
128127 = A: UpdatedWith (Immediate 8)
195194 | sta score
196195 | }
197196 ? routine does not preserve 'A'
197
198 Poisoning a high byte or low byte of a word poisons the whole word.
199
200 | reserve word score
201 | reserve byte temp
202 | routine update_score
203 | {
204 | ldx #4
205 | stx <score
206 | }
207 | routine main {
208 | jsr update_score
209 | lda >score
210 | sta temp
211 | }
212 ? routine does not preserve 'NamedLocation Nothing "score"'
3333 -- -- -- -- -- -- -- -- -- -- -- --
3434
3535 checkInstr (COPY src dst) progCtx routCtx =
36 case Map.lookup src routCtx of
37 Just (PoisonedWith _) ->
38 error ("routine does not preserve '" ++ (show src) ++ "'")
39 _ ->
40 Map.insert dst (UpdatedWith src) routCtx
36 updateRoutCtx dst (UpdatedWith src) routCtx
4137 checkInstr (DELTA dst val) progCtx routCtx =
4238 -- TODO check that dst is not poisoned
43 Map.insert dst (UpdatedWith (Immediate val)) routCtx
39 updateRoutCtx dst (UpdatedWith (Immediate val)) routCtx
4440
4541 checkInstr (ADD dst src) progCtx routCtx =
4642 -- TODO check that dst is not poisoned
47 Map.insert dst (UpdatedWith src) routCtx
43 updateRoutCtx dst (UpdatedWith src) routCtx
4844 checkInstr (SUB dst src) progCtx routCtx =
4945 -- TODO check that dst is not poisoned
50 Map.insert dst (UpdatedWith src) routCtx
46 updateRoutCtx dst (UpdatedWith src) routCtx
5147
5248 checkInstr (AND dst src) progCtx routCtx =
5349 -- TODO check that dst is not poisoned
54 Map.insert dst (UpdatedWith src) routCtx
50 updateRoutCtx dst (UpdatedWith src) routCtx
5551 checkInstr (OR dst src) progCtx routCtx =
5652 -- TODO check that dst is not poisoned
57 Map.insert dst (UpdatedWith src) routCtx
53 updateRoutCtx dst (UpdatedWith src) routCtx
5854 checkInstr (XOR dst src) progCtx routCtx =
5955 -- TODO check that dst is not poisoned
60 Map.insert dst (UpdatedWith src) routCtx
56 updateRoutCtx dst (UpdatedWith src) routCtx
6157
6258 checkInstr (JSR name) progCtx routCtx =
6359 let
9086
9187 checkInstr (BIT dst) progCtx routCtx =
9288 -- TODO check that dst is not poisoned
93 Map.insert dst (UpdatedWith (Immediate 0)) routCtx
89 updateRoutCtx dst (UpdatedWith (Immediate 0)) routCtx
9490
9591 checkInstr (SHR dst flg) progCtx routCtx =
9692 -- TODO check that dst is not poisoned
97 Map.insert dst (UpdatedWith flg) routCtx
93 updateRoutCtx dst (UpdatedWith flg) routCtx
9894 checkInstr (SHL dst flg) progCtx routCtx =
9995 -- TODO check that dst is not poisoned
100 Map.insert dst (UpdatedWith flg) routCtx
96 updateRoutCtx dst (UpdatedWith flg) routCtx
10197
10298 checkInstr (COPYROUTINE name dst) progCtx routCtx =
10399 -- TODO check that dst is not poisoned
104 Map.insert dst (UpdatedWith (Immediate 7)) routCtx
100 updateRoutCtx dst (UpdatedWith (Immediate 7)) routCtx
105101
106102 checkInstr (JMPVECTOR dst) progCtx routCtx =
107103 routCtx
126122 poison location usage routCtxAccum =
127123 case usage of
128124 UpdatedWith ulocation ->
129 case (untypedLocation location) `elem` outputs of
125 case location `elem` outputs of
130126 True ->
131 Map.insert location usage routCtxAccum
127 updateRoutCtx location usage routCtxAccum
132128 False ->
133 Map.insert location (PoisonedWith ulocation) routCtxAccum
129 updateRoutCtx location (PoisonedWith ulocation) routCtxAccum
134130 PoisonedWith ulocation ->
135 Map.insert location usage routCtxAccum
131 updateRoutCtx location usage routCtxAccum
136132 in
137133 Map.foldrWithKey (poison) routCtx calledRoutCtx
138
139 untypedLocation (NamedLocation (Just _) name) =
140 NamedLocation Nothing name
141 untypedLocation x = x
142134
143135 --
144136 -- Utility function:
152144 poison location usage2 routCtxAccum =
153145 case Map.lookup location routCtx1 of
154146 Nothing ->
155 Map.insert location usage2 routCtxAccum
147 updateRoutCtx location usage2 routCtxAccum
156148 Just usage1 ->
157149 -- it exists in both routCtxs.
158150 -- if it is poisoned in either, it's poisoned here.
163155 (_, PoisonedWith _) -> usage2
164156 _ -> usage1 -- or 2. doesn't matter.
165157 in
166 Map.insert location newUsage routCtxAccum
158 updateRoutCtx location newUsage routCtxAccum
167159 in
168160 Map.foldrWithKey (poison) routCtx1 routCtx2
2525
2626 type ProgramContext = Map.Map RoutineName RoutineContext
2727
28 untypedLocation (HighByteOf (NamedLocation _ name)) =
29 NamedLocation Nothing name
30 untypedLocation (LowByteOf (NamedLocation _ name)) =
31 NamedLocation Nothing name
32 untypedLocation (NamedLocation _ name) =
33 NamedLocation Nothing name
34 untypedLocation x = x
35
36 updateRoutCtx :: StorageLocation -> Usage -> RoutineContext -> RoutineContext
37 updateRoutCtx dst (UpdatedWith src) routCtx =
38 let
39 s = untypedLocation src
40 d = untypedLocation dst
41 in
42 case Map.lookup s routCtx of
43 Just (PoisonedWith _) ->
44 error ("routine does not preserve '" ++ (show s) ++ "'")
45 _ ->
46 Map.insert d (UpdatedWith s) routCtx
47 updateRoutCtx dst (PoisonedWith src) routCtx =
48 Map.insert (untypedLocation dst) (PoisonedWith $ untypedLocation src) routCtx
49
50 -- pretty printing
51
2852 ppAnalysis :: Program -> ProgramContext -> IO ()
2953 ppAnalysis program progCtx =
3054 let
439439
440440 stx :: Parser Instruction
441441 stx = do
442 string "stx"
443 spaces
444 l <- named_location
445 return (COPY X l)
442 addressing_mode "stx" gen
443 where
444 gen (Directly l) [] = COPY X (NamedLocation Nothing l)
445 gen (LowBytely l) [] = COPY X (LowByteOf (NamedLocation Nothing l))
446 gen (HighBytely l) [] = COPY X (HighByteOf (NamedLocation Nothing l))
446447
447448 sty :: Parser Instruction
448449 sty = do
449 string "sty"
450 spaces
451 l <- named_location
452 return (COPY Y l)
450 addressing_mode "sty" gen
451 where
452 gen (Directly l) [] = COPY Y (NamedLocation Nothing l)
453 gen (LowBytely l) [] = COPY Y (LowByteOf (NamedLocation Nothing l))
454 gen (HighBytely l) [] = COPY Y (HighByteOf (NamedLocation Nothing l))
453455
454456 txa :: Parser Instruction
455457 txa = do