Groups | Search | Server Info | Keyboard shortcuts | Login | Register [http] [https] [nntp] [nntps]


Groups > comp.lang.forth > #135081

Simple local fvariables

Date 2026-05-13 22:56 +1000
Newsgroups comp.lang.forth
From dxf <dxforth@gmail.com>
Subject Simple local fvariables
Message-ID <6a04750b$1@news.ausics.net> (permalink)
Organization Ausics - https://newsgroups.ausics.net

Show all headers | View raw


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.

Back to comp.lang.forth | Previous | NextNext in thread | Find similar


Thread

Simple local fvariables dxf <dxforth@gmail.com> - 2026-05-13 22:56 +1000
  Re: Simple local fvariables dxf <dxforth@gmail.com> - 2026-05-14 11:40 +1000

csiph-web