Annotation of gforth/intcomp.fs, revision 1.1

1.1     ! anton       1: \ defining words for words with non-default and non-immediate compilation semantics
        !             2: 
        !             3: \ Copyright (C) 1996 Free Software Foundation, Inc.
        !             4: 
        !             5: \ This file is part of Gforth.
        !             6: 
        !             7: \ Gforth is free software; you can redistribute it and/or
        !             8: \ modify it under the terms of the GNU General Public License
        !             9: \ as published by the Free Software Foundation; either version 2
        !            10: \ of the License, or (at your option) any later version.
        !            11: 
        !            12: \ This program is distributed in the hope that it will be useful,
        !            13: \ but WITHOUT ANY WARRANTY; without even the implied warranty of
        !            14: \ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
        !            15: \ GNU General Public License for more details.
        !            16: 
        !            17: \ You should have received a copy of the GNU General Public License
        !            18: \ along with this program; if not, write to the Free Software
        !            19: \ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
        !            20: 
        !            21: \ used like
        !            22: \ : <name> create-interpret/compile ...
        !            23: \     interpretation> ... <interpretation
        !            24: \     compilation> ... <compilation ;
        !            25: 
        !            26: 
        !            27: noname create
        !            28: does> abort" interpreting word without interpretation semantics" ;
        !            29: lastxt >does-code
        !            30: does> abort" compiling word without compilation semantics" ;
        !            31: lastxt >does-code
        !            32: constant no-compilation-does-code
        !            33: constant no-interpretation-does-code
        !            34: 
        !            35: : create-interpret/compile ( -- )
        !            36:     0 0 interpret/compile:
        !            37:     here lastxt interpret/compile-int !
        !            38:     no-interpretation-does-code here does-code!
        !            39:     0 >body allot
        !            40:     here lastxt interpret/compile-comp !
        !            41:     no-compilation-does-code here does-code!
        !            42:     0 >body allot ; \ restrict?
        !            43: 
        !            44: : fix-does-code ( addr ret-addr -- )
        !            45:     lastxt [ interpret/compile-struct drop ] literal + >r
        !            46:     lastxt interpret/compile?
        !            47:     lastxt interpret/compile-int @ r@ = and
        !            48:     lastxt interpret/compile-comp @ r> >body = and
        !            49:     0= abort" not created with create-interpret/compile"
        !            50:     cell+ cell+ /does-handler + \ to does-code
        !            51:     swap @ does-code! ;
        !            52: 
        !            53: : (interpretation>) ( -- )
        !            54:     lastxt interpret/compile-int r@ fix-does-code ;
        !            55: 
        !            56: : interpretation> ( -- orig colon-sys )
        !            57:     POSTPONE (interpretation>) POSTPONE ahead
        !            58:     dodoes, defstart dead-code off 0 set-locals-size-list POSTPONE >body ; immediate restrict
        !            59: 
        !            60: : <interpretation ( orig colon-sys -- )
        !            61:     ?struc POSTPONE exit
        !            62:     POSTPONE then ; immediate restrict
        !            63: 
        !            64: : (compilation>) ( -- )
        !            65:     lastxt interpret/compile-comp r@ fix-does-code ;
        !            66: 
        !            67: : compilation> ( -- orig colon-sys )
        !            68:     POSTPONE (compilation>) POSTPONE ahead
        !            69:     dodoes, defstart dead-code off 0 set-locals-size-list ; immediate restrict
        !            70: 
        !            71: comp' <interpretation drop Alias <compilation immediate restrict
        !            72: 
        !            73: \ example
        !            74: \ : constant ( n "name" -- )
        !            75: \     create-interpret/compile
        !            76: \     ,
        !            77: \ interpretation>
        !            78: \     @
        !            79: \ <interpretation
        !            80: \ compilation>
        !            81: \     @ postpone literal
        !            82: \ <compilation ;
        !            83: 
        !            84: \ 5 constant five
        !            85: 
        !            86: \ cr
        !            87: \ five . cr
        !            88: \ : fuenf five ;
        !            89: \ see fuenf cr

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>