140843Smsmith\ ** ficl/softwords/marker.fr
240843Smsmith\ ** Ficl implementation of CORE EXT MARKER
340843Smsmith\ John Sadler, 4 Oct 98
440843Smsmith\ Requires ficl 2.02 FORGET-WID !!
594290Sdcs\
694290Sdcs\ $FreeBSD$
740843Smsmith
840843Smsmith: marker   ( "name" -- )
940843Smsmith    create  
1040843Smsmith    get-current ,
1140843Smsmith    get-order dup , 
1240843Smsmith    0 ?do , loop 
1340843Smsmith  does>
1440843Smsmith    0 set-order                     \ clear search order
1540843Smsmith    dup body> >name drop 
1640843Smsmith    here - allot                    \ reset HERE to my xt-addr
1740843Smsmith    dup @                           ( pfa current-wid )
1840843Smsmith    dup set-current forget-wid      ( pfa )
1940843Smsmith    cell+ dup @ swap                ( count count-addr )
2040843Smsmith    over cells + swap               ( last-wid-addr count )
2140843Smsmith    0 ?do 
2240843Smsmith        dup @ dup                   ( wid-addr wid wid )
2340843Smsmith        >search forget-wid          ( wid-addr )
2440843Smsmith        cell- 
2540843Smsmith    loop
2640843Smsmith    drop
2740843Smsmith;
28