regina/mt_win32.c

   1 /* This is the file to support WIN32 threads.
   2  * We initialize the global data structure and the global access variable.
   3  */
   4
   5 #include "regina_c.h"
   6 #include "rexxsaa.h"
   7 #define DONT_TYPEDEF_PFN
   8 #include "rexx.h"
   9 #include <stdlib.h>
  10 #include <string.h>
  11 #include <errno.h>
  12 #include <assert.h>
  13
  14 #define WIN32_LEAN_AND_MEAN
  15 #ifdef _MSC_VER
  16 # if _MSC_VER >= 1100
  17 /* Stupid MSC can't compile own headers without warning at least in VC 5.0 */
  18 #  pragma warning(disable: 4115 4201 4214 4514)
  19 # endif
  20 #endif
  21 #include <windows.h>
  22 #ifdef _MSC_VER
  23 # if _MSC_VER >= 1100
  24 #  pragma warning(default: 4115 4201 4214)
  25 # endif
  26 #endif
  27
  28 typedef struct { /* mt_tsd: static variables of this module (thread-safe) */
  29    HANDLE Heap;
  30 } mt_tsd_t; /* thread-specific but only needed by this module. see
  31              * ReginaInitializeThread
  32              */
  33
  34 static DWORD ThreadIndex = 0xFFFFFFFF; /* index of the TSD, not yet got */
  35
  36 /* We use only one critical section for all purposes. That's enough since
  37  * we use it very rarely.
  38  */
  39 static CRITICAL_SECTION cs = {0,};
  40
  41 #if defined(DYNAMIC) || (defined(__MINGW32__) && (__GNUC__ > 3 || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4)))
  42 static void DestroyHeap(tsd_t *TSD)
  43 {
  44    mt_tsd_t *mt = TSD->mt_tsd;
  45
  46    if (mt == NULL)
  47       return;
  48    if (mt->Heap != (HANDLE) 0)
  49       HeapDestroy(mt->Heap);
  50    free(mt);
  51    free(TSD);
  52 }
  53
  54 int IfcReginaCleanup( VOID )
  55 {
  56    tsd_t *TSD = __regina_get_tsd();
  57
  58    if (TSD == NULL)
  59       return 0;
  60
  61    deinit_rexxsaa(TSD);
  62    DestroyHeap(TSD);
  63    TlsSetValue(ThreadIndex,NULL);
  64
  65    return 1;
  66 }
  67 #endif
  68
  69 #ifdef DYNAMIC
  70 #define AcquireCriticalSection(cs) EnterCriticalSection(cs)
  71 #define AcquireThreadIndex() ThreadIndex
  72
  73 /* We provide a DLL entry function. Look at the standard documentation */
  74 BOOL WINAPI DllMain(HINSTANCE hinstDLL, DWORD Reason, LPVOID reserved)
  75 {
  76    tsd_t *TSD;
  77
  78    switch (Reason) {
  79       case DLL_PROCESS_ATTACH:
  80          /* Two things to do */
  81          InitializeCriticalSection(&cs);
  82          ThreadIndex = TlsAlloc();
  83          if (ThreadIndex == 0xFFFFFFFF)
  84             return FALSE; /* FIXME, FGC: Do we have to call SetLastError()? */
  85          break;
  86       case DLL_PROCESS_DETACH:
  87          break;
  88       case DLL_THREAD_ATTACH:
  89          break;
  90       case DLL_THREAD_DETACH:
  91          TSD = __regina_get_tsd();
  92          if (TSD != NULL)
  93          {
  94             deinit_rexxsaa(TSD);
  95             DestroyHeap(TSD);
  96          }
  97          break;
  98    }
  99    return(TRUE);
 100 }
 101 #else
 102 /* The DLL will do this work in DllMain above. This is for a MT library: */
 103
 104 /* AcquireCriticalSection locks the given critical section and
 105  * initializes it on the first use.
 106  */
 107 static void AcquireCriticalSection(CRITICAL_SECTION *cs)
 108 {
 109    /* double initializing the critical section won't produce an error.
 110     * We must do this on thread attachment if an error occurs in later
 111     * implementations of WIN32.
 112     */
 113    InitializeCriticalSection(cs);
 114
 115    EnterCriticalSection(cs);
 116 }
 117
 118 /* AcquireThreadIndex returns a valid ThreadIndex. */
 119 static DWORD AcquireThreadIndex(void)
 120 {
 121    if (ThreadIndex == 0xFFFFFFFF)
 122    {  /* get a unique access variable for the whole process */
 123       AcquireCriticalSection(&cs);
 124       if (ThreadIndex == 0xFFFFFFFF) /* may've changed just before Acquire */
 125          ThreadIndex = TlsAlloc();
 126       LeaveCriticalSection(&cs);
 127       /* give back a possible error value. nothing will help at this point */
 128    }
 129    return(ThreadIndex);
 130 }
 131 #endif
 132
 133 /* This should prevent some error messages and is used as a #define */
 134 static unsigned sizeof_ptr(void)
 135 {
 136    return(sizeof(void *));
 137 }
 138
 139 /* Lowest level memory allocation function for normal circumstances. */
 140 static void *MTMalloc( const tsd_t *TSD, size_t size )
 141 {
 142    mt_tsd_t *mt = TSD->mt_tsd;
 143
 144    if (mt == NULL)
 145       return(NULL); /* Let it die */
 146
 147    return(HeapAlloc(mt->Heap,HEAP_NO_SERIALIZE,size));
 148 }
 149
 150 /* Lowest level memory deallocation function for normal circumstances. */
 151 static void MTFree( const tsd_t *TSD, void *chunk )
 152 {
 153    mt_tsd_t *mt = TSD->mt_tsd;
 154
 155    /*
 156     * Just in case...
 157     */
 158    if ( chunk == NULL)
 159       return;
 160
 161    if (mt == NULL)
 162       return; /* ??? */
 163
 164    HeapFree(mt->Heap,HEAP_NO_SERIALIZE,chunk);
 165 }
 166
 167 /* Lowest level exit handler. */
 168 static void MTExit(int code)
 169 {
 170    ExitThread(code);
 171 }
 172
 173 /* ReginaInitializeThread creates a new thread structure and returns a ptr
 174  * to the initialized value.
 175  * The function may be called more than once.
 176  */
 177 tsd_t *ReginaInitializeThread(void)
 178 {
 179    int OK;
 180    DWORD idx;
 181    tsd_t *retval;
 182    mt_tsd_t *mt;
 183
 184    /* If you run into trouble here, you must change the code in
 185     * ReginsSetMutex/ReginaUnsetMutex. The argument there assumes the
 186     * following rule. This is an ugly hack.
 187     */
 188    assert(sizeof_ptr() >= sizeof(HANDLE));
 189    if (sizeof_ptr() < sizeof(HANDLE))
 190       return(NULL); /* Be absolutely sure that we HAVE a problem */
 191
 192    idx = AcquireThreadIndex();
 193
 194    /* fetch the value of the access variable */
 195    retval = TlsGetValue(idx);
 196
 197    if (retval != NULL) /* already initialized? */
 198       return(retval);
 199
 200    /* First call in this thread... */
 201    retval = malloc(sizeof(tsd_t)); /* no Malloc, etc! */
 202
 203    if (retval == NULL) /* THIS is really a problem. I don't know what we */
 204       return(NULL);    /* should do now. Let the caller run into a crash... */
 205
 206    TlsSetValue(idx,retval);
 207
 208    memset(retval,0,sizeof(tsd_t));
 209    retval->MTMalloc = MTMalloc;
 210    retval->MTFree = MTFree;
 211    retval->MTExit = MTExit;
 212
 213    /* Since the local data structure contains a Heap object for the memory
 214     * management we initialize it first.
 215     */
 216    if ((mt = malloc(sizeof(mt_tsd_t))) == NULL)
 217       return(NULL);                     /* This is a catastrophy             */
 218    retval->mt_tsd = mt;
 219    memset(mt,0,sizeof(mt_tsd_t));
 220    if ((mt->Heap = HeapCreate(HEAP_NO_SERIALIZE,0x10000,0)) == NULL)
 221       return(NULL);                     /* This is a catastrophy             */
 222
 223    OK = init_memory(retval);            /* Initialize the memory module FIRST*/
 224
 225    /* Without the initial memory we don't have ANY chance! */
 226    if (!OK)
 227       return(NULL);
 228
 229    {
 230       extern OS_Dep_funcs __regina_OS_Win;
 231       retval->OS = &__regina_OS_Win;
 232    }
 233    retval->OS->init();
 234    OK &= init_vars(retval);             /* Initialize the variable module    */
 235    OK &= init_stacks(retval);           /* Initialize the stack module       */
 236    OK &= init_filetable(retval);        /* Initialize the files module       */
 237    OK &= init_math(retval);             /* Initialize the math module        */
 238    OK &= init_spec_vars(retval);        /* Initialize the interprt module    */
 239    OK &= init_tracing(retval);          /* Initialize the tracing module     */
 240    OK &= init_builtin(retval);          /* Initialize the builtin module     */
 241    OK &= init_client(retval);           /* Initialize the client module      */
 242    OK &= init_library(retval);          /* Initialize the library module     */
 243    OK &= init_rexxsaa(retval);          /* Initialize the rexxsaa module     */
 244    OK &= init_shell(retval);            /* Initialize the shell module       */
 245    OK &= init_envir(retval);            /* Initialize the envir module       */
 246    OK &= init_expr(retval);             /* Initialize the expr module        */
 247    OK &= init_error(retval);            /* Initialize the error module       */
 248 #ifdef VMS
 249    OK &= init_vms(retval);              /* Initialize the vmscmd module      */
 250    OK &= init_vmf(retval);              /* Initialize the vmsfuncs module    */
 251 #endif
 252    OK &= init_arexxf(retval);           /* Initialize the arxfuncs modules */
 253    retval->loopcnt = 1;                 /* stupid r2perl-module              */
 254    retval->traceparse = -1;
 255    retval->thread_id = (unsigned long)GetCurrentThreadId();
 256
 257    if (!OK)
 258       exiterror( ERR_STORAGE_EXHAUSTED, 0 ) ;
 259
 260    return(retval);
 261 }
 262
 263 /* __regina_get_tsd returns a pointer to the thread specific data. Be sure to
 264  * calls this after a ReginaInitializeThread only.
 265  */
 266 tsd_t *__regina_get_tsd(void)
 267 {
 268    /* See above for comments */
 269    return(TlsGetValue(ThreadIndex));
 270 }
 271
 272 /* ReginaSetMutex is the opposite of ReginaUnsetMutex and sets a mutex
 273  * variable. The "true" mutex is "*arg" since we have hidden the type
 274  * HANDLE which is the correct type. Thus, we have used "HANDLE" and
 275  * "void *" in the same manner. If we include windows.h for the
 276  * definition of HANDLE we cant include windows later and may run
 277  * into trouble. The initialization code will check of errors of
 278  * this assumption.
 279  * The argument (*mutex) may be NULL. We initialize the mutex in this
 280  * case. This prevents the calling functions to initialize the mutex.
 281  * The is a little speed penalty but the mutexes are not used very
 282  * often. YOU should change it if it hurts you.
 283  */
 284 void ReginaSetMutex(void **mutex)
 285 {
 286    int OK = 1;
 287    volatile HANDLE *w32_mutex = (volatile HANDLE *) mutex;
 288
 289    if (*w32_mutex == (HANDLE) 0)
 290    {
 291       AcquireCriticalSection(&cs);
 292       if (*w32_mutex == (HANDLE)0) /* may have changed due MT */
 293       {
 294          *w32_mutex = CreateMutex(NULL,FALSE,NULL);
 295          if (*w32_mutex == NULL)
 296             OK = 0;
 297       }
 298       LeaveCriticalSection(&cs);
 299       if (!OK)
 300       { /* We must die now! There is no other chance. */
 301          *((int *) NULL) = 1;
 302       }
 303    }
 304
 305    WaitForSingleObject(*w32_mutex,INFINITE);
 306    /* ignore errors, we continue especially if WAIT_ABANDONED occurs */
 307 }
 308
 309 /* see ReginaSetMutex */
 310 void ReginaUnsetMutex(void **mutex)
 311 {
 312    volatile HANDLE *w32_mutex = (volatile HANDLE *) mutex;
 313
 314    ReleaseMutex(*w32_mutex);
 315 }