File Coverage

lib/PDL/Core/pdl.h.PL
Criterion Covered Total %
statement 8 8 100.0
branch 12 16 75.0
condition n/a
subroutine n/a
pod n/a
total 20 24 83.3


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