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

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.