[mini] fileIn so you can add classes

29 Sep 1998


      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