From Newsgroup: comp.lang.forth

Reworking of the FSL routine for better or worse ...

\ Simple local fvariables loosely based on FSL code
\
\ Memory is ALLOTed at HERE on entry and released on exit.
\ PAD and HOLD contents not preserved.
\
\ FLOCALS takes 'u' floats from stack reserving space for
\ eight (RA thru RH). Unused locals free for general use.
\ Executing a local returns its value. FTO assigns a value.
\
\ Left-to-right ordering
\ Can be nested (may need 'inlining' disabled)
\ FALIGN may introduce memory leak
\ Briefly tested on several forths but no guarantee
\
\ Public domain - use at own risk

: ;: >r ; \ black magic

: -floc ( -- ) \ locals exit
[ 8 floats negate ] literal allot ;

: +floc ( u -- ) \ locals init
falign 8 umin 8 over - floats allot 0 ?do f, loop
r> ['] -floc >r ;: r> execute \ auto memory release
;

: FLOCALS ( -- ) postpone +floc ; immediate

: (fto) ( r offs -- ) negate here + f! ;

: FTO ( "name" )
' >body c@ postpone literal postpone (fto) ; immediate

\ flocals
:noname does> c@ negate here + f@ ;
dup create RA 1 floats c, execute
dup create RB 2 floats c, execute
dup create RC 3 floats c, execute
dup create RD 4 floats c, execute
dup create RE 5 floats c, execute
dup create RF 6 floats c, execute
dup create RG 7 floats c, execute
create RH 8 floats c, execute

\\
: test 2 flocals ra f. rb f. 3e fto rc rc f. ;
1e 2e test \ 1. 2. 3.

--- Synchronet 3.22a-Linux NewsLink 1.2

From Newsgroup: comp.lang.forth

Updated: simplified and fixes potential memory leak

\ Simple local fvariables loosely based on FSL code
\
\ Memory is ALLOTed at HERE on entry and released on exit.
\ PAD and HOLD contents not preserved.
\
\ FLOCALS takes 'u' floats from stack reserving space for
\ eight (RA thru RH). Unused locals free for general use.
\ Executing a local returns its value. FTO assigns a value.
\
\ Left-to-right ordering
\ Can be nested (may need 'inlining' disabled)
\ Briefly tested on several forths but no guarantee
\
\ 2026-05-14 Fix FALIGN memory leak
\
\ Public domain - use at own risk

: ;: >r ; \ black magic

: FLOCALS ( u -- ) \ locals init
here >r falign 8 umin 8 over - floats allot 0 ?do f, loop
2r> >r ;: r> here - allot \ auto memory release
;

: (fto) ( r offs -- ) negate here + f! ;

: FTO ( "name" )
' >body c@ postpone literal postpone (fto) ; immediate

\ flocals
:noname does> c@ negate here + f@ ;
dup create RA 1 floats c, execute
dup create RB 2 floats c, execute
dup create RC 3 floats c, execute
dup create RD 4 floats c, execute
dup create RE 5 floats c, execute
dup create RF 6 floats c, execute
dup create RG 7 floats c, execute
create RH 8 floats c, execute

\\
: test 2 flocals ra f. rb f. 3e fto rc rc f. ;
1e 2e test \ 1. 2. 3.



--- Synchronet 3.22a-Linux NewsLink 1.2