qemu/roms/openbios/libopenbios/clib.fs

   1 \ tag: C helpers
   2 \
   3 \ Misc C helpers
   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 \ should perhaps be moved somewhere else
  12 : set-property ( buf len propname propname-len phandle -- )
  13         >r 2swap encode-bytes 2swap r> encode-property
  14 ;
  15
  16 \ install C function
  17 : is-cfunc ( funcaddr word word-len -- )
  18   $create , does> @ call
  19 ;
  20
  21 \ install a nameless C function
  22 : is-noname-cfunc ( funcaddr -- xt )
  23   0 0 is-cfunc last-xt
  24 ;
  25
  26 \ is-xt-cfunc installs a function which does the following:
  27 \   - xt is executes
  28 \   - funcarg is pushed
  29 \   - funcaddr is called
  30
  31 : is-xt-cfunc ( xt|0 funcarg funcaddr word word-len -- )
  32         is-func-begin
  33   rot ?dup if , then
  34   swap ['] (lit) , , ['] (lit) , , ['] call ,
  35         is-func-end
  36 ;