For your edification/amusement/nightmares...
A FORTH interpreter.
Doesn't do much, but it -will- compile words. It accepts the following
input:
> 3 : square ( n -- n ) dup * ; : cube ( n -- n )
square> dup square * ;
cube> .
27>
I'll be adding new words as the fancy strikes me. As you can see by the
sample code (or maybe not), it accepts simple words, can handle simple
comments, and even compile words involving multiple-word expansions.
Aside from being a cute example of YA language, it -does- serve the
purpose of testing PerlHashes and the integer stack. I was intending to
let the core split words into a PerlArray, but the simpler architecture
handling one word at a time worked out better, and obviated the need for
a split()-like routine.
--
Jeff <[EMAIL PROTECTED]>
#
# Forth interpreter
#
..constant STDIN 0
..constant PromptString "> "
..constant InterpretMode 0
..constant CompileMode 1
..constant CommentMode 2
..constant Space 32
..constant Tab 9
#
# Allocate registers
#
..constant CommandLength I0
..constant WordStart I1
..constant WordEnd I2
..constant WordLength I3
..constant Mode I4
..constant TempInt I5
..constant TempInt2 I6
..constant TempInt3 I7
..constant IntStack I31
#
..constant Commands S0
..constant CurrentWord S1
..constant CompileWord S2
..constant CompileBuffer S3
..constant TempString S4
#
..constant UserOps P0
#
new .UserOps, .PerlHash
set .Mode, .InterpretMode
Prompt:
print .PromptString
readline .Commands, .STDIN
bsr Chop
bsr Interpret
branch Prompt
end
#------------------------------------------------------------------------------
#
# Test Interpret routine
#
Interpret:
bsr EatLeadingWhitespace
StartInterpret:
bsr CollectWord
bsr EatLeadingWhitespace
ne .CurrentWord, "(", MaybeCompile
save .Mode
set .Mode, .CommentMode
branch DoneSettingMode
MaybeCompile:
ne .CurrentWord, ":", MaybeInterpret
set .Mode, .CompileMode
branch DoneSettingMode
MaybeInterpret:
DoneSettingMode:
bsr InterpretWord
length .TempInt, .Commands
eq .TempInt, 0, DoneInterpret
branch StartInterpret
DoneInterpret:
ret
#------------------------------------------------------------------------------
#
# InterpretWord
#
InterpretWord:
ne .Mode, .CommentMode, MaybeCompileWord
ne .CurrentWord, ")", DoneInterpretWord
restore .Mode
branch DoneInterpretWord
MaybeCompileWord:
ne .Mode, .CompileMode, MaybeInterpretWord
eq .CurrentWord, ":", DoneInterpretWord
ne .CurrentWord, ";", DoCompileStuff
set .Mode, .InterpretMode
print "compiled "
print .CompileWord
print " "
print " from "
print .CompileBuffer
set .UserOps[.CompileWord], .CompileBuffer
set .CompileWord, ""
set .CompileBuffer, ""
branch DoneInterpretWord
DoCompileStuff:
ne .CompileWord, "", FillCompileBuffer
set .CompileWord, .CurrentWord
branch EndCompileWord
FillCompileBuffer:
concat .CompileBuffer, .CurrentWord
concat .CompileBuffer, " "
EndCompileWord:
branch DoneInterpretWord
MaybeInterpretWord:
set .IntStack, .CurrentWord
ne .IntStack, 0, PushInt
eq .CurrentWord, "0", PushInt
eq .CurrentWord, ".", Int_Dot
eq .CurrentWord, "dup", Int_Dup
eq .CurrentWord, "drop", Int_Drop
eq .CurrentWord, "swap", Int_Swap
eq .CurrentWord, "quit", Quit
eq .CurrentWord, "+", Int_Add
eq .CurrentWord, "-", Int_Sub
eq .CurrentWord, "negate", Int_Negate
eq .CurrentWord, "*", Int_Mul
eq .CurrentWord, "/", Int_Div
eq .CurrentWord, "mod", Int_Mod
eq .CurrentWord, "/mod", Int_Slash_Mod
set .TempString, .UserOps[.CurrentWord]
concat .Commands, .TempString, .Commands
branch DoneInterpretWord
PushInt:
save .IntStack
branch DoneInterpretWord
Int_Dot:
restore .IntStack
print .IntStack
print " "
branch DoneInterpretWord
Int_Dup:
restore .IntStack
save .IntStack
save .IntStack
branch DoneInterpretWord
Int_Drop:
restore .IntStack
branch DoneInterpretWord
Int_Swap:
restore .IntStack
set .TempInt, .IntStack
restore .IntStack
set .TempInt2, .IntStack
set .IntStack, .TempInt
save .IntStack
set .IntStack, .TempInt2
save .IntStack
branch DoneInterpretWord
Quit:
end
Int_Add:
restore .IntStack
set .TempInt, .IntStack
restore .IntStack
add .IntStack, .IntStack, .TempInt
save .IntStack
branch DoneInterpretWord
Int_Sub:
restore .IntStack
set .TempInt, .IntStack
restore .IntStack
sub .IntStack, .IntStack, .TempInt
save .IntStack
branch DoneInterpretWord
Int_Negate:
restore .IntStack
mul .IntStack, .IntStack, -1
save .IntStack
branch DoneInterpretWord
Int_Mul:
restore .IntStack
set .TempInt, .IntStack
restore .IntStack
mul .IntStack, .IntStack, .TempInt
save .IntStack
branch DoneInterpretWord
Int_Div:
restore .IntStack
set .TempInt, .IntStack
restore .IntStack
div .IntStack, .IntStack, .TempInt
save .IntStack
branch DoneInterpretWord
Int_Mod:
restore .IntStack
set .TempInt, .IntStack
restore .IntStack
mod .IntStack, .IntStack, .TempInt
save .IntStack
branch DoneInterpretWord
Int_Slash_Mod:
restore .IntStack
set .TempInt, .IntStack
restore .IntStack
set .TempInt2, .IntStack
mod .IntStack, .TempInt2, .TempInt
save .IntStack
div .IntStack, .TempInt2, .TempInt
save .IntStack
branch DoneInterpretWord
DoneInterpretWord:
ret
#------------------------------------------------------------------------------
#
# CollectWord
#
CollectWord:
length .TempInt, .Commands
eq .TempInt, 0, DoneCollectWord
set .TempInt3, 0
NextCharCollectWord:
eq .TempInt3, .TempInt, EndDarkspace
ord .TempInt2, .Commands, .TempInt3
eq .TempInt2, .Space, EndDarkspace
eq .TempInt2, .Tab, EndDarkspace
inc .TempInt3
branch NextCharCollectWord
EndDarkspace:
substr .CurrentWord, .Commands, 0, .TempInt3, ""
DoneCollectWord:
ret
#------------------------------------------------------------------------------
#
# EatLeadingWhitespace
#
EatLeadingWhitespace:
length .TempInt, .Commands
eq .TempInt, 0, DoneLeadingWhitespace
set .TempInt3, 0
ord .TempInt2, .Commands, .TempInt3
eq .TempInt2, .Space, StartLeadingWhitespace
eq .TempInt2, .Tab, StartLeadingWhitespace
branch DoneLeadingWhitespace
StartLeadingWhitespace:
inc .TempInt3
eq .TempInt, .TempInt, FinishLeadingWhitespace
ord .TempInt2, .Commands, .TempInt3
eq .TempInt2, .Space, StartLeadingWhitespace
eq .TempInt2, .Tab, StartLeadingWhitespace
FinishLeadingWhitespace:
substr .Commands, 0, .TempInt3, ""
DoneLeadingWhitespace:
ret
#------------------------------------------------------------------------------
#
# Chop
#
Chop:
length .TempInt, .Commands
dec .TempInt
substr .Commands, .Commands, 0, .TempInt
ret
