2.11BSD#431 - /usr/src/new/PORT/B/src/bint/b1tex.c

   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

Defined functions

Defined struct's

Defined typedef's

Defined macros