Return to wordinfo.fs CVS log

Up to [gforth] / gforth

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.

    1: \ WORDINFO.FS  V1.0                                    17may93jaw
    2: 
    3: \ May be cross-compiled
    4: \ If you want check values then exclude comments,
    5: \ but keep in mind that this can't be cross-compiled
    6: 
    7: INCLUDE look.fs
    8: 
    9: \ Wordinfo is a tool that checks a nfa
   10: \ and finds out what wordtype we have
   11: \ it is used in SEE.FS
   12: 
   13: : alias? ( nfa -- flag )
   14:         dup name> look
   15:         0= ABORT" WINFO: CFA not found"
   16: \       cell+
   17:         2dup <>
   18:         IF   nip dup 1 cells - here !
   19:              count $1f and here cell+ place true
   20:         ELSE 2drop false THEN ;
   21: 
   22: : var?  ( nfa -- flag )
   23:         cell+ (name>)
   24:         >code-address ['] udp >code-address = ;
   25: 
   26: : con?  ( nfa -- flag )
   27:         cell+ (name>)
   28:         >code-address ['] bl >code-address = ;
   29: 
   30: : does? ( nfa -- flag )
   31:         cell+ dup (name>)
   32:         >code-address ['] source >code-address =
   33:         dup IF swap (name>) cell+ @ here ! ELSE nip THEN ;
   34: 
   35: : defered? ( nfa -- flag )
   36:         dup does?
   37:         IF here @ ['] source cell+ @ =
   38:            dup IF swap cell+ (name>) >body @ here ! ELSE nip THEN
   39:         ELSE drop false THEN ;
   40: 
   41: : colon? ( nfa -- flag )
   42:         cell+ (name>)
   43:         >code-address ['] does? >code-address = ;
   44: 
   45: \ VALUE VCheck
   46: 
   47: \ : value? ( nfa -- flag )
   48: \         dup does?
   49: \         IF here @ ['] VCheck cell+ @ =
   50: \            dup IF swap (name>) >body @ here ! ELSE nip THEN
   51: \         ELSE drop false THEN ;
   52: 
   53: : prim? ( nfa -- flag )
   54:         name>
   55:         forthstart u< ;
   56: 
   57: \ None nestable IDs:
   58: 
   59: 1 CONSTANT Pri#         \ Primitives
   60: 2 CONSTANT Con#         \ Constants
   61: 3 CONSTANT Var#         \ Variables
   62: 4 CONSTANT Val#         \ Values
   63: 
   64: \ Nestabe IDs:
   65: 
   66: 5 CONSTANT Doe#         \ Does part
   67: 6 CONSTANT Def#         \ Defer
   68: 7 CONSTANT Col#         \ Colon def
   69: 
   70: \ Nobody knows:
   71: 
   72: 8 CONSTANT Ali#         \ Alias
   73: 
   74: 9 CONSTANT Str#         \ Structure words
   75: 
   76: 10 CONSTANT Com#        \ Compiler directives : ; POSTPONE
   77: 
   78: CREATE InfoTable
   79:         ' Prim? A, Pri# ,
   80:         ' Alias? A, Ali# ,
   81:         ' Con?   A, Con# ,
   82:         ' Var?   A, Var# ,
   83: \        ' Value? A, Val# ,
   84:         ' Defered? A, Def# ,
   85:         ' Does? A, Doe# ,
   86:         ' Colon? A, Col# ,
   87:         0 ,
   88: 
   89: : WordInfo ( nfa --- code )
   90:         InfoTable
   91:         BEGIN  dup @ dup
   92:         WHILE  swap 2 cells + swap
   93:                2 pick swap execute
   94:         UNTIL
   95:         1 cells - @ nip
   96:         ELSE
   97:         2drop drop 0
   98:         THEN ;
   99: