[GNU Smalltalk 3.0] testsuite: 117 failed

As you wish

_______________________________________________
help-smalltalk mailing list
[hidden email]
http://lists.gnu.org/mailman/listinfo/help-smalltalk

Benedikt Rosenau wrote:
> As you wish

Thanks.  Can you do an

   nm packages/tcp/.libs/tcp-3.0*

from the top of your build tree?

Also, is this a "make check" or "make installcheck"?

Paolo



_______________________________________________
help-smalltalk mailing list
[hidden email]
http://lists.gnu.org/mailman/listinfo/help-smalltalk

Hi,

I'm absolutely not sure that this patch will fix it, but it might.  I
don't see other places where there could be a GC bug.

Now, this is exactly the patch I *don't* want to put in a minor release.
  But this particular bug seems frequent, and a GC bug anyway has to be
fixed as soon as possible.

Thanks!

Paolo

diff --git a/libgst/prims.def b/libgst/prims.def
index 745d902..05ab2ce 100644
--- a/libgst/prims.def
+++ b/libgst/prims.def
@@ -2204,16 +2204,17 @@ primitive VMpr_CompiledCode_verificationResult [succeed]
 /* CompiledBlock numArgs:numTemps:bytecodes:depth:literals: */
 primitive VMpr_CompiledBlock_create [succeed]
 {
-  OOP *_gst_literals = OOP_TO_OBJ (POP_OOP ())->data;
-  int depth = TO_INT (POP_OOP ());
-  OOP bytecodesOOP = POP_OOP ();
-  int blockTemps = TO_INT (POP_OOP ());
-  int blockArgs = TO_INT (POP_OOP ());
+  OOP *_gst_literals = OOP_TO_OBJ (STACK_AT (0))->data;
+  int depth = TO_INT (STACK_AT (1));
+  OOP bytecodesOOP = STACK_AT (2);
+  int blockTemps = TO_INT (STACK_AT (3));
+  int blockArgs = TO_INT (STACK_AT (4));
   bc_vector bytecodes = _gst_extract_bytecodes (bytecodesOOP);
 
   OOP block =
     _gst_block_new (blockArgs, blockTemps, bytecodes, depth, _gst_literals);
 
+  POP_N_OOPS (5);
   OOP_CLASS(block) = STACKTOP ();
 
   _gst_primitives_executed++;
@@ -2236,12 +2237,11 @@ primitive VMpr_CompiledMethod_create [succeed,fail]
   if (primitive == -1)
     PRIM_FAILED;
 
-  POP_N_OOPS(6);
-
   method = _gst_make_new_method (primitive, methodArgs, methodTemps, depth,
          literals, bytecodes, _gst_nil_oop,
  _gst_nil_oop, _gst_nil_oop, -1, -1);
 
+  POP_N_OOPS(6);
   OOP_CLASS(method) = STACKTOP ();
 
   _gst_primitives_executed++;
@@ -3916,22 +3916,21 @@ primitive VMpr_CObject_allocType [succeed,fail]
   OOP oop3;
   _gst_primitives_executed++;
 
-  oop1 = POP_OOP ();
-  oop2 = POP_OOP ();
-  oop3 = STACKTOP ();
+  oop1 = STACK_AT (0);
+  oop2 = STACK_AT (1);
+  oop3 = STACK_AT (2);
   if (IS_INT (oop2)
       && (IS_NIL (oop1) || is_a_kind_of (OOP_CLASS (oop1), _gst_c_type_class))
       && COMMON (RECEIVER_IS_A_KIND_OF (oop3, _gst_c_object_class)))
     {
-      intptr_t arg2;
-      PTR ptr;
-      arg2 = TO_INT (oop2);
-      ptr = xmalloc (arg2);
+      intptr_t arg2 = TO_INT (oop2);
+      PTR ptr = xmalloc (arg2);
+      OOP cObjectOOP = _gst_c_object_new (ptr, oop1, oop3);
 
-      SET_STACKTOP (_gst_c_object_new (ptr, oop1, oop3));
+      POP_N_OOPS (2);
+      SET_STACKTOP (cObjectOOP);
       PRIM_SUCCEEDED;
     }
-  UNPOP (2);
   PRIM_FAILED;
 }
 
@@ -4752,62 +4751,63 @@ primitive VMpr_CString_replaceWith [succeed,fail]
 /* ByteArray class fromCdata: aCObject size: anInteger */
 primitive VMpr_ByteArray_fromCData_size [succeed,fail]
 {
-  OOP oop1;
   OOP oop2;
   OOP oop3;
   _gst_primitives_executed++;
 
-  oop3 = POP_OOP ();
-  oop2 = POP_OOP ();
-  oop1 = STACKTOP ();
-  if (IS_INT (oop3))
+  oop3 = STACK_AT (0);
+  oop2 = STACK_AT (1);
+  if (IS_INT (oop3)
+      && is_a_kind_of (OOP_CLASS (oop2), _gst_c_object_class))
     {
       intptr_t arg3 = TO_INT (oop3);
       OOP byteArrayOOP =
  _gst_byte_array_new (COBJECT_VALUE (oop2), arg3);
+      POP_N_OOPS (2);
       SET_STACKTOP (byteArrayOOP);
       PRIM_SUCCEEDED;
     }
-  UNPOP (2);
   PRIM_FAILED;
 }
 
 /* String class fromCdata: aCObject size: anInteger */
 primitive VMpr_String_fromCData_size [succeed,fail]
 {
-  OOP oop1;
   OOP oop2;
   OOP oop3;
   _gst_primitives_executed++;
 
-  oop3 = POP_OOP ();
-  oop2 = POP_OOP ();
-  oop1 = STACKTOP ();
-  if (IS_INT (oop3))
+  oop3 = STACK_AT (0);
+  oop2 = STACK_AT (1);
+  if (IS_INT (oop3)
+      && is_a_kind_of (OOP_CLASS (oop2), _gst_c_object_class))
     {
       intptr_t arg3 = TO_INT (oop3);
       OOP stringOOP =
  _gst_counted_string_new (COBJECT_VALUE (oop2), arg3);
+      POP_N_OOPS (2);
       SET_STACKTOP (stringOOP);
       PRIM_SUCCEEDED;
     }
-  UNPOP (2);
   PRIM_FAILED;
 }
 
 /* String class fromCdata: aCObject */
 primitive VMpr_String_fromCData [succeed]
 {
-  OOP oop1;
   OOP oop2;
   OOP stringOOP;
   _gst_primitives_executed++;
 
-  oop2 = POP_OOP ();
-  oop1 = STACKTOP ();
-  stringOOP = _gst_string_new (COBJECT_VALUE (oop2));
-  SET_STACKTOP (stringOOP);
-  PRIM_SUCCEEDED;
+  oop2 = STACKTOP ();
+  if (is_a_kind_of (OOP_CLASS (oop2), _gst_c_object_class))
+    {
+      stringOOP = _gst_string_new (COBJECT_VALUE (oop2));
+      POP_OOP ();
+      SET_STACKTOP (stringOOP);
+      PRIM_SUCCEEDED;
+    }
+  PRIM_FAILED;
 }
 
 /* String asCdata: aCType
@@ -4822,8 +4822,8 @@ primitive VMpr_String_ByteArray_asCData :
   OOP oop2;
   _gst_primitives_executed++;
 
-  oop2 = POP_OOP ();
-  oop1 = STACKTOP ();
+  oop2 = STACK_AT (0);
+  oop1 = STACK_AT (1);
 #ifndef OPTIMIZE
   if ((IS_CLASS (oop1, _gst_string_class)
        && id == prim_id (VMpr_String_asCData))
@@ -4838,6 +4838,7 @@ primitive VMpr_String_ByteArray_asCData :
   if (data)
     {
       memcpy (data, OOP_TO_OBJ (oop1)->data, size);
+      POP_OOP ();
       SET_STACKTOP (_gst_c_object_new (data, oop2, _gst_c_object_class));
       PRIM_SUCCEEDED;
     }
@@ -4845,7 +4846,6 @@ primitive VMpr_String_ByteArray_asCData :
 #ifndef OPTIMIZE
     }
 #endif
-  UNPOP (1);
   PRIM_FAILED;
 }
 
@@ -5032,16 +5032,14 @@ primitive VMpr_Behavior_primCompileIfError [fail,succeed,reload_ip]
     withArgs: argsArray */
 primitive VMpr_CFuncDescriptor_create [succeed,fail]
 {
-  OOP oop1;
   OOP oop2;
   OOP oop3;
   OOP oop4;
   _gst_primitives_executed++;
 
-  oop4 = POP_OOP ();
-  oop3 = POP_OOP ();
-  oop2 = POP_OOP ();
-  oop1 = POP_OOP ();
+  oop4 = STACK_AT (0);
+  oop3 = STACK_AT (1);
+  oop2 = STACK_AT (2);
 
   if (IS_CLASS (oop2, _gst_string_class)
       && (IS_CLASS (oop3, _gst_symbol_class)
@@ -5049,11 +5047,13 @@ primitive VMpr_CFuncDescriptor_create [succeed,fail]
       && (IS_CLASS (oop4, _gst_array_class)
   || IS_CLASS (oop4, _gst_undefined_object_class)))
     {
-      PUSH_OOP (_gst_make_descriptor (oop2, oop3, oop4));
+      OOP cFuncDescrOOP = _gst_make_descriptor (oop2, oop3, oop4);
+      POP_N_OOPS (3);
+      SET_STACKTOP (cFuncDescrOOP);
       PRIM_SUCCEEDED;
     }
-  UNPOP (4);
-  PRIM_FAILED;
+  else
+    PRIM_FAILED;
 }
 
 /* Object snapshot: aString */
@@ -5159,11 +5159,10 @@ primitive VMpr_FileDescriptor_fileOp [succeed,fail]
     oopVec[i] = POP_OOP ();
 
   oop1 = STACKTOP ();
+  UNPOP (numArgs);
+
   if (!IS_INT (oopVec[0]))
-    {
-      UNPOP (numArgs);
-      PRIM_FAILED;
-    }
+    PRIM_FAILED;
 
   arg1 = TO_INT (oopVec[0]);
   switch (arg1) {
@@ -5215,16 +5214,14 @@ primitive VMpr_FileDescriptor_fileOp [succeed,fail]
 
       xfree (fileName);
       if (fd < 0)
-        {
-  UNPOP (numArgs);
-  PRIM_FAILED;
-        }
+ PRIM_FAILED;
 
       _gst_set_file_stream_file (oop1, fd, oopVec[1],
          is_pipe, access, false);
-    }
 
-    PRIM_SUCCEEDED;
+      POP_N_OOPS (numArgs);
+      PRIM_SUCCEEDED;
+    }
 
   case PRIM_MK_TEMP:
     fileName = _gst_to_cstring (oopVec[1]);
@@ -5235,7 +5232,6 @@ primitive VMpr_FileDescriptor_fileOp [succeed,fail]
     if (fd < 0)
       {
         xfree (fileName2);
- UNPOP (numArgs);
  PRIM_FAILED;
       }
     
@@ -5248,10 +5244,7 @@ primitive VMpr_FileDescriptor_fileOp [succeed,fail]
 
   fileStream = (gst_file_stream) OOP_TO_OBJ (oop1);
   if (!IS_INT (fileStream->file))
-    {
-      UNPOP (numArgs);
-      PRIM_FAILED;
-    }
+    PRIM_FAILED;
 
   fd = TO_INT (fileStream->file);
   switch (arg1)
@@ -5269,7 +5262,10 @@ primitive VMpr_FileDescriptor_fileOp [succeed,fail]
   break;
  }
       else
- PRIM_SUCCEEDED;
+        {
+  POP_N_OOPS (numArgs);
+  PRIM_SUCCEEDED;
+ }
 
     case PRIM_FTELL: /* FileDescriptor position */
       {
@@ -5321,6 +5317,7 @@ primitive VMpr_FileDescriptor_fileOp [succeed,fail]
       result = _gst_write (fd, data + from - 1, to - from + 1);
       if (result >= 0)
  {
+  POP_N_OOPS (numArgs);
   SET_STACKTOP_INT (result);
   PRIM_SUCCEEDED;
  }
@@ -5347,6 +5344,7 @@ primitive VMpr_FileDescriptor_fileOp [succeed,fail]
 
       if (result >= 0)
  {
+  POP_N_OOPS (numArgs);
   SET_STACKTOP_INT (result);
   PRIM_SUCCEEDED;
  }
@@ -5387,6 +5385,7 @@ primitive VMpr_FileDescriptor_fileOp [succeed,fail]
 
       if (result >= 0)
  {
+  POP_N_OOPS (numArgs);
   SET_STACKTOP_INT (result);
   PRIM_SUCCEEDED;
  }
@@ -5427,6 +5426,7 @@ primitive VMpr_FileDescriptor_fileOp [succeed,fail]
 
       if (result >= 0)
  {
+  POP_N_OOPS (numArgs);
   SET_STACKTOP_INT (result);
   PRIM_SUCCEEDED;
  }
@@ -5442,6 +5442,7 @@ primitive VMpr_FileDescriptor_fileOp [succeed,fail]
   break;
 
  ftruncate (fd, pos);
+ POP_N_OOPS (numArgs);
  PRIM_SUCCEEDED;
       }
 
@@ -5450,7 +5451,10 @@ primitive VMpr_FileDescriptor_fileOp [succeed,fail]
   lseek (fd, TO_OFF_T (oopVec[1]), SEEK_CUR) < 0)
  break;
       else
- PRIM_SUCCEEDED;
+ {
+  POP_N_OOPS (numArgs);
+  PRIM_SUCCEEDED;
+ }
 
     case PRIM_SYNC_POLL:
       {
@@ -5459,6 +5463,7 @@ primitive VMpr_FileDescriptor_fileOp [succeed,fail]
  result = _gst_sync_file_polling (fd, TO_INT (oopVec[1]));
  if (result >= 0)
   {
+    POP_N_OOPS (numArgs);
     SET_STACKTOP_INT (result);
     PRIM_SUCCEEDED;
   }
@@ -5472,7 +5477,10 @@ primitive VMpr_FileDescriptor_fileOp [succeed,fail]
  result =
   _gst_async_file_polling (fd, TO_INT (oopVec[1]), oopVec[2]);
  if (result >= 0)
-  PRIM_SUCCEEDED;
+  {
+    POP_N_OOPS (numArgs);
+    PRIM_SUCCEEDED;
+  }
       }
       break;
 
@@ -5517,7 +5525,6 @@ primitive VMpr_FileDescriptor_fileOp [succeed,fail]
   if (errno)
     _gst_set_errno (errno);
 
-  UNPOP (numArgs);
   PRIM_FAILED;
 }
 
@@ -5538,20 +5545,16 @@ primitive VMpr_FileDescriptor_socketOp [succeed,fail]
   for (i = numArgs; --i >= 0;)
     oopVec[i] = POP_OOP ();
 
+  UNPOP (numArgs);
   oop1 = STACKTOP ();
   if (!IS_INT (oopVec[0]))
-    {
-      UNPOP (numArgs);
-      PRIM_FAILED;
-    }
+    PRIM_FAILED;
 
   arg1 = TO_INT (oopVec[0]);
   fileStream = (gst_file_stream) OOP_TO_OBJ (oop1);
   if (IS_NIL (fileStream->file))
-    {
-      UNPOP (numArgs);
-      PRIM_FAILED;
-    }
+    PRIM_FAILED;
+
   fd = TO_INT (fileStream->file);
   switch (arg1)
     {
@@ -5560,6 +5563,7 @@ primitive VMpr_FileDescriptor_socketOp [succeed,fail]
       {
         int result = closesocket (fd);
         SET_STACKTOP_INT (result);
+ POP_N_OOPS (numArgs);
         PRIM_SUCCEEDED;
       }
 
@@ -5580,6 +5584,7 @@ primitive VMpr_FileDescriptor_socketOp [succeed,fail]
  abort ();
       if (result >= 0)
  {
+  POP_N_OOPS (numArgs);
   SET_STACKTOP_INT (result);
   PRIM_SUCCEEDED;
  }
@@ -5614,6 +5619,7 @@ primitive VMpr_FileDescriptor_socketOp [succeed,fail]
 
       if (result >= 0)
  {
+  POP_N_OOPS (numArgs);
   SET_STACKTOP_INT (result);
   PRIM_SUCCEEDED;
  }
@@ -5628,6 +5634,7 @@ primitive VMpr_FileDescriptor_socketOp [succeed,fail]
  result = _gst_sync_file_polling (fd, TO_INT (oopVec[1]));
  if (result >= 0)
   {
+    POP_N_OOPS (numArgs);
     SET_STACKTOP_INT (result);
     PRIM_SUCCEEDED;
   }
@@ -5641,7 +5648,10 @@ primitive VMpr_FileDescriptor_socketOp [succeed,fail]
  result =
   _gst_async_file_polling (fd, TO_INT (oopVec[1]), oopVec[2]);
  if (result >= 0)
-  PRIM_SUCCEEDED;
+  {
+    POP_N_OOPS (numArgs);
+    PRIM_SUCCEEDED;
+  }
       }
       break;
 

_______________________________________________
help-smalltalk mailing list
[hidden email]
http://lists.gnu.org/mailman/listinfo/help-smalltalk

Paolo Bonzini wrote:
> Hi,
>
> I'm absolutely not sure that this patch will fix it, but it might.  I
> don't see other places where there could be a GC bug.
>
> Now, this is exactly the patch I *don't* want to put in a minor release.
>  But this particular bug seems frequent, and a GC bug anyway has to be
> fixed as soon as possible.

This is the same patch, with the difference that this one is finished
and works; I hoped to get a response overnight, but no problem.

Jochen, you may want to try this one too.

Paolo

2008-01-15  Paolo Bonzini  <[hidden email]>

        * libgst/prims.def: Do not pop arguments that end up in an
        object that the primitive creates.

 
diff --git a/libgst/prims.def b/libgst/prims.def
index a243af4..7d92e3d 100644
--- a/libgst/prims.def
+++ b/libgst/prims.def
@@ -2204,16 +2204,17 @@ primitive VMpr_CompiledCode_verificationResult [succeed]
 /* CompiledBlock numArgs:numTemps:bytecodes:depth:literals: */
 primitive VMpr_CompiledBlock_create [succeed]
 {
-  OOP *_gst_literals = OOP_TO_OBJ (POP_OOP ())->data;
-  int depth = TO_INT (POP_OOP ());
-  OOP bytecodesOOP = POP_OOP ();
-  int blockTemps = TO_INT (POP_OOP ());
-  int blockArgs = TO_INT (POP_OOP ());
+  OOP *_gst_literals = OOP_TO_OBJ (STACK_AT (0))->data;
+  int depth = TO_INT (STACK_AT (1));
+  OOP bytecodesOOP = STACK_AT (2);
+  int blockTemps = TO_INT (STACK_AT (3));
+  int blockArgs = TO_INT (STACK_AT (4));
   bc_vector bytecodes = _gst_extract_bytecodes (bytecodesOOP);
 
   OOP block =
     _gst_block_new (blockArgs, blockTemps, bytecodes, depth, _gst_literals);
 
+  POP_N_OOPS (5);
   OOP_CLASS(block) = STACKTOP ();
 
   _gst_primitives_executed++;
@@ -2236,12 +2237,11 @@ primitive VMpr_CompiledMethod_create [succeed,fail]
   if (primitive == -1)
     PRIM_FAILED;
 
-  POP_N_OOPS(6);
-
   method = _gst_make_new_method (primitive, methodArgs, methodTemps, depth,
          literals, bytecodes, _gst_nil_oop,
  _gst_nil_oop, _gst_nil_oop, -1, -1);
 
+  POP_N_OOPS(6);
   OOP_CLASS(method) = STACKTOP ();
 
   _gst_primitives_executed++;
@@ -3914,22 +3914,21 @@ primitive VMpr_CObject_allocType [succeed,fail]
   OOP oop3;
   _gst_primitives_executed++;
 
-  oop1 = POP_OOP ();
-  oop2 = POP_OOP ();
-  oop3 = STACKTOP ();
+  oop1 = STACK_AT (0);
+  oop2 = STACK_AT (1);
+  oop3 = STACK_AT (2);
   if (IS_INT (oop2)
       && (IS_NIL (oop1) || is_a_kind_of (OOP_CLASS (oop1), _gst_c_type_class))
       && COMMON (RECEIVER_IS_A_KIND_OF (oop3, _gst_c_object_class)))
     {
-      intptr_t arg2;
-      PTR ptr;
-      arg2 = TO_INT (oop2);
-      ptr = xmalloc (arg2);
+      intptr_t arg2 = TO_INT (oop2);
+      PTR ptr = xmalloc (arg2);
+      OOP cObjectOOP = _gst_c_object_new (ptr, oop1, oop3);
 
-      SET_STACKTOP (_gst_c_object_new (ptr, oop1, oop3));
+      POP_N_OOPS (2);
+      SET_STACKTOP (cObjectOOP);
       PRIM_SUCCEEDED;
     }
-  UNPOP (2);
   PRIM_FAILED;
 }
 
@@ -4814,36 +4813,25 @@ primitive VMpr_String_ByteArray_asCData :
      prim_id VMpr_String_asCData [checks_receiver],
      prim_id VMpr_ByteArray_asCData [checks_receiver]
 {
-  PTR data;
-  int size;
   OOP oop1;
   OOP oop2;
   _gst_primitives_executed++;
 
-  oop2 = POP_OOP ();
-  oop1 = STACKTOP ();
-#ifndef OPTIMIZE
-  if ((IS_CLASS (oop1, _gst_string_class)
-       && id == prim_id (VMpr_String_asCData))
-      || (IS_CLASS (oop1, _gst_byte_array_class)
-  && id == prim_id (VMpr_ByteArray_asCData)))
+  oop2 = STACK_AT (0);
+  oop1 = STACK_AT (1);
+  if (is_a_kind_of (OOP_CLASS (oop2), _gst_c_type_class))
     {
-#endif
-      if (is_a_kind_of (OOP_CLASS (oop2), _gst_c_type_class))
+      int size = NUM_INDEXABLE_FIELDS (oop1);
+      PTR data = xmalloc (size);
+      if (data)
  {
-  size = NUM_INDEXABLE_FIELDS (oop1);
-  data = xmalloc (size);
-  if (data)
-    {
-      memcpy (data, OOP_TO_OBJ (oop1)->data, size);
-      SET_STACKTOP (_gst_c_object_new (data, oop2, _gst_c_object_class));
-      PRIM_SUCCEEDED;
-    }
+  OOP cObjectOOP = _gst_c_object_new (data, oop2, _gst_c_object_class);
+  memcpy (data, OOP_TO_OBJ (oop1)->data, size);
+  POP_OOP ();
+  SET_STACKTOP (cObjectOOP);
+  PRIM_SUCCEEDED;
  }
-#ifndef OPTIMIZE
     }
-#endif
-  UNPOP (1);
   PRIM_FAILED;
 }
 
@@ -5036,10 +5024,9 @@ primitive VMpr_CFuncDescriptor_create [succeed,fail]
   OOP oop4;
   _gst_primitives_executed++;
 
-  oop4 = POP_OOP ();
-  oop3 = POP_OOP ();
-  oop2 = POP_OOP ();
-  oop1 = POP_OOP ();
+  oop4 = STACK_AT (0);
+  oop3 = STACK_AT (1);
+  oop2 = STACK_AT (2);
 
   if (IS_CLASS (oop2, _gst_string_class)
       && (IS_CLASS (oop3, _gst_symbol_class)
@@ -5047,11 +5034,13 @@ primitive VMpr_CFuncDescriptor_create [succeed,fail]
       && (IS_CLASS (oop4, _gst_array_class)
   || IS_CLASS (oop4, _gst_undefined_object_class)))
     {
-      PUSH_OOP (_gst_make_descriptor (oop2, oop3, oop4));
+      OOP cFuncDescrOOP = _gst_make_descriptor (oop2, oop3, oop4);
+      POP_N_OOPS (3);
+      SET_STACKTOP (cFuncDescrOOP);
       PRIM_SUCCEEDED;
     }
-  UNPOP (4);
-  PRIM_FAILED;
+  else
+    PRIM_FAILED;
 }
 
 /* Object snapshot: aString */
@@ -5150,18 +5139,18 @@ primitive VMpr_FileDescriptor_fileOp [succeed,fail]
   OOP *oopVec = alloca (numArgs * sizeof (OOP));
   int i;
   intptr_t arg1;
+  OOP resultOOP;
 
   _gst_primitives_executed++;
 
   for (i = numArgs; --i >= 0;)
     oopVec[i] = POP_OOP ();
 
-  oop1 = STACKTOP ();
+  resultOOP = oop1 = STACKTOP ();
+  UNPOP (numArgs);
+
   if (!IS_INT (oopVec[0]))
-    {
-      UNPOP (numArgs);
-      PRIM_FAILED;
-    }
+    goto fail;
 
   arg1 = TO_INT (oopVec[0]);
   switch (arg1) {
@@ -5213,16 +5202,13 @@ primitive VMpr_FileDescriptor_fileOp [succeed,fail]
 
       xfree (fileName);
       if (fd < 0)
-        {
-  UNPOP (numArgs);
-  PRIM_FAILED;
-        }
+ goto fail;
 
       _gst_set_file_stream_file (oop1, fd, oopVec[1],
          is_pipe, access, false);
-    }
 
-    PRIM_SUCCEEDED;
+      goto succeed;
+    }
 
   case PRIM_MK_TEMP:
     fileName = _gst_to_cstring (oopVec[1]);
@@ -5233,31 +5219,27 @@ primitive VMpr_FileDescriptor_fileOp [succeed,fail]
     if (fd < 0)
       {
         xfree (fileName2);
- UNPOP (numArgs);
- PRIM_FAILED;
+ goto fail;
       }
     
     _gst_set_file_stream_file (oop1, fd, _gst_string_new (fileName2),
        false, O_RDWR, false);
 
     xfree (fileName2);
-    PRIM_SUCCEEDED;
+    goto succeed;
   }
 
   fileStream = (gst_file_stream) OOP_TO_OBJ (oop1);
   if (!IS_INT (fileStream->file))
-    {
-      UNPOP (numArgs);
-      PRIM_FAILED;
-    }
+    goto fail;
 
   fd = TO_INT (fileStream->file);
   switch (arg1)
     {
 
     case PRIM_CLOSE_FILE: /* FileDescriptor close */
-      SET_STACKTOP_INT (close (fd));
-      PRIM_SUCCEEDED;
+      resultOOP = FROM_INT (close (fd));
+      goto succeed;
 
     case PRIM_FSEEK_SET: /* FileDescriptor position: position */
       if (IS_OFF_T (oopVec[1]) &&
@@ -5267,7 +5249,7 @@ primitive VMpr_FileDescriptor_fileOp [succeed,fail]
   break;
  }
       else
- PRIM_SUCCEEDED;
+        goto succeed;
 
     case PRIM_FTELL: /* FileDescriptor position */
       {
@@ -5278,19 +5260,24 @@ primitive VMpr_FileDescriptor_fileOp [succeed,fail]
     break;
   }
 
- SET_STACKTOP (FROM_OFF_T (off));
- PRIM_SUCCEEDED;
+ resultOOP = FROM_OFF_T (off);
+ goto succeed;
       }
 
     case PRIM_FEOF:
       { /* FileDescriptor atEnd */
  off_t oldPos;
  oldPos = lseek (fd, 0, SEEK_CUR);
- SET_STACKTOP_BOOLEAN (oldPos >= 0
-      && lseek (fd, 0, SEEK_END) == oldPos);
- lseek (fd, oldPos, SEEK_SET);
+ if (oldPos >= 0 && lseek (fd, 0, SEEK_END) == oldPos)
+  resultOOP = _gst_true_oop;
+ else
+  {
+    resultOOP = _gst_false_oop;
+    if (oldPos >= 0)
+      lseek (fd, oldPos, SEEK_SET);
+  }
  errno = 0;
- PRIM_SUCCEEDED;
+ goto succeed;
       }
 
     case PRIM_FSIZE:
@@ -5301,8 +5288,8 @@ primitive VMpr_FileDescriptor_fileOp [succeed,fail]
     errno = 0;
     break;
   }
- SET_STACKTOP_INT (statBuf.st_size);
- PRIM_SUCCEEDED;
+ resultOOP = FROM_INT (statBuf.st_size);
+ goto succeed;
       }
 
     case PRIM_PUT_CHARS:
@@ -5319,8 +5306,8 @@ primitive VMpr_FileDescriptor_fileOp [succeed,fail]
       result = _gst_write (fd, data + from - 1, to - from + 1);
       if (result >= 0)
  {
-  SET_STACKTOP_INT (result);
-  PRIM_SUCCEEDED;
+  resultOOP = FROM_INT (result);
+  goto succeed;
  }
     }
  }
@@ -5345,8 +5332,8 @@ primitive VMpr_FileDescriptor_fileOp [succeed,fail]
 
       if (result >= 0)
  {
-  SET_STACKTOP_INT (result);
-  PRIM_SUCCEEDED;
+  resultOOP = FROM_INT (result);
+  goto succeed;
  }
     }
  }
@@ -5385,8 +5372,8 @@ primitive VMpr_FileDescriptor_fileOp [succeed,fail]
 
       if (result >= 0)
  {
-  SET_STACKTOP_INT (result);
-  PRIM_SUCCEEDED;
+  resultOOP = FROM_INT (result);
+  goto succeed;
  }
     }
  }
@@ -5425,8 +5412,8 @@ primitive VMpr_FileDescriptor_fileOp [succeed,fail]
 
       if (result >= 0)
  {
-  SET_STACKTOP_INT (result);
-  PRIM_SUCCEEDED;
+  resultOOP = FROM_INT (result);
+  goto succeed;
  }
     }
  }
@@ -5440,7 +5427,7 @@ primitive VMpr_FileDescriptor_fileOp [succeed,fail]
   break;
 
  ftruncate (fd, pos);
- PRIM_SUCCEEDED;
+ goto succeed;
       }
 
     case PRIM_FSEEK_CUR: /* FileDescriptor skip: */
@@ -5448,7 +5435,7 @@ primitive VMpr_FileDescriptor_fileOp [succeed,fail]
   lseek (fd, TO_OFF_T (oopVec[1]), SEEK_CUR) < 0)
  break;
       else
- PRIM_SUCCEEDED;
+ goto succeed;
 
     case PRIM_SYNC_POLL:
       {
@@ -5457,8 +5444,8 @@ primitive VMpr_FileDescriptor_fileOp [succeed,fail]
  result = _gst_sync_file_polling (fd, TO_INT (oopVec[1]));
  if (result >= 0)
   {
-    SET_STACKTOP_INT (result);
-    PRIM_SUCCEEDED;
+    resultOOP = FROM_INT (result);
+    goto succeed;
   }
       }
       break;
@@ -5470,7 +5457,7 @@ primitive VMpr_FileDescriptor_fileOp [succeed,fail]
  result =
   _gst_async_file_polling (fd, TO_INT (oopVec[1]), oopVec[2]);
  if (result >= 0)
-  PRIM_SUCCEEDED;
+  goto succeed;
       }
       break;
 
@@ -5479,25 +5466,21 @@ primitive VMpr_FileDescriptor_fileOp [succeed,fail]
  off_t result;
 
  result = lseek (fd, 0, SEEK_END);
- if (result == -1)
+ if (result != -1)
   {
-    if (errno == ESPIPE || errno == EINVAL)
-      {
- SET_STACKTOP (_gst_true_oop);
- errno = 0;
-      }
-    else
-      PRIM_FAILED;
+    lseek (fd, result, SEEK_SET);
+    resultOOP = _gst_false_oop;
+    goto succeed;
   }
- else
+ else if (errno == ESPIPE || errno == EINVAL)
   {
-    lseek (fd, result, SEEK_SET);
-    SET_STACKTOP (_gst_false_oop);
+    resultOOP = _gst_true_oop;
+    errno = 0;
+    goto succeed;
   }
 
- PRIM_SUCCEEDED;
+ goto fail;
       }
-      break;
 
     case PRIM_SHUTDOWN_WRITE:
       shutdown (fd, 1);
@@ -5509,14 +5492,19 @@ primitive VMpr_FileDescriptor_fileOp [succeed,fail]
   errno = 0;
  }
 #endif
-      break;
+      goto succeed;
     }
 
+ fail:
   if (errno)
     _gst_set_errno (errno);
 
-  UNPOP (numArgs);
   PRIM_FAILED;
+
+ succeed:
+  POP_N_OOPS (numArgs);
+  SET_STACKTOP (resultOOP);
+  PRIM_SUCCEEDED;
 }
 
 /* FileDescriptor>>#socketOp..., socket version, variadic */
@@ -5525,7 +5513,7 @@ primitive VMpr_FileDescriptor_socketOp [succeed,fail]
 {
   gst_file_stream fileStream;
   int fd;
-  OOP oop1;
+  OOP oop1, resultOOP;
   OOP *oopVec = alloca (numArgs * sizeof (OOP));
   int i;
   intptr_t arg1;
@@ -5536,20 +5524,16 @@ primitive VMpr_FileDescriptor_socketOp [succeed,fail]
   for (i = numArgs; --i >= 0;)
     oopVec[i] = POP_OOP ();
 
-  oop1 = STACKTOP ();
+  resultOOP = oop1 = STACKTOP ();
+  UNPOP (numArgs);
   if (!IS_INT (oopVec[0]))
-    {
-      UNPOP (numArgs);
-      PRIM_FAILED;
-    }
+    goto fail;
 
   arg1 = TO_INT (oopVec[0]);
   fileStream = (gst_file_stream) OOP_TO_OBJ (oop1);
   if (IS_NIL (fileStream->file))
-    {
-      UNPOP (numArgs);
-      PRIM_FAILED;
-    }
+    goto fail;
+
   fd = TO_INT (fileStream->file);
   switch (arg1)
     {
@@ -5557,8 +5541,8 @@ primitive VMpr_FileDescriptor_socketOp [succeed,fail]
     case PRIM_CLOSE_FILE: /* FileDescriptor close */
       {
         int result = closesocket (fd);
-        SET_STACKTOP_INT (result);
-        PRIM_SUCCEEDED;
+        resultOOP = FROM_INT (result);
+        goto succeed;
       }
 
     case PRIM_PUT_CHARS:
@@ -5578,8 +5562,8 @@ primitive VMpr_FileDescriptor_socketOp [succeed,fail]
  abort ();
       if (result >= 0)
  {
-  SET_STACKTOP_INT (result);
-  PRIM_SUCCEEDED;
+  resultOOP = FROM_INT (result);
+  goto succeed;
  }
     }
  }
@@ -5612,8 +5596,8 @@ primitive VMpr_FileDescriptor_socketOp [succeed,fail]
 
       if (result >= 0)
  {
-  SET_STACKTOP_INT (result);
-  PRIM_SUCCEEDED;
+  resultOOP = FROM_INT (result);
+  goto succeed;
  }
     }
  }
@@ -5626,8 +5610,8 @@ primitive VMpr_FileDescriptor_socketOp [succeed,fail]
  result = _gst_sync_file_polling (fd, TO_INT (oopVec[1]));
  if (result >= 0)
   {
-    SET_STACKTOP_INT (result);
-    PRIM_SUCCEEDED;
+    resultOOP = FROM_INT (result);
+    goto succeed;
   }
       }
       break;
@@ -5639,22 +5623,25 @@ primitive VMpr_FileDescriptor_socketOp [succeed,fail]
  result =
   _gst_async_file_polling (fd, TO_INT (oopVec[1]), oopVec[2]);
  if (result >= 0)
-  PRIM_SUCCEEDED;
+  goto succeed;
       }
       break;
 
     case PRIM_IS_PIPE:
-      {
- SET_STACKTOP (_gst_true_oop);
- PRIM_SUCCEEDED;
-      }
+      resultOOP =_gst_true_oop;
+      goto succeed;
       break;
     }
 
-  UNPOP (numArgs);
 #endif
 
+ fail:
   PRIM_FAILED;
+
+ succeed:
+  POP_N_OOPS (numArgs);
+  SET_STACKTOP (resultOOP);
+  PRIM_SUCCEEDED;
 }
 
 /* C callout primitives.  */

_______________________________________________
help-smalltalk mailing list
[hidden email]
http://lists.gnu.org/mailman/listinfo/help-smalltalk