Generalized copy command for great justice.

doc/Emitting.markdown

@@ -104,7 +104,7 @@ Installing an interrupt handler (at the Kernal level, i.e. with CINV)
     | 
     | routine main {
     |   sei {
-    |     copy vector cinv to save_cinv
+    |     copy cinv save_cinv
     |     copy routine our_cinv to cinv
     |   }
     | }
@@ -134,3 +134,31 @@ Installing an interrupt handler (at the Kernal level, i.e. with CINV)
     = .alias screen 1024
     = .alias cinv 788
     = save_cinv: .word 0
+
+Copy command: immediate -> byte
+
+    | reserve byte position
+    | routine main {
+    |     copy #23 position
+    | }
+    = main:
+    =   lda #23
+    =   sta position
+    =   rts
+    = 
+    = position: .byte 0
+
+Copy command: immediate -> word
+
+    | reserve word position 
+    | routine main {
+    |     copy #$0400 position
+    | }
+    = main:
+    =   lda #0
+    =   sta position
+    =   lda #4
+    =   sta position+1
+    =   rts
+    = 
+    = position: .word 0

eg/cinv.60p

@@ -4,7 +4,7 @@ reserve vector save_cinv
 
 routine main {
   sei {
-    copy vector cinv to save_cinv
+    copy cinv save_cinv
     copy routine our_cinv to cinv
   }
 }

eg/game.60p

@@ -34,7 +34,7 @@ routine main {
     jsr reset_position
     jsr clear_screen
     sei {
-        copy vector cinv to save_cinv
+        copy cinv save_cinv
         copy routine our_cinv to cinv
     }
     clc
@@ -42,8 +42,7 @@ routine main {
 }
 
 routine our_cinv {
-    lda value
+    lda #32
-    inc value
     ldy #0
     sta (position), y
     jsr read_stick
@@ -53,14 +52,15 @@ routine our_cinv {
         jsr install_new_position
     } else { }
 
+    lda #81
+    ldy #0
+    sta (position), y
+
     jmp (save_cinv)
 }
 
 routine reset_position {
-    lda #$00
+    copy #$0400 position
-    sta <position
-    lda #$04
-    sta >position
 }
 
 routine advance_pos {
@@ -74,27 +74,18 @@ routine advance_pos {
 }
 
 routine install_new_position {
-    lda <new_position
+    copy new_position position
-    sta <position
-    lda >new_position
-    sta >position
 }
 
 routine check_new_position_in_bounds {
-    lda #$07                 ; just past bottom of screen
+    copy #$07e8 compare_target      ; just past bottom of screen
-    sta >compare_target
-    lda #$e8
-    sta <compare_target
     jsr compare_new_pos
 
     if bcs {
         clc
     } else {
 
-        lda #$04
+        copy #$0400 compare_target
-        sta >compare_target
-        lda #$00
-        sta <compare_target
         jsr compare_new_pos
 
         if bcc {

src/SixtyPical/Checker.hs

@@ -146,6 +146,8 @@ fillOutNamedLocationTypes p@(Program decls routines) =
         getType A = Byte
         getType X = Byte
         getType Y = Byte
+        getType (Immediate x) =
+            if x > 255 then Word else Byte
         getType _ = Byte
         typeMatch x y constructor =
             let

src/SixtyPical/Emitter.hs

@@ -2,6 +2,8 @@
 
 module SixtyPical.Emitter where
 
+import Data.Bits
+
 import SixtyPical.Model
 
 emitProgram p@(Program decls routines) =
@@ -69,6 +71,27 @@ emitInstr p r (COPY (Indexed (NamedLocation (Just ByteTable) label) Y) A) = "lda
 emitInstr p r (COPY A (IndirectIndexed (NamedLocation st label) Y)) = "sta (" ++ label ++ "), y"
 emitInstr p r (COPY (IndirectIndexed (NamedLocation st label) Y) A) = "lda (" ++ label ++ "), y"
 
+emitInstr p r (COPY (NamedLocation (Just st1) src) (NamedLocation (Just st2) dst))
+  | (st1 == Vector && st2 == Vector) || (st1 == Word && st2 == Word) =
+    "lda " ++ src ++ "\n" ++
+    "  sta " ++ dst ++ "\n" ++
+    "  lda " ++ src ++ "+1\n" ++
+    "  sta " ++ dst ++ "+1"
+
+emitInstr p r (COPY (Immediate v) (NamedLocation (Just st) dst))
+  | st == Byte =
+    "lda #" ++ (show v) ++ "\n" ++
+    "  sta " ++ dst
+  | st == Word =
+    let
+        low = v .&. 255
+        high = (shift v (-8)) .&. 255
+    in
+        "lda #" ++ (show low) ++ "\n" ++
+        "  sta " ++ dst ++ "\n" ++
+        "  lda #" ++ (show high) ++ "\n" ++
+        "  sta " ++ dst ++ "+1"
+
 emitInstr p r (CMP A (NamedLocation st label)) = "cmp " ++ label
 emitInstr p r (CMP X (NamedLocation st label)) = "cpx " ++ label
 emitInstr p r (CMP Y (NamedLocation st label)) = "cpy " ++ label
@@ -144,12 +167,6 @@ emitInstr p r (PUSH FlagC blk) =
     emitInstrs p r blk ++
     "  plp"
 
-emitInstr p r (COPYVECTOR (NamedLocation (Just Vector) src) (NamedLocation (Just Vector) dst)) =
-    "lda " ++ src ++ "\n" ++
-    "  sta " ++ dst ++ "\n" ++
-    "  lda " ++ src ++ "+1\n" ++
-    "  sta " ++ dst ++ "+1"
-
 emitInstr p r (COPYROUTINE src (NamedLocation (Just Vector) dst)) =
     "lda #<" ++ src ++ "\n" ++
     "  sta " ++ dst ++ "\n" ++

src/SixtyPical/Parser.hs

@@ -203,8 +203,8 @@ command = (try lda) <|>
           (try rol) <|> (try ror) <|>
           (try sei) <|> (try pha) <|> (try php) <|>
           (try jmp) <|> (try jsr) <|>
-          (try copy_vector_statement) <|>
           (try copy_routine_statement) <|>
+          (try copy_general_statement) <|>
           if_statement <|> repeat_statement <|> nop
 
 nop :: Parser Instruction
@@ -508,17 +508,17 @@ repeat_statement = do
     blk <- block
     return (REPEAT 0 brch blk)
 
-copy_vector_statement :: Parser Instruction
+copy_general_statement :: Parser Instruction
-copy_vector_statement = do
+copy_general_statement = do
     string "copy"
     spaces
-    string "vector"
+    src <- (try immediate <|> try direct_location)
-    spaces
+    dst <- direct_location
-    src <- locationName
+    return $ case (src, dst) of
-    string "to"
+        (Immediately s, Directly d) ->
-    spaces
+            (COPY (Immediate s) (NamedLocation Nothing d))
-    dst <- locationName
+        (Directly s, Directly d) ->
-    return (COPYVECTOR (NamedLocation Nothing src) (NamedLocation Nothing dst))
+            (COPY (NamedLocation Nothing s) (NamedLocation Nothing d))
 
 copy_routine_statement :: Parser Instruction
 copy_routine_statement = do