Commit aaec12d5e5e3abacd785030749494babc9ae251e - SixtyPical

+10

-12

README.markdown less more

89	89	(Same should apply for `repeat` and `with` and, really, many other cases
90	90	which there just aren't enough test cases for yet.)
91	91
	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
92	102	### "It's a Partial Solution" ###
93	103
94	104	SixtyPical does not attempt to force your typed, abstractly interpreted

120	130	Falderal literate test suites. If you have Falderal installed, you can run
121	131	the tests with `./test.sh`.)
122	132
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
135	133	Internals
136	134	---------
137	135

+37

-0

doc/Emitting.markdown less more

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

+6

-3

src/SixtyPical/Analyzer.hs less more

22	22
23	23	checkRoutine (Routine name outputs instrs) progCtx routCtx =
24	24	checkBlock name instrs progCtx routCtx
	25
	26	checkBlock nm (Block decls instrs) progCtx routCtx =
	27	checkInstrs nm instrs progCtx routCtx
25	28
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 =
28	31	let
29	32	routCtx' = checkInstr nm instr progCtx routCtx
30	33	in
31		checkBlock nm instrs progCtx routCtx'
	34	checkInstrs nm instrs progCtx routCtx'
32	35
33	36	-- -- -- -- -- -- -- -- -- -- -- --
34	37

+19

-10

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 =
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 =
83	92	let
84	93	(instr', iid') = numberInstruction instr iid
85		(instrs', iid'') = numberBlockLoops instrs iid'
	94	(instrs', iid'') = numberInstrsLoops instrs iid'
86	95	in
87	96	((instr':instrs'), iid'')
88	97

+11

-8

src/SixtyPical/Emitter.hs less more

46	46	emitRoutines p (rout:routs) =
47	47	emitRoutine p rout ++ "\n" ++ emitRoutines p routs
48	48
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
51	54
52	55	emitInstrs _ _ [] = ""
53	56	emitInstrs p r (instr:instrs) =

160	163
161	164	emitInstr p r (IF iid branch b1 b2) =
162	165	(show branch) ++ " _label_" ++ (show iid) ++ "\n" ++
163		emitInstrs p r b2 ++
	166	emitBlock p r b2 ++
164	167	" jmp _past_" ++ (show iid) ++ "\n" ++
165	168	"_label_" ++ (show iid) ++ ":\n" ++
166		emitInstrs p r b1 ++
	169	emitBlock p r b1 ++
167	170	"_past_" ++ (show iid) ++ ":"
168	171
169	172	emitInstr p r (REPEAT iid branch blk) =
170	173	"\n_repeat_" ++ (show iid) ++ ":\n" ++
171		emitInstrs p r blk ++
	174	emitBlock p r blk ++
172	175	" " ++ (show branch) ++ " _repeat_" ++ (show iid)
173	176
174	177	emitInstr p r (WITH SEI blk) =
175	178	"sei\n" ++
176		emitInstrs p r blk ++
	179	emitBlock p r blk ++
177	180	" cli"
178	181
179	182	emitInstr p r (WITH (PUSH A) blk) =
180	183	"pha\n" ++
181		emitInstrs p r blk ++
	184	emitBlock p r blk ++
182	185	" pla"
183	186
184	187	emitInstr p r (WITH (PUSH AllFlags) blk) =
185	188	"php\n" ++
186		emitInstrs p r blk ++
	189	emitBlock p r blk ++
187	190	" plp"
188	191
189	192	emitInstr p r (COPYROUTINE src (NamedLocation (Just Vector) dst)) =

+21

-10

src/SixtyPical/Model.hs less more

59	59	\| PUSH StorageLocation
60	60	deriving (Show, Ord, Eq)
61	61
	62	data Block = Block [Decl] [Instruction]
	63	deriving (Show, Ord, Eq)
	64
62	65	data Instruction = COPY StorageLocation StorageLocation
63	66	\| CMP StorageLocation StorageLocation
64	67	\| ADD StorageLocation StorageLocation

72	75	\| JSR RoutineName
73	76	-- \| JSRVECTOR StorageLocation
74	77	\| JMPVECTOR StorageLocation
75		\| IF InternalID Branch [Instruction] [Instruction]
76		\| REPEAT InternalID Branch [Instruction]
	78	\| IF InternalID Branch Block Block
	79	\| REPEAT InternalID Branch Block
77	80	\| DELTA StorageLocation DataValue
78		\| WITH WithInstruction [Instruction]
	81	\| WITH WithInstruction Block
79	82	\| COPYROUTINE RoutineName StorageLocation
80	83	\| NOP
81	84	deriving (Show, Ord, Eq)
82	85
83		data Routine = Routine RoutineName [StorageLocation] [Instruction]
	86	data Routine = Routine RoutineName [StorageLocation] Block
84	87	deriving (Show, Ord, Eq)
85	88
86	89	data Program = Program [Decl] [Routine]

128	131
129	132	--
130	133
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)
133	140
134	141	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)
137	144
138	145	mapRoutines :: (Instruction -> Instruction) -> [Routine] -> [Routine]
139	146	mapRoutines f [] = []

146	153
147	154	--
148	155
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
151	162
152	163	foldRoutine :: (Instruction -> a -> a) -> a -> Routine -> a
153	164	foldRoutine f a (Routine name outputs instrs) =

+4

-3

src/SixtyPical/Parser.hs less more

15	15	\| "external" RoutineName Address.
16	16	StorageType := "byte" ["[" Literal "]"] \| "word" \| "vector".
17	17	Routine := "routine" RoutineName ["outputs" "(" {LocationName} ")"] Block.
18		Block := "{" {Command} "}".
	18	Block := "{" {Decl} {Command} "}".
19	19	Command := "if" Branch Block "else" Block
20	20	\| "lda" (LocationName \| Immediate)
21	21	\| "ldx" (LocationName \| Immediate)

133	133
134	134	location = (try explicit_register <\|> named_location)
135	135
136		block :: Parser [Instruction]
	136	block :: Parser Block
137	137	block = do
138	138	string "{"
139	139	nspaces
	140	ds <- many decl
140	141	cs <- many command
141	142	string "}"
142	143	nspaces
143		return cs
	144	return (Block ds cs)
144	145
145	146	-- -- -- -- -- -- commands -- -- -- -- --
146	147