Skip to content

Commit edbc0c7

Browse files
committed
Ensure thread safety of slamch APIs
Appended thread local storage attribute for static variables in slamch functions Change-Id: I662457372b06ac3ed6248d568e4227d26e9249cd
1 parent 232514c commit edbc0c7

File tree

2 files changed

+62
-62
lines changed

2 files changed

+62
-62
lines changed

src/base/flamec/util/lapack/mch/fla_slamch.c

Lines changed: 56 additions & 56 deletions
Original file line numberDiff line numberDiff line change
@@ -15,15 +15,15 @@
1515
#ifdef __cplusplus
1616
extern "C" {
1717
#endif
18-
#include "FLA_f2c.h"
18+
#include "FLAME.h"
1919
#include "stdio.h"
2020

2121
/* Table of constant values */
2222

23-
//static integer c__1 = 1;
24-
static real c_b32 = (float)0.;
23+
//static TLS_CLASS_SPEC integer c__1 = 1;
24+
static TLS_CLASS_SPEC real c_b32 = (float)0.;
2525

26-
double fla_pow_ri(real *ap, integer *bp)
26+
double fla_pow_realint(real *ap, integer *bp)
2727
{
2828
double pow, x;
2929
integer n;
@@ -57,28 +57,28 @@ real fla_slamch(char *cmach, ftnlen cmach_len)
5757
{
5858
/* Initialized data */
5959

60-
static logical first = TRUE_;
60+
static TLS_CLASS_SPEC logical first = TRUE_;
6161

6262
/* System generated locals */
6363
integer i__1;
6464
real ret_val;
6565

6666
/* Builtin functions */
67-
double fla_pow_ri(real *, integer *);
67+
double fla_pow_realint(real *, integer *);
6868

6969
/* Local variables */
70-
static real base;
71-
static integer beta;
72-
static real emin, prec, emax;
73-
static integer imin, imax;
74-
static logical lrnd;
75-
static real rmin, rmax, t, rmach;
70+
static TLS_CLASS_SPEC real base;
71+
static TLS_CLASS_SPEC integer beta;
72+
static TLS_CLASS_SPEC real emin, prec, emax;
73+
static TLS_CLASS_SPEC integer imin, imax;
74+
static TLS_CLASS_SPEC logical lrnd;
75+
static TLS_CLASS_SPEC real rmin, rmax, t, rmach;
7676
extern logical fla_lsame(char *, char *, ftnlen, ftnlen);
77-
static real small, sfmin;
77+
static TLS_CLASS_SPEC real small, sfmin;
7878
extern /* Subroutine */ integer fla_slamc2(integer *, integer *, logical *, real
7979
*, integer *, real *, integer *, real *);
80-
static integer it;
81-
static real rnd, eps;
80+
static TLS_CLASS_SPEC integer it;
81+
static TLS_CLASS_SPEC real rnd, eps;
8282

8383

8484
/* -- LAPACK auxiliary routine (version 3.2) -- */
@@ -145,11 +145,11 @@ real fla_slamch(char *cmach, ftnlen cmach_len)
145145
if (lrnd) {
146146
rnd = (float)1.;
147147
i__1 = 1 - it;
148-
eps = fla_pow_ri(&base, &i__1) / 2;
148+
eps = fla_pow_realint(&base, &i__1) / 2;
149149
} else {
150150
rnd = (float)0.;
151151
i__1 = 1 - it;
152-
eps = fla_pow_ri(&base, &i__1);
152+
eps = fla_pow_realint(&base, &i__1);
153153
}
154154
prec = eps * base;
155155
emin = (real) imin;
@@ -203,21 +203,21 @@ real fla_slamch(char *cmach, ftnlen cmach_len)
203203
{
204204
/* Initialized data */
205205

206-
static logical first = TRUE_;
206+
static TLS_CLASS_SPEC logical first = TRUE_;
207207

208208
/* System generated locals */
209209
real r__1, r__2;
210210

211211
/* Local variables */
212-
static logical lrnd;
213-
static real a, b, c__, f;
214-
static integer lbeta;
215-
static real savec;
216-
static logical lieee1;
217-
static real t1, t2;
212+
static TLS_CLASS_SPEC logical lrnd;
213+
static TLS_CLASS_SPEC real a, b, c__, f;
214+
static TLS_CLASS_SPEC integer lbeta;
215+
static TLS_CLASS_SPEC real savec;
216+
static TLS_CLASS_SPEC logical lieee1;
217+
static TLS_CLASS_SPEC real t1, t2;
218218
extern real fla_slamc3(real *, real *);
219-
static integer lt;
220-
static real one, qtr;
219+
static TLS_CLASS_SPEC integer lt;
220+
static TLS_CLASS_SPEC real one, qtr;
221221

222222

223223
/* -- LAPACK auxiliary routine (version 3.2) -- */
@@ -411,11 +411,11 @@ real fla_slamch(char *cmach, ftnlen cmach_len)
411411
{
412412
/* Initialized data */
413413

414-
static logical first = TRUE_;
415-
static logical iwarn = FALSE_;
414+
static TLS_CLASS_SPEC logical first = TRUE_;
415+
static TLS_CLASS_SPEC logical iwarn = FALSE_;
416416

417417
/* Format strings */
418-
static char fmt_9999[] = "(//\002 WARNING. The value EMIN may be incorre\
418+
static TLS_CLASS_SPEC char fmt_9999[] = "(//\002 WARNING. The value EMIN may be incorre\
419419
ct:-\002,\002 EMIN = \002,i8,/\002 If, after inspection, the value EMIN loo\
420420
ks\002,\002 acceptable please comment out \002,/\002 the IF block as marked \
421421
within the code of routine\002,\002 SLAMC2,\002,/\002 otherwise supply EMIN \
@@ -426,32 +426,32 @@ explicitly.\002,/)";
426426
real r__1, r__2, r__3, r__4, r__5;
427427

428428
/* Builtin functions */
429-
double fla_pow_ri(real *, integer *);
429+
double fla_pow_realint(real *, integer *);
430430
//integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe();
431431

432432
/* Local variables */
433-
static logical ieee;
434-
static real half;
435-
static logical lrnd;
436-
static real leps, zero, a, b, c__;
437-
static integer i__, lbeta;
438-
static real rbase;
439-
static integer lemin, lemax, gnmin;
440-
static real small;
441-
static integer gpmin;
442-
static real third, lrmin, lrmax, sixth;
443-
static logical lieee1;
433+
static TLS_CLASS_SPEC logical ieee;
434+
static TLS_CLASS_SPEC real half;
435+
static TLS_CLASS_SPEC logical lrnd;
436+
static TLS_CLASS_SPEC real leps, zero, a, b, c__;
437+
static TLS_CLASS_SPEC integer i__, lbeta;
438+
static TLS_CLASS_SPEC real rbase;
439+
static TLS_CLASS_SPEC integer lemin, lemax, gnmin;
440+
static TLS_CLASS_SPEC real small;
441+
static TLS_CLASS_SPEC integer gpmin;
442+
static TLS_CLASS_SPEC real third, lrmin, lrmax, sixth;
443+
static TLS_CLASS_SPEC logical lieee1;
444444
extern /* Subroutine */ integer fla_slamc1(integer *, integer *, logical *,
445445
logical *);
446446
extern real fla_slamc3(real *, real *);
447447
extern /* Subroutine */ integer fla_slamc4(integer *, real *, integer *),
448448
fla_slamc5(integer *, integer *, integer *, logical *, integer *,
449449
real *);
450-
static integer lt, ngnmin, ngpmin;
451-
static real one, two;
450+
static TLS_CLASS_SPEC integer lt, ngnmin, ngpmin;
451+
static TLS_CLASS_SPEC real one, two;
452452

453453
/* Fortran I/O blocks */
454-
//static cilist io___58 = { 0, 6, 0, fmt_9999, 0 };
454+
//static TLS_CLASS_SPEC cilist io___58 = { 0, 6, 0, fmt_9999, 0 };
455455

456456

457457

@@ -548,7 +548,7 @@ explicitly.\002,/)";
548548

549549
b = (real) lbeta;
550550
i__1 = -lt;
551-
a = fla_pow_ri(&b, &i__1);
551+
a = fla_pow_realint(&b, &i__1);
552552
leps = a;
553553

554554
/* Try some tricks to see whether or not this is the correct EPS. */
@@ -767,11 +767,11 @@ real fla_slamc3(real *a, real *b)
767767
real r__1;
768768

769769
/* Local variables */
770-
static real zero, a;
771-
static integer i__;
772-
static real rbase, b1, b2, c1, c2, d1, d2;
770+
static TLS_CLASS_SPEC real zero, a;
771+
static TLS_CLASS_SPEC integer i__;
772+
static TLS_CLASS_SPEC real rbase, b1, b2, c1, c2, d1, d2;
773773
extern real fla_slamc3(real *, real *);
774-
static real one;
774+
static TLS_CLASS_SPEC real one;
775775

776776

777777
/* -- LAPACK auxiliary routine (version 3.2) -- */
@@ -866,14 +866,14 @@ real fla_slamc3(real *a, real *b)
866866
real r__1;
867867

868868
/* Local variables */
869-
static integer lexp;
870-
static real oldy;
871-
static integer uexp, i__;
872-
static real y, z__;
873-
static integer nbits;
869+
static TLS_CLASS_SPEC integer lexp;
870+
static TLS_CLASS_SPEC real oldy;
871+
static TLS_CLASS_SPEC integer uexp, i__;
872+
static TLS_CLASS_SPEC real y, z__;
873+
static TLS_CLASS_SPEC integer nbits;
874874
extern real fla_slamc3(real *, real *);
875-
static real recbas;
876-
static integer exbits, expsum, try__;
875+
static TLS_CLASS_SPEC real recbas;
876+
static TLS_CLASS_SPEC integer exbits, expsum, try__;
877877

878878

879879
/* -- LAPACK auxiliary routine (version 3.2) -- */

src/map/lapack2flamec/f2c/install/static/slamch.c

Lines changed: 6 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -1,22 +1,22 @@
1-
#include "FLA_f2c.h"
1+
#include "FLAME.h"
22
#include <float.h>
33

44
/* Table of constant values */
55

6-
static const real half = 0.5f;
7-
static const real one = 1.f;
8-
static const real zero = 0.f;
6+
static TLS_CLASS_SPEC const real half = 0.5f;
7+
static TLS_CLASS_SPEC const real one = 1.f;
8+
static TLS_CLASS_SPEC const real zero = 0.f;
99

1010
real slamch_(char *cmach)
1111
{
1212
/* Initialized data */
13-
static logical first = TRUE_;
13+
static TLS_CLASS_SPEC logical first = TRUE_;
1414

1515
/* System generated locals */
1616
real ret_val;
1717

1818
/* Local variables */
19-
static real eps, sfmin, base, prec, t, rnd, emin, rmin, emax, rmax;
19+
static TLS_CLASS_SPEC real eps, sfmin, base, prec, t, rnd, emin, rmin, emax, rmax;
2020
real rmach, small;
2121

2222
extern logical lsame_(char *, char *);

0 commit comments

Comments
 (0)