home *** CD-ROM | disk | FTP | other *** search
/ ftp.cs.arizona.edu / ftp.cs.arizona.edu.tar / ftp.cs.arizona.edu / icon / historic / v92.tgz / v92.tar / v92 / src / runtime / fstr.r < prev    next >
Text File  |  1996-03-22  |  18KB  |  708 lines
  1. /*
  2.  * File: fstr.r
  3.  *  Contents: center, detab, entab, left, map, repl, reverse, right, trim
  4.  */
  5.  
  6.  
  7. /*
  8.  * macro used by center, left, right
  9.  */
  10. #begdef FstrSetup
  11.    /*
  12.     * s1 must be a string.  n must be a non-negative integer and defaults
  13.     *  to 1.  s2 must be a string and defaults to a blank.
  14.     */
  15.    if !cnv:string(s1) then
  16.       runerr(103,s1)
  17.    if !def:C_integer(n,1) then
  18.       runerr(101, n)
  19.    if !def:tmp_string(s2,blank) then
  20.       runerr(103, s2)
  21.  
  22.    abstract {
  23.       return string
  24.       }
  25.    body {
  26.       register char *s, *st;
  27.       word slen;
  28.       char *sbuf, *s3;
  29.  
  30.       if (n < 0) {
  31.          irunerr(205,n);
  32.          errorfail;
  33.          }
  34.       /*
  35.        * The padding string is null; make it a blank.
  36.        */
  37.       if (StrLen(s2) == 0)
  38.          s2 = blank;
  39.    /* } must be supplied */
  40. #enddef
  41.  
  42.  
  43. "center(s1,i,s2) - pad s1 on left and right with s2 to length i."
  44.  
  45. function{1} center(s1,n,s2)
  46.    FstrSetup /* includes body { */
  47.       {
  48.       word hcnt;
  49.  
  50.       /*
  51.        * If we are extracting the center of a large string (not padding),
  52.        * just construct a descriptor.
  53.        */
  54.       if (n <= StrLen(s1)) {
  55.          return string(n, StrLoc(s1) + ((StrLen(s1)-n+1)>>1));
  56.          }
  57.  
  58.       /*
  59.        * Get space for the new string.  Start at the right
  60.        *  of the new string and copy s2 into it from right to left as
  61.        *  many times as will fit in the right half of the new string.
  62.        */
  63.       Protect(sbuf = alcstr(NULL, n), runerr(0));
  64.  
  65.       slen = StrLen(s2);
  66.       s3 = StrLoc(s2);
  67.       hcnt = n / 2;
  68.       s = sbuf + n;
  69.       while (s > sbuf + hcnt) {
  70.          st = s3 + slen;
  71.          while (st > s3 && s > sbuf + hcnt)
  72.             *--s = *--st;
  73.          }
  74.  
  75.       /*
  76.        * Start at the left end of the new string and copy s1 into it from
  77.        *  left to right as many time as will fit in the left half of the
  78.        *  new string.
  79.        */
  80.       s = sbuf;
  81.       while (s < sbuf + hcnt) {
  82.          st = s3;
  83.          while (st < s3 + slen && s < sbuf + hcnt)
  84.             *s++ = *st++;
  85.          }
  86.  
  87.       slen = StrLen(s1);
  88.       if (n < slen) {
  89.          /*
  90.           * s1 is larger than the field to center it in.  The source for the
  91.           *  copy starts at the appropriate point in s1 and the destination
  92.           *  starts at the left end of of the new string.
  93.           */
  94.          s = sbuf;
  95.          st = StrLoc(s1) + slen/2 - hcnt + (~n&slen&1);
  96.          }
  97.       else {
  98.          /*
  99.           * s1 is smaller than the field to center it in.  The source for the
  100.           *  copy starts at the left end of s1 and the destination starts at
  101.           *  the appropriate point in the new string.
  102.           */
  103.          s = sbuf + hcnt - slen/2 - (~n&slen&1);
  104.          st = StrLoc(s1);
  105.          }
  106.       /*
  107.        * Perform the copy, moving min(*s1,n) bytes from st to s.
  108.        */
  109.       if (slen > n)
  110.          slen = n;
  111.       while (slen-- > 0)
  112.          *s++ = *st++;
  113.  
  114.       /*
  115.        * Return the new string.
  116.        */
  117.       return string(n, sbuf);
  118.       } }
  119. end
  120.  
  121.  
  122. "detab(s,i,...) - replace tabs with spaces, with stops at columns indicated."
  123.  
  124. function{1} detab(s,i[n])
  125.  
  126.    if !cnv:string(s) then
  127.       runerr(103,s)
  128.  
  129.    abstract {
  130.       return string
  131.       }
  132.  
  133.    body {
  134.       tended char *in, *out, *iend;
  135.       C_integer last, interval, col, target, expand, j;
  136.       dptr tablst;
  137.       dptr endlst;
  138.       int is_expanded = 0;
  139.       char c;
  140.  
  141.       /*
  142.        * Make sure all allocations for result will go in one region
  143.        */
  144.       reserve(Strings, StrLen(s) * 8);
  145.  
  146.       for (j=0; j<n; j++) {
  147.      if (!cnv:integer(i[j],i[j]))
  148.             runerr(101,i[j]);
  149.      if ((j>0) && IntVal(i[j])<=IntVal(i[j-1]))
  150.             runerr(210, i[j]);
  151.  
  152.          }
  153.       /*
  154.        * Start out assuming the result will be the same size as the argument.
  155.        */
  156.       Protect(StrLoc(result) = alcstr(NULL, StrLen(s)), runerr(0));
  157.       StrLen(result) = StrLen(s);
  158.  
  159.       /*
  160.        * Copy the string, expanding tabs.
  161.        */
  162.       last = 1;
  163.       if (n == 0)
  164.          interval = 8;
  165.       else {
  166.          if (!cnv:integer(i[0], i[0]))
  167.             runerr(101, i[0]);
  168.  
  169.          if (IntVal(i[0]) <= last)
  170.             runerr(210, i[0]);
  171.           }
  172.       tablst = i;
  173.       endlst = &i[n];
  174.       col = 1;
  175.       iend = StrLoc(s) + StrLen(s);
  176.       for (in = StrLoc(s), out = StrLoc(result); in < iend; )
  177.          switch (c = *out++ = *in++) {
  178.             case '\b':
  179.                col--;
  180.                tablst = i;  /* reset the list of remaining tab stops */
  181.                last = 1;
  182.                break;
  183.             case LineFeed:
  184.             case CarriageReturn:
  185.                col = 1;
  186.                tablst = i;  /* reset the list of remaining tab stops */
  187.                last = 1;
  188.                break;
  189.             case '\t':
  190.                is_expanded = 1;
  191.                out--;
  192.                target = col;
  193.                nxttab(&target, &tablst, endlst, &last, &interval);
  194.                expand = target - col - 1;
  195.                if (expand > 0) {
  196.                   Protect(alcstr(NULL, expand), runerr(0));
  197.                   StrLen(result) += expand;
  198.                   }
  199.                while (col < target) {
  200.                   *out++ = ' ';
  201.                   col++;
  202.                   }
  203.                break;
  204.             default:
  205.                if (isprint(c))
  206.                   col++;
  207.             }
  208.  
  209.       /*
  210.        * Return new string if indeed there were tabs; otherwise return original
  211.        *  string to conserve memory.
  212.        */
  213.       if (is_expanded)
  214.          return result;
  215.       else {
  216.      MMStr(DiffPtrs(StrLoc(result),strfree)); /* note the deallocation */
  217.      strtotal += DiffPtrs(StrLoc(result),strfree);
  218.          strfree = StrLoc(result);        /* reset the free pointer */
  219.          return s;                /* return original string */
  220.          }
  221.       }
  222. end
  223.  
  224.  
  225.  
  226. "entab(s,i,...) - replace spaces with tabs, with stops at columns indicated."
  227.  
  228. function{1} entab(s,i[n])
  229.    if !cnv:string(s) then
  230.       runerr(103,s)
  231.  
  232.    abstract {
  233.       return string
  234.       }
  235.  
  236.    body {
  237.       C_integer last, interval, col, target, nt, nt1, j;
  238.       dptr tablst;
  239.       dptr endlst;
  240.       char *in, *out, *iend;
  241.       char c;
  242.       int inserted = 0;
  243.  
  244.       for (j=0; j<n; j++) {
  245.      if (!cnv:integer(i[j],i[j]))
  246.             runerr(101,i[j]);
  247.  
  248.      if ((j>0) && IntVal(i[j])<=IntVal(i[j-1]))
  249.             runerr(210, i[j]);
  250.          }
  251.  
  252.       /*
  253.        * Get memory for result at end of string space.  We may give some back
  254.        *  if not all needed, or all of it if no tabs can be inserted.
  255.        */
  256.       Protect(StrLoc(result) = alcstr(NULL, StrLen(s)), runerr(0));
  257.       StrLen(result) = StrLen(s);
  258.  
  259.       /*
  260.        * Copy the string, looking for runs of spaces.
  261.        */
  262.       last = 1;
  263.       if (n == 0)
  264.          interval = 8;
  265.       else {
  266.          if (!cnv:integer(i[0], i[0]))
  267.             runerr(101, i[0]);
  268.          if (IntVal(i[0]) <= last)
  269.             runerr(210, i[0]);
  270.          }
  271.       tablst = i;
  272.       endlst = &i[n];
  273.       col = 1;
  274.       target = 0;
  275.       iend = StrLoc(s) + StrLen(s);
  276.  
  277.       for (in = StrLoc(s), out = StrLoc(result); in < iend; )
  278.          switch (c = *out++ = *in++) {
  279.          case '\b':
  280.             col--;
  281.             tablst = i;  /* reset the list of remaining tab stops */
  282.             last = 1;
  283.             break;
  284.          case LineFeed:
  285.          case CarriageReturn:
  286.             col = 1;
  287.             tablst = i;  /* reset the list of remaining tab stops */
  288.             last = 1;
  289.             break;
  290.          case '\t':
  291.             nxttab(&col, &tablst, endlst, &last, &interval);
  292.             break;
  293.          case ' ':
  294.             target = col + 1;
  295.             while (in < iend && *in == ' ')
  296.                target++, in++;
  297.             if (target - col > 1) { /* never tab just 1; already copied space */
  298.                nt = col;
  299.                nxttab(&nt, &tablst, endlst, &last, &interval);
  300.                if (nt == col+1) {
  301.                   nt1 = nt;
  302.                   nxttab(&nt1, &tablst, endlst, &last, &interval);
  303.                   if (nt1 > target) {
  304.                      col++;    /* keep space to avoid 1-col tab then spaces */
  305.                      nt = nt1;
  306.                      }
  307.                   else
  308.                      out--;    /* back up to begin tabbing */
  309.                   }
  310.                else
  311.                   out--;    /* back up to begin tabbing */
  312.                while (nt <= target)  {
  313.                   inserted = 1;
  314.                   *out++ = '\t';    /* put tabs to tab positions */
  315.                   col = nt;
  316.                   nxttab(&nt, &tablst, endlst, &last, &interval);
  317.                   }
  318.                while (col++ < target)
  319.                   *out++ = ' ';        /* complete gap with spaces */
  320.                }
  321.             col = target;
  322.             break;
  323.          default:
  324.             if (isprint(c))
  325.                col++;
  326.          }
  327.  
  328.       /*
  329.        * Return new string if indeed tabs were inserted; otherwise return
  330.        *  original string (and reset strfree) to conserve memory.
  331.        */
  332.       if (inserted) {
  333.          StrLen(result) = DiffPtrs(out,StrLoc(result));
  334.      MMStr(DiffPtrs(out,strfree));        /* note the deallocation */
  335.      strtotal += DiffPtrs(out,strfree);
  336.          strfree = out;                /* give back unused space */
  337.          return result;                /* return new string */
  338.          }
  339.       else {
  340.      MMStr(DiffPtrs(StrLoc(result),strfree)); /* note the deallocation */
  341.      strtotal += DiffPtrs(StrLoc(result),strfree);
  342.          strfree = StrLoc(result);        /* reset free pointer */
  343.          return s;                /* return original string */
  344.      }
  345.       }
  346. end
  347.  
  348. /*
  349.  * nxttab -- helper routine for entab and detab, returns next tab
  350.  *   beyond col
  351.  */
  352.  
  353. void nxttab(col, tablst, endlst, last, interval)
  354. C_integer *col;
  355. dptr *tablst;
  356. dptr endlst;
  357. C_integer *last;
  358. C_integer *interval;
  359.    {
  360.    /*
  361.     * Look for the right tab stop.
  362.     */
  363.    while (*tablst < endlst && *col >= IntVal((*tablst)[0])) {
  364.       ++*tablst;
  365.       if (*tablst == endlst)
  366.          *interval = IntVal((*tablst)[-1]) - *last;
  367.       else {
  368.          *last = IntVal((*tablst)[-1]);
  369.          }
  370.       }
  371.    if (*tablst >= endlst)
  372.       *col = *col + *interval - (*col - *last) % *interval;
  373.    else
  374.       *col = IntVal((*tablst)[0]);
  375.    }
  376.  
  377.  
  378. "left(s1,i,s2) - pad s1 on right with s2 to length i."
  379.  
  380. function{1} left(s1,n,s2)
  381.    FstrSetup  /* includes body { */
  382.  
  383.       /*
  384.        * If we are extracting the left part of a large string (not padding),
  385.        * just construct a descriptor.
  386.        */
  387.       if (n <= StrLen(s1)) {
  388.      return string(n, StrLoc(s1));
  389.          }
  390.  
  391.       /*
  392.        * Get n bytes of string space.  Start at the right end of the new
  393.        *  string and copy s2 into the new string as many times as it fits.
  394.        *  Note that s2 is copied from right to left.
  395.        */
  396.       Protect(sbuf = alcstr(NULL, n), runerr(0));
  397.  
  398.       slen = StrLen(s2);
  399.       s3 = StrLoc(s2);
  400.       s = sbuf + n;
  401.       while (s > sbuf) {
  402.          st = s3 + slen;
  403.          while (st > s3 && s > sbuf)
  404.             *--s = *--st;
  405.          }
  406.  
  407.       /*
  408.        * Copy up to n bytes of s1 into the new string, starting at the left end
  409.        */
  410.       s = sbuf;
  411.       slen = StrLen(s1);
  412.       st = StrLoc(s1);
  413.       if (slen > n)
  414.          slen = n;
  415.       while (slen-- > 0)
  416.          *s++ = *st++;
  417.  
  418.       /*
  419.        * Return the new string.
  420.        */
  421.       return string(n, sbuf);
  422.       }
  423. end
  424.  
  425.  
  426. "map(s1,s2,s3) - map s1, using s2 and s3."
  427.  
  428. function{1} map(s1,s2,s3)
  429.    /*
  430.     * s1 must be a string; s2 and s3 default to (string conversions of)
  431.     *  &ucase and &lcase, respectively.
  432.     */
  433.    if !cnv:string(s1) then
  434.       runerr(103,s1)
  435. #if COMPILER
  436.    if !def:string(s2, ucase) then
  437.       runerr(103,s2)
  438.    if !def:string(s3, lcase) then
  439.       runerr(103,s3)
  440. #endif                        /* COMPILER */
  441.  
  442.    abstract {
  443.       return string
  444.       }
  445.    body {
  446.       register int i;
  447.       register word slen;
  448.       register char *str1, *str2, *str3;
  449.       static char maptab[256];
  450.  
  451. #if !COMPILER
  452.       if (is:null(s2))
  453.          s2 = ucase;
  454.       if (is:null(s3))
  455.          s3 = lcase;
  456. #endif                    /* !COMPILER */
  457.       /*
  458.        * If s2 and s3 are the same as for the last call of map,
  459.        *  the current values in maptab can be used. Otherwise, the
  460.        *  mapping information must be recomputed.
  461.        */
  462.       if (!EqlDesc(maps2,s2) || !EqlDesc(maps3,s3)) {
  463.          maps2 = s2;
  464.          maps3 = s3;
  465.  
  466. #if !COMPILER
  467.          if (!cnv:string(s2,s2))
  468.             runerr(103,s2);
  469.          if (!cnv:string(s3,s3))
  470.             runerr(103,s3);
  471. #endif                    /* !COMPILER */
  472.          /*
  473.           * s2 and s3 must be of the same length
  474.           */
  475.          if (StrLen(s2) != StrLen(s3))
  476.             runerr(208);
  477.  
  478.          /*
  479.           * The array maptab is used to perform the mapping.  First,
  480.           *  maptab[i] is initialized with i for i from 0 to 255.
  481.           *  Then, for each character in s2, the position in maptab
  482.           *  corresponding to the value of the character is assigned
  483.           *  the value of the character in s3 that is in the same
  484.           *  position as the character from s2.
  485.           */
  486.          str2 = StrLoc(s2);
  487.          str3 = StrLoc(s3);
  488.          for (i = 0; i <= 255; i++)
  489.             maptab[i] = i;
  490.          for (slen = 0; slen < StrLen(s2); slen++)
  491.             maptab[str2[slen]&0377] = str3[slen];
  492.          }
  493.  
  494.       if (StrLen(s1) == 0) {
  495.          return emptystr;
  496.          }
  497.  
  498.       /*
  499.        * The result is a string the size of s1; create the result
  500.        *  string, but specify no value for it.
  501.        */
  502.       StrLen(result) = slen = StrLen(s1);
  503.       Protect(StrLoc(result) = alcstr(NULL, slen), runerr(0));
  504.       str1 = StrLoc(s1);
  505.       str2 = StrLoc(result);
  506.  
  507.       /*
  508.        * Run through the string, using values in maptab to do the
  509.        *  mapping.
  510.        */
  511.       while (slen-- > 0)
  512.          *str2++ = maptab[(*str1++)&0377];
  513.  
  514.       return result;
  515.       }
  516. end
  517.  
  518.  
  519. "repl(s,i) - concatenate i copies of string s."
  520.  
  521. function{1} repl(s,n)
  522.  
  523.    if !cnv:string(s) then
  524.       runerr(103,s)
  525.  
  526.    if !cnv:C_integer(n) then
  527.       runerr(101,n)
  528.  
  529.    abstract {
  530.        return string
  531.        }
  532.  
  533.    body {
  534.       register C_integer cnt;
  535.       register C_integer slen;
  536.       register C_integer size;
  537.       register char * resloc, * sloc, *floc;
  538.  
  539.       if (n < 0) {
  540.          irunerr(205,n);
  541.          errorfail;
  542.          }
  543.  
  544.       slen = StrLen(s);
  545.       /*
  546.        * Return an empty string if n is 0 or if s is the empty string.
  547.        */
  548.       if ((n == 0) || (slen==0))
  549.          return emptystr;
  550.  
  551.       /*
  552.        * Make sure the resulting string will not be too long.
  553.        */
  554.       size = n * slen;
  555.       if (size > MaxStrLen) {
  556.          irunerr(205,n);
  557.          errorfail;
  558.          }
  559.  
  560.       /*
  561.        * Make result a descriptor for the replicated string.
  562.        */
  563.       Protect(resloc = alcstr(NULL, size), runerr(0));
  564.  
  565.       StrLoc(result) = resloc;
  566.       StrLen(result) = size;
  567.  
  568.       /*
  569.        * Fill the allocated area with copies of s.
  570.        */
  571.       sloc = StrLoc(s);
  572.       if (slen == 1)
  573.          memfill(resloc, *sloc, size);
  574.       else {
  575.          while (--n >= 0) {
  576.             floc = sloc;
  577.             cnt = slen;
  578.             while (--cnt >= 0)
  579.                *resloc++ = *floc++;
  580.             }
  581.          }
  582.  
  583.       return result;
  584.       }
  585. end
  586.  
  587.  
  588. "reverse(s) - reverse string s."
  589.  
  590. function{1} reverse(s)
  591.  
  592.    if !cnv:string(s) then
  593.       runerr(103,s)
  594.  
  595.    abstract {
  596.       return string
  597.       }
  598.    body {
  599.       register char c, *floc, *lloc;
  600.       register word slen;
  601.  
  602.       /*
  603.        * Allocate a copy of s.
  604.        */
  605.       slen = StrLen(s);
  606.       Protect(StrLoc(result) = alcstr(StrLoc(s), slen), runerr(0));
  607.       StrLen(result) = slen;
  608.  
  609.       /*
  610.        * Point floc at the start of s and lloc at the end of s.  Work floc
  611.        *  and sloc along s in opposite directions, swapping the characters
  612.        *  at floc and lloc.
  613.        */
  614.       floc = StrLoc(result);
  615.       lloc = floc + --slen;
  616.       while (floc < lloc) {
  617.          c = *floc;
  618.          *floc++ = *lloc;
  619.          *lloc-- = c;
  620.          }
  621.       return result;
  622.       }
  623. end
  624.  
  625.  
  626. "right(s1,i,s2) - pad s1 on left with s2 to length i."
  627.  
  628. function{1} right(s1,n,s2)
  629.    FstrSetup  /* includes body { */
  630.       /*
  631.        * If we are extracting the right part of a large string (not padding),
  632.        * just construct a descriptor.
  633.        */
  634.       if (n <= StrLen(s1)) {
  635.      return string(n, StrLoc(s1) + StrLen(s1) - n);
  636.          }
  637.  
  638.       /*
  639.        * Get n bytes of string space.  Start at the left end of the new
  640.        *  string and copy s2 into the new string as many times as it fits.
  641.        */
  642.       Protect(sbuf = alcstr(NULL, n), runerr(0));
  643.  
  644.       slen = StrLen(s2);
  645.       s3 = StrLoc(s2);
  646.       s = sbuf;
  647.       while (s < sbuf + n) {
  648.          st = s3;
  649.          while (st < s3 + slen && s < sbuf + n)
  650.             *s++ = *st++;
  651.          }
  652.  
  653.       /*
  654.        * Copy s1 into the new string, starting at the right end and copying
  655.        * s2 from right to left.  If *s1 > n, only copy n bytes.
  656.        */
  657.       s = sbuf + n;
  658.       slen = StrLen(s1);
  659.       st = StrLoc(s1) + slen;
  660.       if (slen > n)
  661.          slen = n;
  662.       while (slen-- > 0)
  663.          *--s = *--st;
  664.  
  665.       /*
  666.        * Return the new string.
  667.        */
  668.       return string(n, sbuf);
  669.       }
  670. end
  671.  
  672.  
  673. "trim(s,c) - trim trailing characters in c from s."
  674.  
  675. function{1} trim(s,c)
  676.  
  677.    if !cnv:string(s) then
  678.       runerr(103, s)
  679.    /*
  680.     * c defaults to a cset containing a blank.
  681.     */
  682.    if !def:tmp_cset(c,blankcs) then
  683.       runerr(104, c)
  684.  
  685.    abstract {
  686.       return string
  687.       }
  688.  
  689.    body {
  690.       char *sloc;
  691.       C_integer slen;
  692.  
  693.       /*
  694.        * Start at the end of s and then back up until a character that is
  695.        *  not in c is found.  The actual trimming is done by having a
  696.        *  descriptor that points at a substring of s, but with the length
  697.        *  reduced.
  698.        */
  699.       slen = StrLen(s);
  700.       sloc = StrLoc(s) + slen - 1;
  701.       while (sloc >= StrLoc(s) && Testb(ToAscii(*sloc), c)) {
  702.          sloc--;
  703.          slen--;
  704.          }
  705.       return string(slen, StrLoc(s));
  706.       }
  707. end
  708.