Implement DPEEK/DPOKE

Author: willisblackburn

Makefile

@@ -78,7 +78,7 @@ basic_vc83_serial: basic_vc83_serial.o
 	$(PRINT_SIZE)
 
 basic_vc83_serial.mem: basic_vc83_serial
-	srec_cat $< -Binary -offset 0x0400 -Output $@ -VMem 8
+	if command -v srec_cat >/dev/null; then srec_cat $< -Binary -offset 0x0400 -Output $@ -VMem 8; else echo "srec_cat not installed"; touch $@; fi 
 
 # Rule for version.inc
 version.inc: FORCE

constants.m4

@@ -42,9 +42,11 @@ def(ST_DATA,           20)
 def(ST_READ,           21)
 def(ST_RESTORE,        22)
 def(ST_POKE,           23)
-def(ST_END,            24)
-def(ST_INPUT,          25)
-def(ST_IF_THEN,        26)
+def(ST_DPOKE,          24)
+def(ST_END,            25)
+def(ST_INPUT,          26)
+def(ST_IF_THEN,        27)
+
 
 comment Binary operator tokens: combine with TOKEN_OP
 

expect_tests/list.exp

@@ -10,7 +10,6 @@ spawn_basic
 # Formatting of expressions in LIST
 
 test {
-NEW
 100 PRINT 1
 101 PRINT X
 102 PRINT X+1
@@ -53,10 +52,17 @@ LIST
 118 PRINT "HELLO" AND "WORLD"
 }
 
+test {
+NEW
+} {
+READY
+}
+
 # DATA and REM retain all characters
 
 test {
 10 DATA 1,2,3
+
 20 DATA TEXT WITHOUT QUOTES, "TEXT WITH QUOTES", 3.14159, !@#
 LIST
 } {

expect_tests/peek_poke.exp

@@ -40,3 +40,51 @@ PRINT PEEK(ADDR, 1)
 } {
 ERR: ARITY?
 }
+
+# DPEEK and DPOKE
+
+test {
+NEW
+} {
+READY
+}
+
+test {
+10 LET A$="HELLO"
+20 LET ADDR=ADR(A$)
+30 PRINT DPEEK(ADDR)
+40 DPOKE ADDR,18761
+50 PRINT A$
+RUN
+} {
+17736
+IILLO
+
+READY
+}
+
+test {
+PRINT DPEEK()
+} {
+ERR: SYNTAX
+}
+
+test {
+PRINT DPEEK(ADDR, 1)
+} {
+ERR: ARITY?
+}
+
+test {
+DPOKE ADDR
+} {
+ERR: SYNTAX
+}
+
+test {
+DPOKE ADDR, 1, 2
+} {
+ERR: SYNTAX
+}
+
+

functions.s

@@ -25,6 +25,8 @@ function_table:
     .byte   1 | PROLOG_POP_FP | EPILOG_PUSH_INT
     .word   fun_peek-1
     .byte   1 | PROLOG_POP_INT | EPILOG_PUSH_INT
+    .word   fun_dpeek-1
+    .byte   1 | PROLOG_POP_INT | EPILOG_PUSH_INT
     .word   fun_adr-1
     .byte   1 | PROLOG_POP_STRING | EPILOG_PUSH_INT
     .word   fun_usr-1
@@ -172,6 +174,15 @@ fun_len:
         ldx     #0                      ; Zero-extend to 16 bits; for len we receive the string length in A
         rts
 
+fun_dpeek:
+        jsr     fun_peek                ; Leaves pointer in BC and Y=0
+        pha
+        iny
+        lda     (BC),y                  ; Get high byte
+        tax
+        pla
+        rts
+
 .bss
 
 rnd_value:      .res .sizeof(Float::t)

parser.s

@@ -864,6 +864,8 @@ statement_name_table:
             JUMP pvm_opt_number
 :       name_table_entry "POKE"
             JUMP pvm_arg_2
+:       name_table_entry "DPOKE"
+            JUMP pvm_arg_2
 :       name_table_entry "END"
 :       name_table_entry "INPUT"
             TRY @vars
@@ -949,6 +951,7 @@ function_name_table:
 :       name_table_entry "VAL"
 :       name_table_entry "FRE"
 :       name_table_entry "PEEK"
+:       name_table_entry "DPEEK"
 :       name_table_entry "ADR"
 :       name_table_entry "USR"
 :       name_table_entry "INT"

poke.s

@@ -7,10 +7,18 @@
 exec_poke:
         jsr     evaluate_argument_list
         jsr     pop_int_fp0             ; Pop the value
-        pha                             ; Push the low byte; high byte doesn't matter
+        stax    DE                      ; Save
         jsr     pop_int_fp0             ; Pop the address
         stax    BC                      ; Park it
         ldy     #0                      ; Prepare to store
-        pla                             ; Recover the value
+        lda     D
         sta     (BC),y                  ; Store it
         rts
+
+exec_dpoke:
+        jsr     exec_poke               ; Leaves high byte in E and Y=0
+        iny
+        lda     E
+        sta     (BC),y                  ; Store it
+        rts
+

statements.s

@@ -44,6 +44,7 @@ statement_vectors:
         .word   exec_read-1
         .word   exec_restore-1
         .word   exec_poke-1
+        .word   exec_dpoke-1
         .word   exec_end-1
         .word   exec_input-1
         .word   exec_if-1