3201 this replaces multiple method-changes by the last (i.e. the most recent) change. |
3199 this replaces multiple method-changes by the last (i.e. the most recent) change. |
3202 If the class argument is nil, compress for all classes. |
3200 If the class argument is nil, compress for all classes. |
3203 otherwise, only changes for that class are compressed." |
3201 otherwise, only changes for that class are compressed." |
3204 |
3202 |
3205 |lbl aStream searchIndex anyMore deleteSet index |
3203 |lbl aStream searchIndex anyMore deleteSet index |
3206 str snapshotProto snapshotPrefix snapshotNameIndex fileName| |
3204 str snapshotProto snapshotPrefix snapshotNameIndex| |
3207 |
3205 |
3208 aStream := changeFileName asFilename readStreamOrNil. |
3206 changeFileName notNil ifTrue:[ |
3209 aStream isNil ifTrue:[^ self]. |
3207 aStream := changeFileName asFilename readStreamOrNil. |
|
3208 aStream isNil ifTrue:[^ self]. |
|
3209 ]. |
3210 |
3210 |
3211 lbl := 'compressing'. |
3211 lbl := 'compressing'. |
3212 aClassNameOrNil isNil ifTrue:[ |
3212 aClassNameOrNil isNil ifTrue:[ |
3213 selectorToCompressOrNil notNil ifTrue:[ |
3213 selectorToCompressOrNil notNil ifTrue:[ |
3214 lbl := lbl , ' for ' , selectorToCompressOrNil. |
3214 lbl := lbl , ' for ' , selectorToCompressOrNil. |
3215 ] |
3215 ] |
3216 ] ifFalse:[ |
3216 ] ifFalse:[ |
3217 selectorToCompressOrNil isNil ifTrue:[ |
3217 selectorToCompressOrNil isNil ifTrue:[ |
3218 lbl := lbl , ' for ' , aClassNameOrNil. |
3218 lbl := lbl , ' for ' , aClassNameOrNil. |
3219 ] ifFalse:[ |
3219 ] ifFalse:[ |
3220 lbl := lbl , ' for ' , aClassNameOrNil , '>>' , selectorToCompressOrNil. |
3220 lbl := lbl , ' for ' , aClassNameOrNil , '>>' , selectorToCompressOrNil. |
3221 ] |
3221 ] |
3222 ]. |
3222 ]. |
3223 lbl := lbl , '...'. |
3223 lbl := lbl , '...'. |
3224 self newLabel:lbl. |
3224 self newLabel:lbl. |
3225 |
3225 |
3226 CompressSnapshotInfo == true ifTrue:[ |
3226 CompressSnapshotInfo == true ifTrue:[ |
3227 " |
3227 " |
3228 get a prototype snapshot record (to be independent of |
3228 get a prototype snapshot record (to be independent of |
3229 the actual format .. |
3229 the actual format .. |
3230 " |
3230 " |
3231 str := WriteStream on:String new. |
3231 str := WriteStream on:String new. |
3232 Class addChangeRecordForSnapshot:'foo' to:str. |
3232 Class addChangeRecordForSnapshot:'foo' to:str. |
3233 snapshotProto := str contents. |
3233 snapshotProto := str contents. |
3234 snapshotPrefix := snapshotProto copyTo:10. |
3234 snapshotPrefix := snapshotProto copyTo:10. |
3235 snapshotNameIndex := snapshotProto findString:'foo'. |
3235 snapshotNameIndex := snapshotProto findString:'foo'. |
3236 ]. |
3236 ]. |
3237 |
3237 |
3238 self withExecuteCursorDo:[ |
3238 self withExecuteCursorDo:[ |
3239 |numChanges classes selectors types excla sawExcla |
3239 |numChanges classes selectors types excla sawExcla |
3240 changeNr chunk aParseTree parseTreeChunk |
3240 chunk aParseTree parseTreeChunk |
3241 thisClass thisSelector codeChunk codeParser |
3241 thisClass thisSelector codeChunk codeParser |
3242 compressThis| |
3242 compressThis fileName| |
3243 |
3243 |
3244 numChanges := self numberOfChanges. |
3244 numChanges := self numberOfChanges. |
3245 classes := Array new:numChanges. |
3245 classes := Array new:numChanges. |
3246 selectors := Array new:numChanges. |
3246 selectors := Array new:numChanges. |
3247 types := Array new:numChanges. |
3247 types := Array new:numChanges. |
3248 |
3248 |
3249 "starting at the end, get the change class and change selector; |
3249 "starting at the end, get the change class and change selector; |
3250 collect all in classes / selectors" |
3250 collect all in classes / selectors" |
3251 |
3251 |
3252 changeNr := numChanges. |
3252 aStream notNil ifTrue:[ |
3253 excla := aStream class chunkSeparator. |
3253 excla := aStream class chunkSeparator. |
3254 |
3254 numChanges to:1 by:-1 do:[:changeNr | |
3255 [changeNr >= 1] whileTrue:[ |
3255 aStream position1Based:(changePositions at:changeNr). |
3256 aStream position1Based:(changePositions at:changeNr). |
3256 sawExcla := aStream peekFor:excla. |
3257 sawExcla := aStream peekFor:excla. |
3257 chunk := aStream nextChunk. |
3258 chunk := aStream nextChunk. |
3258 sawExcla ifTrue:[ |
3259 sawExcla ifTrue:[ |
3259 "optimize a bit if multiple methods for same category arrive" |
3260 "optimize a bit if multiple methods for same category arrive" |
3260 (chunk = parseTreeChunk) ifFalse:[ |
3261 (chunk = parseTreeChunk) ifFalse:[ |
3261 aParseTree := Parser parseExpression:chunk. |
3262 aParseTree := Parser parseExpression:chunk. |
3262 parseTreeChunk := chunk |
3263 parseTreeChunk := chunk |
3263 ]. |
3264 ]. |
3264 (aParseTree notNil |
3265 (aParseTree notNil |
3265 and:[(aParseTree ~~ #Error) |
3266 and:[(aParseTree ~~ #Error) |
3266 and:[aParseTree isMessage]]) ifTrue:[ |
3267 and:[aParseTree isMessage]]) ifTrue:[ |
3267 (#( |
3268 (#( |
3268 #methodsFor: |
3269 #methodsFor: |
3269 #privateMethodsFor: |
3270 #privateMethodsFor: |
3270 #publicMethodsFor: |
3271 #publicMethodsFor: |
3271 #ignoredMethodsFor: |
3272 #ignoredMethodsFor: |
3272 #protectedMethodsFor: |
3273 #protectedMethodsFor: |
3273 #methodsFor:stamp: "/ Squeak support |
3274 #methodsFor:stamp: "/ Squeak support |
3274 #methodsFor "/ Dolphin support |
3275 #methodsFor "/ Dolphin support |
3275 #methods "/ STV support |
3276 #methods "/ STV support |
3276 ) |
3277 ) |
3277 includes:aParseTree selector) ifTrue:[ |
3278 includes:aParseTree selector) ifTrue:[ |
3278 thisClass := (aParseTree receiver evaluate). |
3279 thisClass := (aParseTree receiver evaluate). |
3279 codeChunk := aStream nextChunk. |
3280 codeChunk := aStream nextChunk. |
3280 codeParser := Parser |
3281 codeParser := Parser |
3281 parseMethodSpecification:codeChunk |
3282 parseMethodSpecification:codeChunk |
3282 in:thisClass |
3283 in:thisClass |
3283 ignoreErrors:true |
3284 ignoreErrors:true |
3284 ignoreWarnings:true. |
3285 ignoreWarnings:true. |
3285 (codeParser notNil and:[codeParser ~~ #Error]) ifTrue:[ |
3286 (codeParser notNil and:[codeParser ~~ #Error]) ifTrue:[ |
3286 selectors at:changeNr put:(codeParser selector). |
3287 selectors at:changeNr put:(codeParser selector). |
3287 classes at:changeNr put:thisClass. |
3288 classes at:changeNr put:thisClass. |
3288 types at:changeNr put:#methodsFor |
3289 types at:changeNr put:#methodsFor |
3289 ] |
3290 ] |
3290 ] |
3291 ] |
3291 ] |
3292 ] |
3292 ] ifFalse:[ |
3293 ] ifFalse:[ |
3293 aParseTree := Parser parseExpression:chunk. |
3294 aParseTree := Parser parseExpression:chunk. |
3294 parseTreeChunk := chunk. |
3295 parseTreeChunk := chunk. |
3295 (aParseTree notNil |
3296 (aParseTree notNil |
3296 and:[(aParseTree ~~ #Error) |
3297 and:[(aParseTree ~~ #Error) |
3297 and:[aParseTree isMessage]]) ifTrue:[ |
3298 and:[aParseTree isMessage]]) ifTrue:[ |
3298 (aParseTree selector == #removeSelector:) ifTrue:[ |
3299 (aParseTree selector == #removeSelector:) ifTrue:[ |
3299 selectors at:changeNr put:(aParseTree arg1 value ). |
3300 selectors at:changeNr put:(aParseTree arg1 value ). |
3300 classes at:changeNr put:(aParseTree receiver evaluate). |
3301 classes at:changeNr put:(aParseTree receiver evaluate). |
3301 types at:changeNr put:#removeSelector |
3302 types at:changeNr put:#removeSelector |
3302 ] |
3303 ] |
3303 ] ifFalse:[ |
3304 ] ifFalse:[ |
3304 CompressSnapshotInfo == true ifTrue:[ |
3305 CompressSnapshotInfo == true ifTrue:[ |
3305 (chunk startsWith:snapshotPrefix) ifTrue:[ |
3306 (chunk startsWith:snapshotPrefix) ifTrue:[ |
3306 str := chunk readStream position1Based:snapshotNameIndex. |
3307 str := chunk readStream position1Based:snapshotNameIndex. |
3307 fileName := str upTo:(Character space). |
3308 fileName := str upTo:(Character space). |
3308 " |
3309 " |
3309 kludge to allow use of match-check below |
3310 kludge to allow use of match-check below |
3310 " |
3311 " |
3311 selectors at:changeNr put:snapshotPrefix. |
3312 selectors at:changeNr put:snapshotPrefix. |
3312 classes at:changeNr put:fileName. |
3313 classes at:changeNr put:fileName. |
3313 ] |
3314 ] |
3314 ] |
3315 ] |
3315 ] |
3316 ] |
3316 ]. |
3317 ]. |
3317 ]. |
3318 changeNr := changeNr - 1 |
3318 aStream close. |
3319 ]. |
3319 ] ifFalse:[ |
3320 aStream close. |
3320 numChanges to:1 by:-1 do:[:changeNr | |
3321 |
3321 |change| |
3322 "for all changes, look for another class/selector occurrence later |
3322 |
3323 in the list and, if there is one, add change number to the delete set" |
3323 classes at:changeNr put:(self classOfChange:changeNr ifAbsent:[:className| nil]). |
3324 |
3324 selectors at:changeNr put:(self selectorOfMethodChange:changeNr). |
3325 deleteSet := OrderedCollection new. |
3325 ]. |
3326 changeNr := 1. |
3326 ]. |
3327 [changeNr < self numberOfChanges] whileTrue:[ |
3327 |
3328 thisClass := classes at:changeNr. |
3328 "for all changes, look for another class/selector occurrence later |
3329 |
3329 in the list and, if there is one, add change number to the delete set" |
3330 compressThis := false. |
3330 |
3331 aClassNameOrNil isNil ifTrue:[ |
3331 deleteSet := OrderedCollection new. |
3332 compressThis := true |
3332 1 to:self numberOfChanges-1 do:[:changeNr | |
3333 ] ifFalse:[ |
3333 thisClass := classes at:changeNr. |
3334 "/ skipping unloaded/unknown classes |
3334 |
3335 thisClass isBehavior ifTrue:[ |
3335 compressThis := false. |
3336 compressThis := aClassNameOrNil = thisClass theNonMetaclass name. |
3336 aClassNameOrNil isNil ifTrue:[ |
3337 ] |
3337 compressThis := true |
3338 ]. |
3338 ] ifFalse:[ |
3339 compressThis ifTrue:[ |
3339 "/ skipping unloaded/unknown classes |
3340 thisSelector := selectors at:changeNr. |
3340 thisClass isBehavior ifTrue:[ |
3341 compressThis := (selectorToCompressOrNil isNil or:[thisSelector == selectorToCompressOrNil]). |
3341 compressThis := aClassNameOrNil = thisClass theNonMetaclass name. |
3342 compressThis ifTrue:[ |
3342 ] |
3343 searchIndex := changeNr. |
3343 ]. |
3344 anyMore := true. |
3344 compressThis ifTrue:[ |
3345 [anyMore] whileTrue:[ |
3345 thisSelector := selectors at:changeNr. |
3346 searchIndex := classes indexOf:thisClass startingAt:(searchIndex + 1). |
3346 compressThis := (selectorToCompressOrNil isNil or:[thisSelector == selectorToCompressOrNil]). |
3347 (searchIndex ~~ 0) ifTrue:[ |
3347 compressThis ifTrue:[ |
3348 ((selectors at:searchIndex) == thisSelector) ifTrue:[ |
3348 searchIndex := changeNr. |
3349 thisClass notNil ifTrue:[ |
3349 anyMore := true. |
3350 deleteSet add:changeNr. |
3350 [anyMore] whileTrue:[ |
3351 anyMore := false |
3351 searchIndex := classes indexOf:thisClass startingAt:(searchIndex + 1). |
3352 ] |
3352 (searchIndex ~~ 0) ifTrue:[ |
3353 ] |
3353 ((selectors at:searchIndex) == thisSelector) ifTrue:[ |
3354 ] ifFalse:[ |
3354 thisClass notNil ifTrue:[ |
3355 anyMore := false |
3355 deleteSet add:changeNr. |
3356 ] |
3356 anyMore := false |
3357 ]. |
3357 ] |
3358 ]. |
3358 ] |
3359 ]. |
3359 ] ifFalse:[ |
3360 |
3360 anyMore := false |
3361 changeNr := changeNr + 1 |
3361 ] |
3362 ]. |
3362 ]. |
3363 |
3363 ]. |
3364 "finally delete what has been found" |
3364 ]. |
3365 |
3365 ]. |
3366 (deleteSet size > 0) ifTrue:[ |
3366 |
3367 changeListView setSelection:nil. |
3367 "finally delete what has been found" |
3368 index := deleteSet size. |
3368 |
3369 [index > 0] whileTrue:[ |
3369 (deleteSet size > 0) ifTrue:[ |
3370 self silentDeleteChange:(deleteSet at:index). |
3370 changeListView setSelection:nil. |
3371 index := index - 1 |
3371 index := deleteSet size. |
3372 ]. |
3372 [index > 0] whileTrue:[ |
3373 self setChangeList. |
3373 self silentDeleteChange:(deleteSet at:index). |
3374 " |
3374 index := index - 1 |
3375 scroll back a bit, if we are left way behind the list |
3375 ]. |
3376 " |
3376 self setChangeList. |
3377 changeListView firstLineShown > self numberOfChanges ifTrue:[ |
3377 " |
3378 changeListView makeLineVisible:self numberOfChanges |
3378 scroll back a bit, if we are left way behind the list |
3379 ]. |
3379 " |
3380 self clearCodeView |
3380 changeListView firstLineShown > self numberOfChanges ifTrue:[ |
3381 ] |
3381 changeListView makeLineVisible:self numberOfChanges |
|
3382 ]. |
|
3383 self clearCodeView |
|
3384 ] |
3382 ]. |
3385 ]. |
3383 self newLabel:''. |
3386 self newLabel:''. |
3384 |
3387 |
3385 "Modified: / 5.11.2001 / 16:34:53 / cg" |
3388 "Created: / 19-11-2001 / 22:03:42 / cg" |
3386 "Created: / 19.11.2001 / 22:03:42 / cg" |
3389 "Modified: / 13-11-2006 / 11:00:03 / cg" |
3387 ! |
3390 ! |
3388 |
3391 |
3389 deleteChange:changeNr |
3392 deleteChange:changeNr |
3390 "delete a change" |
3393 "delete a change" |
3391 |
3394 |