git @ Cat's Eye Technologies SixtyPical / f43612e
Initial, awkward support for temporaries, with failing test. Cat's Eye Technologies 7 years ago
7 changed file(s) with 77 addition(s) and 26 deletion(s). Raw diff Collapse all Expand all
210210 = .space frequencies 16
211211 = .alias screen 1024
212212
213 Temporary storage. Note that these temporaries are not unioned yet, but
214 they could be.
215
216 | routine a
217 | temporary byte foo
218 | temporary word bar {
219 | lda foo
220 | sta >bar
221 | }
222 | routine b
223 | temporary byte baz
224 | temporary 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
1212 checkRoutines routines Map.empty
1313 where
1414 checkRoutines [] progCtx = progCtx
15 checkRoutines (rout@(Routine name outputs _) : routs) progCtx =
15 checkRoutines (rout@(Routine name outputs temps _) : routs) progCtx =
1616 let
1717 routCtx = Map.empty
1818 routAnalysis = checkRoutine rout progCtx routCtx
2020 in
2121 checkRoutines routs progCtx'
2222
23 checkRoutine (Routine name outputs instrs) progCtx routCtx =
23 checkRoutine (Routine name outputs temps instrs) progCtx routCtx =
2424 checkBlock name instrs progCtx routCtx
2525
2626 checkBlock nm [] progCtx routCtx = routCtx
102102 -- JSR'ed to (immediately previously) -- and merge them to create a new
103103 -- context for the current routine.
104104 --
105 mergeRoutCtxs nm routCtx calledRoutCtx calledRout@(Routine name outputs _) =
105 mergeRoutCtxs nm routCtx calledRoutCtx calledRout@(Routine name outputs temps _) =
106106 let
107107 -- go through all the Usages in the calledRoutCtx
108108 -- insert any that were updated, into routCtx
7171 ((routine':routines'), iid'')
7272
7373 numberRoutineLoops :: Routine -> InternalID -> (Routine, InternalID)
74 numberRoutineLoops (Routine name outputs instrs) iid =
74 numberRoutineLoops (Routine name outputs temps instrs) iid =
7575 let
7676 (instrs', iid') = numberBlockLoops instrs iid
7777 in
78 ((Routine name outputs instrs'), iid')
78 ((Routine name outputs temps instrs'), iid')
7979
8080 numberBlockLoops :: [Instruction] -> InternalID -> ([Instruction], InternalID)
8181 numberBlockLoops [] iid = ([], iid)
6464 ppRoutines program [] = return ()
6565 ppRoutines program ((name, routCtx):rest) =
6666 let
67 Just (Routine rname outputs _) = lookupRoutine program name
67 Just (Routine rname outputs temps _) = lookupRoutine program name
6868 in do
6969 putStrLn (rname ++ " (" ++ (show outputs) ++ ")")
7070 ppRoutine routCtx
77
88 emitProgram p@(Program decls routines) =
99 let
10 mains = filter (\(Routine name _ _) -> name == "main") routines
11 allElse = filter (\(Routine name _ _) -> name /= "main") routines
10 mains = filter (\(Routine name _ _ _) -> name == "main") routines
11 allElse = filter (\(Routine name _ _ _) -> name /= "main") routines
1212 initializedDecls = filter (\d -> isInitializedDecl d) decls
1313 uninitializedDecls = filter (\d -> not $ isInitializedDecl d) decls
1414 in
4646 emitRoutines p (rout:routs) =
4747 emitRoutine p rout ++ "\n" ++ emitRoutines p routs
4848
49 emitRoutine p r@(Routine name _ instrs) =
49 emitRoutine p r@(Routine name _ _ instrs) =
5050 name ++ ":\n" ++ emitInstrs p r instrs ++ " rts\n"
5151
5252 emitInstrs _ _ [] = ""
8080 | NOP
8181 deriving (Show, Ord, Eq)
8282
83 data Routine = Routine RoutineName [StorageLocation] [Instruction]
83 data Temporary = Temporary InternalID LocationName StorageType
84 deriving (Show, Ord, Eq)
85
86 -- name outputs temporaries body
87 data Routine = Routine RoutineName [StorageLocation] [Temporary] [Instruction]
8488 deriving (Show, Ord, Eq)
8589
8690 data Program = Program [Decl] [Routine]
9296 programSummary p@(Program decls routs) =
9397 show ((length $ show p) < 99999)
9498
95 getRoutineName (Routine name _ _) = name
99 getRoutineName (Routine name _ _ _) = name
96100
97101 getDeclLocationName (Assign name _ _) = name
98102 getDeclLocationName (Reserve name _ _) = name
132136 mapBlock = map
133137
134138 mapRoutine :: (Instruction -> Instruction) -> Routine -> Routine
135 mapRoutine f (Routine name outputs instrs) =
136 Routine name outputs (mapBlock f instrs)
139 mapRoutine f (Routine name outputs temps instrs) =
140 Routine name outputs temps (mapBlock f instrs)
137141
138142 mapRoutines :: (Instruction -> Instruction) -> [Routine] -> [Routine]
139143 mapRoutines f [] = []
150154 foldBlock = foldr
151155
152156 foldRoutine :: (Instruction -> a -> a) -> a -> Routine -> a
153 foldRoutine f a (Routine name outputs instrs) =
157 foldRoutine f a (Routine name outputs temps instrs) =
154158 foldBlock f a instrs
155159
156160 foldRoutines :: (Instruction -> a -> a) -> a -> [Routine] -> a
179183 lookupRoutine' routines name
180184
181185 lookupRoutine' [] _ = Nothing
182 lookupRoutine' (rout@(Routine rname _ _):routs) name
186 lookupRoutine' (rout@(Routine rname _ _ _):routs) name
183187 | rname == name = Just rout
184188 | otherwise = lookupRoutine' routs 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 := "{" {Command} "}".
19 Command := "if" Branch Block "else" Block
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 ::= "{" {Temporary} {Command} "}".
19 Temporary ::= "temporary" StorageType LocationName
20 Command ::= "if" Branch Block "else" Block
2021 | "lda" (LocationName | Immediate)
2122 | "ldx" (LocationName | Immediate)
2223 | "ldy" (LocationName | Immediate)
7778 assign = do
7879 string "assign"
7980 nspaces
80 sz <- storage_type
81 typ <- storage_type
8182 name <- location_name
8283 addr <- literal_address
83 return $ Assign name sz addr
84 return $ Assign name typ addr
8485
8586 external :: Parser Decl
8687 external = do
9091 addr <- literal_address
9192 return $ External name addr
9293
94 temporary :: Parser Temporary
95 temporary = do
96 string "temporary"
97 nspaces
98 typ <- storage_type
99 name <- location_name
100 return $ Temporary 0 name typ
101
93102 storage :: String -> StorageType -> Parser StorageType
94103 storage s t = do
95104 string s
117126 nspaces
118127 name <- routineName
119128 outputs <- (try routine_outputs <|> return [])
129 temps <- many temporary
120130 instrs <- block
121 return (Routine name outputs instrs)
131 return (Routine name outputs temps instrs)
122132
123133 routine_outputs :: Parser [StorageLocation]
124134 routine_outputs = do