Commit cb53d461df3488f4f7b378696130eb57d6ad9e16 - SixtyPical

+0

-37

doc/Emitting.markdown less more

210	210	= .space frequencies 16
211	211	= .alias screen 1024
212	212
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

+3

-3

src/SixtyPical/Analyzer.hs less more

12	12	checkRoutines routines Map.empty
13	13	where
14	14	checkRoutines [] progCtx = progCtx
15		checkRoutines (rout@(Routine name outputs temps _) : routs) progCtx =
	15	checkRoutines (rout@(Routine name outputs _) : routs) progCtx =
16	16	let
17	17	routCtx = Map.empty
18	18	routAnalysis = checkRoutine rout progCtx routCtx

20	20	in
21	21	checkRoutines routs progCtx'
22	22
23		checkRoutine (Routine name outputs temps instrs) progCtx routCtx =
	23	checkRoutine (Routine name outputs instrs) progCtx routCtx =
24	24	checkBlock name instrs progCtx routCtx
25	25
26	26	checkBlock nm [] progCtx routCtx = routCtx

102	102	-- JSR'ed to (immediately previously) -- and merge them to create a new
103	103	-- context for the current routine.
104	104	--
105		mergeRoutCtxs nm routCtx calledRoutCtx calledRout@(Routine name outputs temps _) =
	105	mergeRoutCtxs nm routCtx calledRoutCtx calledRout@(Routine name outputs _) =
106	106	let
107	107	-- go through all the Usages in the calledRoutCtx
108	108	-- insert any that were updated, into routCtx

+2

-2

src/SixtyPical/Checker.hs less more

71	71	((routine':routines'), iid'')
72	72
73	73	numberRoutineLoops :: Routine -> InternalID -> (Routine, InternalID)
74		numberRoutineLoops (Routine name outputs temps instrs) iid =
	74	numberRoutineLoops (Routine name outputs instrs) iid =
75	75	let
76	76	(instrs', iid') = numberBlockLoops instrs iid
77	77	in
78		((Routine name outputs temps instrs'), iid')
	78	((Routine name outputs instrs'), iid')
79	79
80	80	numberBlockLoops :: [Instruction] -> InternalID -> ([Instruction], InternalID)
81	81	numberBlockLoops [] iid = ([], iid)

+1

-1

src/SixtyPical/Context.hs less more

64	64	ppRoutines program [] = return ()
65	65	ppRoutines program ((name, routCtx):rest) =
66	66	let
67		Just (Routine rname outputs temps _) = lookupRoutine program name
	67	Just (Routine rname outputs _) = lookupRoutine program name
68	68	in do
69	69	putStrLn (rname ++ " (" ++ (show outputs) ++ ")")
70	70	ppRoutine routCtx

+3

-3

src/SixtyPical/Emitter.hs less more

7	7
8	8	emitProgram p@(Program decls routines) =
9	9	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
12	12	initializedDecls = filter (\d -> isInitializedDecl d) decls
13	13	uninitializedDecls = filter (\d -> not $ isInitializedDecl d) decls
14	14	in

46	46	emitRoutines p (rout:routs) =
47	47	emitRoutine p rout ++ "\n" ++ emitRoutines p routs
48	48
49		emitRoutine p r@(Routine name _ _ instrs) =
	49	emitRoutine p r@(Routine name _ instrs) =
50	50	name ++ ":\n" ++ emitInstrs p r instrs ++ " rts\n"
51	51
52	52	emitInstrs _ _ [] = ""

+6

-10

src/SixtyPical/Model.hs less more

80	80	\| NOP
81	81	deriving (Show, Ord, Eq)
82	82
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]
88	84	deriving (Show, Ord, Eq)
89	85
90	86	data Program = Program [Decl] [Routine]

96	92	programSummary p@(Program decls routs) =
97	93	show ((length $ show p) < 99999)
98	94
99		getRoutineName (Routine name _ _ _) = name
	95	getRoutineName (Routine name _ _) = name
100	96
101	97	getDeclLocationName (Assign name _ _) = name
102	98	getDeclLocationName (Reserve name _ _) = name

136	132	mapBlock = map
137	133
138	134	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)
141	137
142	138	mapRoutines :: (Instruction -> Instruction) -> [Routine] -> [Routine]
143	139	mapRoutines f [] = []

154	150	foldBlock = foldr
155	151
156	152	foldRoutine :: (Instruction -> a -> a) -> a -> Routine -> a
157		foldRoutine f a (Routine name outputs temps instrs) =
	153	foldRoutine f a (Routine name outputs instrs) =
158	154	foldBlock f a instrs
159	155
160	156	foldRoutines :: (Instruction -> a -> a) -> a -> [Routine] -> a

183	179	lookupRoutine' routines name
184	180
185	181	lookupRoutine' [] _ = Nothing
186		lookupRoutine' (rout@(Routine rname _ _ _):routs) name
	182	lookupRoutine' (rout@(Routine rname _ _):routs) name
187	183	\| rname == name = Just rout
188	184	\| otherwise = lookupRoutine' routs name

+11

-21

src/SixtyPical/Parser.hs less more

9	9
10	10	{-
11	11
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
21	20	\| "lda" (LocationName \| Immediate)
22	21	\| "ldx" (LocationName \| Immediate)
23	22	\| "ldy" (LocationName \| Immediate)

78	77	assign = do
79	78	string "assign"
80	79	nspaces
81		typ <- storage_type
	80	sz <- storage_type
82	81	name <- location_name
83	82	addr <- literal_address
84		return $ Assign name typ addr
	83	return $ Assign name sz addr
85	84
86	85	external :: Parser Decl
87	86	external = do

91	90	addr <- literal_address
92	91	return $ External name addr
93	92
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
102	93	storage :: String -> StorageType -> Parser StorageType
103	94	storage s t = do
104	95	string s

126	117	nspaces
127	118	name <- routineName
128	119	outputs <- (try routine_outputs <\|> return [])
129		temps <- many temporary
130	120	instrs <- block
131		return (Routine name outputs temps instrs)
	121	return (Routine name outputs instrs)
132	122
133	123	routine_outputs :: Parser [StorageLocation]
134	124	routine_outputs = do