222 stream nextPut: (manager codeForNil) |
222 stream nextPut: (manager codeForNil) |
223 ! ! |
223 ! ! |
224 |
224 |
225 !UndefinedObject methodsFor:'subclass creation'! |
225 !UndefinedObject methodsFor:'subclass creation'! |
226 |
226 |
227 subclass:t instanceVariableNames:f classVariableNames:d poolDictionaries:s category:cat |
227 nilSubclass:selector args:args |
228 "create a new class which has nil as superclass |
228 "common helper for subclass creation." |
229 - i.e. traps into doesNotUnderstand: for all of its messages." |
229 |
230 |
230 |newClass| |
231 |newClass upd| |
231 |
232 |
232 Class withoutUpdatingChangesDo: |
233 upd := Class updateChanges:false. |
|
234 [ |
233 [ |
235 newClass := Object subclass:t instanceVariableNames:f classVariableNames:d poolDictionaries:s category:cat. |
234 newClass := Object perform:selector withArguments:args |
236 ] valueNowOrOnUnwindDo:[ |
|
237 Class updateChanges:upd |
|
238 ]. |
235 ]. |
239 newClass notNil ifTrue:[ |
236 newClass notNil ifTrue:[ |
240 newClass setSuperclass:nil. |
237 newClass setSuperclass:nil. |
241 newClass |
238 newClass |
242 setSelectors:(Array with:#class |
239 setSelectors:(Array with:#class |
243 with:#doesNotUnderstand:) |
240 with:#doesNotUnderstand:) |
244 methods:(Array with:(Object compiledMethodAt:#class) |
241 methods:(Array with:(Object compiledMethodAt:#class) |
245 with:(Object compiledMethodAt:#doesNotUnderstand:)). |
242 with:(Object compiledMethodAt:#doesNotUnderstand:)). |
246 Class addChangeRecordForClass:newClass. |
243 Class addChangeRecordForClass:newClass. |
247 ]. |
244 ]. |
248 ^ newClass |
245 ^ newClass |
|
246 ! |
|
247 |
|
248 subclass:t instanceVariableNames:f classVariableNames:d poolDictionaries:s category:cat |
|
249 "create a new class which has nil as superclass |
|
250 - i.e. traps into doesNotUnderstand: for all of its messages." |
|
251 |
|
252 ^ self nilSubclass:(thisContext selector) args:(thisContext args) |
249 ! |
253 ! |
250 |
254 |
251 variableSubclass:t instanceVariableNames:f classVariableNames:d poolDictionaries:s category:cat |
255 variableSubclass:t instanceVariableNames:f classVariableNames:d poolDictionaries:s category:cat |
252 "create a new class which has nil as superclass |
256 "create a new class which has nil as superclass |
253 - i.e. traps into doesNotUnderstand: for all of its messages." |
257 - i.e. traps into doesNotUnderstand: for all of its messages." |
254 |
258 |
255 |newClass upd| |
259 ^ self nilSubclass:(thisContext selector) args:(thisContext args) |
256 |
|
257 upd := Class updateChanges:false. |
|
258 [ |
|
259 newClass := Object variableSubclass:t instanceVariableNames:f classVariableNames:d poolDictionaries:s category:cat. |
|
260 ] valueNowOrOnUnwindDo:[ |
|
261 Class updateChanges:upd |
|
262 ]. |
|
263 newClass notNil ifTrue:[ |
|
264 newClass setSuperclass:nil. |
|
265 newClass |
|
266 setSelectors:(Array with:#class |
|
267 with:#doesNotUnderstand:) |
|
268 methods:(Array with:(Object compiledMethodAt:#class) |
|
269 with:(Object compiledMethodAt:#doesNotUnderstand:)). |
|
270 Class addChangeRecordForClass:newClass. |
|
271 ]. |
|
272 ^ newClass |
|
273 ! |
260 ! |
274 |
261 |
275 variableByteSubclass:t instanceVariableNames:f classVariableNames:d poolDictionaries:s category:cat |
262 variableByteSubclass:t instanceVariableNames:f classVariableNames:d poolDictionaries:s category:cat |
276 "create a new class which has nil as superclass |
263 "create a new class which has nil as superclass |
277 - i.e. traps into doesNotUnderstand: for all of its messages." |
264 - i.e. traps into doesNotUnderstand: for all of its messages." |
278 |
265 |
279 |newClass upd| |
266 ^ self nilSubclass:(thisContext selector) args:(thisContext args) |
280 |
267 ! ! |
281 upd := Class updateChanges:false. |
|
282 [ |
|
283 newClass := Object variableByteSubclass:t instanceVariableNames:f classVariableNames:d poolDictionaries:s category:cat. |
|
284 ] valueNowOrOnUnwindDo:[ |
|
285 Class updateChanges:upd |
|
286 ]. |
|
287 newClass notNil ifTrue:[ |
|
288 newClass setSuperclass:nil. |
|
289 newClass |
|
290 setSelectors:(Array with:#class |
|
291 with:#doesNotUnderstand:) |
|
292 methods:(Array with:(Object compiledMethodAt:#class) |
|
293 with:(Object compiledMethodAt:#doesNotUnderstand:)). |
|
294 Class addChangeRecordForClass:newClass. |
|
295 ]. |
|
296 ^ newClass |
|
297 ! ! |
|