6502/SixtyPical
1
0
Fork 0
mirror of https://github.com/catseye/SixtyPical.git synced 2024-06-26 16:29:28 +00:00
Code Issues Projects Releases Wiki Activity

Vector tables, and copy routine into a vector table.

Browse Source
This commit is contained in:
Cat's Eye Technologies 2014-04-13 12:41:26 +01:00
parent eec59ac8a9
commit cbd88abc89
4 changed files with 38 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
eg/game.60p
View File

@ -30,6 +30,7 @@ reserve word compare_target
reserve word[16] actor_pos
reserve word[16] actor_delta
reserve vector[16] actor_logic
reserve vector dispatch_state
reserve vector dispatch_logic
@ -156,6 +157,13 @@ routine init_game {
copy #00 >actor_delta, y
copy #40 <actor_delta, y
cpy #0
if beq {
copy routine logic_player to actor_logic, y
} else {
copy routine logic_obstacle to actor_logic, y
}
iny
cpy #8
}
@ -241,13 +249,8 @@ routine state_play_game {
copy actor_pos, x position
copy actor_delta, x delta
copy actor_logic, x dispatch_logic
cpx #0
if beq {
copy routine logic_player to dispatch_logic
} else {
copy routine logic_obstacle to dispatch_logic
}
jsr indirect_jsr_logic
ldx save_x

13
src/SixtyPical/Emitter.hs
View File

@ -40,9 +40,10 @@ emitDecl p (Reserve name (Table Byte size) vals) =
showList [val] = show val
showList (val:vals) = (show val) ++ ", " ++ (showList vals)
emitDecl p (Reserve name (Table Word size) []) =
".space " ++ name ++ "_lo " ++ (show size) ++ "\n" ++
".space " ++ name ++ "_hi " ++ (show size)
emitDecl p (Reserve name (Table typ size) [])
| typ == Word || typ == Vector =
".space " ++ name ++ "_lo " ++ (show size) ++ "\n" ++
".space " ++ name ++ "_hi " ++ (show size)
emitDecl p (Reserve name typ [])
| typ == Byte = ".space " ++ name ++ " 1"
@ -259,6 +260,12 @@ emitInstr p r (COPYROUTINE src (NamedLocation (Just Vector) dst)) =
" lda #>" ++ src ++ "\n" ++
" sta " ++ dst ++ "+1"
emitInstr p r (COPYROUTINE src (Indexed (NamedLocation (Just (Table Vector _)) dst) reg)) =
"lda #<" ++ src ++ "\n" ++
" sta " ++ dst ++ "_lo, " ++ (regName reg) ++ "\n" ++
" lda #>" ++ src ++ "\n" ++
" sta " ++ dst ++ "_hi, " ++ (regName reg)
emitInstr p r (JMPVECTOR (NamedLocation (Just Vector) dst)) =
"jmp (" ++ dst ++ ")"

5
src/SixtyPical/Parser.hs
View File

@ -608,7 +608,10 @@ copy_routine_statement = do
string "to"
nspaces
dst <- location_name
return (COPYROUTINE src (NamedLocation Nothing dst))
dstI <- many index
return $ case dstI of
[] -> COPYROUTINE src (NamedLocation Nothing dst)
[reg] -> COPYROUTINE src (Indexed (NamedLocation Nothing dst) reg)
branch :: Parser Branch
branch = try (b "bcc" BCC) <|> try (b "bcs" BCS) <|> try (b "beq" BEQ) <|>

23
src/SixtyPical/Transformer.hs
View File

@ -124,14 +124,21 @@ fillOutNamedLocationTypes p@(Program decls routines) =
typeRx = getType rx
typeRy = getType ry
in
case (typeRx == typeRy, typeRx, typeRy) of
(True, _, _) -> constructor rx ry
(_, Byte, (Table Byte _)) -> constructor rx ry
(_, (Table Byte _), Byte) -> constructor rx ry
(_, Word, (Table Word _)) -> constructor rx ry
(_, (Table Word _), Word) -> constructor rx ry
_ -> error ("incompatible types '" ++ (show typeRx) ++ "' and '" ++ (show typeRy) ++ "'" ++
" " ++ (show rx) ++ "," ++ (show ry))
if
typeRx == typeRy
then
constructor rx ry
else
case (typeRx, typeRy) of
(Byte, (Table Byte _)) -> constructor rx ry
((Table Byte _), Byte) -> constructor rx ry
(Word, (Table Word _)) -> constructor rx ry
((Table Word _), Word) -> constructor rx ry
(Vector, (Table Vector _)) -> constructor rx ry
((Table Vector _), Vector) -> constructor rx ry
_ -> error ("incompatible types '" ++ (show typeRx) ++
"' and '" ++ (show typeRy) ++ "'" ++
" [" ++ (show rx) ++ "," ++ (show ry) ++ "]")
resolve (NamedLocation Nothing name) =
case lookupDecl p name of
Just decl ->