git @ Cat's Eye Technologies SixtyPical / 240fd49
named_location production; syntax is "asl .a" now Cat's Eye Technologies 8 years ago
5 changed file(s) with 51 addition(s) and 37 deletion(s). Raw diff Collapse all Expand all
115115 * Addressing modes — indexed mode on more instructions
116116 * `jsr (vector)`
117117 * `jmp routine`
118 * insist on EOL after each instruction. need spacesWOEOL production
119 * asl .a
118 * comments in any spaces; forget the eol thing
120119 * `outputs` on externals
121120 * Routine is a kind of StorageLocation? (Location)?
121 * remove DELTA -> ADD
122 * Poisoning the highbyte or lowbyte of a word should poison the word
263263 | reserve byte vbyte
264264 | assign byte table table 1024
265265 | routine main {
266 | asl @
266 | asl .a
267267 | asl vbyte
268 | lsr @
268 | lsr .a
269269 | lsr vbyte
270 | rol @
270 | rol .a
271271 | rol vbyte
272 | ror @
272 | ror .a
273273 | ror vbyte
274274 | bit vbyte
275275 | eor #5
77
88 emitProgram p@(Program decls routines) =
99 let
10 mains = findRoutines (\(Routine name _ _) -> name == "main") routines
11 allElse = findRoutines (\(Routine name _ _) -> name /= "main") routines
10 mains = filter (\(Routine name _ _) -> name == "main") routines
11 allElse = filter (\(Routine name _ _) -> name /= "main") routines
1212 in
1313 emitRoutines p mains ++
1414 emitRoutines p allElse ++
175175 lookupRoutine' (rout@(Routine rname _ _):routs) name
176176 | rname == name = Just rout
177177 | otherwise = lookupRoutine' routs name
178
179 findRoutines f [] = []
180 findRoutines f (rout:routs)
181 | f rout = (rout:findRoutines f routs)
182 | otherwise = findRoutines f routs
5656 string "reserve"
5757 spaces
5858 sz <- storage_type
59 name <- locationName
59 name <- location_name
6060 return $ Reserve name sz
6161
6262 assign :: Parser Decl
6464 string "assign"
6565 spaces
6666 sz <- storage_type
67 name <- locationName
67 name <- location_name
6868 addr <- address
6969 return $ Assign name sz addr
7070
103103 spaces
104104 string "("
105105 spaces
106 locations <- many locationName
106 locations <- many location
107107 string ")"
108108 spaces
109 return (map (\x -> NamedLocation Nothing x) locations)
109 return locations
110
111 location = (try explicit_register <|> named_location)
110112
111113 block :: Parser [Instruction]
112114 block = do
149151 low_byte_of_absolute :: Parser AddressingModality
150152 low_byte_of_absolute = do
151153 string "<"
152 l <- locationName
154 l <- location_name
153155 return $ LowBytely l
154156
155157 high_byte_of_absolute :: Parser AddressingModality
156158 high_byte_of_absolute = do
157159 string ">"
158 l <- locationName
160 l <- location_name
159161 return $ HighBytely l
160162
161163 indirect_location :: Parser AddressingModality
162164 indirect_location = do
163165 string "("
164166 spaces
165 l <- locationName
167 l <- location_name
166168 string ")"
167169 spaces
168170 return $ Indirectly l
169171
170172 direct_location :: Parser AddressingModality
171173 direct_location = do
172 l <- locationName
174 l <- location_name
173175 return $ Directly l
176
177 explicit_location :: String -> StorageLocation -> Parser StorageLocation
178 explicit_location s l = do
179 string s
180 spaces
181 return $ l
182
183 explicit_register :: Parser StorageLocation
184 explicit_register = ((try $ explicit_location ".a" A) <|>
185 (try $ explicit_location ".x" X) <|>
186 (explicit_location ".y" Y))
174187
175188 register_location :: Parser AddressingModality
176189 register_location = do
177 string "@" --- ARGH
178 spaces
179 return $ Implicitly A
190 z <- explicit_register
191 spaces
192 return $ Implicitly z
180193
181194 immediate :: Parser AddressingModality
182195 immediate = do
311324 inc = do
312325 string "inc"
313326 spaces
314 l <- locationName
315 return (DELTA (NamedLocation Nothing l) 1)
327 l <- named_location
328 return (DELTA l 1)
316329
317330 dec :: Parser Instruction
318331 dec = do
319332 string "dec"
320333 spaces
321 l <- locationName
322 return (DELTA (NamedLocation Nothing l) (-1))
334 l <- named_location
335 return (DELTA l (-1))
323336
324337 cmp :: Parser Instruction
325338 cmp = do
428441 stx = do
429442 string "stx"
430443 spaces
431 l <- locationName
432 return (COPY X (NamedLocation Nothing l))
444 l <- named_location
445 return (COPY X l)
433446
434447 sty :: Parser Instruction
435448 sty = do
436449 string "sty"
437450 spaces
438 l <- locationName
439 return (COPY Y (NamedLocation Nothing l))
451 l <- named_location
452 return (COPY Y l)
440453
441454 txa :: Parser Instruction
442455 txa = do
489502 spaces
490503 string "("
491504 spaces
492 l <- locationName
505 l <- named_location
493506 string ")"
494507 spaces
495 return $ JMPVECTOR (NamedLocation Nothing l)
508 return $ JMPVECTOR l
496509
497510 jsr :: Parser Instruction
498511 jsr = do
541554 src <- routineName
542555 string "to"
543556 spaces
544 dst <- locationName
557 dst <- location_name
545558 return (COPYROUTINE src (NamedLocation Nothing dst))
546559
547560 branch :: Parser Branch
562575 spaces
563576 return (c:cs)
564577
565 locationName :: Parser String
566 locationName = do
578 location_name :: Parser String
579 location_name = do
567580 c <- letter
568581 cs <- many (alphaNum <|> char '_')
569582 spaces
570583 return (c:cs)
584
585 named_location :: Parser StorageLocation
586 named_location = do
587 name <- location_name
588 return (NamedLocation Nothing name)
571589
572590 address = hex_address <|> decimal_address
573591