Generalized copy command for great justice.
Cat's Eye Technologies
8 years ago
3 | 3 |
|
4 | 4 |
routine main {
|
5 | 5 |
sei {
|
6 | |
copy vector cinv to save_cinv
|
|
6 |
copy cinv save_cinv
|
7 | 7 |
copy routine our_cinv to cinv
|
8 | 8 |
}
|
9 | 9 |
}
|
33 | 33 |
jsr reset_position
|
34 | 34 |
jsr clear_screen
|
35 | 35 |
sei {
|
36 | |
copy vector cinv to save_cinv
|
|
36 |
copy cinv save_cinv
|
37 | 37 |
copy routine our_cinv to cinv
|
38 | 38 |
}
|
39 | 39 |
clc
|
|
41 | 41 |
}
|
42 | 42 |
|
43 | 43 |
routine our_cinv {
|
44 | |
lda value
|
45 | |
inc value
|
|
44 |
lda #32
|
46 | 45 |
ldy #0
|
47 | 46 |
sta (position), y
|
48 | 47 |
jsr read_stick
|
|
52 | 51 |
jsr install_new_position
|
53 | 52 |
} else { }
|
54 | 53 |
|
|
54 |
lda #81
|
|
55 |
ldy #0
|
|
56 |
sta (position), y
|
|
57 |
|
55 | 58 |
jmp (save_cinv)
|
56 | 59 |
}
|
57 | 60 |
|
58 | 61 |
routine reset_position {
|
59 | |
lda #$00
|
60 | |
sta <position
|
61 | |
lda #$04
|
62 | |
sta >position
|
|
62 |
copy #$0400 position
|
63 | 63 |
}
|
64 | 64 |
|
65 | 65 |
routine advance_pos {
|
|
73 | 73 |
}
|
74 | 74 |
|
75 | 75 |
routine install_new_position {
|
76 | |
lda <new_position
|
77 | |
sta <position
|
78 | |
lda >new_position
|
79 | |
sta >position
|
|
76 |
copy new_position position
|
80 | 77 |
}
|
81 | 78 |
|
82 | 79 |
routine check_new_position_in_bounds {
|
83 | |
lda #$07 ; just past bottom of screen
|
84 | |
sta >compare_target
|
85 | |
lda #$e8
|
86 | |
sta <compare_target
|
|
80 |
copy #$07e8 compare_target ; just past bottom of screen
|
87 | 81 |
jsr compare_new_pos
|
88 | 82 |
|
89 | 83 |
if bcs {
|
90 | 84 |
clc
|
91 | 85 |
} else {
|
92 | 86 |
|
93 | |
lda #$04
|
94 | |
sta >compare_target
|
95 | |
lda #$00
|
96 | |
sta <compare_target
|
|
87 |
copy #$0400 compare_target
|
97 | 88 |
jsr compare_new_pos
|
98 | 89 |
|
99 | 90 |
if bcc {
|
0 | 0 |
-- encoding: UTF-8
|
1 | 1 |
|
2 | 2 |
module SixtyPical.Emitter where
|
|
3 |
|
|
4 |
import Data.Bits
|
3 | 5 |
|
4 | 6 |
import SixtyPical.Model
|
5 | 7 |
|
|
67 | 69 |
|
68 | 70 |
emitInstr p r (COPY A (IndirectIndexed (NamedLocation st label) Y)) = "sta (" ++ label ++ "), y"
|
69 | 71 |
emitInstr p r (COPY (IndirectIndexed (NamedLocation st label) Y) A) = "lda (" ++ label ++ "), y"
|
|
72 |
|
|
73 |
emitInstr p r (COPY (NamedLocation (Just st1) src) (NamedLocation (Just st2) dst))
|
|
74 |
| (st1 == Vector && st2 == Vector) || (st1 == Word && st2 == Word) =
|
|
75 |
"lda " ++ src ++ "\n" ++
|
|
76 |
" sta " ++ dst ++ "\n" ++
|
|
77 |
" lda " ++ src ++ "+1\n" ++
|
|
78 |
" sta " ++ dst ++ "+1"
|
|
79 |
|
|
80 |
emitInstr p r (COPY (Immediate v) (NamedLocation (Just st) dst))
|
|
81 |
| st == Byte =
|
|
82 |
"lda #" ++ (show v) ++ "\n" ++
|
|
83 |
" sta " ++ dst
|
|
84 |
| st == Word =
|
|
85 |
let
|
|
86 |
low = v .&. 255
|
|
87 |
high = (shift v (-8)) .&. 255
|
|
88 |
in
|
|
89 |
"lda #" ++ (show low) ++ "\n" ++
|
|
90 |
" sta " ++ dst ++ "\n" ++
|
|
91 |
" lda #" ++ (show high) ++ "\n" ++
|
|
92 |
" sta " ++ dst ++ "+1"
|
70 | 93 |
|
71 | 94 |
emitInstr p r (CMP A (NamedLocation st label)) = "cmp " ++ label
|
72 | 95 |
emitInstr p r (CMP X (NamedLocation st label)) = "cpx " ++ label
|
|
143 | 166 |
emitInstrs p r blk ++
|
144 | 167 |
" plp"
|
145 | 168 |
|
146 | |
emitInstr p r (COPYVECTOR (NamedLocation (Just Vector) src) (NamedLocation (Just Vector) dst)) =
|
147 | |
"lda " ++ src ++ "\n" ++
|
148 | |
" sta " ++ dst ++ "\n" ++
|
149 | |
" lda " ++ src ++ "+1\n" ++
|
150 | |
" sta " ++ dst ++ "+1"
|
151 | |
|
152 | 169 |
emitInstr p r (COPYROUTINE src (NamedLocation (Just Vector) dst)) =
|
153 | 170 |
"lda #<" ++ src ++ "\n" ++
|
154 | 171 |
" sta " ++ dst ++ "\n" ++
|
202 | 202 |
(try rol) <|> (try ror) <|>
|
203 | 203 |
(try sei) <|> (try pha) <|> (try php) <|>
|
204 | 204 |
(try jmp) <|> (try jsr) <|>
|
205 | |
(try copy_vector_statement) <|>
|
206 | 205 |
(try copy_routine_statement) <|>
|
|
206 |
(try copy_general_statement) <|>
|
207 | 207 |
if_statement <|> repeat_statement <|> nop
|
208 | 208 |
|
209 | 209 |
nop :: Parser Instruction
|
|
507 | 507 |
blk <- block
|
508 | 508 |
return (REPEAT 0 brch blk)
|
509 | 509 |
|
510 | |
copy_vector_statement :: Parser Instruction
|
511 | |
copy_vector_statement = do
|
|
510 |
copy_general_statement :: Parser Instruction
|
|
511 |
copy_general_statement = do
|
512 | 512 |
string "copy"
|
513 | 513 |
spaces
|
514 | |
string "vector"
|
515 | |
spaces
|
516 | |
src <- locationName
|
517 | |
string "to"
|
518 | |
spaces
|
519 | |
dst <- locationName
|
520 | |
return (COPYVECTOR (NamedLocation Nothing src) (NamedLocation Nothing dst))
|
|
514 |
src <- (try immediate <|> try direct_location)
|
|
515 |
dst <- direct_location
|
|
516 |
return $ case (src, dst) of
|
|
517 |
(Immediately s, Directly d) ->
|
|
518 |
(COPY (Immediate s) (NamedLocation Nothing d))
|
|
519 |
(Directly s, Directly d) ->
|
|
520 |
(COPY (NamedLocation Nothing s) (NamedLocation Nothing d))
|
521 | 521 |
|
522 | 522 |
copy_routine_statement :: Parser Instruction
|
523 | 523 |
copy_routine_statement = do
|