[squeak-dev] The Trunk: System-nice.509.mcz

commits at source.squeak.org commits at source.squeak.org
Wed Jan 2 22:56:42 UTC 2013


Nicolas Cellier uploaded a new version of System to project The Trunk:
http://source.squeak.org/trunk/System-nice.509.mcz

==================== Summary ====================

Name: System-nice.509
Author: nice
Time: 2 January 2013, 11:54:35.157 pm
UUID: 0a5e257b-341e-4a75-9f18-f10eaabc2569
Ancestors: System-cwp.508

Use at:ifAbsentPut: instead of at:ifAbsent: [ at:put: ]
This is an update of http://bugs.squeak.org/view.php?id=5667

=============== Diff against System-cwp.508 ===============

Item was changed:
  ----- Method: ChangeSet>>changeRecorderFor: (in category 'private') -----
  changeRecorderFor: class
  
  	| cname |
  	(class isString)
  		ifTrue: [ cname := class ]
  		ifFalse: [ cname := class name ].
  
  	"Later this will init the changeRecords so according to whether they should be revertable."
  	^ changeRecords at: cname
+ 			ifAbsentPut: [ClassChangeRecord new initFor: cname revertable: revertable]!
- 			ifAbsent: [^ changeRecords at: cname
- 							put: (ClassChangeRecord new initFor: cname revertable: revertable)]!

Item was changed:
  ----- Method: MessageTally>>into:fromSender: (in category 'collecting leaves') -----
  into: leafDict fromSender: senderTally
  	| leafNode |
  	leafNode := leafDict at: method
+ 		ifAbsentPut: [(self class new class: class method: method)
- 		ifAbsent: [leafDict at: method
- 			put: ((MessageTally new class: class method: method)
  				process: process;
+ 				reportOtherProcesses: reportOtherProcesses].
- 				reportOtherProcesses: reportOtherProcesses)].
  	leafNode bump: tally fromSender: senderTally!

Item was changed:
  ----- Method: Preferences class>>standardButtonFont (in category 'fonts') -----
  standardButtonFont
  	"Answer an attractive font to use for buttons"
  	"Answer the font to be used for textual flap tab labels"
+ 	^ Parameters 
+ 			at: #standardButtonFont 
+ 			ifAbsentPut: [StrikeFont familyName: #ComicBold size: 16]!
- 	^ Parameters at: #standardButtonFont ifAbsent:
- 		[Parameters at: #standardButtonFont put: (StrikeFont familyName: #ComicBold size: 16)]!

Item was changed:
  ----- Method: Preferences class>>standardCodeFont (in category 'fonts') -----
  standardCodeFont
  	"Answer the font to be used in code"
+ 	 ^ Parameters at: #standardCodeFont ifAbsentPut: [TextStyle defaultFont]!
- 
- 	 ^ Parameters at: #standardCodeFont ifAbsent:
- 		[Parameters at: #standardCodeFont put: TextStyle defaultFont]!

Item was changed:
  ----- Method: Preferences class>>standardEToysFont (in category 'fonts') -----
  standardEToysFont
  	"Answer the font to be used in the eToys environment"
+ 	^ Parameters at: #eToysFont ifAbsentPut: [self standardButtonFont]!
- 	^ Parameters
- 		at: #eToysFont
- 		ifAbsent: [Parameters at: #eToysFont put: self standardButtonFont]!

Item was changed:
  ----- Method: Preferences class>>standardEToysTitleFont (in category 'fonts') -----
  standardEToysTitleFont
  	"Answer the font to be used in the eToys environment"
+ 	^ Parameters at: #eToysTitleFont ifAbsentPut: [self standardEToysFont]!
- 	^ Parameters
- 		at: #eToysTitleFont
- 		ifAbsent: [Parameters at: #eToysTitleFont put: self standardEToysFont]!

Item was changed:
  ----- Method: Preferences class>>standardFlapFont (in category 'fonts') -----
  standardFlapFont
  	"Answer the font to be used for textual flap tab labels"
+ 	^ Parameters at: #standardFlapFont ifAbsentPut: [self standardButtonFont]!
- 	^ Parameters at: #standardFlapFont ifAbsent:
- 		[Parameters at: #standardFlapFont put: self standardButtonFont]!

Item was changed:
  ----- Method: Preferences class>>standardHaloLabelFont (in category 'fonts') -----
  standardHaloLabelFont
  	"Answer the font to be used in the eToys environment"
+ 	^ Parameters at: #haloLabelFont ifAbsentPut: [TextStyle defaultFont]!
- 	^ Parameters
- 		at: #haloLabelFont
- 		ifAbsent: [Parameters at: #haloLabelFont put: TextStyle defaultFont]!

Item was changed:
  ----- Method: Preferences class>>standardListFont (in category 'fonts') -----
  standardListFont
  	"Answer the font to be used in lists"
+ 	 ^ Parameters at: #standardListFont ifAbsentPut: [TextStyle defaultFont]!
- 
- 	 ^ Parameters at: #standardListFont ifAbsent:
- 		[Parameters at: #standardListFont put: TextStyle defaultFont]!

Item was changed:
  ----- Method: Preferences class>>standardMenuFont (in category 'fonts') -----
  standardMenuFont
  	"Answer the font to be used in menus"
+ 	 ^ Parameters at: #standardMenuFont ifAbsentPut: [TextStyle defaultFont]!
- 
- 	 ^ Parameters at: #standardMenuFont ifAbsent:
- 		[Parameters at: #standardMenuFont put: TextStyle defaultFont]!

Item was changed:
  ----- Method: Preferences class>>standardPaintBoxButtonFont (in category 'fonts') -----
  standardPaintBoxButtonFont
  	"Answer the font to be used in the eToys environment"
+ 	^ Parameters at: #paintBoxButtonFont ifAbsentPut: [self standardButtonFont]!
- 	^ Parameters
- 		at: #paintBoxButtonFont
- 		ifAbsent: [Parameters at: #paintBoxButtonFont put: self standardButtonFont]!

Item was changed:
  ----- Method: Preferences class>>windowTitleFont (in category 'fonts') -----
  windowTitleFont
  	"Answer the standard font to use for window titles"
+ 	^  Parameters at: #windowTitleFont ifAbsentPut: [StrikeFont familyName: #NewYork size: 15]!
- 	^  Parameters at: #windowTitleFont ifAbsent:
- 		[Parameters at: #windowTitleFont put: (StrikeFont familyName: #NewYork size: 15)]!

Item was changed:
  ----- Method: ReferenceStream>>nextPutWeak: (in category 'writing') -----
  nextPutWeak: anObject
      "Write a weak reference to anObject to the receiver stream. Answer anObject.
       If anObject is not a reference type of object, then just put it normally.
       A 'weak' reference means: If anObject gets written this stream via nextPut:,
       then its weak references will become normal references. Otherwise they'll
       read back as nil. -- "
      | typeID referencePosn |
  
      "Is it a reference type of object? If not, just write it normally."
      typeID := self typeIDFor: anObject.
      (self isAReferenceType: typeID) ifFalse: [^ self nextPut: anObject].
  
      "Have we heard of and maybe even written anObject before?"
+     referencePosn := references at: anObject ifAbsentPut: [OrderedCollection new].
-     referencePosn := references at: anObject ifAbsent: [
- 			references at: anObject put: OrderedCollection new].
  
      "If referencePosn is an Integer, it's the stream position of anObject.
       Else it's a collection of hopeful weak-references to anObject."
      referencePosn isInteger ifFalse:
          [referencePosn add: byteStream position - basePos.		"relative"
          referencePosn := self vacantRef].
      self outputReference: referencePosn.		"relative"
  
      ^ anObject!

Item was changed:
  ----- Method: ReferenceStream>>statisticsOfRefs (in category 'statistics') -----
  statisticsOfRefs
  	"Analyze the information in references, the objects being written out"
  
  	| parents ownerBags tallies n nm owners |
  	parents := IdentityDictionary new: references size * 2.
  	n := 0.
  	'Finding Owners...'
  	displayProgressFrom: 0 to: references size
  	during: [:bar |
  	references keysDo:
  		[:parent | | kids |
  		bar value: (n := n+1).
  		kids := parent class isFixed
  			ifTrue: [(1 to: parent class instSize) collect: [:i | parent
  instVarAt: i]]
  			ifFalse: [parent class isBits ifTrue: [Array new]
  					 ifFalse: [(1 to: parent basicSize) collect: [:i | parent basicAt:
  i]]].
  		(kids select: [:x | references includesKey: x])
  			do: [:child | parents at: child put: parent]]].
  	ownerBags := Dictionary new.
  	tallies := Bag new.
  	n := 0.
  	'Tallying Owners...'
  	displayProgressFrom: 0 to: references size
  	during: [:bar |
  	references keysDo:  "For each class of obj, tally a bag of owner
  classes"
  		[:obj | | objParent | bar value: (n := n+1).
  		nm := obj class name.
  		tallies add: nm.
+ 		owners := ownerBags at: nm ifAbsentPut: [Bag new].
- 		owners := ownerBags at: nm ifAbsent: [ownerBags at: nm put: Bag new].
  		(objParent := parents at: obj ifAbsent: [nil]) == nil
  			ifFalse: [owners add: objParent class name]]].
  	^ String streamContents:
  		[:strm |  tallies sortedCounts do:
  			[:assn | n := assn key.  nm := assn value.
  			owners := ownerBags at: nm.
  			strm cr; nextPutAll: nm; space; print: n.
  			owners size > 0 ifTrue:
  				[strm cr; tab; print: owners sortedCounts]]]!

Item was changed:
  ----- Method: SmartRefStream>>instVarInfo: (in category 'read write') -----
  instVarInfo: anObject
  	"Return the object to write on the outgoing file that contains the structure of each class we are about to write out.  Must be an Array whose first element is 'class structure'.  Its second element is a Dictionary of pairs of the form #Rectangle -> #(<classVersion> 'origin' 'corner').  "
  
  	"Make a pass through the objects, not writing, but recording the classes.  Construct a database of their inst vars and any version info (classVersion)."
  
  	| dummy refs cls newSupers |
  	structures := Dictionary new.
  	superclasses := Dictionary new.
  	dummy := ReferenceStream on: (DummyStream on: nil).
  		"Write to a fake Stream, not a file"
  	"Collect all objects"
  	dummy rootObject: anObject.	"inform him about the root"
  	dummy nextPut: anObject.
  	refs := dummy references.
  	objCount := refs size.		"for progress bar"
  		"Note that Dictionary must not change its implementation!!  If it does, how do we read this reading information?"
  	(refs includesKey: #AnImageSegment) 
  		ifFalse: [
  			self uniClassInstVarsRefs: dummy.	"catalog the extra objects in UniClass inst vars"
  			refs keysDo: [:each | 
  				cls := each class.
  				"cls isObsolete ifTrue: [self error: 'Trying to write ', cls name]."
  				(cls class ~~ Metaclass) & (cls isObsolete not) ifTrue: [
  					structures at: cls name put: false]]]
  		ifTrue: [self recordImageSegment: refs].
  	"Save work by only computing inst vars once for each class"
  	newSupers := Set new.
  	structures at: #Point put: false.	"writeRectangle: does not put out class pointer"
  	structures at: #Rectangle put: false.
  	structures at: #LargePositiveInteger put: false.	"used in slow case of WordArray"
  	structures keysDo: [:nm | 
  		cls := (nm endsWith: ' class') 
  			ifFalse: [Smalltalk at: nm]
  			ifTrue: [(Smalltalk at: nm substrings first asSymbol) class].
  		cls allSuperclasses do: [:aSuper |
  			structures at: aSuper name ifAbsent: [newSupers add: aSuper name]]].
  			"Don't modify structures during iteration"
  	newSupers do: [:nm | structures at: nm put: 3].	"Get all superclasses into list"
  	structures keysDo: [:nm | "Nothing added to classes during loop"
  		cls := (nm endsWith: ' class') 
  			ifFalse: [Smalltalk at: nm]
  			ifTrue: [(Smalltalk at: nm substrings first asSymbol) class].
  		structures at: nm put: 
  			((Array with: cls classVersion), (cls allInstVarNames)).
+ 		superclasses at: nm ifAbsentPut: [cls superclass name]].
- 		superclasses at: nm ifAbsent: [
- 				superclasses at: nm put: cls superclass name]].
  	(refs includesKey: #AnImageSegment) 
  		ifTrue: [classInstVars := #()]
  		ifFalse: [self saveClassInstVars].	"of UniClassses"
  	^ (Array with: 'class structure' with: structures with: 'superclasses' with: superclasses)!



More information about the Squeak-dev mailing list