[gforth] / gforth / xxxprim  

gforth: gforth/xxxprim

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

Powered by ViewCVS 1.0-dev 		(Powered by ViewCVS)

ViewCVS and CVS Help