|
9 | 9 | #category : 'Rowan-GemStone'
|
10 | 10 | }
|
11 | 11 |
|
| 12 | +{ #category : 'accessing' } |
| 13 | +RwGsPackageSymbolDictionary class >> defaultProtocolString [ |
| 14 | + |
| 15 | + ^ 'as yet unclassified' |
| 16 | +] |
| 17 | + |
12 | 18 | { #category : 'instance creation' }
|
13 | 19 | RwGsPackageSymbolDictionary class >> newNamed: aSymbol [
|
14 | 20 |
|
@@ -129,8 +135,9 @@ RwGsPackageSymbolDictionary >> addExtensionCompiledMethod: compiledMethod for: b
|
129 | 135 | loadedPackage := self packageRegistry
|
130 | 136 | at: packageName
|
131 | 137 | ifAbsent: [
|
132 |
| - self |
133 |
| - error: 'Internal error -- attempt to add a method to a nonexistent package.' ]. |
| 138 | + self packageRegistry |
| 139 | + at: packageName |
| 140 | + put: (RwGSLoadedSymbolDictPackage newNamed: packageName) ]. |
134 | 141 |
|
135 | 142 | loadedClassOrExtension := loadedPackage
|
136 | 143 | loadedClassExtensionForClass: behavior
|
@@ -166,6 +173,14 @@ RwGsPackageSymbolDictionary >> addNewCompiledMethod: compiledMethod for: behavio
|
166 | 173 | | methodDictionary selector protocolSymbol existing loadedMethod loadedPackage loadedClassOrExtension properties |
|
167 | 174 | methodDictionary := behavior persistentMethodDictForEnv: 0.
|
168 | 175 | selector := compiledMethod selector.
|
| 176 | + methodDictionary |
| 177 | + at: selector |
| 178 | + ifPresent: [ :oldCompiledMethod | |
| 179 | + "there is an existing compiled method ... that means we're adding a recompiled methoded and moving it to the (possibly new) protocol" |
| 180 | + ^ self |
| 181 | + addRecompiledMethod: compiledMethod; |
| 182 | + moveCompiledMethod: compiledMethod toProtocol: protocolString; |
| 183 | + yourself ]. |
169 | 184 | methodDictionary at: selector put: compiledMethod.
|
170 | 185 |
|
171 | 186 | protocolSymbol := protocolString asSymbol.
|
@@ -207,17 +222,23 @@ RwGsPackageSymbolDictionary >> addRecompiledMethod: newCompiledMethod [
|
207 | 222 | oldCompiledMethod := methodDictionary
|
208 | 223 | at: selector
|
209 | 224 | ifAbsent: [
|
210 |
| - self |
211 |
| - error: |
212 |
| - 'Internal error -- no existing CompileMethod found for patched method: ' |
213 |
| - , selector printString ]. |
| 225 | + | loadedClass | |
| 226 | + loadedClass := classRegistry |
| 227 | + at: behavior theNonMetaClass classHistory |
| 228 | + ifAbsent: [ |
| 229 | + self |
| 230 | + error: |
| 231 | + 'Internal error -- The class is not in any known package and no package has been specified' ]. |
| 232 | + ^ self |
| 233 | + addNewCompiledMethod: newCompiledMethod |
| 234 | + for: behavior |
| 235 | + protocol: self class defaultProtocolString |
| 236 | + toPackageNamed: loadedClass packageName ]. |
214 | 237 |
|
215 | 238 | oldCompiledMethod == newCompiledMethod
|
216 | 239 | ifTrue: [
|
217 |
| - self |
218 |
| - error: |
219 |
| - 'Internal error -- The new recompiled method is identical to the installed method ' |
220 |
| - , selector printString ]. |
| 240 | + "exit early, no more work to be done" |
| 241 | + ^ self ]. |
221 | 242 | methodDictionary at: selector put: newCompiledMethod.
|
222 | 243 |
|
223 | 244 | loadedMethod := methodRegistry
|
|
0 commit comments