Initial import of qemu-2.4.1HEADmaster

1 files changed, 76 insertions, 0 deletions

diff --git a/roms/openbios/forth/lib/preprocessor.fs b/roms/openbios/forth/lib/preprocessor.fs
new file mode 100644
index 00000000..89d478cf
--- /dev/null
+++ b/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