5
use File::Basename qw(&basename &dirname);
7
# version 2 is for versions after PDL 2.1.1
8
use vars qw( $pdl_core_version );
11
# List explicitly here the variables you want Configure to
12
# generate. Metaconfig only looks for shell variables, so you
13
# have to mention them as if they were shell variables, not
14
# %Config entries. Thus you write
16
# to ensure Configure will look for $Config{startperl}.
18
# This forces PL files to create target in same directory as PL file.
19
# This is so that make depend always knows where to find PL derivatives.
22
($file = basename($0)) =~ s/\.PL$//;
24
if ($Config{'osname'} eq 'VMS' or
25
$Config{'osname'} eq 'OS2'); # "case-forgiving"
27
print "Extracting $file\n";
28
open OUT,">$file" or die "Can't create $file: $!";
31
# In this section, perl variables will be expanded during extraction.
32
# You can use $Config{...} to use Configure variables.
35
print OUT <<'!NO!SUBS!';
37
* THIS FILE IS GENERATED FROM pdlcore.h.PL! Do NOT edit!
40
#include "EXTERN.h" /* std perl include */
41
#include "perl.h" /* std perl include */
43
#include "XSUB.h" /* for the win32 perlCAPI crap */
45
#if defined(CONTEXT) && defined(__osf__)
50
#include "pdlthread.h"
51
/* the next one causes trouble in c++ compiles - exclude for now */
58
print OUT "#define PDL_CORE_VERSION $pdl_core_version\n";
60
print OUT <<'!NO!SUBS!' if ($^O =~ /MSWin/);
62
#define finite _finite
67
print OUT <<'!NO!SUBS!';
69
#define PDL_TMP 0 /* Flags */
72
#define BIGGESTOF(a,b) ( a->nvals>b->nvals ? a->nvals : b->nvals )
74
/* for the moment we go back to the original croak
75
* since there seem to be quite a few problems with maintaining
76
* our own barf version
83
/*************** Function prototypes *********************/
88
int pdl_howbig (int datatype); /* Size of data type (bytes) */
89
pdl* SvPDLV ( SV* sv ); /* Map SV* to pdl struct */
90
void SetSV_PDL( SV *sv, pdl *it ); /* Outputting a pdl from.. */
91
SV* pdl_copy( pdl* a, char* option ); /* call copy method */
92
PDL_Long * pdl_packdims ( SV* sv, int*ndims ); /* Pack dims[] into SV aref */
93
void pdl_unpackdims ( SV* sv, PDL_Long *dims, /* Unpack */
95
void* pdl_malloc ( int nbytes ); /* malloc memory - auto free()*/
97
void pdl_makescratchhash(pdl *ret,double data, int datatype);
98
PDL_Long pdl_safe_indterm(PDL_Long dsz, PDL_Long at, char *file, int lineno);
99
void pdl_barf(const char* pat,...); /* General croaking utility */
103
void pdl_vaffinechanged(pdl *it, int what);
104
void pdl_trans_mallocfreeproc(struct pdl_trans *tr);
105
void pdl_make_trans_mutual(pdl_trans *trans);
106
void pdl_destroytransform_nonmutual(pdl_trans *trans,int ensure);
108
void pdl_vafftrans_free(pdl *it);
109
void pdl_vafftrans_remove(pdl * it);
110
void pdl_make_physvaffine(pdl *it);
111
void pdl_vafftrans_alloc(pdl *it);
114
pdl *pdl_get_convertedpdl(pdl *pdl,int type);
116
void pdl_destroytransform(pdl_trans *trans,int ensure);
117
pdl *pdl_make_now(pdl *it);
119
pdl *pdl_hard_copy(pdl *src);
121
#define pdl_new() pdl_create(PDL_PERM)
122
#define pdl_tmp() pdl_create(PDL_TMP)
123
pdl* pdl_external_new();
124
pdl* pdl_external_tmp();
125
pdl* pdl_create(int type);
126
void pdl_destroy(pdl *it);
127
void pdl_setdims(pdl* it, PDL_Long* dims, int ndims);
128
void pdl_reallocdims ( pdl *it,int ndims ); /* reallocate dims and incs */
129
void pdl_reallocthreadids ( pdl *it,int ndims ); /* reallocate threadids */
130
void pdl_resize_defaultincs ( pdl *it ); /* Make incs out of dims */
131
void pdl_unpackarray ( HV* hash, char *key, int *dims, int ndims );
132
void pdl_print(pdl *it);
133
void pdl_dump(pdl *it);
134
void pdl_allocdata(pdl *it);
136
int *pdl_get_threadoffsp(pdl_thread *thread); /* For pthreading */
137
void pdl_thread_copy(pdl_thread *from,pdl_thread *to);
138
void pdl_clearthreadstruct(pdl_thread *it);
139
void pdl_initthreadstruct(int nobl,pdl **pdls,int *realdims,int *creating,int npdls,
140
pdl_errorinfo *info,pdl_thread *thread,char *flags);
141
int pdl_startthreadloop(pdl_thread *thread,void (*func)(pdl_trans *),pdl_trans *);
142
int pdl_iterthreadloop(pdl_thread *thread,int which);
143
void pdl_freethreadloop(pdl_thread *thread);
144
void pdl_thread_create_parameter(pdl_thread *thread,int j,int *dims,
146
void pdl_croak_param(pdl_errorinfo *info,int j, char *pat, ...);
148
void pdl_setdims_careful(pdl *pdl);
149
void pdl_put_offs(pdl *pdl,PDL_Long offs, double val);
150
double pdl_get_offs(pdl *pdl,PDL_Long offs);
151
double pdl_get(pdl *pdl,int *inds);
152
void pdl_set_trans(pdl *it, pdl *parent, pdl_transvtable *vtable);
154
void pdl_make_physical(pdl *it);
155
void pdl_make_physdims(pdl *it);
157
void pdl_children_changesoon(pdl *it, int what);
158
void pdl_changed(pdl *it, int what, int recursing);
159
void pdl_separatefromparent(pdl *it);
161
void pdl_trans_changesoon(pdl_trans *trans,int what);
162
void pdl_trans_changed(pdl_trans *trans,int what);
164
void pdl_set_trans_childtrans(pdl *it, pdl_trans *trans,int nth);
165
void pdl_set_trans_parenttrans(pdl *it, pdl_trans *trans,int nth);
169
pdl* pdl_getcache( HV* hash ); /* Retrieve address of $$x{PDL} */
170
pdl* pdl_fillcache( HV* hash, SV* ref); /* Fill/create $$x{PDL} cache */
171
void pdl_fillcache_partial( HV *hash, pdl *thepdl ) ;
172
SV* pdl_getKey( HV* hash, char* key ); /* Get $$x{Key} SV* with deref */
173
void pdl_flushcache( pdl *thepdl ); /* flush cache */
177
void pdl_family_create(pdl *from,pdl_trans *trans,int ind1,int ind2);
178
pdl *pdl_family_clone2now(pdl *from); /* Use pdl_make_now instead */
183
void pdl_writebackdata_vaffine(pdl *it);
184
void pdl_readdata_vaffine(pdl *it);
186
void pdl_swap(pdl** a, pdl** b); /* Swap two pdl ptrs */
187
void pdl_converttype( pdl** a, int targtype, /* Change type of a pdl */
188
Logical changePerl );
189
void pdl_coercetypes( pdl** a, pdl **b, Logical changePerl ); /* Two types to same */
190
void pdl_grow ( pdl* a, int newsize); /* Change pdl 'Data' size */
191
void pdl_retype( pdl* a, int newtype); /* Change pdl 'Datatype' value */
192
void** pdl_twod( pdl* x ); /* Return 2D pointer to data array */
196
int pdl_get_offset(PDL_Long* pos, PDL_Long* dims, PDL_Long *incs, PDL_Long offset, int ndims); /* Offset of pixel x,y,z... */
197
int pdl_validate_section( int* sec, int* dims, /* Check section */
199
void pdl_row_plusplus ( int* pos, int* dims, /* Move down one row */
201
void pdl_subsection( char *y, char*x, int datatype, /* Take subsection */
202
int* sec, int* dims, int *incs, int offset, int* ndims);
203
void pdl_insertin( char*y, int* ydims, int nydims, /* Insert pdl in pdl */
204
char*x, int* xdims, int nxdims,
205
int datatype, int* pos);
206
double pdl_at( void* x, int datatype, PDL_Long* pos, PDL_Long* dims, /* Value at x,y,z,... */
207
PDL_Long *incs, PDL_Long offset, int ndims);
208
void pdl_set( void* x, int datatype, PDL_Long* pos, PDL_Long* dims, /* Set value at x,y,z... */
209
PDL_Long *incs, PDL_Long offs, int ndims, double value);
210
void pdl_axisvals( pdl* a, int axis ); /* Fill with axis values */
212
/* Structure to hold pointers core PDL routines so as to be used by many modules */
216
pdl* (*SvPDLV) ( SV* );
217
void (*SetSV_PDL) ( SV *sv, pdl *it );
218
#if defined(PDL_clean_namespace) || defined(PDL_OLD_API)
219
pdl* (*new) ( ); /* make it work with gimp-perl */
221
pdl* (*pdlnew) ( ); /* renamed because of C++ clash */
224
pdl* (*create) (int type);
225
void (*destroy) (pdl *it);
227
SV* (*copy) ( pdl*, char* );
228
void (*converttype) ( pdl**, int, Logical );
229
void** (*twod) ( pdl* );
230
void* (*smalloc) ( int );
231
int (*howbig) ( int );
232
PDL_Long* (*packdims) ( SV* sv, int *ndims ); /* Pack dims[] into SV aref */
233
void (*setdims) ( pdl* it, PDL_Long* dims, int ndims );
234
void (*unpackdims) ( SV* sv, PDL_Long *dims, /* Unpack */
236
void (*grow) ( pdl* a, int newsize); /* Change pdl 'Data' size */
237
void (*flushcache)( pdl *thepdl ); /* flush cache */
238
void (*reallocdims) ( pdl *it,int ndims ); /* reallocate dims and incs */
239
void (*reallocthreadids) ( pdl *it,int ndims );
240
void (*resize_defaultincs) ( pdl *it ); /* Make incs out of dims */
242
void (*thread_copy)(pdl_thread *from,pdl_thread *to);
243
void (*clearthreadstruct)(pdl_thread *it);
244
void (*initthreadstruct)(int nobl,pdl **pdls,int *realdims,int *creating,int npdls,
245
pdl_errorinfo *info,pdl_thread *thread,char *flags);
246
int (*startthreadloop)(pdl_thread *thread,void (*func)(pdl_trans *),pdl_trans *);
247
int *(*get_threadoffsp)(pdl_thread *thread); /* For pthreading */
248
int (*iterthreadloop)(pdl_thread *thread,int which);
249
void (*freethreadloop)(pdl_thread *thread);
250
void (*thread_create_parameter)(pdl_thread *thread,int j,int *dims,
252
void (*add_deletedata_magic) (pdl *it,void (*func)(pdl *, int param), int param); /* Automagic destructor */
254
/* XXX NOT YET IMPLEMENTED */
255
void (*setdims_careful)(pdl *pdl);
256
void (*put_offs)(pdl *pdl,PDL_Long offs, double val);
257
double (*get_offs)(pdl *pdl,PDL_Long offs);
258
double (*get)(pdl *pdl,int *inds);
259
void (*set_trans_childtrans)(pdl *it, pdl_trans *trans,int nth);
260
void (*set_trans_parenttrans)(pdl *it, pdl_trans *trans,int nth);
261
pdl *(*make_now)(pdl *it);
263
pdl *(*get_convertedpdl)(pdl *pdl,int type);
265
void (*make_trans_mutual)(pdl_trans *trans);
267
/* Affine trans. THESE ARE SET IN ONE OF THE OTHER Basic MODULES
268
and not in Core.xs ! */
269
void (*readdata_affine)(pdl_trans *tr);
270
void (*writebackdata_affine)(pdl_trans *tr);
271
void (*affine_new)(pdl *par,pdl *child,int offs,SV *dims,SV *incs);
273
/* Converttype. Similar */
274
void (*converttypei_new)(pdl *par,pdl *child,int type);
276
void (*trans_mallocfreeproc)(struct pdl_trans *tr);
278
void (*make_physical)(pdl *it);
279
void (*make_physdims)(pdl *it);
280
void (*pdl_barf) (const char* pat,...); /* Not plain 'barf' as this
282
void (*make_physvaffine)(pdl *it);
283
void (*allocdata) (pdl *it);
284
PDL_Long (*safe_indterm)(PDL_Long dsz, PDL_Long at, char *file, int lineno);
288
# set up the qsort routines
290
# fortunately it looks like Types.pm.PL is processed before this
292
require "Types.pm"; # ie PDL::Types
294
for (keys %PDL::Types::typehash) {
295
my $ctype = $PDL::Types::typehash{$_}{ctype};
296
my $ppsym = $PDL::Types::typehash{$_}{ppsym};
298
print OUT "void (*qsort_${ppsym}) (${ctype} *xx, int a, int b );\n";
299
print OUT "void (*qsort_ind_${ppsym}) (${ctype} *xx, int *ix, int a, int b );\n";
302
# storage space for bad values
304
print OUT <<'!NO!SUBS!';
306
badvals bvals; /* store the default bad values */
307
void (*propogate_badflag) (pdl *it, int newval ); /* defined in bad.pd */
311
typedef struct Core Core;
313
Core *pdl__Core_get_Core(); /* INTERNAL TO CORE! DON'T CALL FROM OUTSIDE */