commit 305019da86442226c04b49bf66604da174f04eee from: Benjamin Stürz date: Mon Apr 29 17:53:06 2024 UTC reimplement INTERPRET and CMOVE in native Forth commit - c4d2dd8a21f66f8f0361a6d91ab63819e373e566 commit + 305019da86442226c04b49bf66604da174f04eee blob - a4d6393d61b9bb9153c030681edae17571a95516 blob + 022659a36ea0b9be8c1f7aeacf5fa224c8066efe --- Makefile +++ Makefile @@ -10,6 +10,9 @@ od: rvforth gdb: rvforth egdb ./rvforth +nm: rvforth + nm rvforth | sort -n | less + run: rvforth ./rvforth blob - 4c6ecf6b87bbadebc7288275adf23c47baac845c blob + 780481aeb4b53f4b4757ad58ed97b0df295f7cf4 --- rvforth.S +++ rvforth.S @@ -84,6 +84,16 @@ defcode \name, \namelen, \label, \prev, \flags .macro POPRSP, reg ld \reg, 0(RSP) addi RSP, RSP, 8 +.endm + +.macro GOTO, label + .quad BRANCH + .quad (\label - .) +.endm + +.macro GOTOZ, label + .quad ZBRANCH + .quad (\label - .) .endm .section .text @@ -351,10 +361,14 @@ defcode "EXIT", 4, EXIT, DONE NEXT defcode "DROP", 4, DROP, EXIT - POP t0 + addi DSP, DSP, 8 NEXT -defcode "SWAP", 4, SWAP, DROP +defcode "2DROP", 5, TDROP, DROP + addi DSP, DSP, 16 + NEXT + +defcode "SWAP", 4, SWAP, TDROP POP t0 POP t1 PUSH t0 @@ -366,6 +380,7 @@ defcode "OVER", 4, OVER, SWAP PUSH t0 NEXT +// ( X Y Z -- Z X Y ) defcode "ROT", 3, ROT, OVER POP t0 POP t1 @@ -375,6 +390,8 @@ defcode "ROT", 3, ROT, OVER PUSH t2 NEXT +// ( X Y Z -- Y Z X ) +// ( Z X Y ) -- ( X Y Z ) defcode "-ROT", 4, NROT, ROT POP t0 POP t1 @@ -385,19 +402,37 @@ defcode "-ROT", 4, NROT, ROT NEXT defcode "DUP", 3, DUP, NROT - POP t0 + ld t0, 0(DSP) PUSH t0 + NEXT + +defcode "2DUP", 3, TDUP, DUP + ld t0, 8(DSP) + ld t1, 0(DSP) PUSH t0 + PUSH t1 NEXT -defcode "?DUP", 4, QDUP, DUP +defcode "?DUP", 4, QDUP, TDUP ld t0, 0(DSP) beq t0, zero, 1f PUSH t0 1: NEXT -defcode "+", 1, ADD, QDUP +defcode "1+", 2, INC, QDUP + POP t0 + addi t0, t0, 1 + PUSH t0 + NEXT + +defcode "1-", 2, DEC, INC + POP t0 + addi t0, t0, -1 + PUSH t0 + NEXT + +defcode "+", 1, ADD, DEC POP t1 POP t0 add t0, t0, t1 @@ -455,15 +490,17 @@ defcode "KEY", 3, KEY, EQZ PUSH a0 NEXT +// ( -- word wordlen ) defcode "WORD", 4, WORD, KEY jal _WORD PUSH a1 PUSH a0 NEXT +// ( name namelen -- *word ) defcode "FIND", 4, FIND, WORD - POP a1 POP a0 + POP a1 jal _FIND PUSH a0 NEXT @@ -511,25 +548,30 @@ defcode "DSP@", 4, DSPFETCH, DSPSTORE NEXT // ( src dest len -- ) -defcode "CMOVE", 5, CMOVE, DSPFETCH - POP a0 // src - POP a1 // dest - POP a2 // len - j 2f - +defword "CMOVE", 5, CMOVE, DSPFETCH + 1: - lbu t0, 0(a0) - sb t0, 0(a1) + .quad ROT // ( len src dest ) + .quad DUP // ( len len src dest ) + GOTOZ 2f // ( len src dest ) + .quad NROT // ( src dest len ) + .quad TDUP // ( src dest src dest len ) + .quad FETCHBYTE // ( byte dest src dest len ) + .quad SWAP // ( dest byte src dest len ) + .quad STORE // ( src dest len ) + .quad INC // ( src+1 dest len ) + .quad NROT // ( dest len src+1 ) + .quad INC // ( dest+1 len src+1 ) + .quad NROT // ( len src+1 dest+1 ) + .quad DEC // ( len-1 src+1 dest+1 ) + .quad NROT // ( src+1 dest+1 len-1 ) + GOTO 1b // noreturn - addi a0, a0, 1 - addi a1, a1, 1 - addi a2, a2, -1 +2: // ( len src dest ) + .quad TDROP // ( dest ) + .quad DROP // ( ) + .quad EXIT -2: - bne a2, zero, 1b - - NEXT - // ( name namelen -- ) defword "CREATE", 6, CREATE, CMOVE // store the link pointer @@ -580,65 +622,99 @@ defword "CREATE", 6, CREATE, CMOVE .quad EXIT -defcode "INTERPRET", 9, INTERPRET, CREATE - jal _WORD - beq a1, zero, return - mv s0, a0 - mv s1, a1 +defcode "NUMBER", 6, NUMBER, CREATE + POP a0 + POP a1 + jal _NUMBER + PUSH a1 + PUSH a0 + NEXT - // check if compiling - la t0, var_STATE - ld s2, 0(t0) - - jal _FIND - beq a0, zero, 1f - - // check if word is immediate - lbu t0, 8(a0) - andi t0, t0, F_IMMED - bne t0, zero, 3f - - // check if compiling - beq s2, zero, 3f +defcode "ERROR", 5, ERROR, NUMBER + la a0, .Lerr + jal puts + la PC, cold_start + NEXT - // compile word - jal _TCFA - jal _COMMA +defcode "TELL", 4, TELL, ERROR + li a0, 1 + POP a1 + POP a2 + jal write NEXT -3: // execute word - jal _TCFA - mv t0, a0 +defcode "ENTER", 5, ENTER, TELL + POP t0 ld a0, 0(t0) jr a0 -1: // not found, maybe number? - mv a0, s0 - mv a1, s1 - jal _NUMBER +defword "INTERPRET", 9, INTERPRET, ENTER + .quad WORD // ( word wordlen ) + + // check if length=0 + .quad OVER // ( wordlen word wordlen ) + .quad EQZ // ( wordlen==0 word wordlen ) + GOTOZ 1f // ( word wordlen ) + .quad LIT, 0 // ( 0 ) + .quad DONE // noreturn + +1: // find word in dictionary + .quad TDUP // ( name namelen name namelen ) + .quad FIND // ( word name namelen ) - beq a0, zero, 2f + // word == NULL ? + .quad DUP // ( word word name namelen ) + GOTOZ 2f // ( word name namelen ) + + // clean up stack + .quad TOR // ( name namelen -- word ) + .quad TDROP // ( -- word ) + .quad FROMR // ( word ) + + // check if word is immediate + .quad DUP // ( word word ) + .quad LIT, 8 // ( 8 word word ) + .quad ADD // ( word+8 word ) + .quad FETCHBYTE // ( nf word ) + .quad LIT, F_IMMED // ( F_IMMED nf word ) + .quad AND // ( imm word ) + .quad EQZ // ( !imm word ) + GOTOZ 3f // ( word ) - beq s2, zero, 4f + // check if were compiling + .quad STATE, FETCH // ( state word ) + GOTOZ 3f // ( word ) - mv s0, a1 - la a0, LIT - jal _COMMA + .quad TCFA // ( *cw ) + .quad COMMA // ( ) + .quad EXIT // noreturn - mv a0,s0 - jal _COMMA - NEXT +3: // execute word + .quad TCFA // ( &cw ) + .quad ENTER // noreturn + .quad EXIT -4: // push integer - PUSH a1 - NEXT +2: // not found, maybe number ( word name namelen ) + .quad DROP // ( name namelen ) + .quad NUMBER // ( err value ) + GOTOZ 4f // ( value ) + + .quad STATE, FETCH // ( imm value ) + GOTOZ 5f // ( value ) -2: // not found - la a0, .Lerr - jal puts - la s7, cold_start - NEXT + // compile number + .quad LIT, LIT // ( LIT value ) + .quad COMMA // ( value ) + .quad COMMA // ( ) + .quad EXIT // noreturn +5: // push number + .quad EXIT // ( value ), noreturn + +4: // not found + .quad DROP // ( ) + .quad ERROR // noreturn + defword "QUIT", 4, QUIT, INTERPRET .quad R0, RSPSTORE .quad INTERPRET @@ -792,6 +868,7 @@ wordlen: wordbuf: .skip WORDLEN + 1 +.align 8 .skip 4096 return_stack: .skip 4096