Vector tables, and copy routine into a vector table.

eg/game.60p

@@ -30,6 +30,7 @@ reserve word compare_target
 
 reserve word[16] actor_pos
 reserve word[16] actor_delta
+reserve vector[16] actor_logic
 
 reserve vector dispatch_state
 reserve vector dispatch_logic
@@ -156,6 +157,13 @@ routine init_game {
         copy #00 >actor_delta, y
         copy #40 <actor_delta, y
 
+        cpy #0
+        if beq {
+            copy routine logic_player to actor_logic, y
+        } else {
+            copy routine logic_obstacle to actor_logic, y
+        }
+
         iny
         cpy #8
     }
@@ -241,13 +249,8 @@ routine state_play_game {
 
         copy actor_pos, x position
         copy actor_delta, x delta
+        copy actor_logic, x dispatch_logic
 
-        cpx #0
-        if beq {
-            copy routine logic_player to dispatch_logic
-        } else {
-            copy routine logic_obstacle to dispatch_logic
-        }
         jsr indirect_jsr_logic
 
         ldx save_x

src/SixtyPical/Emitter.hs

@@ -40,9 +40,10 @@ emitDecl p (Reserve name (Table Byte size) vals) =
         showList [val] = show val
         showList (val:vals) = (show val) ++ ", " ++ (showList vals)
 
-emitDecl p (Reserve name (Table Word size) []) =
+emitDecl p (Reserve name (Table typ size) [])
-    ".space " ++ name ++ "_lo " ++ (show size) ++ "\n" ++
+    | typ == Word || typ == Vector =
-    ".space " ++ name ++ "_hi " ++ (show size)
+      ".space " ++ name ++ "_lo " ++ (show size) ++ "\n" ++
+      ".space " ++ name ++ "_hi " ++ (show size)
 
 emitDecl p (Reserve name typ [])
     | typ == Byte = ".space " ++ name ++ " 1"
@@ -259,6 +260,12 @@ emitInstr p r (COPYROUTINE src (NamedLocation (Just Vector) dst)) =
     "  lda #>" ++ src ++ "\n" ++
     "  sta " ++ dst ++ "+1"
 
+emitInstr p r (COPYROUTINE src (Indexed (NamedLocation (Just (Table Vector _)) dst) reg)) =
+    "lda #<" ++ src ++ "\n" ++
+    "  sta " ++ dst ++ "_lo, " ++ (regName reg) ++ "\n" ++
+    "  lda #>" ++ src ++ "\n" ++
+    "  sta " ++ dst ++ "_hi, " ++ (regName reg)
+
 emitInstr p r (JMPVECTOR (NamedLocation (Just Vector) dst)) =
     "jmp (" ++ dst ++ ")"
 

src/SixtyPical/Parser.hs

@@ -608,7 +608,10 @@ copy_routine_statement = do
     string "to"
     nspaces
     dst <- location_name
-    return (COPYROUTINE src (NamedLocation Nothing dst))
+    dstI <- many index
+    return $ case dstI of
+        [] -> COPYROUTINE src (NamedLocation Nothing dst)
+        [reg] -> COPYROUTINE src (Indexed (NamedLocation Nothing dst) reg)
 
 branch :: Parser Branch
 branch = try (b "bcc" BCC) <|> try (b "bcs" BCS) <|> try (b "beq" BEQ) <|>

src/SixtyPical/Transformer.hs

@@ -124,14 +124,21 @@ fillOutNamedLocationTypes p@(Program decls routines) =
                 typeRx = getType rx
                 typeRy = getType ry
             in
-                case (typeRx == typeRy, typeRx, typeRy) of
+                if
-                    (True, _, _) -> constructor rx ry
+                    typeRx == typeRy
-                    (_, Byte, (Table Byte _)) -> constructor rx ry
+                  then
-                    (_, (Table Byte _), Byte) -> constructor rx ry                    
+                    constructor rx ry
-                    (_, Word, (Table Word _)) -> constructor rx ry
+                  else
-                    (_, (Table Word _), Word) -> constructor rx ry                    
+                    case (typeRx, typeRy) of
-                    _ -> error ("incompatible types '" ++ (show typeRx) ++ "' and '" ++ (show typeRy) ++ "'" ++
+                      (Byte, (Table Byte _)) -> constructor rx ry
-                                "  " ++ (show rx) ++ "," ++ (show ry))
+                      ((Table Byte _), Byte) -> constructor rx ry                    
+                      (Word, (Table Word _)) -> constructor rx ry
+                      ((Table Word _), Word) -> constructor rx ry                    
+                      (Vector, (Table Vector _)) -> constructor rx ry
+                      ((Table Vector _), Vector) -> constructor rx ry                    
+                      _ -> error ("incompatible types '" ++ (show typeRx) ++
+                                  "' and '" ++ (show typeRy) ++ "'" ++
+                                  "  [" ++ (show rx) ++ "," ++ (show ry) ++ "]")
         resolve (NamedLocation Nothing name) =
             case lookupDecl p name of
                 Just decl ->