annotate ext/clapack/src/s_copy.c @ 495:1bea13b8f951
Style fixes in constant-Q: avoid unsigned, reuse our Window class, fix
comments
author |
Chris Cannam <cannam@all-day-breakfast.com> |
date |
Fri, 31 May 2019 18:25:31 +0100 |
parents |
905e45637745 |
children |
|
rev |
line source |
c@427
|
1 /* Unless compiled with -DNO_OVERWRITE, this variant of s_copy allows the
|
c@427
|
2 * target of an assignment to appear on its right-hand side (contrary
|
c@427
|
3 * to the Fortran 77 Standard, but in accordance with Fortran 90),
|
c@427
|
4 * as in a(2:5) = a(4:7) .
|
c@427
|
5 */
|
c@427
|
6
|
c@427
|
7 #include "f2c.h"
|
c@427
|
8 #ifdef __cplusplus
|
c@427
|
9 extern "C" {
|
c@427
|
10 #endif
|
c@427
|
11
|
c@427
|
12 /* assign strings: a = b */
|
c@427
|
13
|
c@427
|
14 #ifdef KR_headers
|
c@427
|
15 VOID s_copy(a, b, la, lb) register char *a, *b; ftnlen la, lb;
|
c@427
|
16 #else
|
c@427
|
17 void s_copy(register char *a, register char *b, ftnlen la, ftnlen lb)
|
c@427
|
18 #endif
|
c@427
|
19 {
|
c@427
|
20 register char *aend, *bend;
|
c@427
|
21
|
c@427
|
22 aend = a + la;
|
c@427
|
23
|
c@427
|
24 if(la <= lb)
|
c@427
|
25 #ifndef NO_OVERWRITE
|
c@427
|
26 if (a <= b || a >= b + la)
|
c@427
|
27 #endif
|
c@427
|
28 while(a < aend)
|
c@427
|
29 *a++ = *b++;
|
c@427
|
30 #ifndef NO_OVERWRITE
|
c@427
|
31 else
|
c@427
|
32 for(b += la; a < aend; )
|
c@427
|
33 *--aend = *--b;
|
c@427
|
34 #endif
|
c@427
|
35
|
c@427
|
36 else {
|
c@427
|
37 bend = b + lb;
|
c@427
|
38 #ifndef NO_OVERWRITE
|
c@427
|
39 if (a <= b || a >= bend)
|
c@427
|
40 #endif
|
c@427
|
41 while(b < bend)
|
c@427
|
42 *a++ = *b++;
|
c@427
|
43 #ifndef NO_OVERWRITE
|
c@427
|
44 else {
|
c@427
|
45 a += lb;
|
c@427
|
46 while(b < bend)
|
c@427
|
47 *--a = *--bend;
|
c@427
|
48 a += lb;
|
c@427
|
49 }
|
c@427
|
50 #endif
|
c@427
|
51 while(a < aend)
|
c@427
|
52 *a++ = ' ';
|
c@427
|
53 }
|
c@427
|
54 }
|
c@427
|
55 #ifdef __cplusplus
|
c@427
|
56 }
|
c@427
|
57 #endif
|