contrib/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 #ifdef KR_headers
  11  extern char *F77_aloc();
  12  extern void free();
  13  extern void G77_exit_0 ();
  14 #else
  15 #undef min
  16 #undef max
  17 #include <stdlib.h>
  18  extern char *F77_aloc(ftnlen, char*);
  19 #endif
  20 #include <string.h>
  21 #endif /* NO_OVERWRITE */
  22
  23  VOID
  24 #ifdef KR_headers
  25 s_cat(lp, rpp, rnp, np, ll) char *lp, *rpp[]; ftnlen rnp[], *np, ll;
  26 #else
  27 s_cat(char *lp, char *rpp[], ftnlen rnp[], ftnlen *np, ftnlen ll)
  28 #endif
  29 {
  30         ftnlen i, nc;
  31         char *rp;
  32         ftnlen n = *np;
  33 #ifndef NO_OVERWRITE
  34         ftnlen L, m;
  35         char *lp0, *lp1;
  36
  37         lp0 = 0;
  38         lp1 = lp;
  39         L = ll;
  40         i = 0;
  41         while(i < n) {
  42                 rp = rpp[i];
  43                 m = rnp[i++];
  44                 if (rp >= lp1 || rp + m <= lp) {
  45                         if ((L -= m) <= 0) {
  46                                 n = i;
  47                                 break;
  48                                 }
  49                         lp1 += m;
  50                         continue;
  51                         }
  52                 lp0 = lp;
  53                 lp = lp1 = F77_aloc(L = ll, "s_cat");
  54                 break;
  55                 }
  56         lp1 = lp;
  57 #endif /* NO_OVERWRITE */
  58         for(i = 0 ; i < n ; ++i) {
  59                 nc = ll;
  60                 if(rnp[i] < nc)
  61                         nc = rnp[i];
  62                 ll -= nc;
  63                 rp = rpp[i];
  64                 while(--nc >= 0)
  65                         *lp++ = *rp++;
  66                 }
  67         while(--ll >= 0)
  68                 *lp++ = ' ';
  69 #ifndef NO_OVERWRITE
  70         if (lp0) {
  71                 memcpy(lp0, lp1, L);
  72                 free(lp1);
  73                 }
  74 #endif
  75         }