git @ Cat's Eye Technologies SixtyPical / aaec12d
Initial, awkward support for block-level declarations, including a failing test. Cat's Eye Technologies 7 years ago
7 changed file(s) with 108 addition(s) and 46 deletion(s). Raw diff Collapse all Expand all
8989 (Same should apply for `repeat` and `with` and, really, many other cases
9090 which there just aren't enough test cases for yet.)
9191
92 Declarations can have block scope. Such declarations may only be used within
93 the block in which they are declared. `reserve`d storage inside a block is not,
94 however, like a local variable (or `auto` in C); rather, it is more like a
95 `static` in C, except the value at that address is not guaranteed to be
96 retained between invokations of the block. This is intended to be used for
97 temporary storage. In addition, if analysis of the call graph indicates that
98 two such temporary addresses are never used simultaneously, they may be merged
99 to the same address. (This is, however, not yet implemented, and may not be
100 implemented for a while.)
101
92102 ### "It's a Partial Solution" ###
93103
94104 SixtyPical does not attempt to force your typed, abstractly interpreted
120130 Falderal literate test suites. If you have Falderal installed, you can run
121131 the tests with `./test.sh`.)
122132
123 Ideas
124 -----
125
126 These aren't implemented yet:
127
128 * Inside a routine, an address may be declared with `temporary`. This is like
129 `static` in C, except the value at that address is not guaranteed to be
130 retained between invokations of the routine. Such addresses may only be used
131 within the routine where they are declared. If analysis indicates that two
132 temporary addresses are never used simultaneously, they may be merged
133 to the same address.
134
135133 Internals
136134 ---------
137135
210210 = .space frequencies 16
211211 = .alias screen 1024
212212
213 Temporary storage, in the form of block-local declarations. Note that these
214 temporaries are not unioned yet, but they could be.
215
216 | routine a {
217 | reserve byte foo
218 | reserve word bar
219 | lda foo
220 | sta >bar
221 | }
222 | routine b {
223 | reserve byte baz
224 | reserve word quuz
225 | lda baz
226 | sta <quuz
227 | }
228 | routine main {
229 | jsr a
230 | jsr b
231 | }
232 = main:
233 = jsr a
234 = jsr b
235 = rts
236 = a:
237 = lda _temp_1
238 = sta _temp_2+1
239 = rts
240 = b:
241 = lda _temp_3
242 = sta _temp_4
243 = rts
244 =
245 = .data
246 = .space _temp_1 1
247 = .space _temp_2 2
248 = .space _temp_3 1
249 = .space _temp_4 2
2222
2323 checkRoutine (Routine name outputs instrs) progCtx routCtx =
2424 checkBlock name instrs progCtx routCtx
25
26 checkBlock nm (Block decls instrs) progCtx routCtx =
27 checkInstrs nm instrs progCtx routCtx
2528
26 checkBlock nm [] progCtx routCtx = routCtx
27 checkBlock nm (instr:instrs) progCtx routCtx =
29 checkInstrs nm [] progCtx routCtx = routCtx
30 checkInstrs nm (instr:instrs) progCtx routCtx =
2831 let
2932 routCtx' = checkInstr nm instr progCtx routCtx
3033 in
31 checkBlock nm instrs progCtx routCtx'
34 checkInstrs nm instrs progCtx routCtx'
3235
3336 -- -- -- -- -- -- -- -- -- -- -- --
3437
7171 ((routine':routines'), iid'')
7272
7373 numberRoutineLoops :: Routine -> InternalID -> (Routine, InternalID)
74 numberRoutineLoops (Routine name outputs instrs) iid =
75 let
76 (instrs', iid') = numberBlockLoops instrs iid
77 in
78 ((Routine name outputs instrs'), iid')
79
80 numberBlockLoops :: [Instruction] -> InternalID -> ([Instruction], InternalID)
81 numberBlockLoops [] iid = ([], iid)
82 numberBlockLoops (instr:instrs) iid =
74 numberRoutineLoops (Routine name outputs block) iid =
75 let
76 (block', iid') = numberBlockLoops block iid
77 in
78 ((Routine name outputs block'), iid')
79
80 numberBlockLoops :: Block -> InternalID -> (Block, InternalID)
81 numberBlockLoops block iid =
82 let
83 (Block decls instrs) = block
84 (instrs', iid') = numberInstrsLoops instrs iid
85 block' = Block decls instrs'
86 in
87 (block', iid')
88
89 numberInstrsLoops :: [Instruction] -> InternalID -> ([Instruction], InternalID)
90 numberInstrsLoops [] iid = ([], iid)
91 numberInstrsLoops (instr:instrs) iid =
8392 let
8493 (instr', iid') = numberInstruction instr iid
85 (instrs', iid'') = numberBlockLoops instrs iid'
94 (instrs', iid'') = numberInstrsLoops instrs iid'
8695 in
8796 ((instr':instrs'), iid'')
8897
4646 emitRoutines p (rout:routs) =
4747 emitRoutine p rout ++ "\n" ++ emitRoutines p routs
4848
49 emitRoutine p r@(Routine name _ instrs) =
50 name ++ ":\n" ++ emitInstrs p r instrs ++ " rts\n"
49 emitRoutine p r@(Routine name _ block) =
50 name ++ ":\n" ++ emitBlock p r block ++ " rts\n"
51
52 emitBlock p r (Block decls instrs) =
53 emitInstrs p r instrs
5154
5255 emitInstrs _ _ [] = ""
5356 emitInstrs p r (instr:instrs) =
160163
161164 emitInstr p r (IF iid branch b1 b2) =
162165 (show branch) ++ " _label_" ++ (show iid) ++ "\n" ++
163 emitInstrs p r b2 ++
166 emitBlock p r b2 ++
164167 " jmp _past_" ++ (show iid) ++ "\n" ++
165168 "_label_" ++ (show iid) ++ ":\n" ++
166 emitInstrs p r b1 ++
169 emitBlock p r b1 ++
167170 "_past_" ++ (show iid) ++ ":"
168171
169172 emitInstr p r (REPEAT iid branch blk) =
170173 "\n_repeat_" ++ (show iid) ++ ":\n" ++
171 emitInstrs p r blk ++
174 emitBlock p r blk ++
172175 " " ++ (show branch) ++ " _repeat_" ++ (show iid)
173176
174177 emitInstr p r (WITH SEI blk) =
175178 "sei\n" ++
176 emitInstrs p r blk ++
179 emitBlock p r blk ++
177180 " cli"
178181
179182 emitInstr p r (WITH (PUSH A) blk) =
180183 "pha\n" ++
181 emitInstrs p r blk ++
184 emitBlock p r blk ++
182185 " pla"
183186
184187 emitInstr p r (WITH (PUSH AllFlags) blk) =
185188 "php\n" ++
186 emitInstrs p r blk ++
189 emitBlock p r blk ++
187190 " plp"
188191
189192 emitInstr p r (COPYROUTINE src (NamedLocation (Just Vector) dst)) =
5959 | PUSH StorageLocation
6060 deriving (Show, Ord, Eq)
6161
62 data Block = Block [Decl] [Instruction]
63 deriving (Show, Ord, Eq)
64
6265 data Instruction = COPY StorageLocation StorageLocation
6366 | CMP StorageLocation StorageLocation
6467 | ADD StorageLocation StorageLocation
7275 | JSR RoutineName
7376 -- | JSRVECTOR StorageLocation
7477 | JMPVECTOR StorageLocation
75 | IF InternalID Branch [Instruction] [Instruction]
76 | REPEAT InternalID Branch [Instruction]
78 | IF InternalID Branch Block Block
79 | REPEAT InternalID Branch Block
7780 | DELTA StorageLocation DataValue
78 | WITH WithInstruction [Instruction]
81 | WITH WithInstruction Block
7982 | COPYROUTINE RoutineName StorageLocation
8083 | NOP
8184 deriving (Show, Ord, Eq)
8285
83 data Routine = Routine RoutineName [StorageLocation] [Instruction]
86 data Routine = Routine RoutineName [StorageLocation] Block
8487 deriving (Show, Ord, Eq)
8588
8689 data Program = Program [Decl] [Routine]
128131
129132 --
130133
131 mapBlock :: (Instruction -> Instruction) -> [Instruction] -> [Instruction]
132 mapBlock = map
134 mapInstrs :: (Instruction -> Instruction) -> [Instruction] -> [Instruction]
135 mapInstrs = map
136
137 mapBlock :: (Instruction -> Instruction) -> Block -> Block
138 mapBlock f (Block decls instrs) =
139 Block decls (mapInstrs f instrs)
133140
134141 mapRoutine :: (Instruction -> Instruction) -> Routine -> Routine
135 mapRoutine f (Routine name outputs instrs) =
136 Routine name outputs (mapBlock f instrs)
142 mapRoutine f (Routine name outputs block) =
143 Routine name outputs (mapBlock f block)
137144
138145 mapRoutines :: (Instruction -> Instruction) -> [Routine] -> [Routine]
139146 mapRoutines f [] = []
146153
147154 --
148155
149 foldBlock :: (Instruction -> a -> a) -> a -> [Instruction] -> a
150 foldBlock = foldr
156 foldInstrs :: (Instruction -> a -> a) -> a -> [Instruction] -> a
157 foldInstrs = foldr
158
159 foldBlock :: (Instruction -> a -> a) -> a -> Block -> a
160 foldBlock f a (Block decls instrs) =
161 foldInstrs f a instrs
151162
152163 foldRoutine :: (Instruction -> a -> a) -> a -> Routine -> a
153164 foldRoutine f a (Routine name outputs instrs) =
1515 | "external" RoutineName Address.
1616 StorageType := "byte" ["[" Literal "]"] | "word" | "vector".
1717 Routine := "routine" RoutineName ["outputs" "(" {LocationName} ")"] Block.
18 Block := "{" {Command} "}".
18 Block := "{" {Decl} {Command} "}".
1919 Command := "if" Branch Block "else" Block
2020 | "lda" (LocationName | Immediate)
2121 | "ldx" (LocationName | Immediate)
133133
134134 location = (try explicit_register <|> named_location)
135135
136 block :: Parser [Instruction]
136 block :: Parser Block
137137 block = do
138138 string "{"
139139 nspaces
140 ds <- many decl
140141 cs <- many command
141142 string "}"
142143 nspaces
143 return cs
144 return (Block ds cs)
144145
145146 -- -- -- -- -- -- commands -- -- -- -- --
146147