6502/SixtyPical
1
0
Fork 0
mirror of https://github.com/catseye/SixtyPical.git synced 2024-09-30 14:57:03 +00:00
Code Issues Projects Releases Wiki Activity

typematching

Browse Source
This commit is contained in:
Cat's Eye Technologies 2014-04-02 20:50:35 +01:00
parent d225d1e727
commit f5df4e5680
2 changed files with 93 additions and 63 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

122
README.markdown
View File

@ -467,9 +467,17 @@ We cannot absolute access a word.
| assign word screen 1024 | assign word screen 1024
| routine main { | routine main {
| lda screen | ldx screen
| } | }
? absolute access of non-byte-based address ? incompatible types 'Word' and 'Byte'
No, not even with `ora`.
| assign word screen 1024
| routine main {
| ora screen
| }
? incompatible types 'Byte' and 'Word'
Instead, we have to do this. Instead, we have to do this.
@ -480,112 +488,122 @@ Instead, we have to do this.
| } | }
= True = True
We cannot absolute access a vector.
| assign vector screen 1024
| routine main {
| lda screen
| }
? incompatible types 'Vector' and 'Byte'
-> Tests for functionality "Emit ASM for SixtyPical program" -> Tests for functionality "Emit ASM for SixtyPical program"
-> Functionality "Emit ASM for SixtyPical program" is implemented by -> Functionality "Emit ASM for SixtyPical program" is implemented by
-> shell command "bin/sixtypical emit %(test-file)" -> shell command "bin/sixtypical emit %(test-file)"
| reserve word score | reserve word vword
| assign byte table screen 1024 | reserve byte vbyte
| assign byte table table 1024
| routine main { | routine main {
| lda #4 | lda #4
| ldx #0 | ldx #0
| ldy #$FF | ldy #$FF
| lda screen | lda vbyte
| lda screen, x | lda table, x
| lda screen, y | lda table, y
| lda (screen), y | lda (vword), y
| lda <score | lda <vword
| lda >score | lda >vword
| inc screen | inc vbyte
| tax | tax
| inx | inx
| dex | dex
| stx score | stx vbyte
| tay | tay
| iny | iny
| dey | dey
| sty score | sty vbyte
| cmp score | cmp vbyte
| cmp #30 | cmp #30
| ldx score | ldx vbyte
| cpx screen | cpx vbyte
| cpx #31 | cpx #31
| txa | txa
| ldy score | ldy vbyte
| cpy screen | cpy vbyte
| cpy #32 | cpy #32
| tya | tya
| sta screen | sta vbyte
| sta screen, x | sta table, x
| sta screen, y | sta table, y
| sta (screen), y | sta (vword), y
| dec screen | dec vbyte
| clc | clc
| cld | cld
| clv | clv
| sec | sec
| sed | sed
| adc #8 | adc #8
| adc screen | adc vbyte
| and #8 | and #8
| and screen | and vbyte
| sbc #8 | sbc #8
| sbc screen | sbc vbyte
| ora #8 | ora #8
| ora screen | ora vbyte
| } | }
= main: = main:
= lda #4 = lda #4
= ldx #0 = ldx #0
= ldy #255 = ldy #255
= lda screen = lda vbyte
= lda screen, x = lda table, x
= lda screen, y = lda table, y
= lda (screen), y = lda (vword), y
= lda score = lda vword
= lda score+1 = lda vword+1
= inc screen = inc vbyte
= tax = tax
= inx = inx
= dex = dex
= stx score = stx vbyte
= tay = tay
= iny = iny
= dey = dey
= sty score = sty vbyte
= cmp score = cmp vbyte
= cmp #30 = cmp #30
= ldx score = ldx vbyte
= cpx screen = cpx vbyte
= cpx #31 = cpx #31
= txa = txa
= ldy score = ldy vbyte
= cpy screen = cpy vbyte
= cpy #32 = cpy #32
= tya = tya
= sta screen = sta vbyte
= sta screen, x = sta table, x
= sta screen, y = sta table, y
= sta (screen), y = sta (vword), y
= dec screen = dec vbyte
= clc = clc
= cld = cld
= clv = clv
= sec = sec
= sed = sed
= adc #8 = adc #8
= adc screen = adc vbyte
= and #8 = and #8
= and screen = and vbyte
= sbc #8 = sbc #8
= sbc screen = sbc vbyte
= ora #8 = ora #8
= ora screen = ora vbyte
= rts = rts
= =
= score: .word 0 = vword: .word 0
= .alias screen 1024 = vbyte: .byte 0
= .alias table 1024
| assign byte screen $0400 | assign byte screen $0400
| routine main { | routine main {

34
src/SixtyPical/Checker.hs
View File

@ -111,22 +111,17 @@ fillOutNamedLocationTypes p@(Program decls routines) =
mapProgramRoutines (xform) p mapProgramRoutines (xform) p
where where
xform (COPY src dest) = xform (COPY src dest) =
-- ewww special-case-y typeMatch src dest (COPY)
case ((resolve src), (resolve dest)) of
((NamedLocation (Just Word) name), A) ->
error ("absolute access of non-byte-based address '" ++ name ++ "'")
_ ->
COPY (resolve src) (resolve dest)
xform (CMP dest other) = xform (CMP dest other) =
CMP (resolve dest) (resolve other) typeMatch dest other (CMP)
xform (ADD dest other) = xform (ADD dest other) =
ADD (resolve dest) (resolve other) typeMatch dest other (ADD)
xform (AND dest other) = xform (AND dest other) =
AND (resolve dest) (resolve other) typeMatch dest other (AND)
xform (SUB dest other) = xform (SUB dest other) =
SUB (resolve dest) (resolve other) typeMatch dest other (SUB)
xform (OR dest other) = xform (OR dest other) =
OR (resolve dest) (resolve other) typeMatch dest other (OR)
xform (JMPVECTOR dest) = xform (JMPVECTOR dest) =
case (resolve dest) of case (resolve dest) of
d@(NamedLocation (Just Vector) _) -> d@(NamedLocation (Just Vector) _) ->
@ -147,6 +142,23 @@ fillOutNamedLocationTypes p@(Program decls routines) =
COPYROUTINE name (resolve dest) COPYROUTINE name (resolve dest)
xform other = xform other =
other other
getType (NamedLocation (Just t) _) = t
getType A = Byte
getType X = Byte
getType Y = Byte
getType _ = Byte
typeMatch x y constructor =
let
rx = resolve x
ry = resolve y
typeRx = getType rx
typeRy = getType ry
in
case (typeRx == typeRy, typeRx, typeRy) of
(True, _, _) -> constructor rx ry
(_, Byte, ByteTable) -> constructor rx ry
(_, ByteTable, Byte) -> constructor rx ry
_ -> error ("incompatible types '" ++ (show typeRx) ++ "' and '" ++ (show typeRy) ++ "'")
resolve (NamedLocation Nothing name) = resolve (NamedLocation Nothing name) =
case lookupDecl p name of case lookupDecl p name of
Just decl -> Just decl ->