Return to locals.fs CVS log | Up to [gforth] / gforth |

File:
[gforth] / gforth / locals.fs

Revision**1.4**: download - view: text, annotated - select for diffs

*Wed Nov 29 20:20:36 1995 UTC* (25 years, 6 months ago) by *anton*

Branches: MAIN

CVS tags: v0-4-0, v0-3-0, v0-2-1, v0-2-0, gforth-0_1beta, HEAD

Revision

Branches: MAIN

CVS tags: v0-4-0, v0-3-0, v0-2-1, v0-2-0, gforth-0_1beta, HEAD

replced tester.fs and coretest.fs with the new versions from John Hayes make mostlyclean virtualclean added Cache-flushing now works on the Alpha (other minor changes there) configure now uses gcc by default and passes its GCC variable to the Makefile introduced sourcefilename and sourceline# (and used them in many places).

1: \ Local primitives 17jan92py 2: 3: \ Copyright (C) 1995 Free Software Foundation, Inc. 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 9: \ as published by the Free Software Foundation; either version 2 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 18: \ along with this program; if not, write to the Free Software 19: \ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. 20: 21: Variable loffset 0 loffset ! 22: Variable locals here locals ! 100 ( some) cells allot 23: : local, ( offset -- ) postpone rp@ loffset @ swap - 24: postpone Literal postpone + ; 25: : delocal, ( offset -- ) local, postpone rp! ; 26: : (local DOES> @ local, postpone @ ; 27: : f>r r> rp@ 1 floats - dup rp! f! >r ; 28: : (flocal DOES> @ local, postpone f@ ; 29: 30: : do-nothing ; 31: : ralign r> 32: BEGIN rp@ [ 1 floats 1- ] Literal and 33: WHILE [ ' do-nothing >body ] ALiteral >r 34: REPEAT >r ; 35: 36: : <local ( -- sys1 ) current @ @ loffset @ locals @ 37: over 0= IF postpone ralign THEN ; immediate 38: : local: ( -- ) postpone >r last @ lastcfa @ here locals @ dp ! 39: cell loffset +! Create loffset @ , immediate (local 40: here locals ! dp ! lastcfa ! last ! ; immediate 41: : flocal: ( -- ) last @ lastcfa @ here locals @ dp ! 42: BEGIN loffset @ 0 1 floats fm/mod drop WHILE 43: 0 postpone Literal postpone >r 1 cells loffset +! REPEAT 44: postpone f>r Create loffset @ , immediate (flocal 45: here locals ! dp ! lastcfa ! last ! ; immediate 46: : local> ( sys1 -- sys2 ) ; immediate 47: : local; ( sys2 -- ) locals ! dup delocal, 48: loffset ! current @ ! ; immediate 49: : TO >in @ ' dup @ [ ' (local >body cell+ ] ALiteral = 50: IF >body @ local, postpone ! drop 51: ELSE dup @ [ ' (flocal >body cell+ ] ALiteral = 52: IF >body @ local, postpone f! drop 53: ELSE drop >in ! postpone to THEN THEN ; immediate 54: 55: : DO 2 cells loffset +! postpone DO ; immediate restrict 56: : ?DO 2 cells loffset +! postpone ?DO ; immediate restrict 57: : FOR 2 cells loffset +! postpone FOR ; immediate restrict 58: : LOOP -2 cells loffset +! postpone LOOP ; immediate restrict 59: : +LOOP -2 cells loffset +! postpone +LOOP ; immediate restrict 60: : NEXT -2 cells loffset +! postpone NEXT ; immediate restrict 61: : >R 1 cells loffset +! postpone >R ; immediate restrict 62: : R> -1 cells loffset +! postpone R> ; immediate restrict 63: 64: \ High level locals 19aug93py 65: 66: : { postpone <local -1 67: BEGIN >in @ name dup c@ 1 = swap 1+ c@ '| = and UNTIL 68: drop >in @ >r 69: BEGIN dup 0< 0= WHILE >in ! postpone local: REPEAT drop 70: r> >in ! postpone local> ; immediate restrict 71: 72: : F{ postpone <local -1 73: BEGIN >in @ name dup c@ 1 = swap 1+ c@ '| = and UNTIL 74: drop >in @ >r 75: BEGIN dup 0< 0= WHILE >in ! postpone Flocal: REPEAT drop 76: r> >in ! postpone local> ; immediate restrict 77: 78: ' local; alias } immediate restrict 79: 80: \ ANS Locals 19aug93py 81: 82: Create inlocal 5 cells allot inlocal off 83: : (local) ( addr u -- ) inlocal @ 0= 84: IF postpone <local inlocal on 85: inlocal 3 cells + 2! inlocal cell+ 2! THEN 86: dup IF linestart @ >r sourceline# >r loadfile @ >r 87: blk @ >r >tib @ >r #tib @ dup >r >in @ >r 88: 89: >tib +! dup #tib ! >tib @ swap move 90: >in off blk off loadfile off -1 linestart ! 91: 92: postpone local: 93: 94: r> >in ! r> #tib ! r> >tib ! r> blk ! 95: r> loadfile ! r> loadline ! r> linestart ! 96: ELSE 2drop inlocal cell+ 2@ inlocal 3 cells + 2@ 97: postpone local> 98: inlocal 2 cells + 2! inlocal cell+ ! THEN ; 99: 100: : ?local; inlocal @ 101: IF inlocal cell+ @ inlocal 2 cells + 2@ 102: postpone local; inlocal off THEN ; 103: 104: : ; ?local; postpone ; ; immediate restrict 105: : DOES> ?local; postpone DOES> ; immediate 106: : EXIT inlocal @ IF 0 delocal, THEN postpone EXIT ; immediate 107: 108: : locals| 109: BEGIN name dup c@ 1 = over 1+ c@ '| = and 0= WHILE 110: count (local) REPEAT 0 (local) ; immediate restrict

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