![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to b1tex.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSD / contrib / B / src / bint|
Return to b1tex.c CVS log | Up to [CSRG BSD Unix] / 43BSD / contrib / B / src / bint |
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
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.