Return to locals.fs CVS log

Up to [gforth] / gforth

Annotation of gforth/locals.fs, revision 1.1

1.1     ! pazsan      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