git @ Cat's Eye Technologies SixtyPical / de4a6a7
report the name of the routine that does not preserve locations Cat's Eye Technologies 7 years ago
4 changed file(s) with 64 addition(s) and 74 deletion(s). Raw diff Collapse all Expand all
3232 | jsr update_score
3333 | sta border_colour
3434 | }
35 ? routine does not preserve 'A'
35 ? routine 'main' does not preserve 'A'
3636
3737 But if it does it can.
3838
7171 | jsr update_score
7272 | lda score
7373 | }
74 ? routine does not preserve 'NamedLocation Nothing "score"'
74 ? routine 'main' does not preserve 'NamedLocation Nothing "score"'
7575
7676 What the solution to the above is to notate `update_score` as intentionally
7777 modifying score, as an "output" of the routine.
108108 | jsr update_score
109109 | sta score
110110 | }
111 ? routine does not preserve 'A'
111 ? routine 'main' does not preserve 'A'
112112
113113 | reserve byte score
114114 | routine update_score outputs (.a)
143143 | jsr update_score
144144 | sta score
145145 | }
146 ? routine does not preserve 'A'
146 ? routine 'main' does not preserve 'A'
147147
148148 | reserve byte score
149149 | routine update_score
159159 | jsr update_score
160160 | sta score
161161 | }
162 ? routine does not preserve 'A'
162 ? routine 'main' does not preserve 'A'
163163
164164 | reserve byte score
165165 | routine update_score
176176 | }
177177 | sta score
178178 | }
179 ? routine does not preserve 'A'
179 ? routine 'main' does not preserve 'A'
180180
181181 | reserve byte score
182182 | routine update_score
193193 | }
194194 | sta score
195195 | }
196 ? routine does not preserve 'A'
196 ? routine 'main' does not preserve 'A'
197197
198198 Poisoning a high byte or low byte of a word poisons the whole word.
199199
209209 | lda >score
210210 | sta temp
211211 | }
212 ? routine does not preserve 'NamedLocation Nothing "score"'
212 ? routine 'main' does not preserve 'NamedLocation Nothing "score"'
8080 }
8181
8282 routine our_cinv {
83 inc value
8384 lda value
84 inc value
8585 ldy #0
8686 sta (position), y
8787 jsr increment_pos
8888 jsr compare_pos
89 lda vic_border ; WHY DOES THE FOLLOWING NOT ANALUZE
8990 if beq {
9091 jsr reset_position
9192 } else {
2121 checkRoutines routs progCtx'
2222
2323 checkRoutine (Routine name outputs instrs) progCtx routCtx =
24 checkBlock instrs progCtx routCtx
24 checkBlock name instrs progCtx routCtx
2525
26 checkBlock [] progCtx routCtx = routCtx
27 checkBlock (instr:instrs) progCtx routCtx =
26 checkBlock nm [] progCtx routCtx = routCtx
27 checkBlock nm (instr:instrs) progCtx routCtx =
2828 let
29 routCtx' = checkInstr instr progCtx routCtx
29 routCtx' = checkInstr nm instr progCtx routCtx
3030 in
31 checkBlock instrs progCtx routCtx'
31 checkBlock nm instrs progCtx routCtx'
3232
3333 -- -- -- -- -- -- -- -- -- -- -- --
3434
35 checkInstr (COPY src dst) progCtx routCtx =
36 updateRoutCtx dst (UpdatedWith src) routCtx
37 checkInstr (DELTA dst val) progCtx routCtx =
38 -- TODO check that dst is not poisoned
39 updateRoutCtx dst (UpdatedWith (Immediate val)) routCtx
35 checkInstr nm (COPY src dst) progCtx routCtx =
36 updateRoutCtx nm dst (UpdatedWith src) routCtx
37 checkInstr nm (DELTA dst val) progCtx routCtx =
38 updateRoutCtx nm dst (UpdatedWith (Immediate val)) routCtx
39 checkInstr nm (ADD dst src) progCtx routCtx =
40 updateRoutCtx nm dst (UpdatedWith src) routCtx
41 checkInstr nm (SUB dst src) progCtx routCtx =
42 updateRoutCtx nm dst (UpdatedWith src) routCtx
4043
41 checkInstr (ADD dst src) progCtx routCtx =
42 -- TODO check that dst is not poisoned
43 updateRoutCtx dst (UpdatedWith src) routCtx
44 checkInstr (SUB dst src) progCtx routCtx =
45 -- TODO check that dst is not poisoned
46 updateRoutCtx dst (UpdatedWith src) routCtx
44 checkInstr nm (AND dst src) progCtx routCtx =
45 updateRoutCtx nm dst (UpdatedWith src) routCtx
46 checkInstr nm (OR dst src) progCtx routCtx =
47 updateRoutCtx nm dst (UpdatedWith src) routCtx
48 checkInstr nm (XOR dst src) progCtx routCtx =
49 updateRoutCtx nm dst (UpdatedWith src) routCtx
4750
48 checkInstr (AND dst src) progCtx routCtx =
49 -- TODO check that dst is not poisoned
50 updateRoutCtx dst (UpdatedWith src) routCtx
51 checkInstr (OR dst src) progCtx routCtx =
52 -- TODO check that dst is not poisoned
53 updateRoutCtx dst (UpdatedWith src) routCtx
54 checkInstr (XOR dst src) progCtx routCtx =
55 -- TODO check that dst is not poisoned
56 updateRoutCtx dst (UpdatedWith src) routCtx
57
58 checkInstr (JSR name) progCtx routCtx =
51 checkInstr nm (JSR name) progCtx routCtx =
5952 let
6053 Just calledRout = lookupRoutine program name
6154 in
6255 case Map.lookup name progCtx of
6356 Just calledRoutCtx ->
64 mergeRoutCtxs routCtx calledRoutCtx calledRout
57 mergeRoutCtxs nm routCtx calledRoutCtx calledRout
6558 Nothing ->
6659 error ("can't call routine '" ++ name ++ "' before it is defined")
67 checkInstr (CMP reg addr) progCtx routCtx =
60 checkInstr nm (CMP reg addr) progCtx routCtx =
6861 -- TODO: mark Carry bit as "touched" here
6962 routCtx
70 checkInstr (IF _ branch b1 b2) progCtx routCtx =
63 checkInstr nm (IF _ branch b1 b2) progCtx routCtx =
7164 let
72 routCtx1 = checkBlock b1 progCtx routCtx
73 routCtx2 = checkBlock b2 progCtx routCtx
65 routCtx1 = checkBlock nm b1 progCtx routCtx
66 routCtx2 = checkBlock nm b2 progCtx routCtx
7467 in
75 mergeAlternateRoutCtxs routCtx1 routCtx2
76 checkInstr (REPEAT _ branch blk) progCtx routCtx =
68 mergeAlternateRoutCtxs nm routCtx1 routCtx2
69 checkInstr nm (REPEAT _ branch blk) progCtx routCtx =
7770 -- TODO: oooh, this one's gonna be fun too
7871 --checkBlock blk progCtx routCtx
7972 routCtx
8073
8174 -- TODO -- THESE ARE WEAK --
82 checkInstr (SEI blk) progCtx routCtx =
83 checkBlock blk progCtx routCtx
84 checkInstr (PUSH _ blk) progCtx routCtx =
85 checkBlock blk progCtx routCtx
75 checkInstr nm (SEI blk) progCtx routCtx =
76 checkBlock nm blk progCtx routCtx
77 checkInstr nm (PUSH _ blk) progCtx routCtx =
78 checkBlock nm blk progCtx routCtx
8679
87 checkInstr (BIT dst) progCtx routCtx =
88 -- TODO check that dst is not poisoned
89 updateRoutCtx dst (UpdatedWith (Immediate 0)) routCtx
80 checkInstr nm (BIT dst) progCtx routCtx =
81 updateRoutCtx nm dst (UpdatedWith (Immediate 0)) routCtx
9082
91 checkInstr (SHR dst flg) progCtx routCtx =
92 -- TODO check that dst is not poisoned
93 updateRoutCtx dst (UpdatedWith flg) routCtx
94 checkInstr (SHL dst flg) progCtx routCtx =
95 -- TODO check that dst is not poisoned
96 updateRoutCtx dst (UpdatedWith flg) routCtx
83 checkInstr nm (SHR dst flg) progCtx routCtx =
84 updateRoutCtx nm dst (UpdatedWith flg) routCtx
85 checkInstr nm (SHL dst flg) progCtx routCtx =
86 updateRoutCtx nm dst (UpdatedWith flg) routCtx
9787
98 checkInstr (COPYROUTINE name dst) progCtx routCtx =
99 -- TODO check that dst is not poisoned
100 updateRoutCtx dst (UpdatedWith (Immediate 7)) routCtx
88 checkInstr nm (COPYROUTINE name dst) progCtx routCtx =
89 updateRoutCtx nm dst (UpdatedWith (Immediate 7)) routCtx
10190
102 checkInstr (JMPVECTOR dst) progCtx routCtx =
91 checkInstr nm (JMPVECTOR dst) progCtx routCtx =
10392 routCtx
10493
105 checkInstr NOP progCtx routCtx =
94 checkInstr nm NOP progCtx routCtx =
10695 routCtx
10796
108 checkInstr instr _ _ = error (
97 checkInstr nm instr _ _ = error (
10998 "Internal error: sixtypical doesn't know how to " ++
110 "analyze '" ++ (show instr) ++ "'")
99 "analyze '" ++ (show instr) ++ "' in '" ++ nm ++ "'")
111100
112101 --
113102 -- Utility function:
115104 -- JSR'ed to (immediately previously) -- and merge them to create a new
116105 -- context for the current routine.
117106 --
118 mergeRoutCtxs routCtx calledRoutCtx calledRout@(Routine name outputs _) =
107 mergeRoutCtxs nm routCtx calledRoutCtx calledRout@(Routine name outputs _) =
119108 let
120109 -- go through all the Usages in the calledRoutCtx
121110 -- insert any that were updated, into routCtx
124113 UpdatedWith ulocation ->
125114 case location `elem` outputs of
126115 True ->
127 updateRoutCtx location usage routCtxAccum
116 updateRoutCtx nm location usage routCtxAccum
128117 False ->
129 updateRoutCtx location (PoisonedWith ulocation) routCtxAccum
118 updateRoutCtx nm location (PoisonedWith ulocation) routCtxAccum
130119 PoisonedWith ulocation ->
131 updateRoutCtx location usage routCtxAccum
120 updateRoutCtx nm location usage routCtxAccum
132121 in
133122 Map.foldrWithKey (poison) routCtx calledRoutCtx
134123
137126 -- Take 2 routine contexts -- one from each branch of an `if` -- and merge
138127 -- them to create a new context for the remainder of the routine.
139128 --
140 mergeAlternateRoutCtxs routCtx1 routCtx2 =
129 mergeAlternateRoutCtxs nm routCtx1 routCtx2 =
141130 let
142131 -- go through all the Usages in routCtx2
143132 -- insert any that were updated, into routCtx1
144133 poison location usage2 routCtxAccum =
145134 case Map.lookup location routCtx1 of
146135 Nothing ->
147 updateRoutCtx location usage2 routCtxAccum
136 updateRoutCtx nm location usage2 routCtxAccum
148137 Just usage1 ->
149138 -- it exists in both routCtxs.
150139 -- if it is poisoned in either, it's poisoned here.
155144 (_, PoisonedWith _) -> usage2
156145 _ -> usage1 -- or 2. doesn't matter.
157146 in
158 updateRoutCtx location newUsage routCtxAccum
147 updateRoutCtx nm location newUsage routCtxAccum
159148 in
160149 Map.foldrWithKey (poison) routCtx1 routCtx2
3333 NamedLocation Nothing name
3434 untypedLocation x = x
3535
36 updateRoutCtx :: StorageLocation -> Usage -> RoutineContext -> RoutineContext
37 updateRoutCtx dst (UpdatedWith src) routCtx =
36 updateRoutCtx :: String -> StorageLocation -> Usage -> RoutineContext -> RoutineContext
37 updateRoutCtx nm dst (UpdatedWith src) routCtx =
3838 let
3939 s = untypedLocation src
4040 d = untypedLocation dst
4141 in
4242 case Map.lookup s routCtx of
4343 Just (PoisonedWith _) ->
44 error ("routine does not preserve '" ++ (show s) ++ "'")
44 error ("routine '" ++ nm ++ "' does not preserve '" ++ (show s) ++ "'")
4545 _ ->
4646 Map.insert d (UpdatedWith s) routCtx
47 updateRoutCtx dst (PoisonedWith src) routCtx =
47 updateRoutCtx nm dst (PoisonedWith src) routCtx =
4848 Map.insert (untypedLocation dst) (PoisonedWith $ untypedLocation src) routCtx
4949
5050 -- pretty printing