diff --git a/doc/Emitting.markdown b/doc/Emitting.markdown index 0471c27..56d12af 100644 --- a/doc/Emitting.markdown +++ b/doc/Emitting.markdown @@ -228,6 +228,92 @@ Copy command: word INDEXED -> word = .space locs_lo 4 = .space locs_hi 4 +Copy command: byte -> indexed word table -> error. + + | reserve byte bbb + | reserve word[4] locs + | routine main { + | ldx #0 + | copy bbb locs, x + | } + ? incompatible types 'Byte' and 'Table Word 4' + +Copy command: byte -> low byte of indexed word table + + | reserve byte bbb + | reserve word[4] locs + | routine main { + | ldx #0 + | copy bbb high byte of indexed word table + + | reserve byte bbb + | reserve word[4] locs + | routine main { + | ldx #0 + | copy bbb >locs, x + | } + = main: + = ldx #0 + = lda bbb + = sta locs_hi, x + = rts + = + = .data + = .space bbb 1 + = .space locs_lo 4 + = .space locs_hi 4 + +Copy command: low byte of indexed word table -> byte + + | reserve byte bbb + | reserve word[4] locs + | routine main { + | ldx #0 + | copy byte + + | reserve byte bbb + | reserve word[4] locs + | routine main { + | ldx #0 + | copy >locs, x bbb + | } + = main: + = ldx #0 + = lda locs_hi, x + = sta bbb + = rts + = + = .data + = .space bbb 1 + = .space locs_lo 4 + = .space locs_hi 4 + `main` is always emitted first. | reserve word position diff --git a/eg/game.60p b/eg/game.60p index 6252eeb..cc6b6e8 100644 --- a/eg/game.60p +++ b/eg/game.60p @@ -137,16 +137,19 @@ routine check_fire { } routine init_game { + // this shouldn't be needed! + reserve byte temp_a ldy #0 repeat bne { lda #$04 - // *** this is broken *** - sta >actor_pos, y + sta temp_a + copy temp_a >actor_pos, y tya clc asl .a asl .a - sta "x" - Y -> "y" + " sta " ++ dst ++ "_hi, " ++ (regName reg) + +emitInstr p r (COPY (NamedLocation (Just Byte) src) + (LowByteOf (Indexed (NamedLocation (Just (Table Word _)) dst) reg))) = + "lda " ++ src ++ "\n" ++ + " sta " ++ dst ++ "_lo, " ++ (regName reg) + +emitInstr p r (COPY (NamedLocation (Just Byte) src) + (HighByteOf (Indexed (NamedLocation (Just (Table Word _)) dst) reg))) = + "lda " ++ src ++ "\n" ++ + " sta " ++ dst ++ "_hi, " ++ (regName reg) + +emitInstr p r (COPY (LowByteOf (Indexed (NamedLocation (Just (Table Word _)) src) reg)) + (NamedLocation (Just Byte) dst)) = + "lda " ++ src ++ "_lo, " ++ (regName reg) ++ "\n" ++ + " sta " ++ dst + +emitInstr p r (COPY (HighByteOf (Indexed (NamedLocation (Just (Table Word _)) src) reg)) + (NamedLocation (Just Byte) dst)) = + "lda " ++ src ++ "_hi, " ++ (regName reg) ++ "\n" ++ + " sta " ++ dst emitInstr p r (COPY (Indexed (NamedLocation (Just (Table st1 _)) src) reg) (NamedLocation (Just st2) dst)) | (st1 == Vector && st2 == Vector) || (st1 == Word && st2 == Word) = - "lda " ++ src ++ "_lo, " ++ r ++ "\n" ++ + "lda " ++ src ++ "_lo, " ++ (regName reg) ++ "\n" ++ " sta " ++ dst ++ "\n" ++ - " lda " ++ src ++ "_hi, " ++ r ++ "\n" ++ + " lda " ++ src ++ "_hi, " ++ (regName reg) ++ "\n" ++ " sta " ++ dst ++ "+1" - where - r = case reg of - X -> "x" - Y -> "y" 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" @@ -239,3 +251,6 @@ emitInstr p r i = error ( "Internal error: sixtypical doesn't know how to " ++ "emit assembler code for '" ++ (show i) ++ "'") + +regName X = "x" +regName Y = "y" diff --git a/src/SixtyPical/Parser.hs b/src/SixtyPical/Parser.hs index 356ef76..60fc09b 100644 --- a/src/SixtyPical/Parser.hs +++ b/src/SixtyPical/Parser.hs @@ -576,18 +576,23 @@ copy_general_statement = do string "copy" nspaces - src <- (try immediate <|> try direct_location) + src <- (immediate <|> + low_byte_of_absolute <|> high_byte_of_absolute <|> direct_location) srcI <- many index lhs <- return $ case (src, srcI) of ((Immediately s), []) -> (Immediate s) ((Directly s), []) -> (NamedLocation Nothing s) ((Directly s), [reg]) -> (Indexed (NamedLocation Nothing s) reg) + ((LowBytely s), [reg]) -> (LowByteOf (Indexed (NamedLocation Nothing s) reg)) + ((HighBytely s), [reg]) -> (HighByteOf (Indexed (NamedLocation Nothing s) reg)) - dst <- direct_location + dst <- (low_byte_of_absolute <|> high_byte_of_absolute <|> direct_location) dstI <- many index rhs <- return $ case (dst, dstI) of ((Directly d), []) -> (NamedLocation Nothing d) ((Directly d), [reg]) -> (Indexed (NamedLocation Nothing d) reg) + ((LowBytely d), [reg]) -> (LowByteOf (Indexed (NamedLocation Nothing d) reg)) + ((HighBytely d), [reg]) -> (HighByteOf (Indexed (NamedLocation Nothing d) reg)) return $ COPY lhs rhs diff --git a/src/SixtyPical/Transformer.hs b/src/SixtyPical/Transformer.hs index 0591363..7096cfe 100644 --- a/src/SixtyPical/Transformer.hs +++ b/src/SixtyPical/Transformer.hs @@ -144,6 +144,10 @@ fillOutNamedLocationTypes p@(Program decls routines) = (Indexed (resolve loc) (resolve reg)) resolve (IndirectIndexed loc reg) = (IndirectIndexed (resolve loc) (resolve reg)) + resolve (LowByteOf loc) = + (LowByteOf (resolve loc)) + resolve (HighByteOf loc) = + (HighByteOf (resolve loc)) resolve other = other