Initial work on if/repeat numbering.

README.markdown

@@ -98,6 +98,16 @@ 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.
 
+Unsupported Opcodes
+-------------------
+
+6502 opcodes with no language-level equivalent instructions in SixtyPical
+are `brk`, `cli`, `jmp`, `pla`, `plp`, `rti`, and `rts`.  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
 --------------------------
 
@@ -130,8 +140,6 @@ In these, `absolute` must be a `reserve`d or `locate`d address.
     
       if bpl { block } else { block }
     
-    ! brk
-    
       if bvc { block } else { block }
     
       if bvs { block } else { block }
@@ -140,8 +148,6 @@ In these, `absolute` must be a `reserve`d or `locate`d address.
     
       cld
     
-    ! cli
-    
       clv
     
       cmp #immediate
@@ -168,8 +174,6 @@ In these, `absolute` must be a `reserve`d or `locate`d address.
     
       iny
     
-    ! jmp
-    
     * jsr routine
     
       lda #immediate
@@ -193,20 +197,12 @@ In these, `absolute` must be a `reserve`d or `locate`d address.
     
     X php { block }
     
-    ! pla -- (although note this does change flags)
-    
-    ! plp -- (although note this does change flags -- obviously)
-    
     X rol
     X rol absolute
     
     X ror
     X ror absolute
     
-    ! rti
-    
-    ! rts
-    
     X sbc #immediate
     X sbc absolute
     
@@ -242,7 +238,6 @@ TODO
 *   Character tables ("strings" to everybody else)
 *   External routines
 *   Work out the analyses again and document them
-*   parse support immediate loads, compares
 *   number ifs and repeats
 *   `repeat jmp`
 *   Addressing modes; rename instructions to match
@@ -429,12 +424,12 @@ No duplicate declarations.
     = main:
     =   lda screen
     =   cmp screen
-    =   BEQ _label
+    =   BEQ _label_0
     =   tay
-    =   jmp _past
-    = _label:
+    =   jmp _past_0
+    = _label_0:
     =   tax
-    = _past:
+    = _past_0:
     =   sta screen
     =   rts
 
@@ -459,10 +454,10 @@ No duplicate declarations.
     = main:
     =   ldy zero
     =   
-    = _repeat:
+    = _repeat_0:
     =   inc screen
     =   dey
     =   cpy zero
-    =   BNE _repeat
+    =   BNE _repeat_0
     =   sty screen
     =   rts

src/SixtyPical/Analyzer.hs

@@ -55,6 +55,7 @@ checkRoutines (rout@(Routine name _) : routs) progCtx =
     in
         checkRoutines routs progCtx'
 
+-- TODO: have this call checkblock on its instrs, use checkblock below too...
 checkRoutine (Routine _ []) progCtx routCtx = routCtx
 checkRoutine (Routine name (instr : instrs)) progCtx routCtx =
     let
@@ -75,8 +76,11 @@ checkInstr (JSR name) progCtx routCtx =
 checkInstr (CMP reg addr) progCtx routCtx =
     -- TODO: mark Carry bit as "touched" here
     routCtx
-checkInstr (IF branch b1 b2) progCtx routCtx =
+checkInstr (IF _ branch b1 b2) progCtx routCtx =
     -- TODO: oooh, this one's gonna be fun
     routCtx
+checkInstr (REPEAT _ branch blk) progCtx routCtx =
+    -- TODO: oooh, this one's gonna be fun too
+    routCtx
 checkInstr NOP progCtx routCtx =
     routCtx

src/SixtyPical/Checker.hs

@@ -34,8 +34,10 @@ instrUsedLocations (COPY (NamedLocation loc) _) = [loc]
 instrUsedLocations (COPY _ (NamedLocation loc)) = [loc]
 instrUsedLocations (CMP reg (NamedLocation loc)) = [loc]
 -- TODO: JSR...
-instrUsedLocations (IF branch b1 b2) =
+instrUsedLocations (IF _ branch b1 b2) =
     blockUsedLocations b1 ++ blockUsedLocations b2
+instrUsedLocations (REPEAT _ branch blk) =
+    blockUsedLocations blk
 instrUsedLocations _ = []
 
 allRoutineLocationsDeclared program routine =

src/SixtyPical/Emitter.hs

@@ -72,18 +72,18 @@ emitInstr p r (COPY A Y) = "tay"
 emitInstr p r (COPY X A) = "txa"
 emitInstr p r (COPY Y A) = "tya"
 
-emitInstr p r (IF branch b1 b2) =
-    (show branch) ++ " _label\n" ++
+emitInstr p r (IF iid branch b1 b2) =
+    (show branch) ++ " _label_" ++ (show iid) ++ "\n" ++
     emitInstrs p r b2 ++
-    "  jmp _past\n" ++
-    "_label:\n" ++
+    "  jmp _past_" ++ (show iid) ++ "\n" ++
+    "_label_" ++ (show iid) ++ ":\n" ++
     emitInstrs p r b1 ++
-    "_past:"
+    "_past_" ++ (show iid) ++ ":"
 
-emitInstr p r (REPEAT branch blk) =
-    "\n_repeat:\n" ++
+emitInstr p r (REPEAT iid branch blk) =
+    "\n_repeat_" ++ (show iid) ++ ":\n" ++
     emitInstrs p r blk ++
-    "  " ++ (show branch) ++ " _repeat"
+    "  " ++ (show branch) ++ " _repeat_" ++ (show iid)
 
 emitInstr p r i = error "Internal error: sixtypical doesn't know how to emit assembler code for '" ++ show i ++ "'"
 

src/SixtyPical/Model.hs

@@ -7,6 +7,8 @@ module SixtyPical.Model where
 type DataValue = Int -- LET'S ASSUME THIS IS AT LEAST 8 BITS
 type Address = Int -- LET'S ASSUME THIS IS AT LEAST 16 BITS
 
+type InternalID = Int -- for numbering labels for if/repeat
+
 type LocationName = String
 
 -- We do not include the PC as it of course changes constantly.
@@ -54,8 +56,8 @@ data Instruction = LOADIMM StorageLocation DataValue
                  | CMPIMM StorageLocation DataValue
                  | CMP StorageLocation StorageLocation
                  | JSR RoutineName
-                 | IF Branch [Instruction] [Instruction]
-                 | REPEAT Branch [Instruction]
+                 | IF InternalID Branch [Instruction] [Instruction]
+                 | REPEAT InternalID Branch [Instruction]
                  | DELTA StorageLocation DataValue
                  | NOP
     deriving (Show, Ord, Eq)

src/SixtyPical/Parser.hs

@@ -271,7 +271,7 @@ if_statement = do
     string "else"
     spaces
     b2 <- block
-    return (IF brch b1 b2)
+    return (IF 0 brch b1 b2)
 
 repeat_statement :: Parser Instruction
 repeat_statement = do
@@ -279,7 +279,7 @@ repeat_statement = do
     spaces
     brch <- branch
     blk <- block
-    return (REPEAT brch blk)
+    return (REPEAT 0 brch blk)
 
 branch :: Parser Branch
 branch = try (b "bcc" BCC) <|> try (b "bcs" BCS) <|> try (b "beq" BEQ) <|>