1295263Sgjb\ ** ficl/softwords/marker.fr
2295263Sgjb\ ** Ficl implementation of CORE EXT MARKER
3295263Sgjb\ John Sadler, 4 Oct 98
4295263Sgjb\ Requires ficl 2.02 FORGET-WID !!
5295163Sgjb\
6295163Sgjb\ $FreeBSD: releng/10.3/sys/boot/ficl/softwords/marker.fr 94290 2002-04-09 17:45:28Z dcs $
7295163Sgjb
8295262Sgjb: marker   ( "name" -- )
9295163Sgjb    create  
10295163Sgjb    get-current ,
11295163Sgjb    get-order dup , 
12295163Sgjb    0 ?do , loop 
13295163Sgjb  does>
14295163Sgjb    0 set-order                     \ clear search order
15295163Sgjb    dup body> >name drop 
16295163Sgjb    here - allot                    \ reset HERE to my xt-addr
17295163Sgjb    dup @                           ( pfa current-wid )
18295225Sgjb    dup set-current forget-wid      ( pfa )
19295262Sgjb    cell+ dup @ swap                ( count count-addr )
20295225Sgjb    over cells + swap               ( last-wid-addr count )
21295225Sgjb    0 ?do 
22295225Sgjb        dup @ dup                   ( wid-addr wid wid )
23295225Sgjb        >search forget-wid          ( wid-addr )
24295225Sgjb        cell- 
25    loop
26    drop
27;
28