commit c4d2dd8a21f66f8f0361a6d91ab63819e373e566
from: Benjamin Stürz <benni@stuerz.xyz>
date: Mon Apr 29 15:57:46 2024 UTC

native implementation of CREATE

commit - b0948a2196988cb5c4976fdeeb1ff5cc71123941
commit + c4d2dd8a21f66f8f0361a6d91ab63819e373e566
blob - /dev/null
blob + 6eb73c50bf1583f70d385cd07c69c50031cc3076 (mode 644)
--- /dev/null
+++ .gitignore
@@ -0,0 +1,3 @@
+*.swp
+*.core
+rvforth
blob - a5e20c33ebfa93d315f75c4e1644e58450c3f376
blob + 4c6ecf6b87bbadebc7288275adf23c47baac845c
--- rvforth.S
+++ rvforth.S
@@ -361,13 +361,43 @@ defcode "SWAP", 4, SWAP, DROP
 	PUSH t1
 	NEXT
 
-defcode "DUP", 3, DUP, SWAP
+defcode "OVER", 4, OVER, SWAP
+	ld t0, 8(DSP)
+	PUSH t0
+	NEXT
+
+defcode "ROT", 3, ROT, OVER
 	POP t0
+	POP t1
+	POP t2
+	PUSH t1
 	PUSH t0
+	PUSH t2
+	NEXT
+
+defcode "-ROT", 4, NROT, ROT
+	POP t0
+	POP t1
+	POP t2
 	PUSH t0
+	PUSH t2
+	PUSH t1
 	NEXT
 
-defcode "+", 1, ADD, DUP
+defcode "DUP", 3, DUP, NROT
+	POP t0
+	PUSH t0
+	PUSH t0
+	NEXT
+
+defcode "?DUP", 4, QDUP, DUP
+	ld t0, 0(DSP)
+	beq t0, zero, 1f
+	PUSH t0
+1:
+	NEXT
+
+defcode "+", 1, ADD, QDUP
 	POP t1
 	POP t0
 	add t0, t0, t1
@@ -449,41 +479,107 @@ defcode "0BRANCH", 7, ZBRANCH, BRANCH
 	addi PC, PC, 8
 	NEXT
 
-defcode "RSP!", 8, RSPSTORE, ZBRANCH
+defcode ">R", 2, TOR, ZBRANCH
+	POP t0
+	PUSHRSP t0
+	NEXT
+
+defcode "R>", 2, FROMR, TOR
+	POPRSP t0
+	PUSH t0
+	NEXT
+
+defcode "RSP!", 4, RSPSTORE, FROMR
 	POP RSP
 	NEXT
 
-defcode "CREATE", 6, CREATE, RSPSTORE
-	POP a0		// name
-	POP a1		// namelen
-	la t0, var_LATEST
-	la t1, var_HERE
-	ld t2, 0(t0)	// LATEST
-	ld t3, 0(t1)	// HERE
-	sd t3, 0(t0)	// update LATEST
+defcode "RSP@", 4, RSPFETCH, RSPSTORE
+	PUSH RSP
+	NEXT
 
-	// store link pointer
-	sd t2, 0(t3)
+defcode "RDROP", 5, RDROP, RSPFETCH
+	POPRSP t0
+	NEXT
 
-	// store name length
-	sb a1, 8(t3)
+defcode "DSP!", 4, DSPSTORE, RDROP
+	POP DSP
+	NEXT
 
-	// store name
-	add t3, t3, 9
+defcode "DSP@", 4, DSPFETCH, DSPSTORE
+	mv t0, DSP
+	PUSH t0
+	NEXT
 
+// ( src dest len -- )
+defcode "CMOVE", 5, CMOVE, DSPFETCH
+	POP a0	// src
+	POP a1	// dest
+	POP a2	// len
+	j 2f
+	
 1:
 	lbu t0, 0(a0)
-	sb t0, 0(t3)
+	sb t0, 0(a1)
+	
 	addi a0, a0, 1
-	addi t3, t3, 1
-	addi a1, a1, -1
-	bne a1, zero, 1b
+	addi a1, a1, 1
+	addi a2, a2, -1
 
-	addi t3, t3, 7
-	andi t3, t3, ~7
-	sd t3, 0(t1)
+2:
+	bne a2, zero, 1b
+
 	NEXT
+
+// ( name namelen -- )
+defword "CREATE", 6, CREATE, CMOVE
+	// store the link pointer
+	.quad LATEST, FETCH
+	.quad HERE, FETCH
+	.quad STORE
+
+	// update LATEST
+	.quad HERE, FETCH
+	.quad LATEST
+	.quad STORE
+
+	// store name length
+	.quad OVER
+	.quad HERE, FETCH
+	.quad LIT, 8
+	.quad ADD
+	.quad STOREBYTE
 
+	// HERE += 9
+	.quad HERE
+	.quad DUP
+	.quad FETCH
+	.quad LIT, 9
+	.quad ADD
+	.quad SWAP
+	.quad STORE
+
+	// copy name
+	.quad OVER
+	.quad SWAP
+	.quad HERE, FETCH
+	.quad SWAP
+	.quad CMOVE
+
+	// update HERE
+	.quad HERE	// ( &HERE namelen )
+	.quad DUP	// ( &HERE &HERE namelen )
+	.quad FETCH	// ( HERE &HERE namelen )
+	.quad ROT	// ( namelen HERE &HERE )
+	.quad ADD	// ( newHERE &HERE )
+	.quad LIT, 7	// ( 7 newHERE &HERE )
+	.quad ADD	// ( newHERE &HERE)
+	.quad LIT, ~7	// ( ~7 newHERE &HERE )
+	.quad AND	// ( newHERE &HERE )
+	.quad SWAP	// ( &HERE newHERE )
+	.quad STORE	// ( )
+
+	.quad EXIT
+
 defcode "INTERPRET", 9, INTERPRET, CREATE
 	jal _WORD
 	beq a1, zero, return