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