[gforth] / gforth / intcomp.fs  

gforth: gforth/intcomp.fs


1 : anton 1.1 \ defining words for words with non-default and non-immediate compilation semantics
2 :    
3 : anton 1.6 \ Copyright (C) 1996,1997 Free Software Foundation, Inc.
4 : anton 1.1
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 : anton 1.7 \ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA.
20 : anton 1.1
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 : anton 1.3 : create-interpret/compile ( "name" -- ) \ gforth
36 : anton 1.1 0 0 interpret/compile:
37 : anton 1.2 here lastxt interpret/compile-comp !
38 :     no-compilation-does-code here does-code!
39 :     [ 0 >body ] literal allot
40 : anton 1.1 here lastxt interpret/compile-int !
41 :     no-interpretation-does-code here does-code!
42 : anton 1.2 [ 0 >body ] literal allot ; \ restrict?
43 : anton 1.1
44 :     : fix-does-code ( addr ret-addr -- )
45 : anton 1.4 lastxt [ interpret/compile-struct %size ] literal + >r
46 : anton 1.1 lastxt interpret/compile?
47 : anton 1.2 lastxt interpret/compile-int @ r@ >body = and
48 :     lastxt interpret/compile-comp @ r> = and
49 : anton 1.1 0= abort" not created with create-interpret/compile"
50 : anton 1.5 cell+ cell+ maxaligned /does-handler + \ to does-code
51 : anton 1.1 swap @ does-code! ;
52 :    
53 :     : (interpretation>) ( -- )
54 :     lastxt interpret/compile-int r@ fix-does-code ;
55 :    
56 : anton 1.3 : interpretation> ( compilation. -- orig colon-sys ) \ gforth
57 : anton 1.1 POSTPONE (interpretation>) POSTPONE ahead
58 : anton 1.2 dodoes, defstart dead-code off 0 set-locals-size-list ; immediate restrict
59 : anton 1.1
60 : anton 1.3 : <interpretation ( compilation. orig colon-sys -- ) \ gforth
61 : anton 1.1 ?struc POSTPONE exit
62 :     POSTPONE then ; immediate restrict
63 :    
64 :     : (compilation>) ( -- )
65 :     lastxt interpret/compile-comp r@ fix-does-code ;
66 :    
67 : anton 1.3 : compilation> ( compilation. -- orig colon-sys ) \ gforth
68 : anton 1.1 POSTPONE (compilation>) POSTPONE ahead
69 : anton 1.2 dodoes, defstart dead-code off 0 set-locals-size-list POSTPONE >body ; immediate restrict
70 : anton 1.1
71 : anton 1.3 comp' <interpretation drop
72 :     Alias <compilation ( compilation. orig colon-sys -- ) \ gforth
73 :     immediate restrict
74 : anton 1.1
75 :     \ example
76 :     \ : constant ( n "name" -- )
77 :     \ create-interpret/compile
78 :     \ ,
79 :     \ interpretation>
80 :     \ @
81 :     \ <interpretation
82 :     \ compilation>
83 :     \ @ postpone literal
84 :     \ <compilation ;
85 :    
86 :     \ 5 constant five
87 :    
88 :     \ cr
89 :     \ five . cr
90 :     \ : fuenf five ;
91 :     \ see fuenf cr

CVS Admin

Powered by ViewCVS 1.0-dev
(Powered by ViewCVS)

ViewCVS and CVS Help