git @ Cat's Eye Technologies SixtyPical / cb53d46
Backed out changeset fddaf1476975. Going to do this differently. Cat's Eye Technologies 7 years ago
7 changed file(s) with 26 addition(s) and 77 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 temps _) : routs) progCtx =
15 checkRoutines (rout@(Routine name outputs _) : 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 temps instrs) progCtx routCtx =
23 checkRoutine (Routine name outputs 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 temps _) =
105 mergeRoutCtxs nm routCtx calledRoutCtx calledRout@(Routine name outputs _) =
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 temps instrs) iid =
74 numberRoutineLoops (Routine name outputs instrs) iid =
7575 let
7676 (instrs', iid') = numberBlockLoops instrs iid
7777 in
78 ((Routine name outputs temps instrs'), iid')
78 ((Routine name outputs 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 temps _) = lookupRoutine program name
67 Just (Routine rname outputs _) = 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 Temporary = Temporary InternalID LocationName StorageType
84 deriving (Show, Ord, Eq)
85
86 -- name outputs temporaries body
87 data Routine = Routine RoutineName [StorageLocation] [Temporary] [Instruction]
83 data Routine = Routine RoutineName [StorageLocation] [Instruction]
8884 deriving (Show, Ord, Eq)
8985
9086 data Program = Program [Decl] [Routine]
9692 programSummary p@(Program decls routs) =
9793 show ((length $ show p) < 99999)
9894
99 getRoutineName (Routine name _ _ _) = name
95 getRoutineName (Routine name _ _) = name
10096
10197 getDeclLocationName (Assign name _ _) = name
10298 getDeclLocationName (Reserve name _ _) = name
136132 mapBlock = map
137133
138134 mapRoutine :: (Instruction -> Instruction) -> Routine -> Routine
139 mapRoutine f (Routine name outputs temps instrs) =
140 Routine name outputs temps (mapBlock f instrs)
135 mapRoutine f (Routine name outputs instrs) =
136 Routine name outputs (mapBlock f instrs)
141137
142138 mapRoutines :: (Instruction -> Instruction) -> [Routine] -> [Routine]
143139 mapRoutines f [] = []
154150 foldBlock = foldr
155151
156152 foldRoutine :: (Instruction -> a -> a) -> a -> Routine -> a
157 foldRoutine f a (Routine name outputs temps instrs) =
153 foldRoutine f a (Routine name outputs instrs) =
158154 foldBlock f a instrs
159155
160156 foldRoutines :: (Instruction -> a -> a) -> a -> [Routine] -> a
183179 lookupRoutine' routines name
184180
185181 lookupRoutine' [] _ = Nothing
186 lookupRoutine' (rout@(Routine rname _ _ _):routs) name
182 lookupRoutine' (rout@(Routine rname _ _):routs) name
187183 | rname == name = Just rout
188184 | 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 ::= "{" {Temporary} {Command} "}".
19 Temporary ::= "temporary" StorageType LocationName
20 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 := "{" {Command} "}".
19 Command := "if" Branch Block "else" Block
2120 | "lda" (LocationName | Immediate)
2221 | "ldx" (LocationName | Immediate)
2322 | "ldy" (LocationName | Immediate)
7877 assign = do
7978 string "assign"
8079 nspaces
81 typ <- storage_type
80 sz <- storage_type
8281 name <- location_name
8382 addr <- literal_address
84 return $ Assign name typ addr
83 return $ Assign name sz addr
8584
8685 external :: Parser Decl
8786 external = do
9190 addr <- literal_address
9291 return $ External name addr
9392
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
10293 storage :: String -> StorageType -> Parser StorageType
10394 storage s t = do
10495 string s
126117 nspaces
127118 name <- routineName
128119 outputs <- (try routine_outputs <|> return [])
129 temps <- many temporary
130120 instrs <- block
131 return (Routine name outputs temps instrs)
121 return (Routine name outputs instrs)
132122
133123 routine_outputs :: Parser [StorageLocation]
134124 routine_outputs = do