git @ Cat's Eye Technologies SixtyPical / 2088769
Generalized copy command for great justice. Cat's Eye Technologies 7 years ago
6 changed file(s) with 75 addition(s) and 37 deletion(s). Raw diff Collapse all Expand all
103103 |
104104 | routine main {
105105 | sei {
106 | copy vector cinv to save_cinv
106 | copy cinv save_cinv
107107 | copy routine our_cinv to cinv
108108 | }
109109 | }
133133 = .alias screen 1024
134134 = .alias cinv 788
135135 = save_cinv: .word 0
136
137 Copy command: immediate -> byte
138
139 | reserve byte position
140 | routine main {
141 | copy #23 position
142 | }
143 = main:
144 = lda #23
145 = sta position
146 = rts
147 =
148 = position: .byte 0
149
150 Copy command: immediate -> word
151
152 | reserve word position
153 | routine main {
154 | copy #$0400 position
155 | }
156 = main:
157 = lda #0
158 = sta position
159 = lda #4
160 = sta position+1
161 = rts
162 =
163 = position: .word 0
33
44 routine main {
55 sei {
6 copy vector cinv to save_cinv
6 copy cinv save_cinv
77 copy routine our_cinv to cinv
88 }
99 }
3333 jsr reset_position
3434 jsr clear_screen
3535 sei {
36 copy vector cinv to save_cinv
36 copy cinv save_cinv
3737 copy routine our_cinv to cinv
3838 }
3939 clc
4141 }
4242
4343 routine our_cinv {
44 lda value
45 inc value
44 lda #32
4645 ldy #0
4746 sta (position), y
4847 jsr read_stick
5251 jsr install_new_position
5352 } else { }
5453
54 lda #81
55 ldy #0
56 sta (position), y
57
5558 jmp (save_cinv)
5659 }
5760
5861 routine reset_position {
59 lda #$00
60 sta <position
61 lda #$04
62 sta >position
62 copy #$0400 position
6363 }
6464
6565 routine advance_pos {
7373 }
7474
7575 routine install_new_position {
76 lda <new_position
77 sta <position
78 lda >new_position
79 sta >position
76 copy new_position position
8077 }
8178
8279 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
8781 jsr compare_new_pos
8882
8983 if bcs {
9084 clc
9185 } else {
9286
93 lda #$04
94 sta >compare_target
95 lda #$00
96 sta <compare_target
87 copy #$0400 compare_target
9788 jsr compare_new_pos
9889
9990 if bcc {
145145 getType A = Byte
146146 getType X = Byte
147147 getType Y = Byte
148 getType (Immediate x) =
149 if x > 255 then Word else Byte
148150 getType _ = Byte
149151 typeMatch x y constructor =
150152 let
00 -- encoding: UTF-8
11
22 module SixtyPical.Emitter where
3
4 import Data.Bits
35
46 import SixtyPical.Model
57
6769
6870 emitInstr p r (COPY A (IndirectIndexed (NamedLocation st label) Y)) = "sta (" ++ label ++ "), y"
6971 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"
7093
7194 emitInstr p r (CMP A (NamedLocation st label)) = "cmp " ++ label
7295 emitInstr p r (CMP X (NamedLocation st label)) = "cpx " ++ label
143166 emitInstrs p r blk ++
144167 " plp"
145168
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
152169 emitInstr p r (COPYROUTINE src (NamedLocation (Just Vector) dst)) =
153170 "lda #<" ++ src ++ "\n" ++
154171 " sta " ++ dst ++ "\n" ++
202202 (try rol) <|> (try ror) <|>
203203 (try sei) <|> (try pha) <|> (try php) <|>
204204 (try jmp) <|> (try jsr) <|>
205 (try copy_vector_statement) <|>
206205 (try copy_routine_statement) <|>
206 (try copy_general_statement) <|>
207207 if_statement <|> repeat_statement <|> nop
208208
209209 nop :: Parser Instruction
507507 blk <- block
508508 return (REPEAT 0 brch blk)
509509
510 copy_vector_statement :: Parser Instruction
511 copy_vector_statement = do
510 copy_general_statement :: Parser Instruction
511 copy_general_statement = do
512512 string "copy"
513513 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))
521521
522522 copy_routine_statement :: Parser Instruction
523523 copy_routine_statement = do