\ WORDINFO.FS V1.0 17may93jaw
\ May be cross-compiled
\ If you want check values then exclude comments,
\ but keep in mind that this can't be cross-compiled
INCLUDE look.fs
\ Wordinfo is a tool that checks a nfa
\ and finds out what wordtype we have
\ it is used in SEE.FS
: alias? ( nfa -- flag )
dup name> look
0= ABORT" WINFO: CFA not found"
cell+
2dup <>
IF nip dup 1 cells - here !
count $1f and here cell+ place true
ELSE 2drop false THEN ;
: var? ( nfa -- flag )
(name>)
>code-address ['] udp >code-address = ;
: con? ( nfa -- flag )
(name>)
>code-address ['] bl >code-address = ;
: does? ( nfa -- flag )
dup (name>)
>code-address ['] source >code-address =
dup IF swap (name>) cell+ @ here ! ELSE nip THEN ;
: defered? ( nfa -- flag )
dup does?
IF here @ ['] source cell+ @ =
dup IF swap (name>) >body @ here ! ELSE nip THEN
ELSE drop false THEN ;
: colon? ( nfa -- flag )
(name>)
>code-address ['] does? >code-address = ;
\ VALUE VCheck
\ : value? ( nfa -- flag )
\ dup does?
\ IF here @ ['] VCheck cell+ @ =
\ dup IF swap (name>) >body @ here ! ELSE nip THEN
\ ELSE drop false THEN ;
: prim? ( nfa -- flag )
name>
forthstart u< ;
\ None nestable IDs:
1 CONSTANT Pri# \ Primitives
2 CONSTANT Con# \ Constants
3 CONSTANT Var# \ Variables
4 CONSTANT Val# \ Values
\ Nestabe IDs:
5 CONSTANT Doe# \ Does part
6 CONSTANT Def# \ Defer
7 CONSTANT Col# \ Colon def
\ Nobody knows:
8 CONSTANT Ali# \ Alias
9 CONSTANT Str# \ Structure words
10 CONSTANT Com# \ Compiler directives : ; POSTPONE
CREATE InfoTable
' Alias? A, Ali# ,
' Con? A, Con# ,
' Var? A, Var# ,
\ ' Value? A, Val# ,
' Defered? A, Def# ,
' Does? A, Doe# ,
' Colon? A, Col# ,
' Prim? A, Pri# ,
0 ,
: WordInfo ( nfa --- code )
InfoTable
BEGIN dup @ dup
WHILE swap 2 cells + swap
2 pick swap execute
UNTIL
1 cells - @ nip
ELSE
2drop drop 0
THEN ;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>