xref: /titanic_41/usr/src/lib/efcode/engine/prims64.c (revision 7c478bd95313f5f23a4c958a745db2134aa03244)
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