Changeset 387

Timestamp:

05/17/07 16:25:27 (17 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.

Location:

branches/thune/thread_safe

Files:

• config.t (modified) (1 diff)
• console.c (modified) (6 diffs)
• context.c (modified) (15 diffs)
• encoding.c (modified) (1 diff)
• eval.c (modified) (49 diffs)
• files.c (modified) (21 diffs)
• gc.c (modified) (37 diffs)
• internal.h (modified) (6 diffs)
• list.c (modified) (1 diff)
• list.h (modified) (1 diff)
• make.c (modified) (55 diffs)
• math.c (modified) (5 diffs)
• parse.c (modified) (32 diffs)
• print.c (modified) (23 diffs)
• series.c (modified) (53 diffs)
• stdio.c (modified) (4 diffs)
• tests/working/closure.good (modified) (1 diff)
• tests/working/closure.t (modified) (2 diffs)
• thread.c (modified) (6 diffs)
• thune.c (modified) (46 diffs)
• tokenize.c (modified) (10 diffs)
• unix/os.c (modified) (10 diffs)
• unix/os.h (modified) (2 diffs)
• urlan.c (modified) (27 diffs)
• urlan.h (modified) (24 diffs)
• win32/os.c (modified) (1 diff)

branches/thune/thread_safe/config.t

@@ -1 +1 @@
 ; Thune Configuration
 
-[x] bzip2    "Include bzip2 compress/decompress calls"
-[x] trig     "Include trigonometric math calls"
-[x] math3d   "Include vector & matrix math calls"
+[ ] bzip2    "Include bzip2 compress/decompress calls"
+[ ] trig     "Include trigonometric math calls"
+[ ] math3d   "Include vector & matrix math calls"
              enable trig
-[x] dt-code  "Include 'code datatype"
+[ ] dt-code  "Include 'code datatype"
 
-[x] net      "UDP socket port"
+[ ] net      "UDP socket port"
 
 [ ] uds      "Library with datatype & gc system only - no eval"

branches/thune/thread_safe/console.c

@@ -21 +21 @@
 #include <assert.h>
 #include <stdio.h>
-#include "urlan.h"
+#include "env.h"
 
 
@@ -40 +40 @@
 #else
 
-#define APPNAME     "Thune"
+#define APPNAME     "Bloc3"
 #define CUSTOM_DT           0
 #define CUSTOM_DT_COUNT     0
@@ -77 +77 @@
 
 
-static void reportError( UThread* th )
+static void reportError( UThread* ut )
 {
     UString* str;
 #if 0
     UCell* val;
-    val = ur_result( th, 0 );
+    val = ur_result( ut, 0 );
     str = ur_binPtr( val->err.strN );
 
@@ -89 +89 @@
             str->ptr.c );
 #else
-    str = ur_binPtr( th->callTempBinN );
+    str = ur_threadTmp( ut );
     str->used = 0;
-    ur_toStr( ur_result(th, 0), str, 0 );
+    ur_toStr( ur_result(ut, 0), str, 0 );
     ur_termCStr( str );
     printf( str->ptr.c );
 #endif
 
-    //ur_threadReset( th );
+    //ur_threadReset( ut );
 }
 
@@ -132 +132 @@
     }
 #endif
+
+    ur_freezeEnv( env.threads, 128, 256 );
 
     if( argc > 1 )
@@ -255 +257 @@
 
                         ur_arrayInit( &str, 1, 0 );
-                        ur_toStr( val, &str, 0 );
+                        ur_toStrT( env.threads, val, &str, 0 );
                         if( str.ptr.c )
                         {

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;
+}
 
 

branches/thune/thread_safe/encoding.c

@@ -76 +76 @@
     res = UR_TOS;
 
-    if( ur_isAWord(tos) && ur_stringSlice(res, &cpA, &cpB) )
+    if( ur_isAWord(tos) && ur_stringSlice(ut, res, &cpA, &cpB) )
     {
         count = cpB - cpA;

branches/thune/thread_safe/eval.c

@@ -19 +19 @@
 
 
-#include "os.h"
-#include "urlan.h"
+#include "internal.h"
 #include "urlan_atoms.h"
-#include "internal.h"
 #include "bignum.h"
 
 
+extern UContext ur_global;
+extern UContext ur_envGlobal;
+
 extern void uc_console_out( UThread*, UCell* );
 
 
 #ifdef DEBUG
-void ur_dumpBlock( UIndex blkN )
+void ur_dumpBlock( UThread* ut, UIndex blkN )
 {
     UCell* cell;
@@ -58 +59 @@
 
 
-static void _infuseOpcodes( UThread* thr, UIndex blkN )
+static void _infuseOpcodes( UThread* ut, UIndex blkN )
 {
     UBlock* blk;
-    UBlock* gblk;
+    UContext* global;
     const UCell* ctx;
     int wrdN;
 
-    blk = ur_bind( blkN, &ur_global );
-
-    wrdN = ur_lookup( &ur_global, UR_ATOM_KERNEL_OPS );
-    //assert( wrdN > -1 );
-    if( wrdN > -1 )
-    {
-        gblk = ur_blockPtr( GLOBAL_VAL_BLKN );
-        ctx = gblk->ptr.cells + wrdN;
-
-        assert( ctx->id.type == UT_CONTEXT );
-
-        ur_infuse( thr, blk, ctx );
+    global = (ut->env->blocks.arr.used) ? &ur_envGlobal : &ur_global;
+
+    wrdN = ur_lookup( global, UR_ATOM_KERNEL_OPS );
+    assert( wrdN > -1 );
+    //if( wrdN > -1 )
+    {
+        blk = ur_blockPtr( global->ctx.valBlk );
+        ctx = blk->ptr.cells + wrdN;
+
+        assert( ur_is(ctx, UT_CONTEXT) );
+
+        blk = ur_blockPtr( blkN );
+        ur_infuse( ut, blk, ctx );
     }
 }
@@ -86 +88 @@
    returned.
 */
-static int ur_itLen( UCell* cell )
+static int ur_itLen( UThread* ut, UCell* cell )
 {
     int len = ur_seriesLen( cell );
@@ -101 +103 @@
   Res may be the same as sel.
 */
-int ur_getSelector( UThread* ur_thread, const UCell* sel, UCell* res )
+int ur_getSelector( UThread* ut, const UCell* sel, UCell* res )
 {
 #define ATOM_OFF(val,atm)   (((unsigned int) val) - atm)
@@ -107 +109 @@
     UCell* val;
 
-    val = ur_wordCell( ur_thread, sel );
+    val = ur_wordCell( ut, sel );
     if( ! val )
         return 0;
@@ -157 +159 @@
                 if( ur_type(val) >= UT_BI_COUNT )
                 {
-                    UDatatypeSelFunc func = ur_thread->env->customDT
+                    UDatatypeSelFunc func = ut->env->customDT
                                 [ ur_type(val) - UT_BI_COUNT ].selectAtom;
                     if( func )
-                        return func( ur_thread, val, sel, res );
+                        return func( ut, val, sel, res );
                 }
                 goto set_none;
@@ -167 +169 @@
     else
     {
-        if( ur_pick( val, ur_sel(sel) - 1, res ) )
+        if( ur_pick( ut, val, ur_sel(sel) - 1, res ) )
             return 1;
     }
 
-    ur_throwErr( ur_thread, UR_EX_SCRIPT, "Invalid select!" );
+    ur_throwErr( UR_ERR_SCRIPT, "Invalid select!" );
     return 0;
 
@@ -184 +186 @@
   Returns non-zero if successful.
 */
-int ur_setSelector( UThread* ur_thread, const UCell* sel, const UCell* nval )
+int ur_setSelector( UThread* ut, const UCell* sel, const UCell* nval )
 {
     UBlock* blk;
     UCell* val;
 
-    val = ur_wordCell( ur_thread, sel );
+    val = ur_wordCell( ut, sel );
     if( ! val )
         return 0;
@@ -242 +244 @@
             if( ! ur_selIsAtom(sel) )
             {
-                if( ur_poke( val, ur_sel(sel) - 1, nval ) )
-                    return 1;
-            }
-            break;
-    }
-
-    ur_throwErr( ur_thread, UR_EX_SCRIPT, "Invalid select!" );
+                if( ur_poke( ut, val, ur_sel(sel) - 1, nval ) )
+                    return 1;
+            }
+            break;
+    }
+
+    ur_throwErr( UR_ERR_SCRIPT, "Invalid select!" );
     return 0;
 }
@@ -283 +285 @@
     {
         UCell* val;
-        val = ur_wordCell( ur_thread, tos );
+        val = ur_wordCell( ut, tos );
         if( val )
         {
@@ -317 +319 @@
 
 
-static void _appendTraceBlk( UCellError* err, int n, int it )
+static void _appendTraceBlk( UThread* ut, UCellError* err, int n, int it )
 {
     if( err->traceBlk )
@@ -334 +336 @@
 #define _throwUnbound(th,cell)  _throwUnsetF(th,cell,"unbound")
 
-static void _throwUnsetF( UThread* ur_thread, const UCell* wcell,
-                          const char* umsg )
+static void _throwUnsetF( UThread* ut, const UCell* wcell, const char* umsg )
 {
     UString* str;
-    str = ur_binPtr( ur_thread->callTempBinN );
+    str = ur_threadTmp( ut );
     str->used = 0;
     ur_atomStr( ur_atom(wcell), str );
     ur_termCStr( str );
-    ur_throwErr( ur_thread, UR_EX_SCRIPT,
-                 "word '%s is %s", str->ptr.c, umsg );
-}
-
-
-/*
+    ur_throwErr( UR_ERR_SCRIPT, "word '%s is %s", str->ptr.c, umsg );
+}
+
+
+/**
    Returns cell pointer or zero if word does not reference a valid cell.
 */
-UCell* ur_wordCell( UThread* ur_thread, const UCell* pc )
-{
-    UCell* val;
-    int i;
-   
-    i = pc->word.valBlk;
-    if( i < 0 )
-    {
-        // Find function local frame i.
-
-        LocalFrame* it;
-        LocalFrame* end;
-
-        it  = UR_LF_BEG;
-        end = UR_LF_END;
-        while( it != end )
-        {
-            if( it->localFrame.n == i )
-            {
-                val = it->localFrame.cell;
-              &nbs