Changeset 144 for trunk/orca/ovalue.c

Timestamp:

05/11/06 14:23:03 (3 years ago)

Author:

krobillard

Message:

Native arguments are now kept on the stack until after the call and the
result is now always put into a1.

Files:

• trunk/orca/ovalue.c (modified) (50 diffs)

trunk/orca/ovalue.c

@@ -133 +133 @@
 
 
-static void orNop()
+OR_NATIVE( orNop )
 {
     //cprint( "KR nop %p %d\n", orEnv->dataStack.buf, orEnv->dataStack.used );
@@ -319 +319 @@
 void orInitEnv( OEnv* env, int dataStackSize, int callStackSize )
 {
+    OValue* res;
+
 #ifdef DEBUG
     _validateEnv();
@@ -399 +401 @@
     OBlock* blk;
     OBlock* typeBlk;
-    OValue* res;
     OValue* wval;
     OContext ctx;
@@ -411 +412 @@
     orAppendBlock( typeBlk, 0 );
 
-    res = orRESULT;
+    res = orEnv->dataStack.values;
     orSetTF( res, OT_BLOCK );
     orSetSeries( res, orBlockN(blk), 0 );
@@ -431 +432 @@
     {
         cprint( "** Boot Error: " );
-        orPrintNative( orRESULT );
+        orPrintNative( res );
     }
 
@@ -450 +451 @@
     {
         cprint( "** Boot Error: " );
-        orPrintNative( orRESULT );
+        orPrintNative( res );
     }
 
@@ -685 +686 @@
 #endif
         case OT_LOGIC:
-            orResult( OT_LOGIC, orInt(from) ? 1 : 0 );
+            orSetTF( res, OT_LOGIC );
+            orInt(res) =  orInt(from) ? 1 : 0;
             return 1;
 
@@ -740 +742 @@
                     (it[1].type == OT_INTEGER) )
                 {
-                    OValue* res = orRESULT;
                     orSetTF( res, OT_PAIR );
                     res->pair[0] = it[0].integer;
@@ -901 +902 @@
                 // Return curried function to pick up body argument.
                 // Too bad we have no way of executing this native.
-                OValue* res = orRESULT;
-                res->type  = OT_NATIVE;
-                res->flags = 0;
-                res->argc  = 1;
-                res->refc  = 0;
-                res->native.addr    = orFuncNative;
-                res->native.specBlk = 0;
+                a1->type  = OT_NATIVE;
+                a1->flags = 0;
+                a1->argc  = 1;
+                a1->refc  = 0;
+                a1->native.addr    = orFuncNative;
+                a1->native.specBlk = 0;
                 }
                 return;
@@ -915 +915 @@
             case OT_VEC2:
             case OT_VEC3:
-            {
-                OValue* res = orRESULT;
-                orSetTF( res, orInt(a1) );
-                res->vec3.x = 0.0f;
-                res->vec3.y = 0.0f;
-                res->vec3.z = 0.0f;
+                orSetTF( a1, orInt(a1) );
+                a1->vec3.x = 0.0f;
+                a1->vec3.y = 0.0f;
+                a1->vec3.z = 0.0f;
                 if( a2->type == OT_BLOCK )
-                    orLoadVectorBlock( &res->vec3.x, 3, a2 ); 
-            }
+                    orLoadVectorBlock( &a1->vec3.x, 3, a2 ); 
                 return;
 
@@ -1239 +1236 @@
 
 
-/* Public because of Orca-GL */
+/* Public for Orca-GL */
 OR_NATIVE_PUB( orLoadNative )
 {
@@ -1261 +1258 @@
 
         orTermCStr( str );
-
         file = orStrChars( str, a1 );
 
@@ -1295 +1291 @@
                         {
                             orResultBLOCK( blk - orBLOCKS );
-                            orRESULT->flags |= OR_FLAG_HEADER;
+                            a1->flags |= OR_FLAG_HEADER;
                         }
                     }
@@ -1377 +1373 @@
 #define REF_DO_ARG      a1+2
 
+/*
+  do: native [value /args arg]
+*/
 OR_NATIVE_PUB( orDoNative )
 {
@@ -1382 +1381 @@
     {
         orEvalBlock( orBLOCK( a1 ), a1->series.it );
+        orCopyV(a1, a1[3]);
     }
     else if( orIs(a1, OT_FILE) )
@@ -1411 +1411 @@
             orRefPop( 1 );
             orEvalBlock( orBlockPtr( blkN ), 2 );
+            orCopyV(a1, a1[3]);
             _popScript();
         }
@@ -1424 +1425 @@
             return;
         orEvalBlock( orBLOCK( a1 ), 0 );
+        orCopyV(a1, a1[3]);
     }
     else if( orIs(a1, OT_WORD) )
@@ -1525 +1527 @@
 {
     int logic;
-    if( (a1->type == OT_NONE) ||
-        ((a1->type == OT_LOGIC) && (orInt(a1) == OR_FALSE)) )
+    if( orIfFalse(a1) )
         logic = OR_TRUE;
     else
@@ -1535 +1536 @@
 
 
+/*
+  if: native [cond body]
+*/
 OR_NATIVE( orIfNative )
 {
@@ -1541 +1545 @@
         OValue* a2 = a1 + 1;
         orEvalBlock( orBLOCK( a2 ), a2->series.it );
+        orCopyV( a1, a1[2] );
         return;
     }
@@ -1553 +1558 @@
         OValue* a2 = a1 + 1;
         orEvalBlock( orBLOCK( a2 ), a2->series.it );
+        orCopyV( a1, a1[2] );
         return;
     }
@@ -1562 +1568 @@
 {
     OValue* blkArg = a1 + 2;
-    if( a1->type != OT_NONE )
-    {
-        if( (a1->type != OT_LOGIC) || (orInt(a1) != 0)  )
-            --blkArg;
-    }
+    if( orIfTrue(a1) )
+        --blkArg;
     orEvalBlock( orBLOCK( blkArg ), blkArg->series.it );
-}
-
-
+    orCopyV( a1, a1[3] );
+}
+
+
+/*
+  loop: native [count block]
+*/
 OR_NATIVE( orLoopNative )
 {
@@ -1577 +1584 @@
     int n = orInt(a1);
 
-    ++a1;
-    body = a1->index;
-    bi   = a1->series.it;
+    body = (a1 + 1)->index;
+    bi   = (a1 + 1)->series.it;
+
+    orStackDrop(2);
 
     while( n > 0 )
@@ -1588 +1596 @@
             break;
     }
+
+    orStackGrow(2);
 }
 
@@ -1659 +1669 @@
 
 
+/*
+  until: native [cond]
+*/
 OR_NATIVE( orUntilNative )
 {
-    OValue* res;
+    OValue* res = a1 + 1;
     OIndex cond = a1->index;
     OIndex ci   = a1->series.it;
@@ -1674 +1687 @@
             break;
         }
-        res = orRESULT;
-        if( res->type != OT_NONE )
-        {
-            if( (res->type != OT_LOGIC) || (orInt(res) != 0) )
-                break;
-        }
-    }
-}
-
-
+        if( orIfTrue(res) )
+        {
+            orCopyV(a1, *res);
+            break;
+        }
+    }
+}
+
+
+/*
+  while: native [cond body]
+*/
 OR_NATIVE( orWhileNative )
 {
@@ -1693 +1708 @@
     OIndex bi   = (a1 + 1)->series.it;
 
-    orRefAvailErr( 2 )
-    orRefPush( OT_BLOCK, cond );
-    orRefPush( OT_BLOCK, body );
+    res = orTOS;
 
 loop:
@@ -1703 +1716 @@
         goto exit;
 
-    res = orRESULT;
-    if( res->type != OT_NONE )
-    {
-        if( (res->type != OT_LOGIC) || (orInt(res) != 0) )
-        {
-            if( onstack )
-            {
-                onstack = 0;
-                --orEnv->dataStack.used;
-            }
-
-            orEvalBlock( orBLOCKS + body, bi );
-            if( orErrorThrown )
-            {
-                if( orErrorIsType(OR_ERROR_BREAK) )
-                {
-                    orErrorClear;
-                    res = orRESULT;
-                    orSetTF( res, OT_UNSET );
-                }
-                goto pop;
-            }
-
-            ++orEnv->dataStack.used;
-            onstack = 1;
-            goto loop;
-        }
+    res = orTOS;
+    if( orIfTrue(res) )
+    {
+        if( onstack )
+        {
+            onstack = 0;
+            --orEnv->dataStack.used;
+        }
+
+        orEvalBlock( orBLOCKS + body, bi );
+        if( orErrorThrown )
+        {
+            if( orErrorIsType(OR_ERROR_BREAK) )
+            {
+                orErrorClear;
+                orSetTF( a1, OT_UNSET );
+            }
+            orCopyV( a1, a1[2] );
+            return;
+        }
+
+        ++orEnv->dataStack.used;
+        onstack = 1;
+        goto loop;
     }
 
@@ -1735 +1745 @@
 
     if( onstack )
+    {
         --orEnv->dataStack.used;
-
-pop:
-
-    orRefPop( 2 );
+        orCopyV( a1, a1[2] );
+    }
 }
 
@@ -1774 +1783 @@
 
 
-void orQuitNative()
-{
-    OValue* res = orRESULT;
-
-    orSetError( res, OR_ERROR_QUIT );
-
-    res->error.msg     = 0;
-    res->error.block   = 0;
-    res->error.nearVal = 0;
-}
-
-
-void orHaltNative()
-{
-    OValue* res = orRESULT;
-
-    orSetError( res, OR_ERROR_HALT );
-
-    res->error.msg     = 0;
-    res->error.block   = 0;
-    res->error.nearVal = 0;
+OR_NATIVE( orQuitNative )
+{
+    orSetError( a1, OR_ERROR_QUIT );
+
+    a1->error.msg     = 0;
+    a1->error.block   = 0;
+    a1->error.nearVal = 0;
+}
+
+
+OR_NATIVE( orHaltNative )
+{
+    orSetError( a1, OR_ERROR_HALT );
+
+    a1->error.msg     = 0;
+    a1->error.block   = 0;
+    a1->error.nearVal = 0;
 }
 
@@ -1825 +1830 @@
     // (must set result index before type).
 
-    OValue* res = orRESULT;
-
     if( orRefineSet(REF_TYPEQ_WORD) )
     {
         // NOTE: This assumes word index/atom are the same as type.
-        res->word.context = 0;
-        res->word.index   = a1->type;
-        res->word.atom    = a1->type;
-        orSetTF( res, OT_WORD );
+        a1->word.context = 0;
+        a1->word.index   = a1->type;
+        a1->word.atom    = a1->type;
+        orSetTF( a1, OT_WORD );
     }
     else
     {
-        res->index = a1->type;
-        orSetTF( res, OT_DATATYPE );
+        a1->index = a1->type;
+        orSetTF( a1, OT_DATATYPE );
     }
 }
@@ -1844 +1847 @@
 
 /*
-  try: native [ block [block!] ]
+  try: native [block [block!]]
 */
 OR_NATIVE( orTryNative )
@@ -1851 +1854 @@
    if( orErrorThrown )
    {
-       OValue* res = orRESULT;
-       if( res != orEnv->error )
-           *res = *orEnv->error;
+       orCopyV(a1, *orEnv->error);
        orErrorClear;
+   }
+   else
+   {
+       orCopyV(a1, a1[1]);
    }
 }
@@ -2324 +2329 @@
             int ppos;
 
-            wval = orRESULT;
+            wval = orTOS;
             ppos = orEvalPath( orBLOCK(pc), pc->series.it, 0, wval );
             if( orErrorThrown )
@@ -2568 +2573 @@
 
     assert( data->used > 0 );
-    data->used -= funcv.argc + funcv.refc;
+    {
+    int total = funcv.argc + funcv.refc;
+    int level = data->used;
 
     // NOTE: Natives may need to orHold() any complex argument values since
     // the stack no longer references them here.
 
-    funcv.native.addr( DATA_TOP );
+    funcv.native.addr( DATA_TOP - total );
+    assert( level == data->used );
+    data->used -= total;
+    }
     goto sFinishNative;
 
@@ -2984 +2994 @@
         orRefPush( OT_BLOCK, nblkN );
 
-        orRESULT->type = OT_UNSET;
+        orTOS->type = OT_UNSET;
         while( vi < used )
         {
@@ -2998 +3008 @@
             rblk = orBlockPtr( nblkN );
             OA_EXPAND1( OValue, rblk, val );
-            orCopyV( val, *orRESULT );
+            orCopyV( val, *orTOS );
         }
 
@@ -3022 +3032 @@
                 break;
 
-            res = orRESULT;
+            res = orTOS;
             if( orIs(res, OT_BLOCK) && ! only )
             {
@@ -3069 +3079 @@
 
 /*
+   any: native [block]
+
    Result is the first value that is not false or none!
 */
@@ -3080 +3092 @@
     int reti;
 
-    orRESULT->type = OT_UNSET;
+    orTOS->type = OT_UNSET;
 
     while( vi < used )
@@ -3092 +3104 @@
         vi = reti;
 
-        res = orRESULT;
-        if( res->type != OT_NONE )
-        {
-            if( (res->type != OT_LOGIC) || (orLogic(res) != 0) )
-            {
-                return;
-            }
+        res = orTOS;
+        if( orIfTrue(res) )
+        {
+            orCopyV(a1, *res);
+            return;
         }
     }
@@ -3106 +3116 @@
 
 
+/*
+   all: native [block]
+*/
 OR_NATIVE( orAllNative )
 {
@@ -3115 +3128 @@
     int reti;
 
-    orRESULT->type = OT_UNSET;
+    orTOS->type = OT_UNSET;
 
     while( vi < used )
@@ -3127 +3140 @@
         vi = reti;
 
-        res = orRESULT;
-        if( orIs(res, OT_NONE) )
+        res = orTOS;
+        if( orIfFalse(res) )
             goto fail;
-        if( orIs(res, OT_LOGIC) && (orLogic(res) == 0) )
-            goto fail;
-    }
+    }
+
+    orCopyV(a1, a1[1]);
     return;
 
@@ -3158 +3171 @@
     orRefPush( OT_BLOCK, blkN );
 
-    orRESULT->type = OT_UNSET;
+    orTOS->type = OT_UNSET;
 
     while( vi < used )
@@ -3334 +3347 @@
     msg->used = cp - msg->charArray;
 
-    res = orRESULT;
+    res = orTOS;
 
     orSetError( res, type );
@@ -4198 +4211 @@
 OR_NATIVE_PUB( orNativeNative )
 {
-    if( a1->type == OT_BLOCK )
+    if( orIs(a1, OT_BLOCK) )
     {
         OBlock* blk;
@@ -4280 +4293 @@
 #endif
 
-        val = orRESULT;
+        val = a1;
         val->type  = OT_NATIVE;
         val->flags = 0;
@@ -4297 +4310 @@
 OR_NATIVE( orDoesNative )
 {
-    if( a1->type == OT_BLOCK )
+    if( orIs(a1, OT_BLOCK) )
     {
         OIndex bodyN;
-
         bodyN = a1->index;
 
-        {
-        OValue* res = orRESULT;
-        res->type  = OT_FUNCTION;
-        res->flags = 0;
-        res->argc  = 0;
-        res->refc  = 0;
-        res->func.bodyBlk = bodyN;
-        res->func.specBlk = 0;
-        res->func.context = 0;
-        }
+        a1->type  = OT_FUNCTION;
+        a1->flags = 0;
+        a1->argc  = 0;
+        a1->refc  = 0;
+        a1->func.bodyBlk = bodyN;
+        a1->func.specBlk = 0;
+        a1->func.context = 0;
         return;
     }
@@ -4463 +4472 @@
     int specIndex = a1->index;
 
-    OValue* res = orRESULT;
-
-    res->type  = OT_FUNCTION;
-    res->flags = flags;
-    res->argc  = argc;
-    res->refc  = refc;
-    res->func.bodyBlk = bodyN;
-    res->func.specBlk = specIndex;
-    res->func.context = ctx.vblkN;
+    a1->type  = OT_FUNCTION;
+    a1->flags = flags;
+    a1->argc  = argc;
+    a1->refc  = refc;
+    a1->func.bodyBlk = bodyN;
+    a1->func.specBlk = specIndex;
+    a1->func.context = ctx.vblkN;
 
 #if 0