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