X-Git-Url: https://gerrit.opnfv.org/gerrit/gitweb?a=blobdiff_plain;f=qemu%2Froms%2Fopenbios%2Fforth%2Flib%2Fpreprocessor.fs;fp=qemu%2Froms%2Fopenbios%2Fforth%2Flib%2Fpreprocessor.fs;h=89d478cff7ef0b9cd49e3a21a1a18fa80671add6;hb=e44e3482bdb4d0ebde2d8b41830ac2cdb07948fb;hp=0000000000000000000000000000000000000000;hpb=9ca8dbcc65cfc63d6f5ef3312a33184e1d726e00;p=kvmfornfv.git

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