usr/src/lib/efcode/engine/prims64.c

   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 }