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 3
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, see http://www.gnu.org/licenses/.
19:
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: \E register IPTOS Cell
141: \E register spTOS Cell
142: \E register sp1 Cell
143: \E register sp2 Cell
144: \E register sp3 Cell
145:
146: \E create IPregs IPTOS ,
147: \E create regs sp2 , sp1 , spTOS ,
148:
149: \E IPregs 1 0 stack-state IPss1
150: \E regs 3 cells + 0 -1 stack-state ss0
151: \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:
155: \ the first of these is the default state
156: \E state S1
157: \E state S0
158: \E state S2
159: \E state S3
160:
161: \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:
171: \E data-stack to cache-stack
172: \E here 4 cache-states 2! s0 , s1 , s2 , s3 ,
173:
174: \E S1 to state-default
175: \E state-default to state-in
176: \E state-default to state-out
177:
178: + ( n1 n2 -- n ) core plus
179: n = n1+n2;
180:
181: lit ( #w -- w ) gforth
182: :
183: r> dup @ swap cell+ >r ;
184:
185: over ( n1 n2 -- n1 n2 n1 )
186:
187: drop ( n -- )
188:
189: ?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: \E prim-states drop
199: \E prim-states over
200:
201: \E branch-states ?branch
202:
203: \E gen-transitions noop
204:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>