Changeset 408 for branches/thune

Timestamp:

06/11/07 04:07:02 (18 months ago)

Author:

krobillard

Message:

Thune - Simplified macros with macro! datatype.

Location:

branches/thune/thread_safe

Files:

• boot.c (modified) (1 diff)
• charset.c (modified) (2 diffs)
• config.t (modified) (2 diffs)
• eval.c (modified) (2 diffs)
• internal.h (modified) (1 diff)
• make.c (modified) (2 diffs)
• mkboot.t (modified) (2 diffs)
• print.c (modified) (2 diffs)
• tests/working/bytecode.t (modified) (1 diff)
• thread.c (modified) (1 diff)
• thune.c (modified) (2 diffs)
• tokenize.c (modified) (11 diffs)
• urlan.c (modified) (3 diffs)
• urlan.h (modified) (2 diffs)

branches/thune/thread_safe/boot.c

@@ -117 +117 @@
   "  none :os\n"
   "  [] :devices\n"
-  "  [\n"
-  "    [\n"
-  "      [word word!/lit-word! def] [\n"
-  "        def: word: reader-macros last set\n"
-  "      ] func :macro\n"
-  "      [word word!/lit-word! sig block! body block!] [\n"
-  "        sig  kernel-ops infuse\n"
-  "        body kernel-ops infuse\n"
-  "        func word: reader-macros last set\n"
-  "      ] func :macrof\n"
-  "      [n] [[n: 'add word! as] reduce] func :+\n"
-  "      [n] [[n: 'sub word! as] reduce] func :-\n"
-  "      [n] [[n: 'mul word! as] reduce] func :*\n"
-  "      [n] [[n: 'div word! as] reduce] func :/\n"
-  "    ] context\n"
-  "  ] reduce :reader-macros\n"
   "]\n"
   "context :script-env\n"

branches/thune/thread_safe/charset.c

@@ -26 +26 @@
 /* Strict Word: a-z A-Z ?!.*&|=_~ and all ascii >= 127  */
 uint8_t charset_sword[32] = {
+#ifdef UR_CONFIG_MACROS
+        0x00,0x00,0x00,0x00,0x42,0x44,0x00,0xA0,    // Don't allow < >
+#else
         0x00,0x00,0x00,0x00,0x42,0x44,0x00,0xF0,
+#endif
         0xFE,0xFF,0xFF,0x97,0xFF,0xFF,0xFF,0x57,
         0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,
@@ -35 +39 @@
 /* Word: 0-9 a-z A-Z ?!.'+-*&|=_~ and all ascii >= 127 */
 uint8_t charset_word[32] = {
+#ifdef UR_CONFIG_MACROS
+        0x00,0x00,0x00,0x00,0xC2,0x6C,0xFF,0xA3,    // Don't allow < >
+#else
         0x00,0x00,0x00,0x00,0xC2,0x6C,0xFF,0xF3,
+#endif
         0xFE,0xFF,0xFF,0x97,0xFF,0xFF,0xFF,0x57,
         0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,

branches/thune/thread_safe/config.t

@@ -5 +5 @@
 [x] math3d   "Include vector & matrix math calls"
              enable trig
+[x] macros   "Reader macros"
 [ ] dt-code  "Include 'code datatype"
 
@@ -13 +14 @@
 
 [ ] threads  "Experimental script threads"
-[ ] macros   "Experimantal reader macros"
 [ ] emh      "Debugger Hooks"
 

branches/thune/thread_safe/eval.c

@@ -59 +59 @@
 
 
-static void _infuseOpcodes( UThread* ut, UIndex blkN )
+void ur_infuseOpcodes( UThread* ut, UIndex blkN )
 {
     UBlock* blk;
@@ -432 +432 @@
         if( blkN )
         {
-            _infuseOpcodes( ut, blkN );
+            ur_infuseOpcodes( ut, blkN );
             return ur_eval( ut, blkN, 0 );
         }

branches/thune/thread_safe/internal.h

@@ -14 +14 @@
 #define BLK_GLOBAL_WORD     1
 #define BLK_GLOBAL_VAL      2
-//#define BLK_DSTACK          3
+#define BLK_CTX_STACK       3
+//#define BLK_DSTACK          4
 
 

branches/thune/thread_safe/make.c

@@ -45 +45 @@
 static void ur_internGlobal( UThread* ut, UCell* wc, UAtom atom )
 {
+    UBlock* mblk;
+    UCell* mtop;
+    UCell* mbot;
     int wrdN;
 
-    // A module system could be implemented by looking up atom in a stack
-    // of module contexts here...
-
-    wrdN = ur_lookup( &ur_global, atom );
-    if( wrdN > -1 )
-    {
-        // UR_BIND_THREAD should already be set.
-        wc->word.wordBlk = BLK_GLOBAL_WORD;
-        wc->word.valBlk  = BLK_GLOBAL_VAL;
-        wc->word.index   = wrdN;
-        return;
-    }
-
+    // Look for atom in module context stack.
+    mblk = ur_blockPtr( BLK_CTX_STACK );
+    mbot = mblk->ptr.cells;
+    mtop = mbot + mblk->used;
+    do
+    {
+        --mtop;
+        wrdN = ur_lookup( mtop, atom );
+        if( wrdN > -1 )
+            goto assign;
+    }
+    while( mtop != mbot );
+
+
+    // Now try the shared global context.
     if( ut->env->blocks.arr.used )
     {
@@ -73 +78 @@
     }
 
-    // For modules, intern word into current module (top of context stack).
+    // Word not found, so intern into current module (top of context stack).
+    mtop = mbot + (mblk->used - 1);
+    wrdN = ur_internWord( mtop, atom );
+
+assign:
 
     // UR_BIND_THREAD should already be set.
-    wc->word.wordBlk = BLK_GLOBAL_WORD;
-    wc->word.valBlk  = BLK_GLOBAL_VAL;
-    wc->word.index   = ur_internWord( &ur_global, atom );
+    wc->word.wordBlk = mtop->ctx.wordBlk;
+    wc->word.valBlk  = mtop->ctx.valBlk;
+    wc->word.index   = wrdN;
 }
 

branches/thune/thread_safe/mkboot.t

@@ -41 +41 @@
 :boot-script
 
-
 {
 logic! 1 make dup :yes :on
@@ -134 +133 @@
   none :os
   [] :devices
-  [
-    [
-      [word word!/lit-word! def] [
-        def: word: reader-macros last set
-      ] func :macro
-
-      [word word!/lit-word! sig block! body block!] [
-        sig  kernel-ops infuse
-        body kernel-ops infuse
-        func word: reader-macros last set
-      ] func :macrof
-
-      [n] [[n: 'add word! as] reduce] func :+
-      [n] [[n: 'sub word! as] reduce] func :-
-      [n] [[n: 'mul word! as] reduce] func :*
-      [n] [[n: 'div word! as] reduce] func :/
-    ] context
-  ] reduce :reader-macros
 ]
 context :script-env

branches/thune/thread_safe/print.c

@@ -717 +717 @@
             ur_strCatCell( ut, out, UR_ENC_ASCII, val );
             break;
+
+        case UT_BINARY:
+            _binCellToStr( ut, out, val );
+            break;
 #if 0
         case OT_TAG:        {
@@ -728 +732 @@
         case OT_BITSET:     append(out, "make bitset! ", 13);
                             // Fall through to binary.
-
-        case OT_BINARY:     _binCellToStr( out, val );
-                            break;
 #endif
         case UT_CHAR:       append1( ur_char(val), out );

branches/thune/thread_safe/tests/working/bytecode.t

@@ -41 +41 @@
         [val add-word emit16]               ;20 - block
         nop                                 ;21 - paren
-        nop                                 ;22 - path
-        nop                                 ;23 - setpath
-        nop                                 ;24 - slice
-        nop                                 ;25 - array
-        nop                                 ;26 - bitset
-        nop                                 ;27 - list
-        nop                                 ;28 - context
-        nop                                 ;29 - function
-        nop                                 ;30 - call
-        nop                                 ;31 - date
-        nop                                 ;32 - time
-        nop                                 ;33 - bitset
-        nop                                 ;34 - error
-        nop                                 ;35 - code
-        nop                                 ;36 - port
-        nop                                 ;37 - struct
+        nop                                 ;23 - macro
+        nop                                 ;23 - path
+        nop                                 ;24 - setpath
+        nop                                 ;25 - slice
+        nop                                 ;26 - array
+        nop                                 ;27 - bitset
+        nop                                 ;28 - list
+        nop                                 ;29 - context
+        nop                                 ;30 - function
+        nop                                 ;31 - call
+        nop                                 ;32 - date
+        nop                                 ;33 - time
+        nop                                 ;34 - bitset
+        nop                                 ;35 - error
+        nop                                 ;36 - code
+        nop                                 ;37 - port
+        nop                                 ;38 - struct
     ] :type-convert
 

branches/thune/thread_safe/thread.c

@@ -159 +159 @@
 
 
+void ur_pushContext( UThread* ut, UContext* ctx )
+{
+    UCell* cell;
+    UBlock* blk = ur_blockPtr( BLK_CTX_STACK );
+    UR_EXPAND_1( UCell, blk, cell );
+    ur_copyCell( cell, *ctx );
+}
+
+
+void ur_popContext( UThread* ut )
+{
+    UBlock* blk = ur_blockPtr( BLK_CTX_STACK );
+    if( blk->used )
+        --blk->used;
+}
+
+
 UBinary* ur_threadTmp( UThread* ut )
 {

branches/thune/thread_safe/thune.c

@@ -294 +294 @@
 #define EMH_HALT(pc,end)
 #endif
+
+
+//extern void _addCells( UThread*, UCell*, UCell* );
+//extern void _mulCells( UThread*, UCell*, UCell* );
 
 
@@ -468 +472 @@
                                 goto throw_cc;
 
-                            _infuseOpcodes( ut, tblkN );
+                            ur_infuseOpcodes( ut, tblkN );
                             ur_setSeries(val, tblkN, 0);
                             goto do_block;

branches/thune/thread_safe/tokenize.c

@@ -204 +204 @@
 
 
-/*
-#if UR_CONFIG_MATH3D
-static int isVec3( const char* cp, int len ) 
+#ifdef UR_CONFIG_MACROS
+extern void ur_infuseOpcodes( UThread*, UIndex );
+
+//#define MACRO_CONTEXT   1
+#ifdef MACRO_CONTEXT
+extern UContext ur_global;
+
+static void _pushMacroContext( UThread* ut )
 {
-    if( len < 3 )
-        return 0;
-    if( *cp == '-' )
-        ++cp;
-    if( *cp < '0' || *cp > '9' )
-        return 0;
-    return 1;
-}
-
-
-static void assignVec3( float* vec, const char* start, int len )
-{
-    int ch;
-    const char* pos;
-    const char* end = start + len;
-
-    *vec++ = (float) ur_stringToDec( start, end, &pos );
-    while( pos != end )
-    {
-        ch = *pos;
-        if( ! ur_bitIsSet(charset_white, ch) )
-            break;
-        ++pos;
-    }
-    *vec++ = (float) ur_stringToDec( pos, end, &pos );
-    while( pos != end )
-    {
-        ch = *pos;
-        if( ! ur_bitIsSet(charset_white, ch) )
-            break;
-        ++pos;
-    }
-    *vec   = (float) ur_stringToDec( pos, end, &pos );
+    UBlock* blk;
+    UCell* mc;
+    int wrdN;
+   
+    wrdN = ur_internWord( &ur_global, UR_ATOM_READER_MACROS );
+    blk = ur_blockPtr( ur_global.ctx.valBlk );
+    mc = blk->ptr.cells + wrdN;
+    if( ! ur_is(mc, UT_CONTEXT) )
+        ur_makeContext( mc, 0 );
+    ur_pushContext( ut, mc );
 }
 #endif
-*/
-
-
-#ifdef UR_CONFIG_MACROS
-struct TokenizeCallInfo
-{
-    int valueLimit;
-    const char* finalInputPos;
-};
-
-
-static int _evalMacro( UThread* ut, UBlock* blk, UCell* mval,
-                       const char** pin, const char* end )
-{
-    UCell* cell;
-
-    if( ur_is(mval, UT_FUNCTION) )
-    {
-        if( mval->func.localArgs )
-        {
-            UIndex tblkN;
-            UBlock* callBlk;
-            UCell* otos;
-            int ok;
-            struct TokenizeCallInfo tci;
-
-            tci.valueLimit    = mval->func.localArgs;
-            tci.finalInputPos = 0;
-
-            tblkN = ur_tokenize( ut, *pin, end, &tci );
-            *pin = tci.finalInputPos;
-
-            callBlk = ur_blockPtr( tblkN );
-            UR_EXPAND_1( UCell, callBlk, cell );
-            ur_copyCell(cell, *mval);
-            otos = UR_TOS;
-            ok = ur_eval( ut, tblkN, 0 );
-            if( ok != UR_EVAL_OK )
-                return 0;
-            if( UR_TOS == otos )
-                return 1;
-            mval = ur_result( ut, 1 );
-        }
-    }
-
-    if( ur_is(mval, UT_BLOCK) )
-    {
-        // Join blocks (share code with uc_join?).
-        UBlock* s2 = ur_block(mval);
-        int srcLen = s2->used - mval->series.it;
-
-        ur_arrayReserve( blk, sizeof(UCell), blk->used + srcLen );
-
-        ur_copyCells( s2->ptr.cells + mval->series.it,
-                      s2->ptr.cells + s2->used,
-                      blk->ptr.cells + blk->used );
-        blk->used += srcLen;
-    }
-    else
-    {
-        UR_EXPAND_1( UCell, blk, cell );
-        ur_copyCell( cell, *mval );
-    }
-    return 1;
-}
-
-
-static UCell* _macro( UBlock* macroStack, const char* a, const char* b )
-{
-    int wrdN;
-    UCell* top = macroStack->ptr.cells + macroStack->used;
-    UAtom atom = ur_intern( a, b - a );
-
-    while( top != macroStack->ptr.cells )
-    {
-        wrdN = ur_lookup( --top, atom );
-        if( wrdN > -1 )
-        {
-            return ur_blockPtr( top->ctx.valBlk )->ptr.cells + wrdN;
-        }
-    }
-
-    return 0;
-}
 #endif
 
@@ -341 +239 @@
     ur_throwErr( UR_ERR_SYNTAX, "%s (line %d)", msg, lines + 1 ); \
     goto error
+
+
+/*
+   Returns zero if end reached.
+*/
+static const char* blockComment( const char* it, const char* end, int* lines )
+{
+    int ch, tn, mode;
+    int lineCount = 0;
+
+    mode = 0;
+    tn = 0;
+
+    SCAN_LOOP
+        if( ch == '\n' )
+        {
+            ++lineCount;
+            mode = 0;
+        }
+        else
+        {
+            switch( mode )
+            {
+                case 0:
+                    if( ch == '*' )
+                        mode = 1;
+                    else if( ch == '/' )
+                        mode = 2;
+                    break;
+
+                case 1:
+                    if( ch == '/' )
+                    {
+                        if( tn == 0 )
+                        {
+                            *lines += lineCount;
+                            return ++it;
+                        }
+                        --tn;
+                    }
+                    mode = 0;
+                    break;
+
+                case 2:
+                    if( ch == '*' )
+                        ++tn;
+                    mode = 0;
+                    break;
+            }
+        }
+    SCAN_END
+
+    *lines += lineCount;
+    return 0;
+}
 
 
@@ -359 +312 @@
     int lines = 0;
 #ifdef UR_CONFIG_MACROS
-#define TCI     ((struct TokenizeCallInfo*) tci)
-    UBlock* macroStack;
-    int valueLimit;
-
-    cell = ur_resolvePath( UR_ATOM_SCRIPT_ENV,
-                           UT_WORD, UR_ATOM_READER_MACROS,
-                           UT_NONE );
-    macroStack = cell ? ur_block(cell) : 0;
-    valueLimit = tci ? TCI->valueLimit : 0;
-#else
+    int macroNest = 0;
+#endif
+
     (void) tci;
-#endif
 
 
@@ -448 +393 @@
                 case '[':
                 case '(':
+                case '<':
                     ur_arrayReserve( &stack, sizeof(UIndex), stack.used+1 );
                     STACK[ stack.used ] = ur_makeBlock( 0 );
 
-                    cell = ur_appendCell( BLOCK, 
-                                          (ch == '[') ? UT_BLOCK : UT_PAREN );
+                    switch( ch )
+                    {
+                        case '[': mode = UT_BLOCK; break;
+                        case '(': mode = UT_PAREN; break;
+                        case '<': mode = UT_MACRO;
+#ifdef UR_CONFIG_MACROS
+#ifdef MACRO_CONTEXT
+                            if( ! macroNest )
+                                _pushMacroContext( ut );
+#endif
+                            ++macroNest;
+#endif
+                            break;
+                    }
+
+                    cell = ur_appendCell( BLOCK, mode );
                     ur_setSeries( cell, STACK[ stack.used ], 0 );
 
@@ -465 +425 @@
                 case ']':
                 case ')':
+                case '>':
                     if( stack.used == 1 )
                     {
-                        syntaxError( "End of block found without '['" );
+                        ur_throwErr( UR_ERR_SYNTAX,
+                            "End of block '%c' has no opening match (line %d)",
+                                     ch, lines + 1 );
+                        goto error;
                     }
                     --stack.used;
                     if( eol )
+                        eol = 0;
+#ifdef UR_CONFIG_MACROS
+                    if( ch == '>' && macroNest )
                     {
-                        /*
-                        UBlock* blk = ur_blockPtr( STACK[ stack.used - 1 ] );
-                        cell = blk->ptr.cells + blk->used - 1;
-                        cell->id.flags |= UR_FLAG_BLOCK_EOL;
-                        */
-                        eol = 0;
+                        UCell* otos;
+                        UBlock* blk;
+
+                        otos = UR_TOS;
+                        ur_infuseOpcodes( ut, STACK[ stack.used ] );
+                        tn = ur_eval( ut, STACK[ stack.used ], 0 );
+                        if( tn == UR_EVAL_ERROR )
+                        {
+                            UR_CALL_OP = OP_THROW;
+                            goto error;
+                        }
+
+                        blk = ur_blockPtr( STACK[stack.used - 1] );
+                        --blk->used;    // Remove macro.
+
+                        if( UR_TOS != otos )
+                        {
+                            // Append reduced macro to current block.
+                            tn = UR_TOS - otos;
+                            UR_TOS = otos;
+                            ++otos;
+
+                            ur_arrayReserve( blk, sizeof(UCell),
+                                             blk->used + tn );
+                            ur_copyCells( otos, otos + tn,
+                                          blk->ptr.cells + blk->used );
+                            blk->used += tn;
+                        }
+
+#ifdef MACRO_CONTEXT
+                        if( macroNest == 1 )
+                            ur_popContext( ut );
+#endif
+                        --macroNest;
                     }
-#ifdef UR_CONFIG_MACROS
-                    ++it;
-                    goto check_final;
-#else
+#endif
                     break;
-#endif
                 }
             }
@@ -498 +489 @@
         eol = 0;
     }
-#ifdef UR_CONFIG_MACROS
-check_final:
-    if( valueLimit && (stack.used == 1) )
-    {
-        if( --valueLimit == 0 )
-        {
-            TCI->finalInputPos = it;
-            goto finish;
-        }
-    }
-#endif
     goto start;
 
@@ -544 +524 @@
 //block_comment
 
-    mode = 0;
-    tn = 0;
-