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
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>