libf2c/libF77/s_cat.c

   1 /* Unless compiled with -DNO_OVERWRITE, this variant of s_cat allows the
   2  * target of a concatenation to appear on its right-hand side (contrary
   3  * to the Fortran 77 Standard, but in accordance with Fortran 90).
   4  */
   5
   6 #include "f2c.h"
   7 #ifndef NO_OVERWRITE
   8 #include <stdio.h>
   9 #undef abs
  10 #undef min
  11 #undef max
  12 #include <stdlib.h>
  13 extern char *F77_aloc (ftnlen, char *);
  14 #include <string.h>
  15 #endif /* NO_OVERWRITE */
  16
  17 void
  18 s_cat (char *lp, char *rpp[], ftnint rnp[], ftnint * np, ftnlen ll)
  19 {
  20   ftnlen i, nc;
  21   char *rp;
  22   ftnlen n = *np;
  23 #ifndef NO_OVERWRITE
  24   ftnlen L, m;
  25   char *lp0, *lp1;
  26
  27   lp0 = 0;
  28   lp1 = lp;
  29   L = ll;
  30   i = 0;
  31   while (i < n)
  32     {
  33       rp = rpp[i];
  34       m = rnp[i++];
  35       if (rp >= lp1 || rp + m <= lp)
  36         {
  37           if ((L -= m) <= 0)
  38             {
  39               n = i;
  40               break;
  41             }
  42           lp1 += m;
  43           continue;
  44         }
  45       lp0 = lp;
  46       lp = lp1 = F77_aloc (L = ll, "s_cat");
  47       break;
  48     }
  49   lp1 = lp;
  50 #endif /* NO_OVERWRITE */
  51   for (i = 0; i < n; ++i)
  52     {
  53       nc = ll;
  54       if (rnp[i] < nc)
  55         nc = rnp[i];
  56       ll -= nc;
  57       rp = rpp[i];
  58       while (--nc >= 0)
  59         *lp++ = *rp++;
  60     }
  61   while (--ll >= 0)
  62     *lp++ = ' ';
  63 #ifndef NO_OVERWRITE
  64   if (lp0)
  65     {
  66       memcpy (lp0, lp1, L);
  67       free (lp1);
  68     }
  69 #endif
  70 }