File:
[gforth] /
gforth /
wordinfo.fs
Revision
1.7:
download - view:
text,
annotated -
select for diffs
Sat Oct 7 17:38:21 1995 UTC (28 years, 6 months ago) by
anton
Branches:
MAIN
CVS tags:
HEAD
added code.fs (code, ;code, end-code, assembler)
renamed dostruc to dofield
made index and doc-entries nicer
Only words containing 'e' or 'E' are converted to FP numbers.
added many wordset comments
added flush-icache primitive and FLUSH_ICACHE macro
added +DO, U+DO, -DO, U-DO and -LOOP
added code address labels (`docol:' etc.)
fixed sparc cache_flush
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>) >code-address dovar: = ;
24:
25: : con? ( nfa -- flag )
26: cell+ (name>) >code-address docon: = ;
27:
28: : user? ( nfa -- flag )
29: cell+ (name>) >code-address douser: = ;
30:
31: : does? ( nfa -- flag )
32: \ !! does not work on all installations
33: cell+ (name>)
34: >code-address ['] bits >code-address = ;
35:
36: : defered? ( nfa -- flag )
37: cell+ (name>) >code-address dodefer: = ;
38:
39: : colon? ( nfa -- flag )
40: cell+ (name>) >code-address docol: = ;
41:
42: \ the above words could be factored with create-does>, but this would
43: \ probably make this file incompatible with cross.
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: 8 CONSTANT Use# \ User variable
70:
71: \ Nobody knows:
72:
73: 9 CONSTANT Ali# \ Alias
74:
75: 10 CONSTANT Str# \ Structure words
76:
77: 11 CONSTANT Com# \ Compiler directives : ; POSTPONE
78:
79: CREATE InfoTable
80: ' Prim? A, Pri# ,
81: ' Alias? A, Ali# ,
82: ' Con? A, Con# ,
83: ' Var? A, Var# ,
84: \ ' Value? A, Val# ,
85: ' Defered? A, Def# ,
86: ' Does? A, Doe# ,
87: ' Colon? A, Col# ,
88: ' User? A, Use# ,
89: 0 ,
90:
91: : WordInfo ( nfa --- code )
92: InfoTable
93: BEGIN dup @ dup
94: WHILE swap 2 cells + swap
95: 2 pick swap execute
96: UNTIL
97: 1 cells - @ nip
98: ELSE
99: 2drop drop 0
100: THEN ;
101:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>