sys/boot/ficl/softwords/marker.fr

   1 \ ** ficl/softwords/marker.fr
   2 \ ** Ficl implementation of CORE EXT MARKER
   3 \ John Sadler, 4 Oct 98
   4 \ Requires ficl 2.02 FORGET-WID !!
   5 \
   6 \ $FreeBSD$
   7
   8 : marker   ( "name" -- )
   9     create
  10     get-current ,
  11     get-order dup ,
  12     0 ?do , loop
  13   does>
  14     0 set-order                     \ clear search order
  15     dup body> >name drop
  16     here - allot                    \ reset HERE to my xt-addr
  17     dup @                           ( pfa current-wid )
  18     dup set-current forget-wid      ( pfa )
  19     cell+ dup @ swap                ( count count-addr )
  20     over cells + swap               ( last-wid-addr count )
  21     0 ?do
  22         dup @ dup                   ( wid-addr wid wid )
  23         >search forget-wid          ( wid-addr )
  24         cell-
  25     loop
  26     drop
  27 ;