File: pdlmagic.c

package info (click to toggle)
pdl 1%3A2.4.11-4
  • links: PTS
  • area: main
  • in suites: wheezy
  • size: 11,152 kB
  • sloc: perl: 31,295; fortran: 13,113; ansic: 8,910; makefile: 76; sh: 28; sed: 6
file content (539 lines) | stat: -rw-r--r-- 14,110 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
#define PDL_CORE      /* For certain ifdefs */
#ifndef WIN32
#define USE_MMAP
#else
#undef USE_MMAP
#endif

#include "pdlcore.h"

#ifdef USE_MMAP
#include <sys/mman.h>
#endif

/* Variable storing our the pthread ID for the main PDL thread.
 *  This is used to tell if we are in the main pthread, or in one of
 *  the pthreads spawned for PDL processing
 * This is only used when compiled with pthreads.
 */
#ifdef PDL_PTHREAD
static pthread_t pdl_main_pthreadID;
static int done_pdl_main_pthreadID_init = 0;

/* deferred error messages are stored here. We can only barf/warn from the main
 *  thread, so worker threads complain here and the complaints are printed out
 *  altogether later
 */
static char* pdl_pthread_barf_msgs     = NULL;
static int   pdl_pthread_barf_msgs_len = 0;
static char* pdl_pthread_warn_msgs     = NULL;
static int   pdl_pthread_warn_msgs_len = 0;

#endif


/* Singly linked list */
/* Note that this zeroes ->next!) */

void pdl__magic_add(pdl *it,pdl_magic *mag)
{
	pdl_magic **foo = &(it->magic);
	while(*foo) {
		foo = &((*foo)->next);
	}
	(*foo) = mag;
	mag->next = NULL;
}

void pdl__magic_rm(pdl *it,pdl_magic *mag)
{
	pdl_magic **foo = &(it->magic);
	int found = 0;
	while(*foo) {
		if(*foo == mag) {
			*foo = (*foo)->next;
			found = 1;
		}
		else{
			foo = &((*foo)->next);
		}
	}
	if( !found ){
		die("PDL:Magic not found: Internal error\n");
	}
	return;
}

void pdl__magic_free(pdl *it)
{
  if (pdl__ismagic(it) && !pdl__magic_isundestroyable(it)) {
    pdl_magic *foo = it->magic;
    while(foo) {
      pdl_magic *next = foo->next;
      free(foo);
      foo = next;
    }
  }
}

/* Test for undestroyability */

int pdl__magic_isundestroyable(pdl *it)
{
	pdl_magic **foo = &(it->magic);
	while(*foo) {
		if((*foo)->what & PDL_MAGIC_UNDESTROYABLE) {return 1;}
		foo = &((*foo)->next);
	}
	return 0;
}

/* Call magics */

void *pdl__call_magic(pdl *it,int which)
{
	void *ret = NULL;
	pdl_magic **foo = &(it->magic);
	while(*foo) {
		if((*foo)->what & which) {
			if((*foo)->what & PDL_MAGIC_DELAYED)
				pdl_add_delayed_magic(*foo);
			else
				ret = (void *)((*foo)->vtable->cast(*foo));
					/* Cast spell */
		}
		foo = &((*foo)->next);
	}
	return ret;
}

/* XXX FINDS ONLY FIRST */
pdl_magic *pdl__find_magic(pdl *it, int which)
{
	pdl_magic **foo = &(it->magic);
	while(*foo) {
		if((*foo)->what & which) {
			return *foo;
		}
		foo = &((*foo)->next);
	}
	return NULL;
}

pdl_magic *pdl__print_magic(pdl *it)
{
	pdl_magic **foo = &(it->magic);
	while(*foo) {
	  printf("Magic %p\ttype: ",(void*)(*foo));
		if((*foo)->what & PDL_MAGIC_MARKCHANGED)
		  printf("PDL_MAGIC_MARKCHANGED");
		else if ((*foo)->what & PDL_MAGIC_MUTATEDPARENT)
		  printf("PDL_MAGIC_MUTATEDPARENT");
		else if ((*foo)->what & PDL_MAGIC_THREADING)
		  printf("PDL_MAGIC_THREADING");
		else
		  printf("UNKNOWN");
		if ((*foo)->what & (PDL_MAGIC_DELAYED|PDL_MAGIC_UNDESTROYABLE))
		  {
		    printf(" qualifier(s): ");
		    if ((*foo)->what & PDL_MAGIC_DELAYED)
		      printf(" PDL_MAGIC_DELAYED");
		    if ((*foo)->what & PDL_MAGIC_UNDESTROYABLE)
		      printf(" PDL_MAGIC_UNDESTROYABLE");
		  }
		printf("\n");
		foo = &((*foo)->next);
	}
	return NULL;
}


int pdl__ismagic(pdl *it)
{
	return (it->magic != 0);
}

static pdl_magic **delayed=NULL;
static int ndelayed = 0;
void pdl_add_delayed_magic(pdl_magic *mag) {
	delayed = realloc(delayed,sizeof(*delayed)*++ndelayed);
	delayed[ndelayed-1] = mag;
}
void pdl_run_delayed_magic() {
	int i;
	pdl_magic **oldd = delayed; /* In case someone makes new delayed stuff */
	int nold = ndelayed;
	delayed = NULL;
	ndelayed = 0;
	for(i=0; i<nold; i++) {
		oldd[i]->vtable->cast(oldd[i]);
	}
	free(oldd);
}

/****************
 *
 * ->bind - magic
 */

void *svmagic_cast(pdl_magic *mag)
{
	pdl_magic_perlfunc *magp = (pdl_magic_perlfunc *)mag;
	dSP;
	PUSHMARK(sp);
	perl_call_sv(magp->sv, G_DISCARD | G_NOARGS);
	return NULL;
}

static pdl_magic_vtable svmagic_vtable = {
	svmagic_cast,
	NULL
};

pdl_magic *pdl_add_svmagic(pdl *it,SV *func)
{
	AV *av;
	pdl_magic_perlfunc *ptr = malloc(sizeof(pdl_magic_perlfunc));
	ptr->what = PDL_MAGIC_MARKCHANGED | PDL_MAGIC_DELAYED;
	ptr->vtable = &svmagic_vtable;
	ptr->sv = newSVsv(func);
	ptr->pdl = it;
	ptr->next = NULL;
	pdl__magic_add(it,(pdl_magic *)ptr);
	if(it->state & PDL_ANYCHANGED)
		pdl_add_delayed_magic((pdl_magic *)ptr);
/* In order to have our SV destroyed in time for the interpreter, */
/* XXX Work this out not to memleak */
	av = perl_get_av("PDL::disposable_svmagics",TRUE);
	av_push(av,ptr->sv);
	return (pdl_magic *)ptr;
}


/****************
 *
 * ->bind - magic
 */

pdl_trans *pdl_find_mutatedtrans(pdl *it)
{
	if(!it->magic) return 0;
	return pdl__call_magic(it,PDL_MAGIC_MUTATEDPARENT);
}

static void *fammutmagic_cast(pdl_magic *mag)
{
	pdl_magic_fammut *magp = (pdl_magic_fammut *)mag;
	return magp->ftr;
}

struct pdl_magic_vtable familymutmagic_vtable = {
	fammutmagic_cast,
	NULL
};

pdl_magic *pdl_add_fammutmagic(pdl *it,pdl_trans *ft)
{
	pdl_magic_fammut *ptr = malloc(sizeof(pdl_magic_fammut));
	ptr->what = PDL_MAGIC_MUTATEDPARENT;
	ptr->vtable = &familymutmagic_vtable;
	ptr->ftr = ft;
	ptr->pdl = it;
	ptr->next = NULL;
	pdl__magic_add(it,(pdl_magic *)ptr);
	return (pdl_magic *)ptr;
}

#ifdef PDL_PTHREAD

/**************
 *
 * pthreads
 *
 */

#define TVERB 0

typedef struct ptarg {
	pdl_magic_pthread *mag;
	void (*func)(pdl_trans *);
	pdl_trans *t;
	int no;
} ptarg;

int pdl_pthreads_enabled(void) {return 1;}


static void *pthread_perform(void *vp) {
	struct ptarg *p = (ptarg *)vp;
	/* if(TVERB) printf("STARTING THREAD %d (%d)\n",p->no, pthread_self()); */
	if(TVERB) printf("STARTING THREAD number %d\n",p->no);
	pthread_setspecific(p->mag->key,(void *)&(p->no));
	(p->func)(p->t);
	/* if(TVERB) printf("ENDING THREAD %d (%d)\n",p->no, pthread_self());   */
	if(TVERB) printf("ENDING THREAD number %d\n",p->no);
	return NULL;
}

int pdl_magic_thread_nthreads(pdl *it,int *nthdim) {
	pdl_magic_pthread *ptr = (pdl_magic_pthread *)pdl__find_magic(it, PDL_MAGIC_THREADING);
	if(!ptr) return 0;
	*nthdim = ptr->nthdim;
	return ptr->nthreads;
}

int pdl_magic_get_thread(pdl *it) { /* XXX -> only one thread can handle pdl at once */
	pdl_magic_pthread *ptr;
	int *p;
	ptr = (pdl_magic_pthread *)pdl__find_magic(it, PDL_MAGIC_THREADING);
	if(!ptr) {die("Invalid pdl_magic_get_thread!");}
	p = (int*)pthread_getspecific(ptr->key);
	if(!p) {
		die("Invalid pdl_magic_get_thread specific!!!!");
	}
	return *p;
}

void pdl_magic_thread_cast(pdl *it,void (*func)(pdl_trans *),pdl_trans *t, pdl_thread *thread) {
	pdl_magic_pthread *ptr; pthread_t *tp; ptarg *tparg;
	int i;
	int clearMagic = 0; /* Flag = 1 if we are temporarily creating pthreading magic in the
						   supplied pdl.  */
	SV * barf_msg;	  /* Deferred barf message. Using a perl SV here so it's memory can be freeed by perl
						 after it is sent to croak */
	SV * warn_msg;	  /* Similar deferred warn message. */

	ptr = (pdl_magic_pthread *)pdl__find_magic(it, PDL_MAGIC_THREADING);
	if(!ptr) {
		/* Magic doesn't exist, create it
			Probably was deleted before the transformation performed, due to
			pdl lazy evaluation.
		*/

		pdl_add_threading_magic(it, thread->mag_nth, thread->mag_nthr);
		clearMagic = 1; /* Set flag to delete magic later */

		/* Try to get magic again */
		ptr = (pdl_magic_pthread *)pdl__find_magic(it, PDL_MAGIC_THREADING);

		if(!ptr) {die("Invalid pdl_magic_thread_cast!");}

	}

	tp = malloc(sizeof(pthread_t) * thread->mag_nthr);
	tparg = malloc(sizeof(*tparg) * thread->mag_nthr);
	pthread_key_create(&(ptr->key),NULL);
	/* if(TVERB) printf("CREATING THREADS, ME: %d, key: %d\n",pthread_self(), ptr->key); */
	if(TVERB) printf("CREATING THREADS, ME: TBD, key: %d\n", ptr->key);

	/* Get the pthread ID of this main thread we are in.
	 *	Any barf, warn, etc calls in the spawned pthreads can use this
	 *	to tell if its a spawned pthread
	 */
	pdl_main_pthreadID = pthread_self();   /* should do inside pthread_once() */
    done_pdl_main_pthreadID_init = 1;

    for(i=0; i<thread->mag_nthr; i++) {
        tparg[i].mag = ptr;
        tparg[i].func = func;
        tparg[i].t = t;
        tparg[i].no = i;
        if (pthread_create(tp+i, NULL, pthread_perform, tparg+i)) {
            die("Unable to create pthreads!");
        }
    }
	/* if(TVERB) printf("JOINING THREADS, ME: %d, key: %d\n",pthread_self(), ptr->key); */
	if(TVERB) printf("JOINING THREADS, ME: TBD, key: %d\n", ptr->key);
	for(i=0; i<thread->mag_nthr; i++) {
		pthread_join(tp[i], NULL);
	}
	/* if(TVERB) printf("FINISHED THREADS, ME: %d, key: %d\n",pthread_self(), ptr->key); */
	if(TVERB) printf("FINISHED THREADS, ME: TBD, key: %d\n", ptr->key);
	pthread_key_delete((ptr->key));

	/* Remove pthread magic if we created in this function */
	if( clearMagic ){
		pdl_add_threading_magic(it, -1, -1);
	}

	/* Clean up memory allocated */
	free(tp);
	free(tparg);

	// handle any errors that may have occured in the worker threads I reset the
	// length before actually barfing/warning because barf() may not come back.
	// In that case, I'll have len==0, but an unfreed pointer. This memory will
	// be reclaimed the next time we barf/warn something (since I'm using
	// realloc). If we never barf/warn again, we'll hold onto this memory until
	// the interpreter exits. This is a one-time penalty, though so it's fine
#define handle_deferred_errors(type)							\
	do{															\
		if(pdl_pthread_##type##_msgs_len != 0)					\
		{														\
			pdl_pthread_##type##_msgs_len = 0;					\
			pdl_##type ("%s", pdl_pthread_##type##_msgs);		\
			free(pdl_pthread_##type##_msgs);					\
			pdl_pthread_##type##_msgs	  = NULL;				\
		}														\
	} while(0)

	handle_deferred_errors(warn);
	handle_deferred_errors(barf);
}

/* Function to remove threading magic (added by pdl_add_threading_magic) */
void pdl_rm_threading_magic(pdl *it)
{
	pdl_magic_pthread *ptr = (pdl_magic_pthread *)pdl__find_magic(it, PDL_MAGIC_THREADING);

	/* Don't do anything if threading magic not found */
	if( !ptr) return;

	/* Remove magic */
	pdl__magic_rm(it, (pdl_magic *) ptr);

	/* Free magic */
	free( ptr );
}

/* Function to add threading magic (i.e. identify which PDL dimension should
   be pthreaded and how many pthreads to create
   Note: If nthdim and nthreads = -1 then any pthreading magic is removed */
void pdl_add_threading_magic(pdl *it,int nthdim,int nthreads)
{
      pdl_magic_pthread *ptr;

	/* Remove threading magic if called with parms -1, -1 */
	if( (nthdim == -1) && ( nthreads == -1 ) ){
		 pdl_rm_threading_magic(it);
		 return;
	}

	ptr = malloc(sizeof(pdl_magic_pthread));
	ptr->what = PDL_MAGIC_THREADING;
	ptr->vtable = NULL;
	ptr->next = NULL;
	ptr->nthdim = nthdim;
	ptr->nthreads = nthreads;
	pdl__magic_add(it,(pdl_magic *)ptr);
}

// Barf/warn function for deferred barf message handling during pthreading We
// can't barf/warn during ptheading, because perl-level code isn't
// threadsafe. This routine does nothing if we're in the main thread (allowing
// the caller to barf normally, since there are not threading issues then). If
// we're in a worker thread, this routine stores the message for main-thread
// reporting later
int pdl_pthread_barf_or_warn(const char* pat, int iswarn, va_list *args)
{
	char** msgs;
	int*   len;

	/* Don't do anything if we are in the main pthread */
	if( !done_pdl_main_pthreadID_init || pthread_equal( pdl_main_pthreadID, pthread_self() ) )
		return 0;

	if(iswarn)
	{
		msgs = &pdl_pthread_warn_msgs;
		len	 = &pdl_pthread_warn_msgs_len;
	}
	else
	{
		msgs = &pdl_pthread_barf_msgs;
		len	 = &pdl_pthread_barf_msgs_len;
	}

	// add the new complaint to the list
	{
		static pthread_mutex_t mutex = PTHREAD_MUTEX_INITIALIZER;
		pthread_mutex_lock( &mutex );
		{
			// In the chunk I'm adding I need to store the actual data and a trailing
			// newline.
			int extralen = vsnprintf(NULL, 0, pat, *args) + 1;

			// 1 more for the trailing '\0'. (For windows, we first #undef realloc
			// so that the system realloc function is used instead of the PerlMem_realloc
			// macro. This currently works fine, though could conceivably require some
			// tweaking in the future if it's found to cause any problem.)
#ifdef WIN32
#undef realloc
#endif
			*msgs = realloc(*msgs, *len + extralen + 1);
			vsnprintf( *msgs + *len, extralen + 1, pat, *args);

			// update the length-so-far. This does NOT include the trailing '\0'
			*len += extralen;

			// add the newline to the end
			(*msgs)[*len-1] = '\n';
			(*msgs)[*len  ] = '\0';
		}
		pthread_mutex_unlock( &mutex );
	}

	if(iswarn)
	{
		/* Return 1, indicating we have handled the warn messages */
		return(1);
	}

	/* Exit the current pthread. Since this was a barf call, and we should be halting execution */
	pthread_exit(NULL);
	return 0;
}


#else
/* Dummy versions */
void pdl_add_threading_magic(pdl *it,int nthdim,int nthreads) {}
int pdl_magic_get_thread(pdl *it) {return 0;}
void pdl_magic_thread_cast(pdl *it,void (*func)(pdl_trans *),pdl_trans *t, pdl_thread *thread) {}
int pdl_magic_thread_nthreads(pdl *it,int *nthdim) {return 0;}
int pdl_pthreads_enabled() {return 0;}
int pdl_pthread_barf_or_warn(const char* pat, int iswarn, va_list *args){ return 0;}
#endif

/***************************
 *
 * Delete magic
 *
 */


void pdl_delete_mmapped_data(pdl *p, Size_t param)
{
	if(!p) {return;}
	if(!p->data) {return;}
#ifdef USE_MMAP
	munmap(p->data, param);
#else
      /*  croak("internal error: trying to delete mmaped data on unsupported platform"); */
#endif
	p->data = 0;
}

static void *delete_mmapped_cast(pdl_magic *mag)
{
	pdl_magic_deletedata *magp = (pdl_magic_deletedata *)mag;
	magp->func(magp->pdl, magp->param);
	return NULL;
}

struct pdl_magic_vtable deletedatamagic_vtable = {
	delete_mmapped_cast,
	NULL
};

void pdl_add_deletedata_magic(pdl *it, void (*func)(pdl *, Size_t param), Size_t param)
{
	pdl_magic_deletedata *ptr = malloc(sizeof(pdl_magic_deletedata));
	ptr->what = PDL_MAGIC_DELETEDATA;
	ptr->vtable = &deletedatamagic_vtable;
	ptr->pdl = it;
	ptr->func = func;
	ptr->param = param;
	pdl__magic_add(it, (pdl_magic *)ptr);
}