git @ Cat's Eye Technologies SixtyPical / 2fb9621
Switch to C++/Javascript-style comments, in whitespace production. Cat's Eye Technologies 7 years ago
4 changed file(s) with 115 addition(s) and 107 deletion(s). Raw diff Collapse all Expand all
108108 temporary addresses are never used simultaneously, they may be merged
109109 to the same address.
110110
111 Internals
112 ---------
113
114 Some (OK, a lot) of the Haskell code is kind of gross and non-idiomatic.
115 The parser, in particular, would not be described as "elegant". There
116 could definitely be more higher-order functions defined and used. At the
117 same time, I'm really not a fan of pointless style — I prefer it when things
118 are written out explicitly and pedantically. Still, there are places where
119 an added `foldr` or two would not be unwelcome...
120
111121 TODO
112122 ----
113123
117127 * Addressing modes — indexed mode on more instructions
118128 * `jsr (vector)`
119129 * `jmp routine`
120 * comments in any spaces; forget the eol thing
121130 * `outputs` on externals
122131 * Routine is a kind of StorageLocation? (Location)?
123132 * remove DELTA -> ADD/SUB (requires carry be notated on ADD and SUB though)
2525 | }
2626 ? missing 'main' routine
2727
28 A comment may appear after each command.
29
30 | routine main {
31 | lda #1 ; we assemble the fnord using
32 | ldx #1 ; multiple lorem ipsums which
28 Each instruction need not appear on its own line. (Although you probably
29 still want to write in that style, for consistency with assembly code.)
30
31 | routine main {
32 | nop lda #1 ldx #1 nop
33 | }
34 = True
35
36 Javascript-style block and line comments are both supported.
37 They may appear anywhere whitespace may appear.
38
39 | reserve byte lives /* fnord */
40 | assign byte gdcol 647 // fnord
41 | external blastoff 4 // fnnnnnnnnnnnnnnnnfffffffff
42 |
43 | routine /* hello */ main {
44 | /* this routine does everything you need. */
45 | lda #1 // we assemble the fnord using
46 | ldx #1 // multiple lorem ipsums which
3347 | ldy #1
34 | lda #1 ; we
35 | ldx #1 ; found under the bridge by the old mill yesterday
36 | }
37 = True
38
39 A comment may appear after each declaration.
40
41 | reserve byte lives ; fnord
42 | assign byte gdcol 647 ; fnord
43 | external blastoff 4 ; fnnnnnnnnnnnnnnnnfffffffff
44 |
45 | routine main {
46 | nop
48 | lda #1 /* we
49 | found under the bridge by the old mill yesterday */
50 | ldx #1
4751 | }
4852 = True
4953
1414
1515 assign vector cinv 788
1616
17 ; ---------
17 /* --------- */
1818
1919 reserve vector save_cinv
2020
5454 }
5555
5656 routine check_new_position_in_bounds {
57 copy #$07e8 compare_target ; just past bottom of screen
57 copy #$07e8 compare_target // just past bottom of screen
5858 jsr compare_new_pos
5959
6060 if bcs {
9898 sta >delta
9999 ldx joy2
100100 txa
101 and #1 ; up
101 and #1 // up
102102 if beq {
103 lda #216 ; -40
103 lda #216 // -40
104104 sta <delta
105105 lda #255
106106 sta >delta
107107 } else {
108108 txa
109 and #2 ; down
109 and #2 // down
110110 if beq {
111111 lda #40
112112 sta <delta
113113 } else {
114114 txa
115 and #4 ; left
115 and #4 // left
116116 if beq {
117 lda #255 ; -1
117 lda #255 // -1
118118 sta <delta
119119 lda #255
120120 sta >delta
121121 } else {
122122 txa
123 and #8 ; right
123 and #8 // right
124124 if beq {
125125 lda #1
126126 sta <delta
99
1010 {-
1111
12 Toplevel := {Decl [Comment]} {Routine}.
12 Toplevel := {Decl} {Routine}.
1313 Decl := "reserve" StorageType LocationName
1414 | "assign" StorageType LocationName Address
1515 | "external" RoutineName Address.
1616 StorageType := "byte" | "word" | "vector".
1717 Routine := "routine" RoutineName ["outputs" "(" {LocationName} ")"] Block.
18 Block := "{" [Comment] {Command [Comment]} "}".
18 Block := "{" {Command} "}".
1919 Command := "if" Branch Block "else" Block
2020 | "lda" (LocationName | Immediate)
2121 | "ldx" (LocationName | Immediate)
3434
3535 -}
3636
37 nspaces :: Parser [Char]
37 nspaces :: Parser ()
3838 nspaces = do
39 many (char ' ' <|> char '\t')
39 many (space <|> try block_comment <|> line_comment)
40 return ()
41
42 block_comment :: Parser Char
43 block_comment = do
44 string "/*"
45 manyTill anyChar (try (string "*/"))
46 return ' '
47
48 line_comment :: Parser Char
49 line_comment = do
50 string "//"
51 manyTill anyChar (char '\n')
52 return ' '
4053
4154 toplevel :: Parser Program
4255 toplevel = do
43 spaces
56 nspaces
4457 decls <- many decl
4558 routines <- many routine
4659 return $ Program decls routines
4760
4861 decl :: Parser Decl
49 decl = do
50 d <- (try assign <|> try reserve <|> try external)
51 optional_comment_before_eol
52 return d
62 decl = try assign <|> try reserve <|> external
5363
5464 reserve :: Parser Decl
5565 reserve = do
5666 string "reserve"
57 spaces
67 nspaces
5868 sz <- storage_type
5969 name <- location_name
6070 return $ Reserve name sz
6272 assign :: Parser Decl
6373 assign = do
6474 string "assign"
65 spaces
75 nspaces
6676 sz <- storage_type
6777 name <- location_name
6878 addr <- address
7181 external :: Parser Decl
7282 external = do
7383 string "external"
74 spaces
84 nspaces
7585 name <- routineName
7686 addr <- address
7787 return $ External name addr
8595 storage_type = do
8696 s <- (try $ string "byte table") <|> (string "byte") <|>
8797 (string "word") <|> (string "vector")
88 spaces
98 nspaces
8999 return $ get_storage s
90100
91101 routine :: Parser Routine
92102 routine = do
93103 string "routine"
94 spaces
104 nspaces
95105 name <- routineName
96106 outputs <- (try routine_outputs <|> return [])
97107 instrs <- block
100110 routine_outputs :: Parser [StorageLocation]
101111 routine_outputs = do
102112 string "outputs"
103 spaces
113 nspaces
104114 string "("
105 spaces
115 nspaces
106116 locations <- many location
107117 string ")"
108 spaces
118 nspaces
109119 return locations
110120
111121 location = (try explicit_register <|> named_location)
113123 block :: Parser [Instruction]
114124 block = do
115125 string "{"
116 spaces
117 cs <- many commented_command
126 nspaces
127 cs <- many command
118128 string "}"
119 spaces
129 nspaces
120130 return cs
121
122 optional_comment_before_eol = do
123 optional comment
124
125 comment :: Parser ()
126 comment = do
127 string ";"
128 manyTill anyChar (try (string "\n"))
129 spaces
130131
131132 -- -- -- -- -- -- commands -- -- -- -- --
132133
133134 index :: Parser StorageLocation
134135 index = do
135136 string ","
136 spaces
137 nspaces
137138 c <- (string "x" <|> string "y")
138 spaces
139 nspaces
139140 return $ case c of
140141 "x" -> X
141142 "y" -> Y
163164 indirect_location :: Parser AddressingModality
164165 indirect_location = do
165166 string "("
166 spaces
167 nspaces
167168 l <- location_name
168169 string ")"
169 spaces
170 nspaces
170171 return $ Indirectly l
171172
172173 direct_location :: Parser AddressingModality
177178 explicit_location :: String -> StorageLocation -> Parser StorageLocation
178179 explicit_location s l = do
179180 string s
180 spaces
181 nspaces
181182 return $ l
182183
183184 explicit_register :: Parser StorageLocation
188189 register_location :: Parser AddressingModality
189190 register_location = do
190191 z <- explicit_register
191 spaces
192 return $ Implicitly z
192 nspaces
193 return $ Implicitly z -- ironic?
193194
194195 immediate :: Parser AddressingModality
195196 immediate = do
200201 addressing_mode :: String -> (AddressingModality -> [StorageLocation] -> Instruction) -> Parser Instruction
201202 addressing_mode opcode f = do
202203 string opcode
203 spaces
204 nspaces
204205 d <- ((try immediate) <|> (try high_byte_of_absolute) <|>
205206 (try low_byte_of_absolute) <|> (try indirect_location) <|>
206207 (try register_location) <|> (try direct_location))
207208 indexes <- many index
208209 return $ f d indexes
209
210 commented_command :: Parser Instruction
211 commented_command = do
212 c <- command
213 optional_comment_before_eol
214 return c
215210
216211 command :: Parser Instruction
217212 command = (try lda) <|>
235230 nop :: Parser Instruction
236231 nop = do
237232 string "nop"
238 spaces
233 nspaces
239234 return NOP
240235
241236 asl :: Parser Instruction
269264 clc :: Parser Instruction
270265 clc = do
271266 string "clc"
272 spaces
267 nspaces
273268 return $ COPY (Immediate 0) FlagC
274269
275270 cld :: Parser Instruction
276271 cld = do
277272 string "cld"
278 spaces
273 nspaces
279274 return $ COPY (Immediate 0) FlagD
280275
281276 clv :: Parser Instruction
282277 clv = do
283278 string "clv"
284 spaces
279 nspaces
285280 return $ COPY (Immediate 0) FlagV
286281
287282 sec :: Parser Instruction
288283 sec = do
289284 string "sec"
290 spaces
285 nspaces
291286 return $ COPY (Immediate 1) FlagC
292287
293288 sed :: Parser Instruction
294289 sed = do
295290 string "sed"
296 spaces
291 nspaces
297292 return $ COPY (Immediate 1) FlagD
298293
299294 inx :: Parser Instruction
300295 inx = do
301296 string "inx"
302 spaces
297 nspaces
303298 return $ DELTA X 1
304299
305300 iny :: Parser Instruction
306301 iny = do
307302 string "iny"
308 spaces
303 nspaces
309304 return $ DELTA Y 1
310305
311306 dex :: Parser Instruction
312307 dex = do
313308 string "dex"
314 spaces
309 nspaces
315310 return $ DELTA X (-1)
316311
317312 dey :: Parser Instruction
318313 dey = do
319314 string "dey"
320 spaces
315 nspaces
321316 return $ DELTA Y (-1)
322317
323318 inc :: Parser Instruction
324319 inc = do
325320 string "inc"
326 spaces
321 nspaces
327322 l <- named_location
328323 return (DELTA l 1)
329324
330325 dec :: Parser Instruction
331326 dec = do
332327 string "dec"
333 spaces
328 nspaces
334329 l <- named_location
335330 return (DELTA l (-1))
336331
456451 txa :: Parser Instruction
457452 txa = do
458453 string "txa"
459 spaces
454 nspaces
460455 return (COPY X A)
461456
462457 tax :: Parser Instruction
463458 tax = do
464459 string "tax"
465 spaces
460 nspaces
466461 return (COPY A X)
467462
468463 tya :: Parser Instruction
469464 tya = do
470465 string "tya"
471 spaces
466 nspaces
472467 return (COPY Y A)
473468
474469 tay :: Parser Instruction
475470 tay = do
476471 string "tay"
477 spaces
472 nspaces
478473 return (COPY A Y)
479474
480475 sei :: Parser Instruction
481476 sei = do
482477 string "sei"
483 spaces
478 nspaces
484479 blk <- block
485480 return (SEI blk)
486481
487482 pha :: Parser Instruction
488483 pha = do
489484 string "pha"
490 spaces
485 nspaces
491486 blk <- block
492487 return (PUSH A blk)
493488
494489 php :: Parser Instruction
495490 php = do
496491 string "php"
497 spaces
492 nspaces
498493 blk <- block
499494 return (PUSH AllFlags blk)
500495
501496 jmp :: Parser Instruction
502497 jmp = do
503498 string "jmp"
504 spaces
499 nspaces
505500 string "("
506 spaces
501 nspaces
507502 l <- named_location
508503 string ")"
509 spaces
504 nspaces
510505 return $ JMPVECTOR l
511506
512507 jsr :: Parser Instruction
513508 jsr = do
514509 string "jsr"
515 spaces
510 nspaces
516511 l <- routineName
517512 return $ JSR l
518513
519514 if_statement :: Parser Instruction
520515 if_statement = do
521516 string "if"
522 spaces
517 nspaces
523518 brch <- branch
524519 b1 <- block
525520 string "else"
526 spaces
521 nspaces
527522 b2 <- block
528523 return (IF 0 brch b1 b2)
529524
530525 repeat_statement :: Parser Instruction
531526 repeat_statement = do
532527 string "repeat"
533 spaces
528 nspaces
534529 brch <- branch
535530 blk <- block
536531 return (REPEAT 0 brch blk)
538533 copy_general_statement :: Parser Instruction
539534 copy_general_statement = do
540535 string "copy"
541 spaces
536 nspaces
542537 src <- (try immediate <|> try direct_location)
543538 dst <- direct_location
544539 return $ case (src, dst) of
550545 copy_routine_statement :: Parser Instruction
551546 copy_routine_statement = do
552547 string "copy"
553 spaces
548 nspaces
554549 string "routine"
555 spaces
550 nspaces
556551 src <- routineName
557552 string "to"
558 spaces
553 nspaces
559554 dst <- location_name
560555 return (COPYROUTINE src (NamedLocation Nothing dst))
561556
567562 b :: String -> Branch -> Parser Branch
568563 b s k = do
569564 string s
570 spaces
565 nspaces
571566 return k
572567
573568 routineName :: Parser String
574569 routineName = do
575570 c <- letter
576571 cs <- many (alphaNum <|> char '_')
577 spaces
572 nspaces
578573 return (c:cs)
579574
580575 location_name :: Parser String
581576 location_name = do
582577 c <- letter
583578 cs <- many (alphaNum <|> char '_')
584 spaces
579 nspaces
585580 return (c:cs)
586581
587582 named_location :: Parser StorageLocation
595590 hex_address = do
596591 char '$'
597592 digits <- many hexDigit
598 spaces
593 nspaces
599594 let ((d, _):_) = readHex digits
600595 return (d :: Address)
601596
602597 decimal_address :: Parser Address
603598 decimal_address = do
604599 digits <- many digit
605 spaces
600 nspaces
606601 return (read digits :: Address)
607602
608603 data_value = hex_data_value <|> decimal_data_value
611606 hex_data_value = do
612607 char '$'
613608 digits <- many hexDigit
614 spaces
609 nspaces
615610 let ((d, _):_) = readHex digits
616611 return (d :: DataValue)
617612
618613 decimal_data_value :: Parser DataValue
619614 decimal_data_value = do
620615 digits <- many digit
621 spaces
616 nspaces
622617 return (read digits :: DataValue)
623618
624619 -- -- -- driver -- -- --