Changeset 178 for trunk/thune/eval.c

Timestamp:

06/10/06 00:38:50 (3 years ago)

Author:

krobillard

Message:

Thune -

Reduce now evaluates blocks.
Added 'to-text and 'console.out. Print & prin are now functions.
Fixed un-initialized word.valBlks.

Files:

• trunk/thune/eval.c (modified) (15 diffs)

trunk/thune/eval.c

@@ -26 +26 @@
 
 /*
-   There is a data stack & a control stack which share the UThread::stack
+   There is a data stack and a control stack which share the UThread::stack
    buffer.  The control stack is at the start and grows upward.
-   The data stack is at the end and grows downward
+   The data stack is at the end and grows downward.
 */
 
@@ -64 +64 @@
     UR_TOC->eval.code = CC_EVAL_RUNNING; \
     UR_TOC->eval.n    = blkn; \
+    UR_C_GROW
+
+#define PUSHC_REDUCE(blkn) \
+    UR_TOC->reduce.code = CC_REDUCE; \
+    UR_TOC->reduce.cell = UR_TOS; \
+    UR_TOC->reduce.n    = blkn; \
     UR_C_GROW
 
@@ -238 +244 @@
             }
             break;
-
+#if 0
+        case UT_SLICE:
+            if( ur_selIsAtom(sel) )
+            {
+                if( ur_selector(sel) == UR_ATOM_POS )
+                if( ur_selector(sel) == UR_ATOM_END )
+            }
+            else
+            {
+                if( ur_pick( val, ur_selector(sel) - 1, res ) )
+                    return 1;
+            }
+            break;
+#endif
         case UT_VEC3:
         {
@@ -361 +380 @@
 
 
-// (value -- [result])
+// (value -- result)
 UR_CALL( uc_reduce )
 {
-#if 0
-    if( ur_is(tos, UT_BLOCK) )
-    {
-        ur_clone( tos, UR_COPY_ALL, 0 );
-    }
-    else
-#endif
-    if( ur_is(tos, UT_PAREN) )
-    {
-        UR_CALL_OP = OP_DO;
+    if( ur_is(tos, UT_BLOCK) || ur_is(tos, UT_PAREN) )
+    {
+        UR_CALL_OP = OP_REDUCE;
     }
     else if( ur_is(tos, UT_WORD) )
@@ -382 +394 @@
         ur_wordCell( tos, blk, val );
         ur_copyCell( tos, *val );
+    }
+    else if( ur_is(tos, UT_LITWORD) )
+    {
+        ur_setType(tos, UT_WORD );
     }
     // else leave tos unchanged...
@@ -492 +508 @@
             case CC_EVAL:
             case CC_EVAL_RUNNING:
+            case CC_REDUCE:
                  toc -= CC_LEN_EVAL;
                  break;
@@ -513 +530 @@
 }
 
+
+extern void ur_copyCellsRev( const UCell* src, UCell* dest, int n );
 
 #define DO_BLOCK(vp) \
@@ -855 +874 @@
                             goto do_func;
 
+                        case OP_REDUCE:         // (block! -- )
+                            UR_CALL_OP = 0;
+                            DO_BLOCK( UR_TOS );
+                            PUSHC_REDUCE( UR_TOS->series.n );
+                            UR_S_DROP;
+                            break;
+
                         default:
                             break;
@@ -941 +967 @@
             goto control;
 
+        case CC_REDUCE:
+        {
+            int size;
+            UIndex rblkN;
+            UBlock* rblk;
+            UCell* ntos;
+
+            ntos = UR_TOC->reduce.cell;
+            size = (ntos - UR_TOS) + 1;
+            if( size < 0 )
+                goto stack_eaten;
+            rblkN = ur_makeBlock( size );
+            if( size )
+            {
+                rblk = ur_blockPtr( rblkN );
+                rblk->used = size;
+                ur_copyCellsRev( UR_TOS, rblk->ptr.cells, size );
+                UR_TOS = ntos;
+            }
+            ur_setType(ntos, UT_BLOCK);
+            ur_setSeries(ntos, rblkN, 0);
+        }
+            goto control;
+
         case CC_ITER:
             UR_TOS->series.it++;
@@ -1005 +1055 @@
 
             case CC_EVAL_RUNNING:
+            case CC_REDUCE:
                 UR_C_DECN( CC_LEN_EVAL );
                 break;
@@ -1076 +1127 @@
 
     return UR_EVAL_OK;
+
+stack_eaten:
+
+    ur_throwErr( ur_thread, UR_EX_SCRIPT, "data stack eaten" );
+    _appendTraceBlk( &UR_TOS->err, blkN, pc - start );
+    goto error;
 
 bad_control:
@@ -1543 +1600 @@
     UR_CALL_UNUSED_TH
     ur_setType(tos, UT_WORD);
+    tos->word.wordBlk = 0;
     tos->word.valBlk  = GLOBAL_VAL_BLKN;
     tos->word.index   = t;
@@ -2014 +2072 @@
 
 
+// (val -- str)
+UR_CALL( uc_to_text )
+{
+    if( ! ur_is(tos, UT_STRING) )
+    {
+        UIndex strN;
+        UR_CALL_UNUSED_TH
+
+        strN = ur_makeBinary( 0 );
+
+        ur_toStrNatural( tos, ur_binPtr(strN), 0 );
+
+        ur_setType(tos, UT_STRING);
+        ur_setSeries(tos, strN, 0);
+    }
+}
+
+
 #include "encoding.c"
 
@@ -2019 +2095 @@
 extern void uc_make( UThread*, UCell* );
 extern void uc_bind( UThread*, UCell* );
-extern void uc_prin( UThread*, UCell* );
-extern void uc_print( UThread*, UCell* );
+extern void uc_console_out( UThread*, UCell* );
 extern void uc_parse( UThread*, UCell* );
 extern void uc_now( UThread*, UCell* );
@@ -2044 +2119 @@
     { uc_typeQ,        "type?" },
     { uc_typeQ_word,   "type?.word" },
-    { uc_prin,         "prin" },
-    { uc_print,        "print" },
+    { uc_to_text,      "to-text" },
+    { uc_console_out,  "console.out" },
     { uc_showTOS,      "." },
     { uc_showStack,    ".s" },