annotate ext/clapack/src/s_cat.c @ 209:ccd2019190bf msvc

Some MSVC fixes, including (temporarily, probably) renaming the FFT source file to avoid getting it mixed up with the Vamp SDK one in our object dir
author Chris Cannam
date Thu, 01 Feb 2018 16:34:08 +0000
parents 45330e0d2819
children
rev   line source
Chris@202 1 /* Unless compiled with -DNO_OVERWRITE, this variant of s_cat allows the
Chris@202 2 * target of a concatenation to appear on its right-hand side (contrary
Chris@202 3 * to the Fortran 77 Standard, but in accordance with Fortran 90).
Chris@202 4 */
Chris@202 5
Chris@202 6 #include "f2c.h"
Chris@202 7 #ifndef NO_OVERWRITE
Chris@202 8 #include "stdio.h"
Chris@202 9 #undef abs
Chris@202 10 #ifdef KR_headers
Chris@202 11 extern char *F77_aloc();
Chris@202 12 extern void free();
Chris@202 13 extern void exit_();
Chris@202 14 #else
Chris@202 15 #undef min
Chris@202 16 #undef max
Chris@202 17 #include "stdlib.h"
Chris@202 18 extern
Chris@202 19 #ifdef __cplusplus
Chris@202 20 "C"
Chris@202 21 #endif
Chris@202 22 char *F77_aloc(ftnlen, const char*);
Chris@202 23 #endif
Chris@202 24 #include "string.h"
Chris@202 25 #endif /* NO_OVERWRITE */
Chris@202 26
Chris@202 27 #ifdef __cplusplus
Chris@202 28 extern "C" {
Chris@202 29 #endif
Chris@202 30
Chris@202 31 VOID
Chris@202 32 #ifdef KR_headers
Chris@202 33 s_cat(lp, rpp, rnp, np, ll) char *lp, *rpp[]; ftnint rnp[], *np; ftnlen ll;
Chris@202 34 #else
Chris@202 35 s_cat(char *lp, char *rpp[], ftnint rnp[], ftnint *np, ftnlen ll)
Chris@202 36 #endif
Chris@202 37 {
Chris@202 38 ftnlen i, nc;
Chris@202 39 char *rp;
Chris@202 40 ftnlen n = *np;
Chris@202 41 #ifndef NO_OVERWRITE
Chris@202 42 ftnlen L, m;
Chris@202 43 char *lp0, *lp1;
Chris@202 44
Chris@202 45 lp0 = 0;
Chris@202 46 lp1 = lp;
Chris@202 47 L = ll;
Chris@202 48 i = 0;
Chris@202 49 while(i < n) {
Chris@202 50 rp = rpp[i];
Chris@202 51 m = rnp[i++];
Chris@202 52 if (rp >= lp1 || rp + m <= lp) {
Chris@202 53 if ((L -= m) <= 0) {
Chris@202 54 n = i;
Chris@202 55 break;
Chris@202 56 }
Chris@202 57 lp1 += m;
Chris@202 58 continue;
Chris@202 59 }
Chris@202 60 lp0 = lp;
Chris@202 61 lp = lp1 = F77_aloc(L = ll, "s_cat");
Chris@202 62 break;
Chris@202 63 }
Chris@202 64 lp1 = lp;
Chris@202 65 #endif /* NO_OVERWRITE */
Chris@202 66 for(i = 0 ; i < n ; ++i) {
Chris@202 67 nc = ll;
Chris@202 68 if(rnp[i] < nc)
Chris@202 69 nc = rnp[i];
Chris@202 70 ll -= nc;
Chris@202 71 rp = rpp[i];
Chris@202 72 while(--nc >= 0)
Chris@202 73 *lp++ = *rp++;
Chris@202 74 }
Chris@202 75 while(--ll >= 0)
Chris@202 76 *lp++ = ' ';
Chris@202 77 #ifndef NO_OVERWRITE
Chris@202 78 if (lp0) {
Chris@202 79 memcpy(lp0, lp1, L);
Chris@202 80 free(lp1);
Chris@202 81 }
Chris@202 82 #endif
Chris@202 83 }
Chris@202 84 #ifdef __cplusplus
Chris@202 85 }
Chris@202 86 #endif