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

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.