[gforth] / gforth / xxxprim  

gforth: gforth/xxxprim

1 : anton 1.1 \ Gforth primitives
2 :    
3 : anton 1.9 \ Copyright (C) 1995,1996,1997,1998,2000,2003,2007 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 : anton 1.8 \ as published by the Free Software Foundation, either version 3
10 : anton 1.1 \ 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 : anton 1.8 \ along with this program. If not, see http://www.gnu.org/licenses/.
19 : anton 1.1
20 :    
21 :     \ WARNING: This file is processed by m4. Make sure your identifiers
22 :     \ don't collide with m4's (e.g. by undefining them).
23 :     \
24 :     \
25 :     \
26 :     \ This file contains primitive specifications in the following format:
27 :     \
28 :     \ forth name ( stack effect ) category [pronunciation]
29 :     \ [""glossary entry""]
30 :     \ C code
31 :     \ [:
32 :     \ Forth code]
33 :     \
34 :     \ Note: Fields in brackets are optional. Word specifications have to
35 :     \ be separated by at least one empty line
36 :     \
37 :     \ Both pronounciation and stack items (in the stack effect) must
38 :     \ conform to the C identifier syntax or the C compiler will complain.
39 :     \ If you don't have a pronounciation field, the Forth name is used,
40 :     \ and has to conform to the C identifier syntax.
41 :     \
42 :     \ These specifications are automatically translated into C-code for the
43 :     \ interpreter and into some other files. I hope that your C compiler has
44 :     \ decent optimization, otherwise the automatically generated code will
45 :     \ be somewhat slow. The Forth version of the code is included for manual
46 :     \ compilers, so they will need to compile only the important words.
47 :     \
48 :     \ Note that stack pointer adjustment is performed according to stack
49 :     \ effect by automatically generated code and NEXT is automatically
50 :     \ appended to the C code. Also, you can use the names in the stack
51 :     \ effect in the C code. Stack access is automatic. One exception: if
52 :     \ your code does not fall through, the results are not stored into the
53 :     \ stack. Use different names on both sides of the '--', if you change a
54 :     \ value (some stores to the stack are optimized away).
55 :     \
56 :     \ For superinstructions the syntax is:
57 :     \
58 :     \ forth-name [/ c-name] = forth-name forth-name ...
59 :     \
60 :     \
61 :     \ The stack variables have the following types:
62 :     \
63 :     \ name matches type
64 :     \ f.* Bool
65 :     \ c.* Char
66 :     \ [nw].* Cell
67 :     \ u.* UCell
68 :     \ d.* DCell
69 :     \ ud.* UDCell
70 :     \ r.* Float
71 :     \ a_.* Cell *
72 :     \ c_.* Char *
73 :     \ f_.* Float *
74 :     \ df_.* DFloat *
75 :     \ sf_.* SFloat *
76 :     \ xt.* XT
77 :     \ f83name.* F83Name *
78 :    
79 :     \E stack data-stack sp Cell
80 :     \E stack fp-stack fp Float
81 :     \E stack return-stack rp Cell
82 :     \E
83 :     \E get-current prefixes set-current
84 :     \E
85 :     \E s" Bool" single data-stack type-prefix f
86 :     \E s" Char" single data-stack type-prefix c
87 :     \E s" Cell" single data-stack type-prefix n
88 :     \E s" Cell" single data-stack type-prefix w
89 :     \E s" UCell" single data-stack type-prefix u
90 :     \E s" DCell" double data-stack type-prefix d
91 :     \E s" UDCell" double data-stack type-prefix ud
92 :     \E s" Float" single fp-stack type-prefix r
93 :     \E s" Cell *" single data-stack type-prefix a_
94 :     \E s" Char *" single data-stack type-prefix c_
95 :     \E s" Float *" single data-stack type-prefix f_
96 :     \E s" DFloat *" single data-stack type-prefix df_
97 :     \E s" SFloat *" single data-stack type-prefix sf_
98 :     \E s" Xt" single data-stack type-prefix xt
99 :     \E s" struct F83Name *" single data-stack type-prefix f83name
100 :     \E s" struct Longname *" single data-stack type-prefix longname
101 :     \E
102 :     \E return-stack stack-prefix R:
103 :     \E inst-stream stack-prefix #
104 :     \E
105 :     \E set-current
106 :     \E store-optimization on
107 :     \E ' noop tail-nextp2 ! \ now INST_TAIL just stores, but does not jump
108 :     \E
109 :     \E include-skipped-insts on \ static superinsts include cells for components
110 :     \E \ useful for dynamic programming and
111 :     \E \ superinsts across entry points
112 :    
113 :     \
114 :     \
115 :     \
116 :     \ In addition the following names can be used:
117 :     \ ip the instruction pointer
118 :     \ sp the data stack pointer
119 :     \ rp the parameter stack pointer
120 :     \ lp the locals stack pointer
121 :     \ NEXT executes NEXT
122 :     \ cfa
123 :     \ NEXT1 executes NEXT1
124 :     \ FLAG(x) makes a Forth flag from a C flag
125 :     \
126 :     \
127 :     \
128 :     \ Percentages in comments are from Koopmans book: average/maximum use
129 :     \ (taken from four, not very representative benchmarks)
130 :     \
131 :     \
132 :     \
133 :     \ To do:
134 :     \
135 :     \ throw execute, cfa and NEXT1 out?
136 :     \ macroize *ip, ip++, *ip++ (pipelining)?
137 :    
138 :     \ set up stack caching states
139 :    
140 : anton 1.4 \E register IPTOS Cell
141 : anton 1.2 \E register spTOS Cell
142 : anton 1.1 \E register sp1 Cell
143 :     \E register sp2 Cell
144 :     \E register sp3 Cell
145 :    
146 : anton 1.4 \E create IPregs IPTOS ,
147 :     \E create regs sp2 , sp1 , spTOS ,
148 : anton 1.1
149 : anton 1.4 \E IPregs 1 0 stack-state IPss1
150 : anton 1.7 \E regs 3 cells + 0 -1 stack-state ss0
151 : anton 1.5 \E regs 2 cells + 1 0 stack-state ss1
152 :     \E regs 1 cells + 2 1 stack-state ss2
153 :     \E regs 0 cells + 3 2 stack-state ss3
154 : anton 1.1
155 : anton 1.7 \ the first of these is the default state
156 :     \E state S1
157 : anton 1.1 \E state S0
158 :     \E state S2
159 :     \E state S3
160 :    
161 : anton 1.4 \E ss0 data-stack S0 set-ss
162 :     \E ss1 data-stack S1 set-ss
163 :     \E ss2 data-stack S2 set-ss
164 :     \E ss3 data-stack S3 set-ss
165 :    
166 :     \E IPss1 inst-stream S0 set-ss
167 :     \E IPss1 inst-stream S1 set-ss
168 :     \E IPss1 inst-stream S2 set-ss
169 :     \E IPss1 inst-stream S3 set-ss
170 : anton 1.2
171 : anton 1.5 \E data-stack to cache-stack
172 :     \E here 4 cache-states 2! s0 , s1 , s2 , s3 ,
173 :    
174 : anton 1.7 \E S1 to state-default
175 :     \E state-default to state-in
176 :     \E state-default to state-out
177 : anton 1.1
178 :     + ( n1 n2 -- n ) core plus
179 :     n = n1+n2;
180 :    
181 :     lit ( #w -- w ) gforth
182 :     :
183 :     r> dup @ swap cell+ >r ;
184 : anton 1.3
185 :     over ( n1 n2 -- n1 n2 n1 )
186 : anton 1.4
187 :     drop ( n -- )
188 : anton 1.5
189 : anton 1.6 ?branch ( #a_target f -- ) f83 question_branch
190 :     if (f==0) {
191 :     SET_IP((Xt *)a_target);
192 :     INST_TAIL; NEXT_P2;
193 :     }
194 :     SUPER_CONTINUE;
195 :    
196 :     noop ( -- )
197 :    
198 : anton 1.5 \E prim-states drop
199 :     \E prim-states over
200 : anton 1.6
201 : anton 1.7 \E branch-states ?branch
202 : anton 1.6
203 :     \E gen-transitions noop
204 :    
CVS Admin

Powered by ViewCVS 1.0-dev 		(Powered by ViewCVS)

ViewCVS and CVS Help