'From Croquet1.0beta of 11 April 2006 [latest update: #1] on 24 August 2008 at 10:51:07 am'!

!BlockClosure methodsFor: 'accessing' stamp: 'eem 6/16/2008 15:44'!
copiedValues
	^copiedValues! !


!Object methodsFor: 'class membership' stamp: 'eem 6/11/2008 17:53'!
inheritsFromAnyIn: aList
	"Answer whether the receiver inherits from any class represented by any element in the list.  The elements of the list can be classes, class name symbols, or strings representing possible class names.  This allows speculative membership tests to be made even when some of the classes may not be known to the current image, and even when their names are not interned symbols."

	aList do:
		[:elem | Symbol hasInterned: elem asString ifTrue: 
			[:elemSymbol | | aClass |
			(((aClass := Smalltalk at: elemSymbol ifAbsent: [nil]) isKindOf: Class)
						and: [self isKindOf: aClass])
				ifTrue:
					[^ true]]].
	^ false


"
{3.  true. 'olive'} do:
	[:token |
		 {{#Number. #Boolean}. {Number.  Boolean }.  {'Number'. 'Boolean'}} do:
			[:list |
				Transcript cr; show: token asString, ' list element provided as a ', list first class name, ' - ', (token inheritsFromAnyIn: list) asString]]
"! !

!Object methodsFor: 'comparing' stamp: 'eem 6/11/2008 17:52'!
closeTo: anObject
	"Answer whether the receiver and the argument represent the same
	object. If = is redefined in any subclass, consider also redefining the
	message hash."

	^[self = anObject] ifError: [:aString :aReceiver | ^ false]! !

!Object methodsFor: 'copying' stamp: 'eem 6/11/2008 17:52'!
copySameFrom: otherObject
	"Copy to myself all instance variables named the same in otherObject.
	This ignores otherObject's control over its own inst vars."

	| myInstVars otherInstVars |
	myInstVars := self class allInstVarNames.
	otherInstVars := otherObject class allInstVarNames.
	myInstVars doWithIndex: [:each :index | | match |
		(match := otherInstVars indexOf: each) > 0 ifTrue:
			[self instVarAt: index put: (otherObject instVarAt: match)]].
	1 to: (self basicSize min: otherObject basicSize) do: [:i |
		self basicAt: i put: (otherObject basicAt: i)].
! !


!AbstractSound methodsFor: 'file i/o' stamp: 'eem 6/11/2008 12:37'!
storeSampleCount: samplesToStore bigEndian: bigEndianFlag on: aBinaryStream
	"Store my samples on the given stream at the current SoundPlayer sampling rate. If bigFlag is true, then each 16-bit sample is stored most-significant byte first (AIFF files), otherwise it is stored least-significant byte first (WAV files). If self isStereo is true, both channels are stored, creating a stereo file. Otherwise, only the left channel is stored, creating a mono file."

	| bufSize stereoBuffer reverseBytes |
	self reset.
	bufSize := (2 * self samplingRate rounded) min: samplesToStore.  "two second buffer"
	stereoBuffer := SoundBuffer newStereoSampleCount: bufSize.
	reverseBytes := bigEndianFlag ~= (SmalltalkImage current isBigEndian).

	'Storing audio...'
		displayProgressAt: Sensor cursorPoint
		from: 0 to: samplesToStore during: [:bar | | remaining out |
			remaining := samplesToStore.
			[remaining > 0] whileTrue: [
				bar value: samplesToStore - remaining.
				stereoBuffer primFill: 0.  "clear the buffer"
				self playSampleCount: (bufSize min: remaining) into: stereoBuffer startingAt: 1.
				out := self isStereo
						ifTrue: [stereoBuffer]
						ifFalse: [stereoBuffer extractLeftChannel].
				reverseBytes ifTrue: [out reverseEndianness].
				(aBinaryStream isKindOf: StandardFileStream)
					ifTrue: [  "optimization for files: write sound buffer directly to file"
						aBinaryStream next: (out size // 2) putAll: out startingAt: 1]  "size in words"
					ifFalse: [  "for non-file streams:"
						1 to: out monoSampleCount do: [:i | aBinaryStream int16: (out at: i)]].
				remaining := remaining - bufSize]].
! !


!AcornFileDirectory methodsFor: 'file name utilities' stamp: 'tpr 12/23/2004 19:21'!
checkName: aFileName fixErrors: fixing
	"Check if the file name contains any invalid characters"
	| fName hasBadChars correctedName newChar|
	fName := super checkName: aFileName fixErrors: fixing.
	correctedName := String streamContents:[:s|
								fName do:[:c|
									(newChar := LegalCharMap at: c asciiValue +1) ifNotNil:[s nextPut: newChar]]]. 
	hasBadChars := fName ~= correctedName.
	(hasBadChars and:[fixing not]) ifTrue:[^self error:'Invalid file name'].
	hasBadChars ifFalse:[^ fName].
	^ correctedName! !


!AnalyzerTest methodsFor: 'running' stamp: 'eem 6/11/2008 12:46'!
tearDown

	classesCreated
		do: [:cls | | name |
			name := cls name.
			self removeClassNamedIfExists: name.
			ChangeSet current removeClassChanges: name].
	classesCreated := nil! !


!Archive methodsFor: 'archive operations' stamp: 'eem 6/11/2008 12:47'!
addTree: aFileNameOrDirectory removingFirstCharacters: n match: aBlock
	| dir fullPath relativePath |
	dir := (aFileNameOrDirectory isString)
		ifTrue: [ FileDirectory on: aFileNameOrDirectory ]
		ifFalse: [ aFileNameOrDirectory ].
	fullPath := dir pathName, dir slash.
	relativePath := fullPath copyFrom: n + 1 to: fullPath size.
	(dir entries select: [ :entry | aBlock value: entry])
		do: [ :ea | | fullName newMember |
		fullName := fullPath, ea name.
		newMember := ea isDirectory
				ifTrue: [ self memberClass newFromDirectory: fullName ]
				ifFalse: [ self memberClass newFromFile: fullName ].
		newMember localFileName: relativePath, ea name.
		self addMember: newMember.
		ea isDirectory ifTrue: [ self addTree: fullName removingFirstCharacters: n match: aBlock].
	].
! !


!Array methodsFor: 'converting' stamp: 'eem 6/11/2008 12:48'!
evalStrings
	   "Allows you to construct literal arrays.
    #(true false nil '5@6' 'Set new' '''text string''') evalStrings
    gives an array with true, false, nil, a Point, a Set, and a String
    instead of just a bunch of Symbols"

    ^ self collect: [:each | | it |
        it := each.
        each == #true ifTrue: [it := true].
		      each == #false ifTrue: [it := false].
        each == #nil ifTrue: [it := nil].
        (each isString and:[each isSymbol not]) ifTrue: [
			it := Compiler evaluate: each].
        each class == Array ifTrue: [it := it evalStrings].
        it]! !

!Array methodsFor: 'arithmetic' stamp: 'eem 6/11/2008 12:49'!
preMultiplyByMatrix: m
	"Answer m+*self where m is a Matrix."

	m columnCount = self size ifFalse: [self error: 'dimensions do not conform'].
	^(1 to: m rowCount) collect: [:row | | s |
		s := 0.
		1 to: self size do: [:k | s := (m at: row at: k) * (self at: k) + s].
		s]! !


!AsyncFile methodsFor: 'as yet unclassified' stamp: 'eem 6/11/2008 12:52'!
readByteCount: byteCount fromFilePosition: fPosition onCompletionDo: aBlock
	"Start a read operation to read byteCount's from the given position in this file. and fork a process to await its completion. When the operation completes, evaluate the given block. Note that, since the completion block may run asynchronous, the client may need to use a SharedQueue or a semaphore for synchronization."

	| buffer |
	buffer := String new: byteCount.
	self primReadStart: fileHandle fPosition: fPosition count: byteCount.
	"here's the process that awaits the results:"
	[| n |
		[	semaphore wait.
		  	n := self primReadResult: fileHandle intoBuffer: buffer at: 1 count: byteCount.
		  	n = Busy.
		] whileTrue.  "loop while busy in case the semaphore had excess signals"
		n = Error ifTrue: [^ self error: 'asynchronous read operation failed'].
		aBlock value: buffer.
	] forkAt: Processor userInterruptPriority.
! !

!AsyncFile methodsFor: 'as yet unclassified' stamp: 'eem 6/11/2008 12:52'!
writeBuffer: buffer atFilePosition: fPosition onCompletionDo: aBlock
	"Start an operation to write the contents of the buffer at given position in this file, and fork a process to await its completion. When the write completes, evaluate the given block. Note that, since the completion block runs asynchronously, the client may need to use a SharedQueue or a semaphore for synchronization."

	self primWriteStart: fileHandle
		fPosition: fPosition
		fromBuffer: buffer
		at: 1
		count: buffer size.
	"here's the process that awaits the results:"
	[| n |
		[	semaphore wait.
		  	n := self primWriteResult: fileHandle.
		  	n = Busy.
		] whileTrue.  "loop while busy in case the semaphore had excess signals"
		n = Error ifTrue: [^ self error: 'asynchronous write operation failed'].
		n = buffer size ifFalse: [^ self error: 'did not write the entire buffer'].
		aBlock value.
	] forkAt: Processor userInterruptPriority.
! !


!Behavior methodsFor: 'accessing method dictionary' stamp: 'eem 6/11/2008 16:05'!
selectorsWithArgs: numberOfArgs
	"Return all selectors defined in this class that take this number of arguments.  Could use String.keywords.  Could see how compiler does this."

	| list |
	list := OrderedCollection new.
	self selectorsDo: [:aSel | | num |
		num := aSel count: [:char | char == $:].
		num = 0 ifTrue: [aSel last isLetter ifFalse: [num := 1]].
		num = numberOfArgs ifTrue: [list add: aSel]].
	^ list! !

!Behavior methodsFor: 'user interface' stamp: 'eem 6/11/2008 16:03'!
allUnreferencedInstanceVariables
	"Return a list of the instance variables known to the receiver which are not referenced in the receiver or any of its subclasses OR superclasses"

	^ self allInstVarNames copy reject:
		[:ivn | | any definingClass |
		any := false.
		definingClass := self classThatDefinesInstanceVariable: ivn.
		definingClass withAllSubclasses do:
			[:class |  any ifFalse:
				[(class whichSelectorsAccess: ivn asSymbol) do: 
					[:sel | sel ~~ #DoIt ifTrue: [any := true]]]].
			any]! !

!Behavior methodsFor: 'user interface' stamp: 'eem 6/11/2008 16:07'!
unreferencedInstanceVariables
	"Return a list of the instance variables defined in the receiver which are not referenced in the receiver or any of its subclasses.  2/26/96 sw"

	^ self instVarNames copy reject:
		[:ivn | | any |
		any := false.
		self withAllSubclasses do:
			[:class |  (class whichSelectorsAccess: ivn) do: 
					[:sel | sel ~~ #DoIt ifTrue: [any := true]]].
		any]

"Object unreferencedInstanceVariables"! !

!Behavior methodsFor: 'private' stamp: 'eem 6/11/2008 16:06'!
spaceUsed
	"Answer a rough estimate of number of bytes used by this class and its metaclass. Does not include space used by class variables."

	| space |
	space := 0.
	self selectorsDo: [:sel | | method  |
		space := space + 16.  "dict and org'n space"
		method := self compiledMethodAt: sel.
		space := space + (method size + 6 "hdr + avg pad").
		method literals do: [:lit |
			(lit isMemberOf: Array) ifTrue: [space := space + ((lit size + 1) * 4)].
			(lit isMemberOf: Float) ifTrue: [space := space + 12].
			(lit isMemberOf: ByteString) ifTrue: [space := space + (lit size + 6)].
			(lit isMemberOf: LargeNegativeInteger) ifTrue: [space := space + ((lit size + 1) * 4)].
			(lit isMemberOf: LargePositiveInteger) ifTrue: [space := space + ((lit size + 1) * 4)]]].
	^space! !

!Behavior methodsFor: '*Tweak-Hacks' stamp: 'eem 6/11/2008 16:04'!
fieldNamed: aSymbol

	^self allFields
		detect:
			[:any| any name = aSymbol]
		ifNone:
			[| aGetter |
			(aGetter := aSymbol) last == $: 
				ifTrue: ["allow a setter like borderWidth:, to retrieve field borderWidth"
					aGetter := (aSymbol copyFrom: 1 to: (aSymbol indexOf: $:)-1) asSymbol.
					self fieldNamed: aGetter]
				ifFalse: [nil]]! !


!BlockNode methodsFor: '*VMMaker-C translation' stamp: 'eem 6/11/2008 16:12'!
asTranslatorNode
	"make a CCodeGenerator equivalent of me"
	| statementList |
	statementList := OrderedCollection new.
	statements
		do: [:s | | newS | 
			newS := s asTranslatorNode.
			newS isStmtList
				ifTrue: ["inline the statement list returned when a CascadeNode is 
					translated "
					statementList addAll: newS statements]
				ifFalse: [statementList add: newS]].
	^ TStmtListNode new
		setArguments: (arguments asArray
				collect: [:arg | arg key])
		statements: statementList;
		 comment: comment! !


!ChangeList methodsFor: 'menu actions' stamp: 'eem 6/11/2008 16:45'!
browseCurrentVersionsOfSelections
	"Opens a message-list browser on the current in-memory versions of all methods that are currently seleted"
	| aList |

	aList := OrderedCollection new.
	Cursor read showWhile: [
		1 to: changeList size do: [:i |
			(listSelections at: i) ifTrue: [
				| aClass aChange |
				aChange := changeList at: i.
				(aChange type = #method
					and: [(aClass := aChange methodClass) notNil
					and: [aClass includesSelector: aChange methodSelector]])
						ifTrue: [
							aList add: (
								MethodReference new
									setStandardClass: aClass  
									methodSymbol: aChange methodSelector
							)
						]]]].

	aList size == 0 ifTrue: [^ self inform: 'no selected methods have in-memory counterparts'].
	MessageSet 
		openMessageList: aList 
		name: 'Current versions of selected methods in ', file localName! !

!ChangeList methodsFor: 'menu actions' stamp: 'eem 6/11/2008 16:45'!
optionalButtonRow
	"Answer a row of buttons to occur in a tool pane"

	| aRow |
	aRow := AlignmentMorph newRow.
	aRow hResizing: #spaceFill.
	aRow clipSubmorphs: true.
	aRow layoutInset: 5@2; cellInset: 3.
	aRow wrapCentering: #center; cellPositioning: #leftCenter.
	self changeListButtonSpecs do:
		[:triplet | | aButton |
			aButton := PluggableButtonMorph
				on: self
				getState: nil
				action: triplet second.
			aButton
				hResizing: #spaceFill;
				vResizing: #spaceFill;
				useRoundedCorners;
				label: triplet first asString;
				askBeforeChanging: true;
				onColor: Color transparent offColor: Color transparent.

			aRow addMorphBack: aButton.
			aButton setBalloonText: triplet third].
	aRow addMorphBack: self regularDiffButton.
	self wantsPrettyDiffOption ifTrue:
		[aRow addMorphBack: self prettyDiffButton].
	^ aRow! !


!ClassBuilder methodsFor: 'class mutation' stamp: 'eem 6/11/2008 16:47'!
mutate: oldClass to: newClass
	"Mutate the old class and subclasses into newClass and subclasses.
	Note: This method is slightly different from: #mutate:toSuper: since
	here we are at the root of reshaping and have two distinct roots."

	self showProgressFor: oldClass.
	"Convert the subclasses"
	oldClass subclasses do:[:oldSubclass| | newSubclass |
		newSubclass := self reshapeClass: oldSubclass toSuper: newClass.
		self mutate: oldSubclass to: newSubclass.
	].
	"And any obsolete ones"
	oldClass obsoleteSubclasses do:[:oldSubclass| | newSubclass |
		oldSubclass ifNotNil:[
			newSubclass := self reshapeClass: oldSubclass toSuper: newClass.
			self mutate: oldSubclass to: newSubclass.
		].
	].
	self update: oldClass to: newClass.
	^newClass! !


!ClassChangeRecord methodsFor: 'isolation layers' stamp: 'eem 6/11/2008 16:51'!
invokePhase1

	| elements |
	revertable ifFalse: [^ self].
	inForce ifTrue: [self error: 'Can invoke only when not in force.'].

	"Do the first part of the invoke operation -- no particular hurry."
	"Save the outer method dictionary for quick revert of method changes."
	priorMD := self realClass methodDict.

	"Prepare a methodDictionary for switcheroo."
	thisMD := self realClass methodDict copy.
	methodChanges associationsDo:
		[:assn | | selector changeRecord type |
		selector := assn key.
		changeRecord := assn value.
		type := changeRecord changeType.
		type = #remove ifTrue: [thisMD removeKey: selector].
		type = #add ifTrue: [thisMD at: selector put: changeRecord currentMethod].
		type = #change ifTrue: [thisMD at: selector put: changeRecord currentMethod].
		].

	"Replace the original organization (and comment)."
	priorOrganization := self realClass organization.
	thisOrganization elementArray copy do:
		[:sel | (thisMD includesKey: sel) ifFalse: [thisOrganization removeElement: sel]].
	#(DoIt DoItIn:) do: [:sel | thisMD removeKey: sel ifAbsent: []].
	thisOrganization elementArray size = thisMD size ifFalse:
		[elements := thisOrganization elementArray asSet.
		thisMD keysDo:
			[:sel | (elements includes: sel) ifFalse:
				[thisOrganization classify: sel
					under: (priorOrganization categoryOfElement: sel)]]].
	self realClass organization: thisOrganization.


! !

!ClassChangeRecord methodsFor: 'removal' stamp: 'eem 6/11/2008 16:50'!
forgetChangesIn: otherRecord
	"See forgetAllChangesFoundIn:.  Used in culling changeSets."

	| cls otherMethodChanges |
	(cls := self realClass) == nil ifTrue: [^ self].  "We can do better now, though..."
	otherMethodChanges := otherRecord methodChangeTypes.
	otherMethodChanges associationsDo:
		[:assoc | | selector actionToSubtract |
		selector := assoc key. actionToSubtract := assoc value.
		(cls includesSelector: selector)
			ifTrue: [(#(add change) includes: actionToSubtract)
					ifTrue: [methodChanges removeKey: selector ifAbsent: []]]
			ifFalse: [(#(remove addedThenRemoved) includes: actionToSubtract)
					ifTrue: [methodChanges removeKey: selector ifAbsent: []]]].
	changeTypes isEmpty ifFalse:
		[changeTypes removeAllFoundIn: otherRecord allChangeTypes.
		(changeTypes includes: #rename) ifFalse:
			[changeTypes removeAllSuchThat: [:x | x beginsWith: 'oldName: ']]]! !

!ClassChangeRecord methodsFor: 'method changes' stamp: 'eem 6/11/2008 16:50'!
compileAll: newClass from: oldClass
	"Something about this class has changed.  Locally retained methods must be recompiled.
	NOTE:  You might think that if this changeSet is in force, then we can just note
	the new methods but a lower change set may override and be in force which
	would mean that only the overriding copies go recompiled.  Just do it."

	methodChanges associationsDo:
		[:assn | | sel changeType changeRecord newMethod |
		sel := assn key.
		changeRecord := assn value.
		changeType := changeRecord changeType.
		(changeType == #add or: [changeType == #change]) ifTrue:
			[newMethod := newClass
				recompileNonResidentMethod: changeRecord currentMethod
				atSelector: sel from: oldClass.
			changeRecord noteNewMethod: newMethod]]! !

!ClassChangeRecord methodsFor: 'method changes' stamp: 'eem 6/11/2008 16:53'!
methodChangeTypes
	"Return an old-style dictionary of method change types."

	| dict |
	dict := IdentityDictionary new.
	methodChanges associationsDo:
		[:assn | | selector record |
		selector := assn key.
		record := assn value.
		dict at: selector put: record changeType].
	^ dict! !


!ClassDescription methodsFor: 'instance variables' stamp: 'eem 6/11/2008 16:53'!
chooseClassVarName 
	"Present the user with a list of class variable names and answer the one selected, or nil if none"

	| lines labelStream allVars index |
	lines := OrderedCollection new.
	allVars := OrderedCollection new.
	labelStream := WriteStream on: (String new: 200).
	self withAllSuperclasses reverseDo:
		[:class | | vars |
		vars := class classVarNames asSortedCollection.
		vars do:
			[:var |
			labelStream nextPutAll: var; cr.
			allVars add: var].
		vars isEmpty ifFalse: [lines add: allVars size]].
	labelStream contents isEmpty ifTrue: [^Beeper beep]. "handle nil superclass better"
	labelStream skip: -1 "cut last CR".
	index := (UIManager default chooseFrom: (labelStream contents substrings) lines: lines).
	index = 0 ifTrue: [^ nil].
	^ allVars at: index! !

!ClassDescription methodsFor: 'instance variables' stamp: 'eem 6/17/2008 07:59'!
chooseInstVarThenDo: aBlock 
	"Put up a menu of all the instance variables in the receiver, and when
the user chooses one, evaluate aBlock with the chosen variable as its
parameter.  If the list is 6 or larger, then offer an alphabetical
formulation as an alternative. triggered by a 'show alphabetically' item
at the top of the list."

	| lines labelStream allVars index count offerAlpha |
	(count := self allInstVarNames size) = 0 ifTrue: 
		[^self inform: 'There are no\instance variables.' withCRs].

	allVars := OrderedCollection new.
	lines := OrderedCollection new.
	labelStream := WriteStream on: (String new: 200).

	(offerAlpha := count > 5) ifTrue:
		[lines add: 1.
		 allVars add: 'show alphabetically'.
		 labelStream nextPutAll: allVars first; cr].
	self withAllSuperclasses reverseDo:
		[:class | | vars |
		vars := class instVarNames.
		vars do:
			[:var |
			labelStream nextPutAll: var; cr.
			allVars add: var].
		vars isEmpty ifFalse: [lines add: allVars size]].
	labelStream skip: -1 "cut last CR".
	(lines size > 0 and: [lines last = allVars size]) ifTrue:
		[lines removeLast].  "dispense with inelegant line beneath last item"
	index := UIManager default
				chooseFrom: (labelStream contents findTokens: Character cr) asArray
				lines: lines
				title: 'Instance variables in ', self name.
	index = 0 ifTrue: [^self].
	(index = 1 and: [offerAlpha]) ifTrue:
		[^self chooseInstVarAlphabeticallyThenDo: aBlock].
	aBlock value: (allVars at: index)! !


!AbstractFont class methodsFor: 'as yet unclassified' stamp: 'eem 6/11/2008 12:35'!
emphasisStringFor: emphasisCode
	"Answer a translated string that represents the attributes given in emphasisCode."

	| emphases |
	emphasisCode = 0 ifTrue: [ ^'Normal' translated ].

	emphases := (IdentityDictionary new)
		at: 1 put: 'Bold' translated;
		at: 2 put: 'Italic' translated;
		at: 4 put: 'Underlined' translated;
		at: 8 put: 'Narrow' translated;
		at: 16 put: 'StruckOut' translated;
		yourself.

	^String streamContents: [ :s | | bit |
		bit := 1.
		[ bit < 32 ] whileTrue: [ | code |
			code := emphasisCode bitAnd: bit.
			code isZero ifFalse: [ s nextPutAll: (emphases at: code); space ].
			bit := bit bitShift: 1 ].
		s position isZero ifFalse: [ s skip: -1 ].
	]! !


!AbstractSound class methodsFor: 'instance creation' stamp: 'eem 6/11/2008 12:41'!
noteSequenceOn: aSound from: anArray
	"Build a note sequence (i.e., a SequentialSound) from the given array using the given sound as the instrument. Elements are either (pitch, duration, loudness) triples or (#rest duration) pairs.  Pitches can be given as names or as numbers."
	| score |
	score := SequentialSound new.
	anArray do: [:el | | pitch |
		el size = 3
			ifTrue: [
				pitch := el at: 1.
				pitch isNumber ifFalse: [pitch := self pitchForName: pitch].
				score add: (
					aSound
						soundForPitch: pitch
						dur: (el at: 2)
						loudness: (el at: 3) / 1000.0)]
			ifFalse: [
				score add: (RestSound dur: (el at: 2))]].
	^ score
! !

!AbstractSound class methodsFor: 'utilities' stamp: 'eem 6/11/2008 12:40'!
dial: aString
	| s |
	"AbstractSound dial: '867-5309'" "ask for Jenny"

	s := SequentialSound new.
	aString do: [ :c | | index lo hi m |
		c = $,
			ifTrue: [ s add: (FMSound new setPitch: 1 dur: 1 loudness: 0) ]
			ifFalse: [
				(index := ('123A456B789C*0#D' indexOf: c)) > 0
					ifTrue: [
						lo := #(697 770 852 941) at: (index - 1 // 4 + 1).
						hi := #(1209 1336 1477 1633) at: (index - 1 \\ 4 + 1).
						m := MixedSound new.
						m add: (FMSound new setPitch: lo dur: 0.15 loudness: 0.5).
						m add: (FMSound new setPitch: hi dur: 0.15 loudness: 0.5).
						s add: m.
						s add: (FMSound new setPitch: 1 dur: 0.05 loudness: 0)]]].
	^ s play.

! !

!AbstractSound class methodsFor: 'utilities' stamp: 'eem 6/11/2008 12:43'!
pitchTable
	"AbstractSound pitchTable"

	| out i |
	out := WriteStream on: (String new: 1000).
	i := 12.
	0 to: 8 do: [:octave |
		#(c 'c#' d eb e f fs g 'g#' a bf b) do: [:noteName | | note |
			note := noteName, octave printString.
			out nextPutAll: note; tab.
			out nextPutAll: i printString; tab.
			out nextPutAll: (AbstractSound pitchForName: note) printString; cr.
			i := i + 1]].
	^ out contents
! !

!AbstractSound class methodsFor: 'examples' stamp: 'eem 6/11/2008 12:41'!
majorChordOn: aSound from: aPitch
	"FMSound majorChord play"

	| score majorScale leadingRest pan |
	majorScale := self majorPitchesFrom: aPitch.
	score := MixedSound new.
	leadingRest := pan := 0.
	#(1 3 5 8) do: [:noteIndex | | note |
		note := aSound
					soundForPitch: (majorScale at: noteIndex)
					dur: 2.0 - leadingRest
					loudness: 0.3.
		score add: (RestSound dur: leadingRest), note pan: pan.
		leadingRest := leadingRest + 0.2.
		pan := pan + 0.3].
	^ score
! !


!BalloonEngine class methodsFor: 'private' stamp: 'eem 6/11/2008 13:00'!
recycleBuffer: balloonBuffer
	"Try to keep the buffer for later drawing operations."

	CacheProtect critical:[ | buffer |
		buffer := BufferCache at: 1.
		(buffer isNil or:[buffer size < balloonBuffer size] )
			ifTrue:[BufferCache at: 1 put: balloonBuffer].
	].! !


!BDFFontReader class methodsFor: 'file creation' stamp: 'eem 6/11/2008 13:31'!
convertFilesNamed: fileName toFamilyNamed: familyName inDirectoryNamed: dirName
		"BDFFontReader convertFilesNamed: 'helvR' toFamilyNamed: 'Helvetica' inDirectoryNamed: '' "

	"This utility converts X11 BDF font files to Squeak .sf2 StrikeFont files."

	"For this utility to work as is, the BDF files must be named 'familyNN.bdf',
	and must reside in the directory named by dirName (use '' for the current directory).
	The output StrikeFont files will be named familyNN.sf2, and will be placed in the
	current directory."

	| allFontNames dir |
	"Check for matching file names."
	dir := dirName isEmpty
		ifTrue: [FileDirectory default]
		ifFalse: [FileDirectory default directoryNamed: dirName].
	allFontNames := dir fileNamesMatching: fileName , '##.bdf'.
	allFontNames isEmpty ifTrue: [^ self error: 'No files found like ' , fileName , 'NN.bdf'].
	
	Utilities informUserDuring: [:info |
		allFontNames do: [:fname | | sizeChars f |
			info value: 'Converting ', familyName, ' BDF file ', fname, ' to SF2 format'.
			sizeChars := (fname copyFrom: fileName size + 1 to: fname size) copyUpTo: $. .

			f := StrikeFont new readBDFFromFile: (dir fullNameFor: fname) name: familyName, sizeChars.
			f writeAsStrike2named: familyName, sizeChars, '.sf2'.
		].
	]! !

!BDFFontReader class methodsFor: 'resource download' stamp: 'eem 6/11/2008 13:32'!
downloadFonts  "BDFFontReader downloadFonts"
	"Download a standard set of BDF sources from x.org.  
	The combined size of these source files is around 1.2M; after conversion 
	to .sf2 format they may be deleted."

	| heads tails filenames baseUrl basePath |
	heads := #( 'charR' 'courR' 'helvR' 'lubR' 'luRS' 'lutRS' 'ncenR' 'timR' ).
	tails := #( '08' '10' '12' '14' '18' '24').

	filenames := OrderedCollection new.
	heads do: [:head |
		filenames addAll: (tails collect: [:tail | head , tail , '.bdf'])
	].

	baseUrl := Url absoluteFromText: 'http://ftp.x.org/pub/R6.4/xc/fonts/bdf/75dpi/'.
	basePath := baseUrl path.

	filenames do: [:filename | | newUrl newPath document f |
		newUrl := baseUrl clone.
		newPath := OrderedCollection newFrom: basePath.

		newPath addLast: filename.
		newUrl path: newPath.

		Utilities informUser: 'Fetching ' , filename during: 
			[document := newUrl retrieveContents].

		f := CrLfFileStream newFileNamed: filename.
		f nextPutAll: document content.
		f close.
	].
! !

!BDFFontReader class methodsFor: 'resource download' stamp: 'eem 6/11/2008 13:33'!
installX11Fonts "BDFFontReader installX11Fonts"
	"Installs previously-converted .sf2 fonts into the TextConstants dictionary.  This makes them available as TextStyles everywhere in the image."

	| families |
	families := #( 'Courier' 'Helvetica' 'LucidaBright' 'Lucida' 'LucidaTypewriter' 'NewCenturySchoolbook' 'TimesRoman' ).

	families do: [:family | | fontArray textStyle |
		fontArray := StrikeFont readStrikeFont2Family: family.
		textStyle := TextStyle fontArray: fontArray.
		TextConstants at: family asSymbol put: textStyle.
	].
! !


!Bezier3Segment class methodsFor: 'utilities' stamp: 'eem 6/11/2008 16:08'!
makeEllipseSegments: aRectangle count: segmentCount
	"Answer a set of bezier segments approximating an ellipsoid fitting the given rectangle.
	This method creates segmentCount bezier segments (one for each quadrant) approximating the oval."
	| count angle center scale |
	center := aRectangle origin + aRectangle corner * 0.5.
	scale := aRectangle extent * 0.5.
	count := segmentCount max: 2. "need at least two segments"
	angle := 360.0 / count.
	^(1 to: count) collect:[:i| | seg |
		seg := self makeUnitPieSegmentFrom: i-1*angle to: i*angle.
		self controlPoints: (seg controlPoints collect:[:pt| pt * scale + center])
	].! !


!ClassOrganizer methodsFor: 'private' stamp: 'eem 6/11/2008 17:00'!
notifyOfChangedSelectorsOldDict: oldDictionaryOrNil newDict: newDictionaryOrNil
	(oldDictionaryOrNil isNil and: [newDictionaryOrNil isNil])
		ifTrue: [^ self].
		
	oldDictionaryOrNil isNil ifTrue: [
	newDictionaryOrNil keysAndValuesDo: [:el :cat |
		self notifyOfChangedSelector: el from: nil to: cat].
		^ self.
	].

	newDictionaryOrNil isNil ifTrue: [
	oldDictionaryOrNil keysAndValuesDo: [:el :cat |
		self notifyOfChangedSelector: el from: cat to: nil].
		^ self.
	].
		
	oldDictionaryOrNil keysAndValuesDo: [:el :cat | | newCat |
		newCat := newDictionaryOrNil at: el.
		self notifyOfChangedSelector: el from: cat to: newCat.
	].! !


!CompiledMethod methodsFor: 'printing' stamp: 'eem 6/11/2008 17:08'!
who
	"Answer an Array of the class in which the receiver is defined and the 
	selector to which it corresponds."

	self hasNewPropertyFormat ifTrue:[^{self methodClass. self selector}].
	self systemNavigation allBehaviorsDo: 
		[:class | 
		(class methodDict keyAtIdentityValue: self ifAbsent: [nil]) ifNotNil:
			[:sel| ^Array with: class with: sel]].
	^Array with: #unknown with: #unknown! !

!CompiledMethod methodsFor: 'scanning' stamp: 'eem 6/11/2008 17:07'!
scanVeryLongStore: extension offset: offset
	"Answer whether the receiver contains a long load with the given offset.
	Note that the constant +32 is the known difference between a
	store and a storePop for instVars, and it will always fail on literal variables,
	but these only use store (followed by pop) anyway."
	| scanner |
	scanner := InstructionStream on: self.
	^scanner scanFor:
		[:instr | | ext |
		(instr = 132 and: [(ext := scanner followingByte) = extension
											or: ["might be a store/pop into rcvr"
												ext = (extension+32)]])
		and: [scanner thirdByte = offset]]! !

!CompiledMethod methodsFor: '*Tweak-Hacks' stamp: 'eem 6/11/2008 17:06'!
readsTweakField: field
	"Answer whether the receiver reads the given field"
	| toGet scanner max |
	toGet := field toGet ifNil:[^false].
	(self hasLiteral: toGet) ifFalse:[^false].
	max := self numLiterals.
	"We scan the first sixteen accurately"
	max > 16 ifTrue:[max := 16].
	1 to: self numLiterals do:[:i|
		(self literalAt: i) == toGet ifTrue:[
			"scan for push: self; send: toGet"
			scanner := InstructionStream on: self.
			scanner scanFor: [:insn| | byte type offset |
				(insn = 16r70 "push self") ifTrue:[
					byte := self at: scanner pc+1.
					type := byte // 16.
					offset := byte \\ 16.
					type > 12 ifTrue:[
						(offset+1 = i) ifTrue:[^true].
					].
				].
				false
			].
		].
	].
	17 to: self numLiterals do:[:i|
		(self literalAt: i) == toGet ifTrue:[^true].
	].
	^false! !


!Compiler methodsFor: 'public access' stamp: 'eem 6/11/2008 17:12'!
evaluate: textOrStream in: aContext to: receiver notifying: aRequestor ifFail: failBlock logged: logFlag
	"Compiles the sourceStream into a parse tree, then generates code into a 
	method. This method is then installed in the receiver's class so that it 
	can be invoked. In other words, if receiver is not nil, then the text can 
	refer to instance variables of that receiver (the Inspector uses this). If 
	aContext is not nil, the text can refer to temporaries in that context (the 
	Debugger uses this). If aRequestor is not nil, then it will receive a 
	notify:at: message before the attempt to evaluate is aborted. Finally, the 
	compiled method is invoked from here as DoIt or (in the case of 
	evaluation in aContext) DoItIn:. The method is subsequently removed 
	from the class, but this will not get done if the invocation causes an 
	error which is terminated. Such garbage can be removed by executing: 
	Smalltalk allBehaviorsDo: [:cl | cl removeSelector: #DoIt; removeSelector: 
	#DoItIn:]."

	| methodNode method value selector toLog itsSelection itsSelectionString |
	class := (aContext == nil ifTrue: [receiver] ifFalse: [aContext receiver]) class.
	self from: textOrStream class: class context: aContext notifying: aRequestor.
	methodNode := self translate: sourceStream noPattern: true ifFail:
		[^failBlock value].
	method := methodNode generate: #(0 0 0 0).
	self interactive ifTrue:
		[method := method copyWithTempNames: methodNode tempNames].
	
	selector := context isNil
		ifTrue: [#DoIt]
		ifFalse: [#DoItIn:].
	class addSelectorSilently: selector withMethod: method.
	value := context isNil
		ifTrue: [receiver DoIt]
		ifFalse: [receiver DoItIn: context].
	InMidstOfFileinNotification signal 
		ifFalse: [class basicRemoveSelector: selector].

	logFlag ifTrue:[
		toLog := ((requestor respondsTo: #selection)  
			and:[(itsSelection := requestor selection) notNil
			and:[(itsSelectionString := itsSelection asString) isEmptyOrNil not]])
				ifTrue:[itsSelectionString]
				ifFalse:[sourceStream contents].
		SystemChangeNotifier uniqueInstance evaluated: toLog context: aContext].
	^ value! !


!ContextPart methodsFor: 'system simulation' stamp: 'eem 6/16/2008 15:39'!
runSimulated: aBlock contextAtEachStep: block2
	"Simulate the execution of the argument, aBlock, until it ends. aBlock 
	MUST NOT contain an '^'. Evaluate block2 with the current context 
	prior to each instruction executed. Answer the simulated value of aBlock."
	| current |
	aBlock hasMethodReturn
		ifTrue: [self error: 'simulation of blocks with ^ can run loose'].
	current := aBlock asContext.
	current pushArgs: Array new from: self.
	[current == self]
		whileFalse:
			[block2 value: current.
			current := current step].
	^self pop! !


!DeepCopier methodsFor: 'like fullCopy' stamp: 'eem 6/11/2008 17:21'!
checkDeep
	"Write exceptions in the Transcript.  Every class that implements veryDeepInner: must copy all its inst vars.  Danger is that a user will add a new instance variable and forget to copy it.  This check is only run by hand once in a while to make sure nothing was forgotten.  
(Please do not remove this method.)
	DeepCopier new checkDeep 	"

	Transcript
		cr;
		show: 'Instance variables shared with the original object when it is copied'.
	(self systemNavigation allClassesImplementing: #veryDeepInner:) do: 
		[:aClass | | mm |
		(mm := aClass instVarNames size) > 0 ifTrue:
			[aClass instSize - mm + 1 to: aClass instSize do: 
				[:index | 
				((aClass compiledMethodAt: #veryDeepInner:) writesField: index) ifFalse: 
					[Transcript
						cr;
						show: aClass name;
						space;
						show: (aClass allInstVarNames at: index)]]]]! !

!DeepCopier methodsFor: 'like fullCopy' stamp: 'eem 6/11/2008 17:21'!
checkVariables
	"Check that no indexes of instance vars have changed in certain classes.  If you get an error in this method, an implementation of veryDeepCopyWith: needs to be updated.  The idea is to catch a change while it is still in the system of the programmer who made it.  
	DeepCopier new checkVariables	"

	self checkBasicClasses.

	"Every class that implements veryDeepInner: must copy all its inst vars.  Danger is that a user will add a new instance variable and forget to copy it.  So check that the last one is mentioned in the copy method."
	(self systemNavigation allClassesImplementing: #veryDeepInner:) do: 
			[:aClass | 
			((aClass compiledMethodAt: #veryDeepInner:) writesField: aClass instSize) 
				ifFalse: 
					[aClass instSize > 0 
						ifTrue: [self warnIverNotCopiedIn: aClass sel: #veryDeepInner:]]].
	(self systemNavigation allClassesImplementing: #veryDeepCopyWith:) do: 
			[:aClass | | meth |
			meth := aClass compiledMethodAt: #veryDeepCopyWith:.
			meth size > 20 & (meth literals includes: #veryDeepCopyWith:) not 
				ifTrue: 
					[(meth writesField: aClass instSize) 
						ifFalse: [self warnIverNotCopiedIn: aClass sel: #veryDeepCopyWith:]]]! !

!DeepCopier methodsFor: 'like fullCopy' stamp: 'eem 6/11/2008 17:22'!
fixDependents
	"They are not used much, but need to be right"

	DependentsFields associationsDo:
		[:pair |
		pair value do:
			[:dep |
			(references at: dep ifAbsent: [nil]) ifNotNil:
				[:newDep| | newModel |
				newModel := references at: pair key ifAbsent: [pair key].
				newModel addDependent: newDep]]].
! !

!DeepCopier methodsFor: 'like fullCopy' stamp: 'eem 6/11/2008 17:23'!
mapUniClasses
	"For new Uniclasses, map their class vars to the new objects.  And their additional class instance vars.  (scripts slotInfo) and cross references like (player321)."
	"Players also refer to each other using associations in the References dictionary.  Search the methods of our Players for those.  Make new entries in References and point to them."
| pp |

	newUniClasses ifFalse: [^ self].	"All will be siblings.  uniClasses is empty"
"Uniclasses use class vars to hold onto siblings who are referred to in code"
pp := Player class superclass instSize.
uniClasses do: [:playersClass | "values = new ones"
	playersClass classPool associationsDo: [:assoc |
		assoc value: (assoc value veryDeepCopyWith: self)].
	playersClass scripts: (playersClass privateScripts veryDeepCopyWith: self).	"pp+1"
	"(pp+2) slotInfo was deepCopied in copyUniClass and that's all it needs"
	pp+3 to: playersClass class instSize do: [:ii | 
		playersClass instVarAt: ii put: 
			((playersClass instVarAt: ii) veryDeepCopyWith: self)].
	].

"Make new entries in References and point to them."
References keys "copy" do: [:playerName | | oldPlayer newKey |
	oldPlayer := References at: playerName.
	(references includesKey: oldPlayer) ifTrue: [
		newKey := (references at: oldPlayer) "new player" uniqueNameForReference.
		"now installed in References"
		(references at: oldPlayer) renameTo: newKey]].
uniClasses "values" do: [:newClass | | oldSelList newSelList |
	oldSelList := OrderedCollection new.   newSelList := OrderedCollection new.
	newClass selectorsDo: [:sel | 
		(newClass compiledMethodAt: sel)	 literals do: [:assoc |
			assoc isVariableBinding ifTrue: [
				(References associationAt: assoc key ifAbsent: [nil]) == assoc ifTrue: [
					| newKey newAssoc |
					newKey := (references at: assoc value ifAbsent: [assoc value]) 
									externalName asSymbol.
					(assoc key ~= newKey) & (References includesKey: newKey) ifTrue: [
						newAssoc := References associationAt: newKey.
						newClass methodDictionary at: sel put: 
							(newClass compiledMethodAt: sel) clone.	"were sharing it"
						(newClass compiledMethodAt: sel)
							literalAt: ((newClass compiledMethodAt: sel) literals indexOf: assoc)
							put: newAssoc.
						(oldSelList includes: assoc key) ifFalse: [
							oldSelList add: assoc key.  newSelList add: newKey]]]]]].
	oldSelList with: newSelList do: [:old :new |
			newClass replaceSilently: old to: new]].	"This is text replacement and can be wrong"! !


!Dictionary methodsFor: 'accessing' stamp: 'eem 6/11/2008 17:25'!
associationDeclareAt: aKey
	"Return an existing association, or create and return a new one.  Needed as a single message by ImageSegment.prepareToBeSaved."

	^ self associationAt: aKey ifAbsent: [| existing |
		(Undeclared includesKey: aKey)
			ifTrue: 
				[existing := Undeclared associationAt: aKey.
				Undeclared removeKey: aKey.
				self add: existing]
			ifFalse: 
				[self add: aKey -> false]]! !

!Dictionary methodsFor: 'removing' stamp: 'eem 6/11/2008 17:26'!
unreferencedKeys
	"TextConstants unreferencedKeys"

	^'Scanning for references . . .' 
		displayProgressAt: Sensor cursorPoint
		from: 0
		to: self size
		during: 
			[:bar | | n |
			n := 0.
			self keys select: 
					[:key | 
					bar value: (n := n + 1).
					(self systemNavigation allCallsOn: (self associationAt: key)) isEmpty]]! !


!Encoder methodsFor: 'results' stamp: 'eem 6/11/2008 17:32'!
tempsAndBlockArgs
	| tempNodes |
	tempNodes := OrderedCollection new.
	scopeTable associationsDo:
		[:assn | | var |
		var := assn value.
		((var isTemp and: [var isArg not])
					and: [var scope = 0 or: [var scope = -1]])
			ifTrue: [tempNodes add: var]].
	^tempNodes! !

!Encoder methodsFor: 'private' stamp: 'eem 6/11/2008 17:31'!
name: name key: key class: leafNodeClass type: type set: dict

	^dict 
		at: key
		ifAbsent: 
			[dict
				at: key
				put: (leafNodeClass new
						name: name
						key: key
						index: nil
						type: type)]! !


!Heap class methodsFor: 'examples' stamp: 'eem 6/11/2008 17:39'!
heapExample	"Heap heapExample"
	"Create a sorted collection of numbers, remove the elements
	sequentially and add new objects randomly.
	Note: This is the kind of benchmark a heap is designed for."
	| n rnd array time |
	n := 5000. "# of elements to sort"
	rnd := Random new.
	array := (1 to: n) collect:[:i| rnd next].
	"First, the heap version"
	time := Time millisecondsToRun:[| sorted |
		sorted := Heap withAll: array.
		1 to: n do:[:i| 
			sorted removeFirst.
			sorted add: rnd next].
	].
	Transcript cr; show:'Time for Heap: ', time printString,' msecs'.
	"The quicksort version"
	time := Time millisecondsToRun:[| sorted |
		sorted := SortedCollection withAll: array.
		1 to: n do:[:i| 
			sorted removeFirst.
			sorted add: rnd next].
	].
	Transcript cr; show:'Time for SortedCollection: ', time printString,' msecs'.
! !

!Heap class methodsFor: 'examples' stamp: 'eem 6/11/2008 17:40'!
heapSortExample	"Heap heapSortExample"
	"Sort a random collection of Floats and compare the results with
	SortedCollection (using the quick-sort algorithm) and 
	ArrayedCollection>>mergeSortFrom:to:by: (using the merge-sort algorithm)."
	| n rnd array time |
	n := 10000. "# of elements to sort"
	rnd := Random new.
	array := (1 to: n) collect:[:i| rnd next].
	"First, the heap version"
	time := Time millisecondsToRun:[| sorted |
		sorted := Heap withAll: array.
		1 to: n do:[:i| sorted removeFirst].
	].
	Transcript cr; show:'Time for heap-sort: ', time printString,' msecs'.
	"The quicksort version"
	time := Time millisecondsToRun:[| sorted |
		sorted := SortedCollection withAll: array.
	].
	Transcript cr; show:'Time for quick-sort: ', time printString,' msecs'.
	"The merge-sort version"
	time := Time millisecondsToRun:[
		array mergeSortFrom: 1 to: array size by: [:v1 :v2| v1 <= v2].
	].
	Transcript cr; show:'Time for merge-sort: ', time printString,' msecs'.
! !


!MessageTally methodsFor: 'initialize-release' stamp: 'eem 6/26/2008 09:14'!
spyEvery: millisecs on: aBlock 
	"Create a spy and spy on the given block at the specified rate."

	| myDelay startTime time0 |
	aBlock isBlock ifFalse:
		[self error: 'spy needs a block here'].
	self class: aBlock receiver class method: aBlock method.
		"set up the probe"
	ObservedProcess := Processor activeProcess.
	myDelay := Delay forMilliseconds: millisecs.
	time0 := Time millisecondClockValue.
	gcStats := SmalltalkImage current getVMParameters.
	Timer :=
		[[true] whileTrue: 
			[startTime := Time millisecondClockValue.
			myDelay wait.
			self tally: Processor preemptedProcess suspendedContext
				"tally can be > 1 if ran a long primitive"
				by: (Time millisecondClockValue - startTime) // millisecs].
		nil] newProcess.
	Timer priority: Processor timingPriority - 1.
		"activate the probe and evaluate the block"
	Timer resume.
	^ aBlock ensure:
		["Collect gc statistics"
		SmalltalkImage current getVMParameters keysAndValuesDo:
			[:idx :gcVal| gcStats at: idx put: (gcVal - (gcStats at: idx))].
		"cancel the probe and return the value"
		Timer terminate.
		time := Time millisecondClockValue - time0]! !


!MethodContext methodsFor: 'system simulation' stamp: 'eem 7/22/2008 11:59'!
pushArgs: args "<Array>" from: sendr "<ContextPart>" 
	"Helps simulate action of the value primitive for closures.
	 This is used by ContextPart>>runSimulated:contextAtEachStep:"

	stackp ~= 0 ifTrue:
		[self error: 'stack pointer should be zero!!'].
	closureOrNil ifNil:
		[self error: 'context needs a closure!!'].
	args do: [:arg| self push: arg].
	closureOrNil copiedValues ifNotNil:
		[:copiedValues|
		 copiedValues do: [:arg| self push: arg]].
	sender := sendr! !


!Number methodsFor: 'comparing' stamp: 'eem 6/11/2008 17:51'!
closeTo: num
	"are these two numbers close?"

	num isFloat ifTrue: [^ num closeTo: self asFloat].
	^[self = num] ifError: [:aString :aReceiver | ^ false]! !


!Float methodsFor: 'comparing' stamp: 'eem 6/11/2008 17:37'!
closeTo: num
	"are these two numbers close?"
	| fuzz |
	num isNumber ifFalse:
		[^[self = num] ifError: [:aString :aReceiver | ^ false]].
	self = 0.0 ifTrue: [^ num abs < 0.0001].
	num = 0.0 ifTrue: [^ self abs < 0.0001].
	self isNaN == num isNaN ifFalse: [^ false].
	self isInfinite == num isInfinite ifFalse: [^ false].
	fuzz := (self abs max: num abs) * 0.0001.
	^ (self - num) abs <= fuzz! !

!Float methodsFor: 'printing' stamp: 'eem 6/11/2008 17:38'!
hex  "If ya really want to know..."

	^ String streamContents:
		[:strm | | word nibble |
		1 to: 2 do:
			[:i | word := self at: i.
			1 to: 8 do: 
				[:s | nibble := (word bitShift: -8+s*4) bitAnd: 16rF.
				strm nextPut: ('0123456789ABCDEF' at: nibble+1)]]]
"
(-2.0 to: 2.0) collect: [:f | f hex]
"! !


!String methodsFor: 'internet' stamp: 'eem 6/11/2008 18:12'!
isoToUtf8
	"Convert ISO 8559-1 to UTF-8"
	| s |
	s := WriteStream on: (String new: self size).

	self do: [:c | | v |
		v := c asciiValue.
		(v > 128)
			ifFalse: [s nextPut: c]
			ifTrue: [
				s nextPut: (192+(v >> 6)) asCharacter.
				s nextPut: (128+(v bitAnd: 63)) asCharacter]].
	^s contents. 
! !


!Symbol class methodsFor: 'class initialization' stamp: 'eem 6/11/2008 18:14'!
compareTiming
	" 
	Symbol compareTiming
	"
	| answer t selectorList implementorLists flattenedList md |
	answer := WriteStream on: String new.
	SmalltalkImage current timeStamp: answer.
	answer cr; cr.
	answer nextPutAll: MethodDictionary instanceCount printString , ' method dictionaries';
		 cr;
		 cr.
	answer nextPutAll: (MethodDictionary allInstances
			inject: 0
			into: [:sum :each | sum + each size]) printString , ' method dictionary entries';
		 cr;
		 cr.
	md := MethodDictionary allInstances.
	t := [100
				timesRepeat: [md
						do: [:each | each includesKey: #majorShrink]]] timeToRun.
	answer nextPutAll: t printString , ' ms to check all method dictionaries for #majorShrink 1000 times';
		 cr;
		 cr.
	selectorList := Symbol selectorsContaining: 'help'.
	t := [3
				timesRepeat: [selectorList
						collect: [:each | self systemNavigation allImplementorsOf: each]]] timeToRun.
	answer nextPutAll: t printString , ' ms to do #allImplementorsOf: for ' , selectorList size printString , ' selectors like *help* 3 times';
		 cr;
		 cr.
	t := [3
				timesRepeat: [selectorList
						do: [:eachSel | md
								do: [:eachMd | eachMd includesKey: eachSel]]]] timeToRun.
	answer nextPutAll: t printString , ' ms to do #includesKey: for ' , md size printString , ' methodDicts for ' , selectorList size printString , ' selectors like *help* 3 times';
		 cr;
		 cr.
	#('help' 'majorShrink' )
		do: [:substr | 
			answer nextPutAll: (Symbol selectorsContaining: substr) size printString , ' selectors containing "' , substr , '"';
				 cr.
			t := [3
						timesRepeat: [selectorList := Symbol selectorsContaining: substr]] timeToRun.
			answer nextPutAll: t printString , ' ms to find Symbols containing *' , substr , '* 3 times';
				 cr.
			t := [3
						timesRepeat: [selectorList := Symbol selectorsContaining: substr.
							implementorLists := selectorList
										collect: [:each | self systemNavigation allImplementorsOf: each].
							flattenedList := SortedCollection new.
							implementorLists
								do: [:each | flattenedList addAll: each]]] timeToRun.
			answer nextPutAll: t printString , ' ms to find implementors of *' , substr , '* 3 times';
				 cr;
				 cr].
	StringHolder new contents: answer contents;
		 openLabel: 'timing'! !


!SystemChangeNotifier methodsFor: 'public' stamp: 'eem 6/11/2008 18:17'!
doSilently: aBlock
	"Perform the block, and ensure that no system notification are broadcasted while doing so."

	silenceLevel := silenceLevel + 1.
	^aBlock ensure: [silenceLevel > 0 ifTrue: [silenceLevel := silenceLevel - 1]]! !


!WeakArray class methodsFor: 'accessing' stamp: 'eem 6/11/2008 18:24'!
addWeakDependent: anObject
	self isFinalizationSupported ifFalse:[^self].
	FinalizationLock critical:[| finished index weakDependent |
		finished := false.
		index := 0.
		[index := index + 1.
		finished not and:[index <= FinalizationDependents size]] whileTrue:[
			weakDependent := FinalizationDependents at: index.
			weakDependent isNil ifTrue:[
				FinalizationDependents at: index put: anObject.
				finished := true.
			].
		].
		finished ifFalse:[
			"Grow linearly"
			FinalizationDependents := FinalizationDependents, (WeakArray new: 10).
			FinalizationDependents at: index put: anObject.
		].
	] ifError:[:msg :rcvr| rcvr error: msg].! !