Return to locals.fs CVS log

Up to [gforth] / gforth

This file contains an experimental, simple, but portable local variable
environment.

    1: \ Local primitives                                      17jan92py
    2: 
    3: Variable loffset   0 loffset !
    4: Variable locals  here locals !  100 ( some) cells allot
    5: : local, ( offset -- )  postpone rp@ loffset @ swap -
    6:   postpone Literal postpone + ;
    7: : delocal, ( offset -- ) local, postpone rp! ;
    8: : (local  DOES>  @ local, postpone @ ;
    9: 
   10: : <local ( -- sys1 )  current @ @ loffset @ locals @ ;  immediate
   11: : local: ( -- )  postpone >r  last @ lastcfa @ here locals @ dp !
   12:   cell loffset +! Create  loffset @ , immediate (local
   13:   here locals !  dp !  lastcfa ! last ! ;               immediate
   14: : local> ( sys1 -- sys2 ) ;                             immediate
   15: : local; ( sys2 -- ) locals ! dup delocal,
   16:   loffset ! current @ ! ;                               immediate
   17: : TO  >in @ ' dup @ [ ' (local >body cell+ ] ALiteral =
   18:   IF    >body @ local, postpone ! drop
   19:   ELSE  drop >in ! postpone to  THEN  ;                 immediate
   20: : EXIT  loffset @ IF  0 delocal,  THEN  postpone EXIT ; immediate
   21: 
   22: : DO      2 cells loffset +!  postpone DO     ; immediate restrict
   23: : ?DO     2 cells loffset +!  postpone ?DO    ; immediate restrict
   24: : FOR     2 cells loffset +!  postpone FOR    ; immediate restrict
   25: : LOOP   -2 cells loffset +!  postpone LOOP   ; immediate restrict
   26: : +LOOP  -2 cells loffset +!  postpone +LOOP  ; immediate restrict
   27: : NEXT   -2 cells loffset +!  postpone NEXT   ; immediate restrict
   28: : >R      1 cells loffset +!  postpone >R     ; immediate restrict
   29: : R>     -1 cells loffset +!  postpone R>     ; immediate restrict
   30: 
   31: \ High level locals                                    19aug93py
   32: 
   33: : { postpone <local  -1
   34:   BEGIN  >in @ name dup c@ 1 = swap 1+ c@ '| = and  UNTIL
   35:   drop >in @ >r
   36:   BEGIN  dup 0< 0= WHILE  >in ! postpone local:  REPEAT  drop
   37:   r> >in ! postpone local> ;                  immediate restrict
   38: 
   39: ' local; alias } immediate restrict
   40: 
   41: \ ANS Locals                                           19aug93py
   42: 
   43: Create inlocal  5 cells allot  inlocal off
   44: : (local)  ( addr u -- )  inlocal @ 0=
   45:   IF  postpone <local inlocal on
   46:       inlocal 3 cells + 2!  inlocal cell+ 2! THEN
   47:   dup IF    linestart @ >r loadline @ >r loadfile @ >r
   48:             blk @ >r >tib @ >r  #tib @ dup >r  >in @ >r
   49: 
   50:             >tib +! dup #tib ! >tib @ swap move
   51:             >in off blk off loadfile off -1 linestart !
   52: 
   53:             postpone local:
   54: 
   55:             r> >in !  r> #tib !  r> >tib ! r> blk !
   56:             r> loadfile ! r> loadline ! r> linestart !
   57:       ELSE  2drop  inlocal cell+ 2@  inlocal 3 cells + 2@
   58:             postpone local>
   59:             inlocal 2 cells + 2! inlocal cell+ ! THEN ;
   60: 
   61: : ?local;  inlocal @
   62:   IF  inlocal cell+ @ inlocal 2 cells + 2@
   63:       postpone local; inlocal off  THEN ;
   64: 
   65: : ;      ?local; postpone ; ;                 immediate restrict
   66: : DOES>  ?local; postpone DOES> ;             immediate
   67: 
   68: : locals|
   69:   BEGIN  name dup c@ 1 = over 1+ c@ '| = and 0=  WHILE
   70:          count (local)  REPEAT  0 (local) ;   immediate restrict