File:  [gforth] / gforth / locals.fs
Revision 1.2: download - view: text, annotated - select for diffs
Wed Apr 20 17:12:04 1994 UTC (28 years, 3 months ago) by pazsan
Branches: MAIN
CVS tags: HEAD
primitives: key?, ms and time&date added
engine.c: time.h for ms and time&date included
bugs fixed to run tt.pfe

    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: : f>r  r> rp@ 1 floats - dup rp! f! >r ;
   10: : (flocal DOES>  @ local, postpone f@ ;
   11: 
   12: : do-nothing ;
   13: : ralign  r>
   14:   BEGIN  rp@ [ 1 floats 1- ] Literal and
   15:          WHILE  [ ' do-nothing >body ] ALiteral >r
   16:   REPEAT  >r ;
   17: 
   18: : <local ( -- sys1 )  current @ @ loffset @ locals @
   19:   over 0= IF  postpone  ralign  THEN  ;                 immediate
   20: : local: ( -- )  postpone >r  last @ lastcfa @ here locals @ dp !
   21:   cell loffset +! Create  loffset @ , immediate (local
   22:   here locals !  dp !  lastcfa ! last ! ;               immediate
   23: : flocal: ( -- )  last @ lastcfa @ here locals @ dp !
   24:   BEGIN  loffset @ 0 1 floats fm/mod drop  WHILE
   25:          0 postpone Literal postpone >r  1 cells  loffset +!  REPEAT
   26:   postpone f>r  Create  loffset @ , immediate (flocal
   27:   here locals !  dp !  lastcfa ! last ! ;               immediate
   28: : local> ( sys1 -- sys2 ) ;                             immediate
   29: : local; ( sys2 -- ) locals ! dup delocal,
   30:   loffset ! current @ ! ;                               immediate
   31: : TO  >in @ ' dup @ [ ' (local >body cell+ ] ALiteral =
   32:   IF    >body @ local, postpone ! drop
   33:   ELSE  dup @ [ ' (flocal >body cell+ ] ALiteral =
   34:         IF    >body @ local, postpone f!  drop
   35:         ELSE  drop >in ! postpone to  THEN THEN ;       immediate
   36: 
   37: : DO      2 cells loffset +!  postpone DO     ; immediate restrict
   38: : ?DO     2 cells loffset +!  postpone ?DO    ; immediate restrict
   39: : FOR     2 cells loffset +!  postpone FOR    ; immediate restrict
   40: : LOOP   -2 cells loffset +!  postpone LOOP   ; immediate restrict
   41: : +LOOP  -2 cells loffset +!  postpone +LOOP  ; immediate restrict
   42: : NEXT   -2 cells loffset +!  postpone NEXT   ; immediate restrict
   43: : >R      1 cells loffset +!  postpone >R     ; immediate restrict
   44: : R>     -1 cells loffset +!  postpone R>     ; immediate restrict
   45: 
   46: \ High level locals                                    19aug93py
   47: 
   48: : { postpone <local  -1
   49:   BEGIN  >in @ name dup c@ 1 = swap 1+ c@ '| = and  UNTIL
   50:   drop >in @ >r
   51:   BEGIN  dup 0< 0= WHILE  >in ! postpone local:  REPEAT  drop
   52:   r> >in ! postpone local> ;                  immediate restrict
   53: 
   54: : F{ postpone <local  -1
   55:   BEGIN  >in @ name dup c@ 1 = swap 1+ c@ '| = and  UNTIL
   56:   drop >in @ >r
   57:   BEGIN  dup 0< 0= WHILE  >in ! postpone Flocal:  REPEAT  drop
   58:   r> >in ! postpone local> ;                  immediate restrict
   59: 
   60: ' local; alias } immediate restrict
   61: 
   62: \ ANS Locals                                           19aug93py
   63: 
   64: Create inlocal  5 cells allot  inlocal off
   65: : (local)  ( addr u -- )  inlocal @ 0=
   66:   IF  postpone <local inlocal on
   67:       inlocal 3 cells + 2!  inlocal cell+ 2! THEN
   68:   dup IF    linestart @ >r loadline @ >r loadfile @ >r
   69:             blk @ >r >tib @ >r  #tib @ dup >r  >in @ >r
   70: 
   71:             >tib +! dup #tib ! >tib @ swap move
   72:             >in off blk off loadfile off -1 linestart !
   73: 
   74:             postpone local:
   75: 
   76:             r> >in !  r> #tib !  r> >tib ! r> blk !
   77:             r> loadfile ! r> loadline ! r> linestart !
   78:       ELSE  2drop  inlocal cell+ 2@  inlocal 3 cells + 2@
   79:             postpone local>
   80:             inlocal 2 cells + 2! inlocal cell+ ! THEN ;
   81: 
   82: : ?local;  inlocal @
   83:   IF  inlocal cell+ @ inlocal 2 cells + 2@
   84:       postpone local; inlocal off  THEN ;
   85: 
   86: : ;      ?local; postpone ; ;                 immediate restrict
   87: : DOES>  ?local; postpone DOES> ;             immediate
   88: : EXIT  inlocal @ IF  0 delocal,  THEN  postpone EXIT ; immediate
   89: 
   90: : locals|
   91:   BEGIN  name dup c@ 1 = over 1+ c@ '| = and 0=  WHILE
   92:          count (local)  REPEAT  0 (local) ;   immediate restrict

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>