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