1
0
mirror of https://github.com/catseye/SixtyPical.git synced 2025-01-10 17:31:18 +00:00

A refactor

This commit is contained in:
Cat's Eye Technologies 2014-04-03 19:30:40 +01:00
parent f4a77ae5c4
commit 569de53797
3 changed files with 352 additions and 62 deletions

View File

@ -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

View File

@ -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
| lda >vword
| inc vbyte
| tax
| inx
| dex
| stx vbyte
| tay
| iny
| dey
| sty vbyte
| cmp vbyte
| cmp #30
| cmp <vword
| 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
| 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

View File

@ -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))