Removed extra reference to packihx
[fw/sdcc] / support / gc / cord / cordbscs.c
1 /*
2  * Copyright (c) 1993-1994 by Xerox Corporation.  All rights reserved.
3  *
4  * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
5  * OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
6  *
7  * Permission is hereby granted to use or copy this program
8  * for any purpose,  provided the above notices are retained on all copies.
9  * Permission to modify the code and to distribute modified code is granted,
10  * provided the above notices are retained, and a notice that the code was
11  * modified is included with the above copyright notice.
12  *
13  * Author: Hans-J. Boehm (boehm@parc.xerox.com)
14  */
15 /* Boehm, October 3, 1994 5:19 pm PDT */
16 # include "gc.h"
17 # include "cord.h"
18 # include <stdlib.h>
19 # include <stdio.h>
20 # include <string.h>
21
22 /* An implementation of the cord primitives.  These are the only        */
23 /* Functions that understand the representation.  We perform only       */
24 /* minimal checks on arguments to these functions.  Out of bounds       */
25 /* arguments to the iteration functions may result in client functions  */
26 /* invoked on garbage data.  In most cases, client functions should be  */
27 /* programmed defensively enough that this does not result in memory    */
28 /* smashes.                                                             */ 
29
30 typedef void (* oom_fn)(void);
31
32 oom_fn CORD_oom_fn = (oom_fn) 0;
33
34 # define OUT_OF_MEMORY {  if (CORD_oom_fn != (oom_fn) 0) (*CORD_oom_fn)(); \
35                           ABORT("Out of memory\n"); }
36 # define ABORT(msg) { fprintf(stderr, "%s\n", msg); abort(); }
37
38 typedef unsigned long word;
39
40 typedef union {
41     struct Concatenation {
42         char null;
43         char header;
44         char depth;     /* concatenation nesting depth. */
45         unsigned char left_len;
46                         /* Length of left child if it is sufficiently   */
47                         /* short; 0 otherwise.                          */
48 #           define MAX_LEFT_LEN 255
49         word len;
50         CORD left;      /* length(left) > 0     */
51         CORD right;     /* length(right) > 0    */
52     } concatenation;
53     struct Function {
54         char null;
55         char header;
56         char depth;     /* always 0     */
57         char left_len;  /* always 0     */
58         word len;
59         CORD_fn fn;
60         void * client_data;
61     } function;
62     struct Generic {
63         char null;
64         char header;
65         char depth;
66         char left_len;
67         word len;
68     } generic;
69     char string[1];
70 } CordRep;
71
72 # define CONCAT_HDR 1
73         
74 # define FN_HDR 4
75 # define SUBSTR_HDR 6
76         /* Substring nodes are a special case of function nodes.        */
77         /* The client_data field is known to point to a substr_args     */
78         /* structure, and the function is either CORD_apply_access_fn   */
79         /* or CORD_index_access_fn.                                     */
80
81 /* The following may be applied only to function and concatenation nodes: */
82 #define IS_CONCATENATION(s)  (((CordRep *)s)->generic.header == CONCAT_HDR)
83
84 #define IS_FUNCTION(s)  ((((CordRep *)s)->generic.header & FN_HDR) != 0)
85
86 #define IS_SUBSTR(s) (((CordRep *)s)->generic.header == SUBSTR_HDR)
87
88 #define LEN(s) (((CordRep *)s) -> generic.len)
89 #define DEPTH(s) (((CordRep *)s) -> generic.depth)
90 #define GEN_LEN(s) (CORD_IS_STRING(s) ? strlen(s) : LEN(s))
91
92 #define LEFT_LEN(c) ((c) -> left_len != 0? \
93                                 (c) -> left_len \
94                                 : (CORD_IS_STRING((c) -> left) ? \
95                                         (c) -> len - GEN_LEN((c) -> right) \
96                                         : LEN((c) -> left)))
97
98 #define SHORT_LIMIT (sizeof(CordRep) - 1)
99         /* Cords shorter than this are C strings */
100
101
102 /* Dump the internal representation of x to stdout, with initial        */
103 /* indentation level n.                                                 */
104 void CORD_dump_inner(CORD x, unsigned n)
105 {
106     register size_t i;
107     
108     for (i = 0; i < (size_t)n; i++) {
109         fputs("  ", stdout);
110     }
111     if (x == 0) {
112         fputs("NIL\n", stdout);
113     } else if (CORD_IS_STRING(x)) {
114         for (i = 0; i <= SHORT_LIMIT; i++) {
115             if (x[i] == '\0') break;
116             putchar(x[i]);
117         }
118         if (x[i] != '\0') fputs("...", stdout);
119         putchar('\n');
120     } else if (IS_CONCATENATION(x)) {
121         register struct Concatenation * conc =
122                                 &(((CordRep *)x) -> concatenation);
123         printf("Concatenation: %p (len: %d, depth: %d)\n",
124                x, (int)(conc -> len), (int)(conc -> depth));
125         CORD_dump_inner(conc -> left, n+1);
126         CORD_dump_inner(conc -> right, n+1);
127     } else /* function */{
128         register struct Function * func =
129                                 &(((CordRep *)x) -> function);
130         if (IS_SUBSTR(x)) printf("(Substring) ");
131         printf("Function: %p (len: %d): ", x, (int)(func -> len));
132         for (i = 0; i < 20 && i < func -> len; i++) {
133             putchar((*(func -> fn))(i, func -> client_data));
134         }
135         if (i < func -> len) fputs("...", stdout);
136         putchar('\n');
137     }
138 }
139
140 /* Dump the internal representation of x to stdout      */
141 void CORD_dump(CORD x)
142 {
143     CORD_dump_inner(x, 0);
144     fflush(stdout);
145 }
146
147 CORD CORD_cat_char_star(CORD x, const char * y, size_t leny)
148 {
149     register size_t result_len;
150     register size_t lenx;
151     register int depth;
152     
153     if (x == CORD_EMPTY) return(y);
154     if (leny == 0) return(x);
155     if (CORD_IS_STRING(x)) {
156         lenx = strlen(x);
157         result_len = lenx + leny;
158         if (result_len <= SHORT_LIMIT) {
159             register char * result = GC_MALLOC_ATOMIC(result_len+1);
160         
161             if (result == 0) OUT_OF_MEMORY;
162             memcpy(result, x, lenx);
163             memcpy(result + lenx, y, leny);
164             result[result_len] = '\0';
165             return((CORD) result);
166         } else {
167             depth = 1;
168         }
169     } else {
170         register CORD right;
171         register CORD left;
172         register char * new_right;
173         register size_t right_len;
174         
175         lenx = LEN(x);
176         
177         if (leny <= SHORT_LIMIT/2
178             && IS_CONCATENATION(x)
179             && CORD_IS_STRING(right = ((CordRep *)x) -> concatenation.right)) {
180             /* Merge y into right part of x. */
181             if (!CORD_IS_STRING(left = ((CordRep *)x) -> concatenation.left)) {
182                 right_len = lenx - LEN(left);
183             } else if (((CordRep *)x) -> concatenation.left_len != 0) {
184                 right_len = lenx - ((CordRep *)x) -> concatenation.left_len;
185             } else {
186                 right_len = strlen(right);
187             }
188             result_len = right_len + leny;  /* length of new_right */
189             if (result_len <= SHORT_LIMIT) {
190                 new_right = GC_MALLOC_ATOMIC(result_len + 1);
191                 memcpy(new_right, right, right_len);
192                 memcpy(new_right + right_len, y, leny);
193                 new_right[result_len] = '\0';
194                 y = new_right;
195                 leny = result_len;
196                 x = left;
197                 lenx -= right_len;
198                 /* Now fall through to concatenate the two pieces: */
199             }
200             if (CORD_IS_STRING(x)) {
201                 depth = 1;
202             } else {
203                 depth = DEPTH(x) + 1;
204             }
205         } else {
206             depth = DEPTH(x) + 1;
207         }
208         result_len = lenx + leny;
209     }
210     {
211       /* The general case; lenx, result_len is known: */
212         register struct Concatenation * result;
213         
214         result = GC_NEW(struct Concatenation);
215         if (result == 0) OUT_OF_MEMORY;
216         result->header = CONCAT_HDR;
217         result->depth = depth;
218         if (lenx <= MAX_LEFT_LEN) result->left_len = lenx;
219         result->len = result_len;
220         result->left = x;
221         result->right = y;
222         if (depth > MAX_DEPTH) {
223             return(CORD_balance((CORD)result));
224         } else {
225             return((CORD) result);
226         }
227     }
228 }
229
230
231 CORD CORD_cat(CORD x, CORD y)
232 {
233     register size_t result_len;
234     register int depth;
235     register size_t lenx;
236     
237     if (x == CORD_EMPTY) return(y);
238     if (y == CORD_EMPTY) return(x);
239     if (CORD_IS_STRING(y)) {
240         return(CORD_cat_char_star(x, y, strlen(y)));
241     } else if (CORD_IS_STRING(x)) {
242         lenx = strlen(x);
243         depth = DEPTH(y) + 1;
244     } else {
245         register int depthy = DEPTH(y);
246         
247         lenx = LEN(x);
248         depth = DEPTH(x) + 1;
249         if (depthy >= depth) depth = depthy + 1;
250     }
251     result_len = lenx + LEN(y);
252     {
253         register struct Concatenation * result;
254         
255         result = GC_NEW(struct Concatenation);
256         if (result == 0) OUT_OF_MEMORY;
257         result->header = CONCAT_HDR;
258         result->depth = depth;
259         if (lenx <= MAX_LEFT_LEN) result->left_len = lenx;
260         result->len = result_len;
261         result->left = x;
262         result->right = y;
263         return((CORD) result);
264     }
265 }
266
267
268
269 CORD CORD_from_fn(CORD_fn fn, void * client_data, size_t len)
270 {
271     if (len <= 0) return(0);
272     if (len <= SHORT_LIMIT) {
273         register char * result;
274         register size_t i;
275         char buf[SHORT_LIMIT+1];
276         register char c;
277         
278         for (i = 0; i < len; i++) {
279             c = (*fn)(i, client_data);
280             if (c == '\0') goto gen_case;
281             buf[i] = c;
282         }
283         buf[i] = '\0';
284         result = GC_MALLOC_ATOMIC(len+1);
285         if (result == 0) OUT_OF_MEMORY;
286         strcpy(result, buf);
287         result[len] = '\0';
288         return((CORD) result);
289     }
290   gen_case:
291     {
292         register struct Function * result;
293         
294         result = GC_NEW(struct Function);
295         if (result == 0) OUT_OF_MEMORY;
296         result->header = FN_HDR;
297         /* depth is already 0 */
298         result->len = len;
299         result->fn = fn;
300         result->client_data = client_data;
301         return((CORD) result);
302     }
303 }
304
305 size_t CORD_len(CORD x)
306 {
307     if (x == 0) {
308         return(0);
309     } else {
310         return(GEN_LEN(x));
311     }
312 }
313
314 struct substr_args {
315     CordRep * sa_cord;
316     size_t sa_index;
317 };
318
319 char CORD_index_access_fn(size_t i, void * client_data)
320 {
321     register struct substr_args *descr = (struct substr_args *)client_data;
322     
323     return(((char *)(descr->sa_cord))[i + descr->sa_index]);
324 }
325
326 char CORD_apply_access_fn(size_t i, void * client_data)
327 {
328     register struct substr_args *descr = (struct substr_args *)client_data;
329     register struct Function * fn_cord = &(descr->sa_cord->function);
330     
331     return((*(fn_cord->fn))(i + descr->sa_index, fn_cord->client_data));
332 }
333
334 /* A version of CORD_substr that simply returns a function node, thus   */
335 /* postponing its work. The fourth argument is a function that may      */
336 /* be used for efficient access to the ith character.                   */
337 /* Assumes i >= 0 and i + n < length(x).                                */
338 CORD CORD_substr_closure(CORD x, size_t i, size_t n, CORD_fn f)
339 {
340     register struct substr_args * sa = GC_NEW(struct substr_args);
341     CORD result;
342     
343     if (sa == 0) OUT_OF_MEMORY;
344     sa->sa_cord = (CordRep *)x;
345     sa->sa_index = i;
346     result = CORD_from_fn(f, (void *)sa, n);
347     ((CordRep *)result) -> function.header = SUBSTR_HDR;
348     return (result);
349 }
350
351 # define SUBSTR_LIMIT (10 * SHORT_LIMIT)
352         /* Substrings of function nodes and flat strings shorter than   */
353         /* this are flat strings.  Othewise we use a functional         */
354         /* representation, which is significantly slower to access.     */
355
356 /* A version of CORD_substr that assumes i >= 0, n > 0, and i + n < length(x).*/
357 CORD CORD_substr_checked(CORD x, size_t i, size_t n)
358 {
359     if (CORD_IS_STRING(x)) {
360         if (n > SUBSTR_LIMIT) {
361             return(CORD_substr_closure(x, i, n, CORD_index_access_fn));
362         } else {
363             register char * result = GC_MALLOC_ATOMIC(n+1);
364             register char * p = result;
365             
366             if (result == 0) OUT_OF_MEMORY;
367             strncpy(result, x+i, n);
368             result[n] = '\0';
369             return(result);
370         }
371     } else if (IS_CONCATENATION(x)) {
372         register struct Concatenation * conc
373                         = &(((CordRep *)x) -> concatenation);
374         register size_t left_len;
375         register size_t right_len;
376         
377         left_len = LEFT_LEN(conc);
378         right_len = conc -> len - left_len;
379         if (i >= left_len) {
380             if (n == right_len) return(conc -> right);
381             return(CORD_substr_checked(conc -> right, i - left_len, n));
382         } else if (i+n <= left_len) {
383             if (n == left_len) return(conc -> left);
384             return(CORD_substr_checked(conc -> left, i, n));
385         } else {
386             /* Need at least one character from each side. */
387             register CORD left_part;
388             register CORD right_part;
389             register size_t left_part_len = left_len - i;
390         
391             if (i == 0) {
392                 left_part = conc -> left;
393             } else {
394                 left_part = CORD_substr_checked(conc -> left, i, left_part_len);
395             }
396             if (i + n == right_len + left_len) {
397                  right_part = conc -> right;
398             } else {
399                  right_part = CORD_substr_checked(conc -> right, 0,
400                                                   n - left_part_len);
401             }
402             return(CORD_cat(left_part, right_part));
403         }
404     } else /* function */ {
405         if (n > SUBSTR_LIMIT) {
406             if (IS_SUBSTR(x)) {
407                 /* Avoid nesting substring nodes.       */
408                 register struct Function * f = &(((CordRep *)x) -> function);
409                 register struct substr_args *descr =
410                                 (struct substr_args *)(f -> client_data);
411                 
412                 return(CORD_substr_closure((CORD)descr->sa_cord,
413                                            i + descr->sa_index,
414                                            n, f -> fn));
415             } else {
416                 return(CORD_substr_closure(x, i, n, CORD_apply_access_fn));
417             }
418         } else {
419             char * result;
420             register struct Function * f = &(((CordRep *)x) -> function);
421             char buf[SUBSTR_LIMIT+1];
422             register char * p = buf;
423             register char c;
424             register int j;
425             register int lim = i + n;
426             
427             for (j = i; j < lim; j++) {
428                 c = (*(f -> fn))(j, f -> client_data);
429                 if (c == '\0') {
430                     return(CORD_substr_closure(x, i, n, CORD_apply_access_fn));
431                 }
432                 *p++ = c;
433             }
434             *p = '\0';
435             result = GC_MALLOC_ATOMIC(n+1);
436             if (result == 0) OUT_OF_MEMORY;
437             strcpy(result, buf);
438             return(result);
439         }
440     }
441 }
442
443 CORD CORD_substr(CORD x, size_t i, size_t n)
444 {
445     register size_t len = CORD_len(x);
446     
447     if (i >= len || n <= 0) return(0);
448         /* n < 0 is impossible in a correct C implementation, but       */
449         /* quite possible  under SunOS 4.X.                             */
450     if (i + n > len) n = len - i;
451 #   ifndef __STDC__
452       if (i < 0) ABORT("CORD_substr: second arg. negative");
453         /* Possible only if both client and C implementation are buggy. */
454         /* But empirically this happens frequently.                     */
455 #   endif
456     return(CORD_substr_checked(x, i, n));
457 }
458
459 /* See cord.h for definition.  We assume i is in range. */
460 int CORD_iter5(CORD x, size_t i, CORD_iter_fn f1,
461                          CORD_batched_iter_fn f2, void * client_data)
462 {
463     if (x == 0) return(0);
464     if (CORD_IS_STRING(x)) {
465         register const char *p = x+i;
466         
467         if (*p == '\0') ABORT("2nd arg to CORD_iter5 too big");
468         if (f2 != CORD_NO_FN) {
469             return((*f2)(p, client_data));
470         } else {
471             while (*p) {
472                 if ((*f1)(*p, client_data)) return(1);
473                 p++;
474             }
475             return(0);
476         }
477     } else if (IS_CONCATENATION(x)) {
478         register struct Concatenation * conc
479                         = &(((CordRep *)x) -> concatenation);
480         
481         
482         if (i > 0) {
483             register size_t left_len = LEFT_LEN(conc);
484             
485             if (i >= left_len) {
486                 return(CORD_iter5(conc -> right, i - left_len, f1, f2,
487                                   client_data));
488             }
489         }
490         if (CORD_iter5(conc -> left, i, f1, f2, client_data)) {
491             return(1);
492         }
493         return(CORD_iter5(conc -> right, 0, f1, f2, client_data));
494     } else /* function */ {
495         register struct Function * f = &(((CordRep *)x) -> function);
496         register size_t j;
497         register size_t lim = f -> len;
498         
499         for (j = i; j < lim; j++) {
500             if ((*f1)((*(f -> fn))(j, f -> client_data), client_data)) {
501                 return(1);
502             }
503         }
504         return(0);
505     }
506 }
507                         
508 #undef CORD_iter
509 int CORD_iter(CORD x, CORD_iter_fn f1, void * client_data)
510 {
511     return(CORD_iter5(x, 0, f1, CORD_NO_FN, client_data));
512 }
513
514 int CORD_riter4(CORD x, size_t i, CORD_iter_fn f1, void * client_data)
515 {
516     if (x == 0) return(0);
517     if (CORD_IS_STRING(x)) {
518         register const char *p = x + i;
519         register char c;
520                
521         for(;;) {
522             c = *p;
523             if (c == '\0') ABORT("2nd arg to CORD_riter4 too big");
524             if ((*f1)(c, client_data)) return(1);
525             if (p == x) break;
526             p--;
527         }
528         return(0);
529     } else if (IS_CONCATENATION(x)) {
530         register struct Concatenation * conc
531                         = &(((CordRep *)x) -> concatenation);
532         register CORD left_part = conc -> left;
533         register size_t left_len;
534         
535         left_len = LEFT_LEN(conc);
536         if (i >= left_len) {
537             if (CORD_riter4(conc -> right, i - left_len, f1, client_data)) {
538                 return(1);
539             }
540             return(CORD_riter4(left_part, left_len - 1, f1, client_data));
541         } else {
542             return(CORD_riter4(left_part, i, f1, client_data));
543         }
544     } else /* function */ {
545         register struct Function * f = &(((CordRep *)x) -> function);
546         register size_t j;
547         
548         for (j = i; ; j--) {
549             if ((*f1)((*(f -> fn))(j, f -> client_data), client_data)) {
550                 return(1);
551             }
552             if (j == 0) return(0);
553         }
554     }
555 }
556
557 int CORD_riter(CORD x, CORD_iter_fn f1, void * client_data)
558 {
559     return(CORD_riter4(x, CORD_len(x) - 1, f1, client_data));
560 }
561
562 /*
563  * The following functions are concerned with balancing cords.
564  * Strategy:
565  * Scan the cord from left to right, keeping the cord scanned so far
566  * as a forest of balanced trees of exponentialy decreasing length.
567  * When a new subtree needs to be added to the forest, we concatenate all
568  * shorter ones to the new tree in the appropriate order, and then insert
569  * the result into the forest.
570  * Crucial invariants:
571  * 1. The concatenation of the forest (in decreasing order) with the
572  *     unscanned part of the rope is equal to the rope being balanced.
573  * 2. All trees in the forest are balanced.
574  * 3. forest[i] has depth at most i.
575  */
576
577 typedef struct {
578     CORD c;
579     size_t len;         /* Actual length of c   */
580 } ForestElement;
581
582 static size_t min_len [ MAX_DEPTH ];
583
584 static int min_len_init = 0;
585
586 int CORD_max_len;
587
588 typedef ForestElement Forest [ MAX_DEPTH ];
589                         /* forest[i].len >= fib(i+1)            */
590                         /* The string is the concatenation      */
591                         /* of the forest in order of DECREASING */
592                         /* indices.                             */
593
594 void CORD_init_min_len()
595 {
596     register int i;
597     register size_t last, previous, current;
598         
599     min_len[0] = previous = 1;
600     min_len[1] = last = 2;
601     for (i = 2; i < MAX_DEPTH; i++) {
602         current = last + previous;
603         if (current < last) /* overflow */ current = last;
604         min_len[i] = current;
605         previous = last;
606         last = current;
607     }
608     CORD_max_len = last - 1;
609     min_len_init = 1;
610 }
611
612
613 void CORD_init_forest(ForestElement * forest, size_t max_len)
614 {
615     register int i;
616     
617     for (i = 0; i < MAX_DEPTH; i++) {
618         forest[i].c = 0;
619         if (min_len[i] > max_len) return;
620     }
621     ABORT("Cord too long");
622 }
623
624 /* Add a leaf to the appropriate level in the forest, cleaning          */
625 /* out lower levels as necessary.                                       */
626 /* Also works if x is a balanced tree of concatenations; however        */
627 /* in this case an extra concatenation node may be inserted above x;    */
628 /* This node should not be counted in the statement of the invariants.  */
629 void CORD_add_forest(ForestElement * forest, CORD x, size_t len)
630 {
631     register int i = 0;
632     register CORD sum = CORD_EMPTY;
633     register size_t sum_len = 0;
634     
635     while (len > min_len[i + 1]) {
636         if (forest[i].c != 0) {
637             sum = CORD_cat(forest[i].c, sum);
638             sum_len += forest[i].len;
639             forest[i].c = 0;
640         }
641         i++;
642     }
643     /* Sum has depth at most 1 greter than what would be required       */
644     /* for balance.                                                     */
645     sum = CORD_cat(sum, x);
646     sum_len += len;
647     /* If x was a leaf, then sum is now balanced.  To see this          */
648     /* consider the two cases in which forest[i-1] either is or is      */
649     /* not empty.                                                       */
650     while (sum_len >= min_len[i]) {
651         if (forest[i].c != 0) {
652             sum = CORD_cat(forest[i].c, sum);
653             sum_len += forest[i].len;
654             /* This is again balanced, since sum was balanced, and has  */
655             /* allowable depth that differs from i by at most 1.        */
656             forest[i].c = 0;
657         }
658         i++;
659     }
660     i--;
661     forest[i].c = sum;
662     forest[i].len = sum_len;
663 }
664
665 CORD CORD_concat_forest(ForestElement * forest, size_t expected_len)
666 {
667     register int i = 0;
668     CORD sum = 0;
669     size_t sum_len = 0;
670     
671     while (sum_len != expected_len) {
672         if (forest[i].c != 0) {
673             sum = CORD_cat(forest[i].c, sum);
674             sum_len += forest[i].len;
675         }
676         i++;
677     }
678     return(sum);
679 }
680
681 /* Insert the frontier of x into forest.  Balanced subtrees are */
682 /* treated as leaves.  This potentially adds one to the depth   */
683 /* of the final tree.                                           */
684 void CORD_balance_insert(CORD x, size_t len, ForestElement * forest)
685 {
686     register int depth;
687     
688     if (CORD_IS_STRING(x)) {
689         CORD_add_forest(forest, x, len);
690     } else if (IS_CONCATENATION(x)
691                && ((depth = DEPTH(x)) >= MAX_DEPTH
692                    || len < min_len[depth])) {
693         register struct Concatenation * conc
694                         = &(((CordRep *)x) -> concatenation);
695         size_t left_len = LEFT_LEN(conc);
696         
697         CORD_balance_insert(conc -> left, left_len, forest);
698         CORD_balance_insert(conc -> right, len - left_len, forest);
699     } else /* function or balanced */ {
700         CORD_add_forest(forest, x, len);
701     }
702 }
703
704
705 CORD CORD_balance(CORD x)
706 {
707     Forest forest;
708     register size_t len;
709     
710     if (x == 0) return(0);
711     if (CORD_IS_STRING(x)) return(x);
712     if (!min_len_init) CORD_init_min_len();
713     len = LEN(x);
714     CORD_init_forest(forest, len);
715     CORD_balance_insert(x, len, forest);
716     return(CORD_concat_forest(forest, len));
717 }
718
719
720 /* Position primitives  */
721
722 /* Private routines to deal with the hard cases only: */
723
724 /* P contains a prefix of the  path to cur_pos. Extend it to a full     */
725 /* path and set up leaf info.                                           */
726 /* Return 0 if past the end of cord, 1 o.w.                             */
727 void CORD__extend_path(register CORD_pos p)
728 {
729      register struct CORD_pe * current_pe = &(p[0].path[p[0].path_len]);
730      register CORD top = current_pe -> pe_cord;
731      register size_t pos = p[0].cur_pos;
732      register size_t top_pos = current_pe -> pe_start_pos;
733      register size_t top_len = GEN_LEN(top);
734      
735      /* Fill in the rest of the path. */
736        while(!CORD_IS_STRING(top) && IS_CONCATENATION(top)) {
737          register struct Concatenation * conc =
738                         &(((CordRep *)top) -> concatenation);
739          register size_t left_len;
740          
741          left_len = LEFT_LEN(conc);
742          current_pe++;
743          if (pos >= top_pos + left_len) {
744              current_pe -> pe_cord = top = conc -> right;
745              current_pe -> pe_start_pos = top_pos = top_pos + left_len;
746              top_len -= left_len;
747          } else {
748              current_pe -> pe_cord = top = conc -> left;
749              current_pe -> pe_start_pos = top_pos;
750              top_len = left_len;
751          }
752          p[0].path_len++;
753        }
754      /* Fill in leaf description for fast access. */
755        if (CORD_IS_STRING(top)) {
756          p[0].cur_leaf = top;
757          p[0].cur_start = top_pos;
758          p[0].cur_end = top_pos + top_len;
759        } else {
760          p[0].cur_end = 0;
761        }
762        if (pos >= top_pos + top_len) p[0].path_len = CORD_POS_INVALID;
763 }
764
765 char CORD__pos_fetch(register CORD_pos p)
766 {
767     /* Leaf is a function node */
768     struct CORD_pe * pe = &((p)[0].path[(p)[0].path_len]);
769     CORD leaf = pe -> pe_cord;
770     register struct Function * f = &(((CordRep *)leaf) -> function);
771     
772     if (!IS_FUNCTION(leaf)) ABORT("CORD_pos_fetch: bad leaf");
773     return ((*(f -> fn))(p[0].cur_pos - pe -> pe_start_pos, f -> client_data));
774 }
775
776 void CORD__next(register CORD_pos p)
777 {
778     register size_t cur_pos = p[0].cur_pos + 1;
779     register struct CORD_pe * current_pe = &((p)[0].path[(p)[0].path_len]);
780     register CORD leaf = current_pe -> pe_cord;
781     
782     /* Leaf is not a string or we're at end of leaf */
783     p[0].cur_pos = cur_pos;
784     if (!CORD_IS_STRING(leaf)) {
785         /* Function leaf        */
786         register struct Function * f = &(((CordRep *)leaf) -> function);
787         register size_t start_pos = current_pe -> pe_start_pos;
788         register size_t end_pos = start_pos + f -> len;
789         
790         if (cur_pos < end_pos) {
791           /* Fill cache and return. */
792             register size_t i;
793             register size_t limit = cur_pos + FUNCTION_BUF_SZ;
794             register CORD_fn fn = f -> fn;
795             register void * client_data = f -> client_data;
796             
797             if (limit > end_pos) {
798                 limit = end_pos;
799             }
800             for (i = cur_pos; i < limit; i++) {
801                 p[0].function_buf[i - cur_pos] =
802                         (*fn)(i - start_pos, client_data);
803             }
804             p[0].cur_start = cur_pos;
805             p[0].cur_leaf = p[0].function_buf;
806             p[0].cur_end = limit;
807             return;
808         }
809     }
810     /* End of leaf      */
811     /* Pop the stack until we find two concatenation nodes with the     */
812     /* same start position: this implies we were in left part.          */
813     {
814         while (p[0].path_len > 0
815                && current_pe[0].pe_start_pos != current_pe[-1].pe_start_pos) {
816             p[0].path_len--;
817             current_pe--;
818         }
819         if (p[0].path_len == 0) {
820             p[0].path_len = CORD_POS_INVALID;
821             return;
822         }
823     }
824     p[0].path_len--;
825     CORD__extend_path(p);
826 }
827
828 void CORD__prev(register CORD_pos p)
829 {
830     register struct CORD_pe * pe = &(p[0].path[p[0].path_len]);
831     
832     if (p[0].cur_pos == 0) {
833         p[0].path_len = CORD_POS_INVALID;
834         return;
835     }
836     p[0].cur_pos--;
837     if (p[0].cur_pos >= pe -> pe_start_pos) return;
838     
839     /* Beginning of leaf        */
840     
841     /* Pop the stack until we find two concatenation nodes with the     */
842     /* different start position: this implies we were in right part.    */
843     {
844         register struct CORD_pe * current_pe = &((p)[0].path[(p)[0].path_len]);
845         
846         while (p[0].path_len > 0
847                && current_pe[0].pe_start_pos == current_pe[-1].pe_start_pos) {
848             p[0].path_len--;
849             current_pe--;
850         }
851     }
852     p[0].path_len--;
853     CORD__extend_path(p);
854 }
855
856 #undef CORD_pos_fetch
857 #undef CORD_next
858 #undef CORD_prev
859 #undef CORD_pos_to_index
860 #undef CORD_pos_to_cord
861 #undef CORD_pos_valid
862
863 char CORD_pos_fetch(register CORD_pos p)
864 {
865     if (p[0].cur_start <= p[0].cur_pos && p[0].cur_pos < p[0].cur_end) {
866         return(p[0].cur_leaf[p[0].cur_pos - p[0].cur_start]);
867     } else {
868         return(CORD__pos_fetch(p));
869     }
870 }
871
872 void CORD_next(CORD_pos p)
873 {
874     if (p[0].cur_pos < p[0].cur_end - 1) {
875         p[0].cur_pos++;
876     } else {
877         CORD__next(p);
878     }
879 }
880
881 void CORD_prev(CORD_pos p)
882 {
883     if (p[0].cur_end != 0 && p[0].cur_pos > p[0].cur_start) {
884         p[0].cur_pos--;
885     } else {
886         CORD__prev(p);
887     }
888 }
889
890 size_t CORD_pos_to_index(CORD_pos p)
891 {
892     return(p[0].cur_pos);
893 }
894
895 CORD CORD_pos_to_cord(CORD_pos p)
896 {
897     return(p[0].path[0].pe_cord);
898 }
899
900 int CORD_pos_valid(CORD_pos p)
901 {
902     return(p[0].path_len != CORD_POS_INVALID);
903 }
904
905 void CORD_set_pos(CORD_pos p, CORD x, size_t i)
906 {
907     if (x == CORD_EMPTY) {
908         p[0].path_len = CORD_POS_INVALID;
909         return;
910     }
911     p[0].path[0].pe_cord = x;
912     p[0].path[0].pe_start_pos = 0;
913     p[0].path_len = 0;
914     p[0].cur_pos = i;
915     CORD__extend_path(p);
916 }