Parse (at the very least) decls for word and vector tables.
Cat's Eye Technologies
8 years ago
127 | 127 | | sta table, y |
128 | 128 | | } |
129 | 129 | ? initial table incorrect size |
130 | ||
131 | We can also define word and vector tables. These are each stored as two | |
132 | byte tables, one table of low bytes and one table of high bytes. | |
133 | ||
134 | | reserve word[100] words | |
135 | | reserve vector[100] vectors | |
136 | | routine main { | |
137 | | lda #$04 | |
138 | | sta <words | |
139 | | // sta <words, y | |
140 | | lda #$00 | |
141 | | sta >words | |
142 | | // sta >words, y | |
143 | | // copy routine main to vectors, y | |
144 | | } | |
145 | = True | |
130 | 146 | |
131 | 147 | An address may be declared with `locate`, which is like `.alias` in an |
132 | 148 | assembler, with the understanding that the value will be treated "like an |
30 | 30 | where |
31 | 31 | checkInstr j@(COPY _ (Indexed (NamedLocation sz g) reg)) = |
32 | 32 | case lookupDecl p g of |
33 | Just (Assign _ (ByteTable _) _) -> j | |
34 | Just (Reserve _ (ByteTable _) _) -> j | |
33 | Just (Assign _ (Table Byte _) _) -> j | |
34 | Just (Reserve _ (Table Byte _) _) -> j | |
35 | 35 | Just _ -> (COPY A A) |
36 | 36 | Nothing -> (COPY A A) |
37 | 37 | checkInstr other = other |
56 | 56 | in |
57 | 57 | inconsistentTableSizes == 0 |
58 | 58 | where |
59 | checkDecl (Reserve _ (ByteTable sz) []) acc = acc | |
60 | checkDecl (Reserve _ (ByteTable sz) vals) acc = | |
59 | checkDecl (Reserve _ (Table _ sz) []) acc = acc | |
60 | checkDecl (Reserve _ (Table _ sz) vals) acc = | |
61 | 61 | case sz == (length vals) of |
62 | 62 | True -> acc |
63 | 63 | False -> acc + 1 |
29 | 29 | | typ == Word = name ++ ": .word " ++ (show val) |
30 | 30 | | typ == Vector = name ++ ": .word " ++ (show val) |
31 | 31 | |
32 | emitDecl p (Reserve name (ByteTable size) []) = | |
32 | emitDecl p (Reserve name (Table Byte size) []) = | |
33 | 33 | ".space " ++ name ++ " " ++ (show size) |
34 | 34 | |
35 | emitDecl p (Reserve name (ByteTable size) vals) = | |
35 | emitDecl p (Reserve name (Table Byte size) vals) = | |
36 | 36 | name ++ ": .byte " ++ (showList vals) |
37 | 37 | where |
38 | 38 | showList [] = "" |
91 | 91 | emitInstr p r (COPY X A) = "txa" |
92 | 92 | emitInstr p r (COPY Y A) = "tya" |
93 | 93 | |
94 | emitInstr p r (COPY A (Indexed (NamedLocation (Just (ByteTable _)) label) X)) = "sta " ++ label ++ ", x" | |
95 | emitInstr p r (COPY A (Indexed (NamedLocation (Just (ByteTable _)) label) Y)) = "sta " ++ label ++ ", y" | |
96 | ||
97 | emitInstr p r (COPY (Indexed (NamedLocation (Just (ByteTable _)) label) X) A) = "lda " ++ label ++ ", x" | |
98 | emitInstr p r (COPY (Indexed (NamedLocation (Just (ByteTable _)) label) Y) A) = "lda " ++ label ++ ", y" | |
94 | emitInstr p r (COPY A (Indexed (NamedLocation (Just (Table Byte _)) label) X)) = "sta " ++ label ++ ", x" | |
95 | emitInstr p r (COPY A (Indexed (NamedLocation (Just (Table Byte _)) label) Y)) = "sta " ++ label ++ ", y" | |
96 | ||
97 | emitInstr p r (COPY (Indexed (NamedLocation (Just (Table Byte _)) label) X) A) = "lda " ++ label ++ ", x" | |
98 | emitInstr p r (COPY (Indexed (NamedLocation (Just (Table Byte _)) label) Y) A) = "lda " ++ label ++ ", y" | |
99 | 99 | |
100 | 100 | emitInstr p r (COPY A (IndirectIndexed (NamedLocation st label) Y)) = "sta (" ++ label ++ "), y" |
101 | 101 | emitInstr p r (COPY (IndirectIndexed (NamedLocation st label) Y) A) = "lda (" ++ label ++ "), y" |
22 | 22 | data StorageType = Byte |
23 | 23 | | Word |
24 | 24 | | Vector |
25 | | ByteTable DataValue | |
25 | | Table StorageType DataValue | |
26 | 26 | deriving (Show, Ord, Eq) |
27 | 27 | |
28 | 28 | data StorageLocation = A |
15 | 15 | | "assign" StorageType LocationName Literal |
16 | 16 | | "external" RoutineName Address. |
17 | 17 | InitialValue ::= Literal | StringLiteral | "(" {Literal} ")". |
18 | StorageType ::= "byte" ["[" Literal "]"] | "word" | "vector". | |
18 | StorageType ::= ("byte" | "word" | "vector") ["[" Literal "]"]. | |
19 | 19 | Routine ::= "routine" RoutineName ["outputs" "(" {LocationName} ")"] Block. |
20 | 20 | Block ::= "{" {Decl} {Command} "}". |
21 | 21 | Command ::= "if" Branch Block "else" Block |
98 | 98 | nspaces |
99 | 99 | return t |
100 | 100 | |
101 | byte_table :: Parser StorageType | |
102 | byte_table = do | |
103 | string "byte" | |
104 | nspaces | |
101 | table :: StorageType -> Parser StorageType | |
102 | table typ = do | |
105 | 103 | string "[" |
106 | 104 | nspaces |
107 | 105 | size <- literal_data_value |
108 | 106 | string "]" |
109 | 107 | nspaces |
110 | return $ ByteTable size | |
108 | return $ Table typ size | |
111 | 109 | |
112 | 110 | storage_type :: Parser StorageType |
113 | storage_type = (try $ byte_table) <|> (storage "byte" Byte) <|> | |
114 | (storage "word" Word) <|> (storage "vector" Vector) | |
111 | storage_type = do | |
112 | typ <- (storage "byte" Byte) <|> (storage "word" Word) <|> | |
113 | (storage "vector" Vector) | |
114 | option typ (table typ) | |
115 | 115 | |
116 | 116 | initial_value :: Parser [DataValue] |
117 | 117 | initial_value = |
123 | 123 | in |
124 | 124 | case (typeRx == typeRy, typeRx, typeRy) of |
125 | 125 | (True, _, _) -> constructor rx ry |
126 | (_, Byte, (ByteTable _)) -> constructor rx ry | |
127 | (_, (ByteTable _), Byte) -> constructor rx ry | |
126 | (_, Byte, (Table Byte _)) -> constructor rx ry | |
127 | (_, (Table Byte _), Byte) -> constructor rx ry | |
128 | 128 | _ -> error ("incompatible types '" ++ (show typeRx) ++ "' and '" ++ (show typeRy) ++ "'") |
129 | 129 | resolve (NamedLocation Nothing name) = |
130 | 130 | case lookupDecl p name of |