1 #include "EXTERN.h" 2 #include "perl.h" 3 4 #if defined(PERL_OBJECT) 5 #define NO_XSLOCKS 6 extern CPerlObj* pPerl; 7 #include "XSUB.h" 8 #endif 9 10 #ifdef USE_DECLSPEC_THREAD 11 __declspec(thread) void *PL_current_context = NULL; 12 #endif 13 14 void 15 Perl_set_context(void *t) 16 { 17 #if defined(USE_THREADS) || defined(USE_ITHREADS) 18 # ifdef USE_DECLSPEC_THREAD 19 Perl_current_context = t; 20 # else 21 DWORD err = GetLastError(); 22 TlsSetValue(PL_thr_key,t); 23 SetLastError(err); 24 # endif 25 #endif 26 } 27 28 void * 29 Perl_get_context(void) 30 { 31 #if defined(USE_THREADS) || defined(USE_ITHREADS) 32 # ifdef USE_DECLSPEC_THREAD 33 return Perl_current_context; 34 # else 35 DWORD err = GetLastError(); 36 void *result = TlsGetValue(PL_thr_key); 37 SetLastError(err); 38 return result; 39 # endif 40 #else 41 return NULL; 42 #endif 43 } 44 45 #ifdef USE_THREADS 46 void 47 Perl_init_thread_intern(struct perl_thread *athr) 48 { 49 #ifndef USE_DECLSPEC_THREAD 50 51 /* 52 * Initialize port-specific per-thread data in thr->i 53 * as only things we have there are just static areas for 54 * return values we don't _need_ to do anything but 55 * this is good practice: 56 */ 57 memset(&athr->i,0,sizeof(athr->i)); 58 59 #endif 60 } 61 62 void 63 Perl_set_thread_self(struct perl_thread *thr) 64 { 65 /* Set thr->self. GetCurrentThread() retrurns a pseudo handle, need 66 this to convert it into a handle another thread can use. 67 */ 68 DuplicateHandle(GetCurrentProcess(), 69 GetCurrentThread(), 70 GetCurrentProcess(), 71 &thr->self, 72 0, 73 FALSE, 74 DUPLICATE_SAME_ACCESS); 75 } 76 77 int 78 Perl_thread_create(struct perl_thread *thr, thread_func_t *fn) 79 { 80 DWORD junk; 81 unsigned long th; 82 83 DEBUG_S(PerlIO_printf(Perl_debug_log, 84 "%p: create OS thread\n", thr)); 85 #ifdef USE_RTL_THREAD_API 86 /* See comment about USE_RTL_THREAD_API in win32thread.h */ 87 #if defined(__BORLANDC__) 88 th = _beginthreadNT(fn, /* start address */ 89 0, /* stack size */ 90 (void *)thr, /* parameters */ 91 (void *)NULL, /* security attrib */ 92 0, /* creation flags */ 93 (unsigned long *)&junk); /* tid */ 94 if (th == (unsigned long)-1) 95 th = 0; 96 #elif defined(_MSC_VER_) 97 th = _beginthreadex((void *)NULL, /* security attrib */ 98 0, /* stack size */ 99 fn, /* start address */ 100 (void*)thr, /* parameters */ 101 0, /* creation flags */ 102 (unsigned *)&junk); /* tid */ 103 #else /* compilers using CRTDLL.DLL only have _beginthread() */ 104 th = _beginthread(fn, /* start address */ 105 0, /* stack size */ 106 (void*)thr); /* parameters */ 107 if (th == (unsigned long)-1) 108 th = 0; 109 #endif 110 thr->self = (HANDLE)th; 111 #else /* !USE_RTL_THREAD_API */ 112 thr->self = CreateThread(NULL, 0, fn, (void*)thr, 0, &junk); 113 #endif /* !USE_RTL_THREAD_API */ 114 DEBUG_S(PerlIO_printf(Perl_debug_log, 115 "%p: OS thread = %p, id=%ld\n", thr, thr->self, junk)); 116 return thr->self ? 0 : -1; 117 } 118 #endif 119 120