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