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