xref: /illumos-gate/usr/src/lib/efcode/engine/forth.c (revision 09e6639b)
17c478bd9Sstevel@tonic-gate /*
27c478bd9Sstevel@tonic-gate  * CDDL HEADER START
37c478bd9Sstevel@tonic-gate  *
47c478bd9Sstevel@tonic-gate  * The contents of this file are subject to the terms of the
53aa1cd26Sgovinda  * Common Development and Distribution License (the "License").
63aa1cd26Sgovinda  * You may not use this file except in compliance with the License.
77c478bd9Sstevel@tonic-gate  *
87c478bd9Sstevel@tonic-gate  * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE
97c478bd9Sstevel@tonic-gate  * or http://www.opensolaris.org/os/licensing.
107c478bd9Sstevel@tonic-gate  * See the License for the specific language governing permissions
117c478bd9Sstevel@tonic-gate  * and limitations under the License.
127c478bd9Sstevel@tonic-gate  *
137c478bd9Sstevel@tonic-gate  * When distributing Covered Code, include this CDDL HEADER in each
147c478bd9Sstevel@tonic-gate  * file and include the License file at usr/src/OPENSOLARIS.LICENSE.
157c478bd9Sstevel@tonic-gate  * If applicable, add the following below this CDDL HEADER, with the
167c478bd9Sstevel@tonic-gate  * fields enclosed by brackets "[]" replaced with your own identifying
177c478bd9Sstevel@tonic-gate  * information: Portions Copyright [yyyy] [name of copyright owner]
187c478bd9Sstevel@tonic-gate  *
197c478bd9Sstevel@tonic-gate  * CDDL HEADER END
207c478bd9Sstevel@tonic-gate  */
217c478bd9Sstevel@tonic-gate /*
223aa1cd26Sgovinda  * Copyright 2007 Sun Microsystems, Inc.  All rights reserved.
233aa1cd26Sgovinda  * Use is subject to license terms.
247c478bd9Sstevel@tonic-gate  */
257c478bd9Sstevel@tonic-gate 
267c478bd9Sstevel@tonic-gate #include <stdio.h>
277c478bd9Sstevel@tonic-gate #include <stdlib.h>
287c478bd9Sstevel@tonic-gate #include <string.h>
297c478bd9Sstevel@tonic-gate #include <stdarg.h>
307c478bd9Sstevel@tonic-gate #include <ctype.h>
317c478bd9Sstevel@tonic-gate 
327c478bd9Sstevel@tonic-gate #include <fcode/private.h>
337c478bd9Sstevel@tonic-gate #include <fcode/log.h>
347c478bd9Sstevel@tonic-gate 
357c478bd9Sstevel@tonic-gate void (*semi_ptr)(fcode_env_t *env) = do_semi;
367c478bd9Sstevel@tonic-gate void (*does_ptr)(fcode_env_t *env) = install_does;
377c478bd9Sstevel@tonic-gate void (*quote_ptr)(fcode_env_t *env) = do_quote;
387c478bd9Sstevel@tonic-gate void (*blit_ptr)(fcode_env_t *env) = do_literal;
397c478bd9Sstevel@tonic-gate void (*tlit_ptr)(fcode_env_t *env) = do_literal;
407c478bd9Sstevel@tonic-gate void (*do_bdo_ptr)(fcode_env_t *env) = do_bdo;
417c478bd9Sstevel@tonic-gate void (*do_bqdo_ptr)(fcode_env_t *env) = do_bqdo;
427c478bd9Sstevel@tonic-gate void (*create_ptr)(fcode_env_t *env) = do_creator;
437c478bd9Sstevel@tonic-gate void (*do_leave_ptr)(fcode_env_t *env) = do_bleave;
447c478bd9Sstevel@tonic-gate void (*do_loop_ptr)(fcode_env_t *env) = do_bloop;
457c478bd9Sstevel@tonic-gate void (*do_ploop_ptr)(fcode_env_t *env) = do_bploop;
467c478bd9Sstevel@tonic-gate 
477c478bd9Sstevel@tonic-gate void unaligned_lstore(fcode_env_t *);
487c478bd9Sstevel@tonic-gate void unaligned_wstore(fcode_env_t *);
497c478bd9Sstevel@tonic-gate void unaligned_lfetch(fcode_env_t *);
507c478bd9Sstevel@tonic-gate void unaligned_wfetch(fcode_env_t *);
517c478bd9Sstevel@tonic-gate 
527c478bd9Sstevel@tonic-gate /* start with the simple maths functions */
537c478bd9Sstevel@tonic-gate 
547c478bd9Sstevel@tonic-gate 
557c478bd9Sstevel@tonic-gate void
add(fcode_env_t * env)567c478bd9Sstevel@tonic-gate add(fcode_env_t *env)
577c478bd9Sstevel@tonic-gate {
587c478bd9Sstevel@tonic-gate 	fstack_t d;
597c478bd9Sstevel@tonic-gate 
607c478bd9Sstevel@tonic-gate 	CHECK_DEPTH(env, 2, "+");
617c478bd9Sstevel@tonic-gate 	d = POP(DS);
627c478bd9Sstevel@tonic-gate 	TOS += d;
637c478bd9Sstevel@tonic-gate }
647c478bd9Sstevel@tonic-gate 
657c478bd9Sstevel@tonic-gate void
subtract(fcode_env_t * env)667c478bd9Sstevel@tonic-gate subtract(fcode_env_t *env)
677c478bd9Sstevel@tonic-gate {
687c478bd9Sstevel@tonic-gate 	fstack_t d;
697c478bd9Sstevel@tonic-gate 
707c478bd9Sstevel@tonic-gate 	CHECK_DEPTH(env, 2, "-");
717c478bd9Sstevel@tonic-gate 	d = POP(DS);
727c478bd9Sstevel@tonic-gate 	TOS -= d;
737c478bd9Sstevel@tonic-gate }
747c478bd9Sstevel@tonic-gate 
757c478bd9Sstevel@tonic-gate void
multiply(fcode_env_t * env)767c478bd9Sstevel@tonic-gate multiply(fcode_env_t *env)
777c478bd9Sstevel@tonic-gate {
787c478bd9Sstevel@tonic-gate 	fstack_t d;
797c478bd9Sstevel@tonic-gate 
807c478bd9Sstevel@tonic-gate 	CHECK_DEPTH(env, 2, "*");
817c478bd9Sstevel@tonic-gate 	d = POP(DS);
827c478bd9Sstevel@tonic-gate 	TOS *= d;
837c478bd9Sstevel@tonic-gate }
847c478bd9Sstevel@tonic-gate 
857c478bd9Sstevel@tonic-gate void
slash_mod(fcode_env_t * env)867c478bd9Sstevel@tonic-gate slash_mod(fcode_env_t *env)
877c478bd9Sstevel@tonic-gate {
887c478bd9Sstevel@tonic-gate 	fstack_t d, o, t, rem;
897c478bd9Sstevel@tonic-gate 	int sign = 1;
907c478bd9Sstevel@tonic-gate 
917c478bd9Sstevel@tonic-gate 	CHECK_DEPTH(env, 2, "/mod");
927c478bd9Sstevel@tonic-gate 	d = POP(DS);
937c478bd9Sstevel@tonic-gate 	o = t = POP(DS);
947c478bd9Sstevel@tonic-gate 
957c478bd9Sstevel@tonic-gate 	if (d == 0) {
967c478bd9Sstevel@tonic-gate 		throw_from_fclib(env, 1, "/mod divide by zero");
977c478bd9Sstevel@tonic-gate 	}
987c478bd9Sstevel@tonic-gate 	sign = ((d ^ t) < 0);
997c478bd9Sstevel@tonic-gate 	if (d < 0) {
1007c478bd9Sstevel@tonic-gate 		d = -d;
1017c478bd9Sstevel@tonic-gate 		if (sign) {
1027c478bd9Sstevel@tonic-gate 			t += (d-1);
1037c478bd9Sstevel@tonic-gate 		}
1047c478bd9Sstevel@tonic-gate 	}
1057c478bd9Sstevel@tonic-gate 	if (t < 0) {
1067c478bd9Sstevel@tonic-gate 		if (sign) {
1077c478bd9Sstevel@tonic-gate 			t -= (d-1);
1087c478bd9Sstevel@tonic-gate 		}
1097c478bd9Sstevel@tonic-gate 		t = -t;
1107c478bd9Sstevel@tonic-gate 	}
1117c478bd9Sstevel@tonic-gate 	t = t / d;
1127c478bd9Sstevel@tonic-gate 	if ((o ^ sign) < 0) {
1137c478bd9Sstevel@tonic-gate 		rem = (t * d) + o;
1147c478bd9Sstevel@tonic-gate 	} else {
1157c478bd9Sstevel@tonic-gate 		rem = o - (t*d);
1167c478bd9Sstevel@tonic-gate 	}
1177c478bd9Sstevel@tonic-gate 	if (sign) {
1187c478bd9Sstevel@tonic-gate 		t = -t;
1197c478bd9Sstevel@tonic-gate 	}
1207c478bd9Sstevel@tonic-gate 	PUSH(DS, rem);
1217c478bd9Sstevel@tonic-gate 	PUSH(DS, t);
1227c478bd9Sstevel@tonic-gate }
1237c478bd9Sstevel@tonic-gate 
1247c478bd9Sstevel@tonic-gate /*
1257c478bd9Sstevel@tonic-gate  * 'u/mod' Fcode implementation.
1267c478bd9Sstevel@tonic-gate  */
1277c478bd9Sstevel@tonic-gate void
uslash_mod(fcode_env_t * env)1287c478bd9Sstevel@tonic-gate uslash_mod(fcode_env_t *env)
1297c478bd9Sstevel@tonic-gate {
1307c478bd9Sstevel@tonic-gate 	u_lforth_t u1, u2;
1317c478bd9Sstevel@tonic-gate 
1327c478bd9Sstevel@tonic-gate 	CHECK_DEPTH(env, 2, "u/mod");
1337c478bd9Sstevel@tonic-gate 	u2 = POP(DS);
1347c478bd9Sstevel@tonic-gate 	u1 = POP(DS);
1357c478bd9Sstevel@tonic-gate 
1367c478bd9Sstevel@tonic-gate 	if (u2 == 0)
1377c478bd9Sstevel@tonic-gate 		forth_abort(env, "u/mod: divide by zero");
1387c478bd9Sstevel@tonic-gate 	PUSH(DS, u1 % u2);
1397c478bd9Sstevel@tonic-gate 	PUSH(DS, u1 / u2);
1407c478bd9Sstevel@tonic-gate }
1417c478bd9Sstevel@tonic-gate 
1427c478bd9Sstevel@tonic-gate void
divide(fcode_env_t * env)1437c478bd9Sstevel@tonic-gate divide(fcode_env_t *env)
1447c478bd9Sstevel@tonic-gate {
1457c478bd9Sstevel@tonic-gate 	CHECK_DEPTH(env, 2, "/");
1467c478bd9Sstevel@tonic-gate 	slash_mod(env);
1477c478bd9Sstevel@tonic-gate 	nip(env);
1487c478bd9Sstevel@tonic-gate }
1497c478bd9Sstevel@tonic-gate 
1507c478bd9Sstevel@tonic-gate void
mod(fcode_env_t * env)1517c478bd9Sstevel@tonic-gate mod(fcode_env_t *env)
1527c478bd9Sstevel@tonic-gate {
1537c478bd9Sstevel@tonic-gate 	CHECK_DEPTH(env, 2, "mod");
1547c478bd9Sstevel@tonic-gate 	slash_mod(env);
1557c478bd9Sstevel@tonic-gate 	drop(env);
1567c478bd9Sstevel@tonic-gate }
1577c478bd9Sstevel@tonic-gate 
1587c478bd9Sstevel@tonic-gate void
and(fcode_env_t * env)1597c478bd9Sstevel@tonic-gate and(fcode_env_t *env)
1607c478bd9Sstevel@tonic-gate {
1617c478bd9Sstevel@tonic-gate 	fstack_t d;
1627c478bd9Sstevel@tonic-gate 
1637c478bd9Sstevel@tonic-gate 	CHECK_DEPTH(env, 2, "and");
1647c478bd9Sstevel@tonic-gate 	d = POP(DS);
1657c478bd9Sstevel@tonic-gate 	TOS &= d;
1667c478bd9Sstevel@tonic-gate }
1677c478bd9Sstevel@tonic-gate 
1687c478bd9Sstevel@tonic-gate void
or(fcode_env_t * env)1697c478bd9Sstevel@tonic-gate or(fcode_env_t *env)
1707c478bd9Sstevel@tonic-gate {
1717c478bd9Sstevel@tonic-gate 	fstack_t d;
1727c478bd9Sstevel@tonic-gate 
1737c478bd9Sstevel@tonic-gate 	CHECK_DEPTH(env, 2, "or");
1747c478bd9Sstevel@tonic-gate 	d = POP(DS);
1757c478bd9Sstevel@tonic-gate 	TOS |= d;
1767c478bd9Sstevel@tonic-gate }
1777c478bd9Sstevel@tonic-gate 
1787c478bd9Sstevel@tonic-gate void
xor(fcode_env_t * env)1797c478bd9Sstevel@tonic-gate xor(fcode_env_t *env)
1807c478bd9Sstevel@tonic-gate {
1817c478bd9Sstevel@tonic-gate 	fstack_t d;
1827c478bd9Sstevel@tonic-gate 
1837c478bd9Sstevel@tonic-gate 	CHECK_DEPTH(env, 2, "xor");
1847c478bd9Sstevel@tonic-gate 	d = POP(DS);
1857c478bd9Sstevel@tonic-gate 	TOS ^= d;
1867c478bd9Sstevel@tonic-gate }
1877c478bd9Sstevel@tonic-gate 
1887c478bd9Sstevel@tonic-gate void
invert(fcode_env_t * env)1897c478bd9Sstevel@tonic-gate invert(fcode_env_t *env)
1907c478bd9Sstevel@tonic-gate {
1917c478bd9Sstevel@tonic-gate 	CHECK_DEPTH(env, 1, "invert");
1927c478bd9Sstevel@tonic-gate 	TOS = ~TOS;
1937c478bd9Sstevel@tonic-gate }
1947c478bd9Sstevel@tonic-gate 
1957c478bd9Sstevel@tonic-gate void
lshift(fcode_env_t * env)1967c478bd9Sstevel@tonic-gate lshift(fcode_env_t *env)
1977c478bd9Sstevel@tonic-gate {
1987c478bd9Sstevel@tonic-gate 	fstack_t d;
1997c478bd9Sstevel@tonic-gate 
2007c478bd9Sstevel@tonic-gate 	CHECK_DEPTH(env, 2, "lshift");
2017c478bd9Sstevel@tonic-gate 	d = POP(DS);
2027c478bd9Sstevel@tonic-gate 	TOS = TOS << d;
2037c478bd9Sstevel@tonic-gate }
2047c478bd9Sstevel@tonic-gate 
2057c478bd9Sstevel@tonic-gate void
rshift(fcode_env_t * env)2067c478bd9Sstevel@tonic-gate rshift(fcode_env_t *env)
2077c478bd9Sstevel@tonic-gate {
2087c478bd9Sstevel@tonic-gate 	fstack_t d;
2097c478bd9Sstevel@tonic-gate 
2107c478bd9Sstevel@tonic-gate 	CHECK_DEPTH(env, 2, "rshift");
2117c478bd9Sstevel@tonic-gate 	d = POP(DS);
2127c478bd9Sstevel@tonic-gate 	TOS = ((ufstack_t)TOS) >> d;
2137c478bd9Sstevel@tonic-gate }
2147c478bd9Sstevel@tonic-gate 
2157c478bd9Sstevel@tonic-gate void
rshifta(fcode_env_t * env)2167c478bd9Sstevel@tonic-gate rshifta(fcode_env_t *env)
2177c478bd9Sstevel@tonic-gate {
2187c478bd9Sstevel@tonic-gate 	fstack_t d;
2197c478bd9Sstevel@tonic-gate 
2207c478bd9Sstevel@tonic-gate 	CHECK_DEPTH(env, 2, ">>a");
2217c478bd9Sstevel@tonic-gate 	d = POP(DS);
2227c478bd9Sstevel@tonic-gate 	TOS = ((s_lforth_t)TOS) >> d;
2237c478bd9Sstevel@tonic-gate }
2247c478bd9Sstevel@tonic-gate 
2257c478bd9Sstevel@tonic-gate void
negate(fcode_env_t * env)2267c478bd9Sstevel@tonic-gate negate(fcode_env_t *env)
2277c478bd9Sstevel@tonic-gate {
2287c478bd9Sstevel@tonic-gate 	CHECK_DEPTH(env, 1, "negate");
2297c478bd9Sstevel@tonic-gate 	TOS = -TOS;
2307c478bd9Sstevel@tonic-gate }
2317c478bd9Sstevel@tonic-gate 
2327c478bd9Sstevel@tonic-gate void
f_abs(fcode_env_t * env)2337c478bd9Sstevel@tonic-gate f_abs(fcode_env_t *env)
2347c478bd9Sstevel@tonic-gate {
2357c478bd9Sstevel@tonic-gate 	CHECK_DEPTH(env, 1, "abs");
2367c478bd9Sstevel@tonic-gate 	if (TOS < 0) TOS = -TOS;
2377c478bd9Sstevel@tonic-gate }
2387c478bd9Sstevel@tonic-gate 
2397c478bd9Sstevel@tonic-gate void
f_min(fcode_env_t * env)2407c478bd9Sstevel@tonic-gate f_min(fcode_env_t *env)
2417c478bd9Sstevel@tonic-gate {
2427c478bd9Sstevel@tonic-gate 	fstack_t d;
2437c478bd9Sstevel@tonic-gate 
2447c478bd9Sstevel@tonic-gate 	CHECK_DEPTH(env, 2, "min");
2457c478bd9Sstevel@tonic-gate 	d = POP(DS);
2467c478bd9Sstevel@tonic-gate 	if (d < TOS)	TOS = d;
2477c478bd9Sstevel@tonic-gate }
2487c478bd9Sstevel@tonic-gate 
2497c478bd9Sstevel@tonic-gate void
f_max(fcode_env_t * env)2507c478bd9Sstevel@tonic-gate f_max(fcode_env_t *env)
2517c478bd9Sstevel@tonic-gate {
2527c478bd9Sstevel@tonic-gate 	fstack_t d;
2537c478bd9Sstevel@tonic-gate 
2547c478bd9Sstevel@tonic-gate 	CHECK_DEPTH(env, 2, "max");
2557c478bd9Sstevel@tonic-gate 	d = POP(DS);
2567c478bd9Sstevel@tonic-gate 	if (d > TOS)	TOS = d;
2577c478bd9Sstevel@tonic-gate }
2587c478bd9Sstevel@tonic-gate 
2597c478bd9Sstevel@tonic-gate void
to_r(fcode_env_t * env)2607c478bd9Sstevel@tonic-gate to_r(fcode_env_t *env)
2617c478bd9Sstevel@tonic-gate {
2627c478bd9Sstevel@tonic-gate 	CHECK_DEPTH(env, 1, ">r");
2637c478bd9Sstevel@tonic-gate 	PUSH(RS, POP(DS));
2647c478bd9Sstevel@tonic-gate }
2657c478bd9Sstevel@tonic-gate 
2667c478bd9Sstevel@tonic-gate void
from_r(fcode_env_t * env)2677c478bd9Sstevel@tonic-gate from_r(fcode_env_t *env)
2687c478bd9Sstevel@tonic-gate {
2697c478bd9Sstevel@tonic-gate 	CHECK_RETURN_DEPTH(env, 1, "r>");
2707c478bd9Sstevel@tonic-gate 	PUSH(DS, POP(RS));
2717c478bd9Sstevel@tonic-gate }
2727c478bd9Sstevel@tonic-gate 
2737c478bd9Sstevel@tonic-gate void
rfetch(fcode_env_t * env)2747c478bd9Sstevel@tonic-gate rfetch(fcode_env_t *env)
2757c478bd9Sstevel@tonic-gate {
2767c478bd9Sstevel@tonic-gate 	CHECK_RETURN_DEPTH(env, 1, "r@");
2777c478bd9Sstevel@tonic-gate 	PUSH(DS, *RS);
2787c478bd9Sstevel@tonic-gate }
2797c478bd9Sstevel@tonic-gate 
2807c478bd9Sstevel@tonic-gate void
f_exit(fcode_env_t * env)2817c478bd9Sstevel@tonic-gate f_exit(fcode_env_t *env)
2827c478bd9Sstevel@tonic-gate {
2837c478bd9Sstevel@tonic-gate 	CHECK_RETURN_DEPTH(env, 1, "exit");
2847c478bd9Sstevel@tonic-gate 	IP = (token_t *)POP(RS);
2857c478bd9Sstevel@tonic-gate }
2867c478bd9Sstevel@tonic-gate 
2877c478bd9Sstevel@tonic-gate #define	COMPARE(cmp, rhs)	((((s_lforth_t)TOS) cmp((s_lforth_t)(rhs))) ? \
2887c478bd9Sstevel@tonic-gate 				    TRUE : FALSE)
289*09e6639bSToomas Soome #define	UCOMPARE(cmp, rhs)	((((u_lforth_t)TOS) cmp((u_lforth_t)(rhs))) ? \
2907c478bd9Sstevel@tonic-gate 				    TRUE : FALSE)
2917c478bd9Sstevel@tonic-gate #define	EQUALS		==
2927c478bd9Sstevel@tonic-gate #define	NOTEQUALS	!=
2937c478bd9Sstevel@tonic-gate #define	LESSTHAN	<
2947c478bd9Sstevel@tonic-gate #define	LESSEQUALS	<=
2957c478bd9Sstevel@tonic-gate #define	GREATERTHAN	>
2967c478bd9Sstevel@tonic-gate #define	GREATEREQUALS	>=
2977c478bd9Sstevel@tonic-gate 
2987c478bd9Sstevel@tonic-gate void
zero_equals(fcode_env_t * env)2997c478bd9Sstevel@tonic-gate zero_equals(fcode_env_t *env)
3007c478bd9Sstevel@tonic-gate {
3017c478bd9Sstevel@tonic-gate 	CHECK_DEPTH(env, 1, "0=");
3027c478bd9Sstevel@tonic-gate 	TOS = COMPARE(EQUALS, 0);
3037c478bd9Sstevel@tonic-gate }
3047c478bd9Sstevel@tonic-gate 
3057c478bd9Sstevel@tonic-gate void
zero_not_equals(fcode_env_t * env)3067c478bd9Sstevel@tonic-gate zero_not_equals(fcode_env_t *env)
3077c478bd9Sstevel@tonic-gate {
3087c478bd9Sstevel@tonic-gate 	CHECK_DEPTH(env, 1, "0<>");
3097c478bd9Sstevel@tonic-gate 	TOS = COMPARE(NOTEQUALS, 0);
3107c478bd9Sstevel@tonic-gate }
3117c478bd9Sstevel@tonic-gate 
3127c478bd9Sstevel@tonic-gate void
zero_less(fcode_env_t * env)3137c478bd9Sstevel@tonic-gate zero_less(fcode_env_t *env)
3147c478bd9Sstevel@tonic-gate {
3157c478bd9Sstevel@tonic-gate 	CHECK_DEPTH(env, 1, "0<");
3167c478bd9Sstevel@tonic-gate 	TOS = COMPARE(LESSTHAN, 0);
3177c478bd9Sstevel@tonic-gate }
3187c478bd9Sstevel@tonic-gate 
3197c478bd9Sstevel@tonic-gate void
zero_less_equals(fcode_env_t * env)3207c478bd9Sstevel@tonic-gate zero_less_equals(fcode_env_t *env)
3217c478bd9Sstevel@tonic-gate {
3227c478bd9Sstevel@tonic-gate 	CHECK_DEPTH(env, 1, "0<=");
3237c478bd9Sstevel@tonic-gate 	TOS = COMPARE(LESSEQUALS, 0);
3247c478bd9Sstevel@tonic-gate }
3257c478bd9Sstevel@tonic-gate 
3267c478bd9Sstevel@tonic-gate void
zero_greater(fcode_env_t * env)3277c478bd9Sstevel@tonic-gate zero_greater(fcode_env_t *env)
3287c478bd9Sstevel@tonic-gate {
3297c478bd9Sstevel@tonic-gate 	CHECK_DEPTH(env, 1, "0>");
3307c478bd9Sstevel@tonic-gate 	TOS = COMPARE(GREATERTHAN, 0);
3317c478bd9Sstevel@tonic-gate }
3327c478bd9Sstevel@tonic-gate 
3337c478bd9Sstevel@tonic-gate void
zero_greater_equals(fcode_env_t * env)3347c478bd9Sstevel@tonic-gate zero_greater_equals(fcode_env_t *env)
3357c478bd9Sstevel@tonic-gate {
3367c478bd9Sstevel@tonic-gate 	CHECK_DEPTH(env, 1, "0>=");
3377c478bd9Sstevel@tonic-gate 	TOS = COMPARE(GREATEREQUALS, 0);
3387c478bd9Sstevel@tonic-gate }
3397c478bd9Sstevel@tonic-gate 
3407c478bd9Sstevel@tonic-gate void
less(fcode_env_t * env)3417c478bd9Sstevel@tonic-gate less(fcode_env_t *env)
3427c478bd9Sstevel@tonic-gate {
3437c478bd9Sstevel@tonic-gate 	fstack_t d;
3447c478bd9Sstevel@tonic-gate 
3457c478bd9Sstevel@tonic-gate 	CHECK_DEPTH(env, 2, "<");
3467c478bd9Sstevel@tonic-gate 	d = POP(DS);
3477c478bd9Sstevel@tonic-gate 	TOS = COMPARE(LESSTHAN, d);
3487c478bd9Sstevel@tonic-gate }
3497c478bd9Sstevel@tonic-gate 
3507c478bd9Sstevel@tonic-gate void
greater(fcode_env_t * env)3517c478bd9Sstevel@tonic-gate greater(fcode_env_t *env)
3527c478bd9Sstevel@tonic-gate {
3537c478bd9Sstevel@tonic-gate 	fstack_t d;
3547c478bd9Sstevel@tonic-gate 
3557c478bd9Sstevel@tonic-gate 	CHECK_DEPTH(env, 2, ">");
3567c478bd9Sstevel@tonic-gate 	d = POP(DS);
3577c478bd9Sstevel@tonic-gate 	TOS = COMPARE(GREATERTHAN, d);
3587c478bd9Sstevel@tonic-gate }
3597c478bd9Sstevel@tonic-gate 
3607c478bd9Sstevel@tonic-gate void
equals(fcode_env_t * env)3617c478bd9Sstevel@tonic-gate equals(fcode_env_t *env)
3627c478bd9Sstevel@tonic-gate {
3637c478bd9Sstevel@tonic-gate 	fstack_t d;
3647c478bd9Sstevel@tonic-gate 
3657c478bd9Sstevel@tonic-gate 	CHECK_DEPTH(env, 2, "=");
3667c478bd9Sstevel@tonic-gate 	d = POP(DS);
3677c478bd9Sstevel@tonic-gate 	TOS = COMPARE(EQUALS, d);
3687c478bd9Sstevel@tonic-gate }
3697c478bd9Sstevel@tonic-gate 
3707c478bd9Sstevel@tonic-gate void
not_equals(fcode_env_t * env)3717c478bd9Sstevel@tonic-gate not_equals(fcode_env_t *env)
3727c478bd9Sstevel@tonic-gate {
3737c478bd9Sstevel@tonic-gate 	fstack_t d;
3747c478bd9Sstevel@tonic-gate 
3757c478bd9Sstevel@tonic-gate 	CHECK_DEPTH(env, 2, "<>");
3767c478bd9Sstevel@tonic-gate 	d = POP(DS);
3777c478bd9Sstevel@tonic-gate 	TOS = COMPARE(NOTEQUALS, d);
3787c478bd9Sstevel@tonic-gate }
3797c478bd9Sstevel@tonic-gate 
3807c478bd9Sstevel@tonic-gate 
3817c478bd9Sstevel@tonic-gate void
unsign_greater(fcode_env_t * env)3827c478bd9Sstevel@tonic-gate unsign_greater(fcode_env_t *env)
3837c478bd9Sstevel@tonic-gate {
3847c478bd9Sstevel@tonic-gate 	ufstack_t d;
3857c478bd9Sstevel@tonic-gate 
3867c478bd9Sstevel@tonic-gate 	CHECK_DEPTH(env, 2, "u>");
3877c478bd9Sstevel@tonic-gate 	d = POP(DS);
3887c478bd9Sstevel@tonic-gate 	TOS = UCOMPARE(GREATERTHAN, d);
3897c478bd9Sstevel@tonic-gate }
3907c478bd9Sstevel@tonic-gate 
3917c478bd9Sstevel@tonic-gate void
unsign_less_equals(fcode_env_t * env)3927c478bd9Sstevel@tonic-gate unsign_less_equals(fcode_env_t *env)
3937c478bd9Sstevel@tonic-gate {
3947c478bd9Sstevel@tonic-gate 	ufstack_t d;
3957c478bd9Sstevel@tonic-gate 
3967c478bd9Sstevel@tonic-gate 	CHECK_DEPTH(env, 2, "u<=");
3977c478bd9Sstevel@tonic-gate 	d = POP(DS);
3987c478bd9Sstevel@tonic-gate 	TOS = UCOMPARE(LESSEQUALS, d);
3997c478bd9Sstevel@tonic-gate }
4007c478bd9Sstevel@tonic-gate 
4017c478bd9Sstevel@tonic-gate void
unsign_less(fcode_env_t * env)4027c478bd9Sstevel@tonic-gate unsign_less(fcode_env_t *env)
4037c478bd9Sstevel@tonic-gate {
4047c478bd9Sstevel@tonic-gate 	ufstack_t d;
4057c478bd9Sstevel@tonic-gate 
4067c478bd9Sstevel@tonic-gate 	CHECK_DEPTH(env, 2, "u<");
4077c478bd9Sstevel@tonic-gate 	d = POP(DS);
4087c478bd9Sstevel@tonic-gate 	TOS = UCOMPARE(LESSTHAN, d);
4097c478bd9Sstevel@tonic-gate }
4107c478bd9Sstevel@tonic-gate 
4117c478bd9Sstevel@tonic-gate void
unsign_greater_equals(fcode_env_t * env)4127c478bd9Sstevel@tonic-gate unsign_greater_equals(fcode_env_t *env)
4137c478bd9Sstevel@tonic-gate {
4147c478bd9Sstevel@tonic-gate 	ufstack_t d;
4157c478bd9Sstevel@tonic-gate 
4167c478bd9Sstevel@tonic-gate 	CHECK_DEPTH(env, 2, "u>=");
4177c478bd9Sstevel@tonic-gate 	d = POP(DS);
4187c478bd9Sstevel@tonic-gate 	TOS = UCOMPARE(GREATEREQUALS, d);
4197c478bd9Sstevel@tonic-gate }
4207c478bd9Sstevel@tonic-gate 
4217c478bd9Sstevel@tonic-gate void
greater_equals(fcode_env_t * env)4227c478bd9Sstevel@tonic-gate greater_equals(fcode_env_t *env)
4237c478bd9Sstevel@tonic-gate {
4247c478bd9Sstevel@tonic-gate 	fstack_t d;
4257c478bd9Sstevel@tonic-gate 
4267c478bd9Sstevel@tonic-gate 	CHECK_DEPTH(env, 2, ">=");
4277c478bd9Sstevel@tonic-gate 	d = POP(DS);
4287c478bd9Sstevel@tonic-gate 	TOS = COMPARE(GREATEREQUALS, d);
4297c478bd9Sstevel@tonic-gate }
4307c478bd9Sstevel@tonic-gate 
4317c478bd9Sstevel@tonic-gate void
less_equals(fcode_env_t * env)4327c478bd9Sstevel@tonic-gate less_equals(fcode_env_t *env)
4337c478bd9Sstevel@tonic-gate {
4347c478bd9Sstevel@tonic-gate 	fstack_t d;
4357c478bd9Sstevel@tonic-gate 
4367c478bd9Sstevel@tonic-gate 	CHECK_DEPTH(env, 2, "<=");
4377c478bd9Sstevel@tonic-gate 	d = POP(DS);
4387c478bd9Sstevel@tonic-gate 	TOS = COMPARE(LESSEQUALS, d);
4397c478bd9Sstevel@tonic-gate }
4407c478bd9Sstevel@tonic-gate 
4417c478bd9Sstevel@tonic-gate void
between(fcode_env_t * env)4427c478bd9Sstevel@tonic-gate between(fcode_env_t *env)
4437c478bd9Sstevel@tonic-gate {
4443aa1cd26Sgovinda 	u_lforth_t hi, lo;
4457c478bd9Sstevel@tonic-gate 
4467c478bd9Sstevel@tonic-gate 	CHECK_DEPTH(env, 3, "between");
4473aa1cd26Sgovinda 	hi = (u_lforth_t)POP(DS);
4483aa1cd26Sgovinda 	lo = (u_lforth_t)POP(DS);
4493aa1cd26Sgovinda 	TOS = (((u_lforth_t)TOS >= lo) && ((u_lforth_t)TOS <= hi) ? -1 : 0);
4507c478bd9Sstevel@tonic-gate }
4517c478bd9Sstevel@tonic-gate 
4527c478bd9Sstevel@tonic-gate void
within(fcode_env_t * env)4537c478bd9Sstevel@tonic-gate within(fcode_env_t *env)
4547c478bd9Sstevel@tonic-gate {
4553aa1cd26Sgovinda 	u_lforth_t lo, hi;
4567c478bd9Sstevel@tonic-gate 
4577c478bd9Sstevel@tonic-gate 	CHECK_DEPTH(env, 3, "within");
4583aa1cd26Sgovinda 	hi = (u_lforth_t)POP(DS);
4593aa1cd26Sgovinda 	lo = (u_lforth_t)POP(DS);
4603aa1cd26Sgovinda 	TOS = ((((u_lforth_t)TOS >= lo) && ((u_lforth_t)TOS < hi)) ? -1 : 0);
4617c478bd9Sstevel@tonic-gate }
4627c478bd9Sstevel@tonic-gate 
4637c478bd9Sstevel@tonic-gate void
do_literal(fcode_env_t * env)4647c478bd9Sstevel@tonic-gate do_literal(fcode_env_t *env)
4657c478bd9Sstevel@tonic-gate {
4667c478bd9Sstevel@tonic-gate 	PUSH(DS, *IP);
4677c478bd9Sstevel@tonic-gate 	IP++;
4687c478bd9Sstevel@tonic-gate }
4697c478bd9Sstevel@tonic-gate 
4707c478bd9Sstevel@tonic-gate void
literal(fcode_env_t * env)4717c478bd9Sstevel@tonic-gate literal(fcode_env_t *env)
4727c478bd9Sstevel@tonic-gate {
4737c478bd9Sstevel@tonic-gate 	if (env->state) {
4747c478bd9Sstevel@tonic-gate 		COMPILE_TOKEN(&blit_ptr);
4757c478bd9Sstevel@tonic-gate 		compile_comma(env);
4767c478bd9Sstevel@tonic-gate 	}
4777c478bd9Sstevel@tonic-gate }
4787c478bd9Sstevel@tonic-gate 
4797c478bd9Sstevel@tonic-gate void
do_also(fcode_env_t * env)4807c478bd9Sstevel@tonic-gate do_also(fcode_env_t *env)
4817c478bd9Sstevel@tonic-gate {
4827c478bd9Sstevel@tonic-gate 	token_t *d = *ORDER;
4837c478bd9Sstevel@tonic-gate 
4847c478bd9Sstevel@tonic-gate 	if (env->order_depth < (MAX_ORDER - 1)) {
4857c478bd9Sstevel@tonic-gate 		env->order[++env->order_depth] = d;
4867c478bd9Sstevel@tonic-gate 		debug_msg(DEBUG_CONTEXT, "CONTEXT:also: %d/%p/%p\n",
4877c478bd9Sstevel@tonic-gate 		    env->order_depth, CONTEXT, env->current);
4887c478bd9Sstevel@tonic-gate 	} else
4897c478bd9Sstevel@tonic-gate 		log_message(MSG_WARN, "Vocabulary search order exceeds: %d\n",
4907c478bd9Sstevel@tonic-gate 		    MAX_ORDER);
4917c478bd9Sstevel@tonic-gate }
4927c478bd9Sstevel@tonic-gate 
4937c478bd9Sstevel@tonic-gate void
do_previous(fcode_env_t * env)4947c478bd9Sstevel@tonic-gate do_previous(fcode_env_t *env)
4957c478bd9Sstevel@tonic-gate {
4967c478bd9Sstevel@tonic-gate 	if (env->order_depth) {
4977c478bd9Sstevel@tonic-gate 		env->order_depth--;
4987c478bd9Sstevel@tonic-gate 		debug_msg(DEBUG_CONTEXT, "CONTEXT:previous: %d/%p/%p\n",
4997c478bd9Sstevel@tonic-gate 		    env->order_depth, CONTEXT, env->current);
5007c478bd9Sstevel@tonic-gate 	}
5017c478bd9Sstevel@tonic-gate }
5027c478bd9Sstevel@tonic-gate 
5037c478bd9Sstevel@tonic-gate #ifdef DEBUG
5047c478bd9Sstevel@tonic-gate void
do_order(fcode_env_t * env)5057c478bd9Sstevel@tonic-gate do_order(fcode_env_t *env)
5067c478bd9Sstevel@tonic-gate {
5077c478bd9Sstevel@tonic-gate 	int i;
5087c478bd9Sstevel@tonic-gate 
5097c478bd9Sstevel@tonic-gate 	log_message(MSG_INFO, "Order: Depth: %ld: ", env->order_depth);
5107c478bd9Sstevel@tonic-gate 	for (i = env->order_depth; i >= 0 && env->order[i]; i--)
5117c478bd9Sstevel@tonic-gate 		log_message(MSG_INFO, "%p ", (void *)env->order[i]);
5127c478bd9Sstevel@tonic-gate 	log_message(MSG_INFO, "\n");
5137c478bd9Sstevel@tonic-gate }
5147c478bd9Sstevel@tonic-gate #endif
5157c478bd9Sstevel@tonic-gate 
5167c478bd9Sstevel@tonic-gate void
noop(fcode_env_t * env)5177c478bd9Sstevel@tonic-gate noop(fcode_env_t *env)
5187c478bd9Sstevel@tonic-gate {
5197c478bd9Sstevel@tonic-gate 	/* what a waste of cycles */
5207c478bd9Sstevel@tonic-gate }
5217c478bd9Sstevel@tonic-gate 
5227c478bd9Sstevel@tonic-gate 
5237c478bd9Sstevel@tonic-gate #define	FW_PER_FL	(sizeof (lforth_t)/sizeof (wforth_t))
5247c478bd9Sstevel@tonic-gate 
5257c478bd9Sstevel@tonic-gate void
lwsplit(fcode_env_t * env)5267c478bd9Sstevel@tonic-gate lwsplit(fcode_env_t *env)
5277c478bd9Sstevel@tonic-gate {
5287c478bd9Sstevel@tonic-gate 	union {
5297c478bd9Sstevel@tonic-gate 		u_wforth_t l_wf[FW_PER_FL];
5307c478bd9Sstevel@tonic-gate 		u_lforth_t l_lf;
5317c478bd9Sstevel@tonic-gate 	} d;
5327c478bd9Sstevel@tonic-gate 	int i;
5337c478bd9Sstevel@tonic-gate 
5347c478bd9Sstevel@tonic-gate 	CHECK_DEPTH(env, 1, "lwsplit");
5357c478bd9Sstevel@tonic-gate 	d.l_lf = POP(DS);
5367c478bd9Sstevel@tonic-gate 	for (i = 0; i < FW_PER_FL; i++)
5377c478bd9Sstevel@tonic-gate 		PUSH(DS, d.l_wf[(FW_PER_FL - 1) - i]);
5387c478bd9Sstevel@tonic-gate }
5397c478bd9Sstevel@tonic-gate 
5407c478bd9Sstevel@tonic-gate void
wljoin(fcode_env_t * env)5417c478bd9Sstevel@tonic-gate wljoin(fcode_env_t *env)
5427c478bd9Sstevel@tonic-gate {
5437c478bd9Sstevel@tonic-gate 	union {
5447c478bd9Sstevel@tonic-gate 		u_wforth_t l_wf[FW_PER_FL];
5457c478bd9Sstevel@tonic-gate 		u_lforth_t l_lf;
5467c478bd9Sstevel@tonic-gate 	} d;
5477c478bd9Sstevel@tonic-gate 	int i;
5487c478bd9Sstevel@tonic-gate 
5497c478bd9Sstevel@tonic-gate 	CHECK_DEPTH(env, FW_PER_FL, "wljoin");
5507c478bd9Sstevel@tonic-gate 	for (i = 0; i < FW_PER_FL; i++)
5517c478bd9Sstevel@tonic-gate 		d.l_wf[i] = POP(DS);
5527c478bd9Sstevel@tonic-gate 	PUSH(DS, d.l_lf);
5537c478bd9Sstevel@tonic-gate }
5547c478bd9Sstevel@tonic-gate 
5557c478bd9Sstevel@tonic-gate void
lwflip(fcode_env_t * env)5567c478bd9Sstevel@tonic-gate lwflip(fcode_env_t *env)
5577c478bd9Sstevel@tonic-gate {
5587c478bd9Sstevel@tonic-gate 	union {
5597c478bd9Sstevel@tonic-gate 		u_wforth_t l_wf[FW_PER_FL];
5607c478bd9Sstevel@tonic-gate 		u_lforth_t l_lf;
5617c478bd9Sstevel@tonic-gate 	} d, c;
5627c478bd9Sstevel@tonic-gate 	int i;
5637c478bd9Sstevel@tonic-gate 
5647c478bd9Sstevel@tonic-gate 	CHECK_DEPTH(env, 1, "lwflip");
5657c478bd9Sstevel@tonic-gate 	d.l_lf = POP(DS);
5667c478bd9Sstevel@tonic-gate 	for (i = 0; i < FW_PER_FL; i++)
5677c478bd9Sstevel@tonic-gate 		c.l_wf[i] = d.l_wf[(FW_PER_FL - 1) - i];
5687c478bd9Sstevel@tonic-gate 	PUSH(DS, c.l_lf);
5697c478bd9Sstevel@tonic-gate }
5707c478bd9Sstevel@tonic-gate 
5717c478bd9Sstevel@tonic-gate void
lbsplit(fcode_env_t * env)5727c478bd9Sstevel@tonic-gate lbsplit(fcode_env_t *env)
5737c478bd9Sstevel@tonic-gate {
5747c478bd9Sstevel@tonic-gate 	union {
5757c478bd9Sstevel@tonic-gate 		uchar_t l_bytes[sizeof (lforth_t)];
5767c478bd9Sstevel@tonic-gate 		u_lforth_t l_lf;
5777c478bd9Sstevel@tonic-gate 	} d;
5787c478bd9Sstevel@tonic-gate 	int i;
5797c478bd9Sstevel@tonic-gate 
5807c478bd9Sstevel@tonic-gate 	CHECK_DEPTH(env, 1, "lbsplit");
5817c478bd9Sstevel@tonic-gate 	d.l_lf = POP(DS);
5827c478bd9Sstevel@tonic-gate 	for (i = 0; i < sizeof (lforth_t); i++)
5837c478bd9Sstevel@tonic-gate 		PUSH(DS, d.l_bytes[(sizeof (lforth_t) - 1) - i]);
5847c478bd9Sstevel@tonic-gate }
5857c478bd9Sstevel@tonic-gate 
5867c478bd9Sstevel@tonic-gate void
bljoin(fcode_env_t * env)5877c478bd9Sstevel@tonic-gate bljoin(fcode_env_t *env)
5887c478bd9Sstevel@tonic-gate {
5897c478bd9Sstevel@tonic-gate 	union {
5907c478bd9Sstevel@tonic-gate 		uchar_t l_bytes[sizeof (lforth_t)];
5917c478bd9Sstevel@tonic-gate 		u_lforth_t l_lf;
5927c478bd9Sstevel@tonic-gate 	} d;
5937c478bd9Sstevel@tonic-gate 	int i;
5947c478bd9Sstevel@tonic-gate 
5957c478bd9Sstevel@tonic-gate 	CHECK_DEPTH(env, sizeof (lforth_t), "bljoin");
5967c478bd9Sstevel@tonic-gate 	for (i = 0; i < sizeof (lforth_t); i++)
5977c478bd9Sstevel@tonic-gate 		d.l_bytes[i] = POP(DS);
5987c478bd9Sstevel@tonic-gate 	PUSH(DS, (fstack_t)d.l_lf);
5997c478bd9Sstevel@tonic-gate }
6007c478bd9Sstevel@tonic-gate 
6017c478bd9Sstevel@tonic-gate void
lbflip(fcode_env_t * env)6027c478bd9Sstevel@tonic-gate lbflip(fcode_env_t *env)
6037c478bd9Sstevel@tonic-gate {
6047c478bd9Sstevel@tonic-gate 	union {
6057c478bd9Sstevel@tonic-gate 		uchar_t l_bytes[sizeof (lforth_t)];
6067c478bd9Sstevel@tonic-gate 		u_lforth_t l_lf;
6077c478bd9Sstevel@tonic-gate 	} d, c;
6087c478bd9Sstevel@tonic-gate 	int i;
6097c478bd9Sstevel@tonic-gate 
6107c478bd9Sstevel@tonic-gate 	CHECK_DEPTH(env, 1, "lbflip");
6117c478bd9Sstevel@tonic-gate 	d.l_lf = POP(DS);
6127c478bd9Sstevel@tonic-gate 	for (i = 0; i < sizeof (lforth_t); i++)
6137c478bd9Sstevel@tonic-gate 		c.l_bytes[i] = d.l_bytes[(sizeof (lforth_t) - 1) - i];
6147c478bd9Sstevel@tonic-gate 	PUSH(DS, c.l_lf);
6157c478bd9Sstevel@tonic-gate }
6167c478bd9Sstevel@tonic-gate 
6177c478bd9Sstevel@tonic-gate void
wbsplit(fcode_env_t * env)6187c478bd9Sstevel@tonic-gate wbsplit(fcode_env_t *env)
6197c478bd9Sstevel@tonic-gate {
6207c478bd9Sstevel@tonic-gate 	union {
6217c478bd9Sstevel@tonic-gate 		uchar_t w_bytes[sizeof (wforth_t)];
6227c478bd9Sstevel@tonic-gate 		u_wforth_t w_wf;
6237c478bd9Sstevel@tonic-gate 	} d;
6247c478bd9Sstevel@tonic-gate 	int i;
6257c478bd9Sstevel@tonic-gate 
6267c478bd9Sstevel@tonic-gate 	CHECK_DEPTH(env, 1, "wbsplit");
6277c478bd9Sstevel@tonic-gate 	d.w_wf = POP(DS);
6287c478bd9Sstevel@tonic-gate 	for (i = 0; i < sizeof (wforth_t); i++)
6297c478bd9Sstevel@tonic-gate 		PUSH(DS, d.w_bytes[(sizeof (wforth_t) - 1) - i]);
6307c478bd9Sstevel@tonic-gate }
6317c478bd9Sstevel@tonic-gate 
6327c478bd9Sstevel@tonic-gate void
bwjoin(fcode_env_t * env)6337c478bd9Sstevel@tonic-gate bwjoin(fcode_env_t *env)
6347c478bd9Sstevel@tonic-gate {
6357c478bd9Sstevel@tonic-gate 	union {
6367c478bd9Sstevel@tonic-gate 		uchar_t w_bytes[sizeof (wforth_t)];
6377c478bd9Sstevel@tonic-gate 		u_wforth_t w_wf;
6387c478bd9Sstevel@tonic-gate 	} d;
6397c478bd9Sstevel@tonic-gate 	int i;
6407c478bd9Sstevel@tonic-gate 
6417c478bd9Sstevel@tonic-gate 	CHECK_DEPTH(env, sizeof (wforth_t), "bwjoin");
6427c478bd9Sstevel@tonic-gate 	for (i = 0; i < sizeof (wforth_t); i++)
6437c478bd9Sstevel@tonic-gate 		d.w_bytes[i] = POP(DS);
6447c478bd9Sstevel@tonic-gate 	PUSH(DS, d.w_wf);
6457c478bd9Sstevel@tonic-gate }
6467c478bd9Sstevel@tonic-gate 
6477c478bd9Sstevel@tonic-gate void
wbflip(fcode_env_t * env)6487c478bd9Sstevel@tonic-gate wbflip(fcode_env_t *env)
6497c478bd9Sstevel@tonic-gate {
6507c478bd9Sstevel@tonic-gate 	union {
6517c478bd9Sstevel@tonic-gate 		uchar_t w_bytes[sizeof (wforth_t)];
6527c478bd9Sstevel@tonic-gate 		u_wforth_t w_wf;
6537c478bd9Sstevel@tonic-gate 	} c, d;
6547c478bd9Sstevel@tonic-gate 	int i;
6557c478bd9Sstevel@tonic-gate 
6567c478bd9Sstevel@tonic-gate 	CHECK_DEPTH(env, 1, "wbflip");
6577c478bd9Sstevel@tonic-gate 	d.w_wf = POP(DS);
6587c478bd9Sstevel@tonic-gate 	for (i = 0; i < sizeof (wforth_t); i++)
6597c478bd9Sstevel@tonic-gate 		c.w_bytes[i] = d.w_bytes[(sizeof (wforth_t) - 1) - i];
6607c478bd9Sstevel@tonic-gate 	PUSH(DS, c.w_wf);
6617c478bd9Sstevel@tonic-gate }
6627c478bd9Sstevel@tonic-gate 
6637c478bd9Sstevel@tonic-gate void
upper_case(fcode_env_t * env)6647c478bd9Sstevel@tonic-gate upper_case(fcode_env_t *env)
6657c478bd9Sstevel@tonic-gate {
6667c478bd9Sstevel@tonic-gate 	CHECK_DEPTH(env, 1, "upc");
6677c478bd9Sstevel@tonic-gate 	TOS = toupper(TOS);
6687c478bd9Sstevel@tonic-gate }
6697c478bd9Sstevel@tonic-gate 
6707c478bd9Sstevel@tonic-gate void
lower_case(fcode_env_t * env)6717c478bd9Sstevel@tonic-gate lower_case(fcode_env_t *env)
6727c478bd9Sstevel@tonic-gate {
6737c478bd9Sstevel@tonic-gate 	CHECK_DEPTH(env, 1, "lcc");
6747c478bd9Sstevel@tonic-gate 	TOS = tolower(TOS);
6757c478bd9Sstevel@tonic-gate }
6767c478bd9Sstevel@tonic-gate 
6777c478bd9Sstevel@tonic-gate void
pack_str(fcode_env_t * env)6787c478bd9Sstevel@tonic-gate pack_str(fcode_env_t *env)
6797c478bd9Sstevel@tonic-gate {
6807c478bd9Sstevel@tonic-gate 	char *buf;
6817c478bd9Sstevel@tonic-gate 	size_t len;
6827c478bd9Sstevel@tonic-gate 	char *str;
6837c478bd9Sstevel@tonic-gate 
6847c478bd9Sstevel@tonic-gate 	CHECK_DEPTH(env, 3, "pack");
6857c478bd9Sstevel@tonic-gate 	buf = (char *)POP(DS);
6867c478bd9Sstevel@tonic-gate 	len = (size_t)POP(DS);
6877c478bd9Sstevel@tonic-gate 	str = (char *)TOS;
6887c478bd9Sstevel@tonic-gate 	TOS = (fstack_t)buf;
6897c478bd9Sstevel@tonic-gate 	*buf++ = (uchar_t)len;
690*09e6639bSToomas Soome 	(void) strncpy(buf, str, (len&0xff));
6917c478bd9Sstevel@tonic-gate }
6927c478bd9Sstevel@tonic-gate 
6937c478bd9Sstevel@tonic-gate void
count_str(fcode_env_t * env)6947c478bd9Sstevel@tonic-gate count_str(fcode_env_t *env)
6957c478bd9Sstevel@tonic-gate {
6967c478bd9Sstevel@tonic-gate 	uchar_t *len;
6977c478bd9Sstevel@tonic-gate 
6987c478bd9Sstevel@tonic-gate 	CHECK_DEPTH(env, 1, "count");
6997c478bd9Sstevel@tonic-gate 	len = (uchar_t *)TOS;
7007c478bd9Sstevel@tonic-gate 	TOS += 1;
7017c478bd9Sstevel@tonic-gate 	PUSH(DS, *len);
7027c478bd9Sstevel@tonic-gate }
7037c478bd9Sstevel@tonic-gate 
7047c478bd9Sstevel@tonic-gate void
to_body(fcode_env_t * env)7057c478bd9Sstevel@tonic-gate to_body(fcode_env_t *env)
7067c478bd9Sstevel@tonic-gate {
7077c478bd9Sstevel@tonic-gate 	CHECK_DEPTH(env, 1, ">body");
7087c478bd9Sstevel@tonic-gate 	TOS = (fstack_t)(((acf_t)TOS)+1);
7097c478bd9Sstevel@tonic-gate }
7107c478bd9Sstevel@tonic-gate 
7117c478bd9Sstevel@tonic-gate void
to_acf(fcode_env_t * env)7127c478bd9Sstevel@tonic-gate to_acf(fcode_env_t *env)
7137c478bd9Sstevel@tonic-gate {
7147c478bd9Sstevel@tonic-gate 	CHECK_DEPTH(env, 1, "body>");
7157c478bd9Sstevel@tonic-gate 	TOS = (fstack_t)(((acf_t)TOS)-1);
7167c478bd9Sstevel@tonic-gate }
7177c478bd9Sstevel@tonic-gate 
7187c478bd9Sstevel@tonic-gate /*
7197c478bd9Sstevel@tonic-gate  * 'unloop' Fcode implementation, drop 3 loop ctrl elements off return stack.
7207c478bd9Sstevel@tonic-gate  */
7217c478bd9Sstevel@tonic-gate static void
unloop(fcode_env_t * env)7227c478bd9Sstevel@tonic-gate unloop(fcode_env_t *env)
7237c478bd9Sstevel@tonic-gate {
7247c478bd9Sstevel@tonic-gate 	CHECK_RETURN_DEPTH(env, 3, "unloop");
7257c478bd9Sstevel@tonic-gate 	RS -= 3;
7267c478bd9Sstevel@tonic-gate }
7277c478bd9Sstevel@tonic-gate 
7287c478bd9Sstevel@tonic-gate /*
7297c478bd9Sstevel@tonic-gate  * 'um*' Fcode implementation.
7307c478bd9Sstevel@tonic-gate  */
7317c478bd9Sstevel@tonic-gate static void
um_multiply(fcode_env_t * env)7327c478bd9Sstevel@tonic-gate um_multiply(fcode_env_t *env)
7337c478bd9Sstevel@tonic-gate {
7347c478bd9Sstevel@tonic-gate 	ufstack_t u1, u2;
7357c478bd9Sstevel@tonic-gate 	dforth_t d;
7367c478bd9Sstevel@tonic-gate 
7377c478bd9Sstevel@tonic-gate 	CHECK_DEPTH(env, 2, "um*");
7387c478bd9Sstevel@tonic-gate 	u1 = POP(DS);
7397c478bd9Sstevel@tonic-gate 	u2 = POP(DS);
7407c478bd9Sstevel@tonic-gate 	d = u1 * u2;
7417c478bd9Sstevel@tonic-gate 	push_double(env, d);
7427c478bd9Sstevel@tonic-gate }
7437c478bd9Sstevel@tonic-gate 
7447c478bd9Sstevel@tonic-gate /*
7457c478bd9Sstevel@tonic-gate  * um/mod (d.lo d.hi u -- urem uquot)
7467c478bd9Sstevel@tonic-gate  */
7477c478bd9Sstevel@tonic-gate static void
um_slash_mod(fcode_env_t * env)7487c478bd9Sstevel@tonic-gate um_slash_mod(fcode_env_t *env)
7497c478bd9Sstevel@tonic-gate {
7507c478bd9Sstevel@tonic-gate 	u_dforth_t d;
7517c478bd9Sstevel@tonic-gate 	uint32_t u, urem, uquot;
7527c478bd9Sstevel@tonic-gate 
7537c478bd9Sstevel@tonic-gate 	CHECK_DEPTH(env, 3, "um/mod");
7547c478bd9Sstevel@tonic-gate 	u = (uint32_t)POP(DS);
7557c478bd9Sstevel@tonic-gate 	d = pop_double(env);
7567c478bd9Sstevel@tonic-gate 	urem = d % u;
7577c478bd9Sstevel@tonic-gate 	uquot = d / u;
7587c478bd9Sstevel@tonic-gate 	PUSH(DS, urem);
7597c478bd9Sstevel@tonic-gate 	PUSH(DS, uquot);
7607c478bd9Sstevel@tonic-gate }
7617c478bd9Sstevel@tonic-gate 
7627c478bd9Sstevel@tonic-gate /*
7637c478bd9Sstevel@tonic-gate  * d+ (d1.lo d1.hi d2.lo d2.hi -- dsum.lo dsum.hi)
7647c478bd9Sstevel@tonic-gate  */
7657c478bd9Sstevel@tonic-gate static void
d_plus(fcode_env_t * env)7667c478bd9Sstevel@tonic-gate d_plus(fcode_env_t *env)
7677c478bd9Sstevel@tonic-gate {
7687c478bd9Sstevel@tonic-gate 	dforth_t d1, d2;
7697c478bd9Sstevel@tonic-gate 
7707c478bd9Sstevel@tonic-gate 	CHECK_DEPTH(env, 4, "d+");
7717c478bd9Sstevel@tonic-gate 	d2 = pop_double(env);
7727c478bd9Sstevel@tonic-gate 	d1 = pop_double(env);
7737c478bd9Sstevel@tonic-gate 	d1 += d2;
7747c478bd9Sstevel@tonic-gate 	push_double(env, d1);
7757c478bd9Sstevel@tonic-gate }
7767c478bd9Sstevel@tonic-gate 
7777c478bd9Sstevel@tonic-gate /*
7787c478bd9Sstevel@tonic-gate  * d- (d1.lo d1.hi d2.lo d2.hi -- ddif.lo ddif.hi)
7797c478bd9Sstevel@tonic-gate  */
7807c478bd9Sstevel@tonic-gate static void
d_minus(fcode_env_t * env)7817c478bd9Sstevel@tonic-gate d_minus(fcode_env_t *env)
7827c478bd9Sstevel@tonic-gate {
7837c478bd9Sstevel@tonic-gate 	dforth_t d1, d2;
7847c478bd9Sstevel@tonic-gate 
7857c478bd9Sstevel@tonic-gate 	CHECK_DEPTH(env, 4, "d-");
7867c478bd9Sstevel@tonic-gate 	d2 = pop_double(env);
7877c478bd9Sstevel@tonic-gate 	d1 = pop_double(env);
7887c478bd9Sstevel@tonic-gate 	d1 -= d2;
7897c478bd9Sstevel@tonic-gate 	push_double(env, d1);
7907c478bd9Sstevel@tonic-gate }
7917c478bd9Sstevel@tonic-gate 
7927c478bd9Sstevel@tonic-gate void
set_here(fcode_env_t * env,uchar_t * new_here,char * where)7937c478bd9Sstevel@tonic-gate set_here(fcode_env_t *env, uchar_t *new_here, char *where)
7947c478bd9Sstevel@tonic-gate {
7957c478bd9Sstevel@tonic-gate 	if (new_here < HERE) {
7967c478bd9Sstevel@tonic-gate 		if (strcmp(where, "temporary_execute")) {
7977c478bd9Sstevel@tonic-gate 			/*
7987c478bd9Sstevel@tonic-gate 			 * Other than temporary_execute, no one should set
7997c478bd9Sstevel@tonic-gate 			 * here backwards.
8007c478bd9Sstevel@tonic-gate 			 */
8017c478bd9Sstevel@tonic-gate 			log_message(MSG_WARN, "Warning: set_here(%s) back: old:"
8027c478bd9Sstevel@tonic-gate 			    " %p new: %p\n", where, HERE, new_here);
8037c478bd9Sstevel@tonic-gate 		}
8047c478bd9Sstevel@tonic-gate 	}
8057c478bd9Sstevel@tonic-gate 	if (new_here >= env->base + dict_size)
8067c478bd9Sstevel@tonic-gate 		forth_abort(env, "Here (%p) set past dictionary end (%p)",
8077c478bd9Sstevel@tonic-gate 		    new_here, env->base + dict_size);
8087c478bd9Sstevel@tonic-gate 	HERE = new_here;
8097c478bd9Sstevel@tonic-gate }
8107c478bd9Sstevel@tonic-gate 
8117c478bd9Sstevel@tonic-gate static void
unaligned_store(fcode_env_t * env)8127c478bd9Sstevel@tonic-gate unaligned_store(fcode_env_t *env)
8137c478bd9Sstevel@tonic-gate {
8147c478bd9Sstevel@tonic-gate 	extern void unaligned_xstore(fcode_env_t *);
8157c478bd9Sstevel@tonic-gate 
8167c478bd9Sstevel@tonic-gate 	if (sizeof (fstack_t) == sizeof (lforth_t))
8177c478bd9Sstevel@tonic-gate 		unaligned_lstore(env);
8187c478bd9Sstevel@tonic-gate 	else
8197c478bd9Sstevel@tonic-gate 		unaligned_xstore(env);
8207c478bd9Sstevel@tonic-gate }
8217c478bd9Sstevel@tonic-gate 
8227c478bd9Sstevel@tonic-gate static void
unaligned_fetch(fcode_env_t * env)8237c478bd9Sstevel@tonic-gate unaligned_fetch(fcode_env_t *env)
8247c478bd9Sstevel@tonic-gate {
8257c478bd9Sstevel@tonic-gate 	extern void unaligned_xfetch(fcode_env_t *);
8267c478bd9Sstevel@tonic-gate 
8277c478bd9Sstevel@tonic-gate 	if (sizeof (fstack_t) == sizeof (lforth_t))
8287c478bd9Sstevel@tonic-gate 		unaligned_lfetch(env);
8297c478bd9Sstevel@tonic-gate 	else
8307c478bd9Sstevel@tonic-gate 		unaligned_xfetch(env);
8317c478bd9Sstevel@tonic-gate }
8327c478bd9Sstevel@tonic-gate 
8337c478bd9Sstevel@tonic-gate void
comma(fcode_env_t * env)8347c478bd9Sstevel@tonic-gate comma(fcode_env_t *env)
8357c478bd9Sstevel@tonic-gate {
8367c478bd9Sstevel@tonic-gate 	CHECK_DEPTH(env, 1, ",");
8377c478bd9Sstevel@tonic-gate 	DEBUGF(COMMA, dump_comma(env, ","));
8387c478bd9Sstevel@tonic-gate 	PUSH(DS, (fstack_t)HERE);
8397c478bd9Sstevel@tonic-gate 	unaligned_store(env);
8407c478bd9Sstevel@tonic-gate 	set_here(env, HERE + sizeof (fstack_t), "comma");
8417c478bd9Sstevel@tonic-gate }
8427c478bd9Sstevel@tonic-gate 
8437c478bd9Sstevel@tonic-gate void
lcomma(fcode_env_t * env)8447c478bd9Sstevel@tonic-gate lcomma(fcode_env_t *env)
8457c478bd9Sstevel@tonic-gate {
8467c478bd9Sstevel@tonic-gate 	CHECK_DEPTH(env, 1, "l,");
8477c478bd9Sstevel@tonic-gate 	DEBUGF(COMMA, dump_comma(env, "l,"));
8487c478bd9Sstevel@tonic-gate 	PUSH(DS, (fstack_t)HERE);
8497c478bd9Sstevel@tonic-gate 	unaligned_lstore(env);
8507c478bd9Sstevel@tonic-gate 	set_here(env, HERE + sizeof (u_lforth_t), "lcomma");
8517c478bd9Sstevel@tonic-gate }
8527c478bd9Sstevel@tonic-gate 
8537c478bd9Sstevel@tonic-gate void
wcomma(fcode_env_t * env)8547c478bd9Sstevel@tonic-gate wcomma(fcode_env_t *env)
8557c478bd9Sstevel@tonic-gate {
8567c478bd9Sstevel@tonic-gate 	CHECK_DEPTH(env, 1, "w,");
8577c478bd9Sstevel@tonic-gate 	DEBUGF(COMMA, dump_comma(env, "w,"));
8587c478bd9Sstevel@tonic-gate 	PUSH(DS, (fstack_t)HERE);
8597c478bd9Sstevel@tonic-gate 	unaligned_wstore(env);
8607c478bd9Sstevel@tonic-gate 	set_here(env, HERE + sizeof (u_wforth_t), "wcomma");
8617c478bd9Sstevel@tonic-gate }
8627c478bd9Sstevel@tonic-gate 
8637c478bd9Sstevel@tonic-gate void
ccomma(fcode_env_t * env)8647c478bd9Sstevel@tonic-gate ccomma(fcode_env_t *env)
8657c478bd9Sstevel@tonic-gate {
8667c478bd9Sstevel@tonic-gate 	CHECK_DEPTH(env, 1, "c,");
8677c478bd9Sstevel@tonic-gate 	DEBUGF(COMMA, dump_comma(env, "c,"));
8687c478bd9Sstevel@tonic-gate 	PUSH(DS, (fstack_t)HERE);
8697c478bd9Sstevel@tonic-gate 	cstore(env);
8707c478bd9Sstevel@tonic-gate 	set_here(env, HERE + sizeof (uchar_t), "ccomma");
8717c478bd9Sstevel@tonic-gate }
8727c478bd9Sstevel@tonic-gate 
8737c478bd9Sstevel@tonic-gate void
token_roundup(fcode_env_t * env,char * where)8747c478bd9Sstevel@tonic-gate token_roundup(fcode_env_t *env, char *where)
8757c478bd9Sstevel@tonic-gate {
8767c478bd9Sstevel@tonic-gate 	if ((((token_t)HERE) & (sizeof (token_t) - 1)) != 0) {
8777c478bd9Sstevel@tonic-gate 		set_here(env, (uchar_t *)TOKEN_ROUNDUP(HERE), where);
8787c478bd9Sstevel@tonic-gate 	}
8797c478bd9Sstevel@tonic-gate }
8807c478bd9Sstevel@tonic-gate 
8817c478bd9Sstevel@tonic-gate void
compile_comma(fcode_env_t * env)8827c478bd9Sstevel@tonic-gate compile_comma(fcode_env_t *env)
8837c478bd9Sstevel@tonic-gate {
8847c478bd9Sstevel@tonic-gate 	CHECK_DEPTH(env, 1, "compile,");
8857c478bd9Sstevel@tonic-gate 	DEBUGF(COMMA, dump_comma(env, "compile,"));
8867c478bd9Sstevel@tonic-gate 	token_roundup(env, "compile,");
8877c478bd9Sstevel@tonic-gate 	PUSH(DS, (fstack_t)HERE);
8887c478bd9Sstevel@tonic-gate 	unaligned_store(env);
8897c478bd9Sstevel@tonic-gate 	set_here(env, HERE + sizeof (fstack_t), "compile,");
8907c478bd9Sstevel@tonic-gate }
8917c478bd9Sstevel@tonic-gate 
8927c478bd9Sstevel@tonic-gate void
unaligned_lfetch(fcode_env_t * env)8937c478bd9Sstevel@tonic-gate unaligned_lfetch(fcode_env_t *env)
8947c478bd9Sstevel@tonic-gate {
8957c478bd9Sstevel@tonic-gate 	fstack_t addr;
8967c478bd9Sstevel@tonic-gate 	int i;
8977c478bd9Sstevel@tonic-gate 
8987c478bd9Sstevel@tonic-gate 	CHECK_DEPTH(env, 1, "unaligned-l@");
8997c478bd9Sstevel@tonic-gate 	addr = POP(DS);
9007c478bd9Sstevel@tonic-gate 	for (i = 0; i < sizeof (lforth_t); i++, addr++) {
9017c478bd9Sstevel@tonic-gate 		PUSH(DS, addr);
9027c478bd9Sstevel@tonic-gate 		cfetch(env);
9037c478bd9Sstevel@tonic-gate 	}
9047c478bd9Sstevel@tonic-gate 	bljoin(env);
9057c478bd9Sstevel@tonic-gate 	lbflip(env);
9067c478bd9Sstevel@tonic-gate }
9077c478bd9Sstevel@tonic-gate 
9087c478bd9Sstevel@tonic-gate void
unaligned_lstore(fcode_env_t * env)9097c478bd9Sstevel@tonic-gate unaligned_lstore(fcode_env_t *env)
9107c478bd9Sstevel@tonic-gate {
9117c478bd9Sstevel@tonic-gate 	fstack_t addr;
9127c478bd9Sstevel@tonic-gate 	int i;
9137c478bd9Sstevel@tonic-gate 
9147c478bd9Sstevel@tonic-gate 	CHECK_DEPTH(env, 2, "unaligned-l!");
9157c478bd9Sstevel@tonic-gate 	addr = POP(DS);
9167c478bd9Sstevel@tonic-gate 	lbsplit(env);
9177c478bd9Sstevel@tonic-gate 	for (i = 0; i < sizeof (lforth_t); i++, addr++) {
9187c478bd9Sstevel@tonic-gate 		PUSH(DS, addr);
9197c478bd9Sstevel@tonic-gate 		cstore(env);
9207c478bd9Sstevel@tonic-gate 	}
9217c478bd9Sstevel@tonic-gate }
9227c478bd9Sstevel@tonic-gate 
9237c478bd9Sstevel@tonic-gate void
unaligned_wfetch(fcode_env_t * env)9247c478bd9Sstevel@tonic-gate unaligned_wfetch(fcode_env_t *env)
9257c478bd9Sstevel@tonic-gate {
9267c478bd9Sstevel@tonic-gate 	fstack_t addr;
9277c478bd9Sstevel@tonic-gate 	int i;
9287c478bd9Sstevel@tonic-gate 
9297c478bd9Sstevel@tonic-gate 	CHECK_DEPTH(env, 1, "unaligned-w@");
9307c478bd9Sstevel@tonic-gate 	addr = POP(DS);
9317c478bd9Sstevel@tonic-gate 	for (i = 0; i < sizeof (wforth_t); i++, addr++) {
9327c478bd9Sstevel@tonic-gate 		PUSH(DS, addr);
9337c478bd9Sstevel@tonic-gate 		cfetch(env);
9347c478bd9Sstevel@tonic-gate 	}
9357c478bd9Sstevel@tonic-gate 	bwjoin(env);
9367c478bd9Sstevel@tonic-gate 	wbflip(env);
9377c478bd9Sstevel@tonic-gate }
9387c478bd9Sstevel@tonic-gate 
9397c478bd9Sstevel@tonic-gate void
unaligned_wstore(fcode_env_t * env)9407c478bd9Sstevel@tonic-gate unaligned_wstore(fcode_env_t *env)
9417c478bd9Sstevel@tonic-gate {
9427c478bd9Sstevel@tonic-gate 	fstack_t addr;
9437c478bd9Sstevel@tonic-gate 	int i;
9447c478bd9Sstevel@tonic-gate 
9457c478bd9Sstevel@tonic-gate 	CHECK_DEPTH(env, 2, "unaligned-w!");
9467c478bd9Sstevel@tonic-gate 	addr = POP(DS);
9477c478bd9Sstevel@tonic-gate 	wbsplit(env);
9487c478bd9Sstevel@tonic-gate 	for (i = 0; i < sizeof (wforth_t); i++, addr++) {
9497c478bd9Sstevel@tonic-gate 		PUSH(DS, addr);
9507c478bd9Sstevel@tonic-gate 		cstore(env);
9517c478bd9Sstevel@tonic-gate 	}
9527c478bd9Sstevel@tonic-gate }
9537c478bd9Sstevel@tonic-gate 
9547c478bd9Sstevel@tonic-gate /*
9557c478bd9Sstevel@tonic-gate  * 'lbflips' Fcode implementation.
9567c478bd9Sstevel@tonic-gate  */
9577c478bd9Sstevel@tonic-gate static void
lbflips(fcode_env_t * env)9587c478bd9Sstevel@tonic-gate lbflips(fcode_env_t *env)
9597c478bd9Sstevel@tonic-gate {
9607c478bd9Sstevel@tonic-gate 	fstack_t len, addr;
9617c478bd9Sstevel@tonic-gate 	int i;
9627c478bd9Sstevel@tonic-gate 
9637c478bd9Sstevel@tonic-gate 	CHECK_DEPTH(env, 2, "lbflips");
9647c478bd9Sstevel@tonic-gate 	len = POP(DS);
9657c478bd9Sstevel@tonic-gate 	addr = POP(DS);
9667c478bd9Sstevel@tonic-gate 	for (i = 0; i < len; i += sizeof (lforth_t),
9677c478bd9Sstevel@tonic-gate 	    addr += sizeof (lforth_t)) {
9687c478bd9Sstevel@tonic-gate 		PUSH(DS, addr);
9697c478bd9Sstevel@tonic-gate 		unaligned_lfetch(env);
9707c478bd9Sstevel@tonic-gate 		lbflip(env);
9717c478bd9Sstevel@tonic-gate 		PUSH(DS, addr);
9727c478bd9Sstevel@tonic-gate 		unaligned_lstore(env);
9737c478bd9Sstevel@tonic-gate 	}
9747c478bd9Sstevel@tonic-gate }
9757c478bd9Sstevel@tonic-gate 
9767c478bd9Sstevel@tonic-gate /*
9777c478bd9Sstevel@tonic-gate  * 'wbflips' Fcode implementation.
9787c478bd9Sstevel@tonic-gate  */
9797c478bd9Sstevel@tonic-gate static void
wbflips(fcode_env_t * env)9807c478bd9Sstevel@tonic-gate wbflips(fcode_env_t *env)
9817c478bd9Sstevel@tonic-gate {
9827c478bd9Sstevel@tonic-gate 	fstack_t len, addr;
9837c478bd9Sstevel@tonic-gate 	int i;
9847c478bd9Sstevel@tonic-gate 
9857c478bd9Sstevel@tonic-gate 	CHECK_DEPTH(env, 2, "wbflips");
9867c478bd9Sstevel@tonic-gate 	len = POP(DS);
9877c478bd9Sstevel@tonic-gate 	addr = POP(DS);
9887c478bd9Sstevel@tonic-gate 	for (i = 0; i < len; i += sizeof (wforth_t),
9897c478bd9Sstevel@tonic-gate 	    addr += sizeof (wforth_t)) {
9907c478bd9Sstevel@tonic-gate 		PUSH(DS, addr);
9917c478bd9Sstevel@tonic-gate 		unaligned_wfetch(env);
9927c478bd9Sstevel@tonic-gate 		wbflip(env);
9937c478bd9Sstevel@tonic-gate 		PUSH(DS, addr);
9947c478bd9Sstevel@tonic-gate 		unaligned_wstore(env);
9957c478bd9Sstevel@tonic-gate 	}
9967c478bd9Sstevel@tonic-gate }
9977c478bd9Sstevel@tonic-gate 
9987c478bd9Sstevel@tonic-gate /*
9997c478bd9Sstevel@tonic-gate  * 'lwflips' Fcode implementation.
10007c478bd9Sstevel@tonic-gate  */
10017c478bd9Sstevel@tonic-gate static void
lwflips(fcode_env_t * env)10027c478bd9Sstevel@tonic-gate lwflips(fcode_env_t *env)
10037c478bd9Sstevel@tonic-gate {
10047c478bd9Sstevel@tonic-gate 	fstack_t len, addr;
10057c478bd9Sstevel@tonic-gate 	int i;
10067c478bd9Sstevel@tonic-gate 
10077c478bd9Sstevel@tonic-gate 	CHECK_DEPTH(env, 2, "lwflips");
10087c478bd9Sstevel@tonic-gate 	len = POP(DS);
10097c478bd9Sstevel@tonic-gate 	addr = POP(DS);
10107c478bd9Sstevel@tonic-gate 	for (i = 0; i < len; i += sizeof (lforth_t),
10117c478bd9Sstevel@tonic-gate 	    addr += sizeof (lforth_t)) {
10127c478bd9Sstevel@tonic-gate 		PUSH(DS, addr);
10137c478bd9Sstevel@tonic-gate 		unaligned_lfetch(env);
10147c478bd9Sstevel@tonic-gate 		lwflip(env);
10157c478bd9Sstevel@tonic-gate 		PUSH(DS, addr);
10167c478bd9Sstevel@tonic-gate 		unaligned_lstore(env);
10177c478bd9Sstevel@tonic-gate 	}
10187c478bd9Sstevel@tonic-gate }
10197c478bd9Sstevel@tonic-gate 
10207c478bd9Sstevel@tonic-gate void
base(fcode_env_t * env)10217c478bd9Sstevel@tonic-gate base(fcode_env_t *env)
10227c478bd9Sstevel@tonic-gate {
10237c478bd9Sstevel@tonic-gate 	PUSH(DS, (fstack_t)&env->num_base);
10247c478bd9Sstevel@tonic-gate }
10257c478bd9Sstevel@tonic-gate 
10267c478bd9Sstevel@tonic-gate void
dot_s(fcode_env_t * env)10277c478bd9Sstevel@tonic-gate dot_s(fcode_env_t *env)
10287c478bd9Sstevel@tonic-gate {
10297c478bd9Sstevel@tonic-gate 	output_data_stack(env, MSG_INFO);
10307c478bd9Sstevel@tonic-gate }
10317c478bd9Sstevel@tonic-gate 
10327c478bd9Sstevel@tonic-gate void
state(fcode_env_t * env)10337c478bd9Sstevel@tonic-gate state(fcode_env_t *env)
10347c478bd9Sstevel@tonic-gate {
10357c478bd9Sstevel@tonic-gate 	PUSH(DS, (fstack_t)&env->state);
10367c478bd9Sstevel@tonic-gate }
10377c478bd9Sstevel@tonic-gate 
10387c478bd9Sstevel@tonic-gate int
is_digit(char digit,int num_base,fstack_t * dptr)10397c478bd9Sstevel@tonic-gate is_digit(char digit, int num_base, fstack_t *dptr)
10407c478bd9Sstevel@tonic-gate {
10417c478bd9Sstevel@tonic-gate 	int error = 0;
10427c478bd9Sstevel@tonic-gate 	char base;
10437c478bd9Sstevel@tonic-gate 
10447c478bd9Sstevel@tonic-gate 	if (num_base < 10) {
10457c478bd9Sstevel@tonic-gate 		base = '0' + (num_base-1);
10467c478bd9Sstevel@tonic-gate 	} else {
10477c478bd9Sstevel@tonic-gate 		base = 'a' + (num_base - 10);
10487c478bd9Sstevel@tonic-gate 	}
10497c478bd9Sstevel@tonic-gate 
10507c478bd9Sstevel@tonic-gate 	*dptr = 0;
10517c478bd9Sstevel@tonic-gate 	if (digit > '9') digit |= 0x20;
10527c478bd9Sstevel@tonic-gate 	if (((digit < '0') || (digit > base)) ||
10537c478bd9Sstevel@tonic-gate 	    ((digit > '9') && (digit < 'a') && (num_base > 10)))
10547c478bd9Sstevel@tonic-gate 		error = 1;
10557c478bd9Sstevel@tonic-gate 	else {
10567c478bd9Sstevel@tonic-gate 		if (digit <= '9')
10577c478bd9Sstevel@tonic-gate 			digit -= '0';
10587c478bd9Sstevel@tonic-gate 		else
10597c478bd9Sstevel@tonic-gate 			digit = digit - 'a' + 10;
10607c478bd9Sstevel@tonic-gate 		*dptr = digit;
10617c478bd9Sstevel@tonic-gate 	}
10627c478bd9Sstevel@tonic-gate 	return (error);
10637c478bd9Sstevel@tonic-gate }
10647c478bd9Sstevel@tonic-gate 
10657c478bd9Sstevel@tonic-gate void
dollar_number(fcode_env_t * env)10667c478bd9Sstevel@tonic-gate dollar_number(fcode_env_t *env)
10677c478bd9Sstevel@tonic-gate {
10687c478bd9Sstevel@tonic-gate 	char *buf;
10697c478bd9Sstevel@tonic-gate 	fstack_t value;
10707c478bd9Sstevel@tonic-gate 	int len, sign = 1, error = 0;
10717c478bd9Sstevel@tonic-gate 
10727c478bd9Sstevel@tonic-gate 	CHECK_DEPTH(env, 2, "$number");
10737c478bd9Sstevel@tonic-gate 	buf = pop_a_string(env, &len);
10747c478bd9Sstevel@tonic-gate 	if (*buf == '-') {
10757c478bd9Sstevel@tonic-gate 		sign = -1;
10767c478bd9Sstevel@tonic-gate 		buf++;
10777c478bd9Sstevel@tonic-gate 		len--;
10787c478bd9Sstevel@tonic-gate 	}
10797c478bd9Sstevel@tonic-gate 	value = 0;
10807c478bd9Sstevel@tonic-gate 	while (len-- && !error) {
10817c478bd9Sstevel@tonic-gate 		fstack_t digit;
10827c478bd9Sstevel@tonic-gate 
10837c478bd9Sstevel@tonic-gate 		if (*buf == '.') {
10847c478bd9Sstevel@tonic-gate 			buf++;
10857c478bd9Sstevel@tonic-gate 			continue;
10867c478bd9Sstevel@tonic-gate 		}
10877c478bd9Sstevel@tonic-gate 		value *= env->num_base;
10887c478bd9Sstevel@tonic-gate 		error = is_digit(*buf++, env->num_base, &digit);
10897c478bd9Sstevel@tonic-gate 		value += digit;
10907c478bd9Sstevel@tonic-gate 	}
10917c478bd9Sstevel@tonic-gate 	if (error) {
10927c478bd9Sstevel@tonic-gate 		PUSH(DS, -1);
10937c478bd9Sstevel@tonic-gate 	} else {
10947c478bd9Sstevel@tonic-gate 		value *= sign;
10957c478bd9Sstevel@tonic-gate 		PUSH(DS, value);
10967c478bd9Sstevel@tonic-gate 		PUSH(DS, 0);
10977c478bd9Sstevel@tonic-gate 	}
10987c478bd9Sstevel@tonic-gate }
10997c478bd9Sstevel@tonic-gate 
11007c478bd9Sstevel@tonic-gate void
digit(fcode_env_t * env)11017c478bd9Sstevel@tonic-gate digit(fcode_env_t *env)
11027c478bd9Sstevel@tonic-gate {
11037c478bd9Sstevel@tonic-gate 	fstack_t base;
11047c478bd9Sstevel@tonic-gate 	fstack_t value;
11057c478bd9Sstevel@tonic-gate 
11067c478bd9Sstevel@tonic-gate 	CHECK_DEPTH(env, 2, "digit");
11077c478bd9Sstevel@tonic-gate 	base = POP(DS);
11087c478bd9Sstevel@tonic-gate 	if (is_digit(TOS, base, &value))
11097c478bd9Sstevel@tonic-gate 		PUSH(DS, 0);
11107c478bd9Sstevel@tonic-gate 	else {
11117c478bd9Sstevel@tonic-gate 		TOS = value;
11127c478bd9Sstevel@tonic-gate 		PUSH(DS, -1);
11137c478bd9Sstevel@tonic-gate 	}
11147c478bd9Sstevel@tonic-gate }
11157c478bd9Sstevel@tonic-gate 
11167c478bd9Sstevel@tonic-gate void
space(fcode_env_t * env)11177c478bd9Sstevel@tonic-gate space(fcode_env_t *env)
11187c478bd9Sstevel@tonic-gate {
11197c478bd9Sstevel@tonic-gate 	PUSH(DS, ' ');
11207c478bd9Sstevel@tonic-gate }
11217c478bd9Sstevel@tonic-gate 
11227c478bd9Sstevel@tonic-gate void
backspace(fcode_env_t * env)11237c478bd9Sstevel@tonic-gate backspace(fcode_env_t *env)
11247c478bd9Sstevel@tonic-gate {
11257c478bd9Sstevel@tonic-gate 	PUSH(DS, '\b');
11267c478bd9Sstevel@tonic-gate }
11277c478bd9Sstevel@tonic-gate 
11287c478bd9Sstevel@tonic-gate void
bell(fcode_env_t * env)11297c478bd9Sstevel@tonic-gate bell(fcode_env_t *env)
11307c478bd9Sstevel@tonic-gate {
11317c478bd9Sstevel@tonic-gate 	PUSH(DS, '\a');
11327c478bd9Sstevel@tonic-gate }
11337c478bd9Sstevel@tonic-gate 
11347c478bd9Sstevel@tonic-gate void
fc_bounds(fcode_env_t * env)11357c478bd9Sstevel@tonic-gate fc_bounds(fcode_env_t *env)
11367c478bd9Sstevel@tonic-gate {
11377c478bd9Sstevel@tonic-gate 	fstack_t lo, hi;
11387c478bd9Sstevel@tonic-gate 
11397c478bd9Sstevel@tonic-gate 	CHECK_DEPTH(env, 2, "bounds");
11407c478bd9Sstevel@tonic-gate