src/utils.c

   1 /*
   2 Copyright (C) 2001-2008, The Perl Foundation.
   3 $Id$
   4
   5 =head1 NAME
   6
   7 src/utils.c - Some utility functions
   8
   9 =head1 DESCRIPTION
  10
  11 Prototypes are in F<src/misc.h>.
  12
  13 Opcode helper functions that don't really fit elsewhere.
  14
  15 =head2 Functions
  16
  17 =over 4
  18
  19 =cut
  20
  21 */
  22
  23 #include "parrot/parrot.h"
  24
  25 typedef unsigned short _rand_buf[3];
  26
  27 /* Parrot_register_move companion functions i and data */
  28 typedef struct parrot_prm_context {
  29     unsigned char *dest_regs;
  30     unsigned char *src_regs;
  31     unsigned char temp_reg;
  32     int* nb_succ;
  33     int* backup;
  34     int* reg_to_index;
  35     Interp *interp;
  36     reg_move_func mov;
  37     reg_move_func mov_alt;
  38     void *info;
  39 } parrot_prm_context;
  40
  41 /* HEADERIZER HFILE: include/parrot/misc.h */
  42 /* HEADERIZER BEGIN: static */
  43 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END.  Your changes will be lost. */
  44
  45 static FLOATVAL _drand48(void);
  46 static FLOATVAL _erand48(_rand_buf buf);
  47 static long _jrand48(_rand_buf buf);
  48 static long _lrand48(void);
  49 static long _mrand48(void);
  50 static long _nrand48(_rand_buf buf);
  51 static void _srand48(long seed);
  52 static INTVAL COMPARE(PARROT_INTERP, void *a, void *b, PMC *cmp)
  53         __attribute__nonnull__(1);
  54
  55 static void next_rand(_rand_buf X);
  56 static void process_cycle_without_exit(
  57     int node_index,
  58     ARGIN(parrot_prm_context* c))
  59         __attribute__nonnull__(2);
  60
  61 static void rec_climb_back_and_mark(
  62     int node_index,
  63     ARGIN(parrot_prm_context* c))
  64         __attribute__nonnull__(2);
  65
  66 static void swap(void **x, void **y);
  67 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END.  Your changes will be lost. */
  68 /* HEADERIZER END: static */
  69
  70 #define move_reg(from, dest, c) (c)->mov((c)->interp, (unsigned char)(dest), \
  71                                          (unsigned char)(from), (c)->info)
  72
  73 /*
  74
  75 =item C<INTVAL intval_mod>
  76
  77 NOTE: This "corrected mod" algorithm is based on the C code on page 70
  78 of [1]. Assuming correct behavior of the built-in mod operator (%) with
  79 positive arguments, this algorithm implements a mathematically
  80 convenient version of mod, defined thus:
  81
  82     x mod y = x - y * floor(x / y)
  83
  84 For more information on this definition of mod, see section 3.4 of [2],
  85 pages 81-85.
  86
  87 References:
  88
  89 [1] Donald E. Knuth, *MMIXware: A RISC Computer for the Third
  90 Millennium* Springer, 1999.
  91
  92 [2] Ronald L. Graham, Donald E. Knuth and Oren Patashnik, *Concrete
  93 Mathematics*, Second Edition. Addison-Wesley, 1994.
  94
  95 =cut
  96
  97 */
  98
  99 PARROT_CONST_FUNCTION
 100 INTVAL
 101 intval_mod(INTVAL i2, INTVAL i3)
 102 {
 103     INTVAL z = i3;
 104
 105     if (z == 0)
 106         return i2;
 107     else {
 108         INTVAL r;
 109         INTVAL y;
 110         int s = 0;
 111
 112         y = i2;
 113
 114         if (y < 0) { s += 2; y = -y; }
 115         if (z < 0) { s += 1; z = -z; }
 116
 117         r = y % z;
 118
 119         if (r) {    /* # 36003 */
 120             switch (s) {
 121                 case 0:            break;
 122                 case 1: r = r - z; break;
 123                 case 2: r = z - r; break;
 124                 case 3: r = -r;    break;
 125                 default:           break;
 126             }
 127         }
 128
 129         return r;
 130     }
 131 }
 132
 133 /*
 134
 135 =item C<FLOATVAL floatval_mod>
 136
 137 Returns C<n2 mod n3>.
 138
 139 Includes a workaround for buggy code generation in the C<lcc> compiler.
 140
 141 =cut
 142
 143 */
 144
 145 PARROT_CONST_FUNCTION
 146 FLOATVAL
 147 floatval_mod(FLOATVAL n2, FLOATVAL n3)
 148 {
 149 #ifdef __LCC__
 150
 151   /* Another workaround for buggy code generation in the lcc compiler-
 152    * adding a temporary variable makes it pass the test.
 153    */
 154   const FLOATVAL temp = n3 * floor(n2 / n3);
 155
 156   return !FLOAT_IS_ZERO(n3)
 157      ? (n2 - temp)
 158      : n2;
 159 #else
 160   return !FLOAT_IS_ZERO(n3)
 161      ? (n2 - n3 * floor(n2 / n3))
 162      : n2;
 163 #endif
 164 }
 165
 166
 167 /*
 168
 169 =back
 170
 171 =head2 Random Number Generator
 172
 173 Based on the C<rand48()> family of functions.
 174
 175 =over 4
 176
 177 =cut
 178
 179 */
 180
 181 /*
 182  * currently undefined
 183  */
 184 #ifndef PARROT_HAS_DRAND48
 185
 186 /*
 187  * s. man drand48, SuS V2
 188  *
 189  * X(n+1) = ( aX(n) + c ) mod 2^48
 190  *
 191  */
 192 #  define A_lo  0xE66D
 193 #  define A_mid 0xDEEC
 194 #  define A_hi  0x5
 195 #  define C     0xB
 196 #  define SEED_LO 0x330E
 197
 198 static _rand_buf a = { A_lo, A_mid, A_hi };
 199 static _rand_buf last_rand;
 200 static unsigned short c = C;
 201
 202 /*
 203
 204 =item C<static void next_rand>
 205
 206 Returns the next random number in C<X>.
 207
 208 =cut
 209
 210 */
 211
 212 static void
 213 next_rand(_rand_buf X)
 214 {
 215     unsigned short lo, mid, hi;
 216     unsigned int t;
 217
 218     /* 48 bit mul, one short at a time */
 219     t = X[0] * a[0] + c;
 220     lo = t & 0xffff;
 221     mid = (t >> 16) & 0xffff;
 222
 223     t = X[1] * a[0] + X[0] * a[1] + mid;
 224     mid = t & 0xffff;
 225     hi = (t >> 16) & 0xffff;
 226
 227     t = X[2] * a[0] + X[1] * a[1] + X[0] * a[2] + hi;
 228
 229     X[0] = lo;
 230     X[1] = mid;
 231     X[2] = t & 0xffff;
 232 }
 233
 234 /*
 235
 236 =item C<static FLOATVAL _erand48>
 237
 238 Returns a C<double> in the interval C<[0.0, 1.0)>.
 239
 240 =cut
 241
 242 */
 243
 244 static FLOATVAL
 245 _erand48(_rand_buf buf)
 246 {
 247     FLOATVAL r;
 248     next_rand(buf);
 249     r = ((buf[0] / 65536.0 + buf[1]) / 65536.0 + buf[2]) / 65536.0;
 250     return r;
 251 }
 252
 253 /*
 254
 255 =item C<static FLOATVAL _drand48>
 256
 257 Returns a C<double> in the interval C<[0.0, 1.0)>.
 258
 259 =cut
 260
 261 */
 262
 263 static FLOATVAL
 264 _drand48(void)
 265 {
 266     return _erand48(last_rand);
 267 }
 268
 269 /*
 270
 271 =item C<static long _jrand48>
 272
 273 Returns a C<long> in the interval C<[-2^31, 2^31)>.
 274
 275 =cut
 276
 277 */
 278
 279 static long
 280 _jrand48(_rand_buf buf)
 281 {
 282     long ret;
 283     next_rand(buf);
 284     ret = buf[2] << 16 | buf[1];
 285     return ret;
 286 }
 287
 288 /*
 289
 290 =item C<static long _nrand48>
 291
 292 Returns a C<long> in the interval C<[0, 2^31)>.
 293
 294 =cut
 295
 296 */
 297
 298 static long
 299 _nrand48(_rand_buf buf)
 300 {
 301     return _jrand48(buf) & 0x7fffffff;
 302 }
 303
 304 /*
 305
 306 =item C<static long _lrand48>
 307
 308 Returns a C<long> in the interval C<[0, 2^31)>.
 309
 310 =cut
 311
 312 */
 313
 314 static long
 315 _lrand48(void)
 316 {
 317     return _nrand48(last_rand);
 318 }
 319
 320 /*
 321
 322 =item C<static long _mrand48>
 323
 324 Returns a C<long> in the interval C<[-2^31, 2^31)>.
 325
 326 =cut
 327
 328 */
 329
 330 static long
 331 _mrand48(void)
 332 {
 333     return _jrand48(last_rand);
 334 }
 335
 336 /*
 337
 338 =item C<static void _srand48>
 339
 340 Sets the high order 32 bits to the argument C<seed>. The low order 16
 341 bits are set to the arbitrary value 0x330e.
 342
 343 =cut
 344
 345 */
 346
 347 static void
 348 _srand48(long seed)
 349 {
 350     last_rand[0] = SEED_LO;
 351     last_rand[1] = (unsigned short)seed & 0xffff;
 352     last_rand[2] = (unsigned short)(seed >> 16) & 0xffff;
 353     /*
 354      * reinit a, c if changed by lcong48()
 355      */
 356 }
 357
 358 #  undef A_lo
 359 #  undef A_mid
 360 #  undef A_hi
 361 #  undef C
 362
 363 #else
 364
 365 #  define _drand48 drand48
 366 #  define _erand48(b) erand48(b)
 367
 368 #  define _lrand48 lrand48
 369 #  define _nrand48(b) nrand48(b)
 370
 371 #  define _mrand48 mrand48
 372 #  define _jrand48(b) jrand48(b)
 373
 374 #  define _srand48 srand48
 375
 376 #endif
 377
 378 /*
 379
 380 =item C<FLOATVAL Parrot_float_rand>
 381
 382 Returns a C<FLOATVAL> in the interval C<[0.0, 1.0)>.
 383
 384 C<how_random> is ignored.
 385
 386 =cut
 387
 388 */
 389
 390 PARROT_API
 391 FLOATVAL
 392 Parrot_float_rand(INTVAL how_random)
 393 {
 394     UNUSED(how_random);
 395
 396     return _drand48();          /* [0.0..1.0] */
 397 }
 398
 399 /*
 400
 401 =item C<INTVAL Parrot_uint_rand>
 402
 403 Returns an C<INTVAL> in the interval C<[0, 2^31)>.
 404
 405 C<how_random> is ignored.
 406
 407 =cut
 408
 409 */
 410
 411 PARROT_API
 412 INTVAL
 413 Parrot_uint_rand(INTVAL how_random)
 414 {
 415     UNUSED(how_random);
 416
 417     return _lrand48();          /* [0..2^31] */
 418 }
 419
 420 /*
 421
 422 =item C<INTVAL Parrot_int_rand>
 423
 424 Returns an C<INTVAL> in the interval C<[-2^31, 2^31)>.
 425
 426 C<how_random> is ignored.
 427
 428 =cut
 429
 430 */
 431
 432 PARROT_API
 433 INTVAL
 434 Parrot_int_rand(INTVAL how_random)
 435 {
 436     UNUSED(how_random);
 437
 438     return _mrand48();          /* [-2^31..2^31] */
 439 }
 440
 441 /*
 442
 443 =item C<INTVAL Parrot_range_rand>
 444
 445 Returns an C<INTVAL> in the range C<[from, to]>.
 446
 447 C<how_random> is ignored.
 448
 449 =cut
 450
 451 */
 452
 453 PARROT_API
 454 INTVAL
 455 Parrot_range_rand(INTVAL from, INTVAL to, INTVAL how_random)
 456 {
 457     return (INTVAL)(from + ((double)(to - from))
 458                      * Parrot_float_rand(how_random));
 459 }
 460
 461 /*
 462
 463 =item C<void Parrot_srand>
 464
 465 Seeds the random number generator with C<seed>.
 466
 467 =cut
 468
 469 */
 470
 471 PARROT_API
 472 void
 473 Parrot_srand(INTVAL seed)
 474 {
 475     _srand48(seed);
 476 }
 477
 478
 479 /* &gen_from_enum(tm.pasm) */
 480 typedef enum {
 481     TM_SEC,
 482     TM_MIN,
 483     TM_HOUR,
 484     TM_MDAY,
 485     TM_MON,
 486     TM_YEAR,
 487     TM_WDAY,
 488     TM_YDAY,
 489     TM_ISDST
 490 } tm_struct_enum;
 491 /* &end_gen */
 492
 493 /*
 494
 495 =item C<PMC* tm_to_array>
 496
 497 Helper to convert a B<struct tm *> to an Array
 498
 499 =cut
 500
 501 */
 502
 503 PARROT_WARN_UNUSED_RESULT
 504 PARROT_CANNOT_RETURN_NULL
 505 PMC*
 506 tm_to_array(PARROT_INTERP, ARGIN(const struct tm *tm))
 507 {
 508     PMC * const Array = pmc_new(interp, enum_class_Array);
 509
 510     PARROT_ASSERT(tm);
 511
 512     VTABLE_set_integer_native(interp, Array, 9);
 513     VTABLE_set_integer_keyed_int(interp, Array, 0, tm->tm_sec);
 514     VTABLE_set_integer_keyed_int(interp, Array, 1, tm->tm_min);
 515     VTABLE_set_integer_keyed_int(interp, Array, 2, tm->tm_hour);
 516     VTABLE_set_integer_keyed_int(interp, Array, 3, tm->tm_mday);
 517     VTABLE_set_integer_keyed_int(interp, Array, 4, tm->tm_mon + 1);
 518     VTABLE_set_integer_keyed_int(interp, Array, 5, tm->tm_year + 1900);
 519     VTABLE_set_integer_keyed_int(interp, Array, 6, tm->tm_wday);
 520     VTABLE_set_integer_keyed_int(interp, Array, 7, tm->tm_yday);
 521     VTABLE_set_integer_keyed_int(interp, Array, 8, tm->tm_isdst);
 522
 523     return Array;
 524 }
 525
 526 /*
 527
 528 =item C<INTVAL Parrot_byte_index>
 529
 530 Looks for the location of a substring within a longer string.  Takes
 531 pointers to the strings and the offset within the string at which
 532 to start searching as arguments.
 533
 534 Returns an offset value if it is found, or -1 if no match.
 535
 536 =cut
 537
 538 */
 539
 540 PARROT_API
 541 INTVAL
 542 Parrot_byte_index(SHIM_INTERP, ARGIN(const STRING *base),
 543         ARGIN(const STRING *search), UINTVAL start_offset)
 544 {
 545     const char * const str_start  = base->strstart;
 546     const INTVAL       str_len    = base->strlen;
 547     const char * const search_str = search->strstart;
 548     const INTVAL       search_len = search->strlen;
 549     const char        *str_pos    = str_start + start_offset;
 550     INTVAL             len_remain = str_len   - start_offset;
 551     const char        *search_pos;
 552
 553     /* find the next position of the first character in the search string
 554      * Parrot strings can have NULLs, so strchr() won't work here */
 555     while ((search_pos = (const char *)memchr(str_pos, *search_str, len_remain))) {
 556         const INTVAL offset = search_pos - str_start;
 557
 558         /* now look for the entire string */
 559         if (memcmp(search_pos, search_str, search_len) == 0)
 560             return offset;
 561
 562         /* otherwise loop and memchr() with the rest of the string */
 563         len_remain = str_len    - offset;
 564         str_pos    = search_pos + 1;
 565
 566         if (len_remain < search_len)
 567             return -1;
 568     }
 569
 570     return -1;
 571 }
 572
 573 /*
 574
 575 =item C<INTVAL Parrot_byte_rindex>
 576
 577 Substring search (like Parrot_byte_index), but works backwards,
 578 from the rightmost end of the string.
 579
 580 Returns offset value or -1 (if no match).
 581
 582 =cut
 583
 584 */
 585
 586 PARROT_API
 587 PARROT_WARN_UNUSED_RESULT
 588 INTVAL
 589 Parrot_byte_rindex(SHIM_INTERP, ARGIN(const STRING *base),
 590         ARGIN(const STRING *search), UINTVAL start_offset)
 591 {
 592     const INTVAL searchlen          = search->strlen;
 593     const char * const search_start = search->strstart;
 594     UINTVAL max_possible_offset     = (base->strlen - search->strlen);
 595     INTVAL current_offset;
 596
 597     if (start_offset && start_offset < max_possible_offset)
 598         max_possible_offset = start_offset;
 599
 600     for (current_offset = max_possible_offset; current_offset >= 0;
 601             current_offset--) {
 602         const char * const base_start = (char *)base->strstart + current_offset;
 603         if (memcmp(base_start, search_start, searchlen) == 0) {
 604             return current_offset;
 605         }
 606     }
 607
 608     return -1;
 609 }
 610
 611 /*
 612
 613 =item C<static void rec_climb_back_and_mark>
 614
 615 Recursive function, used by Parrot_register_move to
 616 climb back the graph of register moves operations.
 617
 618 The node must have a predecessor: it is implicit because if a node has
 619 a node_index, it must have a predecessor because the node_index are the
 620 index of registers in dest_regs[] array, so by definition they have
 621 a corrsponding src_regs register.
 622
 623 Then it emits the move operation with its predecessor, or its backup
 624 if already used/visited.
 625
 626 Then continues the climbing if the predecessor was not modified, anf in that
 627 case marks it, and set node_index as its backup.
 628
 629   node_index  ... the index of a destination (i.e. with a pred.) register
 630   c           ... the graph and all the needed params : the context
 631
 632 =cut
 633
 634 */
 635
 636 static void
 637 rec_climb_back_and_mark(int node_index, ARGIN(parrot_prm_context* c))
 638 {
 639     const int node = c->dest_regs[node_index];
 640     const int pred = c->src_regs[node_index];
 641     const int pred_index = c->reg_to_index[pred];
 642
 643     if (pred_index < 0) { /* pred has no predecessor */
 644         move_reg(pred, node, c);
 645     }
 646     else { /* pred has a predecessor, so may be processed */
 647         const int src = c->backup[pred_index];
 648         if (src < 0) { /* not visited */
 649             move_reg(pred, node, c);
 650             c->backup[pred_index] = node; /* marks pred*/
 651             rec_climb_back_and_mark(pred_index, c);
 652         }
 653         else { /* already visited, use backup instead */
 654             move_reg(src, node, c);
 655         }
 656     }
 657 }
 658
 659
 660 /*
 661
 662 =item C<static void process_cycle_without_exit>
 663
 664 Recursive function, used by Parrot_register_move to handle the case
 665 of cycles without exits, that are cycles of move ops between registers
 666 where each register has exactly one predecessor and one successor
 667
 668 For instance: 1-->2, 2-->3, 3-->1
 669
 670   node_index  ... the index of a destination (i.e. with a pred.) register
 671   c           ... the graph and all the needed params : the context
 672
 673 =cut
 674
 675 */
 676
 677 static void
 678 process_cycle_without_exit(int node_index, ARGIN(parrot_prm_context* c))
 679 {
 680     const int pred = c->src_regs[node_index];
 681
 682     /* let's try the alternate move function*/
 683     const int alt =
 684         c->mov_alt
 685             ? c->mov_alt(c->interp, c->dest_regs[node_index], pred, c->info)
 686             : 0;
 687
 688     if (0 == alt) { /* use temp reg */
 689         move_reg(c->dest_regs[node_index], c->temp_reg, c);
 690         c->backup[node_index] = c->temp_reg;
 691     }
 692     else
 693         c->backup[node_index] = c->dest_regs[node_index];
 694
 695     rec_climb_back_and_mark(node_index, c);
 696 }
 697
 698 /*
 699
 700 =item C<void Parrot_register_move>
 701
 702 Move C<n_regs> from the given register list C<src_regs> to C<dest_regs>.
 703
 704   n_regs    ... amount of registers to move
 705   dest_regs ... list of register numbers 0..255
 706   src_regs  ... list of register numbers 0..255
 707   temp_reg  ... a register number not in one of these lists
 708   mov       ... a register move function to be called to move one register
 709   mov_alt   ... a register move function to be called to move one register
 710                 which triese fetching from an alternate src (or NULLfunc):
 711
 712     (void)  (mov)(interp, dest, src, info);
 713     moved = (mov_alt)(interp, dest, src, info);
 714
 715 Some C<dest_regs> might be the same as C<src_regs>, which makes this a bit
 716 non-trivial, because if the destination is already clobbered, using it
 717 later as source doesn"t work. E.g.
 718
 719   0 <- 1
 720   1 <- 0     # register 0 already clobbered
 721
 722 or
 723
 724   2 <- 0
 725   0 <- 1
 726   3 <- 2      # register 2 already clobbered - reorder moves
 727
 728 To handle such cases, we do:
 729
 730   a) rearrange the order of moves (not possible in the first case)
 731      and/or if that failed:
 732   b) if an alternate move function is available, it may fetch the
 733      source from a different (non-clobbered) location - call it.
 734      if the function returns 0 also use c)
 735   c) if no alternate move function is available, use the temp reg
 736
 737 The amount of register moves should of course be minimal.
 738
 739 TODO The current implementation will not work for following cases
 740
 741 Talked to Leo and he said those cases are not likely (Vishal Soni).
 742 1. I0->I1 I1->I0 I0->I3
 743 2. I1->I2 I3->I2
 744
 745 TODO: Add tests for the above conditions.
 746
 747 =cut
 748
 749 */
 750
 751 PARROT_API
 752 void
 753 Parrot_register_move(PARROT_INTERP,
 754         int n_regs,
 755         ARGOUT(unsigned char *dest_regs),
 756         ARGIN(unsigned char *src_regs),
 757         unsigned char temp_reg,
 758         reg_move_func mov,
 759         reg_move_func mov_alt,
 760         ARGIN(void *info))
 761 {
 762     int i;
 763     int max_reg       = 0;
 764     int* nb_succ      = NULL;
 765     int* backup       = NULL;
 766     int* reg_to_index = NULL;
 767     parrot_prm_context c;
 768
 769     if (n_regs == 0)
 770         return;
 771
 772     if (n_regs == 1) {
 773         if (src_regs[0] != dest_regs[0])
 774             mov(interp, dest_regs[0], src_regs[0], info);
 775         return;
 776     }
 777
 778     c.interp = interp;
 779     c.info = info;
 780     c.mov = mov;
 781     c.mov_alt = mov_alt;
 782     c.src_regs = src_regs;
 783     c.dest_regs = dest_regs;
 784     c.temp_reg = temp_reg;
 785
 786     /* compute max_reg, the max reg number + 1 */
 787     for (i = 0; i < n_regs; i++) {
 788         if (src_regs[i] > max_reg)
 789             max_reg = src_regs[i];
 790         if (dest_regs[i] > max_reg)
 791             max_reg = dest_regs[i];
 792     }
 793     ++max_reg;
 794
 795
 796     /* allocate space for data structures */
 797     /* NOTA: data structures could be kept allocated somewhere waiting to get reused...*/
 798     c.nb_succ      = nb_succ      = mem_allocate_n_zeroed_typed(n_regs, int);
 799     c.backup       = backup       = mem_allocate_n_zeroed_typed(n_regs, int);
 800     c.reg_to_index = reg_to_index = mem_allocate_n_zeroed_typed(max_reg, int);
 801
 802     /* init backup array */
 803     for (i = 0; i < n_regs; i++)
 804         backup[i] = -1;
 805
 806     /* fill in the conversion array between a register number and its index */
 807     for (i = 0; i < max_reg; i++)
 808         reg_to_index[i] = -1;
 809     for (i = 0; i < n_regs; i++) {
 810         const int index = dest_regs[i];
 811         if (index != src_regs[i]) /* get rid of self-assignment */
 812             reg_to_index[index] = i;
 813     }
 814
 815     /* count the nb of successors for each reg index */
 816     for (i = 0; i < n_regs; i++) {
 817         const int index = reg_to_index[ src_regs[i] ];
 818         if (index >= 0) /* not interested in the wells that have no preds */
 819             nb_succ[ index ]++;
 820     }
 821     /* process each well if any */
 822     for (i = 0; i < n_regs; i++) {
 823         if (0 == nb_succ[i]) { /* a well */
 824             rec_climb_back_and_mark(i, &c);
 825         }
 826     }
 827
 828     /* process remaining dest registers not processed */
 829     /* remaining nodes are members of cycles without exits */
 830     for (i = 0; i < n_regs; i++) {
 831         if (0 < nb_succ[i] && 0 > backup[i]) { /* not a well nor visited*/
 832             process_cycle_without_exit(i, &c);
 833         }
 834     }
 835
 836     mem_sys_free(nb_succ);
 837     mem_sys_free(reg_to_index);
 838     mem_sys_free(backup);
 839 }
 840
 841 /* TODO: Macroize swap and COMPARE */
 842 static void
 843 swap(void **x, void **y)
 844 {
 845     void *t = *x;
 846     *x      = *y;
 847     *y      =  t;
 848 }
 849
 850 typedef INTVAL (*sort_func_t)(PARROT_INTERP, void*, void*);
 851
 852 static INTVAL
 853 COMPARE(PARROT_INTERP, void *a, void *b, PMC *cmp)
 854 {
 855     if (PMC_IS_NULL(cmp))
 856         return mmd_dispatch_i_pp(interp, (PMC *)a, (PMC *)b, MMD_CMP);
 857
 858     if (cmp->vtable->base_type == enum_class_NCI) {
 859         const sort_func_t f = (sort_func_t)D2FPTR(PMC_struct_val(cmp));
 860         return f(interp, a, b);
 861     }
 862
 863     return Parrot_runops_fromc_args_reti(interp, cmp, "IPP", a, b);
 864 }
 865
 866
 867 void
 868 Parrot_quicksort(PARROT_INTERP, void **data, UINTVAL n, PMC *cmp)
 869 {
 870     while (n > 1) {
 871         UINTVAL i, j, ln, rn;
 872
 873         swap(&data[0], &data[n/2]);
 874
 875         for (i = 0, j = n; ;) {
 876             do
 877                 --j;
 878
 879             while (j > 0 && COMPARE(interp, data[j], data[0], cmp) > 0);
 880
 881             do
 882                 ++i;
 883             while (i < j && COMPARE(interp, data[i], data[0], cmp) < 0);
 884
 885             if (i >= j)
 886                 break;
 887
 888             swap(&data[i], &data[j]);
 889         }
 890
 891         swap(&data[j], &data[0]);
 892
 893         ln = j;
 894         rn = n - ++j;
 895
 896         if (ln < rn) {
 897             Parrot_quicksort(interp, data, ln, cmp);
 898             data += j;
 899             n = rn;
 900         }
 901         else {
 902             Parrot_quicksort(interp, data + j, rn, cmp);
 903             n = ln;
 904         }
 905     }
 906 }
 907
 908 /*
 909
 910 =back
 911
 912 =head1 HISTORY
 913
 914 Initial version by leo 2003.09.09.
 915
 916 =cut
 917
 918 */
 919
 920
 921 /*
 922  * Local variables:
 923  *   c-file-style: "parrot"
 924  * End:
 925  * vim: expandtab shiftwidth=4:
 926  */