1\ WORDINFO.FS  V1.0                                    17may93jaw
2
3\ Copyright (C) 1995,1996,1998,2000,2003,2007 Free Software Foundation, Inc.
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 3
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, see http://www.gnu.org/licenses/.
19
20\ May be cross-compiled
21\ If you want check values then exclude comments,
22\ but keep in mind that this can't be cross-compiled
23
24require look.fs
25
26\ Wordinfo is a tool that checks a nfa
27\ and finds out what wordtype we have
28\ it is used in SEE.FS
29
30\ the old alias? did not work and it is not used, so I changed
31\ it in many respects - anton
32: alias? ( nfa1 -- nfa2|0 )
33    \ if nfa1 is an alias, nfa2 is the name of the original word.
34    \ if the original word has no name, return 0.
35    dup cell+ @ alias-mask and 0=
36    IF ( nfa1 )
37	((name>)) @ >name
38    ELSE
39	drop 0
40    THEN ;
41
42: var?  ( nfa -- flag )
43    ((name>)) >code-address dovar: = ;
44
45: con?  ( nfa -- flag )
46    ((name>)) >code-address docon: = ;
47
48: user?  ( nfa -- flag )
49    ((name>)) >code-address douser: = ;
50
51: does? ( nfa -- flag )
52    ((name>))
53    >does-code 0<> ;
54
55: defered? ( nfa -- flag )
56    ((name>)) >code-address dodefer: = ;
57
58: colon? ( nfa -- flag )
59    ((name>)) >code-address docol: = ;
60
61\ the above words could be factored with create-does>, but this would
62\ probably make this file incompatible with cross.
63
64[IFDEF] forthstart
65: xtprim? ( xt -- flag )
66    in-dictionary? 0= ; \ !! does not work for CODE words
67[ELSE]
68: xtprim? ( xt -- flag )
69    dup >body swap >code-address = ; \ !! works only for indirect threaded code
70				     \ !! does not work for primitives
71[THEN]
72: prim? ( nfa -- flag )
73        name>int xtprim? ;
74
75\ None nestable IDs:
76
771 CONSTANT Pri#         \ Primitives
782 CONSTANT Con#         \ Constants
793 CONSTANT Var#         \ Variables
804 CONSTANT Val#         \ Values
81
82\ Nestabe IDs:
83
845 CONSTANT Doe#         \ Does part
856 CONSTANT Def#         \ Defer
867 CONSTANT Col#         \ Colon def
878 CONSTANT Use#         \ User variable
88
89\ Nobody knows:
90
919 CONSTANT Ali#         \ Alias
92
9310 CONSTANT Str#         \ Structure words
94
9511 CONSTANT Com#        \ Compiler directives : ; POSTPONE
96
97CREATE InfoTable
98        ' Prim?    A, Pri# ,
99        ' Alias?   A, Ali# ,
100        ' Con?     A, Con# ,
101        ' Var?     A, Var# ,
102\        ' Value?  A, Val# ,
103        ' Defered? A, Def# ,
104        ' Does?    A, Doe# ,
105        ' Colon?   A, Col# ,
106	' User?    A, Use# ,
107        0 ,
108
109: WordInfo ( nfa --- code )
110        InfoTable
111        BEGIN  dup @ dup
112        WHILE  swap 2 cells + swap
113               2 pick swap execute
114        UNTIL
115        1 cells - @ nip
116        ELSE
117        2drop drop 0
118        THEN ;
119
120