The mini image of the week wouldn't allow me to accept a new class. Below is a fileOut of changes made by filing in methods from the full 2.2 image.
The fileIn increased the image size from 565K to 636K. It isn't as tight as it could be, because sometimes I filed in whole protocols. I also haven't gone through the roll-your-own scripts to find out where these messages are removed.
Hope this helps!
--Dave ---- 'From Squeak 2.2 of Sept 23, 1998 on 29 September 1998 at 11:13:30 am'!
!Class methodsFor: 'subclass creation' stamp: 'sw 5/19/1998 09:07'! newSubclass | i className | i _ 1. [className _ (self name , i printString) asSymbol. Smalltalk includesKey: className] whileTrue: [i _ i + 1].
^ self subclass: className instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'UserObjects'
"Point newSubclass new"! !
!Class methodsFor: 'subclass creation'! subclass: t instanceVariableNames: f classVariableNames: d poolDictionaries: s category: cat "This is the standard initialization message for creating a new class as a subclass of an existing class (the receiver)."
self isVariable ifTrue: [self isPointers ifTrue: [^self variableSubclass: t instanceVariableNames: f classVariableNames: d poolDictionaries: s category: cat]. self isBytes ifTrue: [^self variableByteSubclass: t instanceVariableNames: f classVariableNames: d poolDictionaries: s category: cat]. ^self variableWordSubclass: t instanceVariableNames: f classVariableNames: d poolDictionaries: s category: cat]. ^self class name: t inEnvironment: Smalltalk subclassOf: self instanceVariableNames: f variable: false words: true pointers: true classVariableNames: d poolDictionaries: s category: cat comment: nil changed: false! !
!Class methodsFor: 'subclass creation'! variableByteSubclass: t instanceVariableNames: f classVariableNames: d poolDictionaries: s category: cat "This is the standard initialization message for creating a new class as a subclass of an existing class (the receiver) in which the subclass is to have indexable byte-sized nonpointer variables."
self instSize > 0 ifTrue: [^self error: 'cannot make a byte subclass of a class with named fields']. (self isVariable and: [self isWords]) ifTrue: [^self error: 'cannot make a byte subclass of a class with word fields']. (self isVariable and: [self isPointers]) ifTrue: [^self error: 'cannot make a byte subclass of a class with pointer fields']. ^self class name: t inEnvironment: Smalltalk subclassOf: self instanceVariableNames: f variable: true words: false pointers: false classVariableNames: d poolDictionaries: s category: cat comment: nil changed: false! !
!Class methodsFor: 'subclass creation'! variableSubclass: t instanceVariableNames: f classVariableNames: d poolDictionaries: s category: cat "This is the standard initialization message for creating a new class as a subclass of an existing class (the receiver) in which the subclass is to have indexable pointer variables."
self isBits ifTrue: [^self error: 'cannot make a pointer subclass of a class with non-pointer fields']. ^self class name: t inEnvironment: Smalltalk subclassOf: self instanceVariableNames: f variable: true words: true pointers: true classVariableNames: d poolDictionaries: s category: cat comment: nil changed: false! !
!Class methodsFor: 'subclass creation'! variableWordSubclass: t instanceVariableNames: f classVariableNames: d poolDictionaries: s category: cat "This is the standard initialization message for creating a new class as a subclass of an existing class (the receiver) in which the subclass is to have indexable word-sized nonpointer variables."
self instSize > 0 ifTrue: [^self error: 'cannot make a word subclass of a class with named fields']. self isBytes ifTrue: [^self error: 'cannot make a word subclass of a class with byte fields']. (self isVariable and: [self isPointers]) ifTrue: [^self error: 'cannot make a word subclass of a class with pointer fields']. ^self class name: t inEnvironment: Smalltalk subclassOf: self instanceVariableNames: f variable: true words: true pointers: false classVariableNames: d poolDictionaries: s category: cat comment: nil changed: false! !
'From Squeak 2.2 of Sept 23, 1998 on 29 September 1998 at 11:16:29 am'!
!Metaclass methodsFor: 'class hierarchy' stamp: 'tk 8/22/1998 10:46'! name: newName inEnvironment: environ subclassOf: sup instanceVariableNames: instVarString variable: v words: w pointers: p classVariableNames: classVarString poolDictionaries: poolString category: categoryName comment: commentString changed: changed "This is the standard initialization message for creating a new Metaclass. Answer an instance of me from the information provided in the arguments. Create an error notification if the name does not begin with an uppercase letter or if a class of the same name already exists. 1/22/96 sw: don't ever do addClass, always do changeClass"
| wasPresent oldClass newClass invalidFields invalidMethods | newName first isUppercase ifFalse: [self error: 'Class names must be capitalized'. ^false]. (wasPresent _ environ includesKey: newName) ifTrue: [oldClass _ environ at: newName. (oldClass isKindOf: Behavior) ifFalse: [self error: newName , ' already exists!! Proceed will store over it'. wasPresent _ false. oldClass _ self newNamed: newName]] ifFalse: [oldClass _ self newNamed: newName. Smalltalk flushClassNameCache]. newClass _ oldClass copy. invalidFields _ changed | (newClass subclassOf: sup oldClass: oldClass instanceVariableNames: instVarString variable: v words: w pointers: p ifBad: [^false]). invalidFields not & (oldClass instSize = newClass instSize) ifTrue: [newClass _ oldClass]. invalidMethods _ invalidFields | (newClass declare: classVarString) | (newClass sharing: poolString). commentString == nil ifFalse: [newClass comment: commentString]. (environ includesKey: newName) ifFalse: [environ declare: newName from: Undeclared]. environ at: newName put: newClass. SystemOrganization classify: newClass name under: categoryName asSymbol. newClass validateFrom: oldClass in: environ instanceVariableNames: invalidFields methods: invalidMethods wasPresent: wasPresent. "update subclass lists" newClass superclass removeSubclass: oldClass. newClass superclass addSubclass: newClass. "Update Changes" Smalltalk changes changeClass: newClass. ^ newClass! !
'From Squeak 2.2 of Sept 23, 1998 on 29 September 1998 at 11:18:12 am'!
!Metaclass methodsFor: 'initialize-release'! newNamed: aSymbol "Answer an instance of me whose name is the argument, aSymbol."
^(self class subclassOf: self) new superclass: Object methodDict: MethodDictionary new format: Object format name: aSymbol organization: (ClassOrganizer defaultList: Array new) instVarNames: nil classPool: nil sharedPools: nil! !
'From Squeak 2.2 of Sept 23, 1998 on 29 September 1998 at 11:22:51 am'!
!Metaclass methodsFor: 'initialize-release' stamp: 'tk 8/21/1998 10:03'! instanceVariableNames: instVarString "Declare additional named variables for my instance." | newMeta invalid | newMeta _ self copyForValidation. invalid _ newMeta subclassOf: superclass oldClass: self instanceVariableNames: instVarString variable: false words: true pointers: true ifBad: [^false]. (invalid or: [instVarString ~= self instanceVariablesString]) ifTrue: [newMeta validateFrom: self in: Smalltalk instanceVariableNames: true methods: true wasPresent: true. "as far as we know" Smalltalk changes changeClass: self]! !
!Metaclass methodsFor: 'initialize-release'! newNamed: aSymbol "Answer an instance of me whose name is the argument, aSymbol."
^(self class subclassOf: self) new superclass: Object methodDict: MethodDictionary new format: Object format name: aSymbol organization: (ClassOrganizer defaultList: Array new) instVarNames: nil classPool: nil sharedPools: nil! !
!Metaclass methodsFor: 'initialize-release'! subclassOf: superMeta "Change the receiver to be a subclass of the argument, superMeta, a metaclass. Reset the receiver's method dictionary and properties."
superclass _ superMeta. methodDict _ MethodDictionary new. format _ superMeta format. instanceVariables _ nil! !
!Metaclass methodsFor: 'initialize-release' stamp: 'tk 8/22/1998 07:45'! updateInstancesFrom: oldClass "Recreate any existing instances of the argument, oldClass, as instances of the receiver, which is a newly changed class. oldClass is a metaclass, so we know there is just one instance. Permute variables as necessary."
| oldInstVarNames map variable new instSize oldInstances | oldClass soleInstance == nil ifTrue: [^self]. "no instances to convert" oldInstVarNames _ oldClass allInstVarNames. map _ self allInstVarNames collect: [:instVarName | oldInstVarNames indexOf: instVarName]. variable _ self isVariable. instSize _ self instSize.
"Now perform a bulk mutation of old instances into new ones" oldInstances _ Array with: oldClass soleInstance. oldInstances elementsExchangeIdentityWith: (oldInstances collect: [:old | variable ifTrue: [new _ self basicNew: old basicSize] ifFalse: [new _ self basicNew]. 1 to: instSize do: [:offset | (map at: offset) > 0 ifTrue: [new instVarAt: offset put: (old instVarAt: (map at: offset))]]. variable ifTrue: [1 to: old basicSize do: [:offset | new basicAt: offset put: (old basicAt: offset)]]. new])! !
'From Squeak 2.2 of Sept 23, 1998 on 29 September 1998 at 11:24:10 am'!
!Metaclass class methodsFor: 'instance creation'! subclassOf: superMeta "Answer an instance of me that is a subclass of the metaclass, superMeta."
^self new subclassOf: superMeta! !
'From Squeak 2.2 of Sept 23, 1998 on 29 September 1998 at 11:33:57 am'!
!Behavior methodsFor: 'accessing'! format "Answer an Integer that encodes the kinds and numbers of variables of instances of the receiver."
^format! ! 'From Squeak 2.2 of Sept 23, 1998 on 29 September 1998 at 11:35:46 am'!
!Class methodsFor: 'initialize-release'! declare: varString "Declare class variables common to all instances. Answer whether recompilation is advisable."
| newVars conflicts assoc class | newVars _ (Scanner new scanFieldNames: varString) collect: [:x | x asSymbol]. newVars do: [:var | var first isLowercase ifTrue: [self error: var, ' class variable name should be capitalized; proceed to include anyway.']]. conflicts _ false. classPool == nil ifFalse: [(classPool keys reject: [:x | newVars includes: x]) do: [:var | self removeClassVarName: var]]. (newVars reject: [:var | self classPool includesKey: var]) do: [:var | "adding" "check if new vars defined elsewhere" (self scopeHas: var ifTrue: [:ignored | ignored]) ifTrue: [self error: var , ' is defined elsewhere'. conflicts _ true]]. newVars size > 0 ifTrue: [classPool _ self classPool. "in case it was nil" newVars do: [:var | classPool declare: var from: Undeclared]]. ^conflicts! !
!Class methodsFor: 'initialize-release'! obsolete "Change the receiver to an obsolete class by changing its name to have the prefix -AnObsolete-."
name _ 'AnObsolete' , name. classPool _ Dictionary new. self class obsolete. super obsolete! !
!Class methodsFor: 'initialize-release'! removeFromSystem "Forget the receiver from the Smalltalk global dictionary. Any existing instances will refer to an obsolete version of the receiver."
Smalltalk removeClassFromSystem: self. self obsolete! !
!Class methodsFor: 'initialize-release' stamp: 'sw 8/11/1998 13:23'! removeFromSystemUnlogged "Forget the receiver from the Smalltalk global dictionary. Any existing instances will refer to an obsolete version of the receiver. Do not log the removal either to the current change set nor to the system changes log"
Smalltalk removeClassFromSystemUnlogged: self. self obsolete! !
!Class methodsFor: 'initialize-release'! sharing: poolString "Set up sharedPools. Answer whether recompilation is advisable." | oldPools found | oldPools _ self sharedPools. sharedPools _ OrderedCollection new. (Scanner new scanFieldNames: poolString) do: [:poolName | sharedPools add: (Smalltalk at: poolName asSymbol)]. sharedPools isEmpty ifTrue: [sharedPools _ nil]. oldPools do: [:pool | found _ false. self sharedPools do: [:p | p == pool ifTrue: [found _ true]]. found ifFalse: [^ true "A pool got deleted"]]. ^ false! !
!Class methodsFor: 'initialize-release'! superclass: sup methodDict: md format: ft name: nm organization: org instVarNames: nilOrArray classPool: pool sharedPools: poolSet "Answer an instance of me, a new class, using the arguments of the message as the needed information."
superclass _ sup. methodDict _ md. format _ ft. name _ nm. organization _ org. instanceVariables _ nilOrArray. classPool _ pool. sharedPools _ poolSet! !
!Class methodsFor: 'initialize-release' stamp: 'tk 8/21/1998 09:53'! validateFrom: oldClass in: environ instanceVariableNames: invalidFields methods: invalidMethods wasPresent: wasPresent "Recompile the receiver and redefine its subclasses if necessary."
super validateFrom: oldClass in: environ instanceVariableNames: invalidFields methods: invalidMethods wasPresent: wasPresent. self ~~ oldClass ifTrue: [environ at: name put: self. oldClass obsolete]! !
-----== Sent via Deja News, The Discussion Network ==----- http://www.dejanews.com/ Easy access to 50,000+ discussion forums
The mini image of the week wouldn't allow me to accept a new class.
Hmm... now, why would you want to do that?
Sorry about that. The old Squeak had a method that held onto the class defining method. I've put out a new mini image that's still under 600k, but includes the class defining method.
Thanks for the alert.
- Dan
P.S. FYI, it's in the method removeAllUnSentMessages that otherwise unreferenced messages get preserved. The current def of this method is in shrinkMods in the MakeYourOwn folder.
squeak-dev@lists.squeakfoundation.org