Changeset 144 for trunk/orca/context.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/context.c (modified) (14 diffs)

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");
     }