mirror of
https://github.com/catseye/SixtyPical.git
synced 2024-11-26 14:49:15 +00:00
Parse (at the very least) decls for word and vector tables.
This commit is contained in:
parent
cac23cc7d0
commit
16d6a54fb5
@ -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
|
||||
| lda #$00
|
||||
| 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
|
||||
|
@ -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
|
||||
|
@ -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"
|
||||
|
@ -23,7 +23,7 @@ type LocationName = String
|
||||
data StorageType = Byte
|
||||
| Word
|
||||
| Vector
|
||||
| ByteTable DataValue
|
||||
| Table StorageType DataValue
|
||||
deriving (Show, Ord, Eq)
|
||||
|
||||
data StorageLocation = A
|
||||
|
@ -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 =
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user