aboutsummaryrefslogtreecommitdiff
path: root/amforth-6.5/common/lib/to-name.frt
blob: 806dc2171bb3e434514196aab765883720bdfb68 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
\ go from the XT backwards to get the Name field
: >name ( xt -- nfa )
    1- \ link address
    \ tricky: we look for the flash cell whose address + it content & 0x00ff is
    \ this address
    dup 1- >r ( -- lfa )
    $ff swap
    begin
      1- dup ( -- cnt lfa lfa )
      @i $00ff and 1+ 2/ ( -- cnt fla len )
      over + ( cnt fla lfa? )
      r@ = ( cnt fla lfa? )
      rot 1- dup >r 0= or ( fla flag )
      r> ( fla flag cnt )
      swap ( fla cnt flag )
      rot
      swap
    until
    swap drop
    r> drop
;