annotate ext/cblas/src/lsame.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 /* lsame.f -- translated by f2c (version 20061008).
Chris@202 2 You must link the resulting object file with libf2c:
Chris@202 3 on Microsoft Windows system, link with libf2c.lib;
Chris@202 4 on Linux or Unix systems, link with .../path/to/libf2c.a -lm
Chris@202 5 or, if you install libf2c.a in a standard place, with -lf2c -lm
Chris@202 6 -- in that order, at the end of the command line, as in
Chris@202 7 cc *.o -lf2c -lm
Chris@202 8 Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
Chris@202 9
Chris@202 10 http://www.netlib.org/f2c/libf2c.zip
Chris@202 11 */
Chris@202 12
Chris@202 13 #include "f2c.h"
Chris@202 14 #include "blaswrap.h"
Chris@202 15
Chris@202 16 logical lsame_(char *ca, char *cb)
Chris@202 17 {
Chris@202 18 /* System generated locals */
Chris@202 19 logical ret_val;
Chris@202 20
Chris@202 21 /* Local variables */
Chris@202 22 integer inta, intb, zcode;
Chris@202 23
Chris@202 24
Chris@202 25 /* -- LAPACK auxiliary routine (version 3.1) -- */
Chris@202 26 /* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
Chris@202 27 /* November 2006 */
Chris@202 28
Chris@202 29 /* .. Scalar Arguments .. */
Chris@202 30 /* .. */
Chris@202 31
Chris@202 32 /* Purpose */
Chris@202 33 /* ======= */
Chris@202 34
Chris@202 35 /* LSAME returns .TRUE. if CA is the same letter as CB regardless of */
Chris@202 36 /* case. */
Chris@202 37
Chris@202 38 /* Arguments */
Chris@202 39 /* ========= */
Chris@202 40
Chris@202 41 /* CA (input) CHARACTER*1 */
Chris@202 42
Chris@202 43 /* CB (input) CHARACTER*1 */
Chris@202 44 /* CA and CB specify the single characters to be compared. */
Chris@202 45
Chris@202 46 /* ===================================================================== */
Chris@202 47
Chris@202 48 /* .. Intrinsic Functions .. */
Chris@202 49 /* .. */
Chris@202 50 /* .. Local Scalars .. */
Chris@202 51 /* .. */
Chris@202 52
Chris@202 53 /* Test if the characters are equal */
Chris@202 54
Chris@202 55 ret_val = *(unsigned char *)ca == *(unsigned char *)cb;
Chris@202 56 if (ret_val) {
Chris@202 57 return ret_val;
Chris@202 58 }
Chris@202 59
Chris@202 60 /* Now test for equivalence if both characters are alphabetic. */
Chris@202 61
Chris@202 62 zcode = 'Z';
Chris@202 63
Chris@202 64 /* Use 'Z' rather than 'A' so that ASCII can be detected on Prime */
Chris@202 65 /* machines, on which ICHAR returns a value with bit 8 set. */
Chris@202 66 /* ICHAR('A') on Prime machines returns 193 which is the same as */
Chris@202 67 /* ICHAR('A') on an EBCDIC machine. */
Chris@202 68
Chris@202 69 inta = *(unsigned char *)ca;
Chris@202 70 intb = *(unsigned char *)cb;
Chris@202 71
Chris@202 72 if (zcode == 90 || zcode == 122) {
Chris@202 73
Chris@202 74 /* ASCII is assumed - ZCODE is the ASCII code of either lower or */
Chris@202 75 /* upper case 'Z'. */
Chris@202 76
Chris@202 77 if (inta >= 97 && inta <= 122) {
Chris@202 78 inta += -32;
Chris@202 79 }
Chris@202 80 if (intb >= 97 && intb <= 122) {
Chris@202 81 intb += -32;
Chris@202 82 }
Chris@202 83
Chris@202 84 } else if (zcode == 233 || zcode == 169) {
Chris@202 85
Chris@202 86 /* EBCDIC is assumed - ZCODE is the EBCDIC code of either lower or */
Chris@202 87 /* upper case 'Z'. */
Chris@202 88
Chris@202 89 if (inta >= 129 && inta <= 137 || inta >= 145 && inta <= 153 || inta
Chris@202 90 >= 162 && inta <= 169) {
Chris@202 91 inta += 64;
Chris@202 92 }
Chris@202 93 if (intb >= 129 && intb <= 137 || intb >= 145 && intb <= 153 || intb
Chris@202 94 >= 162 && intb <= 169) {
Chris@202 95 intb += 64;
Chris@202 96 }
Chris@202 97
Chris@202 98 } else if (zcode == 218 || zcode == 250) {
Chris@202 99
Chris@202 100 /* ASCII is assumed, on Prime machines - ZCODE is the ASCII code */
Chris@202 101 /* plus 128 of either lower or upper case 'Z'. */
Chris@202 102
Chris@202 103 if (inta >= 225 && inta <= 250) {
Chris@202 104 inta += -32;
Chris@202 105 }
Chris@202 106 if (intb >= 225 && intb <= 250) {
Chris@202 107 intb += -32;
Chris@202 108 }
Chris@202 109 }
Chris@202 110 ret_val = inta == intb;
Chris@202 111
Chris@202 112 /* RETURN */
Chris@202 113
Chris@202 114 /* End of LSAME */
Chris@202 115
Chris@202 116 return ret_val;
Chris@202 117 } /* lsame_ */