Return to wordinfo.fs CVS log

Up to [gforth] / gforth

Annotation of gforth/wordinfo.fs, revision 1.1

1.1     ! anton       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:         (name>)
        !            24:         @ ['] leavings @ = ;
        !            25: 
        !            26: : con?  ( nfa -- flag )
        !            27:         (name>)
        !            28:         @ ['] bl @ = ;
        !            29: 
        !            30: : does? ( nfa -- flag )
        !            31:         dup (name>)
        !            32:         @ ['] source @ =
        !            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 (name>) >body @ here ! ELSE nip THEN
        !            39:         ELSE drop false THEN ;
        !            40: 
        !            41: : colon? ( nfa -- flag )
        !            42:         (name>)
        !            43:         @ ['] does? @ = ;
        !            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:         ' Alias? A, Ali# ,
        !            80:         ' Con?   A, Con# ,
        !            81:         ' Var?   A, Var# ,
        !            82: \        ' Value? A, Val# ,
        !            83:         ' Defered? A, Def# ,
        !            84:         ' Does? A, Doe# ,
        !            85:         ' Colon? A, Col# ,
        !            86:         ' Prim? A, Pri# ,
        !            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: