From 2088769b8e5b5563f4ced3569ab42a47262c5315 Mon Sep 17 00:00:00 2001 From: Cat's Eye Technologies Date: Thu, 3 Apr 2014 22:07:19 +0100 Subject: [PATCH] Generalized copy command for great justice. --- doc/Emitting.markdown | 30 +++++++++++++++++++++++++++++- eg/cinv.60p | 2 +- eg/game.60p | 29 ++++++++++------------------- src/SixtyPical/Checker.hs | 2 ++ src/SixtyPical/Emitter.hs | 29 +++++++++++++++++++++++------ src/SixtyPical/Parser.hs | 20 ++++++++++---------- 6 files changed, 75 insertions(+), 37 deletions(-) diff --git a/doc/Emitting.markdown b/doc/Emitting.markdown index 8ddc47e..bc8aed3 100644 --- a/doc/Emitting.markdown +++ b/doc/Emitting.markdown @@ -104,7 +104,7 @@ Installing an interrupt handler (at the Kernal level, i.e. with CINV) | | routine main { | sei { - | copy vector cinv to save_cinv + | copy cinv save_cinv | copy routine our_cinv to cinv | } | } @@ -134,3 +134,31 @@ Installing an interrupt handler (at the Kernal level, i.e. with CINV) = .alias screen 1024 = .alias cinv 788 = save_cinv: .word 0 + +Copy command: immediate -> byte + + | reserve byte position + | routine main { + | copy #23 position + | } + = main: + = lda #23 + = sta position + = rts + = + = position: .byte 0 + +Copy command: immediate -> word + + | reserve word position + | routine main { + | copy #$0400 position + | } + = main: + = lda #0 + = sta position + = lda #4 + = sta position+1 + = rts + = + = position: .word 0 diff --git a/eg/cinv.60p b/eg/cinv.60p index 44b0072..78cdc6a 100644 --- a/eg/cinv.60p +++ b/eg/cinv.60p @@ -4,7 +4,7 @@ reserve vector save_cinv routine main { sei { - copy vector cinv to save_cinv + copy cinv save_cinv copy routine our_cinv to cinv } } diff --git a/eg/game.60p b/eg/game.60p index 8f2d9fd..31c46fb 100644 --- a/eg/game.60p +++ b/eg/game.60p @@ -34,7 +34,7 @@ routine main { jsr reset_position jsr clear_screen sei { - copy vector cinv to save_cinv + copy cinv save_cinv copy routine our_cinv to cinv } clc @@ -42,8 +42,7 @@ routine main { } routine our_cinv { - lda value - inc value + lda #32 ldy #0 sta (position), y jsr read_stick @@ -53,14 +52,15 @@ routine our_cinv { jsr install_new_position } else { } + lda #81 + ldy #0 + sta (position), y + jmp (save_cinv) } routine reset_position { - lda #$00 - sta position + copy #$0400 position } routine advance_pos { @@ -74,27 +74,18 @@ routine advance_pos { } routine install_new_position { - lda new_position - sta >position + copy new_position position } routine check_new_position_in_bounds { - lda #$07 ; just past bottom of screen - sta >compare_target - lda #$e8 - sta compare_target - lda #$00 - sta 255 then Word else Byte getType _ = Byte typeMatch x y constructor = let diff --git a/src/SixtyPical/Emitter.hs b/src/SixtyPical/Emitter.hs index 0eefe31..f43e120 100644 --- a/src/SixtyPical/Emitter.hs +++ b/src/SixtyPical/Emitter.hs @@ -2,6 +2,8 @@ module SixtyPical.Emitter where +import Data.Bits + import SixtyPical.Model emitProgram p@(Program decls routines) = @@ -69,6 +71,27 @@ emitInstr p r (COPY (Indexed (NamedLocation (Just ByteTable) label) Y) A) = "lda emitInstr p r (COPY A (IndirectIndexed (NamedLocation st label) Y)) = "sta (" ++ label ++ "), y" emitInstr p r (COPY (IndirectIndexed (NamedLocation st label) Y) A) = "lda (" ++ label ++ "), y" +emitInstr p r (COPY (NamedLocation (Just st1) src) (NamedLocation (Just st2) dst)) + | (st1 == Vector && st2 == Vector) || (st1 == Word && st2 == Word) = + "lda " ++ src ++ "\n" ++ + " sta " ++ dst ++ "\n" ++ + " lda " ++ src ++ "+1\n" ++ + " sta " ++ dst ++ "+1" + +emitInstr p r (COPY (Immediate v) (NamedLocation (Just st) dst)) + | st == Byte = + "lda #" ++ (show v) ++ "\n" ++ + " sta " ++ dst + | st == Word = + let + low = v .&. 255 + high = (shift v (-8)) .&. 255 + in + "lda #" ++ (show low) ++ "\n" ++ + " sta " ++ dst ++ "\n" ++ + " lda #" ++ (show high) ++ "\n" ++ + " sta " ++ dst ++ "+1" + emitInstr p r (CMP A (NamedLocation st label)) = "cmp " ++ label emitInstr p r (CMP X (NamedLocation st label)) = "cpx " ++ label emitInstr p r (CMP Y (NamedLocation st label)) = "cpy " ++ label @@ -144,12 +167,6 @@ emitInstr p r (PUSH FlagC blk) = emitInstrs p r blk ++ " plp" -emitInstr p r (COPYVECTOR (NamedLocation (Just Vector) src) (NamedLocation (Just Vector) dst)) = - "lda " ++ src ++ "\n" ++ - " sta " ++ dst ++ "\n" ++ - " lda " ++ src ++ "+1\n" ++ - " sta " ++ dst ++ "+1" - emitInstr p r (COPYROUTINE src (NamedLocation (Just Vector) dst)) = "lda #<" ++ src ++ "\n" ++ " sta " ++ dst ++ "\n" ++ diff --git a/src/SixtyPical/Parser.hs b/src/SixtyPical/Parser.hs index 7566b35..446d8f6 100644 --- a/src/SixtyPical/Parser.hs +++ b/src/SixtyPical/Parser.hs @@ -203,8 +203,8 @@ command = (try lda) <|> (try rol) <|> (try ror) <|> (try sei) <|> (try pha) <|> (try php) <|> (try jmp) <|> (try jsr) <|> - (try copy_vector_statement) <|> (try copy_routine_statement) <|> + (try copy_general_statement) <|> if_statement <|> repeat_statement <|> nop nop :: Parser Instruction @@ -508,17 +508,17 @@ repeat_statement = do blk <- block return (REPEAT 0 brch blk) -copy_vector_statement :: Parser Instruction -copy_vector_statement = do +copy_general_statement :: Parser Instruction +copy_general_statement = do string "copy" spaces - string "vector" - spaces - src <- locationName - string "to" - spaces - dst <- locationName - return (COPYVECTOR (NamedLocation Nothing src) (NamedLocation Nothing dst)) + src <- (try immediate <|> try direct_location) + dst <- direct_location + return $ case (src, dst) of + (Immediately s, Directly d) -> + (COPY (Immediate s) (NamedLocation Nothing d)) + (Directly s, Directly d) -> + (COPY (NamedLocation Nothing s) (NamedLocation Nothing d)) copy_routine_statement :: Parser Instruction copy_routine_statement = do