| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
use strict; |
|
2
|
|
|
|
|
|
|
use warnings; |
|
3
|
|
|
|
|
|
|
|
|
4
|
|
|
|
|
|
|
require './lib/PDL/Types.pm'; |
|
5
|
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
my $file = shift @ARGV; |
|
7
|
|
|
|
|
|
|
print "Extracting $file\n"; |
|
8
|
|
|
|
|
|
|
open OUT,">$file" or die "Can't create $file: $!"; |
|
9
|
|
|
|
|
|
|
chmod 0644, $file; |
|
10
|
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
my $FILE = __FILE__ =~ s#\\#/#gr; # so Windows no get \ error |
|
12
|
|
|
|
|
|
|
print OUT sprintf qq{#line %d "%s"\n}, __LINE__ + 2, $FILE; |
|
13
|
|
|
|
|
|
|
print OUT <<'EOF'; |
|
14
|
|
|
|
|
|
|
/* |
|
15
|
|
|
|
|
|
|
* THIS FILE IS GENERATED FROM pdl.h.PL! Do NOT edit! |
|
16
|
|
|
|
|
|
|
*/ |
|
17
|
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
#ifndef __PDL_H |
|
19
|
|
|
|
|
|
|
#define __PDL_H |
|
20
|
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
#include |
|
22
|
|
|
|
|
|
|
#include |
|
23
|
|
|
|
|
|
|
#include |
|
24
|
|
|
|
|
|
|
#include |
|
25
|
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
#define IND_FLAG "td" |
|
27
|
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
#define PDL_DEBUGGING 1 |
|
29
|
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
#ifdef PDL_DEBUGGING |
|
31
|
|
|
|
|
|
|
extern int pdl_debugging; |
|
32
|
|
|
|
|
|
|
#define PDLDEBUG_f(a) do {if (pdl_debugging) { a; fflush(stdout); }} while (0) |
|
33
|
|
|
|
|
|
|
#else |
|
34
|
|
|
|
|
|
|
#define PDLDEBUG_f(a) |
|
35
|
|
|
|
|
|
|
#endif |
|
36
|
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
typedef struct pdl pdl; |
|
38
|
|
|
|
|
|
|
EOF |
|
39
|
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
my @methods = qw(symbol ctype ppsym shortctype defbval realctype convertfunc floatsuffix); |
|
41
|
|
|
|
|
|
|
sub makelister { |
|
42
|
|
|
|
|
|
|
my ($name, $underscore, $pred) = @_; |
|
43
|
|
|
|
|
|
|
my @list = map { my $t = $_; [map $t->$_, @methods] } grep $pred->($_), PDL::Types::types(); |
|
44
|
|
|
|
|
|
|
$underscore = $underscore ? '_' : ''; |
|
45
|
|
|
|
|
|
|
("#define PDL_TYPELIST_$name$underscore(X, ...) \\\n", |
|
46
|
|
|
|
|
|
|
(map " X(__VA_ARGS__ ".join(',', @$_).")\\\n", @list), "\n\n"); |
|
47
|
|
|
|
|
|
|
} |
|
48
|
|
|
|
|
|
|
my $pred_all = sub {1}; |
|
49
|
|
|
|
|
|
|
my $pred_real = sub {$_[0]->real}; |
|
50
|
|
|
|
|
|
|
my $pred_floatreal = sub {$_[0]->real && !$_[0]->integer}; |
|
51
|
|
|
|
|
|
|
my $pred_complex = sub {!$_[0]->real}; |
|
52
|
|
|
|
|
|
|
my $pred_signed = sub {$_[0]->integer && !$_[0]->unsigned}; |
|
53
|
|
|
|
|
|
|
my $pred_unsigned = sub {$_[0]->unsigned}; |
|
54
|
|
|
|
|
|
|
my $pred_integer = sub {$_[0]->integer}; |
|
55
|
|
|
|
|
|
|
print OUT makelister('ALL', 0, $pred_all); |
|
56
|
|
|
|
|
|
|
# extra as macro gets expanded twice, gets painted blue |
|
57
|
|
|
|
|
|
|
print OUT makelister('ALL', 1, $pred_all); |
|
58
|
|
|
|
|
|
|
print OUT makelister('REAL', 0, $pred_real); |
|
59
|
|
|
|
|
|
|
print OUT makelister('FLOATREAL', 0, $pred_floatreal); |
|
60
|
|
|
|
|
|
|
print OUT makelister('COMPLEX', 0, $pred_complex); |
|
61
|
|
|
|
|
|
|
print OUT makelister('SIGNED', 0, $pred_signed); |
|
62
|
|
|
|
|
|
|
print OUT makelister('UNSIGNED', 0, $pred_unsigned); |
|
63
|
|
|
|
|
|
|
print OUT makelister('INTEGER', 0, $pred_integer); |
|
64
|
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
sub makepredicate { |
|
66
|
|
|
|
|
|
|
my ($name, $pred) = @_; |
|
67
|
|
|
|
|
|
|
map "#define PDL_GENTYPE_IS_${name}_".$_->ppsym." ".(0+$pred->($_))."\n", PDL::Types::types(); |
|
68
|
|
|
|
|
|
|
} |
|
69
|
|
|
|
|
|
|
print OUT makepredicate('REAL', $pred_real); |
|
70
|
|
|
|
|
|
|
print OUT makepredicate('FLOATREAL', $pred_floatreal); |
|
71
|
|
|
|
|
|
|
print OUT makepredicate('COMPLEX', $pred_complex); |
|
72
|
|
|
|
|
|
|
print OUT makepredicate('SIGNED', $pred_signed); |
|
73
|
|
|
|
|
|
|
print OUT makepredicate('UNSIGNED', $pred_unsigned); |
|
74
|
|
|
|
|
|
|
print OUT makepredicate('INTEGER', $pred_integer); |
|
75
|
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
for my $type (PDL::Types::types()) { |
|
77
|
|
|
|
|
|
|
my ($ppsym) = map $type->$_, qw(ppsym); |
|
78
|
|
|
|
|
|
|
my $expr = !$type->usenan ? 0 : $type->isnan('x') . '?1:0'; # isnan can return any non-0 |
|
79
|
|
|
|
|
|
|
print OUT "#define PDL_ISNAN_$ppsym(x) ($expr)\n"; |
|
80
|
|
|
|
|
|
|
my $expr2 = !$type->usenan ? 1 : $type->isfinite('x') . '?1:0'; |
|
81
|
|
|
|
|
|
|
print OUT "#define PDL_ISFINITE_$ppsym(x) ($expr2)\n"; |
|
82
|
|
|
|
|
|
|
} |
|
83
|
|
|
|
|
|
|
print OUT "#define PDL_NTYPES (@{[0+PDL::Types::types()]})\n"; |
|
84
|
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
print OUT sprintf qq{#line %d "%s"\n}, __LINE__ + 2, $FILE; |
|
86
|
|
|
|
|
|
|
print OUT <<'EOF'; |
|
87
|
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
#define PDL_BITFIELD_ENT uint64_t |
|
89
|
|
|
|
|
|
|
#define PDL_BITFIELD_ENTSIZE (sizeof(PDL_BITFIELD_ENT)) |
|
90
|
|
|
|
|
|
|
#define PDL_BITFIELD_SIZE(nbits) \ |
|
91
|
|
|
|
|
|
|
(((nbits) + PDL_BITFIELD_ENTSIZE - 1) / PDL_BITFIELD_ENTSIZE) |
|
92
|
|
|
|
|
|
|
#define PDL_BITFIELD_ENTOF(vec, bit) ((vec)[(bit)/PDL_BITFIELD_ENTSIZE]) |
|
93
|
|
|
|
|
|
|
#define PDL_BITFIELD_BITOFFSET(bit) ((bit) % PDL_BITFIELD_ENTSIZE) |
|
94
|
|
|
|
|
|
|
#define PDL_BITFIELD_BITMASK(bit) ((PDL_BITFIELD_ENT)(1 << PDL_BITFIELD_BITOFFSET(bit))) |
|
95
|
|
|
|
|
|
|
#define PDL_BITFIELD_ISSET(vec, bit) \ |
|
96
|
|
|
|
|
|
|
((PDL_BITFIELD_ENTOF(vec, bit) & PDL_BITFIELD_BITMASK(bit)) ? 1 : 0) |
|
97
|
|
|
|
|
|
|
#define PDL_BITFIELD_SET(vec, bit) do { \ |
|
98
|
|
|
|
|
|
|
PDL_Indx PDL_BITFIELD_i = bit; \ |
|
99
|
|
|
|
|
|
|
PDL_BITFIELD_ENTOF(vec, PDL_BITFIELD_i) |= PDL_BITFIELD_BITMASK(PDL_BITFIELD_i); \ |
|
100
|
|
|
|
|
|
|
} while (0) |
|
101
|
|
|
|
|
|
|
#define PDL_BITFIELD_CLR(vec, bit) do { \ |
|
102
|
|
|
|
|
|
|
PDL_Indx PDL_BITFIELD_i = bit; \ |
|
103
|
|
|
|
|
|
|
PDL_BITFIELD_ENTOF(vec, PDL_BITFIELD_i) &= ~PDL_BITFIELD_BITMASK(PDL_BITFIELD_i); \ |
|
104
|
|
|
|
|
|
|
} while (0) |
|
105
|
|
|
|
|
|
|
#define PDL_BITFIELD_SETTO(vec, bit, cond) do { \ |
|
106
|
|
|
|
|
|
|
PDL_Indx PDL_BITFIELD_i = bit; \ |
|
107
|
|
|
|
|
|
|
if (cond) PDL_BITFIELD_SET(vec, PDL_BITFIELD_i); else PDL_BITFIELD_CLR(vec, PDL_BITFIELD_i); \ |
|
108
|
|
|
|
|
|
|
} while (0) |
|
109
|
|
|
|
|
|
|
#define PDL_BITFIELD_ZEROISE(vec, nbits) do { \ |
|
110
|
|
|
|
|
|
|
PDL_Indx PDL_BITFIELD_i, PDL_BITFIELD_n = PDL_BITFIELD_SIZE(nbits); \ |
|
111
|
|
|
|
|
|
|
for (PDL_BITFIELD_i = 0; PDL_BITFIELD_i < PDL_BITFIELD_n; PDL_BITFIELD_i++) \ |
|
112
|
|
|
|
|
|
|
vec[PDL_BITFIELD_i] = 0; \ |
|
113
|
|
|
|
|
|
|
} while (0) |
|
114
|
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
#define X(sym, ...) \ |
|
116
|
|
|
|
|
|
|
, sym |
|
117
|
|
|
|
|
|
|
typedef enum { |
|
118
|
|
|
|
|
|
|
PDL_INVALID=-1 |
|
119
|
|
|
|
|
|
|
PDL_TYPELIST_ALL(X) |
|
120
|
|
|
|
|
|
|
} pdl_datatypes; |
|
121
|
|
|
|
|
|
|
#undef X |
|
122
|
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
#define X(sym, ctype, ppsym, shortctype, defbval, realctype, ...) \ |
|
124
|
|
|
|
|
|
|
typedef realctype ctype; |
|
125
|
|
|
|
|
|
|
PDL_TYPELIST_ALL(X) |
|
126
|
|
|
|
|
|
|
#undef X |
|
127
|
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
typedef union { |
|
129
|
|
|
|
|
|
|
#define X(sym, ctype, ppsym, shortctype, defbval, realctype, ...) \ |
|
130
|
|
|
|
|
|
|
ctype ppsym; |
|
131
|
|
|
|
|
|
|
PDL_TYPELIST_ALL(X) |
|
132
|
|
|
|
|
|
|
#undef X |
|
133
|
|
|
|
|
|
|
} PDL_Value; |
|
134
|
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
typedef struct { |
|
136
|
|
|
|
|
|
|
pdl_datatypes type; |
|
137
|
|
|
|
|
|
|
PDL_Value value; |
|
138
|
|
|
|
|
|
|
} PDL_Anyval; |
|
139
|
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
#define PDL_CHKMAGIC_GENERAL(it,this_magic,type) \ |
|
141
|
|
|
|
|
|
|
if((it)->magicno != this_magic) \ |
|
142
|
|
|
|
|
|
|
return pdl_make_error(PDL_EFATAL, \ |
|
143
|
|
|
|
|
|
|
"INVALID MAGICNO in " type "=%p got 0x%lx instead of 0x%lx%s", \ |
|
144
|
|
|
|
|
|
|
it,(unsigned long)((it)->magicno),this_magic, \ |
|
145
|
|
|
|
|
|
|
((it)->magicno) == PDL_CLEARED_MAGICNO ? " (cleared)" : "" \ |
|
146
|
|
|
|
|
|
|
); \ |
|
147
|
|
|
|
|
|
|
else (void)0 |
|
148
|
|
|
|
|
|
|
#define PDL_CLEARED_MAGICNO 0x99876134 /* value once "cleared" */ |
|
149
|
|
|
|
|
|
|
#define PDL_CLRMAGIC(it) (it)->magicno = PDL_CLEARED_MAGICNO |
|
150
|
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
#include "pdlbroadcast.h" |
|
152
|
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
/* Auto-PThreading (i.e. multi-threading) settings for PDL functions */ |
|
154
|
|
|
|
|
|
|
/* Target number of pthreads: Actual will be this number or less. |
|
155
|
|
|
|
|
|
|
A 0 here means no pthreading */ |
|
156
|
|
|
|
|
|
|
extern int pdl_autopthread_targ; |
|
157
|
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
/* Actual number of pthreads: This is the number of pthreads created for the last |
|
159
|
|
|
|
|
|
|
operation where pthreading was used |
|
160
|
|
|
|
|
|
|
A 0 here means no pthreading */ |
|
161
|
|
|
|
|
|
|
extern int pdl_autopthread_actual; |
|
162
|
|
|
|
|
|
|
/* Minimum size of the target PDL involved in pdl function to attempt pthreading (in MBytes ) |
|
163
|
|
|
|
|
|
|
For small PDLs, it probably isn't worth starting multiple pthreads, so this variable |
|
164
|
|
|
|
|
|
|
is used to define that threshold (in M-elements, or 2^20 elements ) */ |
|
165
|
|
|
|
|
|
|
extern int pdl_autopthread_size; |
|
166
|
|
|
|
|
|
|
extern PDL_Indx pdl_autopthread_dim; |
|
167
|
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
#define PDL_EMPTY() |
|
169
|
|
|
|
|
|
|
#define PDL_DEFER(id) id PDL_EMPTY() |
|
170
|
|
|
|
|
|
|
#define PDL_OBSTRUCT(...) __VA_ARGS__ PDL_DEFER(PDL_EMPTY)() |
|
171
|
|
|
|
|
|
|
#define PDL_EXPAND(...) PDL_EXPAND2(PDL_EXPAND2(PDL_EXPAND2(__VA_ARGS__))) |
|
172
|
|
|
|
|
|
|
#define PDL_EXPAND2(...) __VA_ARGS__ |
|
173
|
|
|
|
|
|
|
#define PDL_EXPAND_(...) PDL_EXPAND2_(PDL_EXPAND2_(PDL_EXPAND2_(__VA_ARGS__))) |
|
174
|
|
|
|
|
|
|
#define PDL_EXPAND2_(...) __VA_ARGS__ |
|
175
|
|
|
|
|
|
|
#define PDL_GENERICSWITCH_CASE(X, extraargs, symbol, ...) \ |
|
176
|
|
|
|
|
|
|
case symbol: { PDL_EXPAND(PDL_OBSTRUCT(X)(PDL_EXPAND extraargs symbol, __VA_ARGS__)) } break; |
|
177
|
|
|
|
|
|
|
#define PDL_GENERICSWITCH(LISTER, typevar, X, dflt, ...) \ |
|
178
|
|
|
|
|
|
|
switch (typevar) { \ |
|
179
|
|
|
|
|
|
|
LISTER(PDL_GENERICSWITCH_CASE, X, (__VA_ARGS__),) \ |
|
180
|
|
|
|
|
|
|
default: dflt; \ |
|
181
|
|
|
|
|
|
|
} |
|
182
|
|
|
|
|
|
|
#define PDL_GENERICSWITCH_CASEout(Xout, extraargs, LISTERin, typevarin, Xin, dfltin, symbol, ...) \ |
|
183
|
|
|
|
|
|
|
case symbol: { PDL_EXPAND_(PDL_OBSTRUCT(Xout)(PDL_EXPAND_ extraargs symbol, __VA_ARGS__)) \ |
|
184
|
|
|
|
|
|
|
PDL_EXPAND_(PDL_OBSTRUCT(PDL_GENERICSWITCH)(LISTERin, typevarin, Xin, dfltin, PDL_EXPAND_ extraargs)) \ |
|
185
|
|
|
|
|
|
|
} break; |
|
186
|
|
|
|
|
|
|
/* two-level */ |
|
187
|
|
|
|
|
|
|
#define PDL_GENERICSWITCH2(LISTERout, typevarout, Xout, dfltout, LISTERin, typevarin, Xin, dfltin, ...) \ |
|
188
|
|
|
|
|
|
|
switch (typevarout) { \ |
|
189
|
|
|
|
|
|
|
LISTERout(PDL_GENERICSWITCH_CASEout, Xout, (__VA_ARGS__), LISTERin, typevarin, Xin, dfltin,) \ |
|
190
|
|
|
|
|
|
|
default: dfltout; \ |
|
191
|
|
|
|
|
|
|
} |
|
192
|
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
#define ANYVAL_FROM_CTYPE_X(outany, inval, datatype, ctype, ppsym, ...) \ |
|
194
|
|
|
|
|
|
|
(outany).type = datatype; (outany).value.ppsym = (inval); |
|
195
|
|
|
|
|
|
|
#define ANYVAL_FROM_CTYPE(outany,avtype,inval) \ |
|
196
|
|
|
|
|
|
|
PDL_GENERICSWITCH(PDL_TYPELIST_ALL, avtype, ANYVAL_FROM_CTYPE_X, \ |
|
197
|
|
|
|
|
|
|
outany.type = -1; outany.value.H = 0, \ |
|
198
|
|
|
|
|
|
|
outany, inval, \ |
|
199
|
|
|
|
|
|
|
) |
|
200
|
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
#define ANYVAL_TO_ANYVAL_NEWTYPE_X_OUTER(from_val, to_val, newtype, datatype_from, ctype_from, ppsym_from, ...) \ |
|
202
|
|
|
|
|
|
|
ctype_from cvalue_from = from_val.value.ppsym_from; |
|
203
|
|
|
|
|
|
|
#define ANYVAL_TO_ANYVAL_NEWTYPE_X_INNER(from_val, to_val, newtype, datatype_to, ctype_to, ppsym_to, ...) \ |
|
204
|
|
|
|
|
|
|
to_val.value.ppsym_to = cvalue_from; to_val.type = newtype; |
|
205
|
|
|
|
|
|
|
#define ANYVAL_TO_ANYVAL_NEWTYPE(from_val, to_val, newtype) \ |
|
206
|
|
|
|
|
|
|
PDL_GENERICSWITCH2( \ |
|
207
|
|
|
|
|
|
|
PDL_TYPELIST_ALL, from_val.type, ANYVAL_TO_ANYVAL_NEWTYPE_X_OUTER, to_val.type = PDL_INVALID, \ |
|
208
|
|
|
|
|
|
|
PDL_TYPELIST_ALL_, newtype, ANYVAL_TO_ANYVAL_NEWTYPE_X_INNER, to_val.type = PDL_INVALID, \ |
|
209
|
|
|
|
|
|
|
from_val, to_val, newtype,) |
|
210
|
|
|
|
|
|
|
|
|
211
|
|
|
|
|
|
|
#define ANYVAL_TO_CTYPE_X(outval, inany, datatype, ctype, ppsym, ...) \ |
|
212
|
|
|
|
|
|
|
outval = (ctype)(inany.value.ppsym); |
|
213
|
|
|
|
|
|
|
#define ANYVAL_TO_CTYPE(outval,ctype,inany) \ |
|
214
|
|
|
|
|
|
|
PDL_GENERICSWITCH(PDL_TYPELIST_ALL_, inany.type, ANYVAL_TO_CTYPE_X, \ |
|
215
|
|
|
|
|
|
|
outval = 0, \ |
|
216
|
|
|
|
|
|
|
outval, inany, \ |
|
217
|
|
|
|
|
|
|
) |
|
218
|
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
#define ANYVAL_TO_CTYPE_OFFSET_X(x, ioff, inany, datatype, ctype, ppsym, ...) \ |
|
220
|
|
|
|
|
|
|
((ctype *)(x))[ioff] = (inany).value.ppsym; |
|
221
|
|
|
|
|
|
|
#define ANYVAL_TO_CTYPE_OFFSET(x,ioff,datatype,value) \ |
|
222
|
|
|
|
|
|
|
PDL_GENERICSWITCH(PDL_TYPELIST_ALL, datatype, ANYVAL_TO_CTYPE_OFFSET_X, \ |
|
223
|
|
|
|
|
|
|
return pdl_make_error(PDL_EUSERERROR, "Not a known data type code=%d", datatype), \ |
|
224
|
|
|
|
|
|
|
x, ioff, value,) |
|
225
|
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
#define ANYVAL_FROM_CTYPE_OFFSET_X(indata, ioff, outany, datatype, ctype, ppsym, ...) \ |
|
227
|
|
|
|
|
|
|
(outany).type = datatype; (outany).value.ppsym = ((ctype *)(indata))[ioff]; |
|
228
|
|
|
|
|
|
|
#define ANYVAL_FROM_CTYPE_OFFSET(outany,avtype,indata,ioff) \ |
|
229
|
|
|
|
|
|
|
PDL_GENERICSWITCH(PDL_TYPELIST_ALL, avtype, ANYVAL_FROM_CTYPE_OFFSET_X, \ |
|
230
|
|
|
|
|
|
|
(outany).type = -1; outany.value.H = 0;, \ |
|
231
|
|
|
|
|
|
|
indata, ioff, outany,) |
|
232
|
|
|
|
|
|
|
|
|
233
|
|
|
|
|
|
|
#define ANYVAL_ISNAN(x) _anyval_isnan(x) |
|
234
|
3186
|
|
|
|
|
|
static inline int _anyval_isnan(PDL_Anyval x) { |
|
235
|
|
|
|
|
|
|
#define X(datatype, ctype, ppsym, ...) \ |
|
236
|
|
|
|
|
|
|
return PDL_ISNAN_ ## ppsym(x.value.ppsym); |
|
237
|
3186
|
100
|
|
|
|
|
PDL_GENERICSWITCH(PDL_TYPELIST_ALL, x.type, X, return -1) |
|
|
|
50
|
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
#undef X |
|
239
|
|
|
|
|
|
|
} |
|
240
|
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
#define ANYVAL_EQ_ANYVAL(x,y) (_anyval_eq_anyval(x,y)) |
|
242
|
3152
|
|
|
|
|
|
static inline int _anyval_eq_anyval(PDL_Anyval x, PDL_Anyval y) { |
|
243
|
|
|
|
|
|
|
#define X_OUTER(datatype_x, ctype_x, ppsym_x, ...) \ |
|
244
|
|
|
|
|
|
|
ctype_x cvalue_x = x.value.ppsym_x; |
|
245
|
|
|
|
|
|
|
#define X_INNER(datatype_y, ctype_y, ppsym_y, ...) \ |
|
246
|
|
|
|
|
|
|
return (cvalue_x == y.value.ppsym_y) ? 1 : 0; |
|
247
|
3152
|
|
|
|
|
|
PDL_GENERICSWITCH2(PDL_TYPELIST_ALL, x.type, X_OUTER, return -1, PDL_TYPELIST_ALL_, y.type, X_INNER, return -1) |
|
248
|
|
|
|
|
|
|
#undef X_INNER |
|
249
|
|
|
|
|
|
|
#undef X_OUTER |
|
250
|
|
|
|
|
|
|
} |
|
251
|
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
#define ANYVAL_ISBAD(inany,badval) _anyval_isbad(inany,badval) |
|
253
|
3169
|
|
|
|
|
|
static inline int _anyval_isbad(PDL_Anyval inany, PDL_Anyval badval) { |
|
254
|
3169
|
|
|
|
|
|
int isnan_badval = ANYVAL_ISNAN(badval); |
|
255
|
3169
|
50
|
|
|
|
|
if (isnan_badval == -1) return -1; |
|
256
|
3169
|
100
|
|
|
|
|
return isnan_badval ? ANYVAL_ISNAN(inany) : ANYVAL_EQ_ANYVAL(inany, badval); |
|
257
|
|
|
|
|
|
|
} |
|
258
|
|
|
|
|
|
|
|
|
259
|
|
|
|
|
|
|
#define PDL_ISBAD(inval,badval,ppsym) \ |
|
260
|
|
|
|
|
|
|
(PDL_ISNAN_ ## ppsym(badval) ? PDL_ISNAN_ ## ppsym(inval) : inval == badval) |
|
261
|
|
|
|
|
|
|
#define PDL_ISBAD2(inval,badval,ppsym,badval_isnan) \ |
|
262
|
|
|
|
|
|
|
(badval_isnan ? PDL_ISNAN_ ## ppsym(inval) : inval == badval) |
|
263
|
|
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
typedef struct pdl_badvals { |
|
265
|
|
|
|
|
|
|
#define X(symbol, ctype, ppsym, ...) ctype ppsym; |
|
266
|
|
|
|
|
|
|
PDL_TYPELIST_ALL(X) |
|
267
|
|
|
|
|
|
|
#undef X |
|
268
|
|
|
|
|
|
|
} pdl_badvals; |
|
269
|
|
|
|
|
|
|
|
|
270
|
|
|
|
|
|
|
/* |
|
271
|
|
|
|
|
|
|
* Define the pdl C data structure which maps onto the original PDL |
|
272
|
|
|
|
|
|
|
* perl data structure. |
|
273
|
|
|
|
|
|
|
* |
|
274
|
|
|
|
|
|
|
* Note: pdl.sv is defined as a void pointer to avoid having to |
|
275
|
|
|
|
|
|
|
* include perl.h in C code which just needs the pdl data. |
|
276
|
|
|
|
|
|
|
* |
|
277
|
|
|
|
|
|
|
* We start with the meanings of the pdl.flags bitmapped flagset, |
|
278
|
|
|
|
|
|
|
* continue with a prerequisite "trans" structure that represents |
|
279
|
|
|
|
|
|
|
* transformations between linked PDLs, and finish withthe PD |
|
280
|
|
|
|
|
|
|
* structure itself. |
|
281
|
|
|
|
|
|
|
*/ |
|
282
|
|
|
|
|
|
|
|
|
283
|
|
|
|
|
|
|
#define PDL_NDIMS 6 /* Number of dims[] to preallocate */ |
|
284
|
|
|
|
|
|
|
#define PDL_NCHILDREN 6 /* Number of trans_children ptrs to preallocate */ |
|
285
|
|
|
|
|
|
|
#define PDL_NBROADCASTIDS 4 /* Number of different broadcastids/pdl to preallocate */ |
|
286
|
|
|
|
|
|
|
|
|
287
|
|
|
|
|
|
|
/* Constants for pdl.state - not all combinations make sense */ |
|
288
|
|
|
|
|
|
|
|
|
289
|
|
|
|
|
|
|
/* data allocated for this pdl. this implies that the data */ |
|
290
|
|
|
|
|
|
|
/* is up to date if !PDL_PARENTCHANGED */ |
|
291
|
|
|
|
|
|
|
#define PDL_ALLOCATED (1 << 0) |
|
292
|
|
|
|
|
|
|
/* Parent data has been altered without changing this pdl */ |
|
293
|
|
|
|
|
|
|
#define PDL_PARENTDATACHANGED (1 << 1) |
|
294
|
|
|
|
|
|
|
/* Parent dims or incs has been altered without changing this pdl. */ |
|
295
|
|
|
|
|
|
|
#define PDL_PARENTDIMSCHANGED (1 << 2) |
|
296
|
|
|
|
|
|
|
/* Marked read-only by user; throw error if given as output to xform. */ |
|
297
|
|
|
|
|
|
|
#define PDL_READONLY (1 << 3) |
|
298
|
|
|
|
|
|
|
/* Physical data representation of the parent has changed (e.g. */ |
|
299
|
|
|
|
|
|
|
/* physical transposition), so incs etc. need to be recalculated. */ |
|
300
|
|
|
|
|
|
|
#define PDL_ANYCHANGED (PDL_PARENTDATACHANGED|PDL_PARENTDIMSCHANGED) |
|
301
|
|
|
|
|
|
|
/* Dataflow forward flag request */ |
|
302
|
|
|
|
|
|
|
#define PDL_DATAFLOW_F (1 << 4) |
|
303
|
|
|
|
|
|
|
/* Was this PDL null originally? */ |
|
304
|
|
|
|
|
|
|
#define PDL_NOMYDIMS (1 << 6) |
|
305
|
|
|
|
|
|
|
/* Dims should be received via trans. */ |
|
306
|
|
|
|
|
|
|
#define PDL_MYDIMS_TRANS (1 << 7) |
|
307
|
|
|
|
|
|
|
/* OK to attach a vaffine transformation (i.e. a slice) */ |
|
308
|
|
|
|
|
|
|
#define PDL_OPT_VAFFTRANSOK (1 << 8) |
|
309
|
|
|
|
|
|
|
#define PDL_OPT_ANY_OK (PDL_OPT_VAFFTRANSOK) |
|
310
|
|
|
|
|
|
|
/* This is the hdrcpy flag */ |
|
311
|
|
|
|
|
|
|
#define PDL_HDRCPY (1 << 9) |
|
312
|
|
|
|
|
|
|
/* This is a badval flag for this PDL as set by "badflag" */ |
|
313
|
|
|
|
|
|
|
#define PDL_BADVAL (1 << 10) |
|
314
|
|
|
|
|
|
|
/* If ndarray was created by PDL API but then got SV attached */ |
|
315
|
|
|
|
|
|
|
#define PDL_DYNLANG_NODESTROY (1 << 11) |
|
316
|
|
|
|
|
|
|
/* inplace flag */ |
|
317
|
|
|
|
|
|
|
#define PDL_INPLACE (1 << 12) |
|
318
|
|
|
|
|
|
|
/* Flag indicating destruction in progress */ |
|
319
|
|
|
|
|
|
|
#define PDL_DESTROYING (1 << 13) |
|
320
|
|
|
|
|
|
|
/* If this flag is set, you must not alter the data pointer nor */ |
|
321
|
|
|
|
|
|
|
/* free this ndarray nor use datasv (which should be null). */ |
|
322
|
|
|
|
|
|
|
/* This means e.g. that the ndarray is mmapped from a file */ |
|
323
|
|
|
|
|
|
|
#define PDL_DONTTOUCHDATA (1 << 14) |
|
324
|
|
|
|
|
|
|
/* whether the given pdl is getting its dims from the given trans */ |
|
325
|
|
|
|
|
|
|
#define PDL_DIMS_FROM_TRANS(wtrans,pdl) (((pdl)->state & PDL_MYDIMS_TRANS) \ |
|
326
|
|
|
|
|
|
|
&& (pdl)->trans_parent == (pdl_trans *)(wtrans)) |
|
327
|
|
|
|
|
|
|
|
|
328
|
|
|
|
|
|
|
#define PDL_LIST_FLAGS_PDLSTATE(X) \ |
|
329
|
|
|
|
|
|
|
X(PDL_ALLOCATED) \ |
|
330
|
|
|
|
|
|
|
X(PDL_PARENTDATACHANGED) \ |
|
331
|
|
|
|
|
|
|
X(PDL_PARENTDIMSCHANGED) \ |
|
332
|
|
|
|
|
|
|
X(PDL_READONLY) \ |
|
333
|
|
|
|
|
|
|
X(PDL_DATAFLOW_F) \ |
|
334
|
|
|
|
|
|
|
X(PDL_NOMYDIMS) \ |
|
335
|
|
|
|
|
|
|
X(PDL_MYDIMS_TRANS) \ |
|
336
|
|
|
|
|
|
|
X(PDL_OPT_VAFFTRANSOK) \ |
|
337
|
|
|
|
|
|
|
X(PDL_HDRCPY) \ |
|
338
|
|
|
|
|
|
|
X(PDL_BADVAL) \ |
|
339
|
|
|
|
|
|
|
X(PDL_DYNLANG_NODESTROY) \ |
|
340
|
|
|
|
|
|
|
X(PDL_INPLACE) \ |
|
341
|
|
|
|
|
|
|
X(PDL_DESTROYING) \ |
|
342
|
|
|
|
|
|
|
X(PDL_DONTTOUCHDATA) |
|
343
|
|
|
|
|
|
|
|
|
344
|
|
|
|
|
|
|
/************************************************** |
|
345
|
|
|
|
|
|
|
* |
|
346
|
|
|
|
|
|
|
* Transformation structure |
|
347
|
|
|
|
|
|
|
* |
|
348
|
|
|
|
|
|
|
* The structure is general enough to deal with functional transforms |
|
349
|
|
|
|
|
|
|
* (which were originally intended) but only slices and retype transforms |
|
350
|
|
|
|
|
|
|
* were implemented. |
|
351
|
|
|
|
|
|
|
* |
|
352
|
|
|
|
|
|
|
*/ |
|
353
|
|
|
|
|
|
|
|
|
354
|
|
|
|
|
|
|
/* Transformation flags */ |
|
355
|
|
|
|
|
|
|
#define PDL_TRANS_DO_BROADCAST (1 << 0) |
|
356
|
|
|
|
|
|
|
#define PDL_TRANS_BADPROCESS (1 << 1) |
|
357
|
|
|
|
|
|
|
#define PDL_TRANS_BADIGNORE (1 << 2) |
|
358
|
|
|
|
|
|
|
#define PDL_TRANS_NO_PARALLEL (1 << 3) |
|
359
|
|
|
|
|
|
|
#define PDL_TRANS_OUTPUT_OTHERPAR (1 << 4) |
|
360
|
|
|
|
|
|
|
|
|
361
|
|
|
|
|
|
|
#define PDL_LIST_FLAGS_PDLVTABLE(X) \ |
|
362
|
|
|
|
|
|
|
X(PDL_TRANS_DO_BROADCAST) \ |
|
363
|
|
|
|
|
|
|
X(PDL_TRANS_BADPROCESS) \ |
|
364
|
|
|
|
|
|
|
X(PDL_TRANS_BADIGNORE) \ |
|
365
|
|
|
|
|
|
|
X(PDL_TRANS_NO_PARALLEL) \ |
|
366
|
|
|
|
|
|
|
X(PDL_TRANS_OUTPUT_OTHERPAR) |
|
367
|
|
|
|
|
|
|
|
|
368
|
|
|
|
|
|
|
typedef struct pdl_trans pdl_trans; |
|
369
|
|
|
|
|
|
|
|
|
370
|
|
|
|
|
|
|
typedef enum { |
|
371
|
|
|
|
|
|
|
PDL_ENONE = 0, /* usable as boolean */ |
|
372
|
|
|
|
|
|
|
PDL_EUSERERROR, /* user error, no need to destroy */ |
|
373
|
|
|
|
|
|
|
PDL_EFATAL |
|
374
|
|
|
|
|
|
|
} pdl_error_type; |
|
375
|
|
|
|
|
|
|
typedef struct { |
|
376
|
|
|
|
|
|
|
pdl_error_type error; |
|
377
|
|
|
|
|
|
|
const char *message; /* if error but this NULL, parsing/alloc error */ |
|
378
|
|
|
|
|
|
|
char needs_free; |
|
379
|
|
|
|
|
|
|
} pdl_error; |
|
380
|
|
|
|
|
|
|
|
|
381
|
|
|
|
|
|
|
typedef struct pdl_transvtable { |
|
382
|
|
|
|
|
|
|
int flags; |
|
383
|
|
|
|
|
|
|
int iflags; /* flags that are starting point for pdl_trans.flags */ |
|
384
|
|
|
|
|
|
|
pdl_datatypes *gentypes; /* ordered list of types handled, ending -1 */ |
|
385
|
|
|
|
|
|
|
PDL_Indx nparents; |
|
386
|
|
|
|
|
|
|
PDL_Indx npdls; |
|
387
|
|
|
|
|
|
|
char *per_pdl_flags; /*CORE21*/ |
|
388
|
|
|
|
|
|
|
PDL_Indx *par_realdims; /* quantity of dimensions each par has */ |
|
389
|
|
|
|
|
|
|
char **par_names; |
|
390
|
|
|
|
|
|
|
short *par_flags; |
|
391
|
|
|
|
|
|
|
pdl_datatypes *par_types; |
|
392
|
|
|
|
|
|
|
PDL_Indx *par_realdim_ind_start; /* each par, where do its inds start in array above */ |
|
393
|
|
|
|
|
|
|
PDL_Indx *par_realdim_ind_ids; /* each realdim, which ind is source */ |
|
394
|
|
|
|
|
|
|
PDL_Indx nind_ids; |
|
395
|
|
|
|
|
|
|
PDL_Indx ninds; |
|
396
|
|
|
|
|
|
|
char **ind_names; /* sorted names of "indices", eg for a(m), the "m" */ |
|
397
|
|
|
|
|
|
|
pdl_error (*redodims)(pdl_trans *tr); /* Only dims and internal trans (makes phys) */ |
|
398
|
|
|
|
|
|
|
pdl_error (*readdata)(pdl_trans *tr); /* Only data, to "data" ptr */ |
|
399
|
|
|
|
|
|
|
pdl_error (*writebackdata)(pdl_trans *tr); /* "data" ptr to parent or granny */ |
|
400
|
|
|
|
|
|
|
pdl_error (*freetrans)(pdl_trans *tr, char); |
|
401
|
|
|
|
|
|
|
int structsize; |
|
402
|
|
|
|
|
|
|
char *name; /* For debuggers, mostly */ |
|
403
|
|
|
|
|
|
|
} pdl_transvtable; |
|
404
|
|
|
|
|
|
|
|
|
405
|
|
|
|
|
|
|
/* offset into either par_realdim_ind_ids or inc_sizes */ |
|
406
|
|
|
|
|
|
|
#define PDL_INC_ID(vtable, i, j) \ |
|
407
|
|
|
|
|
|
|
((vtable)->par_realdim_ind_start[i] + j) |
|
408
|
|
|
|
|
|
|
/* which ind_id (named dim) for the i-th pdl (aka param) in a vtable, the j-th dim on that param */ |
|
409
|
|
|
|
|
|
|
#define PDL_IND_ID(vtable, i, j) \ |
|
410
|
|
|
|
|
|
|
((vtable)->par_realdim_ind_ids[PDL_INC_ID(vtable, i, j)]) |
|
411
|
|
|
|
|
|
|
|
|
412
|
|
|
|
|
|
|
#define PDL_PARAM_ISREAL (1 << 0) |
|
413
|
|
|
|
|
|
|
#define PDL_PARAM_ISCOMPLEX (1 << 1) |
|
414
|
|
|
|
|
|
|
#define PDL_PARAM_ISTYPED (1 << 2) |
|
415
|
|
|
|
|
|
|
#define PDL_PARAM_ISTPLUS (1 << 3) |
|
416
|
|
|
|
|
|
|
#define PDL_PARAM_ISCREAT (1 << 4) |
|
417
|
|
|
|
|
|
|
#define PDL_PARAM_ISCREATEALWAYS (1 << 5) |
|
418
|
|
|
|
|
|
|
#define PDL_PARAM_ISOUT (1 << 6) |
|
419
|
|
|
|
|
|
|
#define PDL_PARAM_ISTEMP (1 << 7) |
|
420
|
|
|
|
|
|
|
#define PDL_PARAM_ISWRITE (1 << 8) |
|
421
|
|
|
|
|
|
|
#define PDL_PARAM_ISPHYS (1 << 9) |
|
422
|
|
|
|
|
|
|
#define PDL_PARAM_ISIGNORE (1 << 10) |
|
423
|
|
|
|
|
|
|
#define PDL_PARAM_ISNOTCOMPLEX (1 << 11) |
|
424
|
|
|
|
|
|
|
#define PDL_PARAM_ALLOW_NULL (1 << 12) |
|
425
|
|
|
|
|
|
|
#define PDL_PARAM_ISNOTREAL (1 << 13) |
|
426
|
|
|
|
|
|
|
|
|
427
|
|
|
|
|
|
|
#define PDL_LIST_FLAGS_PARAMS(X) \ |
|
428
|
|
|
|
|
|
|
X(PDL_PARAM_ISREAL) \ |
|
429
|
|
|
|
|
|
|
X(PDL_PARAM_ISCOMPLEX) \ |
|
430
|
|
|
|
|
|
|
X(PDL_PARAM_ISTYPED) \ |
|
431
|
|
|
|
|
|
|
X(PDL_PARAM_ISTPLUS) \ |
|
432
|
|
|
|
|
|
|
X(PDL_PARAM_ISCREAT) \ |
|
433
|
|
|
|
|
|
|
X(PDL_PARAM_ISCREATEALWAYS) \ |
|
434
|
|
|
|
|
|
|
X(PDL_PARAM_ISOUT) \ |
|
435
|
|
|
|
|
|
|
X(PDL_PARAM_ISTEMP) \ |
|
436
|
|
|
|
|
|
|
X(PDL_PARAM_ISWRITE) \ |
|
437
|
|
|
|
|
|
|
X(PDL_PARAM_ISPHYS) \ |
|
438
|
|
|
|
|
|
|
X(PDL_PARAM_ISIGNORE) \ |
|
439
|
|
|
|
|
|
|
X(PDL_PARAM_ISNOTCOMPLEX) \ |
|
440
|
|
|
|
|
|
|
X(PDL_PARAM_ALLOW_NULL) \ |
|
441
|
|
|
|
|
|
|
X(PDL_PARAM_ISNOTREAL) |
|
442
|
|
|
|
|
|
|
|
|
443
|
|
|
|
|
|
|
/* All trans must start with this */ |
|
444
|
|
|
|
|
|
|
|
|
445
|
|
|
|
|
|
|
/* Trans flags */ |
|
446
|
|
|
|
|
|
|
|
|
447
|
|
|
|
|
|
|
/* Reversible transform -- flag indicates data can flow both ways. */ |
|
448
|
|
|
|
|
|
|
/* This is critical in routines that both input from and output to */ |
|
449
|
|
|
|
|
|
|
/* a non-single-valued pdl: updating must occur. (Note that the */ |
|
450
|
|
|
|
|
|
|
/* transform is not necessarily mathematically reversible) */ |
|
451
|
|
|
|
|
|
|
#define PDL_ITRANS_TWOWAY (1 << 0) |
|
452
|
|
|
|
|
|
|
#define PDL_ITRANS_DO_DATAFLOW_F (1 << 1) |
|
453
|
|
|
|
|
|
|
#define PDL_ITRANS_DO_DATAFLOW_B (1 << 2) |
|
454
|
|
|
|
|
|
|
#define PDL_ITRANS_DO_DATAFLOW_ANY (PDL_ITRANS_DO_DATAFLOW_F|PDL_ITRANS_DO_DATAFLOW_B) |
|
455
|
|
|
|
|
|
|
|
|
456
|
|
|
|
|
|
|
#define PDL_ITRANS_ISAFFINE (1 << 12) |
|
457
|
|
|
|
|
|
|
|
|
458
|
|
|
|
|
|
|
#define PDL_LIST_FLAGS_PDLTRANS(X) \ |
|
459
|
|
|
|
|
|
|
X(PDL_ITRANS_TWOWAY) \ |
|
460
|
|
|
|
|
|
|
X(PDL_ITRANS_DO_DATAFLOW_F) \ |
|
461
|
|
|
|
|
|
|
X(PDL_ITRANS_DO_DATAFLOW_B) \ |
|
462
|
|
|
|
|
|
|
X(PDL_ITRANS_ISAFFINE) |
|
463
|
|
|
|
|
|
|
|
|
464
|
|
|
|
|
|
|
#define PDL_MAXSPACE 256 /* maximal number of prefix spaces in dump routines */ |
|
465
|
|
|
|
|
|
|
#define PDL_MAXLIN 75 |
|
466
|
|
|
|
|
|
|
|
|
467
|
|
|
|
|
|
|
// These define struct pdl_trans and all derived structures. There are many |
|
468
|
|
|
|
|
|
|
// structures that defined in other parts of the code that can be referenced |
|
469
|
|
|
|
|
|
|
// like a pdl_trans* because all of these structures have the same pdl_trans |
|
470
|
|
|
|
|
|
|
// initial piece. These structures can contain multiple pdl* elements in them. |
|
471
|
|
|
|
|
|
|
// Thus pdl_trans itself ends with a flexible pdl*[] array, which can be used to |
|
472
|
|
|
|
|
|
|
// reference any number of pdl objects. As a result pdl_trans itself can NOT be |
|
473
|
|
|
|
|
|
|
// instantiated |
|
474
|
|
|
|
|
|
|
|
|
475
|
|
|
|
|
|
|
#define PDL_TRANS_START_COMMON \ |
|
476
|
|
|
|
|
|
|
unsigned int magicno; \ |
|
477
|
|
|
|
|
|
|
short flags; \ |
|
478
|
|
|
|
|
|
|
pdl_transvtable *vtable; \ |
|
479
|
|
|
|
|
|
|
int bvalflag; \ |
|
480
|
|
|
|
|
|
|
pdl_broadcast broadcast; \ |
|
481
|
|
|
|
|
|
|
PDL_Indx *ind_sizes; \ |
|
482
|
|
|
|
|
|
|
PDL_Indx *inc_sizes; \ |
|
483
|
|
|
|
|
|
|
char dims_redone; \ |
|
484
|
|
|
|
|
|
|
PDL_Indx *incs; PDL_Indx offs; /* only used for affine */ \ |
|
485
|
|
|
|
|
|
|
void *params; \ |
|
486
|
|
|
|
|
|
|
pdl_datatypes __datatype |
|
487
|
|
|
|
|
|
|
|
|
488
|
|
|
|
|
|
|
#define PDL_TRANS_START(np) \ |
|
489
|
|
|
|
|
|
|
PDL_TRANS_START_COMMON; \ |
|
490
|
|
|
|
|
|
|
/* The pdls involved in the transformation */ \ |
|
491
|
|
|
|
|
|
|
pdl *pdls[np] |
|
492
|
|
|
|
|
|
|
|
|
493
|
|
|
|
|
|
|
#define PDL_TRANS_START_FLEXIBLE() \ |
|
494
|
|
|
|
|
|
|
PDL_TRANS_START_COMMON; \ |
|
495
|
|
|
|
|
|
|
/* The pdls involved in the transformation */ \ |
|
496
|
|
|
|
|
|
|
pdl *pdls[] |
|
497
|
|
|
|
|
|
|
|
|
498
|
|
|
|
|
|
|
#define PDL_TR_MAGICNO 0x91827364 |
|
499
|
|
|
|
|
|
|
#define PDL_TR_CHKMAGIC(it) PDL_CHKMAGIC_GENERAL(it, PDL_TR_MAGICNO, "TRANS") |
|
500
|
|
|
|
|
|
|
#define PDL_TR_SETMAGIC(it) (it)->magicno = PDL_TR_MAGICNO |
|
501
|
|
|
|
|
|
|
|
|
502
|
|
|
|
|
|
|
// This is a generic parent of all the trans structures. It is a flexible array |
|
503
|
|
|
|
|
|
|
// (can store an arbitrary number of pdl objects). Thus this can NOT be |
|
504
|
|
|
|
|
|
|
// instantiated, only "child" structures can |
|
505
|
|
|
|
|
|
|
struct pdl_trans { |
|
506
|
|
|
|
|
|
|
PDL_TRANS_START_FLEXIBLE(); |
|
507
|
|
|
|
|
|
|
} ; |
|
508
|
|
|
|
|
|
|
|
|
509
|
|
|
|
|
|
|
typedef struct pdl_vaffine { |
|
510
|
|
|
|
|
|
|
PDL_TRANS_START(2); |
|
511
|
|
|
|
|
|
|
PDL_Indx ndims; |
|
512
|
|
|
|
|
|
|
pdl *from; |
|
513
|
|
|
|
|
|
|
} pdl_vaffine; |
|
514
|
|
|
|
|
|
|
|
|
515
|
|
|
|
|
|
|
#define PDL_VAFFOK(pdl) (pdl->state & PDL_OPT_VAFFTRANSOK) |
|
516
|
|
|
|
|
|
|
#define PDL_REPRINCS(pdl) (PDL_VAFFOK(pdl) ? pdl->vafftrans->incs : pdl->dimincs) |
|
517
|
|
|
|
|
|
|
#define PDL_REPRINC(pdl,which) (PDL_REPRINCS(pdl)[which]) |
|
518
|
|
|
|
|
|
|
|
|
519
|
|
|
|
|
|
|
#define PDL_REPROFFS(pdl) (PDL_VAFFOK(pdl) ? pdl->vafftrans->offs : 0) |
|
520
|
|
|
|
|
|
|
|
|
521
|
|
|
|
|
|
|
#define PDL_REPRP(pdl) (PDL_VAFFOK(pdl) ? pdl->vafftrans->from->data : pdl->data) |
|
522
|
|
|
|
|
|
|
|
|
523
|
|
|
|
|
|
|
struct pdl_magic; |
|
524
|
|
|
|
|
|
|
|
|
525
|
|
|
|
|
|
|
/**************************************** |
|
526
|
|
|
|
|
|
|
* PDL structure |
|
527
|
|
|
|
|
|
|
* Should be kept under 250 bytes if at all possible, for |
|
528
|
|
|
|
|
|
|
* easier segmentation... |
|
529
|
|
|
|
|
|
|
* See current size (360 bytes at time of writing) with: |
|
530
|
|
|
|
|
|
|
perl -Mblib -MInline=with,PDL \ |
|
531
|
|
|
|
|
|
|
-MInline=C,'size_t f() { return sizeof(struct pdl); }' -e 'die f()' |
|
532
|
|
|
|
|
|
|
* |
|
533
|
|
|
|
|
|
|
* The 'sv', 'datasv', and 'hdrsv' fields are all void * to avoid having to |
|
534
|
|
|
|
|
|
|
* load perl.h for C codes that only use PDLs and not the Perl API. |
|
535
|
|
|
|
|
|
|
* |
|
536
|
|
|
|
|
|
|
* Similarly, the 'magic' field is void * to avoid having to typedef pdl_magic |
|
537
|
|
|
|
|
|
|
* here -- it is declared in "pdl_magic.h". |
|
538
|
|
|
|
|
|
|
*/ |
|
539
|
|
|
|
|
|
|
|
|
540
|
|
|
|
|
|
|
#define PDL_MAGICNO 0x24645399 |
|
541
|
|
|
|
|
|
|
#define PDL_CHKMAGIC(it) PDL_CHKMAGIC_GENERAL(it,PDL_MAGICNO,"PDL") |
|
542
|
|
|
|
|
|
|
#define PDL_SETMAGIC(it) (it)->magicno = PDL_MAGICNO |
|
543
|
|
|
|
|
|
|
|
|
544
|
|
|
|
|
|
|
struct pdl { |
|
545
|
|
|
|
|
|
|
unsigned long magicno; /* Always stores PDL_MAGICNO as a sanity check */ |
|
546
|
|
|
|
|
|
|
/* This is first so most pointer accesses to wrong type are caught */ |
|
547
|
|
|
|
|
|
|
int state; /* What's in this pdl */ |
|
548
|
|
|
|
|
|
|
|
|
549
|
|
|
|
|
|
|
pdl_trans *trans_parent; /* Opaque pointer to internals of transformation from |
|
550
|
|
|
|
|
|
|
parent */ |
|
551
|
|
|
|
|
|
|
|
|
552
|
|
|
|
|
|
|
pdl_vaffine *vafftrans; /* pointer to vaffine transformation |
|
553
|
|
|
|
|
|
|
a vafftrans is an optimization that is possible |
|
554
|
|
|
|
|
|
|
for some types of trans (slice etc) |
|
555
|
|
|
|
|
|
|
- unused for non-affine transformations |
|
556
|
|
|
|
|
|
|
*/ |
|
557
|
|
|
|
|
|
|
|
|
558
|
|
|
|
|
|
|
void* sv; /* (optional) pointer back to original sv. |
|
559
|
|
|
|
|
|
|
ALWAYS check for non-null before use. |
|
560
|
|
|
|
|
|
|
We cannot inc refcnt on this one or we'd |
|
561
|
|
|
|
|
|
|
never get destroyed */ |
|
562
|
|
|
|
|
|
|
void *datasv; /* Pointer to SV containing data. We own one inc of refcnt */ |
|
563
|
|
|
|
|
|
|
void *data; /* Pointer to actual data (in SV), or NULL if we have no data */ |
|
564
|
|
|
|
|
|
|
PDL_Anyval badvalue; /* BAD value is stored as a PDL_Anyval for portability */ |
|
565
|
|
|
|
|
|
|
int has_badvalue; /* whether this pdl has non-default badval CORE21 make into state flag */ |
|
566
|
|
|
|
|
|
|
PDL_Indx nvals; /* Real number of elements (not quite nelem in case of dummy) */ |
|
567
|
|
|
|
|
|
|
PDL_Indx nbytes; /* number of bytes allocated in data */ |
|
568
|
|
|
|
|
|
|
pdl_datatypes datatype; /* One of the usual suspects (PDL_L, PDL_D, etc.) */ |
|
569
|
|
|
|
|
|
|
PDL_Indx *dims; /* Array of data dimensions - could point below or to an allocated array */ |
|
570
|
|
|
|
|
|
|
PDL_Indx *dimincs; /* Array of data default increments, aka strides through memory for each dim (0 for dummies) */ |
|
571
|
|
|
|
|
|
|
PDL_Indx ndims; /* Number of data dimensions in dims and dimincs */ |
|
572
|
|
|
|
|
|
|
|
|
573
|
|
|
|
|
|
|
PDL_Indx *broadcastids; /* Starting index of the broadcast index set n */ |
|
574
|
|
|
|
|
|
|
PDL_Indx nbroadcastids; |
|
575
|
|
|
|
|
|
|
|
|
576
|
|
|
|
|
|
|
pdl_trans *def_trans_children[PDL_NCHILDREN]; |
|
577
|
|
|
|
|
|
|
PDL_Indx ntrans_children_allocated; |
|
578
|
|
|
|
|
|
|
PDL_Indx first_trans_child_available; |
|
579
|
|
|
|
|
|
|
pdl_trans **trans_children; |
|
580
|
|
|
|
|
|
|
|
|
581
|
|
|
|
|
|
|
PDL_Indx def_dims[PDL_NDIMS]; /* Preallocated space for efficiency */ |
|
582
|
|
|
|
|
|
|
PDL_Indx def_dimincs[PDL_NDIMS]; /* Preallocated space for efficiency */ |
|
583
|
|
|
|
|
|
|
PDL_Indx def_broadcastids[PDL_NBROADCASTIDS]; |
|
584
|
|
|
|
|
|
|
|
|
585
|
|
|
|
|
|
|
struct pdl_magic *magic; |
|
586
|
|
|
|
|
|
|
|
|
587
|
|
|
|
|
|
|
void *hdrsv; /* "header", settable from Perl */ |
|
588
|
|
|
|
|
|
|
PDL_Value value; /* to store at least one value */ |
|
589
|
|
|
|
|
|
|
PDL_Indx ntrans_children; /* CORE21 put next to other trans-tracking stuff */ |
|
590
|
|
|
|
|
|
|
}; |
|
591
|
|
|
|
|
|
|
|
|
592
|
|
|
|
|
|
|
typedef struct pdl_slice_args { |
|
593
|
|
|
|
|
|
|
PDL_Indx start; /* maps to start index of slice range (inclusive) */ |
|
594
|
|
|
|
|
|
|
PDL_Indx end; /* maps to end index of slice range (inclusive) */ |
|
595
|
|
|
|
|
|
|
PDL_Indx inc; /* maps to increment of slice range */ |
|
596
|
|
|
|
|
|
|
char dummy, squish; /* boolean */ |
|
597
|
|
|
|
|
|
|
struct pdl_slice_args *next; /* NULL is last */ |
|
598
|
|
|
|
|
|
|
} pdl_slice_args; |
|
599
|
|
|
|
|
|
|
|
|
600
|
|
|
|
|
|
|
#define PDL_USESTRUCTVALUE(it) \ |
|
601
|
|
|
|
|
|
|
(it->nbytes <= sizeof(it->value)) |
|
602
|
|
|
|
|
|
|
|
|
603
|
|
|
|
|
|
|
#define PDLMAX(a,b) ((a) > (b) ? (a) : (b)) |
|
604
|
|
|
|
|
|
|
#define PDLMIN(a,b) ((a) < (b) ? (a) : (b)) |
|
605
|
|
|
|
|
|
|
#define PDL_ABS(A) ( (A)>=0 ? (A) : -(A) ) |
|
606
|
|
|
|
|
|
|
|
|
607
|
|
|
|
|
|
|
#define PDL_RETERROR2(rv, expr, iferr) \ |
|
608
|
|
|
|
|
|
|
do { rv = expr; if (rv.error) { iferr } } while (0) |
|
609
|
|
|
|
|
|
|
#define PDL_RETERROR(rv, expr) PDL_RETERROR2(rv, expr, return rv;) |
|
610
|
|
|
|
|
|
|
#define PDL_ACCUMERROR(rv, expr) \ |
|
611
|
|
|
|
|
|
|
do { \ |
|
612
|
|
|
|
|
|
|
pdl_error rv##_local = expr; \ |
|
613
|
|
|
|
|
|
|
if (rv##_local.error) rv = pdl_error_accumulate(rv, rv##_local); \ |
|
614
|
|
|
|
|
|
|
} while (0) |
|
615
|
|
|
|
|
|
|
|
|
616
|
|
|
|
|
|
|
#define PDL_ENSURE_ALLOCATED(it) \ |
|
617
|
|
|
|
|
|
|
if (!(it->state & PDL_ALLOCATED)) { \ |
|
618
|
|
|
|
|
|
|
PDL_RETERROR(PDL_err, pdl_allocdata(it)); \ |
|
619
|
|
|
|
|
|
|
} |
|
620
|
|
|
|
|
|
|
|
|
621
|
|
|
|
|
|
|
/* for use with PDL_TYPELIST_REAL */ |
|
622
|
|
|
|
|
|
|
#define PDL_QSORT(symbol, ctype, ppsym, ...) \ |
|
623
|
|
|
|
|
|
|
static inline void qsort_ ## ppsym(ctype* xx, PDL_Indx a, PDL_Indx b) { \ |
|
624
|
|
|
|
|
|
|
PDL_Indx i,j; \ |
|
625
|
|
|
|
|
|
|
ctype t, median; \ |
|
626
|
|
|
|
|
|
|
i = a; j = b; \ |
|
627
|
|
|
|
|
|
|
median = xx[(i+j) / 2]; \ |
|
628
|
|
|
|
|
|
|
do { \ |
|
629
|
|
|
|
|
|
|
while (xx[i] < median) \ |
|
630
|
|
|
|
|
|
|
i++; \ |
|
631
|
|
|
|
|
|
|
while (median < xx[j]) \ |
|
632
|
|
|
|
|
|
|
j--; \ |
|
633
|
|
|
|
|
|
|
if (i <= j) { \ |
|
634
|
|
|
|
|
|
|
t = xx[i]; xx[i] = xx[j]; xx[j] = t; \ |
|
635
|
|
|
|
|
|
|
i++; j--; \ |
|
636
|
|
|
|
|
|
|
} \ |
|
637
|
|
|
|
|
|
|
} while (i <= j); \ |
|
638
|
|
|
|
|
|
|
if (a < j) \ |
|
639
|
|
|
|
|
|
|
qsort_ ## ppsym(xx,a,j); \ |
|
640
|
|
|
|
|
|
|
if (i < b) \ |
|
641
|
|
|
|
|
|
|
qsort_ ## ppsym(xx,i,b); \ |
|
642
|
|
|
|
|
|
|
} |
|
643
|
|
|
|
|
|
|
|
|
644
|
|
|
|
|
|
|
#define PDL_BROADCASTLOOP_START(funcName, brc, vtable, ptrStep1, ptrStep2, ptrStep3) \ |
|
645
|
|
|
|
|
|
|
__brcloopval = PDL->startbroadcastloop(&(brc),(vtable)->funcName, __privtrans, &PDL_err); \ |
|
646
|
|
|
|
|
|
|
if (PDL_err.error) return PDL_err; \ |
|
647
|
|
|
|
|
|
|
if ( __brcloopval < 0 ) return PDL->make_error_simple(PDL_EFATAL, "Error starting broadcastloop"); \ |
|
648
|
|
|
|
|
|
|
if ( __brcloopval ) return PDL_err; \ |
|
649
|
|
|
|
|
|
|
do { \ |
|
650
|
|
|
|
|
|
|
PDL_Indx *__tdims = PDL->get_broadcastdims(&(brc)); \ |
|
651
|
|
|
|
|
|
|
if (!__tdims) return PDL->make_error_simple(PDL_EFATAL, "Error in get_broadcastdims"); \ |
|
652
|
|
|
|
|
|
|
register PDL_Indx __tdims0 = __tdims[0]; \ |
|
653
|
|
|
|
|
|
|
register PDL_Indx __tdims1 = __tdims[1]; \ |
|
654
|
|
|
|
|
|
|
register PDL_Indx *__offsp = PDL->get_threadoffsp(&(brc)); \ |
|
655
|
|
|
|
|
|
|
if (!__offsp ) return PDL->make_error_simple(PDL_EFATAL, "Error in get_threadoffsp"); \ |
|
656
|
|
|
|
|
|
|
/* incs are each pdl's stride, declared at func start */ \ |
|
657
|
|
|
|
|
|
|
/* offs are each pthread's starting offset into each pdl */ \ |
|
658
|
|
|
|
|
|
|
ptrStep1 \ |
|
659
|
|
|
|
|
|
|
for( __tind1 = 0 ; \ |
|
660
|
|
|
|
|
|
|
__tind1 < __tdims1 ; \ |
|
661
|
|
|
|
|
|
|
__tind1++ \ |
|
662
|
|
|
|
|
|
|
/* step by tinc1, undoing inner-loop of tinc0*tdims0 */ \ |
|
663
|
|
|
|
|
|
|
PDL_EXPAND ptrStep2 \ |
|
664
|
|
|
|
|
|
|
) \ |
|
665
|
|
|
|
|
|
|
{ \ |
|
666
|
|
|
|
|
|
|
for( __tind0 = 0 ; \ |
|
667
|
|
|
|
|
|
|
__tind0 < __tdims0 ; \ |
|
668
|
|
|
|
|
|
|
__tind0++ \ |
|
669
|
|
|
|
|
|
|
PDL_EXPAND ptrStep3 \ |
|
670
|
|
|
|
|
|
|
) { \ |
|
671
|
|
|
|
|
|
|
/* This is the tightest loop. Make sure inside is optimal. */ |
|
672
|
|
|
|
|
|
|
#define PDL_BROADCASTLOOP_END(brc, ptrStep1) \ |
|
673
|
|
|
|
|
|
|
} \ |
|
674
|
|
|
|
|
|
|
} \ |
|
675
|
|
|
|
|
|
|
/* undo outer-loop of tinc1*tdims1, and original per-pthread offset */ \ |
|
676
|
|
|
|
|
|
|
ptrStep1 \ |
|
677
|
|
|
|
|
|
|
__brcloopval = PDL->iterbroadcastloop(&(brc),2); \ |
|
678
|
|
|
|
|
|
|
if ( __brcloopval < 0 ) return PDL->make_error_simple(PDL_EFATAL, "Error in iterbroadcastloop"); \ |
|
679
|
|
|
|
|
|
|
} while(__brcloopval); |
|
680
|
|
|
|
|
|
|
|
|
681
|
|
|
|
|
|
|
/* __PDL_H */ |
|
682
|
|
|
|
|
|
|
#endif |
|
683
|
|
|
|
|
|
|
EOF |