Switch to C++/Javascript-style comments, in whitespace production.
Cat's Eye Technologies
8 years ago
108 | 108 | temporary addresses are never used simultaneously, they may be merged |
109 | 109 | to the same address. |
110 | 110 | |
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 | ||
111 | 121 | TODO |
112 | 122 | ---- |
113 | 123 | |
117 | 127 | * Addressing modes — indexed mode on more instructions |
118 | 128 | * `jsr (vector)` |
119 | 129 | * `jmp routine` |
120 | * comments in any spaces; forget the eol thing | |
121 | 130 | * `outputs` on externals |
122 | 131 | * Routine is a kind of StorageLocation? (Location)? |
123 | 132 | * remove DELTA -> ADD/SUB (requires carry be notated on ADD and SUB though) |
25 | 25 | | } |
26 | 26 | ? missing 'main' routine |
27 | 27 | |
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 | |
33 | 47 | | 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 | |
47 | 51 | | } |
48 | 52 | = True |
49 | 53 |
14 | 14 | |
15 | 15 | assign vector cinv 788 |
16 | 16 | |
17 | ; --------- | |
17 | /* --------- */ | |
18 | 18 | |
19 | 19 | reserve vector save_cinv |
20 | 20 | |
54 | 54 | } |
55 | 55 | |
56 | 56 | 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 | |
58 | 58 | jsr compare_new_pos |
59 | 59 | |
60 | 60 | if bcs { |
98 | 98 | sta >delta |
99 | 99 | ldx joy2 |
100 | 100 | txa |
101 | and #1 ; up | |
101 | and #1 // up | |
102 | 102 | if beq { |
103 | lda #216 ; -40 | |
103 | lda #216 // -40 | |
104 | 104 | sta <delta |
105 | 105 | lda #255 |
106 | 106 | sta >delta |
107 | 107 | } else { |
108 | 108 | txa |
109 | and #2 ; down | |
109 | and #2 // down | |
110 | 110 | if beq { |
111 | 111 | lda #40 |
112 | 112 | sta <delta |
113 | 113 | } else { |
114 | 114 | txa |
115 | and #4 ; left | |
115 | and #4 // left | |
116 | 116 | if beq { |
117 | lda #255 ; -1 | |
117 | lda #255 // -1 | |
118 | 118 | sta <delta |
119 | 119 | lda #255 |
120 | 120 | sta >delta |
121 | 121 | } else { |
122 | 122 | txa |
123 | and #8 ; right | |
123 | and #8 // right | |
124 | 124 | if beq { |
125 | 125 | lda #1 |
126 | 126 | sta <delta |
9 | 9 | |
10 | 10 | {- |
11 | 11 | |
12 | Toplevel := {Decl [Comment]} {Routine}. | |
12 | Toplevel := {Decl} {Routine}. | |
13 | 13 | Decl := "reserve" StorageType LocationName |
14 | 14 | | "assign" StorageType LocationName Address |
15 | 15 | | "external" RoutineName Address. |
16 | 16 | StorageType := "byte" | "word" | "vector". |
17 | 17 | Routine := "routine" RoutineName ["outputs" "(" {LocationName} ")"] Block. |
18 | Block := "{" [Comment] {Command [Comment]} "}". | |
18 | Block := "{" {Command} "}". | |
19 | 19 | Command := "if" Branch Block "else" Block |
20 | 20 | | "lda" (LocationName | Immediate) |
21 | 21 | | "ldx" (LocationName | Immediate) |
34 | 34 | |
35 | 35 | -} |
36 | 36 | |
37 | nspaces :: Parser [Char] | |
37 | nspaces :: Parser () | |
38 | 38 | 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 ' ' | |
40 | 53 | |
41 | 54 | toplevel :: Parser Program |
42 | 55 | toplevel = do |
43 | spaces | |
56 | nspaces | |
44 | 57 | decls <- many decl |
45 | 58 | routines <- many routine |
46 | 59 | return $ Program decls routines |
47 | 60 | |
48 | 61 | 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 | |
53 | 63 | |
54 | 64 | reserve :: Parser Decl |
55 | 65 | reserve = do |
56 | 66 | string "reserve" |
57 | spaces | |
67 | nspaces | |
58 | 68 | sz <- storage_type |
59 | 69 | name <- location_name |
60 | 70 | return $ Reserve name sz |
62 | 72 | assign :: Parser Decl |
63 | 73 | assign = do |
64 | 74 | string "assign" |
65 | spaces | |
75 | nspaces | |
66 | 76 | sz <- storage_type |
67 | 77 | name <- location_name |
68 | 78 | addr <- address |
71 | 81 | external :: Parser Decl |
72 | 82 | external = do |
73 | 83 | string "external" |
74 | spaces | |
84 | nspaces | |
75 | 85 | name <- routineName |
76 | 86 | addr <- address |
77 | 87 | return $ External name addr |
85 | 95 | storage_type = do |
86 | 96 | s <- (try $ string "byte table") <|> (string "byte") <|> |
87 | 97 | (string "word") <|> (string "vector") |
88 | spaces | |
98 | nspaces | |
89 | 99 | return $ get_storage s |
90 | 100 | |
91 | 101 | routine :: Parser Routine |
92 | 102 | routine = do |
93 | 103 | string "routine" |
94 | spaces | |
104 | nspaces | |
95 | 105 | name <- routineName |
96 | 106 | outputs <- (try routine_outputs <|> return []) |
97 | 107 | instrs <- block |
100 | 110 | routine_outputs :: Parser [StorageLocation] |
101 | 111 | routine_outputs = do |
102 | 112 | string "outputs" |
103 | spaces | |
113 | nspaces | |
104 | 114 | string "(" |
105 | spaces | |
115 | nspaces | |
106 | 116 | locations <- many location |
107 | 117 | string ")" |
108 | spaces | |
118 | nspaces | |
109 | 119 | return locations |
110 | 120 | |
111 | 121 | location = (try explicit_register <|> named_location) |
113 | 123 | block :: Parser [Instruction] |
114 | 124 | block = do |
115 | 125 | string "{" |
116 | spaces | |
117 | cs <- many commented_command | |
126 | nspaces | |
127 | cs <- many command | |
118 | 128 | string "}" |
119 | spaces | |
129 | nspaces | |
120 | 130 | 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 | |
130 | 131 | |
131 | 132 | -- -- -- -- -- -- commands -- -- -- -- -- |
132 | 133 | |
133 | 134 | index :: Parser StorageLocation |
134 | 135 | index = do |
135 | 136 | string "," |
136 | spaces | |
137 | nspaces | |
137 | 138 | c <- (string "x" <|> string "y") |
138 | spaces | |
139 | nspaces | |
139 | 140 | return $ case c of |
140 | 141 | "x" -> X |
141 | 142 | "y" -> Y |
163 | 164 | indirect_location :: Parser AddressingModality |
164 | 165 | indirect_location = do |
165 | 166 | string "(" |
166 | spaces | |
167 | nspaces | |
167 | 168 | l <- location_name |
168 | 169 | string ")" |
169 | spaces | |
170 | nspaces | |
170 | 171 | return $ Indirectly l |
171 | 172 | |
172 | 173 | direct_location :: Parser AddressingModality |
177 | 178 | explicit_location :: String -> StorageLocation -> Parser StorageLocation |
178 | 179 | explicit_location s l = do |
179 | 180 | string s |
180 | spaces | |
181 | nspaces | |
181 | 182 | return $ l |
182 | 183 | |
183 | 184 | explicit_register :: Parser StorageLocation |
188 | 189 | register_location :: Parser AddressingModality |
189 | 190 | register_location = do |
190 | 191 | z <- explicit_register |
191 | spaces | |
192 | return $ Implicitly z | |
192 | nspaces | |
193 | return $ Implicitly z -- ironic? | |
193 | 194 | |
194 | 195 | immediate :: Parser AddressingModality |
195 | 196 | immediate = do |
200 | 201 | addressing_mode :: String -> (AddressingModality -> [StorageLocation] -> Instruction) -> Parser Instruction |
201 | 202 | addressing_mode opcode f = do |
202 | 203 | string opcode |
203 | spaces | |
204 | nspaces | |
204 | 205 | d <- ((try immediate) <|> (try high_byte_of_absolute) <|> |
205 | 206 | (try low_byte_of_absolute) <|> (try indirect_location) <|> |
206 | 207 | (try register_location) <|> (try direct_location)) |
207 | 208 | indexes <- many index |
208 | 209 | 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 | |
215 | 210 | |
216 | 211 | command :: Parser Instruction |
217 | 212 | command = (try lda) <|> |
235 | 230 | nop :: Parser Instruction |
236 | 231 | nop = do |
237 | 232 | string "nop" |
238 | spaces | |
233 | nspaces | |
239 | 234 | return NOP |
240 | 235 | |
241 | 236 | asl :: Parser Instruction |
269 | 264 | clc :: Parser Instruction |
270 | 265 | clc = do |
271 | 266 | string "clc" |
272 | spaces | |
267 | nspaces | |
273 | 268 | return $ COPY (Immediate 0) FlagC |
274 | 269 | |
275 | 270 | cld :: Parser Instruction |
276 | 271 | cld = do |
277 | 272 | string "cld" |
278 | spaces | |
273 | nspaces | |
279 | 274 | return $ COPY (Immediate 0) FlagD |
280 | 275 | |
281 | 276 | clv :: Parser Instruction |
282 | 277 | clv = do |
283 | 278 | string "clv" |
284 | spaces | |
279 | nspaces | |
285 | 280 | return $ COPY (Immediate 0) FlagV |
286 | 281 | |
287 | 282 | sec :: Parser Instruction |
288 | 283 | sec = do |
289 | 284 | string "sec" |
290 | spaces | |
285 | nspaces | |
291 | 286 | return $ COPY (Immediate 1) FlagC |
292 | 287 | |
293 | 288 | sed :: Parser Instruction |
294 | 289 | sed = do |
295 | 290 | string "sed" |
296 | spaces | |
291 | nspaces | |
297 | 292 | return $ COPY (Immediate 1) FlagD |
298 | 293 | |
299 | 294 | inx :: Parser Instruction |
300 | 295 | inx = do |
301 | 296 | string "inx" |
302 | spaces | |
297 | nspaces | |
303 | 298 | return $ DELTA X 1 |
304 | 299 | |
305 | 300 | iny :: Parser Instruction |
306 | 301 | iny = do |
307 | 302 | string "iny" |
308 | spaces | |
303 | nspaces | |
309 | 304 | return $ DELTA Y 1 |
310 | 305 | |
311 | 306 | dex :: Parser Instruction |
312 | 307 | dex = do |
313 | 308 | string "dex" |
314 | spaces | |
309 | nspaces | |
315 | 310 | return $ DELTA X (-1) |
316 | 311 | |
317 | 312 | dey :: Parser Instruction |
318 | 313 | dey = do |
319 | 314 | string "dey" |
320 | spaces | |
315 | nspaces | |
321 | 316 | return $ DELTA Y (-1) |
322 | 317 | |
323 | 318 | inc :: Parser Instruction |
324 | 319 | inc = do |
325 | 320 | string "inc" |
326 | spaces | |
321 | nspaces | |
327 | 322 | l <- named_location |
328 | 323 | return (DELTA l 1) |
329 | 324 | |
330 | 325 | dec :: Parser Instruction |
331 | 326 | dec = do |
332 | 327 | string "dec" |
333 | spaces | |
328 | nspaces | |
334 | 329 | l <- named_location |
335 | 330 | return (DELTA l (-1)) |
336 | 331 | |
456 | 451 | txa :: Parser Instruction |
457 | 452 | txa = do |
458 | 453 | string "txa" |
459 | spaces | |
454 | nspaces | |
460 | 455 | return (COPY X A) |
461 | 456 | |
462 | 457 | tax :: Parser Instruction |
463 | 458 | tax = do |
464 | 459 | string "tax" |
465 | spaces | |
460 | nspaces | |
466 | 461 | return (COPY A X) |
467 | 462 | |
468 | 463 | tya :: Parser Instruction |
469 | 464 | tya = do |
470 | 465 | string "tya" |
471 | spaces | |
466 | nspaces | |
472 | 467 | return (COPY Y A) |
473 | 468 | |
474 | 469 | tay :: Parser Instruction |
475 | 470 | tay = do |
476 | 471 | string "tay" |
477 | spaces | |
472 | nspaces | |
478 | 473 | return (COPY A Y) |
479 | 474 | |
480 | 475 | sei :: Parser Instruction |
481 | 476 | sei = do |
482 | 477 | string "sei" |
483 | spaces | |
478 | nspaces | |
484 | 479 | blk <- block |
485 | 480 | return (SEI blk) |
486 | 481 | |
487 | 482 | pha :: Parser Instruction |
488 | 483 | pha = do |
489 | 484 | string "pha" |
490 | spaces | |
485 | nspaces | |
491 | 486 | blk <- block |
492 | 487 | return (PUSH A blk) |
493 | 488 | |
494 | 489 | php :: Parser Instruction |
495 | 490 | php = do |
496 | 491 | string "php" |
497 | spaces | |
492 | nspaces | |
498 | 493 | blk <- block |
499 | 494 | return (PUSH AllFlags blk) |
500 | 495 | |
501 | 496 | jmp :: Parser Instruction |
502 | 497 | jmp = do |
503 | 498 | string "jmp" |
504 | spaces | |
499 | nspaces | |
505 | 500 | string "(" |
506 | spaces | |
501 | nspaces | |
507 | 502 | l <- named_location |
508 | 503 | string ")" |
509 | spaces | |
504 | nspaces | |
510 | 505 | return $ JMPVECTOR l |
511 | 506 | |
512 | 507 | jsr :: Parser Instruction |
513 | 508 | jsr = do |
514 | 509 | string "jsr" |
515 | spaces | |
510 | nspaces | |
516 | 511 | l <- routineName |
517 | 512 | return $ JSR l |
518 | 513 | |
519 | 514 | if_statement :: Parser Instruction |
520 | 515 | if_statement = do |
521 | 516 | string "if" |
522 | spaces | |
517 | nspaces | |
523 | 518 | brch <- branch |
524 | 519 | b1 <- block |
525 | 520 | string "else" |
526 | spaces | |
521 | nspaces | |
527 | 522 | b2 <- block |
528 | 523 | return (IF 0 brch b1 b2) |
529 | 524 | |
530 | 525 | repeat_statement :: Parser Instruction |
531 | 526 | repeat_statement = do |
532 | 527 | string "repeat" |
533 | spaces | |
528 | nspaces | |
534 | 529 | brch <- branch |
535 | 530 | blk <- block |
536 | 531 | return (REPEAT 0 brch blk) |
538 | 533 | copy_general_statement :: Parser Instruction |
539 | 534 | copy_general_statement = do |
540 | 535 | string "copy" |
541 | spaces | |
536 | nspaces | |
542 | 537 | src <- (try immediate <|> try direct_location) |
543 | 538 | dst <- direct_location |
544 | 539 | return $ case (src, dst) of |
550 | 545 | copy_routine_statement :: Parser Instruction |
551 | 546 | copy_routine_statement = do |
552 | 547 | string "copy" |
553 | spaces | |
548 | nspaces | |
554 | 549 | string "routine" |
555 | spaces | |
550 | nspaces | |
556 | 551 | src <- routineName |
557 | 552 | string "to" |
558 | spaces | |
553 | nspaces | |
559 | 554 | dst <- location_name |
560 | 555 | return (COPYROUTINE src (NamedLocation Nothing dst)) |
561 | 556 | |
567 | 562 | b :: String -> Branch -> Parser Branch |
568 | 563 | b s k = do |
569 | 564 | string s |
570 | spaces | |
565 | nspaces | |
571 | 566 | return k |
572 | 567 | |
573 | 568 | routineName :: Parser String |
574 | 569 | routineName = do |
575 | 570 | c <- letter |
576 | 571 | cs <- many (alphaNum <|> char '_') |
577 | spaces | |
572 | nspaces | |
578 | 573 | return (c:cs) |
579 | 574 | |
580 | 575 | location_name :: Parser String |
581 | 576 | location_name = do |
582 | 577 | c <- letter |
583 | 578 | cs <- many (alphaNum <|> char '_') |
584 | spaces | |
579 | nspaces | |
585 | 580 | return (c:cs) |
586 | 581 | |
587 | 582 | named_location :: Parser StorageLocation |
595 | 590 | hex_address = do |
596 | 591 | char '$' |
597 | 592 | digits <- many hexDigit |
598 | spaces | |
593 | nspaces | |
599 | 594 | let ((d, _):_) = readHex digits |
600 | 595 | return (d :: Address) |
601 | 596 | |
602 | 597 | decimal_address :: Parser Address |
603 | 598 | decimal_address = do |
604 | 599 | digits <- many digit |
605 | spaces | |
600 | nspaces | |
606 | 601 | return (read digits :: Address) |
607 | 602 | |
608 | 603 | data_value = hex_data_value <|> decimal_data_value |
611 | 606 | hex_data_value = do |
612 | 607 | char '$' |
613 | 608 | digits <- many hexDigit |
614 | spaces | |
609 | nspaces | |
615 | 610 | let ((d, _):_) = readHex digits |
616 | 611 | return (d :: DataValue) |
617 | 612 | |
618 | 613 | decimal_data_value :: Parser DataValue |
619 | 614 | decimal_data_value = do |
620 | 615 | digits <- many digit |
621 | spaces | |
616 | nspaces | |
622 | 617 | return (read digits :: DataValue) |
623 | 618 | |
624 | 619 | -- -- -- driver -- -- -- |