Return to execute-parsing.fs CVS log

Up to [gforth] / gforth / compat

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

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
        !            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