[Help-smalltalk] Re: GTK bug?

[Paolo Bonzini]

Paolo Bonzini wrote:
> > I've problems with loading GTK. Every time I tried to
> > load GTK, (1) I got errors (at the end mail) when compiling
> > some classes. However, simple GTK programs works fine
> > for serveral minutes - (2) after that, everything freezes
> > and gst starts to consume 100% CPU. Do you have same
> > problems or it is just problem of my machine?
>
> (1) should be fixed by this patch.

Which patch?  This one.

There are multiple problems:

1) after the recent round of CObject/CType changes, CObject has a 
class-instance variable and so does CStruct (which has a total of two). 
 When loading GTK, some classes are initially born as subclasses of 
CObject and then changed to subclasses of CStruct.  The class object was 
not mutated, so that accessing the class-instance variable added by 
CStruct went out of bounds; actually it accessed the size field of the 
immediately neighboring object, so it was not nil and gave an error.

Since I was at it, I modified CStruct to use lazy initialization, so 
that creating a CStruct with an empty field list and then adding some 
fields is not a problem.

2) there was a minor GC problem in the compiler which, luckily, caused 
damage immediately and not some time later.  This means it was fast to 
debug.  One argument in the C function declaration was sometimes stored 
in the wrong place, and `nil' would remain in the "right place".  The 
primitive would fail when asked for the address of function `nil'.

Paolo

2007-09-17  Paolo Bonzini  <address@hidden>

        * kernel/CStruct.st: Use lazy initialization for declaration.  Allow
        replacing an empty declaration.
        * kernel/Metaclass.st: Mutate the class object if the list of class-
        instance variables changes.

        * libgst/comp.c: Fix GC problem with attributes.

M  kernel/CStruct.st
M  kernel/Metaclass.st
M  libgst/comp.c

* modified files

--- orig/kernel/CStruct.st
+++ mod/kernel/CStruct.st
@@ -122,6 +122,7 @@ subclass: structName declaration: array
 
 declaration
     "Return the description of the fields in the receiver class."
+    declaration isNil ifTrue: [ declaration := #() ].
     ^declaration
 !
 
@@ -135,7 +136,7 @@ declaration: array inject: startOffset i
      old offset plus the new field's size is passed to aBlock,
      together with the new field's alignment requirements."
     | offset maxAlignment inspStr |
-    (declaration notNil and: [ declaration ~= array ])
+    (self declaration notEmpty and: [ self declaration ~= array ])
        ifTrue: [ self error: 'cannot redefine CStruct/CUnion' ].
 
     declaration := array.


--- orig/kernel/Metaclass.st
+++ mod/kernel/Metaclass.st
@@ -304,24 +304,32 @@ name: className
                    shape: realShape
            ].
 
+    "Now add/remove pool dictionaries.  FIXME: They may affect name binding,
+     so we should probably recompile everything if they change."
     aClass sharedPoolDictionaries isNil 
-       ifTrue: [ aClass setSharedPools: sharedPoolNames ]
+       ifTrue: [
+           aClass setSharedPools: sharedPoolNames ]
        ifFalse: [
            sharedPoolNames do: [ :dict |
-               (aClass sharedPoolDictionaries includes: dict)
-                   ifFalse: [ aClass addSharedPool: dict ]
-           ].
+               (aClass sharedPoolDictionaries includes: dict) ifFalse: [
+                   aClass addSharedPool: dict ] ].
 
            aClass sharedPoolDictionaries copy do: [ :dict |
-               (sharedPoolNames includes: dict)
-                   ifFalse: [
+               (sharedPoolNames includes: dict) ifFalse: [
                        aClass removeSharedPool: dict.
-                       needToRecompileMetaclasses := true
-                   ]
-           ]
+                       needToRecompileMetaclasses := true ] ]
        ].
 
     (aClass superclass ~~ superclass) ifTrue: [
+       "Mutate the class if the set of class-instance variables changes."
+       (self superclass allInstVarNames ~= superclass class allInstVarNames)
+           ifTrue: [
+               aClass class
+                   updateInstanceVars:
+                       superclass class allInstVarNames,
+                       aClass class instVarNames
+                   shape: aClass class shape ].
+
        "Fix references between classes..."
        aClass superclass removeSubclass: aClass.
        superclass addSubclass: aClass.
@@ -333,6 +341,7 @@ name: className
        superclass class addSubclass: self.
        self superclass: superclass class.
        needToRecompileMetaclasses := true.
+
     ].
 
     aClass category: categoryName.
@@ -477,7 +486,6 @@ growClassInstance
     | newClass numInstVars |
     newClass := self new.
     numInstVars := self instSize.
-    numInstVars printNl.
     1 to: numInstVars - 1 do:
        [ :i | newClass instVarAt: i put: 
                   (instanceClass instVarAt: i) ].


--- orig/libgst/comp.c
+++ mod/libgst/comp.c
@@ -2372,20 +2372,21 @@ _gst_make_attribute (tree_node attribute
        i++, keyword = keyword->v_list.next)
     {
       tree_node value = keyword->v_list.value;
+      OOP result;
       if (value->nodeType != TREE_CONST_EXPR)
        {
-          OOP result = _gst_execute_statements (NULL, value, UNDECLARED_NONE,
-                                               true);
-          value = _gst_make_oop_constant (&value->location, result);
+          result = _gst_execute_statements (NULL, value, UNDECLARED_NONE, 
true);
           if (!result)
            {
              _gst_had_error = true;
              return _gst_nil_oop;
            }
        }
+      else
+       result = _gst_make_constant_oop (value);
 
       argsArray = OOP_TO_OBJ (argsArrayOOP);
-      argsArray->data[i] = _gst_make_constant_oop (value);
+      argsArray->data[i] = result;
     }
 
   messageOOP = _gst_message_new_args (selectorOOP, argsArrayOOP);