Annotation of gforth/locals.fs, revision 1.9
1.1 pazsan 1: \ Local primitives 17jan92py
2:
1.8 anton 3: \ Copyright (C) 1995,2000,2003 Free Software Foundation, Inc.
1.3 anton 4:
5: \ This file is part of Gforth.
6:
7: \ Gforth is free software; you can redistribute it and/or
8: \ modify it under the terms of the GNU General Public License
1.9 ! anton 9: \ as published by the Free Software Foundation, either version 3
1.3 anton 10: \ of the License, or (at your option) any later version.
11:
12: \ This program is distributed in the hope that it will be useful,
13: \ but WITHOUT ANY WARRANTY; without even the implied warranty of
14: \ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15: \ GNU General Public License for more details.
16:
17: \ You should have received a copy of the GNU General Public License
1.9 ! anton 18: \ along with this program. If not, see http://www.gnu.org/licenses/.
1.3 anton 19:
1.1 pazsan 20: Variable loffset 0 loffset !
21: Variable locals here locals ! 100 ( some) cells allot
22: : local, ( offset -- ) postpone rp@ loffset @ swap -
23: postpone Literal postpone + ;
24: : delocal, ( offset -- ) local, postpone rp! ;
25: : (local DOES> @ local, postpone @ ;
1.2 pazsan 26: : f>r r> rp@ 1 floats - dup rp! f! >r ;
27: : (flocal DOES> @ local, postpone f@ ;
1.1 pazsan 28:
1.2 pazsan 29: : do-nothing ;
30: : ralign r>
31: BEGIN rp@ [ 1 floats 1- ] Literal and
32: WHILE [ ' do-nothing >body ] ALiteral >r
33: REPEAT >r ;
34:
35: : <local ( -- sys1 ) current @ @ loffset @ locals @
36: over 0= IF postpone ralign THEN ; immediate
1.7 anton 37: : local: ( -- ) postpone >r latest latestxt here locals @ dp !
1.1 pazsan 38: cell loffset +! Create loffset @ , immediate (local
39: here locals ! dp ! lastcfa ! last ! ; immediate
1.7 anton 40: : flocal: ( -- ) latest latestxt here locals @ dp !
1.2 pazsan 41: BEGIN loffset @ 0 1 floats fm/mod drop WHILE
42: 0 postpone Literal postpone >r 1 cells loffset +! REPEAT
43: postpone f>r Create loffset @ , immediate (flocal
44: here locals ! dp ! lastcfa ! last ! ; immediate
1.1 pazsan 45: : local> ( sys1 -- sys2 ) ; immediate
46: : local; ( sys2 -- ) locals ! dup delocal,
47: loffset ! current @ ! ; immediate
48: : TO >in @ ' dup @ [ ' (local >body cell+ ] ALiteral =
49: IF >body @ local, postpone ! drop
1.2 pazsan 50: ELSE dup @ [ ' (flocal >body cell+ ] ALiteral =
51: IF >body @ local, postpone f! drop
52: ELSE drop >in ! postpone to THEN THEN ; immediate
1.1 pazsan 53:
54: : DO 2 cells loffset +! postpone DO ; immediate restrict
55: : ?DO 2 cells loffset +! postpone ?DO ; immediate restrict
56: : FOR 2 cells loffset +! postpone FOR ; immediate restrict
57: : LOOP -2 cells loffset +! postpone LOOP ; immediate restrict
58: : +LOOP -2 cells loffset +! postpone +LOOP ; immediate restrict
59: : NEXT -2 cells loffset +! postpone NEXT ; immediate restrict
60: : >R 1 cells loffset +! postpone >R ; immediate restrict
61: : R> -1 cells loffset +! postpone R> ; immediate restrict
62:
63: \ High level locals 19aug93py
64:
65: : { postpone <local -1
66: BEGIN >in @ name dup c@ 1 = swap 1+ c@ '| = and UNTIL
67: drop >in @ >r
68: BEGIN dup 0< 0= WHILE >in ! postpone local: REPEAT drop
69: r> >in ! postpone local> ; immediate restrict
70:
1.2 pazsan 71: : F{ postpone <local -1
72: BEGIN >in @ name dup c@ 1 = swap 1+ c@ '| = and UNTIL
73: drop >in @ >r
74: BEGIN dup 0< 0= WHILE >in ! postpone Flocal: REPEAT drop
75: r> >in ! postpone local> ; immediate restrict
76:
1.1 pazsan 77: ' local; alias } immediate restrict
78:
79: \ ANS Locals 19aug93py
80:
81: Create inlocal 5 cells allot inlocal off
82: : (local) ( addr u -- ) inlocal @ 0=
83: IF postpone <local inlocal on
84: inlocal 3 cells + 2! inlocal cell+ 2! THEN
1.4 anton 85: dup IF linestart @ >r sourceline# >r loadfile @ >r
1.1 pazsan 86: blk @ >r >tib @ >r #tib @ dup >r >in @ >r
87:
88: >tib +! dup #tib ! >tib @ swap move
89: >in off blk off loadfile off -1 linestart !
90:
91: postpone local:
92:
93: r> >in ! r> #tib ! r> >tib ! r> blk !
94: r> loadfile ! r> loadline ! r> linestart !
95: ELSE 2drop inlocal cell+ 2@ inlocal 3 cells + 2@
96: postpone local>
97: inlocal 2 cells + 2! inlocal cell+ ! THEN ;
98:
99: : ?local; inlocal @
100: IF inlocal cell+ @ inlocal 2 cells + 2@
101: postpone local; inlocal off THEN ;
102:
103: : ; ?local; postpone ; ; immediate restrict
104: : DOES> ?local; postpone DOES> ; immediate
1.2 pazsan 105: : EXIT inlocal @ IF 0 delocal, THEN postpone EXIT ; immediate
1.1 pazsan 106:
107: : locals|
108: BEGIN name dup c@ 1 = over 1+ c@ '| = and 0= WHILE
109: count (local) REPEAT 0 (local) ; immediate restrict
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>