From 21ac8cc402ea7cd180f39fa9d1095a854e021d1a Mon Sep 17 00:00:00 2001 From: David Schmenk Date: Tue, 12 Dec 2023 19:24:37 -0800 Subject: [PATCH] Add minimal FORTH environmnet --- src/toolsrc/plforth.pla | 160 ++++++++++++++++++++++++++++++++++++++++ 1 file changed, 160 insertions(+) create mode 100644 src/toolsrc/plforth.pla diff --git a/src/toolsrc/plforth.pla b/src/toolsrc/plforth.pla new file mode 100644 index 0000000..9e9e17d --- /dev/null +++ b/src/toolsrc/plforth.pla @@ -0,0 +1,160 @@ +include "inc/cmdsys.plh" + +// +// FORTH dictionary layout +// +// bytes usage +// ----- ----- +// [1..32] name string +// [2] LFA (link field address) +// [2] CFA (code field address) +// [2] PFA (param field address) +// + +// +// Predefine instrinsics +// +predef _drop_(a)#0, _add_(a,b)#1, _vlist_#0 +predef _exit_#0 +// +// DROP +// +char d_drop = "drop" +word = 0, @_drop_, 0 +// +// ADD +// +char d_add = "+" +word = @d_drop, @_add_, 0 +// +// PRINT TOS +// +char d_prtos = "." +word = @d_add, @puti, 0 +// +// EXIT FORTH +// +char d_exit = "exit" +word = @d_prtos, @_exit_, 0 +// +// List vocabulary +// +char d_vlist = "vlist" +word = @d_exit, @_vlist_, 0 +// +// Vocabulary +// +word vocab=@d_vlist +char exit = 0 +// +// Intrinsics +// +def _drop_(a)#0 + return +end +def _add_(a,b)#1 + return a+b +end +def _exit_#0 + exit = 1 +end +def _vlist_#0 + word v + + v = vocab + while v + puts(v); puts(" ") + v = *(v + ^v + 1) + loop +end +// +// Find match in vocabulary +// +def find(name)#1 + word v + byte len + + name-- + v = vocab + while v + for len = 1 to ^v + putc(^(name+len)); putc('='); putc(^(v+len)) + if ^(name+len) <> ^(v+len) + putln + break + fin + next + if len > ^v and ^(name+len) <= ' ' + puts("[Found name = "); puts(v); puts("]\n") + return v + ^v + 3 + fin + v = *(v + ^v + 1) + loop + return 0 +end +// +// Execute code in CFA +// +def exec(cfa)#0 + word w + + w = *cfa + w()#0 +end +// +// Convert input into number +// +def isnum(inbuf)#2 + word num + + + if ^inbuf >= '0' and ^inbuf <= '9' + num = 0 + while ^inbuf >= '0' and ^inbuf <= '9' + num = num * 10 + ^inbuf - '0' + putc(^inbuf); inbuf++ + loop + if inbuf <= ' ' + puts("[Found number = "); puti(num); puts("]\n") + fin + return num, inbuf <= ' ' + fin + return 0, FALSE +end +// +// Quit and look for user input +// +def _quit_#0 + word instr, cfa, __drop, __isnum + + __drop = @_drop_ + __isnum = @isnum + repeat + puts("OK") + instr = gets(':'|$80) + if ^instr + ^(instr + ^instr + 1) = 0 + // + // Clear high bit of input buffer + // + for cfa = 1 to ^instr + ^(instr + cfa) = ^(instr + cfa) & $7F + next + instr++ + while ^instr == ' ' + instr++ + loop + if ^instr > ' ' + cfa = find(instr) + if cfa + (*cfa)()#0 //exec(*cfa) + elsif not __isnum(instr)#1 + __drop()#0 + puts("? No match\n") + fin + fin + fin + until exit +end +_quit_ +done