s_cat.c 1.4 KB

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