Annotation of gforth/wordinfo.fs, revision 1.5
1.1 anton 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"
1.4 pazsan 16: \ cell+
1.1 anton 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 )
1.4 pazsan 23: cell+ (name>)
1.3 pazsan 24: >code-address ['] udp >code-address = ;
1.1 anton 25:
26: : con? ( nfa -- flag )
1.4 pazsan 27: cell+ (name>)
1.2 pazsan 28: >code-address ['] bl >code-address = ;
1.1 anton 29:
1.5 ! pazsan 30: : user? ( nfa -- flag )
! 31: cell+ (name>)
! 32: >code-address ['] s0 >code-address = ;
! 33:
1.1 anton 34: : does? ( nfa -- flag )
1.4 pazsan 35: cell+ dup (name>)
1.2 pazsan 36: >code-address ['] source >code-address =
1.1 anton 37: dup IF swap (name>) cell+ @ here ! ELSE nip THEN ;
38:
39: : defered? ( nfa -- flag )
40: dup does?
41: IF here @ ['] source cell+ @ =
1.4 pazsan 42: dup IF swap cell+ (name>) >body @ here ! ELSE nip THEN
1.1 anton 43: ELSE drop false THEN ;
44:
45: : colon? ( nfa -- flag )
1.4 pazsan 46: cell+ (name>)
1.2 pazsan 47: >code-address ['] does? >code-address = ;
1.1 anton 48:
49: \ VALUE VCheck
50:
51: \ : value? ( nfa -- flag )
52: \ dup does?
53: \ IF here @ ['] VCheck cell+ @ =
54: \ dup IF swap (name>) >body @ here ! ELSE nip THEN
55: \ ELSE drop false THEN ;
56:
57: : prim? ( nfa -- flag )
58: name>
59: forthstart u< ;
60:
61: \ None nestable IDs:
62:
63: 1 CONSTANT Pri# \ Primitives
64: 2 CONSTANT Con# \ Constants
65: 3 CONSTANT Var# \ Variables
66: 4 CONSTANT Val# \ Values
67:
68: \ Nestabe IDs:
69:
70: 5 CONSTANT Doe# \ Does part
71: 6 CONSTANT Def# \ Defer
72: 7 CONSTANT Col# \ Colon def
1.5 ! pazsan 73: 8 CONSTANT Use# \ User variable
1.1 anton 74:
75: \ Nobody knows:
76:
1.5 ! pazsan 77: 9 CONSTANT Ali# \ Alias
1.1 anton 78:
1.5 ! pazsan 79: 10 CONSTANT Str# \ Structure words
1.1 anton 80:
1.5 ! pazsan 81: 11 CONSTANT Com# \ Compiler directives : ; POSTPONE
1.1 anton 82:
83: CREATE InfoTable
1.5 ! pazsan 84: ' Prim? A, Pri# ,
! 85: ' Alias? A, Ali# ,
! 86: ' Con? A, Con# ,
! 87: ' Var? A, Var# ,
! 88: \ ' Value? A, Val# ,
1.1 anton 89: ' Defered? A, Def# ,
1.5 ! pazsan 90: ' Does? A, Doe# ,
! 91: ' Colon? A, Col# ,
! 92: ' User? A, Use# ,
1.1 anton 93: 0 ,
94:
95: : WordInfo ( nfa --- code )
96: InfoTable
97: BEGIN dup @ dup
98: WHILE swap 2 cells + swap
99: 2 pick swap execute
100: UNTIL
101: 1 cells - @ nip
102: ELSE
103: 2drop drop 0
104: THEN ;
105:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>