qemu/roms/openbios/forth/lib/creation.fs

   1 \ tag: misc useful functions
   2 \
   3 \ C bindings
   4 \
   5 \ Copyright (C) 2003, 2004 Samuel Rydh
   6 \
   7 \ See the file "COPYING" for further information about
   8 \ the copyright and warranty status of this work.
   9 \
  10
  11 \ return xt of the word just defined
  12 : last-xt ( -- xt )
  13   latest @ na1+
  14 ;
  15
  16 \ -------------------------------------------------------------------------
  17 \ word creation
  18 \ -------------------------------------------------------------------------
  19
  20 : $is-ibuf ( size name name-len -- xt )
  21   instance $buffer: drop
  22   last-xt
  23 ;
  24
  25 : is-ibuf ( size -- xt )
  26   0 0 $is-ibuf
  27 ;
  28
  29 : is-ivariable ( size name len -- xt )
  30   4 -rot instance $buffer: drop
  31   last-xt
  32 ;
  33
  34 : is-xt-func ( xt|0 wordstr len )
  35   header 1 ,
  36   ?dup if , then
  37   ['] (semis) , reveal
  38 ;
  39
  40 : is-2xt-func ( xt1 xt2 wordstr len )
  41   header 1 ,
  42   swap , ,
  43   ['] (semis) , reveal
  44 ;
  45
  46 : is-func-begin ( wordstr len )
  47   header 1 ,
  48 ;
  49
  50 : is-func-end ( wordstr len )
  51   ['] (semis) , reveal
  52 ;