regina/mt_amigalib.c

   1 /* This is the file to support single-threading.
   2  * We initialize the global data structure and the global access variable.
   3  */
   4
   5 #if !defined(__AROS__) && !defined(_AMIGA)
   6 # error mt_amiga.c only works on Amiga or AROS
   7 #endif
   8
   9 #include "rexx.h"
  10
  11 #include <proto/alib.h>
  12 #include <exec/memory.h>
  13
  14 #include <assert.h>
  15
  16 APTR __regina_semaphorepool;
  17
  18 typedef struct _mt_tsd_t {
  19   APTR mempool;
  20 } mt_tsd_t;
  21
  22
  23 /* Lowest level memory allocation function for normal circumstances. */
  24 static void *MTMalloc(const tsd_t *TSD,size_t size)
  25 {
  26    mt_tsd_t *mt = (mt_tsd_t *)TSD->mt_tsd;
  27    void *mem;
  28
  29    size += sizeof(size_t);
  30    mem = AllocPooled( mt->mempool, size);
  31    if ( mem == NULL )
  32       return NULL;
  33
  34   *((size_t*)mem)=size;
  35   return (void *)(((char *)mem)+sizeof(size_t));
  36 }
  37
  38 /* Lowest level memory deallocation function for normal circumstances. */
  39 static void MTFree(const tsd_t *TSD,void *chunk)
  40 {
  41    mt_tsd_t *mt = (mt_tsd_t *)TSD->mt_tsd;
  42    APTR mem = (APTR)(((char *)chunk)-sizeof(size_t));
  43
  44    FreePooled( mt->mempool, (APTR)mem, *(size_t *)mem );
  45 }
  46
  47 /* Lowest level exit handler. Use this indirection to prevent errors. */
  48 static void MTExit(int code)
  49 {
  50    exit(code);
  51 }
  52
  53 static void cleanup(int dummy, void *ptr)
  54 {
  55   tsd_node_t *node = (tsd_node_t *)ptr;
  56   mt_tsd_t *mt = (mt_tsd_t *)node->TSD->mt_tsd;
  57
  58   DeletePool( mt->mempool );
  59
  60   node->TSD = NULL; /* Node is cleared */
  61 }
  62
  63 tsd_t *ReginaInitializeThread(void)
  64 {
  65    int OK;
  66
  67    tsd_t *__regina_tsd = malloc(sizeof(tsd_t));
  68    mt_tsd_t *mt;
  69
  70    /* Default all values to zero        */
  71    memset(__regina_tsd,0,sizeof(tsd_t));
  72    __regina_tsd->MTMalloc = MTMalloc;
  73    __regina_tsd->MTFree = MTFree;
  74    __regina_tsd->MTExit = MTExit;
  75
  76    OK = ( __regina_tsd->mt_tsd = malloc(sizeof(mt_tsd_t))) != NULL;
  77    mt = (mt_tsd_t *)__regina_tsd->mt_tsd;
  78    OK |= ( mt->mempool = CreatePool(MEMF_PUBLIC, 8192, 1024) ) != NULL;
  79
  80    OK |= init_memory(__regina_tsd);     /* Initialize the memory module FIRST*/
  81
  82    /* Without the initial memory we don't have ANY chance! */
  83    if (!OK)
  84       return(NULL);
  85
  86    OK |= init_vars(__regina_tsd);      /* Initialize the variable module    */
  87    OK |= init_stacks(__regina_tsd);    /* Initialize the stack module       */
  88    OK |= init_filetable(__regina_tsd); /* Initialize the files module       */
  89    OK |= init_math(__regina_tsd);      /* Initialize the math module        */
  90    OK |= init_spec_vars(__regina_tsd); /* Initialize the interprt module    */
  91    OK |= init_tracing(__regina_tsd);   /* Initialize the tracing module     */
  92    OK |= init_builtin(__regina_tsd);   /* Initialize the builtin module     */
  93    OK |= init_client(__regina_tsd);    /* Initialize the client module      */
  94    OK |= init_library(__regina_tsd);   /* Initialize the library module     */
  95    OK |= init_rexxsaa(__regina_tsd);   /* Initialize the rexxsaa module     */
  96    OK |= init_shell(__regina_tsd);     /* Initialize the shell module       */
  97    OK |= init_envir(__regina_tsd);     /* Initialize the envir module       */
  98    OK |= init_expr(__regina_tsd);      /* Initialize the expr module        */
  99    OK |= init_error(__regina_tsd);     /* Initialize the error module       */
 100 #ifdef VMS
 101    OK |= init_vms(__regina_tsd);       /* Initialize the vmscmd module      */
 102    OK |= init_vmf(__regina_tsd);       /* Initialize the vmsfuncs module    */
 103 #endif
 104    OK |= init_arexxf(__regina_tsd);    /* Initialize the arexxfuncs module  */
 105    OK |= init_amigaf(__regina_tsd);    /* Initialize the amigafuncs module  */
 106    __regina_tsd->loopcnt = 1;            /* stupid r2perl-module              */
 107    __regina_tsd->traceparse = -1;
 108    __regina_tsd->thread_id = 1;
 109
 110    /* Initiliaze thread specific data */
 111    if (!OK)
 112       exiterror( ERR_STORAGE_EXHAUSTED, 0 ) ;
 113
 114    return(__regina_tsd);
 115 }
 116
 117 void AmigaLockSemaphore(struct SignalSemaphore **semaphoreptr)
 118 {
 119   if (*semaphoreptr == NULL)
 120   {
 121     Forbid();
 122
 123     if (*semaphoreptr == NULL)
 124     {
 125       *semaphoreptr = AllocPooled (__regina_semaphorepool, sizeof(struct SignalSemaphore));
 126       InitSemaphore(*semaphoreptr);
 127     }
 128
 129     Permit();
 130   }
 131
 132   ObtainSemaphore(*semaphoreptr);
 133 }
 134
 135 void AmigaUnlockSemaphore(struct SignalSemaphore *semaphore)
 136 {
 137   assert(semaphore!=NULL);
 138   ReleaseSemaphore(semaphore);
 139 }
 140
 141
 142 tsd_t *__regina_get_tsd(void)
 143 {
 144   struct Task *thistask = FindTask(NULL);
 145   tsd_node_t *node;
 146
 147   node = (tsd_node_t *)GetHead(__regina_tsdlist);
 148   while (node!=NULL && node->task!=thistask)
 149     node = (tsd_node_t *)GetSucc(node);
 150
 151   if (node==NULL)
 152   {
 153     /* taskdata not found */
 154     node = (tsd_node_t *)AllocPooled(__regina_semaphorepool, sizeof(tsd_node_t));
 155     node->task = thistask;
 156     node->TSD = ReginaInitializeThread();
 157     AddTail((struct List *)__regina_tsdlist, (struct Node *)node);
 158     on_exit(cleanup, node);
 159   }
 160   else if (node->TSD==NULL) /* Was MTExit called on this task ? */
 161   {
 162     node->TSD = ReginaInitializeThread();
 163     on_exit(cleanup, node);
 164   }
 165
 166   return node->TSD;
 167 }