Return to preprocessor.fs CVS log

Up to [Qemu by Fabrice Bellard] / qemu / roms / openbios / forth / lib

Annotation of qemu/roms/openbios/forth/lib/preprocessor.fs, revision 1.1

1.1     ! root        1: \ tag: Forth preprocessor
        !             2: \ 
        !             3: \ Forth preprocessor
        !             4: \ 
        !             5: \ Copyright (C) 2003, 2004 Samuel Rydh
        !             6: \ 
        !             7: \ See the file "COPYING" for further information about
        !             8: \ the copyright and warranty status of this work.
        !             9: \ 
        !            10: 
        !            11: 0 value prep-wid
        !            12: 0 value prep-dict
        !            13: 0 value prep-here
        !            14: 
        !            15: : ([IF])
        !            16:   begin
        !            17:     begin parse-word dup 0= while
        !            18:       2drop refill
        !            19:     repeat
        !            20: 
        !            21:     2dup " [IF]" strcmp 0= if 1 throw then
        !            22:     2dup " [IFDEF]" strcmp 0= if 1 throw then
        !            23:     2dup " [ELSE]" strcmp 0= if 2 throw then
        !            24:     2dup " [THEN]" strcmp 0= if 3 throw then
        !            25:     " \\" strcmp 0= if linefeed parse 2drop then
        !            26:   again
        !            27: ;
        !            28: 
        !            29: : [IF] ( flag -- )
        !            30:   if exit then
        !            31:   1 begin
        !            32:     ['] ([IF]) catch case
        !            33:       \ EOF (FIXME: this does not work)
        !            34:       \ -1 of ." Missing [THEN]" abort exit endof
        !            35:       \ [IF]
        !            36:       1 of 1+ endof
        !            37:       \ [ELSE]
        !            38:       2 of dup 1 = if 1- then endof
        !            39:       \ [THEN]
        !            40:       3 of 1- endof
        !            41:     endcase
        !            42:   dup 0 <=
        !            43:   until drop
        !            44: ; immediate
        !            45: 
        !            46: : [ELSE] 0 [ ['] [IF] , ] ; immediate
        !            47: : [THEN] ; immediate
        !            48: 
        !            49: :noname
        !            50:   0 to prep-wid
        !            51:   0 to prep-dict
        !            52: ; initializer
        !            53: 
        !            54: : [IFDEF] ( <word> -- )
        !            55:   prep-wid if
        !            56:     parse-word prep-wid search-wordlist dup if nip then
        !            57:   else 0 then
        !            58:   [ ['] [IF] , ]
        !            59: ; immediate
        !            60: 
        !            61: : [DEFINE] ( <word> -- )
        !            62:   parse-word here get-current >r >r
        !            63:   prep-dict 0= if
        !            64:     2000 alloc-mem here!
        !            65:     here to prep-dict
        !            66:     wordlist to prep-wid
        !            67:     here to prep-here
        !            68:   then
        !            69:   prep-wid set-current prep-here here!
        !            70:   $create
        !            71:   here to prep-here
        !            72:   r> r> set-current here!
        !            73: ; immediate
        !            74: 
        !            75: : [0] 0 ; immediate
        !            76: : [1] 1 ; immediate

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.