git @ Cat's Eye Technologies SixtyPical / cbd88ab
Vector tables, and copy routine into a vector table. Cat's Eye Technologies 7 years ago
4 changed file(s) with 39 addition(s) and 19 deletion(s). Raw diff Collapse all Expand all
2929
3030 reserve word[16] actor_pos
3131 reserve word[16] actor_delta
32 reserve vector[16] actor_logic
3233
3334 reserve vector dispatch_state
3435 reserve vector dispatch_logic
155156 copy #00 >actor_delta, y
156157 copy #40 <actor_delta, y
157158
159 cpy #0
160 if beq {
161 copy routine logic_player to actor_logic, y
162 } else {
163 copy routine logic_obstacle to actor_logic, y
164 }
165
158166 iny
159167 cpy #8
160168 }
240248
241249 copy actor_pos, x position
242250 copy actor_delta, x delta
243
244 cpx #0
245 if beq {
246 copy routine logic_player to dispatch_logic
247 } else {
248 copy routine logic_obstacle to dispatch_logic
249 }
251 copy actor_logic, x dispatch_logic
252
250253 jsr indirect_jsr_logic
251254
252255 ldx save_x
3939 showList [val] = show val
4040 showList (val:vals) = (show val) ++ ", " ++ (showList vals)
4141
42 emitDecl p (Reserve name (Table Word size) []) =
43 ".space " ++ name ++ "_lo " ++ (show size) ++ "\n" ++
44 ".space " ++ name ++ "_hi " ++ (show size)
42 emitDecl p (Reserve name (Table typ size) [])
43 | typ == Word || typ == Vector =
44 ".space " ++ name ++ "_lo " ++ (show size) ++ "\n" ++
45 ".space " ++ name ++ "_hi " ++ (show size)
4546
4647 emitDecl p (Reserve name typ [])
4748 | typ == Byte = ".space " ++ name ++ " 1"
258259 " lda #>" ++ src ++ "\n" ++
259260 " sta " ++ dst ++ "+1"
260261
262 emitInstr p r (COPYROUTINE src (Indexed (NamedLocation (Just (Table Vector _)) dst) reg)) =
263 "lda #<" ++ src ++ "\n" ++
264 " sta " ++ dst ++ "_lo, " ++ (regName reg) ++ "\n" ++
265 " lda #>" ++ src ++ "\n" ++
266 " sta " ++ dst ++ "_hi, " ++ (regName reg)
267
261268 emitInstr p r (JMPVECTOR (NamedLocation (Just Vector) dst)) =
262269 "jmp (" ++ dst ++ ")"
263270
607607 string "to"
608608 nspaces
609609 dst <- location_name
610 return (COPYROUTINE src (NamedLocation Nothing dst))
610 dstI <- many index
611 return $ case dstI of
612 [] -> COPYROUTINE src (NamedLocation Nothing dst)
613 [reg] -> COPYROUTINE src (Indexed (NamedLocation Nothing dst) reg)
611614
612615 branch :: Parser Branch
613616 branch = try (b "bcc" BCC) <|> try (b "bcs" BCS) <|> try (b "beq" BEQ) <|>
123123 typeRx = getType rx
124124 typeRy = getType ry
125125 in
126 case (typeRx == typeRy, typeRx, typeRy) of
127 (True, _, _) -> constructor rx ry
128 (_, Byte, (Table Byte _)) -> constructor rx ry
129 (_, (Table Byte _), Byte) -> constructor rx ry
130 (_, Word, (Table Word _)) -> constructor rx ry
131 (_, (Table Word _), Word) -> constructor rx ry
132 _ -> error ("incompatible types '" ++ (show typeRx) ++ "' and '" ++ (show typeRy) ++ "'" ++
133 " " ++ (show rx) ++ "," ++ (show ry))
126 if
127 typeRx == typeRy
128 then
129 constructor rx ry
130 else
131 case (typeRx, typeRy) of
132 (Byte, (Table Byte _)) -> constructor rx ry
133 ((Table Byte _), Byte) -> constructor rx ry
134 (Word, (Table Word _)) -> constructor rx ry
135 ((Table Word _), Word) -> constructor rx ry
136 (Vector, (Table Vector _)) -> constructor rx ry
137 ((Table Vector _), Vector) -> constructor rx ry
138 _ -> error ("incompatible types '" ++ (show typeRx) ++
139 "' and '" ++ (show typeRy) ++ "'" ++
140 " [" ++ (show rx) ++ "," ++ (show ry) ++ "]")
134141 resolve (NamedLocation Nothing name) =
135142 case lookupDecl p name of
136143 Just decl ->