Set compile flags with existing hardware access assembly.

Author: Molorius

README.md

@@ -555,6 +555,7 @@ The cross compiler includes some optimizations. More may be added later.
 * Tail calls. Words may be defined in assembly or forth. If the final word before an `EXIT` (or end of definition) is a forth word, this will instead jump to it. For example, a word that is compiled as `+ forth-word EXIT` will be optimized to `+ jump(forth-word)`. Smaller in token threaded model, faster, saves a stack slot.
 
 To be added later:
+* Fallthrough forth words instead of tail call
 * Assembly inlining (subroutine threaded only)
 * Forth inlining
 * Forth common sequence compression

pkg/forth/builtin/11_misc.f

@@ -10,3 +10,9 @@
 : UNHIDE ( xt -- )
     FALSE SWAP SET-HIDDEN
 ;
+
+\ constants used for defining token threaded primitives
+0 CONSTANT TOKEN_NEXT_NONSTANDARD
+1 CONSTANT TOKEN_NEXT_NORMAL
+2 CONSTANT TOKEN_NEXT_SKIP_R2
+3 CONSTANT TOKEN_NEXT_SKIP_LOAD

pkg/forth/esp32/01_instructions.f

@@ -11,7 +11,6 @@
 0x3ff48000 CONSTANT DR_REG_RTCCNTL_BASE
 
 : RTC_ADDR_FIX ( addr -- addr-fixed )
-    DR_REG_RTCCNTL_BASE - \ subtract off the offset
     2 RSHIFT \ divide by 4
     0x3FF AND \ remove extra bits
 ;
@@ -28,12 +27,13 @@
     7 \ number of inputs
 ;
 
-: READ_RTC_ADDR_CHANGE ( addr low width -- addr high low )
+: READ_RTC_ADDR_CHANGE ( addr low width -- addr-fixed high low )
     >R >R
     RTC_ADDR_FIX
-    R> R>
-    SWAP DUP >R
-    + 1- R>
+    R> R> ( addr-fixed low width )
+    SWAP DUP >R ( addr-fixed width low R: low )
+    + 1 - ( addr-fixed high R: low )
+    R> ( addr-fixed high low )
 ;
 
 : READ_RTC_REG.BUILDER ( addr low width "<spaces>name" -- )
@@ -46,15 +46,16 @@
     >R >R >R
     \ create the token threaded assembly
     READ_RTC_REG.BUILDER
-    C" sub r3, r3, 1\nst r0, r3, 0\njump __next_skip_load" \ increase stack, store result, next
+    C" sub r3, r3, 1\nst r0, r3, 0" \ increase stack, store result
     SWAP 1 + \ number of inputs
     \ get the inputs
     R> R> R>
     \ create the subroutine threaded assembly
     READ_RTC_REG.BUILDER
-    C" sub r3, r3, 1\nst r0, r3, 0\nadd r2, r2, 1\njump r2" \ increase stack, store result, next
+    C" sub r3, r3, 1\nst r0, r3, 0" \ increase stack, store result
     SWAP 1 + \ number of inputs
     ASSEMBLY-BOTH
+    TOKEN_NEXT_SKIP_LOAD LAST SET-ULP-ASM-NEXT
 ;
 
 : REG_WR.BUILDER ( addr high low data -- strn..str0 n )
@@ -71,12 +72,10 @@ \ create the subroutine threaded assembly
     9 \ number of inputs
 ;
 
-: WRITE_RTC_ADDR_CHANGE
-    >R >R >R
-    RTC_ADDR_FIX
-    R> R> R>
-    >R SWAP DUP >R
-    + 1- R> R>
+: WRITE_RTC_ADDR_CHANGE ( addr low width data -- addr high low data )
+    >R \ push data onto return stack
+    READ_RTC_ADDR_CHANGE \ fix the rest
+    R> \ pop data
 ;
 
 : WRITE_RTC_REG.BUILDER
@@ -90,15 +89,12 @@ \ create the subroutine threaded assembly
     >R >R >R >R
     \ create the token threaded assembly
     WRITE_RTC_REG.BUILDER
-    C" jump __next_skip_load"
-    SWAP 1 +
     \ get the inputs
     R> R> R> R>
     \ create the subroutine threaded assembly
     WRITE_RTC_REG.BUILDER
-    C" add r2, r2, 1\njump r2"
-    SWAP 1 +
-    ASSEMBLY-BOTH
+    ASSEMBLY-BOTH \ create the assembly
+    TOKEN_NEXT_SKIP_LOAD LAST SET-ULP-ASM-NEXT
 ;
 
 \ create an assembly word that writes to two RTC registers
@@ -111,16 +107,13 @@ \ create the subroutine threaded assembly
     WRITE_RTC_REG.BUILDER >C
     R> R> R> R>
     WRITE_RTC_REG.BUILDER C> +
-    C" jump __next_skip_load"
-    SWAP 1 +
     \ get the inputs
     R> R> R> R> R> R> R> R>
     \ create the subroutine threaded assembly
     >R >R >R >R
     WRITE_RTC_REG.BUILDER >C
     R> R> R> R>
     WRITE_RTC_REG.BUILDER C> +
-    C" add r2, r2, 1\njump r2"
-    SWAP 1 +
     ASSEMBLY-BOTH
+    TOKEN_NEXT_SKIP_LOAD LAST SET-ULP-ASM-NEXT
 ;

pkg/forth/esp32/10_clock.f

@@ -23,9 +23,10 @@
 RTC_CNTL_TIME0_REG 16 16
 READ_RTC_REG.BUILDER >C
 \ store result and exit
-STRING" st r0, r3, 0\njump __next_skip_load"
+STRING" st r0, r3, 0"
 5 C> C> C> C> + + + + \ add up the strings and the built instructions
 ASSEMBLY RTC_CLOCK \ create RTC_CLOCK
+TOKEN_NEXT_SKIP_LOAD LAST SET-ULP-ASM-NEXT
 
 \ delay for d rtc_slow ticks
 : RTC_CLOCK_DELAY ( d -- )
@@ -52,13 +53,10 @@
 
 \ create the token threaded
 BUSY_DELAY.BUILDER
-STRING" jump __next_skip_load"
-SWAP 1 +
 \ create the subroutine threaded
 BUSY_DELAY.BUILDER
-STRING" add r2, r2, 1\njump r2"
-SWAP 1 +
 ASSEMBLY-BOTH BUSY_DELAY
+TOKEN_NEXT_SKIP_LOAD LAST SET-ULP-ASM-NEXT
 
 : DELAY_MS ( n -- )
     BEGIN

pkg/forth/esp32/12_system.f

@@ -23,10 +23,7 @@
 
 \ token threaded assembly
 WAKE.BUILDER
-STRING" jump __next_skip_load"
-SWAP 1 +
 \ subroutine threaded assembly
 WAKE.BUILDER
-STRING" add r2, r2, 1\njump r2"
-SWAP 1 +
 ASSEMBLY-BOTH WAKE
+TOKEN_NEXT_SKIP_LOAD LAST SET-ULP-ASM-NEXT

pkg/forth/esp32/20_serial.f

@@ -53,14 +53,11 @@
     2DUP >R >R \ dup the input
     \ token threaded
     SERIAL.WRITE_CREATE.BUILDER
-    C" jump __next_skip_r2"
-    SWAP 1 +
     \ subroutine threaded
     R> R>
     SERIAL.WRITE_CREATE.BUILDER
-    C" add r2, r2, 1\njump r2"
-    SWAP 1 +
     ASSEMBLY-BOTH
+    TOKEN_NEXT_SKIP_R2 LAST SET-ULP-ASM-NEXT
 ;
 
 \ these were found at 21 C with a logic analyzer

pkg/forth/primitive.go

@@ -235,7 +235,7 @@ func PrimitiveSetup(vm *VirtualMachine) error {
 						Ulp: ulpAsm,
 						UlpSrt: PrimitiveUlpSrt{
 							Asm:             asmSrt,
-							NonStandardNext: true,
+							NonStandardNext: false,
 						},
 						Entry: &newEntry,
 					},
@@ -1113,6 +1113,29 @@ func PrimitiveSetup(vm *VirtualMachine) error {
 				return nil
 			},
 		},
+		{
+			name: "SET-ULP-ASM-NEXT",
+			goFunc: func(vm *VirtualMachine, entry *DictionaryEntry) error {
+				cell0, err := vm.Stack.Pop()
+				if err != nil {
+					return PopError(err, entry)
+				}
+				cellAddr, ok := cell0.(CellAddress)
+				if !ok {
+					return EntryError(entry, "requires an address cell, found %s type %T", cell0, cell0)
+				}
+				value, err := vm.Stack.PopNumber()
+				if err != nil {
+					return JoinEntryError(err, entry, "could not get boolean")
+				}
+				word, ok := cellAddr.Entry.Word.(*WordPrimitive)
+				if !ok {
+					return EntryError(entry, "requires a primitive word")
+				}
+				word.Ulp.Next = TokenNextType(value)
+				return nil
+			},
+		},
 		{
 			name: "EXIT",
 			flag: Flag{
@@ -2425,6 +2448,11 @@ func parseAssembly(vm *VirtualMachine, entry *DictionaryEntry) ([]string, error)
 	asmStr := strings.Join(asm, "")
 	asmStr = strings.ReplaceAll(asmStr, "\\r", "\r")
 	asmStr = strings.ReplaceAll(asmStr, "\\n", "\n")
+	asmStr = strings.ReplaceAll(asmStr, "\\n\\n", "\n")
+	last := len(asmStr) - 1
+	if asmStr[last] == '\n' { // remove a final newline
+		asmStr = asmStr[:last]
+	}
 	asm = strings.Split(asmStr, "\n")
 	return asm, nil
 }

pkg/forth/word.go

@@ -162,6 +162,7 @@ type PrimitiveGo func(*VirtualMachine, *DictionaryEntry) error
 type TokenNextType int
 
 const (
+	// update the constants in 11_misc.f if this list changes
 	TokenNextNonstandard TokenNextType = iota
 	TokenNextNormal
 	TokenNextSkipR2