\ standalone.fs

0 [if]
Copyright (C) 2004-2006 by Charles Shattuck.

This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
version 2.1 of the License, or (at your option) any later version.

This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
Lesser General Public License for more details.

You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

For LGPL information:   http://www.gnu.org/copyleft/lesser.txt

[then]

] \ Target Forth
: emit begin 1 .SCON until. 1 .SCON clr SBUF #! ;
: key begin 0 .SCON until. 0 .SCON clr SBUF #@ ;
-: echo dup emit ;
: space BL # emit ;
: cr 13 # emit 10 # emit ;
-: ok space [ char o ] # emit [ char k ] # emit cr ;
: 2dup |over |over ;
: min 2dup swap
-: clip negate + -if push swap pop then 2drop ;
: max 2dup clip ;
: p |p ;
: @p |@p ;
: @p+ |@p+ ;
\ : depth [ SP0 -2 + ] # S #@ negate + ;
: depth S #@ invert ;
-: huh? [ char ? ] # emit cr reset ;
-: ?stack depth -if huh? ; then drop ;
2 constant tib  \ begins after S, and A.
-: match ( ? - ?) @+ @p+ xor ior ;  \ 0 if still a match.
-: word 0 # tib # a! match match match match ;
-: ?digit [ char 0 negate ] # + -if huh? then -10 # + +if huh? then
   10 # + ;
\ -: number tib # a! 0 # @+ 3 # min begin swap 10 # (*) @+ ?digit + swap
-: number tib # a! 0 # @+ 3 # min begin swap 10 # |* @+ ?digit + swap
   1- 0=until drop ;
-: find @p if drop word if drop p+ p+ find ; then invert ; then drop
   0 # ;
here constant dict  \ Patch this later with real dictionary.
-: dictionary 0 ##p! ;
-: interpret p push push a push dictionary find if
   drop @p+ @p pop a! pop pop p! push push ; then drop number
   pop a! pop pop p! ;
-: tib! ( c) a push tib #@ 1+ tib #! tib # dup a! @ + 6 # min a! ! pop a! ;
-: 0tib tib # dup a! 0 # dup !+ dup !+ dup !+ dup !+ ! a! ;
-: query 0tib
-: back key 8 # =if drop cr query ; then BL # max echo BL # xor if
   BL # xor tib! back ; then drop ;
-: quit query interpret ?stack ok quit ;
