Skip to content

Commit 793fd8f

Browse files
mohawk2mohawk2
committed
fix select-function declarations for C23 - #30 
1 parent f99115b commit 793fd8f

File tree

3 files changed

+32
-68
lines changed

3 files changed

+32
-68
lines changed

‎Changes

+2
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,5 @@
1+
- fix select-function declarations for C23 (#30) - thanks @sebastic for report
2+
13
0.433 2025-01-06
24
- make Trans::toreal do nothing if given real-typed data
35

‎lib/PDL/LinearAlgebra/Complex.pd

+14-33
Original file line numberDiff line numberDiff line change
@@ -32,18 +32,14 @@ typedef PDL_Long logical;
3232
typedef PDL_Long integer;
3333
typedef PDL_Long ftnlen;
3434

35-
#ifdef __cplusplus
36-
typedef logical (*L_fp)(...);
37-
#else
38-
typedef logical (*L_fp)();
39-
#endif
40-
41-
#ifndef min
42-
#define min(a,b) ((a) <= (b) ? (a) : (b))
43-
#endif
44-
#ifndef max
45-
#define max(a,b) ((a) >= (b) ? (a) : (b))
46-
#endif
35+
#define DEF_SEL_FUNC(letter, letter2, args) \
36+
void letter ## letter2 ## select_func_set(SV* func); \
37+
logical letter ## letter2 ## select_wrapper args; \
38+
typedef logical (*L_ ## letter ## letter2 ## p) args;
39+
DEF_SEL_FUNC(f, , (complex float *p))
40+
DEF_SEL_FUNC(d, , (complex double *p))
41+
DEF_SEL_FUNC(f, g, (complex float *p, complex float *q))
42+
DEF_SEL_FUNC(d, g, (complex double *p, complex double *q))
4743

4844
extern integer FORTRAN(ilaenv)(integer *ispec, char *name__, char *opts, integer *n1,
4945
integer *n2, integer *n3, integer *n4, ftnlen name_len, ftnlen
@@ -810,16 +806,9 @@ EOF
810806
}
811807
');
812808

813-
pp_addhdr('
814-
void fselect_func_set(SV* func);
815-
void dselect_func_set(SV* func);
816-
PDL_Long fselect_wrapper(float *p);
817-
PDL_Long dselect_wrapper(double *p);
818-
');
819-
820809
pp_defc("gees",
821810
_decl => <<'EOF',
822-
extern int FORTRAN($TFD(c,z)gees)(char *jobvs, char *sort, L_fp select, integer *n,
811+
extern int FORTRAN($TFD(c,z)gees)(char *jobvs, char *sort, L_$TFD(f,d)p select, integer *n,
823812
$GENERIC() *a, integer *lda, integer *sdim, $GENERIC() *w,
824813
$GENERIC() *vs, integer *ldvs, $GENERIC() *work,
825814
integer *lwork, $GENERIC() *rwork, logical *bwork, integer *info);
@@ -906,7 +895,7 @@ Complex version of L<PDL::LinearAlgebra::Real/gees>
906895

907896
pp_defc("geesx",
908897
_decl => <<'EOF',
909-
extern int FORTRAN($TFD(c,z)geesx)(char *jobvs, char *sort, L_fp select, char * sense,
898+
extern int FORTRAN($TFD(c,z)geesx)(char *jobvs, char *sort, L_$TFD(f,d)p select, char * sense,
910899
integer *n, $GENERIC() *a, integer *lda, integer *sdim, $GENERIC() *w,
911900
$GENERIC() *vs, integer *ldvs, $GENERIC() *rconde, $GENERIC() *rcondv,
912901
$GENERIC() *work, integer *lwork, $GENERIC() *rwork,
@@ -1007,16 +996,9 @@ Complex version of L<PDL::LinearAlgebra::Real/geesx>
1007996
case info is set to N+2.
1008997
');
1009998

1010-
pp_addhdr('
1011-
void fgselect_func_set(SV* func);
1012-
void dgselect_func_set(SV* func);
1013-
PDL_Long fgselect_wrapper(float *p);
1014-
PDL_Long dgselect_wrapper(double *p);
1015-
');
1016-
1017999
pp_defc("gges",
10181000
_decl => <<'EOF',
1019-
extern int FORTRAN($TFD(c,z)gges)(char *jobvsl, char *jobvsr, char *sort, L_fp
1001+
extern int FORTRAN($TFD(c,z)gges)(char *jobvsl, char *jobvsr, char *sort, L_$TFD(f,d)gp
10201002
delctg, integer *n, $GENERIC() *a, integer *lda, $GENERIC() *b,
10211003
integer *ldb, integer *sdim, $GENERIC() *alpha,
10221004
$GENERIC() *beta, $GENERIC() *vsl, integer *ldvsl, $GENERIC() *vsr,
@@ -1116,7 +1098,7 @@ Complex version of L<PDL::LinearAlgebra::Real/ggees>
11161098

11171099
pp_defc("ggesx",
11181100
_decl => <<'EOF',
1119-
extern int FORTRAN($TFD(c,z)ggesx)(char *jobvsl, char *jobvsr, char *sort, L_fp
1101+
extern int FORTRAN($TFD(c,z)ggesx)(char *jobvsl, char *jobvsr, char *sort, L_$TFD(f,d)gp
11201102
delctg, char *sense, integer *n, $GENERIC() *a, integer *lda, $GENERIC() *b,
11211103
integer *ldb, integer *sdim, $GENERIC() *alpha,
11221104
$GENERIC() *beta, $GENERIC() *vsl, integer *ldvsl, $GENERIC() *vsr,
@@ -1174,10 +1156,10 @@ EOF
11741156
integer i__1 = maxwrk;
11751157
integer i__2 = $SIZE(n) + $SIZE(n) * FORTRAN(ilaenv)(&c__1, "ZUNGQR"
11761158
, " ", &(integer){$SIZE(n)}, &c__1, &(integer){$SIZE(n)}, &c_n1, (ftnlen)6, (ftnlen)1);
1177-
maxwrk = max(i__1,i__2);
1159+
maxwrk = PDLMAX(i__1,i__2);
11781160
pjobvsl = \'V\';
11791161
}
1180-
lwork = max(maxwrk,minwrk);
1162+
lwork = PDLMAX(maxwrk,minwrk);
11811163

11821164
{
11831165
$GENERIC() *work = ($GENERIC() *)malloc( 2 * lwork * sizeof($GENERIC()));
@@ -2582,7 +2564,6 @@ EOF
25822564
# COMPUTATIONAL LEVEL ROUTINES
25832565
#
25842566
################################################################################
2585-
# TODO IPIV = min(m,n)
25862567
pp_defc("getrf",
25872568
_decl => <<'EOF',
25882569
extern int FORTRAN($TFD(c,z)getrf)(integer *m, integer *n, $GENERIC() *a, integer *

‎lib/PDL/LinearAlgebra/Real.pd

+16-35
Original file line numberDiff line numberDiff line change
@@ -46,18 +46,14 @@ typedef PDL_Long logical;
4646
typedef PDL_Long integer;
4747
typedef PDL_Long ftnlen;
4848

49-
#ifdef __cplusplus
50-
typedef logical (*L_fp)(...);
51-
#else
52-
typedef logical (*L_fp)();
53-
#endif
54-
55-
#ifndef min
56-
#define min(a,b) ((a) <= (b) ? (a) : (b))
57-
#endif
58-
#ifndef max
59-
#define max(a,b) ((a) >= (b) ? (a) : (b))
60-
#endif
49+
#define DEF_SEL_FUNC(letter, letter2, args) \
50+
void letter ## letter2 ## select_func_set(SV* func); \
51+
logical letter ## letter2 ## select_wrapper args; \
52+
typedef logical (*L_ ## letter ## letter2 ## p) args;
53+
DEF_SEL_FUNC(f, , (float *wr, float *wi))
54+
DEF_SEL_FUNC(d, , (double *wr, double *wi))
55+
DEF_SEL_FUNC(f, g, (float *zr, float *zi, float *d))
56+
DEF_SEL_FUNC(d, g, (double *zr, double *zi, double *d))
6157

6258
static integer c_zero = 0;
6359
static integer c_nine = 9;
@@ -423,8 +419,8 @@ pp_def("gesdd",
423419
$GENERIC() *work;
424420
if (tra == \'N\'){
425421
smlsiz = FORTRAN(ilaenv)(&c_nine, "SGESDD", " ", &c_zero, &c_zero, &c_zero, &c_zero, (ftnlen)6, (ftnlen)1);
426-
lwork = max(14*min($SIZE(m),$SIZE(n))+4, 10*min($SIZE(m),
427-
$SIZE(n))+2+ smlsiz*(smlsiz+8)) + max($SIZE(m),$SIZE(n));
422+
lwork = PDLMAX(14*PDLMIN($SIZE(m),$SIZE(n))+4, 10*PDLMIN($SIZE(m),
423+
$SIZE(n))+2+ smlsiz*(smlsiz+8)) + PDLMAX($SIZE(m),$SIZE(n));
428424
}
429425
work = ($GENERIC() *) malloc(lwork * sizeof($GENERIC()));
430426
FORTRAN($TFD(s,d)gesdd)(
@@ -1664,13 +1660,6 @@ and rcondv, see section 4.11 of LAPACK User\'s Guide.
16641660

16651661
');
16661662

1667-
pp_addhdr('
1668-
void fselect_func_set(SV* func);
1669-
void dselect_func_set(SV* func);
1670-
PDL_Long fselect_wrapper(float *wr, float *wi);
1671-
PDL_Long dselect_wrapper(double *wr, double *wi);
1672-
');
1673-
16741663
pp_def("gees",
16751664
HandleBad => 0,
16761665
Pars => '[io]A(n,n); int jobvs(); int sort(); [o]wr(n); [o]wi(n); [o]vs(p,p); int [o]sdim(); int [o]info(); int [t]bwork(bworkn);',
@@ -1685,7 +1674,7 @@ pp_def("gees",
16851674
char psort = \'N\';
16861675
integer lwork = -1;
16871676

1688-
extern int FORTRAN($TFD(s,d)gees)(char *jobvs, char *sort, L_fp select, integer *n,
1677+
extern int FORTRAN($TFD(s,d)gees)(char *jobvs, char *sort, L_$TFD(f,d)p select, integer *n,
16891678
$GENERIC() *a, integer *lda, integer *sdim, $GENERIC() *wr,
16901679
$GENERIC() *wi, $GENERIC() *vs, integer *ldvs, $GENERIC() *work,
16911680
integer *lwork, logical *bwork, integer *info);
@@ -1853,7 +1842,7 @@ pp_def("geesx",
18531842
integer liwork = 1;
18541843
integer *iwork;
18551844
char sens;
1856-
extern int FORTRAN($TFD(s,d)geesx)(char *jobvs, char *sort, L_fp select, char * sense,
1845+
extern int FORTRAN($TFD(s,d)geesx)(char *jobvs, char *sort, L_$TFD(f,d)p select, char * sense,
18571846
integer *n, $GENERIC() *a, integer *lda, integer *sdim, $GENERIC() *wr,
18581847
$GENERIC() *wi, $GENERIC() *vs, integer *ldvs, $GENERIC() *rconde, $GENERIC() *rcondv,
18591848
$GENERIC() *work, integer *lwork, integer *iwork, integer *liwork,
@@ -2038,13 +2027,6 @@ the form
20382027

20392028
');
20402029

2041-
pp_addhdr('
2042-
void fgselect_func_set(SV* func);
2043-
void dgselect_func_set(SV* func);
2044-
PDL_Long fgselect_wrapper(float *zr, float *zi, float *d);
2045-
PDL_Long dgselect_wrapper(double *zr, double *zi, double *d);
2046-
');
2047-
20482030
pp_def("gges",
20492031
HandleBad => 0,
20502032
Pars => '[io]A(n,n); int jobvsl();int jobvsr();int sort();[io]B(n,n);[o]alphar(n);[o]alphai(n);[o]beta(n);[o]VSL(m,m);[o]VSR(p,p);int [o]sdim();int [o]info(); int [t]bwork(bworkn);',
@@ -2058,7 +2040,7 @@ pp_def("gges",
20582040
Code => generate_code '
20592041
integer lwork = -1;
20602042
char pjobvsl = \'N\', pjobvsr = \'N\', psort = \'N\';
2061-
extern int FORTRAN($TFD(s,d)gges)(char *jobvsl, char *jobvsr, char *sort, L_fp
2043+
extern int FORTRAN($TFD(s,d)gges)(char *jobvsl, char *jobvsr, char *sort, L_$TFD(f,d)gp
20622044
delctg, integer *n, $GENERIC() *a, integer *lda, $GENERIC() *b,
20632045
integer *ldb, integer *sdim, $GENERIC() *alphar, $GENERIC() *alphai,
20642046
$GENERIC() *beta, $GENERIC() *vsl, integer *ldvsl, $GENERIC() *vsr,
@@ -2286,7 +2268,7 @@ pp_def("ggesx",
22862268
char psort = \'N\';
22872269
char psens = \'N\';
22882270
integer *iwork;
2289-
extern int FORTRAN($TFD(s,d)ggesx)(char *jobvsl, char *jobvsr, char *sort, L_fp
2271+
extern int FORTRAN($TFD(s,d)ggesx)(char *jobvsl, char *jobvsr, char *sort, L_$TFD(f,d)gp
22902272
delctg, char *sense, integer *n, $GENERIC() *a, integer *lda, $GENERIC() *b,
22912273
integer *ldb, integer *sdim, $GENERIC() *alphar, $GENERIC() *alphai,
22922274
$GENERIC() *beta, $GENERIC() *vsl, integer *ldvsl, $GENERIC() *vsr,
@@ -2327,10 +2309,10 @@ pp_def("ggesx",
23272309
integer i__1 = maxwrk;
23282310
integer i__2 = minwrk + $SIZE(n) * (integer)FORTRAN(ilaenv)(&c__1, "DORGQR"
23292311
, " ", &(integer){$SIZE(n)}, &c__1, &(integer){$SIZE(n)}, &c_n1, (ftnlen)6, (ftnlen)1);
2330-
maxwrk = (integer ) max(i__1,i__2);
2312+
maxwrk = (integer ) PDLMAX(i__1,i__2);
23312313
pjobvsl = \'V\';
23322314
}
2333-
lwork = (integer ) max(maxwrk,minwrk);
2315+
lwork = (integer ) PDLMAX(maxwrk,minwrk);
23342316

23352317
{
23362318
$GENERIC() *work = ($GENERIC() *)malloc(lwork * sizeof($GENERIC()));
@@ -5492,7 +5474,6 @@ problem
54925474
# COMPUTATIONAL LEVEL ROUTINES
54935475
#
54945476
################################################################################
5495-
# TODO IPIV = min(m,n)
54965477
pp_def("getrf",
54975478
HandleBad => 0,
54985479
Pars => '[io]A(m,n); int [o]ipiv(p=CALC(PDLMIN($SIZE(m),$SIZE(n)))); int [o]info()',

0 commit comments

Comments
 (0)