source: trunk/gcc/libf2c/libF77/s_cat.c

Last change on this file was 1392, checked in by bird, 21 years ago

This commit was generated by cvs2svn to compensate for changes in r1391,
which included commits to RCS files with non-trunk default branches.

  • Property cvs2svn:cvs-rev set to 1.1.1.2
  • Property svn:eol-style set to native
  • Property svn:executable set to *
File size: 1.2 KB
Line 
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>
13extern char *F77_aloc (ftnlen, char *);
14#include <string.h>
15#endif /* NO_OVERWRITE */
16
17void
18s_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}
Note: See TracBrowser for help on using the repository browser.