Annotation of gforth/locals.fs, revision 1.2
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 @ ;
1.2 ! pazsan 9: : f>r r> rp@ 1 floats - dup rp! f! >r ;
! 10: : (flocal DOES> @ local, postpone f@ ;
1.1 pazsan 11:
1.2 ! pazsan 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
1.1 pazsan 20: : local: ( -- ) postpone >r last @ lastcfa @ here locals @ dp !
21: cell loffset +! Create loffset @ , immediate (local
22: here locals ! dp ! lastcfa ! last ! ; immediate
1.2 ! pazsan 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
1.1 pazsan 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
1.2 ! pazsan 33: ELSE dup @ [ ' (flocal >body cell+ ] ALiteral =
! 34: IF >body @ local, postpone f! drop
! 35: ELSE drop >in ! postpone to THEN THEN ; immediate
1.1 pazsan 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:
1.2 ! pazsan 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:
1.1 pazsan 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
1.2 ! pazsan 88: : EXIT inlocal @ IF 0 delocal, THEN postpone EXIT ; immediate
1.1 pazsan 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>