git @ Cat's Eye Technologies SixtyPical / 7a3b3b1
Initial values for reserved tables; checks length is right. Cat's Eye Technologies 7 years ago
7 changed file(s) with 124 addition(s) and 25 deletion(s). Raw diff Collapse all Expand all
154154 Falderal literate test suites. If you have Falderal installed, you can run
155155 the tests with `./test.sh`.)
156156
157 * [Checking](https://github.com/catseye/SixtyPical/blob/master/doc/Checking.markdown)
158 * [Analyzing](https://github.com/catseye/SixtyPical/blob/master/doc/Analyzing.markdown)
159 * [Emitting](https://github.com/catseye/SixtyPical/blob/master/doc/Emitting.markdown)
160 * [Instruction Support](https://github.com/catseye/SixtyPical/blob/master/doc/Instruction_Support.markdown)
161
157162 Internals
158163 ---------
159164
205210 TODO
206211 ----
207212
208 * Initial values for reserved tables
209213 * Character tables ("strings" to everybody else)
210214 * Addressing modes — indexed mode on more instructions
211215 * Rename and lift temporaries in nested blocks
7878 | dec lives
7979 | }
8080 = True
81
82 A byte table declared with `reserve` may be given an initial value consisting
83 of a sequence of bytes.
84
85 | reserve byte[4] table : (0 $40 $10 20)
86 | routine main {
87 | ldy #0
88 | lda table, y
89 | }
90 | routine died {
91 | sta table, y
92 | }
93 = True
94
95 A byte table declared with `reserve` may be given an initial value consisting
96 of a sequence of bytes represented as a character string.
97
98 | reserve byte[4] table : "What"
99 | routine main {
100 | ldy #0
101 | lda table, y
102 | }
103 | routine died {
104 | sta table, y
105 | }
106 = True
107
108 When a byte table declared with `reserve` is given an initial value consisting
109 of a sequence of bytes, it must be the same length as the table is declared.
110
111 | reserve byte[4] table : (0 $40 $10 20 60 70 90)
112 | routine main {
113 | ldy #0
114 | lda table, y
115 | }
116 | routine died {
117 | sta table, y
118 | }
119 ? initial table incorrect size
120
121 | reserve byte[4] table : "Hello, world!"
122 | routine main {
123 | ldy #0
124 | lda table, y
125 | }
126 | routine died {
127 | sta table, y
128 | }
129 ? initial table incorrect size
81130
82131 An address may be declared with `locate`, which is like `.alias` in an
83132 assembler, with the understanding that the value will be treated "like an
5050 False -> error ("undeclared routine '" ++ routName ++ "'") -- acc + 1
5151 checkInstr other acc = acc
5252
53 consistentInitialTableSizes p@(Program decls routines) =
54 let
55 inconsistentTableSizes = foldProgramDecls (checkDecl) 0 p
56 in
57 inconsistentTableSizes == 0
58 where
59 checkDecl (Reserve _ (ByteTable sz) []) acc = acc
60 checkDecl (Reserve _ (ByteTable sz) vals) acc =
61 case sz == (length vals) of
62 True -> acc
63 False -> acc + 1
64 checkDecl _ acc = acc
65
5366 -- - - - - - -
5467
5568 checkAndTransformProgram :: Program -> Maybe Program
5972 trueOrDie "duplicate location name" (noDuplicateDecls program) &&
6073 trueOrDie "duplicate routine name" (noDuplicateRoutines program) &&
6174 trueOrDie "undeclared routine" (noUseOfUndeclaredRoutines program) &&
62 trueOrDie "indexed access of non-table" (noIndexedAccessOfNonTables program)
75 trueOrDie "indexed access of non-table" (noIndexedAccessOfNonTables program) &&
76 trueOrDie "initial table incorrect size" (consistentInitialTableSizes program)
6377 then
6478 let
6579 program' = numberProgramLoops program
2424 emitDecl p decl ++ "\n" ++ emitDecls p decls
2525
2626 emitDecl p (Assign name _ addr) = ".alias " ++ name ++ " " ++ (show addr)
27 emitDecl p (Reserve name typ (Just val))
27 emitDecl p (Reserve name typ [val])
2828 | typ == Byte = name ++ ": .byte " ++ (show val)
2929 | typ == Word = name ++ ": .word " ++ (show val)
3030 | typ == Vector = name ++ ": .word " ++ (show val)
3131
32 emitDecl p (Reserve name (ByteTable size) Nothing) =
32 emitDecl p (Reserve name (ByteTable size) []) =
3333 ".space " ++ name ++ " " ++ (show size)
3434
35 emitDecl p (Reserve name typ Nothing)
35 emitDecl p (Reserve name (ByteTable size) vals) =
36 name ++ ": .byte " ++ (showList vals)
37 where
38 showList [] = ""
39 showList (val:vals) = (show val) ++ " " ++ (showList vals)
40
41 emitDecl p (Reserve name typ [])
3642 | typ == Byte = ".space " ++ name ++ " 1"
3743 | typ == Word = ".space " ++ name ++ " 2"
3844 | typ == Vector = ".space " ++ name ++ " 2"
4646 -- -- -- -- program model -- -- -- --
4747
4848 data Decl = Assign LocationName StorageType Address -- .alias
49 | Reserve LocationName StorageType (Maybe DataValue) -- .word, .byte
49 | Reserve LocationName StorageType [DataValue] -- .word, .byte
5050 | External RoutineName Address
5151 deriving (Show, Ord, Eq)
5252
108108 isLocationDecl _ = False
109109
110110 isInitializedDecl (Assign _ _ _) = False
111 isInitializedDecl (Reserve _ _ (Just _)) = True
112 isInitializedDecl (Reserve _ _ Nothing) = False
111 isInitializedDecl (Reserve _ _ (v:vs)) = True
112 isInitializedDecl (Reserve _ _ []) = False
113113
114114 declaredLocationNames (Program decls _) =
115115 map (getDeclLocationName) (filter (isLocationDecl) decls)
176176 foldProgramRoutines f a (Program decls routs) =
177177 foldRoutines f a routs
178178
179 foldDecls :: (Decl -> a -> a) -> a -> [Decl] -> a
180 foldDecls = foldr
181
182 foldProgramDecls :: (Decl -> a -> a) -> a -> Program -> a
183 foldProgramDecls f a (Program decls routs) =
184 foldDecls f a decls
185
179186 --
180187
181188 lookupDecl (Program decls _) name =
99
1010 {-
1111
12 Toplevel := {Decl} {Routine}.
13 Decl := "reserve" StorageType LocationName [":" Literal]
14 | "assign" StorageType LocationName Literal
15 | "external" RoutineName Address.
16 StorageType := "byte" ["[" Literal "]"] | "word" | "vector".
17 Routine := "routine" RoutineName ["outputs" "(" {LocationName} ")"] Block.
18 Block := "{" {Decl} {Command} "}".
19 Command := "if" Branch Block "else" Block
12 Toplevel ::= {Decl} {Routine}.
13 Decl ::= "reserve" StorageType LocationName [":" InitialValue]
14 | "assign" StorageType LocationName Literal
15 | "external" RoutineName Address.
16 InitialValue ::= Literal | StringLiteral | "(" {Literal} ")".
17 StorageType ::= "byte" ["[" Literal "]"] | "word" | "vector".
18 Routine ::= "routine" RoutineName ["outputs" "(" {LocationName} ")"] Block.
19 Block ::= "{" {Decl} {Command} "}".
20 Command ::= "if" Branch Block "else" Block
2021 | "lda" (LocationName | Immediate)
2122 | "ldx" (LocationName | Immediate)
2223 | "ldy" (LocationName | Immediate)
3031 | "jmp" LocationName
3132 | "jsr" RoutineName
3233 | "nop".
33 Branch := "bcc" | "bcs" | "beq" | "bmi" | "bne" | "bpl" | "bvc" | "bvs".
34 Branch ::= "bcc" | "bcs" | "beq" | "bmi" | "bne" | "bpl" | "bvc" | "bvs".
3435
3536 -}
3637
6768 nspaces
6869 sz <- storage_type
6970 name <- location_name
70 value <- option Nothing (do{ string ":";
71 nspaces;
72 x <- literal_data_value;
73 return $ Just x })
71 value <- option [] (do{ string ":";
72 nspaces;
73 x <- initial_value;
74 return x })
7475 return $ Reserve name sz value
7576
7677 assign :: Parser Decl
110111 storage_type :: Parser StorageType
111112 storage_type = (try $ byte_table) <|> (storage "byte" Byte) <|>
112113 (storage "word" Word) <|> (storage "vector" Vector)
114
115 initial_value :: Parser [DataValue]
116 initial_value =
117 data_value_list <|> single_literal_data_value
118 where
119 single_literal_data_value = do
120 a <- literal_data_value
121 return [a]
122
123 data_value_list = do
124 string "("
125 nspaces
126 a <- many literal_data_value
127 string ")"
128 nspaces
129 return a
130
131 -- -- --
113132
114133 routine :: Parser Routine
115134 routine = do
624643
625644 decimal_literal :: Parser Int
626645 decimal_literal = do
627 digits <- many digit
646 digits <- many1 digit
628647 nspaces
629648 return $ read digits
630649
160160 ((Routine name outputs block'):rest)
161161
162162 foldDeclsRenaming [] id block = (id, block)
163 foldDeclsRenaming ((Reserve name typ Nothing):decls) id block =
163 foldDeclsRenaming ((Reserve name typ []):decls) id block =
164164 let
165165 newName = "_temp_" ++ (show id)
166166 id' = id + 1
175175 substDeclName n1 n2 (Block decls instrs) =
176176 Block (map (s) decls) instrs
177177 where
178 s d@(Reserve name typ Nothing)
179 | name == n1 = (Reserve n2 typ Nothing)
178 s d@(Reserve name typ [])
179 | name == n1 = (Reserve n2 typ [])
180180 | otherwise = d
181181
182182