Initial import of abandoned HQEMU version 2.5.2HEADmaster

1 files changed, 52 insertions, 0 deletions

diff --git a/src/roms/openbios/forth/lib/creation.fs b/src/roms/openbios/forth/lib/creation.fs
new file mode 100644
index 0000000..c3d0db8
--- /dev/null
+++ b/src/roms/openbios/forth/lib/creation.fs
@@ -0,0 +1,52 @@
+\ tag: misc useful functions
+\ 
+\ C bindings
+\ 
+\ Copyright (C) 2003, 2004 Samuel Rydh
+\ 
+\ See the file "COPYING" for further information about
+\ the copyright and warranty status of this work.
+\ 
+
+\ return xt of the word just defined
+: last-xt ( -- xt )
+  latest @ na1+
+;
+
+\ -------------------------------------------------------------------------
+\ word creation
+\ -------------------------------------------------------------------------
+
+: $is-ibuf ( size name name-len -- xt )
+  instance $buffer: drop
+  last-xt
+;
+
+: is-ibuf ( size -- xt )
+  0 0 $is-ibuf
+;
+
+: is-ivariable ( size name len -- xt )
+  4 -rot instance $buffer: drop
+  last-xt
+;
+
+: is-xt-func ( xt|0 wordstr len )
+  header 1 ,
+  ?dup if , then
+  ['] (semis) , reveal
+;
+
+: is-2xt-func ( xt1 xt2 wordstr len )
+  header 1 ,
+  swap , ,
+  ['] (semis) , reveal
+;
+
+: is-func-begin ( wordstr len )
+  header 1 ,
+;
+
+: is-func-end ( wordstr len )
+  ['] (semis) , reveal
+;