More access of word tables. Game works with a word table now!

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 <locs, x
+    | }
+    = main:
+    =   ldx #0
+    =   lda bbb
+    =   sta locs_lo, x
+    =   rts
+    = 
+    = .data
+    = .space bbb 1
+    = .space locs_lo 4
+    = .space locs_hi 4
+
+Copy command: byte -> 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 <locs, x bbb
+    | }
+    = main:
+    =   ldx #0
+    =   lda locs_lo, x
+    =   sta bbb
+    =   rts
+    = 
+    = .data
+    = .space bbb 1
+    = .space locs_lo 4
+    = .space locs_hi 4
+
+Copy command: high byte of indexed word table -> 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 

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 <actor_pos, y
+        sta temp_a
+        copy temp_a <actor_pos, y
         iny
         cpy #8
     }

src/SixtyPical/Emitter.hs

@@ -105,24 +105,36 @@ emitInstr p r (COPY (Indexed (NamedLocation (Just (Table Byte _)) label) Y) A) =
 emitInstr p r (COPY (NamedLocation (Just st1) src) (Indexed (NamedLocation (Just (Table st2 _)) dst) reg))
   | (st1 == Vector && st2 == Vector) || (st1 == Word && st2 == Word) =
     "lda " ++ src ++ "\n" ++
-    "  sta " ++ dst ++ "_lo, " ++ r ++ "\n" ++
+    "  sta " ++ dst ++ "_lo, " ++ (regName reg) ++ "\n" ++
     "  lda " ++ src ++ "+1\n" ++
-    "  sta " ++ dst ++ "_hi, " ++ r
-  where
-    r = case reg of
-         X -> "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"

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
 

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