Changeset 458

Show
Ignore:
Timestamp:
08/28/07 04:12:53 (1 year ago)
Author:
krobillard
Message:

Merged Thune thread_safe branch into trunk (r386:457)

Files:

Legend:

Unmodified
Added
Removed
Modified
Copied
Moved

  • trunk/thune/boot.c

    r378 r458  
    3030  "  opcode! 25 'inc     make :inc\n" 
    3131  "  opcode! 26 'dec     make :dec\n" 
    32   "  opcode! 27 'verify  make :verify\n" 
    33   "  opcode! 28 'forever make :forever\n" 
     32  "  opcode! 27 '++      make :++\n" 
     33  "  opcode! 28 '--      make :--\n" 
     34  "  opcode! 29 'verify  make :verify\n" 
     35  "  opcode! 30 'forever make :forever\n" 
    3436  "  int!/decimal! :number!\n" 
    3537  "  word!/set-word!/get-word!/lit-word! :any-word!\n" 
    …… 
    9294  "]\n" 
    9395  "'loop func :each.set       ; (ser words body -- )\n" 
    94   "[ser comb]\n" 
    95   "[\n" 
     96  "[ser accu op] [\n" 
     97  "  ser [first accu op do :accu] iter\n" 
     98  "  accu\n" 
     99  "] 'loop func :fold      ;(ser accu op -- accu)\n" 
     100  "[ser comb] [\n" 
    96101  "  ser [dup first comb do 1 poke drop] iter\n" 
    97   "] 'loop func :map     ;(ser comb -- )\n" 
     102  "] 'loop func :map       ;(ser comb -- )\n" 
     103  "[ser old new | len] [\n" 
     104  "    old length? :len\n" 
     105  "    ser old find if/keep (new len change :ser recurse)\n" 
     106  "    ser\n" 
     107  "] func :replace.all     ;(ser old new -- ser)\n" 
    98108  "[reduce to-text console.out] proc :prin  ;(val -- )\n" 
    99109  "[reduce [first to-text console.out] iter] proc :prin.pack  ;(val -- )\n" 
    …… 
    117127  "  none :os\n" 
    118128  "  [] :devices\n" 
    119   "  [\n" 
    120   "    [\n" 
    121   "      [word word!/lit-word! def] [\n" 
    122   "        def: word: reader-macros last set\n" 
    123   "      ] func :macro\n" 
    124   "      [word word!/lit-word! sig block! body block!] [\n" 
    125   "        sig  kernel-ops infuse\n" 
    126   "        body kernel-ops infuse\n" 
    127   "        func word: reader-macros last set\n" 
    128   "      ] func :macrof\n" 
    129   "      [n] [[n: 'add word! as] reduce] func :+\n" 
    130   "      [n] [[n: 'sub word! as] reduce] func :-\n" 
    131   "      [n] [[n: 'mul word! as] reduce] func :*\n" 
    132   "      [n] [[n: 'div word! as] reduce] func :/\n" 
    133   "    ] context\n" 
    134   "  ] reduce :reader-macros\n" 
    135129  "]\n" 
    136130  "context :script-env\n" 
    …… 
    141135  "  reduce\n" 
    142136  "  dup first\n" 
    143   "    dup series! is-type? [copy] [string! to] either :val\n" 
     137  "    dup series! is-type? [copy] [to-text] either :val\n" 
    144138  "  next [\n" 
    145139  "    first val swap append drop\n" 
    …… 
    163157  "      ; fullpath file\n" 
    164158  "      next\n" 
    165   "      dup2 slice! rot.r make\n" 
     159  "      dup2 slice\n" 
    166160  "      rot.r nip\n" 
    167161  "    ]\n" 

  • trunk/thune/charset.c

    r186 r458  
    2424 
    2525 
    26 /* Strict Word: a-z A-Z ?!.*&|=_~ and all ascii >= 127  */ 
     26/* Start of Word: a-z A-Z ?!.*&|=_~ and all ascii >= 127  */ 
    2727uint8_t charset_sword[32] = { 
     28#ifdef UR_CONFIG_MACROS 
     29        0x00,0x00,0x00,0x00,0x42,0x44,0x00,0xA0,    // Don't allow < > 
     30#else 
    2831        0x00,0x00,0x00,0x00,0x42,0x44,0x00,0xF0, 
     32#endif 
    2933        0xFE,0xFF,0xFF,0x97,0xFF,0xFF,0xFF,0x57, 
    3034        0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF, 
    …… 
    3337 
    3438 
    35 /* Word: 0-9 a-z A-Z ?!.'+-*&|=_~ and all ascii >= 127 */ 
     39/* Word: 0-9 a-z A-Z ?!.+-*&|=_~ and all ascii >= 127 */ 
    3640uint8_t charset_word[32] = { 
    37         0x00,0x00,0x00,0x00,0xC2,0x6C,0xFF,0xF3, 
     41#ifdef UR_CONFIG_MACROS 
     42        0x00,0x00,0x00,0x00,0x42,0x6C,0xFF,0xA3,    // Don't allow < > 
     43#else 
     44        0x00,0x00,0x00,0x00,0x42,0x6C,0xFF,0xF3, 
     45#endif 
    3846        0xFE,0xFF,0xFF,0x97,0xFF,0xFF,0xFF,0x57, 
    3947        0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF, 

  • trunk/thune/config.t

    r350 r458  
    55[x] math3d   "Include vector & matrix math calls" 
    66             enable trig 
    7 [x] dt-code  "Include 'code datatype" 
     7[x] macros   "Reader macros" 
     8[x] net      "UDP socket port" 
     9[x] dataflow "Component! datatype for dataflow programming" 
    810 
    9 [x] net      "UDP socket port" 
     11[ ] threads  "CPU Threads" 
     12[ ] emh      "Debugger Hooks" 
     13[ ] dt-code  "Include 'code datatype" 
    1014 
    11 [ ] uds      "Library with datatype & gc system only - no eval" 
    12              disable [bzip2 trig math3d dt-code] 
    13  
    14 [ ] threads  "Experimental script threads" 
    15 [ ] macros   "Experimantal reader macros" 
    16 [ ] emh      "Debugger Hooks" 
     15;[ ] uds      "Library with datatype & gc system only - no eval" 
     16;             disable [bzip2 trig math3d dt-code] 
    1717 
    1818;eof 

  • trunk/thune/console.c

    r369 r458  
    2121#include <assert.h> 
    2222#include <stdio.h> 
    23 #include "urlan.h" 
     23#include "env.h" 
    2424 
    2525 
    …… 
    4040#else 
    4141 
    42 #define APPNAME     "Thune" 
     42#define APPNAME     "Bloc3" 
    4343#define CUSTOM_DT           0 
    4444#define CUSTOM_DT_COUNT     0 
    …… 
    7777 
    7878 
    79 static void reportError( UThread* th ) 
     79static void reportError( UThread* ut ) 
    8080{ 
    8181    UString* str; 
    8282#if 0 
    8383    UCell* val; 
    84     val = ur_result( th, 0 ); 
     84    val = ur_result( ut, 0 ); 
    8585    str = ur_binPtr( val->err.strN ); 
    8686 
    …… 
    8989            str->ptr.c ); 
    9090#else 
    91     str = ur_binPtr( th->callTempBinN ); 
     91    str = ur_threadTmp( ut ); 
    9292    str->used = 0; 
    93     ur_toStr( ur_result(th, 0), str, 0 ); 
     93    ur_toStr( ur_result(ut, 0), str, 0 ); 
    9494    ur_termCStr( str ); 
    9595    printf( str->ptr.c ); 
    9696#endif 
    9797 
    98     //ur_threadReset( th ); 
     98    //ur_threadReset( ut ); 
    9999} 
    100100 
    …… 
    132132    } 
    133133#endif 
     134 
     135    ur_freezeEnv( env.threads, 128, 256 ); 
    134136 
    135137    if( argc > 1 ) 
    …… 
    255257 
    256258                        ur_arrayInit( &str, 1, 0 ); 
    257                         ur_toStr( val, &str, 0 ); 
     259                        ur_toStrT( env.threads, val, &str, 0 ); 
    258260                        if( str.ptr.c ) 
    259261                        { 

  • trunk/thune/context.c

    r323 r458  
    11/*============================================================================ 
    22    Thune Interpreter 
    3     Copyright (C) 2005-2006  Karl Robillard 
     3    Copyright (C) 2005-2007  Karl Robillard 
    44 
    55    This library is free software; you can redistribute it and/or 
    …… 
    1919 
    2020 
    21 #include "os.h" 
    22 #include "urlan.h" 
    2321#include "internal.h" 
    2422 
    …… 
    2725 
    2826#define LOWERCASE(c)    if(c >= 'A' && c <= 'Z') c -= 'A' - 'a' 
     27 
     28 
     29/* 
     30   UrlanEnv::atoms & UrlanEnv::atomNames can be made thread safe through one 
     31   of the following: 
     32 
     33   1. Use LOCK_ATOMS in or around these functions: 
     34        ur_internT() 
     35        ur_atomStrT() 
     36        ur_atomCStrT() (and all use of returned pointer) 
     37        ur_atomHash() 
     38        dumpAtoms() 
     39 
     40   2. Fix size of atom arrays and throw error/assert when full. 
     41      Must still lock these functions to access head/chain AtomRec members: 
     42        ur_internT() 
     43        dumpAtoms() 
     44 
     45   Option #2 is currently being used. 
     46*/ 
    2947 
    3048 
    …… 
    3250  Appends atom name to string. 
    3351*/ 
    34 void ur_atomStr( UAtom atom, UString* str ) 
    35 { 
    36     UBinary* names; 
    37     AtomRec* rec; 
    38  
    39     rec = ((AtomRec*) ur_env->atoms.ptr.v) + atom; 
    40     names = ur_binPtr( BIN_ATOM_NAMES ); 
     52void ur_atomStrT( UThread* ut, UAtom atom, UString* str ) 
     53{ 
     54    AtomRec* rec = ((AtomRec*) ut->env->atoms.ptr.v) + atom; 
    4155 
    4256    ur_arrayReserve( str, sizeof(char), str->used + rec->nameLen ); 
    4357    memCpy( str->ptr.c + str->used, 
    44             names->ptr.c + rec->nameIndex, 
     58            ut->env->atomNames.ptr.c + rec->nameIndex, 
    4559            rec->nameLen ); 
    4660    str->used += rec->nameLen; 
    …… 
    5468 
    5569 
    56 const char* ur_atomCStr( UAtom atom, int* plen ) 
    57 { 
    58     UBinary* names; 
    59     AtomRec* rec; 
    60  
    61     rec = ((AtomRec*) ur_env->atoms.ptr.v) + atom; 
    62     names = ur_binPtr( BIN_ATOM_NAMES ); 
     70const char* ur_atomCStrT( UThread* ut, UAtom atom, int* plen ) 
     71{ 
     72    AtomRec* rec = ((AtomRec*) ut->env->atoms.ptr.v) + atom; 
    6373    if( plen ) 
    6474        *plen = rec->nameLen; 
    65     return names->ptr.c + rec->nameIndex; 
     75    return ut->env->atomNames.ptr.c + rec->nameIndex; 
    6676} 
    6777 
    …… 
    128138 
    129139#ifdef DEBUG 
    130 void dumpAtoms() 
    131 { 
    132     UString* names; 
    133     AtomRec* table = (AtomRec*) ur_env->atoms.ptr.v; 
     140void dumpAtoms( UThread* ut ) 
     141{ 
     142    LOCK_ATOMS 
     143    { 
     144    const char* names = ut->env->atomNames.ptr.c; 
     145    AtomRec* table = (AtomRec*) ut->env->atoms.ptr.v; 
    134146    AtomRec* it  = table; 
    135     AtomRec* end = table + ur_env->atoms.used; 
    136  
    137     names = ur_binPtr( BIN_ATOM_NAMES ); 
     147    AtomRec* end = table + ut->env->atoms.used; 
    138148 
    139149    while( it != end ) 
    …… 
    141151        dprint( "%4ld %08x %5d %5d %s\n", it - table, it->hash, 
    142152                it->head, it->chain, 
    143                 names->ptr.c + it->nameIndex ); 
    144         ++it; 
    145     } 
    146  
    147     end = table + ur_env->atoms.avail; 
     153                names + it->nameIndex ); 
     154        ++it; 
     155    } 
     156 
     157    end = table + ut->env->atoms.avail; 
    148158    while( it != end ) 
    149159    { 
    …… 
    152162        ++it; 
    153163    } 
     164    } 
     165    UNLOCK_ATOMS 
    154166} 
    155167#endif 
    …… 
    162174  \param len  Number of characters. 
    163175 
    164   \returns Atom  
    165 */ 
    166 UAtom ur_intern( UrlanEnv* env, const char* str, int len ) 
     176  \return Atom  
     177*/ 
     178UAtom ur_internT( UThread* ut, const char* str, int len ) 
    167179{ 
    168180    char* cp; 
    …… 
    176188    AtomRec* node; 
    177189 
    178  
    179190    assert( len > 0 ); 
    180191 
    …… 
    182193    // Check if atom already exists. 
    183194 
    184     atoms = &env->atoms; 
     195    hash = ur_hash( str, str + len ); 
     196 
     197    LOCK_ATOMS 
     198 
     199    atoms = &ut->env->atoms; 
    185200    table = (AtomRec*) atoms->ptr.v; 
    186     names = ur_binPtr( BIN_ATOM_NAMES ); 
    187  
    188     hash = ur_hash( str, str + len ); 
     201    names = &ut->env->atomNames; 
    189202 
    190203    node = table + (hash % atoms->avail); 
    …… 
    235248    if( atoms->used == atoms->avail ) 
    236249    { 
     250#if 1 
     251        // Atom table size is fixed so read only access does not need to be 
     252        // locked.  When the table is full, we are finished. 
     253        assert( 0 && "Atom table is full" ); 
     254        return 0;       // TODO: Report fatal error 
     255#else 
    237256        ur_arrayReserve( atoms, sizeof(AtomRec), atoms->used + 1 ); 
    238257        ur_rebuildAtomHash( atoms ); 
    …… 
    240259 
    241260        HASH_INSERT( atoms, table, node, hash, atoms->used ) 
     261#endif 
    242262    } 
    243263    node = table + atoms->used; 
    …… 
    248268    node->nameLen   = len; 
    249269 
     270#if 1 
     271    if( (names->used + len + 1) > names->avail ) 
     272    { 
     273        assert( 0 && "Atom name buffer is full" ); 
     274        return 0;       // TODO: Report fatal error 
     275    } 
     276#else 
    250277    ur_arrayReserve( names, sizeof(char), names->used + len + 1 ); 
     278#endif 
     279 
    251280    cp = names->ptr.c + names->used; 
    252281    ep = cp + len; 
    …… 
    262291done: 
    263292 
    264     return node - table; 
     293    c = node - table; 
     294 
     295    UNLOCK_ATOMS 
     296 
     297    return c; 
    265298} 
    266299 
    …… 
    270303 
    271304/** 
    272   Add word to context if it does not already exist. 
    273   If added, the word is initialied as unset. 
    274  
    275   \returns  Index of word in context. 
    276 */ 
    277 int ur_internWord( const UContext* ctx, UAtom atom ) 
    278 { 
    279     int wrdN; 
    280     UBlock* vblk; 
     305  Find word in context by atom. 
     306  \return  Word index or -1 if not found. 
     307*/ 
     308static int _lookupNoSort( UThread* ut, const UContext* ctx, UAtom atom ) 
     309{ 
    281310    UBlock* wblk; 
    282311    UCell* it; 
    283312    UCell* end; 
    284313 
    285  
    286     // Lookup word. 
    287  
    288314    wblk = ur_blockPtr( ctx->ctx.wordBlk ); 
    289315    it = wblk->ptr.cells; 
    290316 
    291317    if( (wblk->used < SEARCH_LEN) || (it->word.sel == UR_CTX_UNORDERED) ) 
    292     { 
    293         end = it + wblk->used; 
    294         while( it != end ) 
    295         { 
    296             if( it->word.atom == atom ) 
    297                 return it - wblk->ptr.cells; 
    298             ++it; 
    299         } 
    300     } 
    301     else 
    302     { 
    303         wrdN = _binarySearch( it, wblk->used, atom ); 
    304         if( wrdN > -1 ) 
    305             return wrdN; 
    306     } 
    307  
    308  
    309     // Not found - add new word. 
    310  
    311     wrdN = wblk->used; 
    312     UR_EXPAND_1( UCell, wblk, it ); 
    313  
    314     ur_initType( it, UT_WORD ); 
    315     it->word.atom    = atom; 
    316     it->word.wordBlk = 0; 
    317     it->word.valBlk  = ctx->ctx.valBlk; 
    318     it->word.index   = 0; 
    319     it->word.sel     = 0; 
    320  
    321     wblk->ptr.cells->word.sel = UR_CTX_UNORDERED; 
    322  
    323     vblk = ur_blockPtr( ctx->ctx.valBlk ); 
    324     if( vblk->used < wblk->used ) 
    325     { 
    326         ur_arrayReserve( vblk, sizeof(UCell), wblk->used ); 
    327         vblk->used = wblk->used; 
    328  
    329         it = vblk->ptr.cells + wrdN; 
    330         ur_initType( it, UT_UNSET ); 
    331     } 
    332  
    333     return wrdN; 
    334 } 
    335  
    336  
    337 #define QS_VAL(a)   cells[a].word.sel 
    338  
    339 // Using series.end to swap word.index & word.sel together. 
    340 #define QS_SWAP(a,b) \ 
    341     stmp = cells[a].series.end; \ 
    342     cells[a].series.end = cells[b].series.end; \ 
    343     cells[b].series.end = stmp 
    344  
    345 static void _quickSort( UCell* cells, int low, int high ) 
    346 { 
    347     int i, j; 
    348     UAtom val; 
    349     UIndex stmp; 
    350  
    351     if( low >= high ) 
    352         return; 
    353  
    354     val = QS_VAL(low); 
    355     i = low; 
    356     j = high+1; 
    357     for(;;) 
    358     { 
    359         do i++; while( i <= high && QS_VAL(i) < val ); 
    360         do j--; while( QS_VAL(j) > val ); 
    361         if( i > j ) 
    362             break; 
    363         QS_SWAP( i, j ); 
    364     } 
    365     QS_SWAP( low, j ); 
    366     _quickSort( cells, low, j-1 ); 
    367     _quickSort( cells, j+1, high ); 
    368 } 
    369  
    370  
    371 static void _orderWords( UCell* words, int count ) 
    372 { 
    373     UCell* it; 
    374     UCell* end; 
    375     int index = 0; 
    376  
    377     it  = words; 
    378     end = words + count; 
    379  
    380     while( it != end ) 
    381     { 
    382         it->word.index = index++; 
    383         it->word.sel   = ur_atom(it); 
    384         ++it; 
    385     } 
    386  
    387     _quickSort( words, 0, count - 1 ); 
    388 } 
    389  
    390  
    391 /* 
    392    Returns index of atom in word block or -1 if not found. 
    393 */ 
    394 static int _binarySearch( UCell* words, int count, UAtom atom ) 
    395 { 
    396     int sAtom; 
    397     int mid; 
    398     int low = 0; 
    399     int high = count - 1; 
    400  
    401     while( low <= high ) 
    402     { 
    403         mid = ((unsigned int) (low + high)) >> 1; 
    404         sAtom = words[ mid ].word.sel; 
    405  
    406         if( sAtom < atom ) 
    407             low = mid + 1; 
    408         else if( sAtom > atom ) 
    409             high = mid - 1; 
    410         else 
    411             return words[ mid ].word.index; 
    412     } 
    413  
    414     // Atom not found. 
    415     return -1; 
    416 } 
    417  
    418  
    419 /** 
    420   Find word in context by atom. 
    421   \returns  Word index or -1 if not found. 
    422 */ 
    423 int ur_lookup( const UContext* ctx, UAtom atom ) 
    424 { 
    425     UBlock* wblk; 
    426     UCell* it; 
    427     UCell* end; 
    428  
    429     wblk = ur_blockPtr( ctx->ctx.wordBlk ); 
    430     it = wblk->ptr.cells; 
    431  
    432     if( wblk->used < SEARCH_LEN ) 
    433318    { 
    434319        end = it + wblk->used; 
    …… 
    443328    else 
    444329    { 
     330        return _binarySearch( it, wblk->used, atom ); 
     331    } 
     332} 
     333 
     334 
     335static int _internWord( UThread* ut, const UContext* ctx, UAtom atom ) 
     336{ 
     337    int wrdN; 
     338    UBlock* vblk; 
     339    UBlock* wblk; 
     340    UCell* it; 
     341 
     342    wblk = ur_blockPtr( ctx->ctx.wordBlk ); 
     343    wrdN = wblk->used; 
     344    UR_EXPAND_1( UCell, wblk, it ); 
     345 
     346    ur_initType( it, UT_WORD ); 
     347    it->word.atom    = atom; 
     348    it->word.wordBlk = 0; 
     349    it->word.valBlk  = ctx->ctx.valBlk; 
     350    it->word.index   = 0; 
     351    it->word.sel     = 0; 
     352 
     353    wblk->ptr.cells->word.sel = UR_CTX_UNORDERED; 
     354 
     355    vblk = ur_blockPtr( ctx->ctx.valBlk ); 
     356    if( vblk->used < wblk->used ) 
     357    { 
     358        ur_arrayReserve( vblk, sizeof(UCell), wblk->used ); 
     359        vblk->used = wblk->used; 
     360 
     361        it = vblk->ptr.cells + wrdN; 
     362        ur_initType( it, UT_UNSET ); 
     363    } 
     364 
     365    return wrdN; 
     366} 
     367 
     368 
     369/** 
     370  Add word to context if it does not already exist. 
     371  If added, the word is initialied as unset. 
     372 
     373  \return  Index of word in context. 
     374*/ 
     375int ur_internWordT( UThread* ut, const UContext* ctx, UAtom atom ) 
     376{ 
     377    int wrdN; 
     378 
     379    wrdN = _lookupNoSort( ut, ctx, atom ); 
     380    if( wrdN > -1 ) 
     381        return wrdN; 
     382 
     383    // Not found - add new word. 
     384    return _internWord( ut, ctx, atom ); 
     385} 
     386 
     387 
     388#define QS_VAL(a)   cells[a].word.sel 
     389 
     390// Using series.end to swap word.index & word.sel together. 
     391#define QS_SWAP(a,b) \ 
     392    stmp = cells[a].series.end; \ 
     393    cells[a].series.end = cells[b].series.end; \ 
     394    cells[b].series.end = stmp 
     395 
     396static void _quickSort( UCell* cells, int low, int high ) 
     397{ 
     398    int i, j; 
     399    UAtom val; 
     400    UIndex stmp; 
     401 
     402    if( low >= high ) 
     403        return; 
     404 
     405    val = QS_VAL(low); 
     406    i = low; 
     407    j = high+1; 
     408    for(;;) 
     409    { 
     410        do i++; while( i <= high && QS_VAL(i) < val ); 
     411        do j--; while( QS_VAL(j) > val ); 
     412        if( i > j ) 
     413            break; 
     414        QS_SWAP( i, j ); 
     415    } 
     416    QS_SWAP( low, j ); 
     417    _quickSort( cells, low, j-1 ); 
     418    _quickSort( cells, j+1, high ); 
     419} 
     420 
     421 
     422static void _orderWords( UCell* words, int count ) 
     423{ 
     424    UCell* it; 
     425    UCell* end; 
     426    int index = 0; 
     427 
     428    it  = words; 
     429    end = words + count; 
     430 
     431    while( it != end ) 
     432    { 
     433        it->word.index = index++; 
     434        it->word.sel   = ur_atom(it); 
     435        ++it; 
     436    } 
     437 
     438    _quickSort( words, 0, count - 1 ); 
     439} 
     440 
     441 
     442/* 
     443   Returns index of atom in word block or -1 if not found. 
     444*/ 
     445static int _binarySearch( UCell* words, int count, UAtom atom ) 
     446{ 
     447    int sAtom; 
     448    int mid; 
     449    int low = 0; 
     450    int high = count - 1; 
     451 
     452    while( low <= high ) 
     453    { 
     454        mid = ((unsigned int) (low + high)) >> 1; 
     455        sAtom = words[ mid ].word.sel; 
     456 
     457        if( sAtom < atom ) 
     458            low = mid + 1; 
     459        else if( sAtom > atom ) 
     460            high = mid - 1; 
     461        else 
     462            return words[ mid ].word.index; 
     463    } 
     464 
     465    // Atom not found. 
     466    return -1; 
     467} 
     468 
     469 
     470/** 
     471  Find word in context by atom. 
     472  \return  Word index or -1 if not found. 
     473*/ 
     474int ur_lookupT( UThread* ut, const UContext* ctx, UAtom atom ) 
     475{ 
     476    UBlock* wblk; 
     477    UCell* it; 
     478    UCell* end; 
     479 
     480    wblk = ur_blockPtr( ctx->ctx.wordBlk ); 
     481    it = wblk->ptr.cells; 
     482 
     483    if( wblk->used < SEARCH_LEN ) 
     484    { 
     485        end = it + wblk->used; 
     486        while( it != end ) 
     487        { 
     488            if( it->word.atom == atom ) 
     489                return it - wblk->ptr.cells; 
     490            ++it; 
     491        } 
     492        return -1; 
     493    } 
     494    else 
     495    { 
    445496        if( it->word.sel == UR_CTX_UNORDERED ) 
    446497        { 
    …… 
    454505// Atom remains the same. 
    455506 
    456 #define _bindWord(val) \ 
    457     wrdN = ur_lookup( ctx, val->word.atom ); \ 
     507#define _bindWord(cell) \ 
     508    wrdN = ur_lookup( ctx, cell->word.atom ); \ 
    458509    if( wrdN > -1 ) { \ 
    459         val->word.wordBlk = ctx->ctx.wordBlk; \ 
    460         val->word.valBlk  = ctx->ctx.valBlk; \ 
    461         val->word.index   = wrdN; } 
    462  
    463  
    464 UBlock* ur_bind( UIndex blkN, UContext* ctx ) 
     510        if( ur_bindType(cell) != btype ) \ 
     511            ur_setBindType(cell,btype); \ 
     512        cell->word.wordBlk = ctx->ctx.wordBlk; \ 
     513        cell->word.valBlk  = ctx->ctx.valBlk; \ 
     514        cell->word.index   = wrdN; } 
     515 
     516 
     517UBlock* ur_bindT( UThread* ut, UIndex blkN, const UContext* ctx, int btype ) 
    465518{ 
    466519    int wrdN; 
    …… 
    469522    UCell* end = it + blk->used; 
    470523 
    471     while( it != end ) 
    472     { 
    473         if( ur_isAWord(it) || 
    474             ur_is(it, UT_OPCODE) || 
    475             ur_is(it, UT_SELECT) || 
    476             ur_is(it, UT_SETSELECT) ) 
    477         { 
    478             _bindWord( it ); 
    479         } 
    480         else if( ur_is(it, UT_PATH) || ur_is(it, UT_SETPATH) ) 
    481         { 
    482             UCell* path1 = ur_blockPtr( it->series.n )->ptr.cells; 
    483             if( ur_isAWord(path1) ) 
    484             { 
    485                 _bindWord( path1 ); 
    486             } 
    487         } 
    488         else if( ur_is(it, UT_BLOCK) || ur_is(it, UT_PAREN) ) 
    489         { 
    490             ur_bind( it->series.n, ctx ); 
    491         } 
    492         else if( ur_is(it, UT_FUNCTION) ) 
    493         { 
    494             ur_bind( it->func.bodyN, ctx ); 
    495  
    496             // NOTE: Will probably need to rebind to local func context in 
    497             // case ctx contains the same words.  
    498             //orBind( orBlockPtr( it->func.bodyBlk ), it->func.context ); 
    499         } 
    500  
    501         ++it; 
    502     } 
    503  
    504     return blk; 
    505 } 
    506  
    507  
    508 #ifndef UR_CONFIG_UDS 
    509 /** 
    510   ur_resolveArgPath is provided as a fast but still convenient method of 
    511   resolving paths from C code. 
    512  
    513   Pass a number of datatype/value argument pairs terminated by UT_NONE to 
    514   specify the path. A pair can be either UT_WORD,atom or UT_INT,int. 
    515  
    516   Returns zero if the path is not valid. 
    517  
    518   Using a string argument rather than a tag list would be more convenient 
    519   but not as quick. 
    520 */ 
    521 UCell* ur_resolveArgPath( int first_tag, ... ) 
    522 { 
    523     va_list args; 
    524     int tag; 
    525     int data; 
    526     UIndex wrd; 
    527     UBlock* blk; 
    528     UCell* val; 
    529  
    530     val = &ur_global; 
    531  
    532     va_start(args, first_tag); 
    533     tag = first_tag; 
    534  
    535     while( tag != UT_NONE ) 
    536     { 
    537         data = va_arg(args, int); 
    538         switch( tag ) 
     524    if( ur_isGlobal(blkN) ) 
     525        return 0;       // Cannot bind global blocks. 
     526 
     527    while( it != end ) 
     528    { 
     529        switch( ur_type(it) ) 
    539530        { 
    540531            case UT_WORD: 
    541                 if( ur_is(val, UT_CONTEXT) ) 
     532            case UT_SETWORD: 
     533            case UT_GETWORD: 
     534            case UT_LITWORD: 
     535            case UT_SELECT: 
     536            case UT_SETSELECT: 
     537            case UT_LITSELECT: 
     538            case UT_OPCODE: 
     539                _bindWord( it ); 
     540                break; 
     541 
     542            case UT_PATH: 
     543            case UT_SETPATH: 
     544            { 
     545                UCell* path1 = ur_blockPtr( it->series.n )->ptr.cells; 
     546                if( ur_isAWord(path1) ) 
    542547                { 
    543                     wrd = ur_lookup( val, data ); 
    544                     if( wrd < 0 ) 
    545                         goto abort; 
    546  
    547                     blk = ur_blockPtr( val->ctx.valBlk ); 
    548                     val = blk->ptr.cells + wrd; 
    549                     break; 
     548                    _bindWord( path1 ); 
    550549                } 
    551                 goto abort; 
    552  
    553             case UT_INT: 
    554                 if( ur_is(val, UT_BLOCK) ) 
     550            } 
     551                break; 
     552 
     553            case UT_BLOCK: 
     554            case UT_PAREN: 
     555                ur_bindT( ut, it->series.n, ctx, btype ); 
     556                break; 
     557 
     558            case UT_FUNCTION: 
     559                ur_bindT( ut, it->func.bodyN, ctx, btype ); 
     560 
     561                // NOTE: Will probably need to rebind to local func context in 
     562                // case ctx contains the same words.  
     563                //orBind( orBlockPtr( it->func.bodyBlk ), it->func.context ); 
     564                break; 
     565        } 
     566 
     567        ++it; 
     568    } 
     569 
     570    return blk; 
     571} 
     572 
     573 
     574extern UContext ur_envGlobal; 
     575 
     576/* 
     577   wc->flags, wc->word wordBlk, valBlk, & index are set. 
     578   ctop must be greater than cbot. 
     579*/ 
     580void ur_internDefault( UThread* ut, UCell* wc, UAtom atom, 
     581                       UCell* cbot, UCell* ctop ) 
     582{ 
     583    UCell* cit; 
     584    int wrdN; 
     585&