src/ops/experimental.ops

   1 /*
   2  * $Id$
   3 ** experimental.ops
   4 */
   5
   6 VERSION = PARROT_VERSION;
   7
   8 =head1 NAME
   9
  10 experimental.ops - Experimental Operations
  11
  12 =cut
  13
  14 =head1 DESCRIPTION
  15
  16 This file contains operations that are in an experimental state. Do not
  17 rely upon the existence of the ops in this file when writing production code.
  18 No decision has yet been made as to whether they are accepted as regular
  19 Parrot ops or not. They are included here for testing purposes only!
  20
  21 =cut
  22
  23 ###############################################################################
  24
  25 =head2 Mathematical operations
  26
  27 Implementations of various mathematical operations
  28
  29 =over 4
  30
  31 =cut
  32
  33 ########################################
  34
  35 =item B<gcd>(out INT, in NUM, in NUM)
  36
  37 Greatest Common divisor of $2 and $3.
  38
  39 =item B<gcd>(out INT, out INT, out INT, in INT, in INT)
  40
  41 Given $4 and $5, it calculates $1, $2 and $3 so that
  42
  43 $1 = gcd($4, $5) = $2 * $4 + $3 * $5 (d = gcd(a, b) = x*a + y*b)
  44
  45 =cut
  46
  47 inline op gcd(out INT, in NUM, in NUM) :advanced_math {
  48
  49   FLOATVAL q     = 0;
  50   FLOATVAL c     = 0;
  51   FLOATVAL temp2 = fabs($2);
  52   FLOATVAL temp3 = fabs($3);
  53
  54   while (!FLOAT_IS_ZERO(temp3)) {
  55     q     = floor((FLOATVAL)temp2/temp3);
  56     c     = temp2 - temp3*q;
  57     temp2 = temp3;
  58     temp3 = c;
  59   }
  60
  61   $1 = (INTVAL)temp2;
  62 }
  63
  64 inline op gcd(out INT, out INT, out INT, in INT, in INT) :advanced_math {
  65   /* r0 = q1*r1 + r2 */
  66   INTVAL r0 = $4 < 0 ? -$4 : $4;
  67   INTVAL r1 = $5 < 0 ? -$5 : $5;
  68   INTVAL r2 = 0;
  69   INTVAL q1 = 0;
  70
  71   INTVAL xkm1 = 1;
  72   INTVAL xk = 0;
  73   INTVAL xkp1 = 0;
  74
  75   INTVAL ykm1 = 0;
  76   INTVAL yk = 1;
  77   INTVAL ykp1 = 0;
  78
  79   INTVAL n = 1;
  80
  81   INTVAL x;
  82   INTVAL y;
  83
  84   while (1) {
  85     q1 = r0/r1;
  86     r2 = r0 - q1*r1;
  87     if (r2 == 0) {
  88       break;
  89     }
  90     r0 = r1;
  91     r1 = r2;
  92
  93     xkp1 = q1*xk + xkm1;
  94     xkm1 = xk;
  95     xk = xkp1;
  96
  97     ykp1 = q1*yk + ykm1;
  98     ykm1 = yk;
  99     yk = ykp1;
 100   }
 101   $1 = r1;
 102   $2 = (INTVAL)(xk * pow(-1, n));
 103   $3 = (INTVAL)(yk * pow(-1, n+1));
 104
 105   x = $2 * $4;
 106   y = $3 * $5;
 107
 108   /* correct the sign (can be wrong because we used abs($4) and abs($5) */
 109   if (x + y == r1) {
 110     /* no correction necessary */
 111   }
 112   else if (x + y == -r1) {
 113     $2 = -$2;
 114     $3 = -$3;
 115   }
 116   else if (x - y == r1) {
 117     $3 = -$3;
 118   }
 119   else if (-x + y == r1) {
 120     $2 = -$2;
 121   }
 122 }
 123
 124 =back
 125
 126 =cut
 127
 128 ###############################################################################
 129
 130 =head2 Misc other ops
 131
 132 =over 4
 133
 134 =cut
 135
 136 =item B<splice>(invar PMC, invar PMC, in INT, in INT)
 137
 138 Replace $4 values at offset $3 in aggregate $1 with the PMCs in aggregate $2.
 139 The values are put into the aggregate by a shallow copy. If the values would
 140 be reused, they have to be B<clone>d.
 141
 142 =cut
 143
 144 inline op splice(invar PMC, invar PMC, in INT, in INT) {
 145     VTABLE_splice(interp, $1, $2, $3, $4);
 146 }
 147
 148
 149 =item B<slice>(out PMC, invar PMC, in KEY)
 150
 151 Return a new Iterator PMC $1 for aggregate $2 and Slice PMC $3.
 152
 153 =item B<slice>(out PMC, invar PMC, in KEY, inconst INT)
 154
 155 Return a new list PMC $1 for aggregate $2 and Slice PMC $3.
 156
 157 This is a Python opcode. Range is i <= k < j. $4 must be 1.
 158 May change and move to python.ops.
 159
 160 =item B<iter>(out PMC, invar PMC)
 161
 162 Return a new Iterator PMC $1 for aggregate $2.
 163
 164 =cut
 165
 166 inline op slice(out PMC, invar PMC, in KEY) :base_core {
 167     $1 = VTABLE_slice(interp, $2, $3, 0);
 168 }
 169
 170 inline op slice(out PMC, invar PMC, in KEY, inconst INT) :python {
 171     $1 = VTABLE_slice(interp, $2, $3, $4);
 172 }
 173
 174 inline op iter(out PMC, invar PMC) :base_core {
 175     $1 = VTABLE_get_iter(interp, $2);
 176 }
 177
 178 ########################################
 179
 180 =item B<morph>(invar PMC, in INT)
 181
 182 =item B<morph>(invar PMC, in STR)
 183
 184 Have $1 turn itself into a PMC of type $2.
 185
 186 =cut
 187
 188 inline op morph(invar PMC, in INT) {
 189   VTABLE_morph(interp, $1, $2);
 190 }
 191
 192 inline op morph(invar PMC, in STR) {
 193   INTVAL type = pmc_type(interp, $2);
 194   VTABLE_morph(interp, $1, type);
 195 }
 196
 197 =item B<exec>(in STR)
 198
 199 Execute the passed-in command. Completely tosses the current process
 200 image and replaces it with the command. Doesn't exit (the program
 201 ends, after all), though it does throw an exception if something goes
 202 wrong.
 203
 204 =cut
 205
 206 inline op exec(in STR) {
 207   Parrot_Exec_OS_Command(interp, $1);
 208 }
 209
 210
 211 =item B<classname>(out PMC, invar PMC)
 212
 213 Get the class name for the class in $2 and put it in $1. Note that $1 will be
 214 a Key PMC that you can use with "new", for example.
 215
 216 =cut
 217
 218 op classname(out PMC, invar PMC) :object_base {
 219     PMC *ns = Parrot_ns_get_name(interp,
 220                                     VTABLE_get_namespace(interp, $2));
 221     if (PMC_IS_NULL(ns) || VTABLE_elements(interp, ns) < 2)
 222     {
 223         real_exception(interp, NULL, NO_CLASS,
 224             "Attempt to get class name of a non-class.");
 225     }
 226     else
 227     {
 228         PMC *key_tail, *key;
 229         STRING *tmp;
 230         int i, max;
 231
 232         /* Need to turn list of strings into a key. Note that we are not
 233            including the first item in the array, since that is the HLL. */
 234         tmp = VTABLE_get_string_keyed_int(interp, ns, 1);
 235         $1 = key_tail = key_new_string(interp, tmp);
 236         max = VTABLE_elements(interp, ns);
 237         for (i = 2; i < max; i++)
 238         {
 239             tmp = VTABLE_get_string_keyed_int(interp, ns, i);
 240             key = key_new_string(interp, tmp);
 241             key_append(interp, key_tail, key);
 242             key_tail = key;
 243         }
 244     }
 245 }
 246
 247 =back
 248
 249 =head2 More Experimental Ops
 250
 251 =over 4
 252
 253 =item C<trap>
 254
 255 Break into debugger. Implementation notes:
 256
 257  - x86/gcc ... works with gdb
 258  - ppc/gcc ... works with gdb, to proceed: gdb> p $pc = $pc + 4
 259  - TODO
 260
 261 For other architectures, this is a C<noop>.
 262
 263 =cut
 264
 265 op trap() {
 266 #if defined(__GNUC__) && defined(i386)
 267     __asm__("int3");       /* opcode 0xcc */
 268 #endif
 269 #if defined(__GNUC__) && defined(PPC)
 270     __asm__("trap");       /* opcode tr 31, 0, 0 */
 271 #endif
 272 }
 273
 274 =item B<pow>(out NUM, in NUM, in INT)
 275
 276 Set $1 to $2 raised to the power $3.
 277
 278 =cut
 279
 280 inline op pow(out NUM, in NUM, in INT) :base_core {
 281     FLOATVAL n2 = $2;
 282     FLOATVAL res = 1.0;
 283     INTVAL   e  = $3;
 284     int s = 1;
 285     if (e != 0) {
 286         if (e < 0) {
 287             s = -1;
 288             e = -e;
 289         }
 290     }
 291     while (e) {
 292         if (e & 1) {
 293             res *= n2;
 294         }
 295         n2 *= n2;
 296         e >>= 1;
 297     }
 298     if (s < 0) {
 299         res = 1.0/res;
 300     }
 301     $1 = res;
 302 }
 303
 304 =item B<new>(out PMC, in INT, in STR)
 305
 306 Create a new PMC of the type $2 according to the PMCs string representation
 307 in $3.
 308
 309 BUT SINCE INSTANTIATE WILL PROBABLY DIE, DON'T USE THIS;
 310 OR IF YOU NEED THIS (OR INSTANTIATE), TELL CHIP
 311
 312 =cut
 313
 314 op new(out PMC, in INT, in STR) {
 315   PMC *_class;
 316   if ($2 <= 0 || $2 >= interp->n_vtable_max) {
 317     real_exception(interp, 0, NO_CLASS,
 318                    "Illegal PMC enum (%d) in new", (int)$2);
 319   }
 320   _class = interp->vtables[$2]->pmc_class;
 321   $1 = VTABLE_new_from_string(interp, _class, $3, 0);
 322 }
 323
 324 ########################################
 325
 326 =item B<add_io_event>(invar PMC, invar PMC, invar PMC, inconst INT)
 327
 328 Call the sub $2 for PIO $1 with user data $3 on ready state of $4.
 329 RT#42376 The only handled $4 = IO_THR_MSG_ADD_SELECT_RD aka 2 for now.
 330
 331 =cut
 332
 333 op add_io_event(invar PMC, invar PMC, invar PMC, inconst INT) {
 334     Parrot_event_add_io_event(interp, $1, $2, $3, $4);
 335 }
 336
 337 =item B<need_finalize>(invar PMC)
 338
 339 The ParrotObject $1 needs the __finalize method during GC.
 340
 341 =cut
 342
 343 op need_finalize(invar PMC) {
 344     PMC* pmc = $1;
 345     if (PObj_is_object_TEST(pmc)) {
 346         PObj_get_FLAGS(pmc) |= PObj_need_finalize_FLAG;
 347     }
 348 }
 349
 350 #########################################
 351
 352 =item B<setstdout>(invar PMC)
 353
 354 Sets the standard output for a bare C<print> op to go to the supplied ParrotIO
 355 PMC.  Call C<getstdout> first if you care about retaining the previous PMC.
 356
 357 =item B<setstderr>(invar PMC)
 358
 359 Sets the standard error for a bare C<printerr> op to go to the supplied
 360 ParrotIO PMC.  Call C<getstderr> first if you care about retaining the previous
 361 PMC.
 362
 363 =cut
 364
 365 inline op setstdout(invar PMC) :base_io {
 366         _PIO_STDOUT(interp) = $1;
 367 }
 368
 369 inline op setstderr(invar PMC) :base_io {
 370         _PIO_STDERR(interp) = $1;
 371 }
 372
 373
 374 ########################################
 375
 376 =item B<runinterp>(invar PMC, in PMC)
 377
 378 Invokes the PMC $2 using interp $1.
 379
 380 =cut
 381
 382 op runinterp(invar PMC, in PMC) {
 383     Interp * const new_interp = (Interp *)PMC_data($1);
 384     opcode_t *pc;
 385     Interp_flags_SET(new_interp, PARROT_EXTERN_CODE_FLAG);
 386     pc = (opcode_t *)VTABLE_invoke(new_interp, $2, NULL);
 387     UNUSED(pc);
 388     Parrot_runops_fromc_args(new_interp, $2, "P");
 389 }
 390
 391 ########################################
 392
 393 =item B<substr_r>(out STR, in STR, in INT, in INT)
 394
 395 Make $1 refer to the given part of $2, basically like above, but it
 396 is reusing the given destination string and does not care if the
 397 source string is changed later. This I<is changed> includes
 398 also GC runs, which will move the referenced string. This also
 399 means that $1 has to be reset before any GC may happen.
 400
 401 This opcode should really be just used to quickly refer to a substring of
 402 another part, e.g. for printing and is a temporary hack.
 403
 404 B<Handle with care.>
 405
 406 =cut
 407
 408 inline op substr_r(out STR, in STR, in INT, in INT) :base_core {
 409   STRING *dest = $1;
 410   if (!dest)
 411     dest = new_string_header(interp, 0);
 412   $1 = string_substr(interp, $2, $3, $4, &dest, 1);
 413 }
 414
 415 =item C<find_sub_not_null>(out PMC, in STR)
 416
 417 inline op find_sub_not_null(out PMC, in STR) :base_core {
 418     PMC *sub = Parrot_find_name_op(interp, $2, expr NEXT());
 419
 420     if (PMC_IS_NULL(sub))
 421         real_exception(interp, NULL, GLOBAL_NOT_FOUND,
 422                        "Could not find non-existent sub %Ss", $2);
 423
 424     $1 = sub;
 425 }
 426
 427 =back
 428
 429 =head1 COPYRIGHT
 430
 431 Copyright (C) 2001-2008, The Perl Foundation.
 432
 433 =head1 LICENSE
 434
 435 This program is free software. It is subject to the same license
 436 as the Parrot interp itself.
 437
 438 =cut
 439
 440
 441 /*
 442  * Local variables:
 443  *   c-file-style: "parrot"
 444  * End:
 445  * vim: expandtab shiftwidth=4:
 446  */