Return to creation.fs CVS log

Up to [Qemu by Fabrice Bellard] / qemu / roms / openbios / forth / lib

Annotation of qemu/roms/openbios/forth/lib/creation.fs, revision 1.1

1.1     ! root        1: \ tag: misc useful functions
        !             2: \ 
        !             3: \ C bindings
        !             4: \ 
        !             5: \ Copyright (C) 2003, 2004 Samuel Rydh
        !             6: \ 
        !             7: \ See the file "COPYING" for further information about
        !             8: \ the copyright and warranty status of this work.
        !             9: \ 
        !            10: 
        !            11: \ return xt of the word just defined
        !            12: : last-xt ( -- xt )
        !            13:   latest @ na1+
        !            14: ;
        !            15: 
        !            16: \ -------------------------------------------------------------------------
        !            17: \ word creation
        !            18: \ -------------------------------------------------------------------------
        !            19: 
        !            20: : $is-ibuf ( size name name-len -- xt )
        !            21:   instance $buffer: drop
        !            22:   last-xt
        !            23: ;
        !            24: 
        !            25: : is-ibuf ( size -- xt )
        !            26:   0 0 $is-ibuf
        !            27: ;
        !            28: 
        !            29: : is-ivariable ( size name len -- xt )
        !            30:   4 -rot instance $buffer: drop
        !            31:   last-xt
        !            32: ;
        !            33: 
        !            34: : is-xt-func ( xt|0 wordstr len )
        !            35:   header 1 ,
        !            36:   ?dup if , then
        !            37:   ['] (semis) , reveal
        !            38: ;
        !            39: 
        !            40: : is-2xt-func ( xt1 xt2 wordstr len )
        !            41:   header 1 ,
        !            42:   swap , ,
        !            43:   ['] (semis) , reveal
        !            44: ;
        !            45: 
        !            46: : is-func-begin ( wordstr len )
        !            47:   header 1 ,
        !            48: ;
        !            49: 
        !            50: : is-func-end ( wordstr len )
        !            51:   ['] (semis) , reveal
        !            52: ;

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.