Commit f43612e6169d928faeabcf349ee3e6ef679bee24 - SixtyPical

+37

-0

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 _) : routs) progCtx =
	15	checkRoutines (rout@(Routine name outputs temps _) : 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 instrs) progCtx routCtx =
	23	checkRoutine (Routine name outputs temps 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 _) =
	105	mergeRoutCtxs nm routCtx calledRoutCtx calledRout@(Routine name outputs temps _) =
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 instrs) iid =
	74	numberRoutineLoops (Routine name outputs temps instrs) iid =
75	75	let
76	76	(instrs', iid') = numberBlockLoops instrs iid
77	77	in
78		((Routine name outputs instrs'), iid')
	78	((Routine name outputs temps 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 _) = lookupRoutine program name
	67	Just (Routine rname outputs temps _) = 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 _ _ [] = ""

+10

-6

src/SixtyPical/Model.hs less more

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

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

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

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

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

+21

-11

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

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

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

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