Return to execute-parsing.fs CVS log

Up to [gforth] / gforth / compat

Annotation of gforth/compat/execute-parsing.fs, revision 1.2

1.1       anton       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
1.2     ! anton      50:     source >in ! drop ; immediate \ skip remaining input
1.1       anton      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