Mercurial > hg > qm-dsp

annotate ext/cblas/src/lsame.c @ 501:12b5a9244bb0

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