53 lines
930 B
Forth
53 lines
930 B
Forth
|
\ 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
|
||
|
|
;
|