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>