commit 34149a2174203f148ec1e47ec74ce8eaba14e3bf
from: Benjamin Stürz <benni@stuerz.xyz>
date: Mon Apr 29 19:36:26 2024 UTC

reimplemented MEMEQ in native Forth

commit - 9fbaab72c1953893040111708affa2b75702cf87
commit + 34149a2174203f148ec1e47ec74ce8eaba14e3bf
blob - 187d8c4683bbfe89f50fe21c75f516a4d549fb5b
blob + 2232800451f29c868cdb69efa04074b45a10c2bb
--- rvforth.S
+++ rvforth.S
@@ -153,26 +153,6 @@ cold_start:
 
 .section .text
 
-// memeq (s1, s2, n);
-_MEMEQ:
-	beq a2, zero, 1f
-	lbu t0, 0(a0)
-	lbu t1, 0(a1)
-	bne t0, t1, 2f
-	addi a0, a0, 1
-	addi a1, a1, 1
-	addi a2, a2, -1
-	j _MEMEQ
-
-1:	// equal
-	li a0, -1
-	jr ra
-
-2:	// not equal
-	mv a0, zero
-	jr ra
-.size _MEMEQ, . - _MEMEQ	
-
 // return:
 //   a0 - word
 //   a1 - wordlen
@@ -410,14 +390,50 @@ defcode "WORD", 4, WORD, KEY
 	PUSH a0
 	NEXT
 
-defcode "MEMEQ", 5, MEMEQ, WORD
-	POP a0
-	POP a1
-	POP a2
-	jal _MEMEQ
-	PUSH a0
-	NEXT
+// ( s1 s2 len -- eql )
+defword "MEMEQ", 5, MEMEQ, WORD
+	.quad ROT	// ( len s1 s2 )
+	.quad DUP	// ( len len s1 s2 )
+	GOTOZ 4f	// ( len s1 s2 )
+
+	.quad TOR	// ( s1 s2 -- len )
+
+1:	// ( s1 s2 -- len )
+	.quad DUP	// ( s1 s1 s2 -- len )
+	.quad FETCHBYTE	// ( c1 s1 s2 -- len )
+	.quad TOR	// ( s1 s2 -- c1 len )
+	.quad SWAP	// ( s2 s1 -- c1 len )
+	.quad DUP	// ( s2 s2 s1 -- c1 len )
+	.quad FETCHBYTE	// ( c2 s2 s1 -- c1 len )
+	.quad FROMR	// ( c1 c2 s2 s1 -- len )
+	.quad SUB	// ( eql s2 s1 -- len )
+	GOTONZ 3f	// ( s2 s1 -- len )
+
+	.quad FROMR	// ( len s2 s1 )
+	.quad DEC	// ( len-1 s2 s1 )
+	.quad DUP	// ( len-1 len-1 s2 s1 )
+	GOTOZ 4f	// ( len-1 s2 s1 )
+
+	.quad TOR	// ( s2 s1 -- len-1 )
+	.quad INC	// ( s2+1 s1 -- len-1 )
+	.quad SWAP	// ( s1 s2+1 -- len-1 )
+	.quad INC	// ( s1+1 s2+1 -- len-1 )
+	GOTO 1b
+
+
+3:	// not equal	// ( s2 s1 -- len )
+	.quad FROMR	// ( len s2 s1 )
+	.quad TDROP	// ( s1 )
+	.quad DROP	// ( )
+	.quad LIT, 0	// ( 0 )
+	.quad EXIT
 
+4:	// equal	// ( len s2 s1 )
+	.quad TDROP	// ( s1 )
+	.quad DROP	// ( )
+	.quad LIT, -1	// ( 0 )
+	.quad EXIT
+
 // ( name namelen -- &word )
 defword "FIND", 4, FIND, MEMEQ
 	.quad TOR		// ( namelen -- name )