From 16d6a54fb5e2b006122815ccc732aee11c4da149 Mon Sep 17 00:00:00 2001 From: Cat's Eye Technologies Date: Sat, 12 Apr 2014 21:54:00 +0100 Subject: [PATCH] Parse (at the very least) decls for word and vector tables. --- doc/Checking.markdown | 16 ++++++++++++++++ src/SixtyPical/Checker.hs | 8 ++++---- src/SixtyPical/Emitter.hs | 12 ++++++------ src/SixtyPical/Model.hs | 2 +- src/SixtyPical/Parser.hs | 16 ++++++++-------- src/SixtyPical/Transformer.hs | 4 ++-- 6 files changed, 37 insertions(+), 21 deletions(-) diff --git a/doc/Checking.markdown b/doc/Checking.markdown index 807d91e..9ba6fab 100644 --- a/doc/Checking.markdown +++ b/doc/Checking.markdown @@ -129,6 +129,22 @@ of a sequence of bytes, it must be the same length as the table is declared. | } ? initial table incorrect size +We can also define word and vector tables. These are each stored as two +byte tables, one table of low bytes and one table of high bytes. + + | reserve word[100] words + | reserve vector[100] vectors + | routine main { + | lda #$04 + | sta words + | // sta >words, y + | // copy routine main to vectors, y + | } + = True + An address may be declared with `locate`, which is like `.alias` in an assembler, with the understanding that the value will be treated "like an address." This is generally an address into the operating system or hardware diff --git a/src/SixtyPical/Checker.hs b/src/SixtyPical/Checker.hs index 4609f5f..f82d7c6 100644 --- a/src/SixtyPical/Checker.hs +++ b/src/SixtyPical/Checker.hs @@ -31,8 +31,8 @@ noIndexedAccessOfNonTables p@(Program decls routines) = where checkInstr j@(COPY _ (Indexed (NamedLocation sz g) reg)) = case lookupDecl p g of - Just (Assign _ (ByteTable _) _) -> j - Just (Reserve _ (ByteTable _) _) -> j + Just (Assign _ (Table Byte _) _) -> j + Just (Reserve _ (Table Byte _) _) -> j Just _ -> (COPY A A) Nothing -> (COPY A A) checkInstr other = other @@ -57,8 +57,8 @@ consistentInitialTableSizes p@(Program decls routines) = in inconsistentTableSizes == 0 where - checkDecl (Reserve _ (ByteTable sz) []) acc = acc - checkDecl (Reserve _ (ByteTable sz) vals) acc = + checkDecl (Reserve _ (Table _ sz) []) acc = acc + checkDecl (Reserve _ (Table _ sz) vals) acc = case sz == (length vals) of True -> acc False -> acc + 1 diff --git a/src/SixtyPical/Emitter.hs b/src/SixtyPical/Emitter.hs index c024af3..5ec0074 100644 --- a/src/SixtyPical/Emitter.hs +++ b/src/SixtyPical/Emitter.hs @@ -30,10 +30,10 @@ emitDecl p (Reserve name typ [val]) | typ == Word = name ++ ": .word " ++ (show val) | typ == Vector = name ++ ": .word " ++ (show val) -emitDecl p (Reserve name (ByteTable size) []) = +emitDecl p (Reserve name (Table Byte size) []) = ".space " ++ name ++ " " ++ (show size) -emitDecl p (Reserve name (ByteTable size) vals) = +emitDecl p (Reserve name (Table Byte size) vals) = name ++ ": .byte " ++ (showList vals) where showList [] = "" @@ -92,11 +92,11 @@ emitInstr p r (COPY A Y) = "tay" emitInstr p r (COPY X A) = "txa" emitInstr p r (COPY Y A) = "tya" -emitInstr p r (COPY A (Indexed (NamedLocation (Just (ByteTable _)) label) X)) = "sta " ++ label ++ ", x" -emitInstr p r (COPY A (Indexed (NamedLocation (Just (ByteTable _)) label) Y)) = "sta " ++ label ++ ", y" +emitInstr p r (COPY A (Indexed (NamedLocation (Just (Table Byte _)) label) X)) = "sta " ++ label ++ ", x" +emitInstr p r (COPY A (Indexed (NamedLocation (Just (Table Byte _)) label) Y)) = "sta " ++ label ++ ", y" -emitInstr p r (COPY (Indexed (NamedLocation (Just (ByteTable _)) label) X) A) = "lda " ++ label ++ ", x" -emitInstr p r (COPY (Indexed (NamedLocation (Just (ByteTable _)) label) Y) A) = "lda " ++ label ++ ", y" +emitInstr p r (COPY (Indexed (NamedLocation (Just (Table Byte _)) label) X) A) = "lda " ++ label ++ ", x" +emitInstr p r (COPY (Indexed (NamedLocation (Just (Table Byte _)) label) Y) A) = "lda " ++ label ++ ", 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" diff --git a/src/SixtyPical/Model.hs b/src/SixtyPical/Model.hs index 933aa97..647e485 100644 --- a/src/SixtyPical/Model.hs +++ b/src/SixtyPical/Model.hs @@ -23,7 +23,7 @@ type LocationName = String data StorageType = Byte | Word | Vector - | ByteTable DataValue + | Table StorageType DataValue deriving (Show, Ord, Eq) data StorageLocation = A diff --git a/src/SixtyPical/Parser.hs b/src/SixtyPical/Parser.hs index 8ad3cdd..0f543cf 100644 --- a/src/SixtyPical/Parser.hs +++ b/src/SixtyPical/Parser.hs @@ -16,7 +16,7 @@ Decl ::= "reserve" StorageType LocationName [":" InitialValue] | "assign" StorageType LocationName Literal | "external" RoutineName Address. InitialValue ::= Literal | StringLiteral | "(" {Literal} ")". -StorageType ::= "byte" ["[" Literal "]"] | "word" | "vector". +StorageType ::= ("byte" | "word" | "vector") ["[" Literal "]"]. Routine ::= "routine" RoutineName ["outputs" "(" {LocationName} ")"] Block. Block ::= "{" {Decl} {Command} "}". Command ::= "if" Branch Block "else" Block @@ -99,20 +99,20 @@ storage s t = do nspaces return t -byte_table :: Parser StorageType -byte_table = do - string "byte" - nspaces +table :: StorageType -> Parser StorageType +table typ = do string "[" nspaces size <- literal_data_value string "]" nspaces - return $ ByteTable size + return $ Table typ size storage_type :: Parser StorageType -storage_type = (try $ byte_table) <|> (storage "byte" Byte) <|> - (storage "word" Word) <|> (storage "vector" Vector) +storage_type = do + typ <- (storage "byte" Byte) <|> (storage "word" Word) <|> + (storage "vector" Vector) + option typ (table typ) initial_value :: Parser [DataValue] initial_value = diff --git a/src/SixtyPical/Transformer.hs b/src/SixtyPical/Transformer.hs index 623a4dd..7e1f2f9 100644 --- a/src/SixtyPical/Transformer.hs +++ b/src/SixtyPical/Transformer.hs @@ -124,8 +124,8 @@ fillOutNamedLocationTypes p@(Program decls routines) = in case (typeRx == typeRy, typeRx, typeRy) of (True, _, _) -> constructor rx ry - (_, Byte, (ByteTable _)) -> constructor rx ry - (_, (ByteTable _), Byte) -> constructor rx ry + (_, Byte, (Table Byte _)) -> constructor rx ry + (_, (Table Byte _), Byte) -> constructor rx ry _ -> error ("incompatible types '" ++ (show typeRx) ++ "' and '" ++ (show typeRy) ++ "'") resolve (NamedLocation Nothing name) = case lookupDecl p name of