From 569de537979cf9c525ab96b1258eb2643752ea2d Mon Sep 17 00:00:00 2001 From: Cat's Eye Technologies Date: Thu, 3 Apr 2014 19:30:40 +0100 Subject: [PATCH] A refactor --- README.markdown | 14 +- doc/Instruction_Support.markdown | 318 +++++++++++++++++++++++++++++++ src/SixtyPical/Parser.hs | 82 +++----- 3 files changed, 352 insertions(+), 62 deletions(-) create mode 100644 doc/Instruction_Support.markdown diff --git a/README.markdown b/README.markdown index e5d8641..62a78cb 100644 --- a/README.markdown +++ b/README.markdown @@ -61,7 +61,7 @@ For example, the following is illegal: ...*unless* one of the following is true: * the A register is declared to be a meaningful output of `update_score` -* `update_score` was determined to not change the value of the A registers +* `update_score` was determined to not change the value of the A register The first must be done with an explicit declaration on `update_score` (NYI). The second will be done using abstract interpretation of the code of @@ -167,19 +167,19 @@ but only when the routine is used as a subroutine. Also, if the routine ends by `jsr`ing another routine, it reserves the right to do a tail-call or even a fallthrough. -There are also _with_ instructions, which are associated with an opcode -that has a natural symmetrical opcode (e.g. `pha`, `sei`). These instructions -take a block. The natural symmetrical opcode is inserted at the end of the -block. +There are also _with_ instructions, which are associated with three opcodes +that have natural symmetrical opcodes: `pha`, `php`, and `sei`. These +instructions take a block. The natural symmetrical opcode is inserted at +the end of the block. TODO ---- * Initial values for reserved, incl. tables -* give length for tables, must be there for reserved +* give length for tables, must be there for reserved, if no init val * Character tables ("strings" to everybody else) * Work out the analyses again and document them -* Addressing modes; rename instructions to match +* Addressing modes — indexed mode on more instructions * `jsr (vector)` * `jmp routine` * insist on EOL after each instruction. need spacesWOEOL production diff --git a/doc/Instruction_Support.markdown b/doc/Instruction_Support.markdown new file mode 100644 index 0000000..289fb3b --- /dev/null +++ b/doc/Instruction_Support.markdown @@ -0,0 +1,318 @@ +SixtyPical: Instruction Support +=============================== + +Unsupported Opcodes +------------------- + +6502 opcodes with no language-level equivalent instructions in SixtyPical +are `brk`, `cli`, `pla`, `plp`, `rti`, `rts`, `tsx`, `txs`. These may be +inserted into the output program as a SixtyPical → 6502 compiler sees fit, +however. + +Note to self, the `pl` opcodes *do* change flags. + +Instruction Support so far +-------------------------- + +A `X` indicates unsupported. + +Funny syntax indicates use of a special form. + +In these, `absolute` must be a `reserve`d or `locate`d address. +`immediate` must be a literal decimal or hexadecimal number +(or in future, a declared constant.) + + adc #immediate + adc absolute + + and #immediate + and absolute + + asl + asl absolute + + if bcc { block } else { block } + + if bcs { block } else { block } + + if beq { block } else { block } + + bit absolute + + if bmi { block } else { block } + + if bne { block } else { block } + + if bpl { block } else { block } + + if bvc { block } else { block } + + if bvs { block } else { block } + + clc + + cld + + clv + + cmp #immediate + cmp absolute + + cpx #immediate + cpx absolute + + cpy #immediate + cpy absolute + + dec absolute + + dex + + dey + + eor #immediate + eor absolute + + inc absolute + + inx + + iny + + jsr routine + + jmp (vector) + + lda #immediate + lda absolute + lda absolute, x + lda absolute, y + lda (absolute), y + + ldx #immediate + ldx absolute + + ldy #immediate + ldy absolute + + lsr + lsr absolute + + nop + + ora #immediate + ora absolute + + pha { block } + + php { block } + + rol + rol absolute + + ror + ror absolute + + sbc #immediate + sbc absolute + + sec + + sed + + sei { block } + + sta absolute + sta absolute, x + sta absolute, y + sta (absolute), y + + stx absolute + + sty absolute + + tax + + tay + + txa + + tya + +Tests +----- + +Should be merged with the above nicely someday. + + -> Tests for functionality "Emit ASM for SixtyPical program" + +Big test for parsing and emitting instructions. + + | reserve word vword + | reserve byte vbyte + | assign byte table table 1024 + | routine main { + | lda #4 + | ldx #0 + | ldy #$FF + | lda vbyte + | lda table, x + | lda table, y + | lda (vword), y + | lda vword + | inc vbyte + | tax + | inx + | dex + | stx vbyte + | tay + | iny + | dey + | sty vbyte + | cmp vbyte + | cmp #30 + | cmp vword + | ldx vbyte + | cpx vbyte + | cpx #31 + | txa + | ldy vbyte + | cpy vbyte + | cpy #32 + | tya + | sta vbyte + | sta table, x + | sta table, y + | sta (vword), y + | sta vword + | dec vbyte + | clc + | cld + | clv + | sec + | sed + | adc #8 + | adc vbyte + | and #8 + | and vbyte + | sbc #8 + | sbc vbyte + | ora #8 + | ora vbyte + | } + = main: + = lda #4 + = ldx #0 + = ldy #255 + = lda vbyte + = lda table, x + = lda table, y + = lda (vword), y + = lda vword + = lda vword+1 + = inc vbyte + = tax + = inx + = dex + = stx vbyte + = tay + = iny + = dey + = sty vbyte + = cmp vbyte + = cmp #30 + = cmp vword + = cmp vword+1 + = ldx vbyte + = cpx vbyte + = cpx #31 + = txa + = ldy vbyte + = cpy vbyte + = cpy #32 + = tya + = sta vbyte + = sta table, x + = sta table, y + = sta (vword), y + = sta vword + = sta vword+1 + = dec vbyte + = clc + = cld + = clv + = sec + = sed + = adc #8 + = adc vbyte + = and #8 + = and vbyte + = sbc #8 + = sbc vbyte + = ora #8 + = ora vbyte + = rts + = + = vword: .word 0 + = vbyte: .byte 0 + = .alias table 1024 + + | reserve word vword + | reserve byte vbyte + | assign byte table table 1024 + | routine main { + | asl @ + | asl vbyte + | lsr @ + | lsr vbyte + | rol @ + | rol vbyte + | ror @ + | ror vbyte + | bit vbyte + | eor #5 + | eor vbyte + | } + = main: + = asl + = asl vbyte + = lsr + = lsr vbyte + = rol + = rol vbyte + = ror + = ror vbyte + = bit vbyte + = eor #5 + = eor vbyte + = rts + = + = vword: .word 0 + = vbyte: .byte 0 + = .alias table 1024 + + | routine main { + | pha { + | sei { + | php { + | lda #0 + | } + | lda #1 + | } + | lda #2 + | } + | } + = main: + = pha + = sei + = php + = lda #0 + = plp + = lda #1 + = cli + = lda #2 + = pla + = rts diff --git a/src/SixtyPical/Parser.hs b/src/SixtyPical/Parser.hs index dcc879b..492629e 100644 --- a/src/SixtyPical/Parser.hs +++ b/src/SixtyPical/Parser.hs @@ -35,6 +35,8 @@ Branch := "bcc" | "bcs" | "beq" | "bmi" | "bne" | "bpl" | "bvc" | "bvs". -} +nspaces = many (oneOf " \t") + toplevel :: Parser Program toplevel = do decls <- many decl @@ -102,6 +104,10 @@ block = do spaces return cs +optional_comment = do + optional comment + nspaces + comment :: Parser () comment = do string ";" @@ -167,8 +173,10 @@ immediate = do v <- data_value return $ Immediately v -addressing_mode :: (AddressingModality -> [StorageLocation] -> Instruction) -> Parser Instruction -addressing_mode f = do +addressing_mode :: String -> (AddressingModality -> [StorageLocation] -> Instruction) -> Parser Instruction +addressing_mode opcode f = do + string opcode + spaces d <- ((try immediate) <|> (try high_byte_of_absolute) <|> (try low_byte_of_absolute) <|> (try indirect_location) <|> (try register_location) <|> (try direct_location)) @@ -179,8 +187,6 @@ commented_command :: Parser Instruction commented_command = do c <- command optional comment - -- string "\n" -- not yet... - -- spaces return c command :: Parser Instruction @@ -210,36 +216,28 @@ nop = do asl :: Parser Instruction asl = do - string "asl" - spaces - addressing_mode gen + addressing_mode "asl" gen where gen (Implicitly A) [] = SHL A (Immediate 0) gen (Directly l) [] = SHL (NamedLocation Nothing l) (Immediate 0) lsr :: Parser Instruction lsr = do - string "lsr" - spaces - addressing_mode gen + addressing_mode "lsr" gen where gen (Implicitly A) [] = SHR A (Immediate 0) gen (Directly l) [] = SHR (NamedLocation Nothing l) (Immediate 0) rol :: Parser Instruction rol = do - string "rol" - spaces - addressing_mode gen + addressing_mode "rol" gen where gen (Implicitly A) [] = SHL A FlagC gen (Directly l) [] = SHL (NamedLocation Nothing l) FlagC ror :: Parser Instruction ror = do - string "ror" - spaces - addressing_mode gen + addressing_mode "ror" gen where gen (Implicitly A) [] = SHR A FlagC gen (Directly l) [] = SHR (NamedLocation Nothing l) FlagC @@ -314,9 +312,7 @@ dec = do cmp :: Parser Instruction cmp = do - string "cmp" - spaces - addressing_mode gen + addressing_mode "cmp" gen where gen (Immediately v) [] = CMP A (Immediate v) gen (LowBytely l) [] = CMP A (LowByteOf (NamedLocation Nothing l)) @@ -325,27 +321,21 @@ cmp = do cpx :: Parser Instruction cpx = do - string "cpx" - spaces - addressing_mode gen + addressing_mode "cpx" gen where gen (Immediately v) [] = CMP X (Immediate v) gen (Directly l) [] = CMP X (NamedLocation Nothing l) cpy :: Parser Instruction cpy = do - string "cpy" - spaces - addressing_mode gen + addressing_mode "cpy" gen where gen (Immediately v) [] = CMP Y (Immediate v) gen (Directly l) [] = CMP Y (NamedLocation Nothing l) adc :: Parser Instruction adc = do - string "adc" - spaces - addressing_mode gen + addressing_mode "adc" gen where gen (Immediately v) [] = ADD A (Immediate v) gen (LowBytely l) [] = ADD A (LowByteOf (NamedLocation Nothing l)) @@ -354,9 +344,7 @@ adc = do sbc :: Parser Instruction sbc = do - string "sbc" - spaces - addressing_mode gen + addressing_mode "sbc" gen where gen (Immediately v) [] = SUB A (Immediate v) gen (LowBytely l) [] = SUB A (LowByteOf (NamedLocation Nothing l)) @@ -365,44 +353,34 @@ sbc = do and :: Parser Instruction and = do - string "and" - spaces - addressing_mode gen + addressing_mode "and" gen where gen (Immediately v) [] = AND A (Immediate v) gen (Directly l) [] = AND A (NamedLocation Nothing l) ora :: Parser Instruction ora = do - string "ora" - spaces - addressing_mode gen + addressing_mode "ora" gen where gen (Immediately v) [] = OR A (Immediate v) gen (Directly l) [] = OR A (NamedLocation Nothing l) eor :: Parser Instruction eor = do - string "eor" - spaces - addressing_mode gen + addressing_mode "eor" gen where gen (Immediately v) [] = XOR A (Immediate v) gen (Directly l) [] = XOR A (NamedLocation Nothing l) bit :: Parser Instruction bit = do - string "bit" - spaces - addressing_mode gen + addressing_mode "bit" gen where gen (Directly l) [] = BIT (NamedLocation Nothing l) lda :: Parser Instruction lda = do - string "lda" - spaces - addressing_mode gen + addressing_mode "lda" gen where gen (Immediately v) [] = COPY (Immediate v) A gen (LowBytely l) [] = COPY (LowByteOf (NamedLocation Nothing l)) A @@ -413,27 +391,21 @@ lda = do ldx :: Parser Instruction ldx = do - string "ldx" - spaces - addressing_mode gen + addressing_mode "ldx" gen where gen (Immediately v) [] = COPY (Immediate v) X gen (Directly l) [] = COPY (NamedLocation Nothing l) X ldy :: Parser Instruction ldy = do - string "ldy" - spaces - addressing_mode gen + addressing_mode "ldy" gen where gen (Immediately v) [] = COPY (Immediate v) Y gen (Directly l) [] = COPY (NamedLocation Nothing l) Y sta :: Parser Instruction sta = do - string "sta" - spaces - addressing_mode gen + addressing_mode "sta" gen where gen (LowBytely l) [] = COPY A (LowByteOf (NamedLocation Nothing l)) gen (HighBytely l) [] = COPY A (HighByteOf (NamedLocation Nothing l))