Annotation of gforth/intcomp.fs, revision 1.2
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:
1.2 ! anton 37: here lastxt interpret/compile-comp !
! 38: no-compilation-does-code here does-code!
! 39: [ 0 >body ] literal allot
1.1 anton 40: here lastxt interpret/compile-int !
41: no-interpretation-does-code here does-code!
1.2 ! anton 42: [ 0 >body ] literal allot ; \ restrict?
1.1 anton 43:
44: : fix-does-code ( addr ret-addr -- )
45: lastxt [ interpret/compile-struct drop ] literal + >r
46: lastxt interpret/compile?
1.2 ! anton 47: lastxt interpret/compile-int @ r@ >body = and
! 48: lastxt interpret/compile-comp @ r> = and
1.1 anton 49: 0= abort" not created with create-interpret/compile"
1.2 ! anton 50: [ /does-handler cell+ cell+ ] literal + \ to does-code
1.1 anton 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
1.2 ! anton 58: dodoes, defstart dead-code off 0 set-locals-size-list ; immediate restrict
1.1 anton 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
1.2 ! anton 69: dodoes, defstart dead-code off 0 set-locals-size-list POSTPONE >body ; immediate restrict
1.1 anton 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>