Add minimal FORTH environmnet

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