Byte tables. And checking for same.

README.markdown

@@ -80,13 +80,13 @@ An address knows what kind of data is stored at the address:
     *   copying the address of a routine into a vector
     *   jumping indirectly to a vector (i.e. to the code at the address
         contained in the vector (and this can only happen at the end of a
-        routine)
+        routine (NYI))
     *   `jsr`'ing indirectly to a vector (which is done with a fun
-        generated trick
+        generated trick (NYI))
     
-*   `byte table`: (not yet implemented) a series of `byte`s
-    contiguous in memory starting from the address.
-    this is the only kind of address that can be used in indexed addressing.
+*   `byte table`: a series of `byte`s contiguous in memory starting from the
+    address.  This is the only kind of address that can be used in
+    indexed addressing.
 
 ### Blocks ###
 
@@ -290,19 +290,18 @@ Tests
     | }
     ? missing 'main' routine
 
-A program may reserve and assign.
+A program may `reserve` and `assign`.
 
+    | reserve byte lives
+    | assign byte gdcol 647
     | reserve word score
-    | assign word screen 1024
+    | assign word memstr 641
+    | reserve vector v
+    | assign vector cinv 788
+    | reserve byte table frequencies
+    | assign byte table screen 1024
     | routine main {
-    |    lda screen
-    |    tax
-    |    tay
-    |    cmp score
-    |    ldx score
-    |    txa
-    |    ldy score
-    |    tya
+    |    nop
     | }
     = True
 
@@ -381,13 +380,37 @@ We can't jump to a byte.
     | }
     ? jmp to non-vector
 
+We can absolute-indexed a byte table.
+
+    | assign byte table screen 1024
+    | routine main {
+    |    sta screen, x
+    | }
+    = True
+
+We cannot absolute-indexed a byte.
+
+    | assign byte screen 1024
+    | routine main {
+    |    sta screen, x
+    | }
+    ? indexed access of non-table
+
+We cannot absolute-indexed a word.
+
+    | assign word screen 1024
+    | routine main {
+    |    sta screen, x
+    | }
+    ? indexed access of non-table
+
     -> Tests for functionality "Emit ASM for SixtyPical program"
     
     -> Functionality "Emit ASM for SixtyPical program" is implemented by
     -> shell command "bin/sixtypical emit %(test-file)"
 
     | reserve word score
-    | assign word screen 1024
+    | assign byte table screen 1024
     | routine main {
     |    lda #4
     |    ldx #0
@@ -413,6 +436,7 @@ We can't jump to a byte.
     |    cpy #32
     |    tya
     |    sta screen
+    |    sta screen, x
     |    dec screen
     |    clc
     |    cld
@@ -452,6 +476,7 @@ We can't jump to a byte.
     =   cpy #32
     =   tya
     =   sta screen
+    =   sta screen, x
     =   dec screen
     =   clc
     =   cld

src/SixtyPical/Analyzer.hs

@@ -63,8 +63,8 @@ checkRoutine (Routine name (instr : instrs)) progCtx routCtx =
     in
         checkRoutine (Routine name instrs) progCtx routCtx'
 
-checkInstr (LOADIMM reg imm) progCtx routCtx =
-    Map.insert reg (Value imm) routCtx
+checkInstr (PUT dst imm) progCtx routCtx =
+    Map.insert dst (Value imm) routCtx
 checkInstr (COPY src dst) progCtx routCtx =
     Map.insert dst (Map.findWithDefault Unknown src routCtx) routCtx
 checkInstr (JSR name) progCtx routCtx =

src/SixtyPical/Checker.hs

@@ -83,6 +83,20 @@ noJmpsToNonVectors p@(Program decls routines) =
                 Nothing -> (COPY A A)
         checkInstr other = other
 
+noIndexedAccessOfNonTables p@(Program decls routines) =
+    let
+        mappedProgram = mapProgramRoutines (checkInstr) p
+    in
+        mappedProgram == p
+    where
+        checkInstr j@(COPYINDEXED _ (NamedLocation g) _) =
+            case lookupDecl p g of
+                Just (Assign _ ByteTable _) -> j
+                Just (Reserve _ ByteTable) -> j
+                Just _ -> (COPY A A)
+                Nothing -> (COPY A A)
+        checkInstr other = other
+
 checkAndTransformProgram :: Program -> Maybe Program
 checkAndTransformProgram program =
     if
@@ -90,7 +104,8 @@ checkAndTransformProgram program =
         trueOrDie "undeclared location" (allUsedLocationsDeclared program) &&
         trueOrDie "duplicate location name" (noDuplicateDecls program) &&
         trueOrDie "duplicate routine name" (noDuplicateRoutines program) &&
-        trueOrDie "jmp to non-vector" (noJmpsToNonVectors program)
+        trueOrDie "jmp to non-vector" (noJmpsToNonVectors program) &&
+        trueOrDie "indexed access of non-table" (noIndexedAccessOfNonTables program) 
       then
         Just $ numberProgramLoops program
       else Nothing

src/SixtyPical/Emitter.hs

@@ -36,15 +36,15 @@ emitInstrs _ _ [] = ""
 emitInstrs p r (instr:instrs) =
     "  " ++ emitInstr p r instr ++ "\n" ++ emitInstrs p r instrs
 
-emitInstr p r (LOADIMM A val) = "lda #" ++ (show val)
-emitInstr p r (LOADIMM X val) = "ldx #" ++ (show val)
-emitInstr p r (LOADIMM Y val) = "ldy #" ++ (show val)
+emitInstr p r (PUT A val) = "lda #" ++ (show val)
+emitInstr p r (PUT X val) = "ldx #" ++ (show val)
+emitInstr p r (PUT Y val) = "ldy #" ++ (show val)
 
-emitInstr p r (LOADIMM FlagC 0) = "clc"
-emitInstr p r (LOADIMM FlagD 0) = "cld"
-emitInstr p r (LOADIMM FlagV 0) = "clv"
-emitInstr p r (LOADIMM FlagC 1) = "sec"
-emitInstr p r (LOADIMM FlagD 1) = "sed"
+emitInstr p r (PUT FlagC 0) = "clc"
+emitInstr p r (PUT FlagD 0) = "cld"
+emitInstr p r (PUT FlagV 0) = "clv"
+emitInstr p r (PUT FlagC 1) = "sec"
+emitInstr p r (PUT FlagD 1) = "sed"
 
 emitInstr p r (COPY A (NamedLocation label)) = "sta " ++ label
 emitInstr p r (COPY X (NamedLocation label)) = "stx " ++ label
@@ -53,6 +53,14 @@ emitInstr p r (COPY (NamedLocation label) A) = "lda " ++ label
 emitInstr p r (COPY (NamedLocation label) X) = "ldx " ++ label
 emitInstr p r (COPY (NamedLocation label) Y) = "ldy " ++ label
 
+emitInstr p r (COPY A X) = "tax"
+emitInstr p r (COPY A Y) = "tay"
+emitInstr p r (COPY X A) = "txa"
+emitInstr p r (COPY Y A) = "tya"
+
+emitInstr p r (COPYINDEXED A (NamedLocation label) X) = "sta " ++ label ++ ", x"
+emitInstr p r (COPYINDEXED A (NamedLocation label) Y) = "sta " ++ label ++ ", x"
+
 emitInstr p r (CMP A (NamedLocation label)) = "cmp " ++ label
 emitInstr p r (CMP X (NamedLocation label)) = "cpx " ++ label
 emitInstr p r (CMP Y (NamedLocation label)) = "cpy " ++ label
@@ -68,11 +76,6 @@ emitInstr p r (DELTA Y (-1)) = "dey"
 emitInstr p r (DELTA (NamedLocation label) 1) = "inc " ++ label
 emitInstr p r (DELTA (NamedLocation label) (-1)) = "dec " ++ label
 
-emitInstr p r (COPY A X) = "tax"
-emitInstr p r (COPY A Y) = "tay"
-emitInstr p r (COPY X A) = "txa"
-emitInstr p r (COPY Y A) = "tya"
-
 emitInstr p r (IF iid branch b1 b2) =
     (show branch) ++ " _label_" ++ (show iid) ++ "\n" ++
     emitInstrs p r b2 ++

src/SixtyPical/Model.hs

@@ -41,6 +41,7 @@ allRegisters = [A, X, Y, FlagN, FlagV, FlagD, FlagZ, FlagC]
 data StorageType = Byte
                  | Word
                  | Vector
+                 | ByteTable
     deriving (Show, Ord, Eq)
 
 data Decl = Assign LocationName StorageType Address -- .alias
@@ -52,8 +53,9 @@ type RoutineName = String
 data Branch = BCC | BCS | BEQ | BMI | BNE | BPL | BVC | BVS
     deriving (Show, Ord, Eq)
 
-data Instruction = LOADIMM StorageLocation DataValue
+data Instruction = PUT StorageLocation DataValue
                  | COPY StorageLocation StorageLocation
+                 | COPYINDEXED StorageLocation StorageLocation StorageLocation
                  | CMPIMM StorageLocation DataValue
                  | CMP StorageLocation StorageLocation
                  | JSR RoutineName

src/SixtyPical/Parser.hs

@@ -56,10 +56,12 @@ assign = do
 get_storage "byte" = Byte
 get_storage "word" = Word
 get_storage "vector" = Vector
+get_storage "byte table" = ByteTable
 
 storage_type :: Parser StorageType
 storage_type = do
-    s <- (string "byte") <|> (string "word") <|> (string "vector")
+    s <- (try $ string "byte table") <|> (string "byte") <|>
+         (string "word") <|> (string "vector")
     spaces
     return $ get_storage s
 
@@ -107,31 +109,31 @@ clc :: Parser Instruction
 clc = do
     string "clc"
     spaces
-    return $ LOADIMM FlagC 0
+    return $ PUT FlagC 0
 
 cld :: Parser Instruction
 cld = do
     string "cld"
     spaces
-    return $ LOADIMM FlagD 0
+    return $ PUT FlagD 0
 
 clv :: Parser Instruction
 clv = do
     string "clv"
     spaces
-    return $ LOADIMM FlagV 0
+    return $ PUT FlagV 0
 
 sec :: Parser Instruction
 sec = do
     string "sec"
     spaces
-    return $ LOADIMM FlagC 1
+    return $ PUT FlagC 1
 
 sed :: Parser Instruction
 sed = do
     string "sed"
     spaces
-    return $ LOADIMM FlagD 1
+    return $ PUT FlagD 1
 
 inx :: Parser Instruction
 inx = do
@@ -203,25 +205,33 @@ absolute f = do
     l <- locationName
     return $ f l
 
+index :: Parser StorageLocation
+index = do
+    string ","
+    spaces
+    string "x"
+    spaces
+    return X
+
 lda :: Parser Instruction
 lda = do
     string "lda"
     spaces
-    (try $ immediate (\v -> LOADIMM A v) <|>
+    (try $ immediate (\v -> PUT A v) <|>
      absolute (\l -> COPY (NamedLocation l) A))
 
 ldx :: Parser Instruction
 ldx = do
     string "ldx"
     spaces
-    (try $ immediate (\v -> LOADIMM X v) <|>
+    (try $ immediate (\v -> PUT X v) <|>
      absolute (\l -> COPY (NamedLocation l) X))
 
 ldy :: Parser Instruction
 ldy = do
     string "ldy"
     spaces
-    (try $ immediate (\v -> LOADIMM Y v) <|>
+    (try $ immediate (\v -> PUT Y v) <|>
      absolute (\l -> COPY (NamedLocation l) Y))
 
 sta :: Parser Instruction
@@ -229,7 +239,12 @@ sta = do
     string "sta"
     spaces
     l <- locationName
-    return (COPY A (NamedLocation l))
+    indexes <- many index
+    return $ case indexes of
+        [] ->
+            COPY A (NamedLocation l)
+        [X] ->
+            COPYINDEXED A (NamedLocation l) X
 
 stx :: Parser Instruction
 stx = do