mirror of
https://github.com/dschmenk/PLASMA.git
synced 2024-08-27 01:29:48 +00:00
Add minimal FORTH environmnet
This commit is contained in:
parent
7433b52e28
commit
21ac8cc402
160
src/toolsrc/plforth.pla
Normal file
160
src/toolsrc/plforth.pla
Normal file
@ -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
|
Loading…
Reference in New Issue
Block a user