1 /*
2 * listfunc - list handling routines
3 *
4 * Copyright (C) 1999-2007,2021 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 * Under source code control: 1990/02/15 01:48:18
21 * File existed as early as: before 1990
22 *
23 * Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
24 */
25
26 /*
27 * List handling routines.
28 * Lists can be composed of any types of values, mixed if desired.
29 * Lists are doubly linked so that elements can be inserted or
30 * deleted efficiently at any point in the list. A pointer is
31 * kept to the most recently indexed element so that sequential
32 * accesses are fast.
33 */
34
35
36 #include "value.h"
37 #include "zrand.h"
38
39
40 #include "banned.h" /* include after system header <> includes */
41
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
insertlistfirst(LIST * lp,VALUE * vp)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
insertlistlast(LIST * lp,VALUE * vp)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
insertlistmiddle(LIST * lp,long index,VALUE * vp)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
removelistfirst(LIST * lp,VALUE * vp)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_subtype = 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
removelistlast(LIST * lp,VALUE * vp)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
removelistmiddle(LIST * lp,long index,VALUE * vp)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
removelistelement(LIST * lp,LISTELEM * ep)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 *
listsegment(LIST * lp,long n1,long n2)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
listsearch(LIST * lp,VALUE * vp,long i,long j,ZVALUE * index)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
listrsearch(LIST * lp,VALUE * vp,long i,long j,ZVALUE * index)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 *
listfindex(LIST * lp,long index)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 *
listelement(LIST * lp,long index)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
listcmp(LIST * lp1,LIST * lp2)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 *
listcopy(LIST * oldlp)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 *
listround(LIST * oldlp,VALUE * v2,VALUE * v3)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 *
listbround(LIST * oldlp,VALUE * v2,VALUE * v3)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 *
listappr(LIST * oldlp,VALUE * v2,VALUE * v3)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 *
listquo(LIST * oldlp,VALUE * v2,VALUE * v3)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 *
listmod(LIST * oldlp,VALUE * v2,VALUE * v3)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
listreverse(LIST * lp)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
listsort(LIST * lp)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
listrandperm(LIST * lp)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 *
elemalloc(void)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
elemfree(LISTELEM * ep)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 *
listalloc(void)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
listfree(LIST * lp)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
listprint(LIST * lp,long max_print)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 }
920