Changeset 387 for branches/thune/thread_safe/context.c

Timestamp:

05/17/07 16:25:27 (18 months ago)

Author:

krobillard

Message:

Thread safe Thune -

The only globals are now the static ur_global & ur_envGlobal.
Each thread has own data store.
Series data now accessed through functions which take thread pointer.
Word names now part of UrlanEnv? - no longer a binary!
Hold/release now implemented with a block.

Files:

• branches/thune/thread_safe/context.c (modified) (15 diffs)

branches/thune/thread_safe/context.c

@@ -1 +1 @@
 /*============================================================================
     Thune Interpreter
-    Copyright (C) 2005-2006  Karl Robillard
+    Copyright (C) 2005-2007  Karl Robillard
 
     This library is free software; you can redistribute it and/or
@@ -19 +19 @@
 
 
-#include "os.h"
-#include "urlan.h"
 #include "internal.h"
 
@@ -32 +30 @@
   Appends atom name to string.
 */
-void ur_atomStr( UAtom atom, UString* str )
-{
-    UBinary* names;
-    AtomRec* rec;
-
-    rec = ((AtomRec*) ur_env->atoms.ptr.v) + atom;
-    names = ur_binPtr( BIN_ATOM_NAMES );
+void ur_atomStrT( UThread* ut, UAtom atom, UString* str )
+{
+    AtomRec* rec = ((AtomRec*) ut->env->atoms.ptr.v) + atom;
 
     ur_arrayReserve( str, sizeof(char), str->used + rec->nameLen );
     memCpy( str->ptr.c + str->used,
-            names->ptr.c + rec->nameIndex,
+            ut->env->atomNames.ptr.c + rec->nameIndex,
             rec->nameLen );
     str->used += rec->nameLen;
@@ -54 +48 @@
 
 
-const char* ur_atomCStr( UAtom atom, int* plen )
-{
-    UBinary* names;
-    AtomRec* rec;
-
-    rec = ((AtomRec*) ur_env->atoms.ptr.v) + atom;
-    names = ur_binPtr( BIN_ATOM_NAMES );
+const char* ur_atomCStrT( UThread* ut, UAtom atom, int* plen )
+{
+    AtomRec* rec = ((AtomRec*) ut->env->atoms.ptr.v) + atom;
     if( plen )
         *plen = rec->nameLen;
-    return names->ptr.c + rec->nameIndex;
+    return ut->env->atomNames.ptr.c + rec->nameIndex;
 }
 
@@ -128 +118 @@
 
 #ifdef DEBUG
-void dumpAtoms()
-{
-    UString* names;
-    AtomRec* table = (AtomRec*) ur_env->atoms.ptr.v;
+void dumpAtoms( UThread* ut )
+{
+    LOCK_GLOBAL
+    {
+    const char* names = ut->env->atomNames.ptr.c;
+    AtomRec* table = (AtomRec*) ut->env->atoms.ptr.v;
     AtomRec* it  = table;
-    AtomRec* end = table + ur_env->atoms.used;
-
-    names = ur_binPtr( BIN_ATOM_NAMES );
+    AtomRec* end = table + ut->env->atoms.used;
 
     while( it != end )
@@ -141 +131 @@
         dprint( "%4ld %08x %5d %5d %s\n", it - table, it->hash,
                 it->head, it->chain,
-                names->ptr.c + it->nameIndex );
+                names + it->nameIndex );
         ++it;
     }
 
-    end = table + ur_env->atoms.avail;
+    end = table + ut->env->atoms.avail;
     while( it != end )
     {
@@ -152 +142 @@
         ++it;
     }
+    }
+    UNLOCK_GLOBAL
 }
 #endif
@@ -159 +151 @@
   Add atom to environment.
 
+  If the environment has multiple threads, the caller must have called
+  LOCK_GLOBAL.
+
   \param str  Name of atom.
   \param len  Number of characters.
@@ -164 +159 @@
   \returns Atom 
 */
-UAtom ur_intern( UrlanEnv* env, const char* str, int len )
+UAtom ur_internT( UThread* ut, const char* str, int len )
 {
     char* cp;
@@ -182 +177 @@
     // Check if atom already exists.
 
-    atoms = &env->atoms;
+    atoms = &ut->env->atoms;
     table = (AtomRec*) atoms->ptr.v;
-    names = ur_binPtr( BIN_ATOM_NAMES );
+    names = &ut->env->atomNames;
 
     hash = ur_hash( str, str + len );
@@ -233 +228 @@
     // Nope, add new atom.
 
+    /* TODO: Make atoms & atomNames thread safe through one of the following:
+
+       1. Halt all other threads.
+       2. Fix size of atom arrays and throw error/assert when full.
+       3. Use LOCK_GLOBAL in or around these functions in addition to ur_intern:
+            ur_atomStrT()
+            ur_atomCStrT()
+            dumpAtoms()
+    */
+
     if( atoms->used == atoms->avail )
     {
@@ -275 +280 @@
   \returns  Index of word in context.
 */
-int ur_internWord( const UContext* ctx, UAtom atom )
+int ur_internWordT( UThread* ut, const UContext* ctx, UAtom atom )
 {
     int wrdN;
@@ -421 +426 @@
   \returns  Word index or -1 if not found.
 */
-int ur_lookup( const UContext* ctx, UAtom atom )
+int ur_lookupT( UThread* ut, const UContext* ctx, UAtom atom )
 {
     UBlock* wblk;
@@ -454 +459 @@
 // Atom remains the same.
 
-#define _bindWord(val) \
-    wrdN = ur_lookup( ctx, val->word.atom ); \
+#define _bindWord(cell) \
+    wrdN = ur_lookup( ctx, cell->word.atom ); \
     if( wrdN > -1 ) { \
-        val->word.wordBlk = ctx->ctx.wordBlk; \
-        val->word.valBlk  = ctx->ctx.valBlk; \
-        val->word.index   = wrdN; }
-
-
-UBlock* ur_bind( UIndex blkN, UContext* ctx )
+        if( ur_bindType(cell) != btype ) \
+            ur_setBindType(cell,btype); \
+        cell->word.wordBlk = ctx->ctx.wordBlk; \
+        cell->word.valBlk  = ctx->ctx.valBlk; \
+        cell->word.index   = wrdN; }
+
+
+UBlock* ur_bindT( UThread* ut, UIndex blkN, const UContext* ctx, int btype )
 {
     int wrdN;
@@ -469 +476 @@
     UCell* end = it + blk->used;
 
+    if( ur_isGlobal(blkN) )
+        return 0;       // Cannot bind global blocks.
+
     while( it != end )
     {
-        if( ur_isAWord(it) ||
-            ur_is(it, UT_OPCODE) ||
-            ur_is(it, UT_SELECT) ||
-            ur_is(it, UT_SETSELECT) )
-        {
-            _bindWord( it );
-        }
-        else if( ur_is(it, UT_PATH) || ur_is(it, UT_SETPATH) )
-        {
-            UCell* path1 = ur_blockPtr( it->series.n )->ptr.cells;
-            if( ur_isAWord(path1) )
-            {
-                _bindWord( path1 );
-            }
-        }
-        else if( ur_is(it, UT_BLOCK) || ur_is(it, UT_PAREN) )
-        {
-            ur_bind( it->series.n, ctx );
-        }
-        else if( ur_is(it, UT_FUNCTION) )
-        {
-            ur_bind( it->func.bodyN, ctx );
-
-            // NOTE: Will probably need to rebind to local func context in
-            // case ctx contains the same words. 
-            //orBind( orBlockPtr( it->func.bodyBlk ), it->func.context );
-        }
-
-        ++it;
-    }
-
-    return blk;
-}
-
-
-#ifndef UR_CONFIG_UDS
-/**
-  ur_resolveArgPath is provided as a fast but still convenient method of
-  resolving paths from C code.
-
-  Pass a number of datatype/value argument pairs terminated by UT_NONE to
-  specify the path. A pair can be either UT_WORD,atom or UT_INT,int.
-
-  Returns zero if the path is not valid.
-
-  Using a string argument rather than a tag list would be more convenient
-  but not as quick.
-*/
-UCell* ur_resolveArgPath( int first_tag, ... )
-{
-    va_list args;
-    int tag;
-    int data;
-    UIndex wrd;
-    UBlock* blk;
-    UCell* val;
-
-    val = &ur_global;
-
-    va_start(args, first_tag);
-    tag = first_tag;
-
-    while( tag != UT_NONE )
-    {
-        data = va_arg(args, int);
-        switch( tag )
+        switch( ur_type(it) )
         {
             case UT_WORD:
-                if( ur_is(val, UT_CONTEXT) )
+            case UT_SETWORD:
+            case UT_GETWORD:
+            case UT_LITWORD:
+            case UT_SELECT:
+            case UT_SETSELECT:
+            case UT_OPCODE:
+                _bindWord( it );
+                break;
+
+            case UT_PATH:
+            case UT_SETPATH:
+            {
+                UCell* path1 = ur_blockPtr( it->series.n )->ptr.cells;
+                if( ur_isAWord(path1) )
                 {
-                    wrd = ur_lookup( val, data );
-                    if( wrd < 0 )
-                        goto abort;
-
-                    blk = ur_blockPtr( val->ctx.valBlk );
-                    val = blk->ptr.cells + wrd;
-                    break;
+                    _bindWord( path1 );
                 }
-                goto abort;
-
-            case UT_INT:
-                if( ur_is(val, UT_BLOCK) )
-                {
-                    blk = ur_block(val);
-                    val = blk->ptr.cells + data;
-                    break;
-                }
-                // TODO: binary, string, etc
-                goto abort;
-
-            default:
-                goto abort;
+            }
+                break;
+
+            case UT_BLOCK:
+            case UT_PAREN:
+                ur_bindT( ut, it->series.n, ctx, btype );
+                break;
+
+            case UT_FUNCTION:
+                ur_bindT( ut, it->func.bodyN, ctx, btype );
+
+                // NOTE: Will probably need to rebind to local func context in
+                // case ctx contains the same words. 
+                //orBind( orBlockPtr( it->func.bodyBlk ), it->func.context );
+                break;
         }
-        tag = va_arg(args, int);
-    }
-
-done:
-
-    va_end(args);
-    return val;
-
-abort:
-
-    val = 0;
-    goto done;
-}
-#endif
+
+        ++it;
+    }
+
+    return blk;
+}