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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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