File:  [gforth] / gforth / compat / execute-parsing.fs
Revision 1.1: download - view: text, annotated - select for diffs
Fri Feb 17 16:23:10 2006 UTC (15 years, 11 months ago) by anton
Branches: MAIN
CVS tags: HEAD
added compat/execute-parsing.fs

    1: \ implementation of EXECUTE-PARSING
    2: 
    3: \ This file is in the public domain. NO WARRANTY.
    4: 
    5: \ execute-parsing   ( ... c-addr u xt - ... )
    6: \ 
    7: \ Make c-addr u the current input source, execute xt ( ... -- ... ),
    8: \ then restore the previous input source.
    9: \ 
   10: \ This word is used like this:
   11: \ 
   12: \ s" test" ' create execute-parsing
   13: \ 
   14: \ and this would be equivalent to 
   15: \ 
   16: \ create test
   17: \ 
   18: \ It can be used to provide the input-stream input of a parsing word
   19: \ without consuming the input stream of the calling word.
   20: 
   21: \ this implementation copies the string to be parsed elsewhere (while
   22: \ EVALUATE is required to work in-place)
   23: 
   24: \ The program uses the following words
   25: \ from CORE :
   26: \  Constant : execute source >in ! drop ; >r 1+ r> swap dup chars + r@ move 
   27: \  rot ['] 
   28: \ from BLOCK :
   29: \  evaluate 
   30: \ from BLOCK-EXT :
   31: \  \ 
   32: \ from EXCEPTION :
   33: \  throw catch 
   34: \ from FILE :
   35: \  ( S" 
   36: \ from MEMORY :
   37: \  allocate free 
   38: \ from SEARCH :
   39: \  wordlist get-current set-current get-order set-order 
   40: \ from SEARCH-EXT :
   41: \  previous 
   42: 
   43: wordlist constant execute-parsing-wordlist
   44: 
   45: get-current execute-parsing-wordlist set-current
   46: 
   47: \ X is prepended to the string, then the string is EVALUATEd
   48: : X ( xt -- )
   49:     previous execute
   50:     source >in ! drop ; \ skip remaining input
   51: 
   52: set-current
   53: 
   54: : >order ( wid -- )
   55:   >r get-order 1+ r> swap set-order ;
   56: 
   57: : execute-parsing ( ... c-addr u xt -- ... )
   58:     >r dup >r
   59:     dup 2 chars + allocate throw >r  \ construct the string to be EVALUATEd
   60:     s" X " r@ swap chars move
   61:     r@ 2 chars + swap chars move
   62:     r> r> 2 + r> rot dup >r rot ( xt c-addr1 u1 r: c-addr1 )
   63:     execute-parsing-wordlist >order  \ make sure the right X is executed
   64:     ['] evaluate catch               \ now EVALUATE the string
   65:     r> free throw throw ;            \ cleanup

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>