A refactor

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
+There are also _with_ instructions, which are associated with three opcodes
-that has a natural symmetrical opcode (e.g. `pha`, `sei`).  These instructions
+that have natural symmetrical opcodes: `pha`, `php`, and `sei`.  These
-take a block.  The natural symmetrical opcode is inserted at the end of the
+instructions take a block.  The natural symmetrical opcode is inserted at
-block.
+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

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

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 :: String -> (AddressingModality -> [StorageLocation] -> Instruction) -> Parser Instruction
-addressing_mode f = do
+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"
+    addressing_mode "asl" gen
-    spaces
-    addressing_mode 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"
+    addressing_mode "lsr" gen
-    spaces
-    addressing_mode 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"
+    addressing_mode "rol" gen
-    spaces
-    addressing_mode gen
     where
        gen (Implicitly A) [] = SHL A FlagC
        gen (Directly l) [] = SHL (NamedLocation Nothing l) FlagC
 
 ror :: Parser Instruction
 ror = do
-    string "ror"
+    addressing_mode "ror" gen
-    spaces
-    addressing_mode 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"
+    addressing_mode "cmp" gen
-    spaces
-    addressing_mode 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"
+    addressing_mode "cpx" gen
-    spaces
-    addressing_mode gen
     where
        gen (Immediately v) [] = CMP X (Immediate v)
        gen (Directly l) [] = CMP X (NamedLocation Nothing l)
 
 cpy :: Parser Instruction
 cpy = do
-    string "cpy"
+    addressing_mode "cpy" gen
-    spaces
-    addressing_mode gen
     where
        gen (Immediately v) [] = CMP Y (Immediate v)
        gen (Directly l) [] = CMP Y (NamedLocation Nothing l)
 
 adc :: Parser Instruction
 adc = do
-    string "adc"
+    addressing_mode "adc" gen
-    spaces
-    addressing_mode 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"
+    addressing_mode "sbc" gen
-    spaces
-    addressing_mode 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"
+    addressing_mode "and" gen
-    spaces
-    addressing_mode gen
     where
        gen (Immediately v) [] = AND A (Immediate v)
        gen (Directly l) [] = AND A (NamedLocation Nothing l)
 
 ora :: Parser Instruction
 ora = do
-    string "ora"
+    addressing_mode "ora" gen
-    spaces
-    addressing_mode gen
     where
        gen (Immediately v) [] = OR A (Immediate v)
        gen (Directly l) [] = OR A (NamedLocation Nothing l)
 
 eor :: Parser Instruction
 eor = do
-    string "eor"
+    addressing_mode "eor" gen
-    spaces
-    addressing_mode gen
     where
        gen (Immediately v) [] = XOR A (Immediate v)
        gen (Directly l) [] = XOR A (NamedLocation Nothing l)
 
 bit :: Parser Instruction
 bit = do
-    string "bit"
+    addressing_mode "bit" gen
-    spaces
-    addressing_mode gen
     where
        gen (Directly l) [] = BIT (NamedLocation Nothing l)
 
 lda :: Parser Instruction
 lda = do
-    string "lda"
+    addressing_mode "lda" gen
-    spaces
-    addressing_mode 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"
+    addressing_mode "ldx" gen
-    spaces
-    addressing_mode gen
     where
        gen (Immediately v) [] = COPY (Immediate v) X
        gen (Directly l) [] = COPY (NamedLocation Nothing l) X
 
 ldy :: Parser Instruction
 ldy = do
-    string "ldy"
+    addressing_mode "ldy" gen
-    spaces
-    addressing_mode gen
     where
        gen (Immediately v) [] = COPY (Immediate v) Y
        gen (Directly l) [] = COPY (NamedLocation Nothing l) Y
 
 sta :: Parser Instruction
 sta = do
-    string "sta"
+    addressing_mode "sta" gen
-    spaces
-    addressing_mode gen
     where
        gen (LowBytely l) [] = COPY A (LowByteOf (NamedLocation Nothing l))
        gen (HighBytely l) [] = COPY A (HighByteOf (NamedLocation Nothing l))