Annotation of 43BSD/contrib/B/src/bint/b1tex.c, revision 1.1.1.1

1.1       root        1: /* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1985. */
                      2: 
                      3: /*
                      4:  * $Header: b1tex.c,v 1.4 85/08/22 16:52:36 timo Exp $
                      5:  */
                      6: 
                      7: /* B texts */
                      8: 
                      9: #include "b.h"
                     10: #include "b1obj.h"
                     11: #ifndef INTEGRATION
                     12: #include "b0con.h"
                     13: #include "b1mem.h"
                     14: #include "b1btr.h"
                     15: #include "b1val.h"
                     16: #endif
                     17: #include "b1tlt.h"
                     18: #include "b3err.h"
                     19: 
                     20: #ifndef INTEGRATION
                     21: 
                     22: /*
                     23:  * Operations on texts represented as B-trees.
                     24:  *
                     25:  * Comments:
                     26:  * - The functions with 'i' prepended (ibehead, etc.) do no argument
                     27:  *   checking at all.  They actually implement the planned behaviour
                     28:  *   of | and @, where out-of-bounds numerical values are truncated
                     29:  *   rather than causing errors ("abc"|100 = "abc"@-100 = "abc").
                     30:  * - The 'size' field of all texts must fit in a C int.  If the result of
                     31:  *   ^ or ^^ would exceed Maxint in size, a user error is signalled.  If
                     32:  *   the size of the *input* value(s) of any operation is Bigsize, a syserr
                     33:  *   is signalled.
                     34:  * - Argument checking: trims, concat and repeat must check their arguments
                     35:  *   for user errors.
                     36:  * - t^^n is implemented with an algorithm similar to the 'square and
                     37:  *   multiply' algorithm for x**n, using the binary representation of n,
                     38:  *   but it uses straightforward 'concat' operations.  A more efficient
                     39:  *   scheme is possible [see IW219], but small code seems more important.
                     40:  * - Degenerated cases (e.g. t@1, t|0, t^'' or t^^n) are not optimized,
                     41:  *   but produce the desired result by virtue of the algorithms used.
                     42:  *   The extra checking does not seem worth the overhead for the
                     43:  *   non-degenerate cases.
                     44:  * - The code for PUT v IN t@h|l is still there, but it is not compiled,
                     45:  *   as the interpreter implements the same strategy directly.
                     46:  * - 'trim()' is only used by f_uname in "b3fil.c".
                     47:  * - Code for outputting texts has been added. This is called from wri()
                     48:  *   to output a text, and has running time O(n), compared to O(n log n)
                     49:  *   for the old code in wri().
                     50:  *
                     51:  * *** WARNING ***
                     52:  * - The 'zip' routine and its subroutine 'copynptrs' assume that items and
                     53:  *   pointers are stored contiguously, so that &Ptr(p, i+1) == &Ptr(p, i)+1
                     54:  *   and &[IB]char(p, i+1) == &[IB]char(p, i)+1.  For pointers, the order
                     55:  *   might be reversed in the future; then change the macro Incr(pp, n) below
                     56:  *   to *decrement* the pointer!
                     57:  * - Mkbtext and bstrval make the same assumption about items (using strncpy
                     58:  *   to move charaters to/from a bottom node).
                     59:  */
                     60: 
                     61: /*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/
                     62: 
                     63: #define IsInner(p) (Flag(p) == Inner)
                     64: #define IsBottom(p) (Flag(p) == Bottom)
                     65: 
                     66: #define Incr(pp, n) ((pp) += (n))
                     67: 
                     68: /*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/
                     69: 
                     70: /* make a B text out of a C char */
                     71: 
                     72: Visible value mkchar(c) char c; {
                     73:        char buf[2];
                     74:        buf[0] = c;
                     75:        buf[1] = '\0';
                     76:        return mk_text(buf);
                     77: }
                     78: 
                     79: Visible char charval(v) value v; {
                     80:        if (!Character(v))
                     81:                syserr(MESS(1600, "charval on non-char"));
                     82:        return Bchar(Root(v), 0);
                     83: }
                     84: 
                     85: Visible bool character(v) value v; {
                     86:        return Character(v);
                     87: }
                     88: 
                     89: /*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/
                     90: 
                     91: Hidden btreeptr mkbtext(s, len) string s; int len; {
                     92:        btreeptr p; int chunk, i, n, nbig;
                     93: 
                     94:        /*
                     95:         * Determine level of tree.
                     96:         * This is done for each inner node anew, to avoid having
                     97:         * to keep an explicit stack.
                     98:         * Problem is: make sure that for each node at the same
                     99:         * level, the computation indeed finds the same level!
                    100:         * (Don't care about efficiency here; in practice the trees
                    101:         * built by mk_text rarely need more than two levels.)
                    102:         */
                    103:        chunk = 0;
                    104:        i = Maxbottom; /* Next larger chunk size */
                    105:        while (len > i) {
                    106:                chunk = i;
                    107:                i = (i+1) * Maxinner + Maxinner;
                    108:        }
                    109:        n = len / (chunk+1); /* Number of items at this level; n+1 subtrees */
                    110:        chunk = len / (n+1); /* Use minimal chunk size for subtrees */
                    111:        p = grabbtreenode(chunk ? Inner : Bottom, Ct);
                    112:        Size(p) = len;
                    113:        Lim(p) = n;
                    114:        if (!chunk)
                    115:                strncpy(&Bchar(p, 0), s, len);
                    116:        else {
                    117:                nbig = len+1 - (n+1)*chunk;
                    118:                        /* There will be 'nbig' nodes of size 'chunk'. */
                    119:                        /* The remaining 'n-nbig' will have size 'chunk-1'. */
                    120:                for (i = 0; i < n; ++i) {
                    121:                        Ptr(p, i) = mkbtext(s, chunk);
                    122:                        s += chunk;
                    123:                        Ichar(p, i) = *s++;
                    124:                        len -= chunk+1;
                    125:                        if (--nbig == 0)
                    126:                                --chunk; /* This was the last 'big' node */
                    127:                }
                    128:                Ptr(p, i) = mkbtext(s, len);
                    129:        }
                    130:        return p;
                    131: }
                    132: 
                    133: Visible value mk_text(s) string s; {
                    134:        value v; int len = strlen(s);
                    135: 
                    136:        v = grab_tlt(Tex, Ct);
                    137:        if (len == 0)
                    138:                Root(v) = Bnil;
                    139:        else
                    140:                Root(v) = mkbtext(s, len);
                    141:        return v;
                    142: }
                    143: 
                    144: /*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/
                    145: 
                    146: Hidden string bstrval(buf, p) string buf; btreeptr p; {
                    147:        /* Returns *next* available position in buffer */
                    148:        int i, n = Lim(p);
                    149:        if (IsInner(p)) {
                    150:                for (i = 0; i < n; ++i) {
                    151:                        buf = bstrval(buf, Ptr(p, i));
                    152:                        *buf++ = Ichar(p, i);
                    153:                }
                    154:                return bstrval(buf, Ptr(p, i));
                    155:        }
                    156:        strncpy(buf, &Bchar(p, 0), n);
                    157:        return buf+n;
                    158: }
                    159: 
                    160: Visible string strval(v) value v; {
                    161:        static char *buffer; int len = Tltsize(v);
                    162:        if (len == Bigsize) syserr(MESS(1601, "strval on big text"));
                    163:        if (len == 0) return "";
                    164:        if (buffer != NULL)
                    165:                regetmem(&buffer, (unsigned) len+1);
                    166:        else
                    167:                buffer = getmem((unsigned) len+1);
                    168:        *bstrval(buffer, Root(v)) = '\0';
                    169:        return buffer;
                    170: }
                    171: 
                    172: /*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/
                    173: 
                    174: typedef struct stackelem {
                    175:        btreeptr s_ptr;
                    176:        int s_lim;
                    177: } stackelem;
                    178: 
                    179: typedef stackelem stack[Maxheight];
                    180: typedef stackelem *stackptr;
                    181: 
                    182: #define Snil ((stackptr)0)
                    183: 
                    184: #define Push(s, p, l) ((s)->s_ptr = (p), ((s)->s_lim = (l)), (s)++)
                    185: #define Pop(s, p, l) (--(s), (p) = (s)->s_ptr, (l) = (s)->s_lim)
                    186: 
                    187: extern stackptr unzip();
                    188: extern Procedure cpynptrs();
                    189: extern int movnptrs();
                    190: 
                    191: Hidden btreeptr zip(s1, sp1, s2, sp2) stackptr s1, sp1, s2, sp2; {
                    192:        btreeptr p1, p2, newptr[2]; int l1, l2, i, n, n2;
                    193: #define q1 newptr[0]
                    194: #define q2 newptr[1]
                    195:        char newitem; bool overflow, underflow, inner;
                    196:        char *cp; btreeptr *pp;
                    197:        char cbuf[2*Maxbottom]; btreeptr pbuf[2*Maxinner+2];
                    198: 
                    199:        while (s1 < sp1 && s1->s_lim == 0)
                    200:                ++s1;
                    201:        while (s2 < sp2 && s2->s_lim == Lim(s2->s_ptr))
                    202:                ++s2;
                    203:        inner = overflow = underflow = No;
                    204:        q1 = Bnil;
                    205:        while (s1 < sp1 || s2 < sp2) {
                    206:                if (s1 < sp1)
                    207:                        Pop(sp1, p1, l1);
                    208:                else
                    209:                        p1 = Bnil;
                    210:                if (s2 < sp2)
                    211:                        Pop(sp2, p2, l2);
                    212:                else
                    213:                        p2 = Bnil;
                    214:                cp = cbuf;
                    215:                if (p1 != Bnil) {
                    216:                        strncpy(cp, (inner ? &Ichar(p1, 0) : &Bchar(p1, 0)), l1);
                    217:                        cp += l1;
                    218:                }
                    219:                if (overflow)
                    220:                        *cp++ = newitem;
                    221:                n = cp - cbuf;
                    222:                if (p2 != Bnil) {
                    223:                        strncpy(cp, (inner ? &Ichar(p2, l2) : &Bchar(p2, l2)), Lim(p2)-l2);
                    224:                        n += Lim(p2)-l2;
                    225:                }
                    226:                if (inner) {
                    227:                        pp = pbuf; /***** Change if reverse direction! *****/
                    228:                        if (p1 != Bnil) {
                    229:                                cpynptrs(pp, &Ptr(p1, 0), l1);
                    230:                                Incr(pp, l1);
                    231:                        }
                    232:                        movnptrs(pp, newptr, 1+overflow);
                    233:                        Incr(pp, 1+overflow);
                    234:                        if (p2 != Bnil) {
                    235:                                cpynptrs(pp, &Ptr(p2, l2+1), Lim(p2)-l2);
                    236:                                Incr(pp, Lim(p2)-l2);
                    237:                        }
                    238:                        if (underflow) {
                    239:                                underflow= No;
                    240:                                n= uflow(n, p1 ? l1 : 0, cbuf, pbuf, Ct);
                    241:                        }
                    242:                }
                    243:                overflow = No;
                    244:                if (n > (inner ? Maxinner : Maxbottom)) {
                    245:                        overflow = Yes;
                    246:                        n2 = (n-1)/2;
                    247:                        n -= n2+1;
                    248:                }
                    249:                else if (n < (inner ? Mininner : Minbottom))
                    250:                        underflow = Yes;
                    251:                q1 = grabbtreenode(inner ? Inner : Bottom, Ct);
                    252:                Lim(q1) = n;
                    253:                cp = cbuf;
                    254:                strncpy((inner ? &Ichar(q1, 0) : &Bchar(q1, 0)), cp, n);
                    255:                cp += n;
                    256:                if (inner) {
                    257:                        pp = pbuf;
                    258:                        i = movnptrs(&Ptr(q1, 0), pp, n+1);
                    259:                        Incr(pp, n+1);
                    260:                        n += i;
                    261:                }
                    262:                Size(q1) = n;
                    263:                if (overflow) {
                    264:                        newitem = *cp++;
                    265:                        q2 = grabbtreenode(inner ? Inner : Bottom, Ct);
                    266:                        Lim(q2) = n2;
                    267:                        strncpy((inner ? &Ichar(q2, 0) : &Bchar(q2, 0)), cp, n2);
                    268:                        if (inner)
                    269:                                n2 += movnptrs(&Ptr(q2, 0), pp, n2+1);
                    270:                        Size(q2) = n2;
                    271:                }
                    272:                inner = Yes;
                    273:        }
                    274:        if (overflow)
                    275:                q1 = mknewroot(q1, (itemptr)&newitem, q2, Ct);
                    276:        return q1;
                    277: #undef q1
                    278: #undef q2
                    279: }
                    280: 
                    281: /*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/
                    282: 
                    283: Hidden value ibehead(v, h) value v; int h; { /* v@h */
                    284:        stack s; stackptr sp;
                    285:        sp = (stackptr) unzip(Root(v), h-1, s);
                    286:        v = grab_tlt(Tex, Ct);
                    287:        Root(v) = zip(Snil, Snil, s, sp);
                    288:        return v;
                    289: }
                    290: 
                    291: Hidden value icurtail(v, t) value v; int t; { /* v|t */
                    292:        stack s; stackptr sp;
                    293:        sp = (stackptr) unzip(Root(v), t, s);
                    294:        v = grab_tlt(Tex, Ct);
                    295:        Root(v) = zip(s, sp, Snil, Snil);
                    296:        return v;
                    297: }
                    298: 
                    299: Hidden value iconcat(v, w) value v, w; { /* v^w */
                    300:        stack s1, s2;
                    301:        stackptr sp1 = (stackptr) unzip(Root(v), Tltsize(v), s1);
                    302:        stackptr sp2 = (stackptr) unzip(Root(w), 0, s2);
                    303:        v = grab_tlt(Tex, Ct);
                    304:        Root(v) = zip(s1, sp1, s2, sp2);
                    305:        return v;
                    306: }
                    307: 
                    308: #define Odd(n) (((n)&1) != 0)
                    309: 
                    310: Hidden value irepeat(v, n) value v; int n; { /* v^^n */
                    311:        value x, w = grab_tlt(Tex, Ct);
                    312:        Root(w) = Bnil;
                    313:        v = copy(v);
                    314:        while (n > 0) {
                    315:                if (Odd(n)) {
                    316:                        w = iconcat(x = w, v);
                    317:                        release(x);
                    318:                }
                    319:                n /= 2;
                    320:                if (n == 0)
                    321:                        break;
                    322:                v = iconcat(x = v, v);
                    323:                release(x);
                    324:        }
                    325:        release(v);
                    326:        return w;
                    327: }
                    328: 
                    329: #ifdef UNUSED_CODE
                    330: Hidden value jrepeat(v, n) value v; int n; { /* v^^n, recursive solution */
                    331:        value w, x;
                    332:        if (n <= 1) {
                    333:                if (n == 1)
                    334:                        return copy(v);
                    335:                w = grab_tlt(Tex, Ct);
                    336:                Root(w) = Bnil;
                    337:                return w;
                    338:        }
                    339:        w = jrepeat(v, n/2);
                    340:        w = iconcat(x = w, w);
                    341:        release(x);
                    342:        if (Odd(n)) {
                    343:                w = iconcat(x = w, v);
                    344:                release(x);
                    345:        }
                    346:        return w;
                    347: }
                    348: #endif UNUSED_CODE
                    349: 
                    350: /*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/
                    351: 
                    352: Visible value curtail(t, after) value t, after; {
                    353:        int syzcurv, syztext;
                    354: 
                    355:        if (!Is_text(t)) {
                    356:                reqerr(MESS(1602, "in t|n, t is not a text"));
                    357:                return Vnil;
                    358:        }
                    359:        if (!Is_number(after)) {
                    360:                reqerr(MESS(1603, "in t|n, n is not a number"));
                    361:                return Vnil;
                    362:        }
                    363:        syztext = Tltsize(t);
                    364:        if (syztext == Bigsize)
                    365:                syserr(MESS(1604, "curtail on very big text"));
                    366:        if (large(after) || (syzcurv = intval(after)) < 0
                    367:                || syztext < syzcurv) {
                    368:                reqerr(MESS(1605, "in t|n, n is out of bounds"));
                    369:                return Vnil;
                    370:        }
                    371:        return icurtail(t, syzcurv);
                    372: }
                    373: 
                    374: Visible value behead(t, before) value t, before; {
                    375:        int syzbehv, syztext;
                    376: 
                    377:        if (!Is_text(t)) {
                    378:                reqerr(MESS(1606, "in t@n, t is not a text"));
                    379:                return Vnil;
                    380:        }
                    381:        if (!Is_number(before)) {
                    382:                reqerr(MESS(1607, "in t@n, n is not a number"));
                    383:                return Vnil;
                    384:        }
                    385:        syztext = Tltsize(t);
                    386:        if (syztext == Bigsize) syserr(MESS(1608, "behead on very big text"));
                    387:        if (large(before) || (syzbehv = intval(before)) <= 0
                    388:                || syztext < syzbehv-1) {
                    389:                reqerr(MESS(1609, "in t@n, n is out of bounds"));
                    390:                return Vnil;
                    391:        }
                    392:        return ibehead(t, syzbehv);
                    393: }
                    394: 
                    395: #ifdef NOT_USED
                    396: Visible value trim(v, b, c) value v; intlet b, c; { /*temporary*/
                    397:        /* Only used in f_uname */
                    398:        int len= Tltsize(v);
                    399:        value r= ibehead(v, b+1), s;
                    400:        s= icurtail(r, len-b-c); release(r);
                    401:        return s;
                    402: }
                    403: #endif
                    404: 
                    405: /*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/
                    406: 
                    407: Visible value concat(tleft, tright) value tleft, tright; {
                    408:        int syzleft, syzright;
                    409:        if (!Is_text(tleft) || !Is_text(tright)) {
                    410:                reqerr(MESS(1610, "in t^u, t or u is not a text"));
                    411:                return Vnil;
                    412:        }
                    413:        syzleft = Tltsize(tleft);
                    414:        syzright =  Tltsize(tright);
                    415:        if (syzleft == Bigsize || syzright == Bigsize)
                    416:                syserr(MESS(1611, "concat on very big text"));
                    417:        if (syzleft > Maxint-syzright
                    418:                || syzright > Maxint-syzleft) {
                    419:                reqerr(MESS(1612, "in t^u, the result is too long"));
                    420:                return Vnil;
                    421:        }
                    422:        return iconcat(tleft, tright);
                    423: }
                    424: 
                    425: /*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/
                    426: 
                    427: Visible value repeat(t, n) value t, n; {
                    428:        int tsize, k;
                    429: 
                    430:        if (!Is_text(t)) {
                    431:                reqerr(MESS(1613, "in t^^n, t is not a text"));
                    432:                return Vnil;
                    433:        }
                    434:        if (!Is_number(n)) {
                    435:                reqerr(MESS(1614, "in t^^n, n is not a number"));
                    436:                return Vnil;
                    437:        }
                    438:        if (numcomp(n, zero) < 0) {
                    439:                reqerr(MESS(1615, "in t^^n, n is negative"));
                    440:                return Vnil;
                    441:        }
                    442:        tsize = Tltsize(t);
                    443:        if (tsize == 0) return copy(t);
                    444: 
                    445:        if (large(n) || Maxint/tsize < (k = intval(n))) {
                    446:                reqerr(MESS(1616, "in t^^n, the result is too long"));
                    447:                return Vnil;
                    448:        }
                    449:        return irepeat(t, k);
                    450: }
                    451: 
                    452: /*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/
                    453: 
                    454: Visible Procedure wrtext(putch, v, quote) int (*putch)(); value v; char quote; {
                    455:        if (v == Vnil || !Is_text(v)) {
                    456:                (*putch)('?');
                    457:                return;
                    458:        }
                    459:        if (quote) (*putch)(quote);
                    460:        if (Root(v) != Bnil) wrbtext(putch, Root(v), quote);
                    461:        if (quote) (*putch)(quote);
                    462: }
                    463: 
                    464: Hidden Procedure wrbtext(putch, p, quote)
                    465:  int (*putch)(); btreeptr p; char quote; {
                    466:        int i, n = Lim(p); char c;
                    467:        if (IsInner(p)) {
                    468:                for (i = 0; still_ok && i < n; ++i) {
                    469:                        wrbtext(putch, Ptr(p, i), quote);
                    470:                        c = Ichar(p, i);
                    471:                        (*putch)(c);
                    472:                        if (quote && (c == quote || c == '`')) (*putch)(c);
                    473:                }
                    474:                wrbtext(putch, Ptr(p, i), quote);
                    475:        }
                    476:        else if (quote) {
                    477:                for (i = 0; i < n; ++i) {
                    478:                        c = Bchar(p, i);
                    479:                        (*putch)(c);
                    480:                        if (c == quote || c == '`') (*putch)(c);
                    481:                }
                    482:        }
                    483:        else {
                    484:                for (i = 0; i < n; ++i) (*putch)(Bchar(p, i));
                    485:        }
                    486: }
                    487: 
                    488: #else INTEGRATION
                    489: 
                    490: Visible value mk_text(m) string m; {
                    491:        value v; intlet len= strlen(m);
                    492:        v= grab_tex(len);
                    493:        strcpy(Str(v), m);
                    494:        return v;
                    495: }
                    496: 
                    497: Visible bool character(v) value v; {
                    498:        if (Is_text(v) && Length(v) == 1) return Yes;
                    499:        else return No;
                    500: }
                    501: 
                    502: Visible char charval(v) value v; {
                    503:        if (!Is_text(v) || Length(v) != 1) error(MESS(1617, "value not a character"));
                    504:        return *Str(v);
                    505: }
                    506: 
                    507: Visible string strval(v) value v; {
                    508:        return Str(v);
                    509: }
                    510: 
                    511: Visible value concat(s, t) value s, t; {
                    512:        if (Type(s) != Tex)
                    513:                error(MESS(1618, "in t^u, t is not a text"));
                    514:        else if (Type(t) != Tex)
                    515:                error(MESS(1619, "in t^u, t is a text, but u is not"));
                    516:        else {
                    517:                value c= grab_tex(Length(s)+Length(t));
                    518:                strcpy(Str(c), Str(s)); strcpy(Str(c)+Length(s), Str(t));
                    519:                return c;
                    520:        }
                    521:        return grab_tex(0);
                    522: }
                    523: 
                    524: #define VERSION2
                    525: 
                    526: Visible Procedure concato(s, t) value *s; string t; {
                    527:        if (Type(*s) != Tex)
                    528:                error(MESS(1620, "attempt to join text with non-text"));
                    529:        else {
                    530: #ifdef VERSION1
                    531:                xtndtex(s, strlen(t));
                    532:                strcat(Str(*s), t);
                    533: #endif
                    534: #ifdef VERSION2
                    535:                value v= mk_text(t);
                    536:                value w= concat(*s, v);
                    537:                release(*s); release(v);
                    538:                *s= w;
                    539: #endif
                    540:        }
                    541: }
                    542: 
                    543: Visible value trim(v, B, C) value v; intlet B, C; {
                    544:        intlet len= Length(v), k;
                    545:        if (Type(v) != Tex)
                    546:                error(MESS(1621, "trim (@ or |) applied to non-text"));
                    547:        else if (B < 0 || C < 0 || B+C > len)
                    548:                error(MESS(1622, "trim (@ or |) out of bounds"));
                    549:        else {
                    550:                value w= grab_tex(len-=(B+C));
                    551:                string vp= Str(v)+B, wp= Str(w);
                    552:                Overall *wp++= *vp++; *wp= '\0';
                    553:                return w;
                    554:        }
                    555:        return grab_tex(0);
                    556: }
                    557: 
                    558: Visible Procedure
                    559: putintrim(pn, head, tail, str)
                    560:        value *pn;
                    561:        intlet head, tail;
                    562:        string str;
                    563: {
                    564:        value v = *pn;
                    565:        intlet len= Length(v);
                    566: 
                    567:        if (Type(v) != Tex)
                    568:                error(MESS(1623, "putintrim (@ or |) applied to non-text"));
                    569:        else if (head < 0 || tail < 0 || head+tail > len)
                    570:                error(MESS(1624, "putintrim (@ or |) out of bounds"));
                    571:        else {
                    572:                value w = head == 0 ? mk_text("") :
                    573:                        head == len ? copy(v) : trim(v, 0, len - head);
                    574:                if (*str)
                    575:                        concato(&w, str);
                    576:                if (tail > 0)
                    577:                        concato(&w, Str(v)+(len - tail));
                    578:                release(v);
                    579:                *pn = w;
                    580:        }
                    581: }
                    582: 
                    583: Visible value curtail(v, n) value v, n; {
                    584:        intlet c= intval(n);
                    585:        v= trim(v, 0, Length(v) - c);
                    586:        return v;
                    587: }
                    588: 
                    589: Visible value behead(v, n) value v, n; {
                    590:        intlet b= intval(n);
                    591:        v= trim(v, b-1, 0);
                    592:        return v;
                    593: }
                    594: 
                    595: Visible value repeat(x, y) value x, y; {
                    596:        intlet i= propintlet(intval(y));
                    597:        if (Type(x) != Tex)
                    598:                error(MESS(1625, "in t^^n, t is not a text"));
                    599:        if (i < 0)
                    600:                error(MESS(1626, "in t^^n, n is negative"));
                    601:        else {
                    602:                value r; string xp, rp; intlet p, q, xl= Length(x);
                    603:                r= grab_tex(propintlet(i*xl));
                    604:                rp= Str(r);
                    605:                for (p= 0; p < i; p++) {
                    606:                        xp= Str(x);
                    607:                        for (q= 0; q < xl; q++) *rp++= *xp++;
                    608:                }
                    609:                *rp= '\0';
                    610:                return r;
                    611:        }
                    612:        return grab_tex(0);
                    613: }
                    614: 
                    615: #define Left 'L'
                    616: #define Right 'R'
                    617: #define Centre 'C'
                    618: 
                    619: Hidden value adj(x, y, side) value x, y; literal side; {
                    620:        value r, v= convert(x, Yes, Yes); int i= intval(y);
                    621:        intlet lv= Length(v), la, k, ls, rs;
                    622:        string rp, vp;
                    623:        la= propintlet(i) - lv;
                    624:        if (la <= 0) return v;
                    625:        r= grab_tex(lv+la); rp= Str(r); vp= Str(v);
                    626: 
                    627:        if (side == Left) { ls= 0; rs= la; }
                    628:        else if (side == Centre) { ls= la/2; rs= (la+1)/2; }
                    629:        else { ls= la; rs= 0; }
                    630: 
                    631:        for (k= 0; k < ls; k++) *rp++= ' ';
                    632:        for (k= 0; k < lv; k++) *rp++= *vp++;
                    633:        for (k= 0; k < rs; k++) *rp++= ' ';
                    634:        *rp= 0;
                    635:        release(v);
                    636:        return r;
                    637: }
                    638: 
                    639: Visible value adjleft(x, y) value x, y; {
                    640:        return adj(x, y, Left);
                    641: }
                    642: 
                    643: Visible value centre(x, y) value x, y; {
                    644:        return adj(x, y, Centre);
                    645: }
                    646: 
                    647: Visible value adjright(x, y) value x, y; {
                    648:        return adj(x, y, Right);
                    649: }
                    650: 
                    651: /* For reasons of efficiency, wri does not always call convert but writes
                    652:    directly on the standard output. Modifications in convert should
                    653:    be mirrored by changes in wri and vice versa. */
                    654: 
                    655: Visible value convert(v, coll, outer) value v; bool coll, outer; {
                    656:        literal type= Type(v); intlet len= Length(v), k; value *vp= Ats(v);
                    657:        value t, cv;
                    658:        switch (type) {
                    659:        case Num:
                    660:                return mk_text(convnum(v));
                    661:        case Tex:
                    662:                if (outer) return copy(v);
                    663:                else {string tp= (string) vp; char cs[2];
                    664:                        cs[1]= '\0';
                    665:                        t= mk_text("'");
                    666:                        Overall {
                    667:                                cs[0]= *tp++;
                    668:                                concato(&t, cs);
                    669:                                if (cs[0] == '\'' || cs[0] == '`')
                    670:                                        concato(&t, cs);
                    671:                        }
                    672:                        concato(&t, "'");
                    673:                        return t;
                    674:                }
                    675:        case Com:
                    676:                outer&= coll;
                    677:                t= mk_text(coll ? "" : "(");
                    678:                Overall {
                    679:                        concato(&t, Str(cv= convert(*vp++, No, outer)));
                    680:                        release(cv);
                    681:                        if (k != len-1) concato(&t, outer ? " " : ", ");
                    682:                }
                    683:                if (!coll) concato(&t, ")");
                    684:                return t;
                    685:        case Lis: case ELT:
                    686:                t= mk_text("{");
                    687:                Overall {
                    688:                        concato(&t, Str(cv= convert(*vp++, No, No)));
                    689:                        release(cv);
                    690:                        if (k != len-1) concato(&t, "; ");
                    691:                }
                    692:                concato(&t, "}");
                    693:                return t;
                    694:        case Tab:
                    695:                t= mk_text("{");
                    696:                Overall {
                    697:                        concato(&t, "[");
                    698:                        concato(&t, Str(cv= convert(Cts(*vp), Yes, No)));
                    699:                        release(cv);
                    700:                        concato(&t, "]: ");
                    701:                        concato(&t, Str(cv= convert(Dts(*vp++), No, No)));
                    702:                        release(cv);
                    703:                        if (k != len-1) concato(&t, "; ");
                    704:                }
                    705:                concato(&t, "}");
                    706:                return t;
                    707:        default:
                    708:                syserr(MESS(1627, "converting value of unknown type"));
                    709:                return (value) Dummy;
                    710:        }
                    711: }
                    712: 
                    713: #endif INTEGRATION

unix.superglobalmegacorp.com

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.