File:
[gforth] /
gforth /
wordinfo.fs
Revision
1.6:
download - view:
text,
annotated -
select for diffs
Tue Nov 29 16:22:51 1994 UTC (29 years, 3 months ago) by
pazsan
Branches:
MAIN
CVS tags:
HEAD
* added configure mode for DOS-Makefile:
configure -target=i386-<anythinh>-msdos<anyversion>
creates Makefile for DOS.
* checked in some mminor changes which never were checked in.
* added special startup file for DOS
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: : user? ( nfa -- flag )
31: cell+ (name>)
32: >code-address ['] s0 >code-address = ;
33:
34: : does? ( nfa -- flag )
35: cell+ (name>)
36: >code-address ['] bits >code-address = ;
37:
38: : defered? ( nfa -- flag )
39: cell+ (name>)
40: >code-address ['] source >code-address = ;
41:
42: : colon? ( nfa -- flag )
43: cell+ (name>)
44: >code-address ['] does? >code-address = ;
45:
46: \ VALUE VCheck
47:
48: \ : value? ( nfa -- flag )
49: \ dup does?
50: \ IF here @ ['] VCheck cell+ @ =
51: \ dup IF swap (name>) >body @ here ! ELSE nip THEN
52: \ ELSE drop false THEN ;
53:
54: : prim? ( nfa -- flag )
55: name>
56: forthstart u< ;
57:
58: \ None nestable IDs:
59:
60: 1 CONSTANT Pri# \ Primitives
61: 2 CONSTANT Con# \ Constants
62: 3 CONSTANT Var# \ Variables
63: 4 CONSTANT Val# \ Values
64:
65: \ Nestabe IDs:
66:
67: 5 CONSTANT Doe# \ Does part
68: 6 CONSTANT Def# \ Defer
69: 7 CONSTANT Col# \ Colon def
70: 8 CONSTANT Use# \ User variable
71:
72: \ Nobody knows:
73:
74: 9 CONSTANT Ali# \ Alias
75:
76: 10 CONSTANT Str# \ Structure words
77:
78: 11 CONSTANT Com# \ Compiler directives : ; POSTPONE
79:
80: CREATE InfoTable
81: ' Prim? A, Pri# ,
82: ' Alias? A, Ali# ,
83: ' Con? A, Con# ,
84: ' Var? A, Var# ,
85: \ ' Value? A, Val# ,
86: ' Defered? A, Def# ,
87: ' Does? A, Doe# ,
88: ' Colon? A, Col# ,
89: ' User? A, Use# ,
90: 0 ,
91:
92: : WordInfo ( nfa --- code )
93: InfoTable
94: BEGIN dup @ dup
95: WHILE swap 2 cells + swap
96: 2 pick swap execute
97: UNTIL
98: 1 cells - @ nip
99: ELSE
100: 2drop drop 0
101: THEN ;
102:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>