File:
[gforth] /
gforth /
wordinfo.fs
Revision
1.4:
download - view:
text,
annotated -
select for diffs
Wed Jul 13 19:21:09 1994 UTC (28 years, 6 months ago) by
pazsan
Branches:
MAIN
CVS tags:
HEAD
Moved setjmp from engine to go_forth, because the socalled "globbered"
variables where saved in memory (and this slows down everything).
Added global up0 for security (up is globbered).
Added restrict's functionalitz to cross.fs
removed all occurency of cell+ name>, because the bug in name> is
fixed.
Added a dusty workaround at the end of prims2x.fs, because of
strange exceptions.
1: \ WORDINFO.FS V1.0 17may93jaw
2:
3: \ May be cross-compiled
4: \ If you want check values then exclude comments,
5: \ but keep in mind that this can't be cross-compiled
6:
7: INCLUDE look.fs
8:
9: \ Wordinfo is a tool that checks a nfa
10: \ and finds out what wordtype we have
11: \ it is used in SEE.FS
12:
13: : alias? ( nfa -- flag )
14: dup name> look
15: 0= ABORT" WINFO: CFA not found"
16: \ cell+
17: 2dup <>
18: IF nip dup 1 cells - here !
19: count $1f and here cell+ place true
20: ELSE 2drop false THEN ;
21:
22: : var? ( nfa -- flag )
23: cell+ (name>)
24: >code-address ['] udp >code-address = ;
25:
26: : con? ( nfa -- flag )
27: cell+ (name>)
28: >code-address ['] bl >code-address = ;
29:
30: : does? ( nfa -- flag )
31: cell+ dup (name>)
32: >code-address ['] source >code-address =
33: dup IF swap (name>) cell+ @ here ! ELSE nip THEN ;
34:
35: : defered? ( nfa -- flag )
36: dup does?
37: IF here @ ['] source cell+ @ =
38: dup IF swap cell+ (name>) >body @ here ! ELSE nip THEN
39: ELSE drop false THEN ;
40:
41: : colon? ( nfa -- flag )
42: cell+ (name>)
43: >code-address ['] does? >code-address = ;
44:
45: \ VALUE VCheck
46:
47: \ : value? ( nfa -- flag )
48: \ dup does?
49: \ IF here @ ['] VCheck cell+ @ =
50: \ dup IF swap (name>) >body @ here ! ELSE nip THEN
51: \ ELSE drop false THEN ;
52:
53: : prim? ( nfa -- flag )
54: name>
55: forthstart u< ;
56:
57: \ None nestable IDs:
58:
59: 1 CONSTANT Pri# \ Primitives
60: 2 CONSTANT Con# \ Constants
61: 3 CONSTANT Var# \ Variables
62: 4 CONSTANT Val# \ Values
63:
64: \ Nestabe IDs:
65:
66: 5 CONSTANT Doe# \ Does part
67: 6 CONSTANT Def# \ Defer
68: 7 CONSTANT Col# \ Colon def
69:
70: \ Nobody knows:
71:
72: 8 CONSTANT Ali# \ Alias
73:
74: 9 CONSTANT Str# \ Structure words
75:
76: 10 CONSTANT Com# \ Compiler directives : ; POSTPONE
77:
78: CREATE InfoTable
79: ' Prim? A, Pri# ,
80: ' Alias? A, Ali# ,
81: ' Con? A, Con# ,
82: ' Var? A, Var# ,
83: \ ' Value? A, Val# ,
84: ' Defered? A, Def# ,
85: ' Does? A, Doe# ,
86: ' Colon? A, Col# ,
87: 0 ,
88:
89: : WordInfo ( nfa --- code )
90: InfoTable
91: BEGIN dup @ dup
92: WHILE swap 2 cells + swap
93: 2 pick swap execute
94: UNTIL
95: 1 cells - @ nip
96: ELSE
97: 2drop drop 0
98: THEN ;
99:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>