File:
[gforth] /
gforth /
compat /
anslocal.fs
Revision
1.3:
download - view:
text,
annotated -
select for diffs
Fri Jun 6 17:28:12 1997 UTC (25 years ago) by
anton
Branches:
MAIN
CVS tags:
v0-7-0,
v0-6-2,
v0-6-1,
v0-6-0,
v0-5-0,
v0-4-0,
HEAD
Environmental query "gforth" now returns the version-string
dictionary-end and unused moved into the kernel/basics.fs
Minor gforth.el bug fixes
Major rewrite of objects.fs (not yet done)
fixed -trailing bug (with test in test/other.fs)
optimization of fields with offset 0 in struct.fs and compat/struct.fs
other changes in compat/struct.fs (not yet done)
added ansreports to compat/*.fs
documentation changes
allot now checks for dict overflow
named [IS] (compilation semantics of IS).
minor changes
1: \ This implements a subset of the gforth locals syntax in pure ANS Forth
2:
3: \ This file is in the public domain. NO WARRANTY.
4:
5: \ This implementation technique has been described by John Hayes in
6: \ the SigForth Newsletter 4(2), Fall '92. He did not do the complete
7: \ job, but left some more mundane parts as an exercise to the reader.
8:
9: \ I don't implement the "|" part, because 1) gforth does not implement
10: \ it and 2) it's unnecessary; just put a 0 before the "{" for every
11: \ additional local you want to declare.
12:
13: \ The program uses the following words
14: \ from CORE :
15: \ : bl word count ; >in @ 2dup 0= IF 2drop [char] ELSE THEN drop
16: \ recurse swap ! immediate
17: \ from CORE-EXT :
18: \ parse true
19: \ from BLOCK-EXT :
20: \ \
21: \ from FILE :
22: \ ( S"
23: \ from LOCAL :
24: \ (local)
25: \ from STRING :
26: \ compare
27:
28: : local ( "name" -- )
29: bl word count (local) ;
30:
31: : {helper ( -- final-offset )
32: >in @
33: bl word count
34: 2dup s" --" compare 0= if
35: 2drop [char] } parse 2drop true
36: else
37: s" }" compare 0=
38: then
39: if
40: drop >in @
41: else
42: recurse
43: swap >in ! local
44: then ;
45:
46: : { ( -- )
47: {helper >in ! 0 0 (local) ; immediate
48:
49: \ : test-swap { a b -- b a } ." xxx"
50: \ b a ;
51:
52: \ 1 2 test-swap . . .s cr
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>