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 : marker   ( "name" -- )
   7     create
   8     get-current ,
   9     get-order dup ,
  10     0 ?do , loop
  11   does>
  12     0 set-order                     \ clear search order
  13     dup body> >name drop
  14     here - allot                    \ reset HERE to my xt-addr
  15     dup @                           ( pfa current-wid )
  16     dup set-current forget-wid      ( pfa )
  17     cell+ dup @ swap                ( count count-addr )
  18     over cells + swap               ( last-wid-addr count )
  19     0 ?do
  20         dup @ dup                   ( wid-addr wid wid )
  21         >search forget-wid          ( wid-addr )
  22         cell-
  23     loop
  24     drop
  25 ;