c_cpp/etc/calc/listfunc.c

   1 /*
   2  * listfunc - list handling routines
   3  *
   4  * Copyright (C) 1999-2007  David I. Bell
   5  *
   6  * Calc is open software; you can redistribute it and/or modify it under
   7  * the terms of the version 2.1 of the GNU Lesser General Public License
   8  * as published by the Free Software Foundation.
   9  *
  10  * Calc is distributed in the hope that it will be useful, but WITHOUT
  11  * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
  12  * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General
  13  * Public License for more details.
  14  *
  15  * A copy of version 2.1 of the GNU Lesser General Public License is
  16  * distributed with calc under the filename COPYING-LGPL.  You should have
  17  * received a copy with calc; if not, write to Free Software Foundation, Inc.
  18  * 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
  19  *
  20  * @(#) $Revision: 30.1 $
  21  * @(#) $Id: listfunc.c,v 30.1 2007/03/16 11:09:46 chongo Exp $
  22  * @(#) $Source: /usr/local/src/bin/calc/RCS/listfunc.c,v $
  23  *
  24  * Under source code control:   1990/02/15 01:48:18
  25  * File existed as early as:    before 1990
  26  *
  27  * Share and enjoy!  :-)        http://www.isthe.com/chongo/tech/comp/calc/
  28  */
  29
  30 /*
  31  * List handling routines.
  32  * Lists can be composed of any types of values, mixed if desired.
  33  * Lists are doubly linked so that elements can be inserted or
  34  * deleted efficiently at any point in the list.  A pointer is
  35  * kept to the most recently indexed element so that sequential
  36  * accesses are fast.
  37  */
  38
  39
  40 #include "value.h"
  41 #include "zrand.h"
  42
  43 E_FUNC long irand(long s);
  44
  45 S_FUNC LISTELEM *elemalloc(void);
  46 S_FUNC void elemfree(LISTELEM *ep);
  47 S_FUNC void removelistelement(LIST *lp, LISTELEM *ep);
  48
  49
  50 /*
  51  * Insert an element before the first element of a list.
  52  *
  53  * given:
  54  *      lp              list to put element onto
  55  *      vp              value to be inserted
  56  */
  57 void
  58 insertlistfirst(LIST *lp, VALUE *vp)
  59 {
  60         LISTELEM *ep;           /* list element */
  61
  62         ep = elemalloc();
  63         copyvalue(vp, &ep->e_value);
  64         if (lp->l_count == 0) {
  65                 lp->l_last = ep;
  66         } else {
  67                 lp->l_cacheindex++;
  68                 lp->l_first->e_prev = ep;
  69                 ep->e_next = lp->l_first;
  70         }
  71         lp->l_first = ep;
  72         lp->l_count++;
  73 }
  74
  75
  76 /*
  77  * Insert an element after the last element of a list.
  78  *
  79  * given:
  80  *      lp              list to put element onto
  81  *      vp              value to be inserted
  82  */
  83 void
  84 insertlistlast(LIST *lp, VALUE *vp)
  85 {
  86         LISTELEM *ep;           /* list element */
  87
  88         ep = elemalloc();
  89         copyvalue(vp, &ep->e_value);
  90         if (lp->l_count == 0) {
  91                 lp->l_first = ep;
  92         } else {
  93                 lp->l_last->e_next = ep;
  94                 ep->e_prev = lp->l_last;
  95         }
  96         lp->l_last = ep;
  97         lp->l_count++;
  98 }
  99
 100
 101 /*
 102  * Insert an element into the middle of list at the given index (zero based).
 103  * The specified index will select the new element, so existing elements
 104  * at or beyond the index will be shifted down one position.  It is legal
 105  * to specify an index which is right at the end of the list, in which
 106  * case the element is appended to the list.
 107  *
 108  * given:
 109  *      lp              list to put element onto
 110  *      index           element number to insert in front of
 111  *      vp              value to be inserted
 112  */
 113 void
 114 insertlistmiddle(LIST *lp, long index, VALUE *vp)
 115 {
 116         LISTELEM *ep;           /* list element */
 117         LISTELEM *oldep;        /* old list element at desired index */
 118
 119         if (index == 0) {
 120                 insertlistfirst(lp, vp);
 121                 return;
 122         }
 123         if (index == lp->l_count) {
 124                 insertlistlast(lp, vp);
 125                 return;
 126         }
 127         oldep = NULL;
 128         if ((index >= 0) && (index < lp->l_count))
 129                 oldep = listelement(lp, index);
 130         if (oldep == NULL) {
 131                 math_error("Index out of bounds for list insertion");
 132                 /*NOTREACHED*/
 133         }
 134         ep = elemalloc();
 135         copyvalue(vp, &ep->e_value);
 136         ep->e_next = oldep;
 137         ep->e_prev = oldep->e_prev;
 138         ep->e_prev->e_next = ep;
 139         oldep->e_prev = ep;
 140         lp->l_cache = ep;
 141         lp->l_cacheindex = index;
 142         lp->l_count++;
 143 }
 144
 145
 146 /*
 147  * Remove the first element from a list, returning its value.
 148  * Returns the null value if no more elements exist.
 149  *
 150  * given:
 151  *      lp              list to have element removed
 152  *      vp              location of the value
 153  */
 154 void
 155 removelistfirst(LIST *lp, VALUE *vp)
 156 {
 157         if (lp->l_count == 0) {
 158                 vp->v_type = V_NULL;
 159                 vp->v_subtype = V_NOSUBTYPE;
 160                 return;
 161         }
 162         *vp = lp->l_first->e_value;
 163         lp->l_first->e_value.v_type = V_NULL;
 164         lp->l_first->e_value.v_type = V_NOSUBTYPE;
 165         removelistelement(lp, lp->l_first);
 166 }
 167
 168
 169 /*
 170  * Remove the last element from a list, returning its value.
 171  * Returns the null value if no more elements exist.
 172  *
 173  * given:
 174  *      lp              list to have element removed
 175  *      vp              location of the value
 176  */
 177 void
 178 removelistlast(LIST *lp, VALUE *vp)
 179 {
 180         if (lp->l_count == 0) {
 181                 vp->v_type = V_NULL;
 182                 vp->v_subtype = V_NOSUBTYPE;
 183                 return;
 184         }
 185         *vp = lp->l_last->e_value;
 186         lp->l_last->e_value.v_type = V_NULL;
 187         lp->l_last->e_value.v_subtype = V_NOSUBTYPE;
 188         removelistelement(lp, lp->l_last);
 189 }
 190
 191
 192 /*
 193  * Remove the element with the given index from a list, returning its value.
 194  *
 195  * given:
 196  *      lp              list to have element removed
 197  *      index           list element to be removed
 198  *      vp              location of the value
 199  */
 200 void
 201 removelistmiddle(LIST *lp, long index, VALUE *vp)
 202 {
 203         LISTELEM *ep;           /* element being removed */
 204
 205         ep = NULL;
 206         if ((index >= 0) && (index < lp->l_count))
 207                 ep = listelement(lp, index);
 208         if (ep == NULL) {
 209                 math_error("Index out of bounds for list deletion");
 210                 /*NOTREACHED*/
 211         }
 212         *vp = ep->e_value;
 213         ep->e_value.v_type = V_NULL;
 214         ep->e_value.v_subtype = V_NOSUBTYPE;
 215         removelistelement(lp, ep);
 216 }
 217
 218
 219 /*
 220  * Remove an arbitrary element from a list.
 221  * The value contained in the element is freed.
 222  *
 223  * given:
 224  *      lp              list header
 225  *      ep              list element to remove
 226  */
 227 S_FUNC void
 228 removelistelement(LIST *lp, LISTELEM *ep)
 229 {
 230         if ((ep == lp->l_cache) || ((ep != lp->l_first) && (ep != lp->l_last)))
 231                 lp->l_cache = NULL;
 232         if (ep->e_next)
 233                 ep->e_next->e_prev = ep->e_prev;
 234         if (ep->e_prev)
 235                 ep->e_prev->e_next = ep->e_next;
 236         if (ep == lp->l_first) {
 237                 lp->l_first = ep->e_next;
 238                 lp->l_cacheindex--;
 239         }
 240         if (ep == lp->l_last)
 241                 lp->l_last = ep->e_prev;
 242         lp->l_count--;
 243         elemfree(ep);
 244 }
 245
 246
 247 LIST *
 248 listsegment(LIST *lp, long n1, long n2)
 249 {
 250         LIST *newlp;
 251         LISTELEM *ep;
 252         long i;
 253
 254         newlp = listalloc();
 255         if ((n1 >= lp->l_count && n2 >= lp->l_count) || (n1 < 0 && n2 < 0))
 256                 return newlp;
 257         if (n1 >= lp->l_count)
 258                 n1 = lp->l_count - 1;
 259         if (n2 >= lp->l_count)
 260                 n2 = lp->l_count - 1;
 261         if (n1 < 0)
 262                 n1 = 0;
 263         if (n2 < 0)
 264                 n2 = 0;
 265
 266         ep = lp->l_first;
 267         if (n1 <= n2) {
 268                 i = n2 - n1 + 1;
 269                 while(n1-- > 0 && ep)
 270                         ep = ep->e_next;
 271                 while(i-- > 0 && ep) {
 272                         insertlistlast(newlp, &ep->e_value);
 273                         ep = ep->e_next;
 274                 }
 275         } else {
 276                 i = n1 - n2 + 1;
 277                 while(n2-- > 0 && ep)
 278                         ep = ep->e_next;
 279                 while(i-- > 0 && ep) {
 280                         insertlistfirst(newlp, &ep->e_value);
 281                         ep = ep->e_next;
 282                 }
 283         }
 284         return newlp;
 285 }
 286
 287
 288 /*
 289  * Search a list for the specified value starting at the specified index.
 290  * Returns 0 and stores the element number (zero based) if the value is
 291  * found, otherwise returns 1.
 292  */
 293 int
 294 listsearch(LIST *lp, VALUE *vp, long i, long j, ZVALUE *index)
 295 {
 296         register LISTELEM *ep;
 297
 298         if (i < 0 || j > lp->l_count) {
 299                 math_error("This should not happen in call to listsearch");
 300                 /*NOTREACHED*/
 301         }
 302
 303         ep = listelement(lp, i);
 304         while (i < j) {
 305                 if (!ep) {
 306                         math_error("This should not happen in listsearch");
 307                         /*NOTREACHED*/
 308                 }
 309                 if (acceptvalue(&ep->e_value, vp)) {
 310                         lp->l_cache = ep;
 311                         lp->l_cacheindex = i;
 312                         utoz(i, index);
 313                         return 0;
 314                 }
 315                 ep = ep->e_next;
 316                 i++;
 317         }
 318         return 1;
 319 }
 320
 321
 322 /*
 323  * Search a list backwards for the specified value starting at the
 324  * specified index.  Returns 0 and stores i if the value is found at
 325  * index i; otherwise returns 1.
 326  */
 327 int
 328 listrsearch(LIST *lp, VALUE *vp, long i, long j, ZVALUE *index)
 329 {
 330         register LISTELEM *ep;
 331
 332         if (i < 0 || j > lp->l_count) {
 333                 math_error("This should not happen in call to listrsearch");
 334                 /*NOTREACHED*/
 335         }
 336
 337         ep = listelement(lp, --j);
 338         while (j >= i) {
 339                 if (!ep) {
 340                         math_error("This should not happen in listsearch");
 341                         /*NOTREACHED*/
 342                 }
 343                 if (acceptvalue(&ep->e_value, vp)) {
 344                         lp->l_cache = ep;
 345                         lp->l_cacheindex = j;
 346                         utoz(j, index);
 347                         return 0;
 348                 }
 349                 ep = ep->e_prev;
 350                 j--;
 351         }
 352         return 1;
 353 }
 354
 355
 356 /*
 357  * Index into a list and return the address for the value corresponding
 358  * to that index.  Returns NULL if the element does not exist.
 359  *
 360  * given:
 361  *      lp              list to index into
 362  *      index           index of desired element
 363  */
 364 VALUE *
 365 listfindex(LIST *lp, long index)
 366 {
 367         LISTELEM *ep;
 368
 369         ep = listelement(lp, index);
 370         if (ep == NULL)
 371                 return NULL;
 372         return &ep->e_value;
 373 }
 374
 375
 376 /*
 377  * Return the element at a specified index number of a list.
 378  * The list is indexed starting at zero, and negative indices
 379  * indicate to index from the end of the list.  This routine finds
 380  * the element by chaining through the list from the closest one
 381  * of the first, last, and cached elements.  Returns NULL if the
 382  * element does not exist.
 383  *
 384  * given:
 385  *      lp              list to index into
 386  *      index           index of desired element
 387  */
 388 LISTELEM *
 389 listelement(LIST *lp, long index)
 390 {
 391         register LISTELEM *ep;  /* current list element */
 392         long dist;              /* distance to element */
 393         long temp;              /* temporary distance */
 394         BOOL forward;           /* TRUE if need to walk forwards */
 395
 396         if (index < 0)
 397                 index += lp->l_count;
 398         if ((index < 0) || (index >= lp->l_count))
 399                 return NULL;
 400         /*
 401          * Check quick special cases first.
 402          */
 403         if (index == 0)
 404                 return lp->l_first;
 405         if (index == 1)
 406                 return lp->l_first->e_next;
 407         if (index == lp->l_count - 1)
 408                 return lp->l_last;
 409         if ((index == lp->l_cacheindex) && lp->l_cache)
 410                 return lp->l_cache;
 411         /*
 412          * Calculate whether it is better to go forwards from
 413          * the first element or backwards from the last element.
 414          */
 415         forward = ((index * 2) <= lp->l_count);
 416         if (forward) {
 417                 dist = index;
 418                 ep = lp->l_first;
 419         } else {
 420                 dist = (lp->l_count - 1) - index;
 421                 ep = lp->l_last;
 422         }
 423         /*
 424          * Now see if we have a cached element and if so, whether or
 425          * not the distance from it is better than the above distance.
 426          */
 427         if (lp->l_cache) {
 428                 temp = index - lp->l_cacheindex;
 429                 if ((temp >= 0) && (temp < dist)) {
 430                         dist = temp;
 431                         ep = lp->l_cache;
 432                         forward = TRUE;
 433                 }
 434                 if ((temp < 0) && (-temp < dist)) {
 435                         dist = -temp;
 436                         ep = lp->l_cache;
 437                         forward = FALSE;
 438                 }
 439         }
 440         /*
 441          * Now walk forwards or backwards from the selected element
 442          * until we reach the correct element.  Cache the location of
 443          * the found element for future use.
 444          */
 445         if (forward) {
 446                 while (dist-- > 0)
 447                         ep = ep->e_next;
 448         } else {
 449                 while (dist-- > 0)
 450                         ep = ep->e_prev;
 451         }
 452         lp->l_cache = ep;
 453         lp->l_cacheindex = index;
 454         return ep;
 455 }
 456
 457
 458 /*
 459  * Compare two lists to see if they are identical.
 460  * Returns TRUE if they are different.
 461  */
 462 BOOL
 463 listcmp(LIST *lp1, LIST *lp2)
 464 {
 465         LISTELEM *e1, *e2;
 466         long count;
 467
 468         if (lp1 == lp2)
 469                 return FALSE;
 470         if (lp1->l_count != lp2->l_count)
 471                 return TRUE;
 472         e1 = lp1->l_first;
 473         e2 = lp2->l_first;
 474         count = lp1->l_count;
 475         while (count-- > 0) {
 476                 if (comparevalue(&e1->e_value, &e2->e_value))
 477                         return TRUE;
 478                 e1 = e1->e_next;
 479                 e2 = e2->e_next;
 480         }
 481         return FALSE;
 482 }
 483
 484
 485 /*
 486  * Copy a list
 487  */
 488 LIST *
 489 listcopy(LIST *oldlp)
 490 {
 491         LIST *lp;
 492         LISTELEM *oldep;
 493
 494         lp = listalloc();
 495         oldep = oldlp->l_first;
 496         while (oldep) {
 497                 insertlistlast(lp, &oldep->e_value);
 498                 oldep = oldep->e_next;
 499         }
 500         return lp;
 501 }
 502
 503
 504 /*
 505  * Round elements of a list to a specified number of decimal digits
 506  */
 507 LIST *
 508 listround(LIST *oldlp, VALUE *v2, VALUE *v3)
 509 {
 510         LIST *lp;
 511         LISTELEM *oldep, *ep, *eq;
 512
 513         lp = listalloc();
 514         oldep = oldlp->l_first;
 515         lp->l_count = oldlp->l_count;
 516         if (oldep) {
 517                 ep = elemalloc();
 518                 lp->l_first = ep;
 519                 for (;;) {
 520                         roundvalue(&oldep->e_value, v2, v3, &ep->e_value);
 521                         oldep = oldep->e_next;
 522                         if (!oldep)
 523                                 break;
 524                         eq = elemalloc();
 525                         ep->e_next = eq;
 526                         eq->e_prev = ep;
 527                         ep = eq;
 528                 }
 529                 lp->l_last = ep;
 530         }
 531         return lp;
 532 }
 533
 534
 535 /*
 536  * Round elements of a list to a specified number of binary digits
 537  */
 538 LIST *
 539 listbround(LIST *oldlp, VALUE *v2, VALUE *v3)
 540 {
 541         LIST *lp;
 542         LISTELEM *oldep, *ep, *eq;
 543
 544         lp = listalloc();
 545         oldep = oldlp->l_first;
 546         lp->l_count = oldlp->l_count;
 547         if (oldep) {
 548                 ep = elemalloc();
 549                 lp->l_first = ep;
 550                 for (;;) {
 551                         broundvalue(&oldep->e_value, v2, v3, &ep->e_value);
 552                         oldep = oldep->e_next;
 553                         if (!oldep)
 554                                 break;
 555                         eq = elemalloc();
 556                         ep->e_next = eq;
 557                         eq->e_prev = ep;
 558                         ep = eq;
 559                 }
 560                 lp->l_last = ep;
 561         }
 562         return lp;
 563 }
 564
 565
 566 /*
 567  * Approximate a list by approximating elements by multiples of v2,
 568  * type of rounding determined by v3.
 569  */
 570 LIST *
 571 listappr(LIST *oldlp, VALUE *v2, VALUE *v3)
 572 {
 573         LIST *lp;
 574         LISTELEM *oldep, *ep, *eq;
 575
 576         lp = listalloc();
 577         oldep = oldlp->l_first;
 578         lp->l_count = oldlp->l_count;
 579         if (oldep) {
 580                 ep = elemalloc();
 581                 lp->l_first = ep;
 582                 for (;;) {
 583                         apprvalue(&oldep->e_value, v2, v3, &ep->e_value);
 584                         oldep = oldep->e_next;
 585                         if (!oldep)
 586                                 break;
 587                         eq = elemalloc();
 588                         ep->e_next = eq;
 589                         eq->e_prev = ep;
 590                         ep = eq;
 591                 }
 592                 lp->l_last = ep;
 593         }
 594         return lp;
 595 }
 596
 597
 598 /*
 599  * Construct a list whose elements are integer quotients of the elements
 600  * of a specified list by a specified number.
 601  */
 602 LIST *
 603 listquo(LIST *oldlp, VALUE *v2, VALUE *v3)
 604 {
 605         LIST *lp;
 606         LISTELEM *oldep, *ep, *eq;
 607
 608         lp = listalloc();
 609         oldep = oldlp->l_first;
 610         lp->l_count = oldlp->l_count;
 611         if (oldep) {
 612                 ep = elemalloc();
 613                 lp->l_first = ep;
 614                 for (;;) {
 615                         quovalue(&oldep->e_value, v2, v3, &ep->e_value);
 616                         oldep = oldep->e_next;
 617                         if (!oldep)
 618                                 break;
 619                         eq = elemalloc();
 620                         ep->e_next = eq;
 621                         eq->e_prev = ep;
 622                         ep = eq;
 623                 }
 624                 lp->l_last = ep;
 625         }
 626         return lp;
 627 }
 628
 629
 630 /*
 631  * Construct a list whose elements are the remainders after integral
 632  * division of the elements of a specified list by a specified number.
 633  */
 634 LIST *
 635 listmod(LIST *oldlp, VALUE *v2, VALUE *v3)
 636 {
 637         LIST *lp;
 638         LISTELEM *oldep, *ep, *eq;
 639
 640         lp = listalloc();
 641         oldep = oldlp->l_first;
 642         lp->l_count = oldlp->l_count;
 643         if (oldep) {
 644                 ep = elemalloc();
 645                 lp->l_first = ep;
 646                 for (;;) {
 647                         modvalue(&oldep->e_value, v2, v3, &ep->e_value);
 648                         oldep = oldep->e_next;
 649                         if (!oldep)
 650                                 break;
 651                         eq = elemalloc();
 652                         ep->e_next = eq;
 653                         eq->e_prev = ep;
 654                         ep = eq;
 655                 }
 656                 lp->l_last = ep;
 657         }
 658         return lp;
 659 }
 660
 661
 662 void
 663 listreverse(LIST *lp)
 664 {
 665         LISTELEM *e1, *e2;
 666         VALUE tmp;
 667         long s;
 668
 669         s = lp->l_count/2;
 670         e1 = lp->l_first;
 671         e2 = lp->l_last;
 672         lp->l_cache = NULL;
 673         while (s-- > 0) {
 674                 tmp = e1->e_value;
 675                 e1->e_value = e2->e_value;
 676                 e2->e_value = tmp;
 677                 e1 = e1->e_next;
 678                 e2 = e2->e_prev;
 679         }
 680 }
 681
 682
 683 void
 684 listsort(LIST *lp)
 685 {
 686         LISTELEM *start;
 687         LISTELEM *last, *a, *a1, *b, *next;
 688         LISTELEM *S[LONG_BITS+1];
 689         long len[LONG_BITS+1];
 690         long i, j, k;
 691
 692         if (lp->l_count < 2)
 693                 return;
 694         lp->l_cache = NULL;
 695         start = elemalloc();
 696         next = lp->l_first;
 697         last = start;
 698         start->e_next = next;
 699         for (k = 0; next && k < LONG_BITS; k++) {
 700                 next->e_prev = last;
 701                 last = next;
 702                 S[k] = next;
 703                 next = next->e_next;
 704                 len[k] = 1;
 705                 while (k > 0 && (!next || len[k] >= len[k - 1])) {/* merging */
 706                         j = len[k];
 707                         b = S[k--];
 708                         i = len[k];
 709                         a = S[k];
 710                         a1 = b->e_prev;
 711                         len[k] = i + j;
 712                         if (precvalue(&b->e_value, &a->e_value)) {
 713                                 S[k] = b;
 714                                 a->e_prev->e_next = b;
 715                                 b->e_prev = a->e_prev;
 716                                 j--;
 717                                 while (j > 0) {
 718                                         b = b->e_next;
 719                                         if (!precvalue(&b->e_value,
 720                                                        &a->e_value))
 721                                                 break;
 722                                         j--;
 723                                 }
 724                                 if (j == 0) {
 725                                         b->e_next = a;
 726                                         a->e_prev = b;
 727                                         last = a1;
 728                                         continue;
 729                                 }
 730                                 b->e_prev->e_next = a;
 731                                 a->e_prev = b->e_prev;
 732                         }
 733
 734                         do {
 735                                 i--;
 736                                 while (i > 0) {
 737                                         a = a->e_next;
 738                                         if (precvalue(&b->e_value,
 739                                                       &a->e_value))
 740                                                 break;
 741                                         i--;
 742                                 }
 743                                 if (i == 0)
 744                                         break;
 745                                 a->e_prev->e_next = b;
 746                                 b->e_prev = a->e_prev;
 747                                 j--;
 748                                 while (j > 0) {
 749                                         b = b->e_next;
 750                                         if (!precvalue(&b->e_value,
 751                                                        &a->e_value))
 752                                                 break;
 753                                         j--;
 754                                 }
 755                                 if (j != 0) {
 756                                         b->e_prev->e_next = a;
 757                                         a->e_prev = b->e_prev;
 758                                 }
 759                         } while (j != 0);
 760
 761                         if (i == 0) {
 762                                 a->e_next = b;
 763                                 b->e_prev = a;
 764                         } else if (j == 0) {
 765                                 b->e_next = a;
 766                                 a->e_prev = b;
 767                                 last = a1;
 768                         }
 769                 }
 770         }
 771         if (k >= LONG_BITS) {
 772                 /* this should never happen */
 773                 math_error("impossible k overflow in listsort!");
 774                 /*NOTREACHED*/
 775         }
 776         lp->l_first = start->e_next;
 777         lp->l_first->e_prev = NULL;
 778         lp->l_last = last;
 779         lp->l_last->e_next = NULL;
 780         elemfree(start);
 781 }
 782
 783 void
 784 listrandperm(LIST *lp)
 785 {
 786         LISTELEM *ep, *eq;
 787         long i, s;
 788         VALUE val;
 789
 790         s = lp->l_count;
 791         for (ep = lp->l_last; s > 1; ep = ep->e_prev) {
 792                 i = irand(s--);
 793                 if (i < s) {
 794                         eq = listelement(lp, i);
 795                         val = eq->e_value;
 796                         eq->e_value = ep->e_value;
 797                         ep->e_value = val;
 798                 }
 799         }
 800 }
 801
 802
 803
 804 /*
 805  * Allocate an element for a list.
 806  */
 807 S_FUNC LISTELEM *
 808 elemalloc(void)
 809 {
 810         LISTELEM *ep;
 811
 812         ep = (LISTELEM *) malloc(sizeof(LISTELEM));
 813         if (ep == NULL) {
 814                 math_error("Cannot allocate list element");
 815                 /*NOTREACHED*/
 816         }
 817         ep->e_next = NULL;
 818         ep->e_prev = NULL;
 819         ep->e_value.v_type = V_NULL;
 820         ep->e_value.v_subtype = V_NOSUBTYPE;
 821         return ep;
 822 }
 823
 824
 825 /*
 826  * Free a list element, along with any contained value.
 827  */
 828 S_FUNC void
 829 elemfree(LISTELEM *ep)
 830 {
 831         if (ep->e_value.v_type != V_NULL)
 832                 freevalue(&ep->e_value);
 833         free(ep);
 834 }
 835
 836
 837 /*
 838  * Allocate a new list header.
 839  */
 840 LIST *
 841 listalloc(void)
 842 {
 843         register LIST *lp;
 844
 845         lp = (LIST *) malloc(sizeof(LIST));
 846         if (lp == NULL) {
 847                 math_error("Cannot allocate list header");
 848                 /*NOTREACHED*/
 849         }
 850         lp->l_first = NULL;
 851         lp->l_last = NULL;
 852         lp->l_cache = NULL;
 853         lp->l_cacheindex = 0;
 854         lp->l_count = 0;
 855         return lp;
 856 }
 857
 858
 859 /*
 860  * Free a list header, along with all of its list elements.
 861  */
 862 void
 863 listfree(LIST *lp)
 864 {
 865         register LISTELEM *ep;
 866
 867         while (lp->l_count-- > 0) {
 868                 ep = lp->l_first;
 869                 lp->l_first = ep->e_next;
 870                 elemfree(ep);
 871         }
 872         free(lp);
 873 }
 874
 875
 876 /*
 877  * Print out a list along with the specified number of its elements.
 878  * The elements are printed out in shortened form.
 879  */
 880 void
 881 listprint(LIST *lp, long max_print)
 882 {
 883         long count;
 884         long index;
 885         LISTELEM *ep;
 886
 887         if (max_print > lp->l_count)
 888                 max_print = lp->l_count;
 889         count = 0;
 890         ep = lp->l_first;
 891         index = lp->l_count;
 892         while (index-- > 0) {
 893                 if ((ep->e_value.v_type != V_NUM) ||
 894                         (!qiszero(ep->e_value.v_num)))
 895                                 count++;
 896                 ep = ep->e_next;
 897         }
 898         if (max_print > 0)
 899                 math_str("\n");
 900         math_fmt("list (%ld element%s, %ld nonzero)", lp->l_count,
 901                 ((lp->l_count == 1) ? "" : "s"), count);
 902         if (max_print <= 0)
 903                 return;
 904
 905         /*
 906          * Walk through the first few list elements, printing their
 907          * value in short and unambiguous format.
 908          */
 909         math_str(":\n");
 910         ep = lp->l_first;
 911         for (index = 0; index < max_print; index++) {
 912                 math_fmt("\t[[%ld]] = ", index);
 913                 printvalue(&ep->e_value, PRINT_SHORT | PRINT_UNAMBIG);
 914                 math_str("\n");
 915                 ep = ep->e_next;
 916         }
 917         if (max_print < lp->l_count)
 918                 math_str("  ...\n");
 919 }