File:  [gforth] / gforth / wordinfo.fs
Revision 1.4: download - view: text, annotated - select for diffs
Wed Jul 13 19:21:09 1994 UTC (25 years, 4 months ago) by pazsan
Branches: MAIN
CVS tags: HEAD
Moved setjmp from engine to go_forth, because the socalled "globbered"
variables where saved in memory (and this slows down everything).
Added global up0 for security (up is globbered).

Added restrict's functionalitz to cross.fs

removed all occurency of cell+ name>, because the bug in name> is
fixed.

Added a dusty workaround at the end of prims2x.fs, because of
strange exceptions.

\ 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 )
        cell+ (name>)
        >code-address ['] udp >code-address = ;

: con?  ( nfa -- flag )
        cell+ (name>)
        >code-address ['] bl >code-address = ;

: does? ( nfa -- flag )
        cell+ 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 cell+ (name>) >body @ here ! ELSE nip THEN
        ELSE drop false THEN ;

: colon? ( nfa -- flag )
        cell+ (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
        ' Prim? A, Pri# ,
        ' Alias? A, Ali# ,
        ' Con?   A, Con# ,
        ' Var?   A, Var# ,
\        ' Value? A, Val# ,
        ' Defered? A, Def# ,
        ' Does? A, Doe# ,
        ' Colon? A, Col# ,
        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>