git @ Cat's Eye Technologies SixtyPical / 16d6a54
Parse (at the very least) decls for word and vector tables. Cat's Eye Technologies 8 years ago
6 changed file(s) with 38 addition(s) and 22 deletion(s). Raw diff Collapse all Expand all
127127 | sta table, y
128128 | }
129129 ? 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
130146
131147 An address may be declared with `locate`, which is like `.alias` in an
132148 assembler, with the understanding that the value will be treated "like an
3030 where
3131 checkInstr j@(COPY _ (Indexed (NamedLocation sz g) reg)) =
3232 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
3535 Just _ -> (COPY A A)
3636 Nothing -> (COPY A A)
3737 checkInstr other = other
5656 in
5757 inconsistentTableSizes == 0
5858 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 =
6161 case sz == (length vals) of
6262 True -> acc
6363 False -> acc + 1
2929 | typ == Word = name ++ ": .word " ++ (show val)
3030 | typ == Vector = name ++ ": .word " ++ (show val)
3131
32 emitDecl p (Reserve name (ByteTable size) []) =
32 emitDecl p (Reserve name (Table Byte size) []) =
3333 ".space " ++ name ++ " " ++ (show size)
3434
35 emitDecl p (Reserve name (ByteTable size) vals) =
35 emitDecl p (Reserve name (Table Byte size) vals) =
3636 name ++ ": .byte " ++ (showList vals)
3737 where
3838 showList [] = ""
9191 emitInstr p r (COPY X A) = "txa"
9292 emitInstr p r (COPY Y A) = "tya"
9393
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"
9999
100100 emitInstr p r (COPY A (IndirectIndexed (NamedLocation st label) Y)) = "sta (" ++ label ++ "), y"
101101 emitInstr p r (COPY (IndirectIndexed (NamedLocation st label) Y) A) = "lda (" ++ label ++ "), y"
2222 data StorageType = Byte
2323 | Word
2424 | Vector
25 | ByteTable DataValue
25 | Table StorageType DataValue
2626 deriving (Show, Ord, Eq)
2727
2828 data StorageLocation = A
1515 | "assign" StorageType LocationName Literal
1616 | "external" RoutineName Address.
1717 InitialValue ::= Literal | StringLiteral | "(" {Literal} ")".
18 StorageType ::= "byte" ["[" Literal "]"] | "word" | "vector".
18 StorageType ::= ("byte" | "word" | "vector") ["[" Literal "]"].
1919 Routine ::= "routine" RoutineName ["outputs" "(" {LocationName} ")"] Block.
2020 Block ::= "{" {Decl} {Command} "}".
2121 Command ::= "if" Branch Block "else" Block
9898 nspaces
9999 return t
100100
101 byte_table :: Parser StorageType
102 byte_table = do
103 string "byte"
104 nspaces
101 table :: StorageType -> Parser StorageType
102 table typ = do
105103 string "["
106104 nspaces
107105 size <- literal_data_value
108106 string "]"
109107 nspaces
110 return $ ByteTable size
108 return $ Table typ size
111109
112110 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)
115115
116116 initial_value :: Parser [DataValue]
117117 initial_value =
123123 in
124124 case (typeRx == typeRy, typeRx, typeRy) of
125125 (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
128128 _ -> error ("incompatible types '" ++ (show typeRx) ++ "' and '" ++ (show typeRy) ++ "'")
129129 resolve (NamedLocation Nothing name) =
130130 case lookupDecl p name of