Changeset 144 for trunk/orca

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.

Location:

trunk/orca

Files:

• console.c (modified) (1 diff)
• context.c (modified) (14 diffs)
• files.c (modified) (6 diffs)
• gl/audio.c (modified) (1 diff)
• gl/gx.c (modified) (1 diff)
• gl/gx.h (modified) (1 diff)
• gl/joystick.c (modified) (1 diff)
• gl/main.c (modified) (2 diffs)
• gl/png_load.c (modified) (1 diff)
• internal.h (modified) (1 diff)
• math.c (modified) (6 diffs)
• op.c (modified) (64 diffs)
• ovalue.c (modified) (50 diffs)
• ovalue.h (modified) (4 diffs)
• parse.c (modified) (8 diffs)
• project.r (modified) (1 diff)
• qt/main.cpp (modified) (2 diffs)
• qt/qorca.cpp (modified) (3 diffs)
• series.c (modified) (4 diffs)
• tests/working/blocks.r (modified) (1 diff)
• tests/working/strings.r (modified) (1 diff)
• unix/os.c (modified) (6 diffs)
• win32/os.c (modified) (4 diffs)

trunk/orca/console.c

@@ -126 +126 @@
                 {
                     OValue* val;
-                    val = orRESULT;
+                    val = orTOS;
                     if( (val->type != OT_UNSET) &&
                         (val->type != OT_OBJECT) &&

trunk/orca/context.c

@@ -876 +876 @@
     body = orBlockN( blk );
     bi   = 0;
+    a1[2].series.n = body;      // Replace original on stack to keep from GC.
     orBind( blk, &ctx );
 
@@ -1209 +1210 @@
 
 /*
-   'variables   [word! block!]
-   series       [series!]
-   body         [block!]
+  foreach: native [
+    'variables   [word! block!]
+    series       [series!]
+    body         [block!]
+  ]
 */
 //see orForeachNative
@@ -1226 +1229 @@
     OIndex si   = a2->series.it;
 
-    OIndex sdest = 0;//in second buffer
+    OIndex sdest = 0;       //in second buffer
     OIndex sorig = si; 
     OIndex ssrc;
@@ -1234 +1237 @@
     OIndex bi   = (a1 + 2)->series.it;
 
-    // Binding a copy of the body to a private context is horribly
-    // expensive but what choice do we have?
-    // Still, 'foreach is faster than 'forall (probably because using paths
-    // is so slow).
-
-    orRefAvailErr( 5 ) // 4 + block-temp
+
+    orRefAvailErr( 5 )      // 4 + block-temp
 
     // Must hold body & a2 in case orMakeContext() or orCopyBlock() trigger
@@ -1275 +1274 @@
             ++it;
         }
-
     }
     else
@@ -1293 +1291 @@
     body = orBlockN( blk );
     bi   = 0;
+    a1[2].series.n = body;      // Replace original on stack to keep from GC.
     orBind( blk, &ctx );
 
@@ -1305 +1304 @@
         case OT_PATH:
         {
-          OIndex keeptBlkIndex;
-          OBlock* keeptBlock;
-          OValue *keept;
+            OIndex keeptBlkIndex;
+            OBlock* keeptBlock;
+            OValue* keept;
 
             blk = orBlockPtr( serN );
-            keeptBlock = orMakeBlock( blk->used );
-            keeptBlkIndex = orBlockN( keeptBlock );
-            orRefPush( OT_BLOCK, keeptBlkIndex );
-            keept = keeptBlock->values; 
+            keeptBlock = orMakeBlock( blk->used );
+            keeptBlkIndex = orBlockN( keeptBlock );
+            orRefPush( OT_BLOCK, keeptBlkIndex );
+            keept = keeptBlock->values; 
             send = blk->used;
 
@@ -1328 +1327 @@
                 blk = orBlockPtr( serN );          // Reacquire.
                 send = blk->used;
-                keeptBlock =  orBlockPtr( keeptBlkIndex );
-                keept = keeptBlock->values; 
-
-                if( !orIfTrue(orRESULT)){
-                  memCpy( keept + sdest, blk->values + si, vlen * sizeof(OValue) );
-                  sdest += vlen;
-                  keeptBlock->used = sdest;
-                }
+                keeptBlock = orBlockPtr( keeptBlkIndex );
+                keept = keeptBlock->values; 
+
+                if( ! orIfTrue(orTOS) )
+                {
+                    memCpy( keept + sdest, blk->values + si,
+                            vlen * sizeof(OValue) );
+                    sdest += vlen;
+                    keeptBlock->used = sdest;
+                }
                 si += vlen; 
             }
 
-            //handle rest, if less values then loopvars
+            // handle rest, if less values then loopvars
 
             if( si < blk->used )
@@ -1358 +1359 @@
                 if( orErrorThrown )
                     goto error;
-
-                blk = orBlockPtr( serN );          // Reacquire.
-                send = blk->used;
-                keeptBlock =  orBlockPtr( keeptBlkIndex );
-                keept = keeptBlock->values; 
-
-                if( !orIfTrue(orRESULT)){
-                  memCpy( keept + sdest, blk->values + si, (blk->used - si) * sizeof(OValue) );
-                  sdest += blk->used - si;
-                  keeptBlock->used = sdest;
-                }               
-            }
-        
-            orResultBLOCK( serN );
-            blk->used = sorig + sdest;
-            orRESULT->series.it = sorig;
-            memCpy( blk->values + sorig, keept, sdest * sizeof(OValue));
-            orRefPop( 1 ); //free(keept);
-        }
-        break;
+                blk = orBlockPtr( serN );          // Reacquire.
+                send = blk->used;
+                keeptBlock = orBlockPtr( keeptBlkIndex );
+                keept = keeptBlock->values; 
+
+                if( ! orIfTrue(orTOS) )
+                {
+                    memCpy( keept + sdest, blk->values + si,
+                            (blk->used - si) * sizeof(OValue) );
+                    sdest += blk->used - si;
+                    keeptBlock->used = sdest;
+                }               
+            }
+
+            orResultBLOCK( serN );
+            blk->used = sorig + sdest;
+            a1->series.it = sorig;
+            memCpy( blk->values + sorig, keept, sdest * sizeof(OValue));
+            orRefPop( 1 ); //free(keept);
+        }
+            break;
 
         case OT_STRING:
@@ -1385 +1387 @@
         {
             OString* str = orStringPtr( serN );
-            char *keept = malloc(str->used);
+            char* keept = malloc(str->used);
             send = str->used;
 
@@ -1400 +1402 @@
             while( si < send )
             {
-              ssrc = si;
+                ssrc = si;
                 for( rlen = 0; rlen < vlen; ++rlen )
                     (wval + rlen)->integer = str->charArray[ si++ ];
@@ -1408 +1410 @@
                     goto error;
                 str = orStringPtr( serN );     // Reacquire.
-                send = str->used;
-
-                if( !orIfTrue(orRESULT)){
-                  strNCpy( keept + sdest, str->charArray + ssrc, vlen );
-                  sdest += vlen;
-                }
+                send = str->used;
+
+                if( ! orIfTrue(orTOS) )
+                {
+                    strNCpy( keept + sdest, str->charArray + ssrc, vlen );
+                    sdest += vlen;
+                }
             }
 
@@ -1419 +1422 @@
             {
                 rlen = str->used - si;
-              ssrc = si;
+                ssrc = si;
 
                 while( si < str->used )
@@ -1435 +1438 @@
 
                 orEvalBlock( orBlockPtr( body ), bi );
-
                 if( orErrorThrown )
                     goto error;
-
-                str = orStringPtr( serN );          // Reacquire.
+                str = orStringPtr( serN );          // Reacquire.
                 send = str->used;
-                if( !orIfTrue(orRESULT)){
-                  strNCpy( keept + sdest, str->charArray + ssrc, (str->used - ssrc) );
-                  sdest += str->used - ssrc;
-                }               
-            }
-
-            orResultSTRING( serN );
-            str->used = sorig + sdest;
-            orRESULT->series.it = sorig;
-            strNCpy( str->charArray + sorig, keept, str->used );
-            free(keept);
+                if( ! orIfTrue(orTOS) )
+                {
+                    strNCpy( keept + sdest, str->charArray + ssrc,
+                             (str->used - ssrc) );
+                    sdest += str->used - ssrc;
+                }               
+            }
+
+            orResultSTRING( serN );
+            str->used = sorig + sdest;
+            a1->series.it = sorig;
+            strNCpy( str->charArray + sorig, keept, str->used );
+            free(keept);
         }
             break;
 
-    default:
-      orError("remove-each for this type not implemented");
-
-
-/*         case OT_LIST: */
-/*             if( a1->type == OT_BLOCK ) */
-/*             { */
-/*                 orError( "foreach block! list! not implemented" ); */
-/*                 break; */
-/*             } */
-
-/*             orResultNONE; */
-
-/*             if( a2->series.index ) */
-/*             { */
-/*                 OValue* begin; */
-/*                 OValue* it; */
-
-/*                 blk = orBLOCK(a2); */
-/*                 begin = blk->values; */
-/*                 it    = begin + a2->series.index; */
-
-/*                 while( it->LIST_NEXT > 0 ) */
-/*                 { */
-/*                     orCopyV( wval, it[1] ); */
-
-/*                     orEvalBlock( orBlockPtr( body ), bi ); */
-/*                     if( orErrorThrown ) */
-/*                         goto error; */
-
-/*                     //blk = orBlockPtr( serN );          // Reacquire. */
-/*                     //orListNextNode( blk, it ); */
-/*                     it = begin + it->LIST_NEXT; */
-/*                 } */
-/*             } */
-/*             break; */
+        default:
+            orError("remove-each for this type not implemented");
     }
 

trunk/orca/files.c

@@ -26 +26 @@
 extern int orIsDir( const char* path );
 extern int orFileModified( const char* path, OValue* res );
-extern void orReadDir( const char* filename );
+extern void orReadDir( OValue*, const char* filename );
 extern void orNowNative( OValue* a1 );
 extern void orChangeDirNative( OValue* a1 );
@@ -126 +126 @@
     OString* str = orSTRING(a1);
     orTermCStr( str );
-    status = orFileModified( str->charArray + a1->series.it, orRESULT );
+    status = orFileModified( str->charArray + a1->series.it, a1 );
     if( status < 0 )
     {
@@ -248 +248 @@
 #define REF_READ_SIZE       a1+6
 
+/*
+    read: native [
+        source [file! port!]
+        /binary
+        /lines
+        /skip length [number!]
+        /part size [number!]
+    ]
+*/
 OR_NATIVE( orReadNative )
 {
@@ -257 +266 @@
 
         orTermCStr( str );
-
         fn = str->charArray + a1->series.it;
+
         n = orIsDir( fn );
         if( n < 0 )
@@ -266 +275 @@
         else if( n == 1 )
         {
-            orReadDir( fn );
+            // TODO: Hold a1 from GC (or copy fn).
+            orReadDir( a1, fn );
         }
         else
@@ -361 +371 @@
 
         assert( (devID > -1) && (devID < arr->used) );
-        ((OPortDevice**) arr->buf)[ devID ]->read( &a1->ctx );
+        ((OPortDevice**) arr->buf)[ devID ]->read( &a1->ctx, a1 );
     }
 }

trunk/orca/gl/audio.c

@@ -157 +157 @@
             alGenBuffers( 1, &buffer );
             alBufferData( buffer, format, data, size, freq );
+            {
+            OValue* a1 = orTOS;
             orResult( OT_SOUND, buffer );
+            }
         }
         else

trunk/orca/gl/gx.c

@@ -480 +480 @@
         resd_add( &gEnv.resd, &tex->res, key );
 
-        result = orRESULT;
+        result = orTOS;
         orCopyV( result, *val );
         orLoadNative( result );

trunk/orca/gl/gx.h

@@ -147 +147 @@
 
 #define gxResultRES(rp) \
-   {OValue* _or_result = orRESULT; \
-    orSetTF(_or_result, OT_RESOURCE); \
-    _or_result->argc  = rp->res.resType; \
-    _or_result->index = rp->res.resKey;}
+   {orSetTF(a1, OT_RESOURCE); \
+    a1->argc  = rp->res.resType; \
+    a1->index = rp->res.resKey;}
 
 #define gxResType(val)  val->argc

trunk/orca/gl/joystick.c

@@ -132 +132 @@
   Set 'input block values.
 */
-static void jsRead( OContext* ctx )
+static void jsRead( OContext* ctx, OValue* a1 )
 {
     int events = 0;

trunk/orca/gl/main.c

@@ -56 +56 @@
     {
         OIndex strN;
+        OValue* tos;
 
+        tos = orTOS;
         strN = orMakeCString( argv[1], -1 );
-        orResultFILE( strN );
+        orSetTF(tos, OT_FILE );
+        orSetSeries(tos, strN, 0 );
 
-        orDoNative( orRESULT );
+        orDoNative( tos );
         if( orErrorThrown )
         {
@@ -123 +126 @@
                 {
                     OValue* val;
-                    val = orRESULT;
+                    val = orTOS;
                     if( (val->type != OT_UNSET) &&
                         (val->type != OT_OBJECT) &&

trunk/orca/gl/png_load.c

@@ -57 +57 @@
 
         bin = orMakeImage( format, width, height );
+        {
+        OValue* a1 = orTOS;
         orResult( OT_IMAGE, orBinaryN(bin) );
+        }
 
         if( bin->byteArray )

trunk/orca/internal.h

@@ -15 +15 @@
 
 
-#define orPushStack     ++orEnv->dataStack.used
-#define orPopStack      --orEnv->dataStack.used
+#define orStackGrow(n)      orEnv->dataStack.used += n
+#define orStackDrop(n)      orEnv->dataStack.used -= n
 
 #define OA_EXPAND1(type,arr,newptr) \

trunk/orca/math.c

@@ -170 +170 @@
 
 
-static void orOpPower( OValue* a )
+static void orOpPower( OValue* a1 )
 {
     double x, y;
-    OValue* b = a + 1;
-    if( a->type == OT_INTEGER )
+    OValue* b = a1 + 1;
+    if( a1->type == OT_INTEGER )
     {
         if( b->type == OT_INTEGER )
@@ -182 +182 @@
             if( n )
             {
-                sum = orInt(a);
+                sum = orInt(a1);
                 while( --n )
-                    sum *= orInt(a);
+                    sum *= orInt(a1);
             }
             else
@@ -195 +195 @@
         else if( b->type == OT_DECIMAL )
         {
-            x = (double) orInt(a);
+            x = (double) orInt(a1);
             y = orDecimal(b);
             goto fp;
         }
-        a = b;
-    }
-    else if( a->type == OT_DECIMAL )
-    {
-        x = orDecimal(a);
+        a1 = b;
+    }
+    else if( a1->type == OT_DECIMAL )
+    {
+        x = orDecimal(a1);
         if( b->type == OT_INTEGER )
         {
@@ -214 +214 @@
             goto fp;
         }
-        a = b;
-    }
-    orErrorOp( "**", a );
+        a1 = b;
+    }
+    orErrorOp( "**", a1 );
     return;
 
@@ -224 +224 @@
 
 
-static void orOpRemainder( OValue* a )
+static void orOpRemainder( OValue* a1 )
 {
     double x, y;
-    OValue* b = a + 1;
-    if( a->type == OT_INTEGER )
+    OValue* b = a1 + 1;
+    if( a1->type == OT_INTEGER )
     {
         if( b->type == OT_INTEGER )
         {
-            orResult( OT_INTEGER, orInt(a) % orInt(b) );
+            orResult( OT_INTEGER, orInt(a1) % orInt(b) );
             return;
         }
         else if( b->type == OT_DECIMAL )
         {
-            x = (double) orInt(a);
+            x = (double) orInt(a1);
             y = orDecimal(b);
             goto fp;
         }
-        a = b;
-    }
-    else if( a->type == OT_DECIMAL )
-    {
-        x = orDecimal(a);
+        a1 = b;
+    }
+    else if( a1->type == OT_DECIMAL )
+    {
+        x = orDecimal(a1);
         if( b->type == OT_INTEGER )
         {
@@ -256 +256 @@
             goto fp;
         }
-        a = b;
-    }
-    orErrorOp( "//", a );
+        a1 = b;
+    }
+    orErrorOp( "//", a1 );
     return;
 

trunk/orca/op.c

@@ -28 +28 @@
 
 
-void orOpAdd( OValue* a )
-{
-    OValue* b = a + 1;
-    if( orIs(a, OT_INTEGER) )
-    {
-        if( orIs(b, OT_INTEGER) )
-        {
-            orResult( OT_INTEGER, orInt(a) + orInt(b) );
-            return;
-        }
-        else if( orIs(b, OT_DECIMAL) )
-        {
-            orResultDECIMAL( (double) orInt(a) + orDecimal(b) );
+void orOpAdd( OValue* a1 )
+{
+    OValue* b = a1 + 1;
+    if( orIs(a1, OT_INTEGER) )
+    {
+        if( orIs(b, OT_INTEGER) )
+        {
+            orResult( OT_INTEGER, orInt(a1) + orInt(b) );
+            return;
+        }
+        else if( orIs(b, OT_DECIMAL) )
+        {
+            orResultDECIMAL( (double) orInt(a1) + orDecimal(b) );
             return;
         }
@@ -52 +52 @@
             for( i = 0; i < res->argc; i++ )
             {
-                tmp = orInt(a) + b->tuple[i];
+                tmp = orInt(a1) + b->tuple[i];
                 res->tuple[i] = orToByteRange(tmp);
             }   
@@ -59 +59 @@
             return;
         }
-        a = b;
-    }
-    else if( orIs(a, OT_DECIMAL) )