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

Timestamp:

07/07/07 04:41:31 (17 months ago)

Author:

krobillard

Message:

Setting words in the shared global store now throws an error.
Default binding changed so top-level set-words are added to thread context.

Files:

• branches/thune/thread_safe/context.c (modified) (1 diff)

branches/thune/thread_safe/context.c

@@ -526 +526 @@
 
 
+extern UContext ur_envGlobal;
+
+/*
+   wc->flags, wc->word wordBlk, valBlk, & index are set.
+   ctop must be greater than cbot.
+*/
+void ur_internDefault( UThread* ut, UCell* wc, UAtom atom,
+                       UCell* cbot, UCell* ctop )
+{
+    UCell* cit;
+    int wrdN;
+
+    // Look for atom in module context stack.
+    cit = ctop;
+    do
+    {
+        --cit;
+        wrdN = ur_lookup( cit, atom );
+        if( wrdN > -1 )
+            goto assign;
+    }
+    while( cit != cbot );
+
+
+    // Now try the shared global context.
+    if( ut->env->blocks.arr.used )
+    {
+        wrdN = ur_lookup( &ur_envGlobal, atom );
+        if( wrdN > -1 )
+        {
+            ur_setBindType( wc, UR_BIND_GLOBAL );
+            wc->word.wordBlk = ur_envGlobal.ctx.wordBlk;
+            wc->word.valBlk  = ur_envGlobal.ctx.valBlk;
+            wc->word.index   = wrdN;
+            return;
+        }
+    }
+
+    // Word not found, so intern into current module (top of context stack).
+    cit = ctop - 1;
+    wrdN = ur_internWord( cit, atom );
+
+assign:
+
+    ur_setBindType( wc, UR_BIND_THREAD );
+    wc->word.wordBlk = cit->ctx.wordBlk;
+    wc->word.valBlk  = cit->ctx.valBlk;
+    wc->word.index   = wrdN;
+}
+
+
+static
+UBlock* _bindDefault( UThread* ut, UIndex blkN, UCell* cbot, UCell* ctop )
+{
+    UBlock* blk;
+    UCell* it;
+    UCell* end;
+
+    if( ur_isGlobal(blkN) )
+        return 0;       // Cannot bind global blocks.
+
+    blk = ur_blockPtr( blkN );
+    it  = blk->ptr.cells;
+    end = it + blk->used;
+
+    while( it != end )
+    {
+        switch( ur_type(it) )
+        {
+            case UT_WORD:
+            case UT_SETWORD:
+            case UT_GETWORD:
+            case UT_LITWORD:
+            case UT_SELECT:
+            case UT_SETSELECT:
+            case UT_LITSELECT:
+            case UT_OPCODE:
+                ur_internDefault( ut, it, ur_atom(it), cbot, ctop );
+                break;
+
+            case UT_PATH:
+            case UT_SETPATH:
+            {
+                UCell* path1 = ur_blockPtr( it->series.n )->ptr.cells;
+                if( ur_isAWord(path1) )
+                {
+                    ur_internDefault( ut, path1, ur_atom(path1), cbot, ctop );
+                }
+            }
+                break;
+
+            case UT_BLOCK:
+            case UT_PAREN:
+                _bindDefault( ut, it->series.n, cbot, ctop );
+                break;
+
+            case UT_FUNCTION:
+                _bindDefault( ut, it->func.bodyN, cbot, ctop );
+                break;
+        }
+
+        ++it;
+    }
+
+    return blk;
+}
+
+
+void ur_bindDefault( UThread* ut, UIndex blkN )
+{
+    UBlock* blk;
+    UBlock* cblk;
+    UCell* ctx;
+    UCell* it;
+    UCell* end;
+
+    cblk = tBlockPtr( BLK_CTX_STACK );
+    ctx = cblk->ptr.cells + (cblk->used - 1);
+
+    // Intern all set-words found in block to the top context.
+    blk = ur_blockPtr( blkN );
+    it  = blk->ptr.cells;
+    end = it + blk->used;
+    while( it != end )
+    {
+        if( ur_is(it, UT_SETWORD) )
+            ur_internWord( ctx, it->word.atom );
+        ++it;
+    }
+
+    _bindDefault( ut, blkN, cblk->ptr.cells,
+                            cblk->ptr.cells + cblk->used );
+}
+
+
+#if 0
+/**
+   Intern all set-words found in block to the top context.
+*/
+void ur_internSetWords( UThread* ut, UIndex blkN )
+{
+    UBlock* blk;
+    UBlock* cblk;
+    UCell* ctx;
+    UCell* it;
+    UCell* end;
+
+    cblk = tBlockPtr( BLK_CTX_STACK );
+    ctx = cblk->ptr.cells + (cblk->used - 1);
+
+    blk = ur_blockPtr( blkN );
+    it  = blk->ptr.cells;
+    end = it + blk->used;
+    while( it != end )
+    {
+        if( ur_is(it, UT_SETWORD) )
+            ur_internWord( ctx, it->word.atom );
+        ++it;
+    }
+}
+#endif
+
+
 /*EOF*/