It has a basic set of well known built-in Forth functions and the functionality may be easily expanded by means of user defined functions. Those functions may be nested to a very deep level (actually 100, but easily expandable).
If you look at the code, it is clear that built-in functions can also easily added (to the function "op_code(w$)").
I will not give a thorough description of Forth, but it can be found easily on Internet. The built-in functions are describred briefly at the end of the code.
My effort for a next version will be the addition of some control mechanisms, a facility to prtint text, and edit functions for the user function library. This library is automatically created when defining your first function and is saved upon each next addition, so there are no visible "load" and "save" functions needed. For now, this ASCII file may be edited directly to make small corrections to user functions. It is named "forthlib".
In this version there will be no need for more capacity, but in case of, those capacities may be augmented by modifying the following variables in the function "app_init()" :
- ".fsize" to augment the max. numberof user defined functions
- ".stsize" to enlarge the datastack
- ".retsize" to enlarge the returnstack, and with that, the nesting depth
But once more: without control mechanisms the current values (100) will be large enough.
In the enclosure, two example user function are shown:
A random function to put a random number between a minimum and maximum value (taken from the data stack) on the stack; it uses the built-in function "rnd", with is nothing more than the SB instruction rnd(1).
A rounding function that rounds the TOS (Top Of Stack) to two decimal places.
- image.jpeg (103.74 KiB) Viewed 21627 times
Code: Select all
' Forth interpreter (mini,mini)
' version 1 (20 febr 2016) by Henko
' explanations at the end of the code
'
app_init()
key_in:
print ">"; ! input in$ ! in$=lowstr$(in$) ! print in$
if left$(in$,1)=":" then
if new_func(in$)=0 then ! print error$(6) ! stop ! end if
goto key_in
end if
body$(0)=in$ ! ls=len(in$) ! curw=0 ! curp=0
interp:
while curp=ls
if rsp=0 then goto key_in
curw=rstack(rsp,0) ! curp=rstack(rsp,1) ! ls=rstack(rsp,2) ! rsp-=1
end while
next_word:
w$=extract$() ! if w$="" then goto interp
if op_code(w$) then goto interp
if value(w$) then goto interp
if function(w$) then goto interp
print error$(4) & w$ ! stop
end
def app_init()
text clear ! fil$="forthlib"
.fsize=100 ! .stsize=100 ! .retsize=100
dim .func$(.fsize+1),.body$(.fsize+1)
dim .st(.stsize+1),.rstack(.retsize+1,3)
if file_exists(fil$) then
file fil$ input .nfunc
if .nfunc then
for i=1 to .nfunc
file fil$ input .func$(i)
file fil$ input .body$(i)
next i
end if
end if
for i=1 to 6 !read .error$(i) ! next i
data "error, reserved"
data "error, stack is full"
data "error, stack is empty"
data "error, unknown opcode or function name : "
data "error, returnstack is full"
data "error, function table is full"
.sp=0
end def
def new_func(in$)
if .nfunc=.fsize then return 0
.nfunc+=1 ! lin=len(in$) ! fil$="forthlib"
pb=instr(in$," ")
.func$(.nfunc)=mid$(in$,1,pb-1)
.body$(.nfunc)=mid$(in$,pb,lin-pb)
if file_exists(fil$) then file fil$ delete
file fil$ print .nfunc
for i=1 to .nfunc
file fil$ print .func$(i),"""" & .body$(i) & """"
next i
return 1
end def
def extract$()
w$="" ! al=0
do c$=mid$(.body$(.curw),.curp,1)
.curp+=1
if c$=" " then
if al=1 then break
else ! al=1 ! w$&=c$
end if
until .curp=.ls
return w$
end def
def op_code(w$)
if w$="." then ! print pop() ! return 1 ! end if
if w$="cr" then ! print ! return 1 ! end if
if w$="+" then ! push(pop()+pop()) ! return 1 ! end if
if w$="-" then
b=pop() ! a=pop() ! push(a-b) ! return 1
end if
if w$="*" then ! push(pop()*pop()) ! return 1 ! end if
if w$="/" then
b=pop() ! a=pop() ! push(a/b) ! return 1
end if
if w$="^" then
b=pop() ! a=pop() ! push(a^b) ! return 1
end if
if w$="int" then ! push(floor(pop())) ! return 1 ! end if
if w$="sqr" then ! push(sqrt(pop())) ! return 1 ! end if
if w$="exp" then ! push(exp(pop())) ! return 1 ! end if
if w$="ln" then ! push(ln(pop())) ! return 1 ! end if
if w$="rnd" then ! push(rnd(1)) ! return 1 ! end if
if w$="drop" then ! pop() ! return 1 ! end if
if w$="dup" then ! a=pop() ! push(a) ! push(a) ! return 1 ! end if
if w$="s>ma" then ! .mema=pop() ! return 1 ! end if
if w$="ma>s" then ! push(.mema) ! return 1 ! end if
if w$="s>mb" then ! .memb=pop() ! return 1 ! end if
if w$="mb>s" then ! push(.memb) ! return 1 ! end if
if w$="swap" then
a=.st(.sp) ! .st(.sp)=.st(.sp-1) ! .st(.sp-1)=a ! return 1
end if
if w$="rot" then
a=.st(.sp) ! .st(.sp)=.st(.sp-1) ! .st(.sp-1)=.st(.sp-2)
.st(.sp-2)=a ! return 1
end if
if w$=".s" then
for i=1 to .sp ! print i;" ";.st(.sp-i+1) ! next i
return 1
end if
if w$="words" then
for i=1 to .nfunc ! print .func$(i);" ";.body$(i) ! next i
return 1
end if
if w$="cls" then ! text clear ! return 1 ! end if
if w$="bye" then ! stop ! end if
return 0
end def
def value(w$)
x=val(w$) ! if x=0 and left$(w$,1)<>"0" then return 0
push(x) ! return 1
end def
def function(w$)
if .nfunc=0 then return 0
for i=1 to .nfunc ! if w$=.func$(i) then break ! next i
if i>.nfunc then return 0
if .rsp=.retsize then ! print .error$(5) ! stop ! end if
.rsp+=1 ! .rstack(.rsp,0)=.curw ! .rstack(.rsp,1)=.curp
.rstack(.rsp,2)=.ls ! .curw=i ! .curp=0 ! .ls=len(.body$(i))
return 1
end def
def push(x)
if .sp=.stsize then ! print .error$(2) ! stop ! end if
.sp+=1 ! .st(.sp)=x
end def
def pop()
if .sp=0 then ! print .error$(3) ! stop ! end if
.sp-=1 ! return .st(.sp+1)
end def
' definitions
' TOS means "top of stack", NOS means "next (2nd) on stack"
' differences with "standard" Forth :
' user function definitions are not terminated with ";"
' two memory locations "a" and "b" for intermediate storage
' words (function names) must be lower case only
'
' specification of "built-in" functions (or op-codes)
' (+): stack grows, (0): same size, (-) stack shrinks
' most functions remove used data from stack
'
' "cls" - clear screen (0)
' "." - print TOS (-)
' "cr" - new line (0)
' ".s" - print stack content (0)
' "words" - print user defined functions
' "+" - add TOS and NOS, result on stack (-)
' "-" - subtract TOS from NOS (-)
' "*" - product of TOS and NOS (-)
' "/" - divide NOS by TOS (-)
' "^" - NOS to the power of TOS
' "int" - integer part of TOS (0)
' "sqr" - square root of TOS (0)
' "exp" - e^TOS (0)
' "ln" - natural logarithm of TOS (0)
' "rnd" - adds random number (0-1) to stack (+)
' "drop" - removes TOS from stack (-)
' "dup" - duplicates TOS (+)
' "rot" - rotates 3 first values of stack "upwards" (0)
' "swap" - swaps TOS and NOS (0)
' "s>ma" - move TOS to memory a (-)
' "ma>s" - write memory a to stack (+)
' "s>mb" - move TOS to memory b (-)
' "mb>s" - write memory b to stack (+)
' "bye" - stop Forth