Changeset 76 for trunk/orca

Timestamp:

03/08/06 14:57:20 (3 years ago)

Author:

volker

Message:

remove-each added

Files:

• trunk/orca/context.c (modified) (1 diff)

trunk/orca/context.c

@@ -1206 +1206 @@
 
 
+/*
+   'variables   [word! block!]
+   series       [series!]
+   body         [block!]
+*/
+//see orForeachNative
+
+void orRemoveEachNative( OValue* a1 )
+{
+    int rlen;
+    int vlen;
+    OBlock* blk;
+    OValue* wval;
+    OContext ctx;
+    OValue* a2 = a1 + 1;
+    OIndex serN = a2->index;
+    OIndex si   = a2->series.it;
+    //:
+    OIndex sdest = 0;//in second buffer
+    OIndex sorig = si; 
+    OIndex ssrc;
+
+    OIndex send;
+    OIndex body = (a1 + 2)->index;
+    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( 4 )
+
+    // Must hold body & a2 in case orMakeContext() or orCopyBlock() trigger
+    // recycle.
+    orRefPush( OT_BLOCK, body );
+    orRefPush( a2->type, a2->index );
+
+    if( a1->type == OT_BLOCK )
+    {
+        OValue* it;
+        OValue* end;
+
+        blk = orBLOCK(a1);
+
+        orRefPush( OT_BLOCK, a1->index );
+        orMakeContext( &ctx, blk->used - a1->series.it );
+        orRefPop( 1 );
+
+        it  = blk->values + a1->series.it;
+        end = blk->values + blk->used;
+
+        blk = orBlockPtr( ctx.wblkN );
+        while( it != end )
+        {
+            if( it->type == OT_WORD )
+            {
+                orInternA( blk, it->word.atom );
+            }
+            else
+            {
+                orError( "Invalid foreach argument" );
+                orRefPop( 2 );
+                return;
+            }
+            ++it;
+        }
+
+    }
+    else
+    {
+        orMakeContext( &ctx, 1 );
+        orInternA( orBlockPtr( ctx.wblkN ), a1->word.atom );
+    }
+
+    orRefPush( OT_BLOCK, ctx.wblkN );
+    orRefPush( OT_BLOCK, ctx.vblkN );
+
+    blk = orBlockPtr( ctx.vblkN );
+    wval = blk->values;
+    vlen = blk->avail;
+
+    blk = orCopyBlock( body, bi, 1 );
+    body = orBlockN( blk );
+    bi   = 0;
+    orBind( blk, &ctx );
+
+    //
+    // the real loop
+    //
+
+    switch( a2->type )
+    {
+        case OT_BLOCK:
+        case OT_PAREN:
+        case OT_PATH:
+        {
+            blk = orBlockPtr( serN );
+            OValue *keept = calloc(blk->used,sizeof(OValue));
+            send = blk->used;
+
+            if( vlen > 1 )
+                send -= vlen - 1;
+
+            while( si < send )
+            {
+                memCpy( wval, blk->values + si, vlen * sizeof(OValue) );
+
+                //:
+                orEvalBlock( orBlockPtr( body ), bi );
+                if( orErrorThrown )
+                    goto error;
+                blk = orBlockPtr( serN );          // Reacquire.
+                //:
+                if( !orIfTrue(orRESULT)){
+                  memCpy( keept + sdest, blk->values + si, vlen * sizeof(OValue) );
+                  sdest += vlen;
+                }
+                si += vlen; //:moved
+            }
+
+            //handle rest, if less values then loopvars
+
+            if( si < blk->used )
+            {
+                rlen = blk->used - si;
+
+                memCpy( wval, blk->values + si, rlen * sizeof(OValue) );
+                wval += rlen;
+
+                while( rlen < vlen )
+                {
+                    orSetTF( wval, OT_NONE );
+                    ++wval;
+                    ++rlen;
+                }
+
+                orEvalBlock( orBlockPtr( body ), bi );
+                if( orErrorThrown )
+                    goto error;
+                //:
+                blk = orBlockPtr( serN );          // Reacquire.
+                if( !orIfTrue(orRESULT)){
+                  memCpy( keept + sdest, blk->values + si, (blk->used - si) * sizeof(OValue) );
+                  sdest += blk->used - si;
+                }               
+            }
+
+            //: return block        
+            orResultBLOCK( serN );
+            blk->used = sorig + sdest;
+            orRESULT->series.it = sorig;
+            memCpy( blk->values + sorig, keept, sdest * sizeof(OValue));
+            free(keept);
+        }
+        break;
+
+        case OT_STRING:
+        case OT_FILE:
+        case OT_ISSUE:
+        case OT_TAG:
+        {
+            OString* str = orStringPtr( serN );
+            char *keept = malloc(str->used);
+            send = str->used;
+
+            orSetTF( wval, OT_CHAR );
+
+            if( vlen > 1 )
+            {
+                send -= vlen - 1;
+
+                for( rlen = 1; rlen < vlen; ++rlen )
+                    orSetTF( (wval + rlen), OT_CHAR );
+            }
+
+            while( si < send )
+            {
+              ssrc = si;
+                for( rlen = 0; rlen < vlen; ++rlen )
+                    (wval + rlen)->integer = str->charArray[ si++ ];
+
+                orEvalBlock( orBlockPtr( body ), bi );
+                if( orErrorThrown )
+                    goto error;
+                str = orStringPtr( serN );     // Reacquire.
+                //:
+                if( !orIfTrue(orRESULT)){
+                  strNCpy( keept + sdest, str->charArray + ssrc, vlen );
+                  sdest += vlen;
+                }
+            }
+
+            if( si < str->used )
+            {
+                rlen = str->used - si;
+              ssrc = si;
+
+                while( si < str->used )
+                {
+                    wval->integer = str->charArray[ si++ ];
+                    ++wval;
+                }
+
+                while( rlen < vlen )
+                {
+                    orSetTF( wval, OT_NONE );
+                    ++wval;
+                    ++rlen;
+                }
+
+                orEvalBlock( orBlockPtr( body ), bi );
+                if( orErrorThrown )
+                    goto error;
+                //:
+                str = orStringPtr( serN );          // Reacquire.
+                if( !orIfTrue(orRESULT)){
+                  strNCpy( keept + sdest, str->charArray + ssrc, (str->used - ssrc) );
+                  sdest += str->used - ssrc;
+                }               
+            }
+            //: return string
+            orResultSTRING( serN );
+            str->used = sorig + sdest;
+            orRESULT->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; */
+    }
+
+free_private:
+
+    orFreeBlock( body );
+    orFreeBlock( ctx.wblkN );
+    orFreeBlock( ctx.vblkN );
+    goto pop;
+
+error:
+
+    if( orErrorIsType(OR_ERROR_BREAK) )
+    {
+        orErrorClear;
+        orSetTF( a1, OT_UNSET );
+        goto free_private;
+    }
+
+    // Cannot free body block if error is thrown and orError->block == body.
+
+pop:
+
+    orRefPop( 4 );
+}
+
 /*EOF*/