[squeak-dev] The Trunk: System-ul.393.mcz

commits at source.squeak.org commits at source.squeak.org
Tue Nov 16 04:11:58 UTC 2010

Levente Uzonyi uploaded a new version of System to project The Trunk:

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

Name: System-ul.393
Author: ul
Time: 16 November 2010, 5:11:01.011 am
UUID: ee4afd6d-fcb8-2d42-976e-4a4c427a2213
Ancestors: System-ul.392

- use #= for integer comparison instead of #== (http://bugs.squeak.org/view.php?id=2788 )

=============== Diff against System-ul.392 ===============

Item was changed:
  ----- Method: ChangeSet class>>scanVersionsOf:class:meta:category:selector: (in category 'scanning') -----
  scanVersionsOf: method class: class meta: meta category: cat selector: selector
  	| position prevPos prevFileIndex preamble tokens sourceFilesCopy stamp changeList file |
  	changeList := OrderedCollection new.
  	position := method filePosition.
  	sourceFilesCopy := SourceFiles collect:[:x | x ifNotNil:[x readOnlyCopy]].
+ 	method fileIndex = 0 ifTrue: [^ nil].
- 	method fileIndex == 0 ifTrue: [^ nil].
  	file := sourceFilesCopy at: method fileIndex.
  	[position notNil & file notNil] whileTrue:[
  		preamble := method getPreambleFrom: file at: (0 max: position - 3).
  		"Preamble is likely a linked method preamble, if we're in
  			a changes file (not the sources file).  Try to parse it
  			for prior source position and file index"
  		prevPos := nil.
  		stamp := ''.
  		(preamble findString: 'methodsFor:' startingAt: 1) > 0
  			ifTrue: [tokens := [Scanner new scanTokens: preamble] on: Error do:[#()]]
  			ifFalse: [tokens := Array new  "ie cant be back ref"].
  		((tokens size between: 7 and: 8)
  			and: [(tokens at: tokens size-5) = #methodsFor:]) ifTrue:[
  				(tokens at: tokens size-3) = #stamp: ifTrue:[
  					"New format gives change stamp and unified prior pointer"
  					stamp := tokens at: tokens size-2.
  					prevPos := tokens last.
  					prevFileIndex := sourceFilesCopy fileIndexFromSourcePointer: prevPos.
  					prevPos := sourceFilesCopy filePositionFromSourcePointer: prevPos.
  				] ifFalse: ["Old format gives no stamp; prior pointer in two parts"
  					prevPos := tokens at: tokens size-2.
  					prevFileIndex := tokens last.
  				(prevPos = 0 or: [prevFileIndex = 0]) ifTrue: [prevPos := nil]
  		((tokens size between: 5 and: 6)
  			and: [(tokens at: tokens size-3) = #methodsFor:]) ifTrue:[
  				(tokens at: tokens size-1) = #stamp: ifTrue: [
  					"New format gives change stamp and unified prior pointer"
  					stamp := tokens at: tokens size.
   		changeList add: (ChangeRecord new file: file position: position type: #method
  						class: class name category: cat meta: meta stamp: stamp).
  		position := prevPos.
  		prevPos notNil ifTrue:[file := sourceFilesCopy at: prevFileIndex].
  	sourceFilesCopy do: [:x | x ifNotNil:[x close]].

Item was changed:
  ----- Method: ChangeSet>>lookForSlips (in category 'fileIn/Out') -----
  	"Scan the receiver for changes that the user may regard as slips to be remedied"
  	| slips nameLine msg |
  	nameLine := '
  "', self name, '"
+ 	(slips := self checkForSlips) size = 0 ifTrue:
- 	(slips := self checkForSlips) size == 0 ifTrue:
  		[^ self inform: 'No slips detected in change set', nameLine].
+ 	msg := slips size = 1
- 	msg := slips size == 1
  			[ 'One method in change set', nameLine, 
  'has a halt, reference to the Transcript,
  and/or some other ''slip'' in it.
  Would you like to browse it? ?']
  			[ slips size printString,
  ' methods in change set', nameLine, 'have halts or references to the
  Transcript or other ''slips'' in them.
  Would you like to browse them?'].
  	(UIManager default  chooseFrom: #('Ignore' 'Browse slips') title: msg) = 2
  		ifTrue: [self systemNavigation  browseMessageList: slips
  							name: 'Possible slips in ', name]!

Item was changed:
  ----- Method: DataStream>>next (in category 'write and read') -----
  	"Answer the next object in the stream."
  	| type selector anObject isARefType pos internalObject |
  	type := byteStream next.
  	type ifNil: [pos := byteStream position.	"absolute!!!!"
  		byteStream close.	"clean up"
  		byteStream position = 0 
  			ifTrue: [self error: 'The file did not exist in this directory'] 
  			ifFalse: [self error: 'Unexpected end of object file'].
  		pos.	"so can see it in debugger"
  		^ nil].
  	type = 0 ifTrue: [pos := byteStream position.	"absolute!!!!"
  		byteStream close.	"clean up"
  		self error: 'Expected start of object, but found 0'.
  		^ nil].
  	isARefType := self noteCurrentReference: type.
  	selector := #(readNil readTrue readFalse readInteger	"<-4"
  			readStringOld readSymbol readByteArray		"<-7"
  			readArray readInstance readReference readBitmap	"<-11"
  			readClass readUser readFloat readRectangle readShortInst 	"<-16"
  			readString readWordArray readWordArrayForSegment 	"<-19"
+ 			readWordLike readMethod "<-21") at: type ifAbsent: [
+ 				pos := byteStream position.	"absolute!!!!"
+ 				byteStream close. 
+ 				self error: 'file is more recent than this system'. ^ nil].
- 			readWordLike readMethod "<-21") at: type.
- 	selector == 0 ifTrue: [pos := byteStream position.	"absolute!!!!"
- 			byteStream close. 
- 			self error: 'file is more recent than this system'. ^ nil].
  	anObject := self perform: selector. "A method that recursively
  		calls next (readArray, readInstance, objectAt:) must save &
  		restore the current reference position."
  	isARefType ifTrue: [self beginReference: anObject].
  		"After reading the externalObject, internalize it.
  		 #readReference is a special case. Either:
  		   (1) We actually have to read the object, recursively calling
  			   next, which internalizes the object.
  		   (2) We just read a reference to an object already read and
  			   thus already interalized.
  		 Either way, we must not re-internalize the object here."
  	selector == #readReference ifTrue: [^ anObject].
  	internalObject := anObject comeFullyUpOnReload: self.
  	internalObject == String ifTrue:[
  		"This is a hack to figure out if we're loading a String class 
  		that really should be a ByteString. Note that these days this
  		will no longer be necessary since we use #withClassVersion:
  		for constructing the global thus using a different classVersion
  		will perfectly do the trick."
  		((anObject isKindOf: DiskProxy) 
  			and:[anObject globalObjectName == #String
  			and:[anObject constructorSelector == #yourself]]) ifTrue:[
  				internalObject := ByteString]].
  	^ self maybeBeginReference: internalObject!

Item was changed:
  ----- Method: ExternalDropHandler>>handle:in:dropEvent: (in category 'accessing') -----
  handle: dropStream in: pasteUp dropEvent: anEvent
  	| numArgs |
  	numArgs := action numArgs.
+ 	numArgs = 1
- 	numArgs == 1
  		ifTrue: [^action value: dropStream].
+ 	numArgs = 2
- 	numArgs == 2
  		ifTrue: [^action value: dropStream value: pasteUp].
+ 	numArgs = 3
- 	numArgs == 3
  		ifTrue: [^action value: dropStream value: pasteUp value: anEvent].
  	self error: 'Wrong number of args for dop action.'!

Item was changed:
  ----- Method: ImageSegment>>copySmartRootsExport: (in category 'read/write segment') -----
  copySmartRootsExport: rootArray 
  	"Use SmartRefStream to find the object.  Make them all roots.  Create the segment in memory.  Project should be in first five objects in rootArray."
  	| newRoots list segSize symbolHolder replacements naughtyBlocks allClasses sizeHint proj dummy |
  	Smalltalk forgetDoIts.
  	"self halt."
  	symbolHolder := Symbol allSymbols.	"Hold onto Symbols with strong pointers, 
  		so they will be in outPointers"
  	dummy := ReferenceStream on: (DummyStream on: nil).
  		"Write to a fake Stream, not a file"
  	"Collect all objects"
  	dummy insideASegment: true.	"So Uniclasses will be traced"
  	dummy rootObject: rootArray.	"inform him about the root"
  	dummy nextPut: rootArray.
  	(proj :=dummy project) ifNotNil: [self dependentsSave: dummy].
  	allClasses := SmartRefStream new uniClassInstVarsRefs: dummy.
  		"catalog the extra objects in UniClass inst vars.  Put into dummy"
  	allClasses do: [:cls | 
  		dummy references at: cls class put: false.	"put Player5 class in roots"
  		dummy blockers removeKey: cls class ifAbsent: []].
  	"refs := dummy references."
  	arrayOfRoots := self smartFillRoots: dummy.	"guaranteed none repeat"
  	self savePlayerReferences: dummy references.	"for shared References table"
  	replacements := dummy blockers.
  	dummy project "recompute it" ifNil: [self error: 'lost the project!!'].
  	dummy project class == DiskProxy ifTrue: [self error: 'saving the wrong project'].
  	dummy := nil.	"force GC?"
  	naughtyBlocks := arrayOfRoots select: [ :each |
  		(each isKindOf: ContextPart) and: [each hasInstVarRef]
  	"since the caller switched ActiveWorld, put the real one back temporarily"
  	naughtyBlocks isEmpty ifFalse: [
  		World becomeActiveDuring: [ | goodToGo |
  			goodToGo := (UIManager default
  				chooseFrom: #('keep going' 'stop and take a look')
  'Some block(s) which reference instance variables 
  are included in this segment. These may fail when
  the segment is loaded if the class has been reshaped.
+ What would you like to do?') = 1.
- What would you like to do?') == 1.
  			goodToGo ifFalse: [
  				naughtyBlocks inspect.
  				self error: 'Here are the bad blocks'].
  	"Creation of the segment happens here"
  	"try using one-quarter of memory min: four megs to publish (will get bumped later)"
  	sizeHint := (Smalltalk garbageCollect // 4 // 4) min: 1024*1024.
  	self copyFromRoots: arrayOfRoots sizeHint: sizeHint areUnique: true.
  	segSize := segment size.
  	[(newRoots := self rootsIncludingBlockMethods) == nil] whileFalse: [
  		arrayOfRoots := newRoots.
  		self copyFromRoots: arrayOfRoots sizeHint: segSize areUnique: true].
  		"with methods pointed at from outside"
  	[(newRoots := self rootsIncludingBlocks) == nil] whileFalse: [
  		arrayOfRoots := newRoots.
  		self copyFromRoots: arrayOfRoots sizeHint: segSize areUnique: true].
  		"with methods, blocks from outPointers"
  	list := self compactClassesArray.
  	outPointers := outPointers, ((list select: [:cls | cls ~~ nil]), (Array with: 1717 with: list)).
  	1 to: outPointers size do: [:ii | 
  		(outPointers at: ii) isBlock ifTrue: [outPointers at: ii put: nil].
  		(outPointers at: ii) class == MethodContext ifTrue: [outPointers at: ii put: nil].
  		"substitute new object in outPointers"
  		(replacements includesKey: (outPointers at: ii)) ifTrue: [
  			outPointers at: ii put: (replacements at: (outPointers at: ii))]].
  	proj ifNotNil: [self dependentsCancel: proj].

Item was changed:
  ----- Method: Locale>>fetchISO2Language (in category 'private') -----
  	"Locale current fetchISO2Language"
  	| lang isoLang |
  	lang := self primLanguage.
  	lang ifNil: [^nil].
  	lang := lang copyUpTo: 0 asCharacter.
+ 	lang size = 2
- 	lang size == 2
  		ifTrue: [^lang].
  	isoLang := ISOLanguageDefinition iso3LanguageDefinition: lang.
  		ifNil: [nil]
  		ifNotNil: [isoLang iso2]!

Item was changed:
  ----- Method: ReferenceStream>>isAReferenceType: (in category 'writing') -----
  isAReferenceType: typeID
  	"Return true iff typeID is one of the classes that can be written as a reference to an instance elsewhere in the stream."
  	"too bad we can't put Booleans in an Array literal"
+ 	^ (RefTypes at: typeID) = 1
- 	^ (RefTypes at: typeID) == 1
  		"NOTE: If you get a bounds error here, the file probably has bad bits in it.  The most common cause is a file unpacking program that puts linefeeds after carriage returns."!

Item was changed:
  ----- Method: SmartRefStream>>restoreClassInstVars (in category 'read write') -----
  	"Install the values of the class instance variables of UniClasses
  (i.e. scripts slotInfo).  classInstVars is ((#Player25 scripts slotInfo)
  ...).  Thank you Mark Wai for the bug fix."
  	| normal trans classPlayer |
  	self flag: #bobconv.	
  	classPlayer := Smalltalk at: #Player ifAbsent:[^self].
  	self moreObjects ifFalse: [^ self]. 	"are no UniClasses with class inst vars"
  	classInstVars := super next.	"Array of arrays"
  	normal := Object class instSize.	"might give trouble if Player class superclass changes size"
  	(structures at: #Player ifAbsent: [#()]) = #(0 'dependents' 'costume') ifTrue:
  		[trans := 1].	"now (0 costume costumes).  Do the conversion of Player class
  			inst vars in Update 509."
  	classInstVars do: [:list | | aName newCls rList newName start |
  		aName := (list at: 1) asSymbol.
  		rList := list.
  		newName := renamed at: aName ifAbsent: [aName].
  		newCls := Smalltalk at: newName
  				ifAbsent: [self error: 'UniClass definition missing'].
+ 		("old conversion" trans = 1 and: [newCls inheritsFrom: classPlayer]) ifTrue: [
- 		("old conversion" trans == 1 and: [newCls inheritsFrom: classPlayer]) ifTrue: [
  			"remove costumeDictionary from Player class inst vars"
  			rList := rList asOrderedCollection.
  			rList removeAt: 4].	"costumeDictionary's value"
  		start := list second = 'Update to read classPool' ifTrue: [4] ifFalse: [2].
  		newCls class instSize = (normal + (rList size) - start + 1) ifFalse:
  			[self error: 'UniClass superclass class has changed size'].
  			"Need to install a conversion method mechanism"
  		start = 4 ifTrue: [newCls instVarAt: normal - 1 "classPool" put: (list at: 3)].
  		start to: rList size do: [:ii |
  			newCls instVarAt: normal + ii - start + 1 put: (rList at: ii)]].

Item was changed:
  ----- Method: SystemNavigation>>confirmRemovalOf:on: (in category 'ui') -----
  confirmRemovalOf: aSelector on: aClass 
  	"Determine if it is okay to remove the given selector. Answer 1 if it  
  	should be removed, 2 if it should be removed followed by a senders  
  	browse, and 3 if it should not be removed."
  	| count answer caption allCalls |
  	allCalls := self allCallsOn: aSelector.
+ 	(count := allCalls size) = 0
- 	(count := allCalls size) == 0
  		ifTrue: [^ 1].
  	"no senders -- let the removal happen without warning"
+ 	count = 1
- 	count == 1
  		ifTrue: [(allCalls first actualClass == aClass
  					and: [allCalls first methodSymbol == aSelector])
  				ifTrue: [^ 1]].
  	"only sender is itself"
  	caption := 'This message has ' , count printString , ' sender'.
  	count > 1
  		ifTrue: [caption := caption copyWith: $s].
  	answer := UIManager default 
  		chooseFrom: #('Remove it'
  				'Remove, then browse senders'
  				'Don''t remove, but show me those senders'
  				'Forget it -- do nothing -- sorry I asked') title: caption.
+ 	answer = 3
- 	answer == 3
  		ifTrue: [self
  				browseMessageList: allCalls
  				name: 'Senders of ' , aSelector
  				autoSelect: aSelector keywords first].
+ 	answer = 0
- 	answer == 0
  		ifTrue: [answer := 3].
  	"If user didn't answer, treat it as cancel"
  	^ answer min: 3!

Item was changed:
  ----- Method: Utilities class>>applyUpdatesFromDiskToUpdateNumber:stopIfGap: (in category 'fetching updates') -----
  applyUpdatesFromDiskToUpdateNumber: lastUpdateNumber stopIfGap: stopIfGapFlag 
  	"To use this mechanism, be sure all updates you want to have considered 
  	are in a folder named 'updates' which resides in the same directory as  
  	your image. Having done that, simply evaluate:  
  	Utilities applyUpdatesFromDiskToUpdateNumber: 1234 stopIfGap: false  
  	and all numbered updates <= lastUpdateNumber not yet in the image will 
  	be loaded in numerical order."
  	| previousHighest currentUpdateNumber done fileNames aMessage updateDirectory loaded |
  	updateDirectory := self getUpdateDirectoryOrNil.
  	updateDirectory ifNil: [^ self].
  	previousHighest := SystemVersion current highestUpdate.
  	currentUpdateNumber := previousHighest.
  	done := false.
  	loaded := 0.
  		whileFalse: [currentUpdateNumber := currentUpdateNumber + 1.
  			currentUpdateNumber > lastUpdateNumber
  				ifTrue: [done := true]
  				ifFalse: [fileNames := updateDirectory fileNamesMatching: currentUpdateNumber printString , '*'.
  					fileNames size > 1
  						ifTrue: [^ self inform: 'ambiguity -- two files both start with ' , currentUpdateNumber printString , '
  (at this point it is probably best to remedy
  the situation on disk, then try again.)'].
+ 					fileNames size = 0
- 					fileNames size == 0
  						ifTrue: [Transcript cr; show: 'gap in updates from disk for update number '; print: currentUpdateNumber; show: ' found...'.
  							done := stopIfGapFlag]
  						ifFalse: [ChangeSet
  								newChangesFromStream: (updateDirectory readOnlyFileNamed: fileNames first)
  								named: fileNames first.
  							SystemVersion current registerUpdate: currentUpdateNumber.
  							loaded := loaded + 1]]].
  	aMessage := loaded = 0
  				ifTrue: ['No new updates found.']
  				ifFalse: [loaded printString , ' update(s) loaded.'].
  	self inform: aMessage , '
  Highest numbered update is now ' , (currentUpdateNumber - 1) printString , '.'!

Item was changed:
  ----- Method: Utilities class>>instanceComparisonsBetween:and: (in category 'miscellaneous') -----
  instanceComparisonsBetween: fileName1 and: fileName2
  	"For differential results, run printSpaceAnalysis twice with different fileNames,
  	then run this method...
  		Smalltalk printSpaceAnalysis: 0 on: 'STspace.text1'.
  			--- do something that uses space here ---
  		Smalltalk printSpaceAnalysis: 0 on: 'STspace.text2'.
  		Smalltalk instanceComparisonsBetween: 'STspace.text1' and 'STspace.text2'"
  	| instCountDict report f aString items className newInstCount oldInstCount newSpace oldPair oldSpace |
  	instCountDict := Dictionary new.
  	report := ReadWriteStream on: ''.
  	f := FileStream readOnlyFileNamed: fileName1.
  	[f atEnd] whileFalse:
  		[aString := f nextLine.
  		items := aString findTokens: ' '.
+ 		(items size = 4 or: [items size = 5]) ifTrue:
- 		(items size == 4 or: [items size == 5]) ifTrue:
  			[instCountDict at: items first put: (Array with: items third asNumber with: items fourth asNumber)]].
  	f close.
  	f := FileStream readOnlyFileNamed: fileName2.
  	[f atEnd] whileFalse:
  		[aString := f nextLine.
  		items := aString findTokens: ' '.
+ 		(items size = 4 or: [items size = 5]) ifTrue:
- 		(items size == 4 or: [items size == 5]) ifTrue:
  			[className := items first.
  			newInstCount := items third asNumber.
  			newSpace := items fourth asNumber.
  			oldPair := instCountDict at: className ifAbsent: [nil].
  			oldInstCount := oldPair ifNil: [0] ifNotNil: [oldPair first].
  			oldSpace := oldPair ifNil: [0] ifNotNil: [oldPair second].
  			oldInstCount ~= newInstCount ifTrue:
  				[report nextPutAll: (newInstCount - oldInstCount) printString; tab; nextPutAll: (newSpace - oldSpace) printString; tab; nextPutAll: className asString; cr]]].
  	f close.
  	(StringHolder new contents: report contents)
  		openLabel: 'Instance count differentials between ', fileName1, ' and ', fileName2!

Item was changed:
  ----- Method: Utilities class>>offerCommonRequests (in category 'common requests') -----
  	"Offer up the common-requests menu.  If the user chooses one, then evaluate it, and -- provided the value is a number or string -- show it in the Transcript."
  	"Utilities offerCommonRequests"
  	| reply result aMenu index normalItemCount strings |
  	Smalltalk isMorphic ifTrue: [^ self offerCommonRequestsInMorphic].
  	(CommonRequestStrings == nil or: [CommonRequestStrings isKindOf: Array])
  			[self initializeCommonRequestStrings].
  	strings := CommonRequestStrings contents.
  	normalItemCount := strings asString lineCount.
  	aMenu := UIManager default 
  		chooseFrom: (strings asString lines copyWith: 'edit this menu')
  		lines: (Array with: normalItemCount).
  	index := aMenu startUp.
+ 	index = 0 ifTrue: [^ self].
- 	index == 0 ifTrue: [^ self].
  	reply := aMenu labelString lineNumber: index.
+ 	reply size = 0 ifTrue: [^ self].
- 	reply size == 0 ifTrue: [^ self].
  	index > normalItemCount ifTrue:
  		[^ self editCommonRequestStrings].
  	result := self evaluate: reply in: nil to: nil.
  	(result isNumber) | (result isString)
  			[Transcript cr; nextPutAll: result printString]!

Item was changed:
  ----- Method: Utilities class>>revertLastMethodSubmission (in category 'recent method submissions') -----
  	| changeRecords lastSubmission theClass theSelector |
  	"If the most recent method submission was a method change, revert
  	that change, and if it was a submission of a brand-new method, 
  	remove that method."
  	RecentSubmissions isEmptyOrNil ifTrue: [^ Beeper beep].
  	lastSubmission := RecentSubmissions last.
  	theClass := lastSubmission actualClass ifNil: [^ Beeper beep].
  	theSelector := lastSubmission methodSymbol.
  	changeRecords := theClass changeRecordsAt: theSelector.
  	changeRecords isEmptyOrNil ifTrue: [^ Beeper beep].
+ 	changeRecords size = 1
- 	changeRecords size == 1
  			["method has no prior version, so reverting in this case means removing"
  			theClass removeSelector: theSelector]
  			[changeRecords second fileIn].
  "Utilities revertLastMethodSubmission"!

More information about the Squeak-dev mailing list