Annotation of gforth/wordinfo.fs, revision 1.20
1.1 anton 1: \ WORDINFO.FS V1.0 17may93jaw
2:
1.17 anton 3: \ Copyright (C) 1995,1996,1998 Free Software Foundation, Inc.
1.8 anton 4:
5: \ This file is part of Gforth.
6:
7: \ Gforth is free software; you can redistribute it and/or
8: \ modify it under the terms of the GNU General Public License
9: \ as published by the Free Software Foundation; either version 2
10: \ of the License, or (at your option) any later version.
11:
12: \ This program is distributed in the hope that it will be useful,
13: \ but WITHOUT ANY WARRANTY; without even the implied warranty of
14: \ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15: \ GNU General Public License for more details.
16:
17: \ You should have received a copy of the GNU General Public License
18: \ along with this program; if not, write to the Free Software
19: \ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
20:
1.1 anton 21: \ May be cross-compiled
22: \ If you want check values then exclude comments,
23: \ but keep in mind that this can't be cross-compiled
24:
1.19 anton 25: require look.fs
1.1 anton 26:
27: \ Wordinfo is a tool that checks a nfa
28: \ and finds out what wordtype we have
29: \ it is used in SEE.FS
30:
1.9 anton 31: \ the old alias? did not work and it is not used, so I changed
32: \ it in many respects - anton
33: : alias? ( nfa1 -- nfa2|0 )
1.20 ! anton 34: \ if nfa1 is an alias, nfa2 is the name of the original word.
! 35: \ if the original word has no name, return 0.
1.12 anton 36: dup cell+ c@ alias-mask and 0=
37: IF ( nfa1 )
1.20 ! anton 38: ((name>)) @ >name
1.9 anton 39: ELSE
40: drop 0
41: THEN ;
1.1 anton 42:
43: : var? ( nfa -- flag )
1.12 anton 44: ((name>)) >code-address dovar: = ;
1.1 anton 45:
46: : con? ( nfa -- flag )
1.12 anton 47: ((name>)) >code-address docon: = ;
1.1 anton 48:
1.5 pazsan 49: : user? ( nfa -- flag )
1.12 anton 50: ((name>)) >code-address douser: = ;
1.5 pazsan 51:
1.1 anton 52: : does? ( nfa -- flag )
1.12 anton 53: ((name>))
1.13 anton 54: >does-code 0<> ;
1.1 anton 55:
56: : defered? ( nfa -- flag )
1.12 anton 57: ((name>)) >code-address dodefer: = ;
1.1 anton 58:
59: : colon? ( nfa -- flag )
1.12 anton 60: ((name>)) >code-address docol: = ;
1.7 anton 61:
62: \ the above words could be factored with create-does>, but this would
63: \ probably make this file incompatible with cross.
1.1 anton 64:
1.14 jwilke 65: [IFDEF] forthstart
66: : xtprim? ( xt -- flag )
1.18 anton 67: in-dictionary? 0= ; \ !! does not work for CODE words
1.14 jwilke 68: [ELSE]
69: : xtprim? ( xt -- flag )
1.15 anton 70: dup >body swap >code-address = ; \ !! works only for indirect threaded code
71: \ !! does not work for primitives
1.14 jwilke 72: [THEN]
1.1 anton 73: : prim? ( nfa -- flag )
1.14 jwilke 74: name>int xtprim? ;
1.1 anton 75:
76: \ None nestable IDs:
77:
78: 1 CONSTANT Pri# \ Primitives
79: 2 CONSTANT Con# \ Constants
80: 3 CONSTANT Var# \ Variables
81: 4 CONSTANT Val# \ Values
82:
83: \ Nestabe IDs:
84:
85: 5 CONSTANT Doe# \ Does part
86: 6 CONSTANT Def# \ Defer
87: 7 CONSTANT Col# \ Colon def
1.5 pazsan 88: 8 CONSTANT Use# \ User variable
1.1 anton 89:
90: \ Nobody knows:
91:
1.5 pazsan 92: 9 CONSTANT Ali# \ Alias
1.1 anton 93:
1.5 pazsan 94: 10 CONSTANT Str# \ Structure words
1.1 anton 95:
1.5 pazsan 96: 11 CONSTANT Com# \ Compiler directives : ; POSTPONE
1.1 anton 97:
98: CREATE InfoTable
1.5 pazsan 99: ' Prim? A, Pri# ,
100: ' Alias? A, Ali# ,
101: ' Con? A, Con# ,
102: ' Var? A, Var# ,
103: \ ' Value? A, Val# ,
1.1 anton 104: ' Defered? A, Def# ,
1.5 pazsan 105: ' Does? A, Doe# ,
106: ' Colon? A, Col# ,
107: ' User? A, Use# ,
1.1 anton 108: 0 ,
109:
110: : WordInfo ( nfa --- code )
111: InfoTable
112: BEGIN dup @ dup
113: WHILE swap 2 cells + swap
114: 2 pick swap execute
115: UNTIL
116: 1 cells - @ nip
117: ELSE
118: 2drop drop 0
119: THEN ;
120:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>