Commit de4a6a7c83169980d64d1124c31d983861c325b3 - SixtyPical

report the name of the routine that does not preserve locations Cat's Eye Technologies 8 years ago

4 changed file(s) with 64 addition(s) and 74 deletion(s). Raw diff Collapse all Expand all

-8

doc/Analyzing.markdown less more

32	32	\| jsr update_score
33	33	\| sta border_colour
34	34	\| }
35		? routine does not preserve 'A'
	35	? routine 'main' does not preserve 'A'
36	36
37	37	But if it does it can.
38	38

71	71	\| jsr update_score
72	72	\| lda score
73	73	\| }
74		? routine does not preserve 'NamedLocation Nothing "score"'
	74	? routine 'main' does not preserve 'NamedLocation Nothing "score"'
75	75
76	76	What the solution to the above is to notate `update_score` as intentionally
77	77	modifying score, as an "output" of the routine.

108	108	\| jsr update_score
109	109	\| sta score
110	110	\| }
111		? routine does not preserve 'A'
	111	? routine 'main' does not preserve 'A'
112	112
113	113	\| reserve byte score
114	114	\| routine update_score outputs (.a)

143	143	\| jsr update_score
144	144	\| sta score
145	145	\| }
146		? routine does not preserve 'A'
	146	? routine 'main' does not preserve 'A'
147	147
148	148	\| reserve byte score
149	149	\| routine update_score

159	159	\| jsr update_score
160	160	\| sta score
161	161	\| }
162		? routine does not preserve 'A'
	162	? routine 'main' does not preserve 'A'
163	163
164	164	\| reserve byte score
165	165	\| routine update_score

176	176	\| }
177	177	\| sta score
178	178	\| }
179		? routine does not preserve 'A'
	179	? routine 'main' does not preserve 'A'
180	180
181	181	\| reserve byte score
182	182	\| routine update_score

193	193	\| }
194	194	\| sta score
195	195	\| }
196		? routine does not preserve 'A'
	196	? routine 'main' does not preserve 'A'
197	197
198	198	Poisoning a high byte or low byte of a word poisons the whole word.
199	199

209	209	\| lda >score
210	210	\| sta temp
211	211	\| }
212		? routine does not preserve 'NamedLocation Nothing "score"'
	212	? routine 'main' does not preserve 'NamedLocation Nothing "score"'

-1

eg/demo.60p less more

80	80	}
81	81
82	82	routine our_cinv {
	83	inc value
83	84	lda value
84		inc value
85	85	ldy #0
86	86	sta (position), y
87	87	jsr increment_pos
88	88	jsr compare_pos
	89	lda vic_border ; WHY DOES THE FOLLOWING NOT ANALUZE
89	90	if beq {
90	91	jsr reset_position
91	92	} else {

+50

-61

src/SixtyPical/Analyzer.hs less more

21	21	checkRoutines routs progCtx'
22	22
23	23	checkRoutine (Routine name outputs instrs) progCtx routCtx =
24		checkBlock instrs progCtx routCtx
	24	checkBlock name instrs progCtx routCtx
25	25
26		checkBlock [] progCtx routCtx = routCtx
27		checkBlock (instr:instrs) progCtx routCtx =
	26	checkBlock nm [] progCtx routCtx = routCtx
	27	checkBlock nm (instr:instrs) progCtx routCtx =
28	28	let
29		routCtx' = checkInstr instr progCtx routCtx
	29	routCtx' = checkInstr nm instr progCtx routCtx
30	30	in
31		checkBlock instrs progCtx routCtx'
	31	checkBlock nm instrs progCtx routCtx'
32	32
33	33	-- -- -- -- -- -- -- -- -- -- -- --
34	34
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
40	43
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
47	50
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 =
59	52	let
60	53	Just calledRout = lookupRoutine program name
61	54	in
62	55	case Map.lookup name progCtx of
63	56	Just calledRoutCtx ->
64		mergeRoutCtxs routCtx calledRoutCtx calledRout
	57	mergeRoutCtxs nm routCtx calledRoutCtx calledRout
65	58	Nothing ->
66	59	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 =
68	61	-- TODO: mark Carry bit as "touched" here
69	62	routCtx
70		checkInstr (IF _ branch b1 b2) progCtx routCtx =
	63	checkInstr nm (IF _ branch b1 b2) progCtx routCtx =
71	64	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
74	67	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 =
77	70	-- TODO: oooh, this one's gonna be fun too
78	71	--checkBlock blk progCtx routCtx
79	72	routCtx
80	73
81	74	-- 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
86	79
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
90	82
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
97	87
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
101	90
102		checkInstr (JMPVECTOR dst) progCtx routCtx =
	91	checkInstr nm (JMPVECTOR dst) progCtx routCtx =
103	92	routCtx
104	93
105		checkInstr NOP progCtx routCtx =
	94	checkInstr nm NOP progCtx routCtx =
106	95	routCtx
107	96
108		checkInstr instr _ _ = error (
	97	checkInstr nm instr _ _ = error (
109	98	"Internal error: sixtypical doesn't know how to " ++
110		"analyze '" ++ (show instr) ++ "'")
	99	"analyze '" ++ (show instr) ++ "' in '" ++ nm ++ "'")
111	100
112	101	--
113	102	-- Utility function:

115	104	-- JSR'ed to (immediately previously) -- and merge them to create a new
116	105	-- context for the current routine.
117	106	--
118		mergeRoutCtxs routCtx calledRoutCtx calledRout@(Routine name outputs _) =
	107	mergeRoutCtxs nm routCtx calledRoutCtx calledRout@(Routine name outputs _) =
119	108	let
120	109	-- go through all the Usages in the calledRoutCtx
121	110	-- insert any that were updated, into routCtx

124	113	UpdatedWith ulocation ->
125	114	case location `elem` outputs of
126	115	True ->
127		updateRoutCtx location usage routCtxAccum
	116	updateRoutCtx nm location usage routCtxAccum
128	117	False ->
129		updateRoutCtx location (PoisonedWith ulocation) routCtxAccum
	118	updateRoutCtx nm location (PoisonedWith ulocation) routCtxAccum
130	119	PoisonedWith ulocation ->
131		updateRoutCtx location usage routCtxAccum
	120	updateRoutCtx nm location usage routCtxAccum
132	121	in
133	122	Map.foldrWithKey (poison) routCtx calledRoutCtx
134	123

137	126	-- Take 2 routine contexts -- one from each branch of an `if` -- and merge
138	127	-- them to create a new context for the remainder of the routine.
139	128	--
140		mergeAlternateRoutCtxs routCtx1 routCtx2 =
	129	mergeAlternateRoutCtxs nm routCtx1 routCtx2 =
141	130	let
142	131	-- go through all the Usages in routCtx2
143	132	-- insert any that were updated, into routCtx1
144	133	poison location usage2 routCtxAccum =
145	134	case Map.lookup location routCtx1 of
146	135	Nothing ->
147		updateRoutCtx location usage2 routCtxAccum
	136	updateRoutCtx nm location usage2 routCtxAccum
148	137	Just usage1 ->
149	138	-- it exists in both routCtxs.
150	139	-- if it is poisoned in either, it's poisoned here.

155	144	(_, PoisonedWith _) -> usage2
156	145	_ -> usage1 -- or 2. doesn't matter.
157	146	in
158		updateRoutCtx location newUsage routCtxAccum
	147	updateRoutCtx nm location newUsage routCtxAccum
159	148	in
160	149	Map.foldrWithKey (poison) routCtx1 routCtx2

-4

src/SixtyPical/Context.hs less more

33	33	NamedLocation Nothing name
34	34	untypedLocation x = x
35	35
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 =
38	38	let
39	39	s = untypedLocation src
40	40	d = untypedLocation dst
41	41	in
42	42	case Map.lookup s routCtx of
43	43	Just (PoisonedWith _) ->
44		error ("routine does not preserve '" ++ (show s) ++ "'")
	44	error ("routine '" ++ nm ++ "' does not preserve '" ++ (show s) ++ "'")
45	45	_ ->
46	46	Map.insert d (UpdatedWith s) routCtx
47		updateRoutCtx dst (PoisonedWith src) routCtx =
	47	updateRoutCtx nm dst (PoisonedWith src) routCtx =
48	48	Map.insert (untypedLocation dst) (PoisonedWith $ untypedLocation src) routCtx
49	49
50	50	-- pretty printing