summaryrefslogtreecommitdiffstats
path: root/qemu/roms/openbios/forth/lib/preprocessor.fs
diff options
context:
space:
mode:
Diffstat (limited to 'qemu/roms/openbios/forth/lib/preprocessor.fs')
-rw-r--r--qemu/roms/openbios/forth/lib/preprocessor.fs76
1 files changed, 76 insertions, 0 deletions
diff --git a/qemu/roms/openbios/forth/lib/preprocessor.fs b/qemu/roms/openbios/forth/lib/preprocessor.fs
new file mode 100644
index 000000000..89d478cff
--- /dev/null
+++ b/qemu/roms/openbios/forth/lib/preprocessor.fs
@@ -0,0 +1,76 @@
+\ tag: Forth preprocessor
+\
+\ Forth preprocessor
+\
+\ Copyright (C) 2003, 2004 Samuel Rydh
+\
+\ See the file "COPYING" for further information about
+\ the copyright and warranty status of this work.
+\
+
+0 value prep-wid
+0 value prep-dict
+0 value prep-here
+
+: ([IF])
+ begin
+ begin parse-word dup 0= while
+ 2drop refill
+ repeat
+
+ 2dup " [IF]" strcmp 0= if 1 throw then
+ 2dup " [IFDEF]" strcmp 0= if 1 throw then
+ 2dup " [ELSE]" strcmp 0= if 2 throw then
+ 2dup " [THEN]" strcmp 0= if 3 throw then
+ " \\" strcmp 0= if linefeed parse 2drop then
+ again
+;
+
+: [IF] ( flag -- )
+ if exit then
+ 1 begin
+ ['] ([IF]) catch case
+ \ EOF (FIXME: this does not work)
+ \ -1 of ." Missing [THEN]" abort exit endof
+ \ [IF]
+ 1 of 1+ endof
+ \ [ELSE]
+ 2 of dup 1 = if 1- then endof
+ \ [THEN]
+ 3 of 1- endof
+ endcase
+ dup 0 <=
+ until drop
+; immediate
+
+: [ELSE] 0 [ ['] [IF] , ] ; immediate
+: [THEN] ; immediate
+
+:noname
+ 0 to prep-wid
+ 0 to prep-dict
+; initializer
+
+: [IFDEF] ( <word> -- )
+ prep-wid if
+ parse-word prep-wid search-wordlist dup if nip then
+ else 0 then
+ [ ['] [IF] , ]
+; immediate
+
+: [DEFINE] ( <word> -- )
+ parse-word here get-current >r >r
+ prep-dict 0= if
+ 2000 alloc-mem here!
+ here to prep-dict
+ wordlist to prep-wid
+ here to prep-here
+ then
+ prep-wid set-current prep-here here!
+ $create
+ here to prep-here
+ r> r> set-current here!
+; immediate
+
+: [0] 0 ; immediate
+: [1] 1 ; immediate