xref: /freebsd/stand/ficl/softwords/marker.fr (revision c697fb7f) 
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;
28