creation.fs

open source bios with linux platform, very good and can be reused.

\ 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
;