VP and forth-wordlist as pvalues

arm/dev/amforth.gdb

@@ -121,12 +121,31 @@ define .mps
   x/a *(unsigned int *)(PFA_VP+4)
 end
 
+# show flash cache
+define .fc
+  printf "         dp "
+  x/xw &DP_ram
+  printf "   dp.flash "
+  x/xw &DP_FLASH_ram
+  printf "forth-wlist "
+  x/xw &FORTH_WORDLIST_ram
+  printf "   dp.cache "
+  x/dw &DP_CACHE_ram
+  printf "flash.cache "
+  x/2xw &FLASH_CACHE_ram
+end
+
 # to help stepping through colon words, put a breakpoint at DO_EXECUTE
 # and add commands to step twice to get into the next word's code.
 # You can then move to the next word with 'continue'.
 # Use 'disable/enable' to (de)activate the breakpoint.
+# Optionally pass word XT symbol to break when that word is being executed.
 define bde
-  hbreak DO_EXECUTE
+  if $argc == 1
+    hbreak DO_EXECUTE if $r8 == $arg0
+  else
+    hbreak DO_EXECUTE
+  end
   commands
     step 2
   end
@@ -135,4 +154,4 @@ end
 # set breakpoint in the `break` word
 define bb
   hbreak PFA_BREAK
-end
+end

arm/mcu/ra4m1/Makefile

@@ -78,6 +78,7 @@ ocd:
 		-c "adapter driver cmsis-dap" \
 		-c "transport select swd" \
 		-f dev/R7FA4M1AB.cfg
+		# -c "init; ra4m1.cpu configure -event gdb-detach { resume }"
 
 # If you don't have/want python enabled GDB you can
 # * replace $(GDBPY) with $(GDB)

arm/mcu/ra4m1/config.inc

@@ -6,5 +6,6 @@
 .equ flash_cell, 8
 .equ flash_erased, 0xFFFFFFFF /* a word in erased flash */
 
+# RA4 has non-rewritable code flash with 8 byte flash page.
 .equ RA_FLASH, YES
 

arm/mcu/ra4m1/words/flash.s

@@ -38,7 +38,7 @@ COLON "flash.init" , FLASH_INIT /* ( -- ) set defers for NFF */
     .word XT_DOLITERAL
     .word XT_TILDEDODALLOT
     .word XT_DOLITERAL    
-    .word XT_LPARENDALLOTRPAREN
+    .word XT_DODALLOT
     .word XT_CELLPLUS
 	.word XT_FETCH
 	.word XT_STORE
@@ -47,7 +47,7 @@ COLON "flash.init" , FLASH_INIT /* ( -- ) set defers for NFF */
     .word XT_DOLITERAL
     .word XT_TILDEDOCCOMMA
     .word XT_DOLITERAL
-    .word XT_LPARENCCOMMARPAREN
+    .word XT_DOCCOMMA
     .word XT_CELLPLUS
 	.word XT_FETCH
 	.word XT_STORE
@@ -119,9 +119,8 @@ COLON "~!i", TILDEBANGI /* ( x addr -- ) write x at addr in flash */
 	.word XT_DP0_FLASH
 	.word XT_LESS
 	.word XT_DOCONDBRANCH,TILDEBANGI_0001 /* # if */
-	.word XT_DOLITERAL
-	.word -10    /* replace with more suitable value */
-	.word XT_THROW
+	/* replace with more suitable value */
+	.word XT_DOLITERAL, -10, XT_THROW
 TILDEBANGI_0001: /* # then */
 	.word XT_FLASH_CACHE
 	.word XT_FLASH_SHADOW
@@ -153,73 +152,60 @@ COLON "2!i", 2STOREI /* ( x1 x2 addr -- ) [addr] = x2, [addr+cellsize] = x1 (in
 	.word XT_DP0_FLASH
 	.word XT_LESS
 	.word XT_DOCONDBRANCH, 1f /* # if */
-	.word XT_DOLITERAL
-	.word -10    /* replace with more suitable value */
-	.word XT_THROW
+	/* replace with more suitable value */
+	.word XT_DOLITERAL, -10, XT_THROW
 1:	/* # then */
+	/* back up flash.cache */
+	.word XT_FLASH_CACHE, XT_FLASH_SHADOW, XT_FLASH_CELL, XT_MOVE
 	.word XT_MROT /* ( addr x1 x2 ) */
 	.word XT_FLASH_CACHE, XT_STORE
 	.word XT_FLASH_CACHE, XT_CELLPLUS, XT_STORE
 	.word XT_DOFLASH_WRITE
+	/* restore flash cache */
+	.word XT_FLASH_SHADOW, XT_FLASH_CACHE, XT_FLASH_CELL, XT_MOVE
 	.word XT_EXIT
 END 2STOREI
 
 # ----------------------------------------------------------------------
 
-COLON "~(dallot)", TILDEDODALLOT 
-	.word XT_DP
-	.word XT_FLASH_PAGE
-	.word XT_MOD
-	.word XT_ZEROEQUAL
+COLON "~(dallot)", TILDEDODALLOT /* ( u -- allocate u bytes in the dictionary ) */
+	/* Are we crossing over to the next flash page? (dp mod flash.page) + u >= flash.page ? */
+	.word XT_DUP, XT_DP, XT_FLASH_PAGE, XT_MOD, XT_PLUS, XT_FLASH_PAGE, XT_GREATEREQUAL
 	.word XT_DOCONDBRANCH,TILDEDODALLOT_0001 /* if */
-	.word XT_DP_CACHE
-	.word XT_ZEROEQUAL
-	.word XT_DOCONDBRANCH,TILDEDODALLOT_0002 /* if */
-	.word XT_DP
-	.word XT_DOFLASH_ERASE
-	.word XT_DOBRANCH,TILDEDODALLOT_0003
+		/* Is the flash.cache empty? */
+		.word XT_DP_CACHE, XT_ZEROEQUAL
+		.word XT_DOCONDBRANCH,TILDEDODALLOT_0002 /* if */
+			.word XT_DUP, XT_DP, XT_PLUS, XT_DOFLASH_ERASE /* erase the flash page at DP + u */
+			.word XT_DOBRANCH,TILDEDODALLOT_0003
 TILDEDODALLOT_0002: /* else */
-	.word XT_DROP
-	.word XT_FINISH
+			.word XT_DROP, XT_FINISH /* flash.cache is dirty, exit. TODO: WHY? */
 TILDEDODALLOT_0003: /* then */
 TILDEDODALLOT_0001: /* then */
-	.word XT_TO_R
-	.word XT_R_FETCH
-	.word XT_DP_CACHE
-	.word XT_PLUS
-	.word XT_FLASH_CELL
-	.word XT_LESS
+	.word XT_TO_R, XT_R_FETCH /* copy u to R stack */
+	/* Is u + dp.cache < flash.cell ? */
+	.word XT_DP_CACHE, XT_PLUS, XT_FLASH_CELL, XT_LESS
 	.word XT_DOCONDBRANCH,TILDEDODALLOT_0004 /* if */
-	.word XT_R_FETCH
-	.word XT_CALLOT
-	.word XT_R_FROM
-	.word XT_DP
-	.word XT_PLUS
-	.word XT_DOTO
-	.word XT_DP
-	.word XT_DOBRANCH,TILDEDODALLOT_0005
+		/* allocate u bytes in flash.cache */
+		.word XT_R_FETCH, XT_CALLOT
+		/* increment DP by u */
+		.word XT_R_FROM, XT_DP, XT_PLUS, XT_DOTO, XT_DP
+		.word XT_DOBRANCH,TILDEDODALLOT_0005
 TILDEDODALLOT_0004: /* else */
-	.word XT_R_FETCH
-	.word XT_DP_CACHE
-	.word XT_PLUS
-	.word XT_FLASH_CELL
-	.word XT_EQUAL
-	.word XT_DOCONDBRANCH,TILDEDODALLOT_0006 /* if */
-	.word XT_ZERO
-	.word XT_DOTO
-	.word XT_DP_CACHE
-	.word XT_R_FROM
-	.word XT_DP
-	.word XT_PLUS
-	.word XT_DUP
-	.word XT_DOTO
-	.word XT_DP
-	.word XT_FLASH_WRITE
-	.word XT_DOBRANCH,TILDEDODALLOT_0007
+		/* is u + dp.cache == flash.cell ? */
+		.word XT_R_FETCH, XT_DP_CACHE, XT_PLUS, XT_FLASH_CELL, XT_EQUAL
+		.word XT_DOCONDBRANCH,TILDEDODALLOT_0006 /* if */
+			/* zero out dp.cache */
+			.word XT_ZERO, XT_DOTO, XT_DP_CACHE
+			.word XT_R_FROM, XT_DP, XT_PLUS, XT_DUP
+			/* ( dp+u dp+u ) */
+			.word XT_DOTO, XT_DP /* update dp */
+			.word XT_FLASH_WRITE /* flush the cache */
+			.word XT_DOBRANCH,TILDEDODALLOT_0007
 TILDEDODALLOT_0006: /* else */
-	.word XT_R_FROM
-	.word XT_DROP
-	.word XT_FINISH
+			/* u + dp.cache > flash.cell ? TODO: do nothing? */
+			.word XT_R_FROM
+			.word XT_DROP
+			.word XT_FINISH
 TILDEDODALLOT_0007: /* then */
 TILDEDODALLOT_0005: /* then */
 	.word XT_EXIT

arm/mcu/ra4m1/words/warm.s

@@ -24,9 +24,11 @@ COLON "warm", WARM /* ( -- ) high level part of the boot sequence, VM is running
 2:
   /* check and mark first-boot done */
   .word XT_QFIRST_BOOT, XT_DOCONDBRANCH, 1f
-    .word XT_ZERO, XT_DOTO, XT_PV1
     .word XT_FIRST_BOOT_DONE
 1:
+  /* find the end of the used flash and set DP;
+    do it after first-boot-done so that the first-boot page is erased already */
+  .word XT_INIT_DP_FLASH
 
   .word XT_LBRACKET   
   .word XT_TURNKEY    

arm/words/naligned.s

@@ -1,6 +1,6 @@
 # SPDX-License-Identifier: GPL-3.0-only
 
-CODEWORD "naligned" , NALIGNED /* ( n a1 -- a2 ) a2 is n aligned a1 )  */
+CODEWORD "naligned" , NALIGNED /* ( n a1 -- a2 ) n = 2**u; a2 is a1 aligned (up) at n bytes */
 naligned:
     ldr     r1, [psp]       @ r1 = n (byte count from NOS)
     add     psp, psp, #4    @ pop stack (remove n)

arm/words/warm.s

@@ -22,6 +22,10 @@ COLON "warm", WARM /* ( -- ) high level part of the boot sequence, VM is running
   .word XT_QFIRST_BOOT, XT_DOCONDBRANCH, 1f
     .word XT_FIRST_BOOT_DONE
 1:
+  /* find the end of the used flash and set DP;
+    do it after first-boot-done so that the first-boot page is erased already */
+  .word XT_INIT_DP_FLASH
+
   .word XT_LBRACKET   
   .word XT_TURNKEY    
   .word XT_QUIT       

core/amforth32.ld

@@ -162,6 +162,9 @@ SECTIONS
 		PROVIDE( flash.max = ORIGIN(FLASH) + LENGTH(FLASH));
 	} >FLASH AT>FLASH
 
+	ASSERT(FSH_upper_res <= dp0.flash ,"*ERROR* userdict overlaps amramres")
+
+
 	/*
 		This is not a real section, it just marks a flash page that is filled with known value on upload
 		and that will be erased at the end of the first boot.
@@ -178,9 +181,10 @@ SECTIONS
 		BYTE(0); /* seems to be needed to actually get a write */
 	} >FLASH AT>FLASH
 
+	ASSERT(FSH_upper_res <= first_boot , "*ERROR* first_boot overlaps amramres")
+
 	/* C data sections */
 
-	ASSERT(FSH_upper_res <= dp0.flash , "*ERROR* amramres and userdict overlap")
 
 	.dalign :
 	{

core/dev/Makefile

@@ -109,7 +109,7 @@ build/%.o: %.s buildinfo
 	$(AS) $(ASFLAGS) $(INCLUDES) -o $@ $<
 
 # Sometimes make decides that amforth.elf is an intermediary file that should be deleted.
-.PRECIOUS: build/amforth.elf, build/amforth.dep
+.PRECIOUS: build/amforth.elf build/amforth.dep
 
 build/%.elf: build/%.o
 	$(LD) $(LDFLAGS) $< -o $@ 

core/dev/categories

@@ -63,8 +63,8 @@ SYSTEM:
     cold warm init-ram turnkey appl-turnkey quit pause
     first-boot.done ?first-boot first-boot.marker first-boot.start
     ms us ver rev-info build-info
-    pv.do pv.init vaddr pv.store pvp
-    pvflash.size pvflash.page pvflash.cell pvflash.erased pvflash.erase 2!pvf
+    pv.do pv.init vaddr pv.store pvp pv.reset-hard
+    pvflash.start pvflash.size pvflash.page pvflash.cell pvflash.erased pvflash.erase 2!pvf
     pvarena.size pvarena.init pvarena.swap pvarena.erase pvarena pvarena.dormant pvarena1 pvarena2
 TOOLS:
     debug || dump ?ascii vdump break

core/macros.inc

@@ -24,12 +24,12 @@ VALUE "\ARCH-wordlist", ARCH_WORDLIST, 97b
 END ARCH_WORDLIST
 VALUE "environment", ENVIRONMENT, 98b
 END ENVIRONMENT
-VALUE "forth-wordlist", FORTH_WORDLIST, 99b
-END FORTH_WORDLIST
 .set core_wordlist , 99b
-.set DPSTART, 99b
 CONSTANT "core-wordlist", CORE_WORDLIST, core_wordlist
 END CORE_WORDLIST
+# forth-wordlist needs to be the last of the compiled words
+PVALUE "forth-wordlist", FORTH_WORDLIST, 99b
+END FORTH_WORDLIST
 .endm
 
 .macro STRING string
@@ -238,7 +238,7 @@ PFA_\Label:
    .word \Label\()_ram             
    .word \Default
    .word XT_FETCH
-   .word XT_STORE
+   .word XT_PV_STORE
 .endm
 
 .macro CLOAKED_VALUE Name, Label, Default

core/words/alto.s

@@ -31,23 +31,23 @@ END TO
 #       .word XT_COMMA
 #       .word XT_EXIT
 
-NONAME DOTO
+NONAME DOTO /* ( x -- ) update value identified by xt in the cell following XT_DOTO to x, skip that cell in execution */
     .word XT_R_FROM /* address of the next word in the calling word */
     .word XT_DUP
     .word XT_CELLPLUS
-    .word XT_TO_R /* skip the immediately following word when we return */
+    .word XT_TO_R /* update return IP to skip the immediately following word when we return */
     .word XT_FETCH /* ( xt ) of the following word in the caller */
     .word XT_DOTO1
     .word XT_EXIT
 END DOTO
 
-NONAME DOTO1
-    .word XT_CELLPLUS /* ( xt ) */
-    .word XT_DUP, XT_FETCH, XT_SWAP /* ( ram-address pfa ) */
+NONAME DOTO1 /* ( x xt ) update value identified by xt to x */
+    .word XT_CELLPLUS /* ( x xt ) */
+    .word XT_DUP, XT_FETCH, XT_SWAP /* ( x ram-address pfa ) */
     .word XT_CELLPLUS
     .word XT_CELLPLUS
     .word XT_CELLPLUS
-    .word XT_FETCH /* ( ram-address setter-xt ) */
+    .word XT_FETCH /* ( x ram-address setter-xt ) */
     .word XT_EXECUTE
     .word XT_EXIT
 END DOTO1

core/words/ccomma.s

@@ -1,11 +1,11 @@
 
-DEFER "(c,)", LPARENCCOMMARPAREN, XT_NOP
-END LPARENCCOMMARPAREN
+DEFER "(c,)", DOCCOMMA, XT_NOP
+END DOCCOMMA
 
 COLON "c,", CCOMMA /* ( c -- ) append c to the dictionary */
     .word XT_MEMMODE
     .word XT_DOCONDBRANCH,CCOMMA_0001 /* if */
-    .word XT_LPARENCCOMMARPAREN
+    .word XT_DOCCOMMA
     .word XT_DOBRANCH,CCOMMA_0002
 CCOMMA_0001: # else
     .word XT_DP

core/words/chkdalign.s

@@ -1,22 +1,12 @@
 # SPDX-License-Identifier: GPL-3.0-only
-/*
-WORD:  chkdalign
-STACK: ( -- ) 
-MOTIF: 
-CATEG: system
-STDID: 
-SHORT: check DP for cell alignment, throw exception (-9) if not 
-*/
 
-COLON "chkdalign", CHKDALIGN 
+COLON "chkdalign", CHKDALIGN /* ( -- ) check DP for cell alignment, throw if not */
 	.word XT_DP
 	.word XT_DUP
 	.word XT_ALIGNED
 	.word XT_MINUS
 	.word XT_DOCONDBRANCH,CHKDALIGN_0001 /* if */
-	.word XT_BREAK
-	.word XT_DOLITERAL
-	.word EADRINV
-	.word XT_THROW
+	.word XT_DOLITERAL, EADRINV, XT_THROW
 CHKDALIGN_0001: /* then */
 	.word XT_EXIT
+END CHKDALIGN

core/words/dallot.s

@@ -1,12 +1,12 @@
 # SPDX-License-Identifier: GPL-3.0-only
 
-DEFER "(dallot)", LPARENDALLOTRPAREN, XT_NOP
-END LPARENDALLOTRPAREN
+DEFER "(dallot)", DODALLOT, XT_NOP
+END DODALLOT
 
 COLON "dallot", DALLOT /* ( u -- allocate u bytes in the dictionary ) */
     .word XT_MEMMODE
     .word XT_DOCONDBRANCH,DALLOT_0001 /* if */
-    .word XT_LPARENDALLOTRPAREN
+    .word XT_DODALLOT
     .word XT_DOBRANCH,DALLOT_0002
 DALLOT_0001: /* else */
     .word XT_DP

core/words/float.s

@@ -76,9 +76,7 @@ COLON ">f", GTF
 	.word XT_RTEST
 	.word XT_ZEROEQUAL
 	.word XT_DOCONDBRANCH,GTF_0001 # if
-	.word XT_DOLITERAL
-	.word -50
-	.word XT_THROW
+	.word XT_DOLITERAL, -50, XT_THROW
 GTF_0001: # then
 	.word XT_EXIT
 # ----------------------------------------------------------------------