1*0Sstevel@tonic-gate /*
2*0Sstevel@tonic-gate * CDDL HEADER START
3*0Sstevel@tonic-gate *
4*0Sstevel@tonic-gate * The contents of this file are subject to the terms of the
5*0Sstevel@tonic-gate * Common Development and Distribution License, Version 1.0 only
6*0Sstevel@tonic-gate * (the "License"). You may not use this file except in compliance
7*0Sstevel@tonic-gate * with the License.
8*0Sstevel@tonic-gate *
9*0Sstevel@tonic-gate * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE
10*0Sstevel@tonic-gate * or http://www.opensolaris.org/os/licensing.
11*0Sstevel@tonic-gate * See the License for the specific language governing permissions
12*0Sstevel@tonic-gate * and limitations under the License.
13*0Sstevel@tonic-gate *
14*0Sstevel@tonic-gate * When distributing Covered Code, include this CDDL HEADER in each
15*0Sstevel@tonic-gate * file and include the License file at usr/src/OPENSOLARIS.LICENSE.
16*0Sstevel@tonic-gate * If applicable, add the following below this CDDL HEADER, with the
17*0Sstevel@tonic-gate * fields enclosed by brackets "[]" replaced with your own identifying
18*0Sstevel@tonic-gate * information: Portions Copyright [yyyy] [name of copyright owner]
19*0Sstevel@tonic-gate *
20*0Sstevel@tonic-gate * CDDL HEADER END
21*0Sstevel@tonic-gate */
22*0Sstevel@tonic-gate /*
23*0Sstevel@tonic-gate * Copyright (c) 2000 by Sun Microsystems, Inc.
24*0Sstevel@tonic-gate * All rights reserved.
25*0Sstevel@tonic-gate */
26*0Sstevel@tonic-gate
27*0Sstevel@tonic-gate #pragma ident "%Z%%M% %I% %E% SMI"
28*0Sstevel@tonic-gate
29*0Sstevel@tonic-gate #include <stdio.h>
30*0Sstevel@tonic-gate #include <stdlib.h>
31*0Sstevel@tonic-gate #include <string.h>
32*0Sstevel@tonic-gate #include <fcode/private.h>
33*0Sstevel@tonic-gate #include <fcdriver/fcdriver.h>
34*0Sstevel@tonic-gate
35*0Sstevel@tonic-gate #define LF_PER_XF (sizeof (xforth_t)/sizeof (lforth_t))
36*0Sstevel@tonic-gate #define WF_PER_XF (sizeof (xforth_t)/sizeof (wforth_t))
37*0Sstevel@tonic-gate
38*0Sstevel@tonic-gate void unaligned_xfetch(fcode_env_t *);
39*0Sstevel@tonic-gate void unaligned_xstore(fcode_env_t *);
40*0Sstevel@tonic-gate static void xbsplit(fcode_env_t *);
41*0Sstevel@tonic-gate
42*0Sstevel@tonic-gate xforth_t
pop_xforth(fcode_env_t * env)43*0Sstevel@tonic-gate pop_xforth(fcode_env_t *env)
44*0Sstevel@tonic-gate {
45*0Sstevel@tonic-gate if (sizeof (xforth_t) == sizeof (fstack_t))
46*0Sstevel@tonic-gate return (POP(DS));
47*0Sstevel@tonic-gate return ((xforth_t)pop_double(env));
48*0Sstevel@tonic-gate }
49*0Sstevel@tonic-gate
50*0Sstevel@tonic-gate xforth_t
peek_xforth(fcode_env_t * env)51*0Sstevel@tonic-gate peek_xforth(fcode_env_t *env)
52*0Sstevel@tonic-gate {
53*0Sstevel@tonic-gate xforth_t d;
54*0Sstevel@tonic-gate
55*0Sstevel@tonic-gate d = pop_xforth(env);
56*0Sstevel@tonic-gate push_xforth(env, d);
57*0Sstevel@tonic-gate return (d);
58*0Sstevel@tonic-gate }
59*0Sstevel@tonic-gate
60*0Sstevel@tonic-gate void
push_xforth(fcode_env_t * env,xforth_t a)61*0Sstevel@tonic-gate push_xforth(fcode_env_t *env, xforth_t a)
62*0Sstevel@tonic-gate {
63*0Sstevel@tonic-gate if (sizeof (xforth_t) == sizeof (fstack_t))
64*0Sstevel@tonic-gate PUSH(DS, a);
65*0Sstevel@tonic-gate else
66*0Sstevel@tonic-gate push_double(env, (dforth_t)a);
67*0Sstevel@tonic-gate }
68*0Sstevel@tonic-gate
69*0Sstevel@tonic-gate /*
70*0Sstevel@tonic-gate * bxjoin ( b.lo b.2 b.3 b.4 b.5 b.6 b.7 b.hi -- o )
71*0Sstevel@tonic-gate */
72*0Sstevel@tonic-gate static void
bxjoin(fcode_env_t * env)73*0Sstevel@tonic-gate bxjoin(fcode_env_t *env)
74*0Sstevel@tonic-gate {
75*0Sstevel@tonic-gate union {
76*0Sstevel@tonic-gate uchar_t b_bytes[sizeof (xforth_t)];
77*0Sstevel@tonic-gate xforth_t b_xf;
78*0Sstevel@tonic-gate } b;
79*0Sstevel@tonic-gate int i;
80*0Sstevel@tonic-gate
81*0Sstevel@tonic-gate CHECK_DEPTH(env, sizeof (xforth_t), "bxjoin");
82*0Sstevel@tonic-gate for (i = 0; i < sizeof (xforth_t); i++)
83*0Sstevel@tonic-gate b.b_bytes[i] = POP(DS);
84*0Sstevel@tonic-gate push_xforth(env, b.b_xf);
85*0Sstevel@tonic-gate }
86*0Sstevel@tonic-gate
87*0Sstevel@tonic-gate /*
88*0Sstevel@tonic-gate * <l@ ( qaddr -- n )
89*0Sstevel@tonic-gate */
90*0Sstevel@tonic-gate static void
lsfetch(fcode_env_t * env)91*0Sstevel@tonic-gate lsfetch(fcode_env_t *env)
92*0Sstevel@tonic-gate {
93*0Sstevel@tonic-gate s_lforth_t *addr;
94*0Sstevel@tonic-gate xforth_t a;
95*0Sstevel@tonic-gate
96*0Sstevel@tonic-gate CHECK_DEPTH(env, 1, "<l@");
97*0Sstevel@tonic-gate addr = (s_lforth_t *)POP(DS);
98*0Sstevel@tonic-gate a = *addr;
99*0Sstevel@tonic-gate push_xforth(env, a);
100*0Sstevel@tonic-gate }
101*0Sstevel@tonic-gate
102*0Sstevel@tonic-gate /*
103*0Sstevel@tonic-gate * lxjoin ( quad.lo quad.hi -- o )
104*0Sstevel@tonic-gate */
105*0Sstevel@tonic-gate static void
lxjoin(fcode_env_t * env)106*0Sstevel@tonic-gate lxjoin(fcode_env_t *env)
107*0Sstevel@tonic-gate {
108*0Sstevel@tonic-gate union {
109*0Sstevel@tonic-gate lforth_t b_lf[LF_PER_XF];
110*0Sstevel@tonic-gate xforth_t b_xf;
111*0Sstevel@tonic-gate } b;
112*0Sstevel@tonic-gate int i;
113*0Sstevel@tonic-gate
114*0Sstevel@tonic-gate CHECK_DEPTH(env, LF_PER_XF, "lxjoin");
115*0Sstevel@tonic-gate for (i = 0; i < LF_PER_XF; i++)
116*0Sstevel@tonic-gate b.b_lf[i] = POP(DS);
117*0Sstevel@tonic-gate push_xforth(env, b.b_xf);
118*0Sstevel@tonic-gate }
119*0Sstevel@tonic-gate
120*0Sstevel@tonic-gate /*
121*0Sstevel@tonic-gate * wxjoin ( w.lo w.2 w.3 w.hi -- o )
122*0Sstevel@tonic-gate */
123*0Sstevel@tonic-gate static void
wxjoin(fcode_env_t * env)124*0Sstevel@tonic-gate wxjoin(fcode_env_t *env)
125*0Sstevel@tonic-gate {
126*0Sstevel@tonic-gate union {
127*0Sstevel@tonic-gate wforth_t b_wf[WF_PER_XF];
128*0Sstevel@tonic-gate xforth_t b_xf;
129*0Sstevel@tonic-gate } b;
130*0Sstevel@tonic-gate int i;
131*0Sstevel@tonic-gate
132*0Sstevel@tonic-gate CHECK_DEPTH(env, WF_PER_XF, "wxjoin");
133*0Sstevel@tonic-gate for (i = 0; i < WF_PER_XF; i++)
134*0Sstevel@tonic-gate b.b_wf[i] = POP(DS);
135*0Sstevel@tonic-gate push_xforth(env, b.b_xf);
136*0Sstevel@tonic-gate }
137*0Sstevel@tonic-gate
138*0Sstevel@tonic-gate /*
139*0Sstevel@tonic-gate * x, ( o -- )
140*0Sstevel@tonic-gate */
141*0Sstevel@tonic-gate static void
xcomma(fcode_env_t * env)142*0Sstevel@tonic-gate xcomma(fcode_env_t *env)
143*0Sstevel@tonic-gate {
144*0Sstevel@tonic-gate CHECK_DEPTH(env, 1, "x,");
145*0Sstevel@tonic-gate DEBUGF(COMMA, dump_comma(env, "x,"));
146*0Sstevel@tonic-gate PUSH(DS, (fstack_t)HERE);
147*0Sstevel@tonic-gate unaligned_xstore(env);
148*0Sstevel@tonic-gate set_here(env, HERE + sizeof (xforth_t), "xcomma");
149*0Sstevel@tonic-gate }
150*0Sstevel@tonic-gate
151*0Sstevel@tonic-gate /*
152*0Sstevel@tonic-gate * x@ ( xaddr -- o )
153*0Sstevel@tonic-gate */
154*0Sstevel@tonic-gate void
xfetch(fcode_env_t * env)155*0Sstevel@tonic-gate xfetch(fcode_env_t *env)
156*0Sstevel@tonic-gate {
157*0Sstevel@tonic-gate xforth_t *addr;
158*0Sstevel@tonic-gate xforth_t a;
159*0Sstevel@tonic-gate
160*0Sstevel@tonic-gate CHECK_DEPTH(env, 1, "x@");
161*0Sstevel@tonic-gate addr = (xforth_t *)POP(DS);
162*0Sstevel@tonic-gate a = *addr;
163*0Sstevel@tonic-gate push_xforth(env, a);
164*0Sstevel@tonic-gate }
165*0Sstevel@tonic-gate
166*0Sstevel@tonic-gate /*
167*0Sstevel@tonic-gate * x! ( o xaddr -- )
168*0Sstevel@tonic-gate */
169*0Sstevel@tonic-gate void
xstore(fcode_env_t * env)170*0Sstevel@tonic-gate xstore(fcode_env_t *env)
171*0Sstevel@tonic-gate {
172*0Sstevel@tonic-gate xforth_t *addr;
173*0Sstevel@tonic-gate xforth_t a;
174*0Sstevel@tonic-gate
175*0Sstevel@tonic-gate CHECK_DEPTH(env, 2, "x!");
176*0Sstevel@tonic-gate addr = (xforth_t *)POP(DS);
177*0Sstevel@tonic-gate a = pop_xforth(env);
178*0Sstevel@tonic-gate *addr = a;
179*0Sstevel@tonic-gate }
180*0Sstevel@tonic-gate
181*0Sstevel@tonic-gate /*
182*0Sstevel@tonic-gate * /x ( -- n )
183*0Sstevel@tonic-gate */
184*0Sstevel@tonic-gate static void
slash_x(fcode_env_t * env)185*0Sstevel@tonic-gate slash_x(fcode_env_t *env)
186*0Sstevel@tonic-gate {
187*0Sstevel@tonic-gate PUSH(DS, sizeof (xforth_t));
188*0Sstevel@tonic-gate }
189*0Sstevel@tonic-gate
190*0Sstevel@tonic-gate /*
191*0Sstevel@tonic-gate * /x* ( nu1 -- nu2 )
192*0Sstevel@tonic-gate */
193*0Sstevel@tonic-gate static void
slash_x_times(fcode_env_t * env)194*0Sstevel@tonic-gate slash_x_times(fcode_env_t *env)
195*0Sstevel@tonic-gate {
196*0Sstevel@tonic-gate CHECK_DEPTH(env, 1, "/x*");
197*0Sstevel@tonic-gate TOS *= sizeof (xforth_t);
198*0Sstevel@tonic-gate }
199*0Sstevel@tonic-gate
200*0Sstevel@tonic-gate /*
201*0Sstevel@tonic-gate * xa+ ( addr1 index -- addr2 )
202*0Sstevel@tonic-gate */
203*0Sstevel@tonic-gate static void
xa_plus(fcode_env_t * env)204*0Sstevel@tonic-gate xa_plus(fcode_env_t *env)
205*0Sstevel@tonic-gate {
206*0Sstevel@tonic-gate fstack_t index;
207*0Sstevel@tonic-gate
208*0Sstevel@tonic-gate CHECK_DEPTH(env, 2, "xa+");
209*0Sstevel@tonic-gate index = POP(DS);
210*0Sstevel@tonic-gate TOS += index * sizeof (xforth_t);
211*0Sstevel@tonic-gate }
212*0Sstevel@tonic-gate
213*0Sstevel@tonic-gate /*
214*0Sstevel@tonic-gate * xa1+ ( addr1 -- addr2 )
215*0Sstevel@tonic-gate */
216*0Sstevel@tonic-gate static void
xa_one_plus(fcode_env_t * env)217*0Sstevel@tonic-gate xa_one_plus(fcode_env_t *env)
218*0Sstevel@tonic-gate {
219*0Sstevel@tonic-gate CHECK_DEPTH(env, 1, "xa1+");
220*0Sstevel@tonic-gate TOS += sizeof (xforth_t);
221*0Sstevel@tonic-gate }
222*0Sstevel@tonic-gate
223*0Sstevel@tonic-gate /*
224*0Sstevel@tonic-gate * xbflip ( oct1 -- oct2 )
225*0Sstevel@tonic-gate */
226*0Sstevel@tonic-gate void
xbflip(fcode_env_t * env)227*0Sstevel@tonic-gate xbflip(fcode_env_t *env)
228*0Sstevel@tonic-gate {
229*0Sstevel@tonic-gate union {
230*0Sstevel@tonic-gate uchar_t b_bytes[sizeof (xforth_t)];
231*0Sstevel@tonic-gate xforth_t b_xf;
232*0Sstevel@tonic-gate } b, c;
233*0Sstevel@tonic-gate int i;
234*0Sstevel@tonic-gate
235*0Sstevel@tonic-gate CHECK_DEPTH(env, 1, "xbflip");
236*0Sstevel@tonic-gate b.b_xf = pop_xforth(env);
237*0Sstevel@tonic-gate for (i = 0; i < sizeof (xforth_t); i++)
238*0Sstevel@tonic-gate c.b_bytes[i] = b.b_bytes[(sizeof (xforth_t) - 1) - i];
239*0Sstevel@tonic-gate push_xforth(env, c.b_xf);
240*0Sstevel@tonic-gate }
241*0Sstevel@tonic-gate
242*0Sstevel@tonic-gate void
unaligned_xfetch(fcode_env_t * env)243*0Sstevel@tonic-gate unaligned_xfetch(fcode_env_t *env)
244*0Sstevel@tonic-gate {
245*0Sstevel@tonic-gate fstack_t addr;
246*0Sstevel@tonic-gate int i;
247*0Sstevel@tonic-gate
248*0Sstevel@tonic-gate CHECK_DEPTH(env, 1, "unaligned-x@");
249*0Sstevel@tonic-gate addr = POP(DS);
250*0Sstevel@tonic-gate for (i = 0; i < sizeof (xforth_t); i++, addr++) {
251*0Sstevel@tonic-gate PUSH(DS, addr);
252*0Sstevel@tonic-gate cfetch(env);
253*0Sstevel@tonic-gate }
254*0Sstevel@tonic-gate bxjoin(env);
255*0Sstevel@tonic-gate xbflip(env);
256*0Sstevel@tonic-gate }
257*0Sstevel@tonic-gate
258*0Sstevel@tonic-gate void
unaligned_xstore(fcode_env_t * env)259*0Sstevel@tonic-gate unaligned_xstore(fcode_env_t *env)
260*0Sstevel@tonic-gate {
261*0Sstevel@tonic-gate fstack_t addr;
262*0Sstevel@tonic-gate int i;
263*0Sstevel@tonic-gate
264*0Sstevel@tonic-gate CHECK_DEPTH(env, 2, "unaligned-x!");
265*0Sstevel@tonic-gate addr = POP(DS);
266*0Sstevel@tonic-gate xbsplit(env);
267*0Sstevel@tonic-gate for (i = 0; i < sizeof (xforth_t); i++, addr++) {
268*0Sstevel@tonic-gate PUSH(DS, addr);
269*0Sstevel@tonic-gate cstore(env);
270*0Sstevel@tonic-gate }
271*0Sstevel@tonic-gate }
272*0Sstevel@tonic-gate
273*0Sstevel@tonic-gate /*
274*0Sstevel@tonic-gate * xbflips ( xaddr len -- )
275*0Sstevel@tonic-gate */
276*0Sstevel@tonic-gate static void
xbflips(fcode_env_t * env)277*0Sstevel@tonic-gate xbflips(fcode_env_t *env)
278*0Sstevel@tonic-gate {
279*0Sstevel@tonic-gate fstack_t len, addr;
280*0Sstevel@tonic-gate int i;
281*0Sstevel@tonic-gate
282*0Sstevel@tonic-gate CHECK_DEPTH(env, 2, "xbflips");
283*0Sstevel@tonic-gate len = POP(DS);
284*0Sstevel@tonic-gate addr = POP(DS);
285*0Sstevel@tonic-gate for (i = 0; i < len; i += sizeof (xforth_t),
286*0Sstevel@tonic-gate addr += sizeof (xforth_t)) {
287*0Sstevel@tonic-gate PUSH(DS, addr);
288*0Sstevel@tonic-gate unaligned_xfetch(env);
289*0Sstevel@tonic-gate xbflip(env);
290*0Sstevel@tonic-gate PUSH(DS, addr);
291*0Sstevel@tonic-gate unaligned_xstore(env);
292*0Sstevel@tonic-gate }
293*0Sstevel@tonic-gate }
294*0Sstevel@tonic-gate
295*0Sstevel@tonic-gate /*
296*0Sstevel@tonic-gate * xbsplit ( o -- b.lo b.2 b.3 b.4 b.5 b.6 b.7 b.hi )
297*0Sstevel@tonic-gate */
298*0Sstevel@tonic-gate static void
xbsplit(fcode_env_t * env)299*0Sstevel@tonic-gate xbsplit(fcode_env_t *env)
300*0Sstevel@tonic-gate {
301*0Sstevel@tonic-gate union {
302*0Sstevel@tonic-gate uchar_t b_bytes[sizeof (xforth_t)];
303*0Sstevel@tonic-gate xforth_t b_xf;
304*0Sstevel@tonic-gate } b;
305*0Sstevel@tonic-gate int i;
306*0Sstevel@tonic-gate
307*0Sstevel@tonic-gate CHECK_DEPTH(env, 1, "xbsplit");
308*0Sstevel@tonic-gate b.b_xf = pop_xforth(env);
309*0Sstevel@tonic-gate for (i = 0; i < sizeof (xforth_t); i++)
310*0Sstevel@tonic-gate PUSH(DS, b.b_bytes[(sizeof (xforth_t) - 1) - i]);
311*0Sstevel@tonic-gate }
312*0Sstevel@tonic-gate
313*0Sstevel@tonic-gate /*
314*0Sstevel@tonic-gate * xlflip ( oct1 -- oct2 )
315*0Sstevel@tonic-gate */
316*0Sstevel@tonic-gate void
xlflip(fcode_env_t * env)317*0Sstevel@tonic-gate xlflip(fcode_env_t *env)
318*0Sstevel@tonic-gate {
319*0Sstevel@tonic-gate union {
320*0Sstevel@tonic-gate lforth_t b_lf[LF_PER_XF];
321*0Sstevel@tonic-gate xforth_t b_xf;
322*0Sstevel@tonic-gate } b, c;
323*0Sstevel@tonic-gate int i;
324*0Sstevel@tonic-gate
325*0Sstevel@tonic-gate CHECK_DEPTH(env, 1, "xlflip");
326*0Sstevel@tonic-gate b.b_xf = pop_xforth(env);
327*0Sstevel@tonic-gate for (i = 0; i < LF_PER_XF; i++)
328*0Sstevel@tonic-gate c.b_lf[i] = b.b_lf[(LF_PER_XF - 1) - i];
329*0Sstevel@tonic-gate push_xforth(env, c.b_xf);
330*0Sstevel@tonic-gate }
331*0Sstevel@tonic-gate
332*0Sstevel@tonic-gate /*
333*0Sstevel@tonic-gate * xlflips ( xaddr len -- )
334*0Sstevel@tonic-gate */
335*0Sstevel@tonic-gate static void
xlflips(fcode_env_t * env)336*0Sstevel@tonic-gate xlflips(fcode_env_t *env)
337*0Sstevel@tonic-gate {
338*0Sstevel@tonic-gate fstack_t len, addr;
339*0Sstevel@tonic-gate int i;
340*0Sstevel@tonic-gate
341*0Sstevel@tonic-gate CHECK_DEPTH(env, 2, "xlflips");
342*0Sstevel@tonic-gate len = POP(DS);
343*0Sstevel@tonic-gate addr = POP(DS);
344*0Sstevel@tonic-gate for (i = 0; i < len; i += sizeof (xforth_t),
345*0Sstevel@tonic-gate addr += sizeof (xforth_t)) {
346*0Sstevel@tonic-gate PUSH(DS, addr);
347*0Sstevel@tonic-gate unaligned_xfetch(env);
348*0Sstevel@tonic-gate xlflip(env);
349*0Sstevel@tonic-gate PUSH(DS, addr);
350*0Sstevel@tonic-gate unaligned_xstore(env);
351*0Sstevel@tonic-gate }
352*0Sstevel@tonic-gate }
353*0Sstevel@tonic-gate
354*0Sstevel@tonic-gate /*
355*0Sstevel@tonic-gate * xlsplit ( o -- quad.lo quad.hi )
356*0Sstevel@tonic-gate */
357*0Sstevel@tonic-gate static void
xlsplit(fcode_env_t * env)358*0Sstevel@tonic-gate xlsplit(fcode_env_t *env)
359*0Sstevel@tonic-gate {
360*0Sstevel@tonic-gate union {
361*0Sstevel@tonic-gate lforth_t b_lf[LF_PER_XF];
362*0Sstevel@tonic-gate xforth_t b_xf;
363*0Sstevel@tonic-gate } b;
364*0Sstevel@tonic-gate int i;
365*0Sstevel@tonic-gate
366*0Sstevel@tonic-gate CHECK_DEPTH(env, 1, "xlsplit");
367*0Sstevel@tonic-gate b.b_xf = pop_xforth(env);
368*0Sstevel@tonic-gate for (i = 0; i < LF_PER_XF; i++)
369*0Sstevel@tonic-gate PUSH(DS, b.b_lf[(LF_PER_XF - 1) - i]);
370*0Sstevel@tonic-gate }
371*0Sstevel@tonic-gate
372*0Sstevel@tonic-gate
373*0Sstevel@tonic-gate /*
374*0Sstevel@tonic-gate * xwflip ( oct1 -- oct2 )
375*0Sstevel@tonic-gate */
376*0Sstevel@tonic-gate static void
xwflip(fcode_env_t * env)377*0Sstevel@tonic-gate xwflip(fcode_env_t *env)
378*0Sstevel@tonic-gate {
379*0Sstevel@tonic-gate union {
380*0Sstevel@tonic-gate wforth_t b_wf[WF_PER_XF];
381*0Sstevel@tonic-gate xforth_t b_xf;
382*0Sstevel@tonic-gate } b, c;
383*0Sstevel@tonic-gate int i;
384*0Sstevel@tonic-gate
385*0Sstevel@tonic-gate CHECK_DEPTH(env, 1, "xwflip");
386*0Sstevel@tonic-gate b.b_xf = pop_xforth(env);
387*0Sstevel@tonic-gate for (i = 0; i < WF_PER_XF; i++)
388*0Sstevel@tonic-gate c.b_wf[i] = b.b_wf[(WF_PER_XF - 1) - i];
389*0Sstevel@tonic-gate push_xforth(env, c.b_xf);
390*0Sstevel@tonic-gate }
391*0Sstevel@tonic-gate
392*0Sstevel@tonic-gate /*
393*0Sstevel@tonic-gate * xwflips ( xaddr len -- )
394*0Sstevel@tonic-gate */
395*0Sstevel@tonic-gate static void
xwflips(fcode_env_t * env)396*0Sstevel@tonic-gate xwflips(fcode_env_t *env)
397*0Sstevel@tonic-gate {
398*0Sstevel@tonic-gate fstack_t len, addr;
399*0Sstevel@tonic-gate int i;
400*0Sstevel@tonic-gate
401*0Sstevel@tonic-gate CHECK_DEPTH(env, 2, "xwflips");
402*0Sstevel@tonic-gate len = POP(DS);
403*0Sstevel@tonic-gate addr = POP(DS);
404*0Sstevel@tonic-gate for (i = 0; i < len; i += sizeof (xforth_t),
405*0Sstevel@tonic-gate addr += sizeof (xforth_t)) {
406*0Sstevel@tonic-gate PUSH(DS, addr);
407*0Sstevel@tonic-gate unaligned_xfetch(env);
408*0Sstevel@tonic-gate xwflip(env);
409*0Sstevel@tonic-gate PUSH(DS, addr);
410*0Sstevel@tonic-gate unaligned_xstore(env);
411*0Sstevel@tonic-gate }
412*0Sstevel@tonic-gate }
413*0Sstevel@tonic-gate
414*0Sstevel@tonic-gate /*
415*0Sstevel@tonic-gate * xwsplit ( o -- w.lo w.2 w.3 w.hi )
416*0Sstevel@tonic-gate */
417*0Sstevel@tonic-gate static void
xwsplit(fcode_env_t * env)418*0Sstevel@tonic-gate xwsplit(fcode_env_t *env)
419*0Sstevel@tonic-gate {
420*0Sstevel@tonic-gate union {
421*0Sstevel@tonic-gate wforth_t b_wf[WF_PER_XF];
422*0Sstevel@tonic-gate xforth_t b_xf;
423*0Sstevel@tonic-gate } b;
424*0Sstevel@tonic-gate int i;
425*0Sstevel@tonic-gate
426*0Sstevel@tonic-gate CHECK_DEPTH(env, 1, "xwsplit");
427*0Sstevel@tonic-gate b.b_xf = pop_xforth(env);
428*0Sstevel@tonic-gate for (i = 0; i < WF_PER_XF; i++)
429*0Sstevel@tonic-gate PUSH(DS, b.b_wf[(WF_PER_XF - 1) - i]);
430*0Sstevel@tonic-gate }
431*0Sstevel@tonic-gate
432*0Sstevel@tonic-gate #pragma init(_init)
433*0Sstevel@tonic-gate
434*0Sstevel@tonic-gate static void
_init(void)435*0Sstevel@tonic-gate _init(void)
436*0Sstevel@tonic-gate {
437*0Sstevel@tonic-gate fcode_env_t *env = initial_env;
438*0Sstevel@tonic-gate
439*0Sstevel@tonic-gate ASSERT(env);
440*0Sstevel@tonic-gate NOTICE;
441*0Sstevel@tonic-gate P1275(0x241, 0, "bxjoin", bxjoin);
442*0Sstevel@tonic-gate P1275(0x242, 0, "<l@", lsfetch);
443*0Sstevel@tonic-gate P1275(0x243, 0, "lxjoin", lxjoin);
444*0Sstevel@tonic-gate P1275(0x244, 0, "wxjoin", wxjoin);
445*0Sstevel@tonic-gate P1275(0x245, 0, "x,", xcomma);
446*0Sstevel@tonic-gate P1275(0x246, 0, "x@", xfetch);
447*0Sstevel@tonic-gate P1275(0x247, 0, "x!", xstore);
448*0Sstevel@tonic-gate P1275(0x248, 0, "/x", slash_x);
449*0Sstevel@tonic-gate P1275(0x249, 0, "/x*", slash_x_times);
450*0Sstevel@tonic-gate P1275(0x24a, 0, "xa+", xa_plus);
451*0Sstevel@tonic-gate P1275(0x24b, 0, "xa1+", xa_one_plus);
452*0Sstevel@tonic-gate P1275(0x24c, 0, "xbflip", xbflip);
453*0Sstevel@tonic-gate P1275(0x24d, 0, "xbflips", xbflips);
454*0Sstevel@tonic-gate P1275(0x24e, 0, "xbsplit", xbsplit);
455*0Sstevel@tonic-gate P1275(0x24f, 0, "xlflip", xlflip);
456*0Sstevel@tonic-gate P1275(0x250, 0, "xlflips", xlflips);
457*0Sstevel@tonic-gate P1275(0x251, 0, "xlsplit", xlsplit);
458*0Sstevel@tonic-gate P1275(0x252, 0, "xwflip", xwflip);
459*0Sstevel@tonic-gate P1275(0x253, 0, "xwflips", xwflips);
460*0Sstevel@tonic-gate P1275(0x254, 0, "xwsplit", xwsplit);
461*0Sstevel@tonic-gate
462*0Sstevel@tonic-gate FORTH(0, "unaligned-x@", unaligned_xfetch);
463*0Sstevel@tonic-gate FORTH(0, "unaligned-x!", unaligned_xstore);
464*0Sstevel@tonic-gate }
465