[squeak-dev] The Inbox: Kernel-eem.1486.mcz

commits at source.squeak.org commits at source.squeak.org
Thu Jul 14 14:15:01 UTC 2022


A new version of Kernel was added to project The Inbox:
http://source.squeak.org/inbox/Kernel-eem.1486.mcz

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

Name: Kernel-eem.1486
Author: eem
Time: 5 July 2022, 4:08:05.255241 pm
UUID: a9406e26-5f92-40fe-a876-a151252043e1
Ancestors: Kernel-eem.1485

Slightly faster implementations of CompiledMethod>>reads/writesField:.
SImilarly neater CompiledCode>>sendsToSuper.
Corrected CompiledCode>>hasMethodReturn; needs Compiler-eem.479

=============== Diff against Kernel-eem.1485 ===============

Item was removed:
- (PackageInfo named: 'Kernel') preamble: '"below, add code to be run before the loading of this package"
- ProcessorScheduler instVarNames at: 2 put: ''genuineProcess''.'!

Item was removed:
- SystemOrganization addCategory: #'Kernel-Classes'!
- SystemOrganization addCategory: #'Kernel-Exceptions'!
- SystemOrganization addCategory: #'Kernel-Exceptions-Kernel'!
- SystemOrganization addCategory: #'Kernel-Methods'!
- SystemOrganization addCategory: #'Kernel-Models'!
- SystemOrganization addCategory: #'Kernel-Numbers'!
- SystemOrganization addCategory: #'Kernel-Numbers-Exceptions'!
- SystemOrganization addCategory: #'Kernel-Objects'!
- SystemOrganization addCategory: #'Kernel-Pools'!
- SystemOrganization addCategory: #'Kernel-Processes'!
- SystemOrganization addCategory: #'Kernel-Processes-Variables'!

Item was removed:
- Object variableSubclass: #AdditionalMethodState
- 	instanceVariableNames: 'method selector'
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'Kernel-Methods'!
- 
- !AdditionalMethodState commentStamp: '<historical>' prior: 0!
- I am class holding state for compiled methods. All my instance variables should be actually part of the CompiledMethod itself, but the current implementation of the VM doesn't allow this.  Currently I hold the selector and any pragmas or properties the compiled method has.  Pragmas and properties are stored in indexable fields; pragmas as instances of Pragma, properties as instances of Association.
- 
- I am a reimplementation of much of MethodProperties, but eliminating the explicit properties and pragmas dictionaries.  Hence I answer true to isMethodProperties.!

Item was removed:
- ----- Method: AdditionalMethodState class>>forMethod:selector: (in category 'instance creation') -----
- forMethod: aMethod selector: aSelector
- 	^(self new: 0)
- 		selector: aSelector;
- 		setMethod: aMethod;
- 		yourself!

Item was removed:
- ----- Method: AdditionalMethodState class>>new (in category 'instance creation') -----
- new
- 	^self new: 0!

Item was removed:
- ----- Method: AdditionalMethodState class>>selector:with: (in category 'instance creation') -----
- selector: aSelector with: aPropertyOrPragma
- 	^(self new: 1)
- 		selector: aSelector;
- 		basicAt: 1 put: aPropertyOrPragma;
- 		yourself!

Item was removed:
- ----- Method: AdditionalMethodState>>allLiteralsDo: (in category 'literals') -----
- allLiteralsDo: aBlock
- 
- 	1 to: self basicSize do: [:index |
- 		(self basicAt: index) allLiteralsDo: aBlock].!

Item was removed:
- ----- Method: AdditionalMethodState>>analogousCodeTo: (in category 'testing') -----
- analogousCodeTo: aMethodProperties
- 	| bs |
- 	self class == aMethodProperties class ifFalse:
- 		[^false].
- 	(bs := self basicSize) = aMethodProperties basicSize ifFalse:
- 		[^false].
- 	1 to: bs do:
- 		[:i|
- 		((self basicAt: i) analogousCodeTo: (aMethodProperties basicAt: i)) ifFalse:
- 			[^false]].
- 	^true!

Item was removed:
- ----- Method: AdditionalMethodState>>at: (in category 'accessing') -----
- at: aKey
- 	"Answer the property value or pragma associated with aKey."
- 	
- 	^self at: aKey ifAbsent: [self error: 'not found']!

Item was removed:
- ----- Method: AdditionalMethodState>>at:ifAbsent: (in category 'accessing') -----
- at: aKey ifAbsent: aBlock
- 	"Answer the property value or pragma associated with aKey or,
- 	 if aKey isn't found, answer the result of evaluating aBlock."
- 
- 	1 to: self basicSize do:
- 		[:i |
- 		| propertyOrPragma "<Association|Pragma>" |
- 		(propertyOrPragma := self basicAt: i) key == aKey ifTrue:
- 			[^propertyOrPragma isVariableBinding
- 				ifTrue: [propertyOrPragma value]
- 				ifFalse: [propertyOrPragma]]].
- 	^aBlock value!

Item was removed:
- ----- Method: AdditionalMethodState>>at:ifAbsentPut: (in category 'accessing') -----
- at: aKey ifAbsentPut: aBlock
- 	"Answer the property value or pragma associated with aKey or,
- 	 if aKey isn't found, answer the result of evaluating aBlock."
- 
- 	1 to: self basicSize do:
- 		[:i |
- 		| propertyOrPragma "<Association|Pragma>" |
- 		(propertyOrPragma := self basicAt: i) key == aKey ifTrue:
- 			[^propertyOrPragma isVariableBinding
- 				ifTrue: [propertyOrPragma value]
- 				ifFalse: [propertyOrPragma]]].
- 	^method propertyValueAt: aKey put: aBlock value!

Item was removed:
- ----- Method: AdditionalMethodState>>at:put: (in category 'accessing') -----
- at: aKey put: aValue
- 	"Replace the property value or pragma associated with aKey."
- 	| keyAlreadyExists |
- 	keyAlreadyExists := false.
- 	
- 	1 to: self basicSize do:
- 		[:i |
- 		| propertyOrPragma "<Association|Pragma>" |
- 		(propertyOrPragma := self basicAt: i) key == aKey ifTrue: [
- 			keyAlreadyExists := true.
- 			propertyOrPragma isVariableBinding
- 				ifTrue: [propertyOrPragma value: aValue]
- 				ifFalse: [self basicAt: i put: aValue]]].
- 	
- 	keyAlreadyExists ifFalse: [
- 		method propertyValueAt: aKey put: aValue ].
- 	
- 	^ aValue!

Item was removed:
- ----- Method: AdditionalMethodState>>copyWith: (in category 'copying') -----
- copyWith: aPropertyOrPragma "<Association|Pragma>"
- 	"Answer a copy of the receiver which includes aPropertyOrPragma"
- 	| bs copy |
- 	(Association == aPropertyOrPragma class
- 	 or: [Pragma == aPropertyOrPragma class]) ifFalse:
- 		[self error: self class name, ' instances should hold only Associations or Pragmas.'].
- 	"no need to initialize here; we're copying all inst vars"
- 	copy := self class basicNew: (bs := self basicSize) + 1.
- 	1 to: bs do:
- 		[:i|
- 		copy basicAt: i put: (self basicAt: i) shallowCopy].
- 	copy basicAt: bs + 1 put: aPropertyOrPragma.
- 	1 to: self class instSize do:
- 		[:i| copy instVarAt: i put: (self instVarAt: i)].
- 	^copy!

Item was removed:
- ----- Method: AdditionalMethodState>>copyWithout: (in category 'copying') -----
- copyWithout: aPropertyOrPragma "<Association|Pragma>"
- 	"Answer a copy of the receiver which no longer includes aPropertyOrPragma"
- 	| bs copy offset |
- 	"no need to initialize here; we're copying all inst vars"
- 	copy := self class basicNew: (bs := self basicSize) - ((self includes: aPropertyOrPragma)
- 															ifTrue: [1]
- 															ifFalse: [0]).
- 	offset := 0.
- 	1 to: bs do:
- 		[:i|
- 		(self basicAt: i) = aPropertyOrPragma
- 			ifTrue: [offset := 1]
- 			ifFalse: [copy basicAt: i - offset put: (self basicAt: i) shallowCopy]].
- 	1 to: self class instSize do:
- 		[:i| copy instVarAt: i put: (self instVarAt: i)].
- 	^copy!

Item was removed:
- ----- Method: AdditionalMethodState>>hasAtLeastTheSamePropertiesAs: (in category 'testing') -----
- hasAtLeastTheSamePropertiesAs: aMethodProperties
- 	"Answer if the recever has at least the same properties as the argument.
- 	 N.B. The receiver may have additional properties and still answer true."
- 	aMethodProperties keysAndValuesDo:
- 		[:k :v|
- 		(v isKindOf: Pragma)
- 			"ifTrue: [Pragmas have already been checked]"
- 			ifFalse: [
- 				(self includes: k->v) ifFalse: [^false]]].
- 	^true!

Item was removed:
- ----- Method: AdditionalMethodState>>includes: (in category 'testing') -----
- includes: aPropertyOrPragma "<Association|Pragma>"
- 	"Test if the property or pragma is present."
- 
- 	1 to: self basicSize do:
- 		[:i |
- 		(self basicAt: i) = aPropertyOrPragma ifTrue:
- 			[^true]].
- 	^false!

Item was removed:
- ----- Method: AdditionalMethodState>>includesKey: (in category 'testing') -----
- includesKey: aKey
- 	"Test if the property aKey or pragma with selector aKey is present."
- 
- 	1 to: self basicSize do:
- 		[:i |
- 		(self basicAt: i) key == aKey ifTrue:
- 			[^true]].
- 	^false!

Item was removed:
- ----- Method: AdditionalMethodState>>includesProperty: (in category 'properties') -----
- includesProperty: aKey
- 	"Test if the property aKey is present."
- 
- 	1 to: self basicSize do: [:i |
- 		| propertyOrPragma "<Association|Pragma>" |
- 		propertyOrPragma := self basicAt: i.
- 		(propertyOrPragma isVariableBinding
- 		 and: [propertyOrPragma key == aKey]) ifTrue:
- 			[^true]].
- 	^false!

Item was removed:
- ----- Method: AdditionalMethodState>>isEmpty (in category 'testing') -----
- isEmpty
- 	^self basicSize = 0!

Item was removed:
- ----- Method: AdditionalMethodState>>isMethodProperties (in category 'testing') -----
- isMethodProperties
- 	^true!

Item was removed:
- ----- Method: AdditionalMethodState>>keysAndValuesDo: (in category 'accessing') -----
- keysAndValuesDo: aBlock
- 	"Enumerate the receiver with all the keys and values."
- 
- 	1 to: self basicSize do: [:i |
- 		| propertyOrPragma "<Association|Pragma>" |
- 		(propertyOrPragma := self basicAt: i) isVariableBinding
- 			ifTrue: [aBlock value: propertyOrPragma key value: propertyOrPragma value]
- 			ifFalse: [aBlock value: propertyOrPragma keyword value: propertyOrPragma]]!

Item was removed:
- ----- Method: AdditionalMethodState>>method (in category 'accessing') -----
- method
- 	^method!

Item was removed:
- ----- Method: AdditionalMethodState>>method: (in category 'decompiling') -----
- method: aMethodNodeOrNil
- 	"For decompilation"
- 	method := aMethodNodeOrNil!

Item was removed:
- ----- Method: AdditionalMethodState>>methodHome (in category 'accessing') -----
- methodHome
- 	"The behavior (trait/class) this method was originally defined in. 
- 	The methodClass in AdditionalMethodState but subclasses 
- 	(TraitMethodState) may know differently"
- 	^method methodClass!

Item was removed:
- ----- Method: AdditionalMethodState>>notEmpty (in category 'testing') -----
- notEmpty
- 	^self basicSize > 0!

Item was removed:
- ----- Method: AdditionalMethodState>>postCopy (in category 'copying') -----
- postCopy
- 	"After copying we must duplicate any associations and pragmas so they don't end up being shared."
- 	1 to: self basicSize do:
- 		[:i| self basicAt: i put: (self basicAt: i) shallowCopy]!

Item was removed:
- ----- Method: AdditionalMethodState>>pragmas (in category 'accessing') -----
- pragmas
- 	"Answer the raw messages comprising my pragmas."
- 	| pragmaStream |
- 	pragmaStream := WriteStream on: (Array new: self basicSize).
- 	1 to: self basicSize do: [:i |
- 		| propertyOrPragma "<Association|Message>" |
- 		(propertyOrPragma := self basicAt: i) isVariableBinding ifFalse:
- 			[pragmaStream nextPut: propertyOrPragma]].
- 	^pragmaStream contents!

Item was removed:
- ----- Method: AdditionalMethodState>>printOn: (in category 'printing') -----
- printOn: aStream
- 	super printOn: aStream.
- 	aStream space; nextPut: $(; print: self identityHash; nextPut: $)!

Item was removed:
- ----- Method: AdditionalMethodState>>properties (in category 'accessing') -----
- properties
- 
- 	| propertyStream |
- 	propertyStream := WriteStream on: (Array new: self basicSize * 2).
- 	1 to: self basicSize do: [:i |
- 		| propertyOrPragma "<Association|Pragma>" |
- 		(propertyOrPragma := self basicAt: i) isVariableBinding ifTrue:
- 			[propertyStream nextPut: propertyOrPragma key; nextPut: propertyOrPragma value]].
- 	^IdentityDictionary newFromPairs: propertyStream contents!

Item was removed:
- ----- Method: AdditionalMethodState>>propertyKeysAndValuesDo: (in category 'properties') -----
- propertyKeysAndValuesDo: aBlock
- 	"Enumerate the receiver with all the keys and values."
- 
- 	1 to: self basicSize do: [:i |
- 		| propertyOrPragma "<Association|Pragma>" |
- 		(propertyOrPragma := self basicAt: i) isVariableBinding ifTrue:
- 			[aBlock value: propertyOrPragma key value: propertyOrPragma value]]!

Item was removed:
- ----- Method: AdditionalMethodState>>propertyValueAt: (in category 'properties') -----
- propertyValueAt: aKey
- 	"Answer the property value associated with aKey."
- 	
- 	^ self propertyValueAt: aKey ifAbsent: [ self error: 'Property not found' ].!

Item was removed:
- ----- Method: AdditionalMethodState>>propertyValueAt:ifAbsent: (in category 'properties') -----
- propertyValueAt: aKey ifAbsent: aBlock
- 	"Answer the property value associated with aKey or, if aKey isn't found, answer the result of evaluating aBlock."
- 
- 	1 to: self basicSize do: [:i |
- 		| propertyOrPragma "<Association|Pragma>" |
- 		propertyOrPragma := self basicAt: i.
- 		(propertyOrPragma isVariableBinding
- 		 and: [propertyOrPragma key == aKey]) ifTrue:
- 			[^propertyOrPragma value]].
- 	^aBlock value!

Item was removed:
- ----- Method: AdditionalMethodState>>removeKey: (in category 'properties') -----
- removeKey: aKey
- 	"Remove the property with aKey. Answer the property or raise an error if aKey isn't found."
- 	
- 	^ self removeKey: aKey ifAbsent: [ self error: 'Property not found' ].!

Item was removed:
- ----- Method: AdditionalMethodState>>removeKey:ifAbsent: (in category 'accessing') -----
- removeKey: aKey ifAbsent: aBlock
- 	"Remove the property with aKey. Answer the value or, if aKey isn't found, answer the result of evaluating aBlock."
- 	
- 	1 to: self basicSize do: [:i |
- 		| propertyOrPragma "<Association|Pragma>" |
- 		propertyOrPragma := self basicAt: i.
- 		(propertyOrPragma isVariableBinding
- 				ifTrue: [propertyOrPragma key]
- 				ifFalse: [propertyOrPragma keyword])
- 			== aKey ifTrue:
- 			[^method removeProperty: aKey]].
- 	^aBlock value!

Item was removed:
- ----- Method: AdditionalMethodState>>selector (in category 'accessing') -----
- selector
- 	^selector!

Item was removed:
- ----- Method: AdditionalMethodState>>selector: (in category 'accessing') -----
- selector: aSymbol
- 	selector := aSymbol!

Item was removed:
- ----- Method: AdditionalMethodState>>setMethod: (in category 'accessing') -----
- setMethod: aMethod
- 	method := aMethod.
- 	1 to: self basicSize do:
- 		[:i| | propertyOrPragma "<Association|Pragma>" |
- 		(propertyOrPragma := self basicAt: i) isVariableBinding ifFalse:
- 			[propertyOrPragma setMethod: aMethod]]!

Item was removed:
- Error subclass: #ArithmeticError
- 	instanceVariableNames: ''
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'Kernel-Numbers-Exceptions'!

Item was removed:
- Error subclass: #AssertionFailure
- 	instanceVariableNames: ''
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'Kernel-Exceptions'!
- 
- !AssertionFailure commentStamp: 'gh 5/2/2002 20:29' prior: 0!
- AsssertionFailure is the exception signaled from Object>>assert: when the assertion block evaluates to false.!

Item was removed:
- ----- Method: AssertionFailure>>isResumable (in category 'priv handling') -----
- isResumable
- 	^ true!

Item was removed:
- Error subclass: #AttemptToWriteReadOnlyGlobal
- 	instanceVariableNames: ''
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'Kernel-Exceptions'!
- 
- !AttemptToWriteReadOnlyGlobal commentStamp: 'gh 5/2/2002 20:26' prior: 0!
- This is a resumable error you get if you try to assign a readonly variable a value.
- Name definitions in the module system can be read only and are then created using instances of ReadOnlyVariableBinding instead of Association.
- See also LookupKey>>beReadWriteBinding and LookupKey>>beReadOnlyBinding.
- 
- !

Item was removed:
- ----- Method: AttemptToWriteReadOnlyGlobal>>description (in category 'as yet unclassified') -----
- description
- 	"Return a textual description of the exception."
- 
- 	| desc mt |
- 	desc := 'Error'.
- 	^(mt := self messageText) == nil
- 		ifTrue: [desc]
- 		ifFalse: [desc, ': ', mt]!

Item was removed:
- ----- Method: AttemptToWriteReadOnlyGlobal>>isResumable (in category 'as yet unclassified') -----
- isResumable
- 	^true!

Item was removed:
- Categorizer subclass: #BasicClassOrganizer
- 	instanceVariableNames: 'subject classComment commentStamp'
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'Kernel-Classes'!

Item was removed:
- ----- Method: BasicClassOrganizer class>>ambiguous (in category 'constants') -----
- ambiguous
- 	^ #ambiguous!

Item was removed:
- ----- Method: BasicClassOrganizer class>>class: (in category 'instance creation') -----
- class: aClassDescription
- 	^ self new setSubject: aClassDescription!

Item was removed:
- ----- Method: BasicClassOrganizer class>>class:defaultList: (in category 'instance creation') -----
- class: aClassDescription defaultList: aSortedCollection
- 	| inst |
- 	inst := self defaultList: aSortedCollection.
- 	inst setSubject: aClassDescription.
- 	^ inst!

Item was removed:
- ----- Method: BasicClassOrganizer>>classComment (in category 'accessing') -----
- classComment
- 	classComment
- 		ifNil: [^ ''].
- 	^ classComment text ifNil: ['']!

Item was removed:
- ----- Method: BasicClassOrganizer>>classComment: (in category 'accessing') -----
- classComment: aString 
- 	"Store the comment, aString, associated with the object that refers to the 
- 	receiver."
- 
- 	(aString isKindOf: RemoteString) 
- 		ifTrue: [classComment := aString]
- 		ifFalse: [(aString == nil or: [aString size = 0])
- 			ifTrue: [classComment := nil]
- 			ifFalse: [
- 				self error: 'use aClass classComment:'.
- 				classComment := RemoteString newString: aString onFileNumber: 2]]
- 				"Later add priorSource and date and initials?"!

Item was removed:
- ----- Method: BasicClassOrganizer>>classComment:stamp: (in category 'accessing') -----
- classComment: aString  stamp: aStamp
- 	"Store the comment, aString, associated with the object that refers to the receiver."
- 
- 	self commentStamp: aStamp.
- 	(aString isKindOf: RemoteString) 
- 		ifTrue: [classComment := aString]
- 		ifFalse: [(aString == nil or: [aString size = 0])
- 			ifTrue: [classComment := nil]
- 			ifFalse:
- 				[self error: 'use aClass classComment:'.
- 				classComment := RemoteString newString: aString onFileNumber: 2]]
- 				"Later add priorSource and date and initials?"!

Item was removed:
- ----- Method: BasicClassOrganizer>>commentRemoteStr (in category 'accessing') -----
- commentRemoteStr
- 	^ classComment!

Item was removed:
- ----- Method: BasicClassOrganizer>>commentStamp (in category 'accessing') -----
- commentStamp
- 	"Answer the comment stamp for the class"
- 
- 	^ commentStamp!

Item was removed:
- ----- Method: BasicClassOrganizer>>commentStamp: (in category 'accessing') -----
- commentStamp: aStamp
- 	commentStamp := aStamp!

Item was removed:
- ----- Method: BasicClassOrganizer>>dateCommentLastSubmitted (in category 'accessing') -----
- dateCommentLastSubmitted
- 	"Answer a Date object indicating when my class comment was last submitted.  If there is no date stamp, or one of the old-time <historical>  guys, return nil"
- 	"RecentMessageSet organization dateCommentLastSubmitted"
- 
- 	| aStamp tokens |
- 	(aStamp := self commentStamp) isEmptyOrNil ifTrue: [^ nil].
- 	tokens := aStamp findBetweenSubStrs: ' 
- '.  "space is expected delimiter, but cr is sometimes seen, though of mysterious provenance"
- 	^ tokens size > 1
- 		ifTrue:
- 			[[tokens second asDate] ifError: [nil]]
- 		ifFalse:
- 			[nil]!

Item was removed:
- ----- Method: BasicClassOrganizer>>fileOutCommentOn:moveSource:toFile: (in category 'fileIn/Out') -----
- fileOutCommentOn: aFileStream moveSource: moveSource toFile: fileIndex
- 	"Copy the class comment to aFileStream.  If moveSource is true (as in compressChanges or compressSources, then update classComment to point to the new file."
- 	| fileComment |
- 	classComment ifNotNil: 
- 			[aFileStream cr.
- 			fileComment := RemoteString newString: classComment text
- 							onFileNumber: fileIndex toFile: aFileStream.
- 			moveSource ifTrue: [classComment := fileComment]]!

Item was removed:
- ----- Method: BasicClassOrganizer>>hasNoComment (in category 'testing') -----
- hasNoComment
- 	"Answer whether the class classified by the receiver has a comment."
- 
- 	^classComment == nil!

Item was removed:
- ----- Method: BasicClassOrganizer>>hasSubject (in category 'testing') -----
- hasSubject
- 	^ self subject notNil!

Item was removed:
- ----- Method: BasicClassOrganizer>>moveChangedCommentToFile:numbered: (in category 'fileIn/Out') -----
- moveChangedCommentToFile: aFileStream numbered: fileIndex 
- 	"If the comment is in the changes file, then move it to a new file."
- 
- 	(classComment ~~ nil and: [classComment sourceFileNumber > 1]) ifTrue: 
- 		[self fileOutCommentOn: aFileStream moveSource: true toFile: fileIndex]!

Item was removed:
- ----- Method: BasicClassOrganizer>>objectForDataStream: (in category 'fileIn/Out') -----
- objectForDataStream: refStrm
- 	| dp |
- 	"I am about to be written on an object file.  Write a path to me in the other system instead."
- 
- 	self hasSubject ifTrue: [
- 		(refStrm insideASegment and: [self subject isSystemDefined not]) ifTrue: [
- 			^ self].	"do trace me"
- 		(self subject isKindOf: Class) ifTrue: [
- 			dp := DiskProxy global: self subject name selector: #organization args: #().
- 			refStrm replace: self with: dp.
- 			^ dp]].
- 	^ self	"in desparation"
- !

Item was removed:
- ----- Method: BasicClassOrganizer>>putCommentOnFile:numbered:moveSource:forClass: (in category 'fileIn/Out') -----
- putCommentOnFile: aFileStream numbered: sourceIndex moveSource: moveSource forClass: aClass
- 	"Store the comment about the class onto file, aFileStream."
- 	| header |
- 	classComment ifNotNil:
- 		[aFileStream cr; nextPut: $!!.
- 		header := String streamContents: [:strm | 
- 				strm nextPutAll: aClass name;
- 				nextPutAll: ' commentStamp: '.
- 				commentStamp ifNil: [commentStamp := '<historical>'].
- 				commentStamp storeOn: strm.
- 				strm nextPutAll: ' prior: '; nextPutAll: '0'].
- 		aFileStream nextChunkPut: header.
- 		aClass organization fileOutCommentOn: aFileStream
- 				moveSource: moveSource toFile: sourceIndex.
- 		aFileStream cr]!

Item was removed:
- ----- Method: BasicClassOrganizer>>setSubject: (in category 'private') -----
- setSubject: aClassDescription
- 	subject := aClassDescription!

Item was removed:
- ----- Method: BasicClassOrganizer>>subject (in category 'accessing') -----
- subject
- 	^ subject.!

Item was removed:
- Object subclass: #Behavior
- 	instanceVariableNames: 'superclass methodDict format'
- 	classVariableNames: 'ObsoleteSubclasses'
- 	poolDictionaries: ''
- 	category: 'Kernel-Classes'!
- 
- !Behavior commentStamp: 'al 12/8/2005 20:44' prior: 0!
- My instances describe the behavior of other objects. I provide the minimum state necessary for compiling methods, and creating and running instances. Most objects are created as instances of the more fully supported subclass, Class, but I am a good starting point for providing instance-specific behavior (as in Metaclass).!

Item was removed:
- ----- Method: Behavior class>>canZapMethodDictionary (in category 'testing') -----
- canZapMethodDictionary
- 	"Return false since zapping the method dictionary of Behavior class or its subclasses will cause the system to fail."
- 	^false!

Item was removed:
- ----- Method: Behavior class>>cleanUp (in category 'class initialization') -----
- cleanUp
- 	"Flush the obsolete subclasses."
- 
- 	self flushObsoleteSubclasses!

Item was removed:
- ----- Method: Behavior class>>flushObsoleteSubclasses (in category 'class initialization') -----
- flushObsoleteSubclasses
- 	"Behavior flushObsoleteSubclasses"
- 	ObsoleteSubclasses finalizeValues.!

Item was removed:
- ----- Method: Behavior class>>initialize (in category 'class initialization') -----
- initialize
- 	"Behavior initialize"
- 	"Never called for real"
- 	ObsoleteSubclasses
- 		ifNil: [self initializeObsoleteSubclasses]
- 		ifNotNil: [| newDict | 
- 			newDict := WeakKeyToCollectionDictionary newFrom: ObsoleteSubclasses.
- 			newDict rehash.
- 			ObsoleteSubclasses := newDict]!

Item was removed:
- ----- Method: Behavior class>>initializeObsoleteSubclasses (in category 'class initialization') -----
- initializeObsoleteSubclasses
- 	ObsoleteSubclasses := WeakKeyToCollectionDictionary new.!

Item was removed:
- ----- Method: Behavior>>>> (in category 'accessing method dictionary') -----
- >> selector 
- 	"Answer the compiled method associated with the argument, selector (a 
- 	Symbol), a message selector in the receiver's method dictionary. If the 
- 	selector is not in the dictionary, create an error notification."
- 
- 	^self compiledMethodAt: selector
- !

Item was removed:
- ----- Method: Behavior>>addObsoleteSubclass: (in category 'obsolete subclasses') -----
- addObsoleteSubclass: aClass
- 	"Weakly remember that aClass was a subclass of the receiver and is now obsolete"
- 	| obs |
- 
- 	obs := ObsoleteSubclasses at: self ifAbsent:[WeakArray new].
- 	(obs includes: aClass) ifTrue:[^self].
- 	obs := obs copyWithout: nil.
- 	obs := obs copyWith: aClass.
- 	ObsoleteSubclasses at: self put: obs.
- !

Item was removed:
- ----- Method: Behavior>>addSelector:withMethod: (in category 'adding/removing methods') -----
- addSelector: selector withMethod: compiledMethod 
- 	^ self addSelector: selector withMethod: compiledMethod notifying: nil!

Item was removed:
- ----- Method: Behavior>>addSelector:withMethod:notifying: (in category 'adding/removing methods') -----
- addSelector: selector withMethod: compiledMethod notifying: requestor
- 	^ self basicAddSelector: selector withMethod: compiledMethod!

Item was removed:
- ----- Method: Behavior>>addSelectorSilently:withMethod: (in category 'adding/removing methods') -----
- addSelectorSilently: selector withMethod: compiledMethod
- 	self basicAddSelector: selector withMethod: compiledMethod.!

Item was removed:
- ----- Method: Behavior>>adoptInstance: (in category 'instance creation') -----
- adoptInstance: anObject
- 	"Change the class of anObject to me.
- 	Primitive (found in Cog and new VMs)  follows the same rules as primitiveChangeClassTo:, but returns the class rather than the modified instance"
- 
- 	<primitive: 160 error: ec>
- 	ec == #'no modification' ifTrue:
- 		[^self modificationForbiddenAdopting: anObject].
- 	self primitiveFailed!

Item was removed:
- ----- Method: Behavior>>allClassVarNames (in category 'accessing instances and variables') -----
- allClassVarNames
- 	"Answer a Set of the names of the receiver's and the receiver's ancestor's 
- 	class variables."
- 
- 	^superclass allClassVarNames!

Item was removed:
- ----- Method: Behavior>>allInstVarNames (in category 'accessing instances and variables') -----
- allInstVarNames
- 	"Answer an Array of the names of the receiver's instance variables. The 
- 	Array ordering is the order in which the variables are stored and 
- 	accessed by the interpreter."
- 
- 	| vars |
- 	superclass == nil
- 		ifTrue: [vars := self instVarNames copy]	"Guarantee a copy is answered."
- 		ifFalse: [vars := superclass allInstVarNames , self instVarNames].
- 	^vars!

Item was removed:
- ----- Method: Behavior>>allInstances (in category 'accessing instances and variables') -----
- allInstances
- 	"Answer all instances of the receiver."
- 	<primitive: 177>
- 	"The primitive can fail because memory is low.  If so, fall back on the old
- 	 enumeration code, which gives the system a chance to GC and/or grow.
- 	 Because aBlock might change the class of inst (for example, using become:),
- 	 it is essential to compute next before aBlock value: inst."
- 	| inst insts next |
- 	insts := WriteStream on: (Array new: 64).
- 	inst := self someInstance.
- 	[inst == nil] whileFalse:
- 		[next := inst nextInstance.
- 		 (inst == insts or: [inst == insts originalContents]) ifFalse: [insts nextPut: inst].
- 		 inst := next].
- 	^insts contents!

Item was removed:
- ----- Method: Behavior>>allInstancesDo: (in category 'enumerating') -----
- allInstancesDo: aBlock
- 	"Evaluate aBlock with each of the current instances of the receiver."
- 	| instances inst next |
- 	instances := self allInstancesOrNil.
- 	instances ifNotNil:
- 		[instances do: aBlock.
- 		 ^self].
- 	"allInstancesOrNil can fail because memory is low.  If so, fall back on the old
- 	 enumeration code.  Because aBlock might change the class of inst (for example,
- 	 using become:), it is essential to compute next before aBlock value: inst."
- 	inst := self someInstance.
- 	[inst == nil] whileFalse:
- 		[next := inst nextInstance.
- 		 aBlock value: inst.
- 		 inst := next]!

Item was removed:
- ----- Method: Behavior>>allInstancesOrNil (in category 'enumerating') -----
- allInstancesOrNil
- 	"Answer all instances of the receiver, or nil if the primitive
- 	 fails, which it may be due to being out of memory."
- 	<primitive: 177>
- 	^nil!

Item was removed:
- ----- Method: Behavior>>allSelectors (in category 'accessing method dictionary') -----
- allSelectors
-     "Answer all selectors understood by instances of the receiver"
- 
-     ^(Array streamContents: [ :stream |
-         self withAllSuperclassesDo: [ :aClass |
-             aClass selectorsDo: [ :each | 
-                 stream nextPut: each ] ] ]) asIdentitySet!

Item was removed:
- ----- Method: Behavior>>allSelectorsBelow: (in category 'accessing method dictionary') -----
- allSelectorsBelow: topClass 
- 	| coll |
- 	coll := IdentitySet new.
- 	self withAllSuperclassesDo: 
- 			[:aClass | 
- 			aClass = topClass
- 				ifTrue: [^ coll ]
- 				ifFalse: [aClass selectorsDo: [ :sel | coll add: sel ]]].
- 	^ coll
- 	
- 
- !

Item was removed:
- ----- Method: Behavior>>allSharedPools (in category 'accessing instances and variables') -----
- allSharedPools
- 	"Answer a Set of the names of the pools (Dictionaries or SharedPool subclasses) that the receiver and the receiver's ancestors share."
- 
- 	^superclass allSharedPools!

Item was removed:
- ----- Method: Behavior>>allSubInstances (in category 'accessing instances and variables') -----
- allSubInstances 
- 	"Answer a list of all current instances of the receiver and all of its subclasses."
- 	| aCollection |
- 	aCollection := OrderedCollection new.
- 	self allSubInstancesDo:
- 		[:x | x == aCollection ifFalse: [aCollection add: x]].
- 	^ aCollection!

Item was removed:
- ----- Method: Behavior>>allSubInstancesDo: (in category 'enumerating') -----
- allSubInstancesDo: aBlock 
- 	"Evaluate the argument, aBlock, for each of the current instances of the 
- 	receiver and all its subclasses."
- 
- 	self allInstancesDo: aBlock.
- 	self allSubclassesDo: [:sub | sub allInstancesDo: aBlock]!

Item was removed:
- ----- Method: Behavior>>allSubclasses (in category 'accessing class hierarchy') -----
- allSubclasses
- 	"Answer a Collection of the receiver's and the receiver's descendent's subclasses. "
- 
- 	| scan scanTop |
- 	scan := OrderedCollection withAll: self subclasses.
- 	scanTop := 1.
- 	[scanTop > scan size]
- 		whileFalse: [scan addAll: (scan at: scanTop) subclasses.
- 			scanTop := scanTop + 1].
- 	^ scan!

Item was removed:
- ----- Method: Behavior>>allSubclassesDo: (in category 'enumerating') -----
- allSubclassesDo: aBlock 
- 	"Evaluate the argument, aBlock, for each of the receiver's subclasses."
- 
- 	self subclassesDo: 
- 		[:cl | 
- 		aBlock value: cl.
- 		cl allSubclassesDo: aBlock]!

Item was removed:
- ----- Method: Behavior>>allSubclassesDoGently: (in category 'enumerating') -----
- allSubclassesDoGently: aBlock 
- 	"Evaluate the argument, aBlock, for each of the receiver's subclasses."
- 
- 	self subclassesDoGently: 
- 		[:cl | 
- 		cl isInMemory ifTrue: [
- 			aBlock value: cl.
- 			cl allSubclassesDoGently: aBlock]]!

Item was removed:
- ----- Method: Behavior>>allSubclassesWithLevelDo:startingLevel: (in category 'accessing class hierarchy') -----
- allSubclassesWithLevelDo: classAndLevelBlock startingLevel: level 
- 	"Walk the tree of subclasses, giving the class and its level"
- 
- 	classAndLevelBlock value: self value: level.
- 	self == Class ifTrue:  [^ self].  "Don't visit all the metaclasses"
- 	"Visit subclasses in alphabetical order"
- 	self subclasses
- 		sort: [ :a :b | a name <= b name ];
- 		do: [ :subclass | 
- 			subclass
- 				allSubclassesWithLevelDo: classAndLevelBlock
- 				startingLevel: level + 1 ]!

Item was removed:
- ----- Method: Behavior>>allSuperclasses (in category 'accessing class hierarchy') -----
- allSuperclasses
- 	"Answer an OrderedCollection of the receiver's and the receiver's  
- 	ancestor's superclasses. The first element is the receiver's immediate  
- 	superclass, followed by its superclass; the last element is Object."
- 	| temp |
- 	^ superclass == nil
- 		ifTrue: [ OrderedCollection new]
- 		ifFalse: [temp := superclass allSuperclasses.
- 			temp addFirst: superclass.
- 			temp]!

Item was removed:
- ----- Method: Behavior>>allSuperclassesDo: (in category 'enumerating') -----
- allSuperclassesDo: aBlock 
- 	"Evaluate the argument, aBlock, for each of the receiver's superclasses."
- 
- 	superclass == nil
- 		ifFalse: [aBlock value: superclass.
- 				superclass allSuperclassesDo: aBlock]!

Item was removed:
- ----- Method: Behavior>>allTraits (in category 'Backstop-Traits') -----
- allTraits
- 	"Backstop. When traits are unloaded there are no traits hiding here."
- 	^#()!

Item was removed:
- ----- Method: Behavior>>allUnreferencedInstanceVariables (in category 'user interface') -----
- 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 reject: [:ivn |
- 		| definingClass |		
- 		definingClass := self classThatDefinesInstanceVariable: ivn.
- 		definingClass withAllSubclasses anySatisfy: [:class |  
- 				(class whichSelectorsAccess: ivn asSymbol) notEmpty]]!

Item was removed:
- ----- Method: Behavior>>allowUnderscoreAssignments (in category 'compiling') -----
- allowUnderscoreAssignments
- 	"Return true if the receiver and its subclasses should be allowed to use underscore as assignment operator. Returning nil here means that the compiler should use the system-wide default preference. Also see #allowUnderscoreSelectors.
- 
- 	Combinations: If both preferences are false, underscore is illegal. If both preferences are true, underscore assignment needs the be surrounded by spaces and a single underscore cannot be used as selector."
- 	^nil!

Item was removed:
- ----- Method: Behavior>>allowsSubInstVars (in category 'accessing instances and variables') -----
- allowsSubInstVars
- 	"Classes that allow instances to change classes among its subclasses will want to override this and return false, so inst vars are not accidentally added to its subclasses."
- 
- 	^ true!

Item was removed:
- ----- Method: Behavior>>basicAddSelector:withMethod: (in category 'adding/removing methods') -----
- basicAddSelector: selector withMethod: compiledMethod 
- 	"Add the message selector with the corresponding compiled method to the 
- 	receiver's method dictionary.
- 	Do this without sending system change notifications"
- 
- 	self methodDict at: selector put: compiledMethod.
- 	compiledMethod
- 		methodClass: self;
- 		selector: selector.
- 
- 	"Now flush Squeak's method cache for this selector"
- 	selector flushCache!

Item was removed:
- ----- Method: Behavior>>basicNew (in category 'instance creation') -----
- basicNew
- 	"Primitive. Answer an instance of the receiver (which is a class) with no 
- 	 indexable variables. Fail if the class is indexable. Essential. See Object 
- 	 documentation whatIsAPrimitive.
- 	
- 	 If the primitive fails because space is low then the scavenger will run
- 	 before the method is activated.  Check that space was low and retry
- 	 via handleFailingBasicNew if so."
- 
- 	<primitive: 70 error: ec>
- 	ec == #'insufficient object memory' ifTrue:
- 		[^self handleFailingBasicNew].
- 	self isVariable ifTrue: [^self basicNew: 0].
- 	self primitiveFailed!

Item was removed:
- ----- Method: Behavior>>basicNew: (in category 'instance creation') -----
- basicNew: sizeRequested
- 	"Primitive. Answer an instance of this class with the number of indexable
- 	 variables specified by the argument, sizeRequested.  Fail if this class is not
- 	 indexable or if the argument is not a positive Integer, or if there is not
- 	 enough memory available. Essential. See Object documentation whatIsAPrimitive.
- 	
- 	 If the primitive fails because space is low then the scavenger will run before the
- 	 method is activated.  Check args and retry via handleFailingBasicNew: if they're OK."
- 
- 	<primitive: 71 error: ec>
- 	(ec == #'insufficient object memory') ifTrue:
- 		[^self handleFailingBasicNew: sizeRequested].
- 	(ec == #'bad argument') ifTrue:
- 		[self error: self printString, ' called #basicNew: with invalid argument ', sizeRequested].
- 	self isVariable ifFalse:
- 		[self error: self printString, ' cannot have variable sized instances'].
- 	self primitiveFailed!

Item was removed:
- ----- Method: Behavior>>basicRemoveSelector: (in category 'adding/removing methods') -----
- basicRemoveSelector: selector 
- 	"Assuming that the argument, selector (a Symbol), is a message selector 
- 	in my method dictionary, remove it and its method. Returns the old method
- 	if found, nil otherwise."
- 
- 	| oldMethod |
- 	oldMethod := self methodDict at: selector ifAbsent: [^ nil].
- 	self methodDict removeKey: selector.
- 
- 	"Now flush Squeak's method cache for this selector"
- 	selector flushCache.
- 	^oldMethod!

Item was removed:
- ----- Method: Behavior>>binding (in category 'compiling') -----
- binding
- 	^ nil -> self!

Item was removed:
- ----- Method: Behavior>>bindingOf: (in category 'testing method dictionary') -----
- bindingOf: varName
- 	"Answer the binding of some variable resolved in the scope of the receiver"
- 	^superclass bindingOf: varName!

Item was removed:
- ----- Method: Behavior>>bindingOf:environment: (in category 'testing method dictionary') -----
- bindingOf: varName environment: anEnvironment
- 	^superclass bindingOf: varName environment: anEnvironment!

Item was removed:
- ----- Method: Behavior>>byteSizeOfInstance (in category 'accessing instances and variables') -----
- byteSizeOfInstance
- 	"Answer the total memory size of an instance of the receiver."
- 
- 	<primitive: 181 error: ec>
- 	self isVariable ifTrue:
- 		[^self byteSizeOfInstanceOfSize: 0].
- 	self primitiveFailed!

Item was removed:
- ----- Method: Behavior>>byteSizeOfInstanceOfSize: (in category 'accessing instances and variables') -----
- byteSizeOfInstanceOfSize: basicSize
- 	"Answer the total memory size of an instance of the receiver
- 	 with the given number of indexable instance variables."
- 
- 	<primitive: 181 error: ec>
- 	self isVariable
- 		ifTrue: "If the primitive overflowed answer a close approximation"
- 			[(basicSize isInteger
- 			  and: [basicSize >= 16r1000000]) ifTrue:
- 				[^2 * (self byteSizeOfInstanceOfSize: basicSize + 1 // 2)
- 				   - (self byteSizeOfInstanceOfSize: 0)]]
- 		ifFalse:
- 			[basicSize = 0 ifTrue:
- 				[^self byteSizeOfInstance]].
- 	self primitiveFailed!

Item was removed:
- ----- Method: Behavior>>canUnderstand: (in category 'testing method dictionary') -----
- canUnderstand: selector 
- 	"Answer whether the receiver can respond to the message whose selector 
- 	is the argument. The selector can be in the method dictionary of the 
- 	receiver's class or any of its superclasses."
- 
- 	(self includesSelector: selector) ifTrue: [^true].
- 	superclass == nil ifTrue: [^false].
- 	^superclass canUnderstand: selector!

Item was removed:
- ----- Method: Behavior>>canZapMethodDictionary (in category 'testing') -----
- canZapMethodDictionary
- 	"Return true if it is safe to zap the method dictionary on #obsolete"
- 	^true!

Item was removed:
- ----- Method: Behavior>>classBindingOf: (in category 'testing method dictionary') -----
- classBindingOf: varName
- 	"Answer the binding of some variable resolved in the scope of the receiver's class"
- 	^self bindingOf: varName!

Item was removed:
- ----- Method: Behavior>>classBindingOf:environment: (in category 'testing method dictionary') -----
- classBindingOf: varName environment: anEnvironment
- 	^self bindingOf: varName environment: anEnvironment!

Item was removed:
- ----- Method: Behavior>>classDepth (in category 'accessing') -----
- classDepth
- 
- 	superclass ifNil: [^ 1].
- 	^ superclass classDepth + 1!

Item was removed:
- ----- Method: Behavior>>classVarNames (in category 'accessing instances and variables') -----
- classVarNames
- 	"Answer a collection of the receiver's class variable names."
- 
- 	^#()!

Item was removed:
- ----- Method: Behavior>>cleanUp (in category 'initialize-release') -----
- cleanUp
- 	"Clean out any caches and other state that should be flushed when trying to get an image into a pristine state. Subclasses may override #cleanUp: to provide different levels of cleanliness"
- !

Item was removed:
- ----- Method: Behavior>>cleanUp: (in category 'initialize-release') -----
- cleanUp: aggressive
- 	"Clean out any caches and other state that should be flushed when trying to get an image into a pristine state. The argument should be used to indicate how aggressive the cleanup should be. Some subclasses may act differently depending on its value - for example, ChangeSet will only delete all unused and reinitialize the current change set if we're asking it to be aggressive."
- 
- 	^self cleanUp!

Item was removed:
- ----- Method: Behavior>>commentsAt: (in category 'accessing method dictionary') -----
- commentsAt:  selector
- 	"Answer a string representing the first comment in the method associated with selector.  Return an empty string if the relevant source file is not available, or if the method's source code does not contain a comment.  Not smart enough to bypass quotes in string constants, but does map doubled quote into a single quote."
- 
- 
- 	^self commentsIn:  (self sourceCodeAt: selector) asString.
- 	
- "Behavior commentsAt: #commentsAt:"!

Item was removed:
- ----- Method: Behavior>>commentsIn: (in category 'accessing method dictionary') -----
- commentsIn: sourceString
- 	"Return the comments as a collection of strings in sourceString. This method along with #nextQuotePosIn:startingFrom: is wrong, because it assumes that all double quote characters are comment delimiters, but even this method has a double quote which is not part of any method comment. Also this method has nothing to do with the Behavior itself. Probably CompiledMethod is the best place for this."
- 	
- 	| commentStart nextQuotePos someComments aPos |
- 	(sourceString includes: $") ifFalse: [^#()].
- 	someComments:= OrderedCollection new.
- 	aPos:=1.
- 	nextQuotePos:= 0.
- 	[commentStart := sourceString findString: '"' startingAt: aPos.
- 	nextQuotePos:= self nextQuotePosIn: sourceString startingFrom: commentStart.
- 	(commentStart ~= 0 and: [nextQuotePos >commentStart])] whileTrue: [
- 		commentStart ~= nextQuotePos ifTrue: [
- 			someComments add: ((sourceString copyFrom: commentStart + 1 to: nextQuotePos - 1) copyReplaceAll: '""' with: '"').].
- 	aPos := nextQuotePos+1].
- 	^someComments!

Item was removed:
- ----- Method: Behavior>>compile: (in category 'compiling') -----
- compile: code 
- 	"Compile the argument, code, as source code in the context of the 
- 	receiver. Create an error notification if the code can not be compiled. 
- 	The argument is either a string or an object that converts to a string or a 
- 	PositionableStream on an object that converts to a string."
- 
- 	^self compile: code notifying: nil!

Item was removed:
- ----- Method: Behavior>>compile:environment:notifying:trailer:ifFail: (in category 'compiling') -----
- compile: code environment: anEnvironment notifying: requestor trailer: bytes ifFail: failBlock
- 	"Compile code in another Environment without logging the source in the changes file"
- 
- 	| methodNode |
- 	methodNode  := self newCompiler
- 				compile: code
- 				in: self
- 				environment: anEnvironment
- 				notifying: requestor
- 				ifFail: failBlock.
- 	^ CompiledMethodWithNode generateMethodFromNode: methodNode trailer: bytes.!

Item was removed:
- ----- Method: Behavior>>compile:notifying: (in category 'compiling') -----
- compile: code notifying: requestor 
- 	"Compile the argument, code, as source code in the context of the 
- 	receiver and insEtall the result in the receiver's method dictionary. The 
- 	second argument, requestor, is to be notified if an error occurs. The 
- 	argument code is either a string or an object that converts to a string or 
- 	a PositionableStream. This method also saves the source code."
- 	
- 	| methodAndNode |
- 	methodAndNode  := self
- 		compile: code "a Text"
- 		notifying: requestor
- 		trailer: (self defaultMethodTrailerIfLogSource: true)
- 		ifFail: [^nil].
- 	methodAndNode method putSource: code fromParseNode: methodAndNode node inFile: 2
- 			withPreamble: [:f | f cr; nextPut: $!!; nextChunkPut: 'Behavior method'; cr].
- 	self addSelector: methodAndNode selector withMethod: methodAndNode method notifying: requestor.
- 	^ methodAndNode selector!

Item was removed:
- ----- Method: Behavior>>compile:notifying:trailer:ifFail: (in category 'compiling') -----
- compile: code notifying: requestor trailer: bytes ifFail: failBlock
- 	"Compile code without logging the source in the changes file"
- 
- 	| methodNode |
- 	methodNode  := self newCompiler
- 				compile: code
- 				in: self
- 				notifying: requestor
- 				ifFail: failBlock.
- 	^ CompiledMethodWithNode generateMethodFromNode: methodNode trailer: bytes.!

Item was removed:
- ----- Method: Behavior>>compileAll (in category 'compiling') -----
- compileAll
- 	^ self compileAllFrom: self!

Item was removed:
- ----- Method: Behavior>>compileAllFrom: (in category 'compiling') -----
- compileAllFrom: oldClass
- 	"Compile all the methods in the receiver's method dictionary.
- 	 This validates sourceCode and variable references and forces
- 	 all methods to use the current bytecode set"
- 
- 	"ar 7/10/1999: Use oldClass selectors not self selectors"
- 	oldClass selectorsDo: [:sel | self recompile: sel from: oldClass]!

Item was removed:
- ----- Method: Behavior>>compiledMethodAt: (in category 'accessing method dictionary') -----
- compiledMethodAt: selector 
- 	"Answer the compiled method associated with the argument, selector (a 
- 	Symbol), a message selector in the receiver's method dictionary. If the 
- 	selector is not in the dictionary, create an error notification."
- 
- 	^ self methodDict at: selector!

Item was removed:
- ----- Method: Behavior>>compiledMethodAt:ifAbsent: (in category 'accessing method dictionary') -----
- compiledMethodAt: selector ifAbsent: aBlock
- 	"Answer the compiled method associated with the argument, selector (a Symbol), a message selector in the receiver's method dictionary. If the selector is not in the dictionary, return the value of aBlock"
- 
- 	^ self methodDict at: selector ifAbsent: aBlock!

Item was removed:
- ----- Method: Behavior>>compilerClass (in category 'compiling') -----
- compilerClass
- 	"Answer a compiler class appropriate for source methods of this class."
- 
- 	^Compiler!

Item was removed:
- ----- Method: Behavior>>compress (in category 'accessing method dictionary') -----
- compress
- 	"Compact the method dictionary of the receiver."
- 
- 	self methodDict compact!

Item was removed:
- ----- Method: Behavior>>compressedSourceCodeAt: (in category 'accessing method dictionary') -----
- compressedSourceCodeAt: selector
- 	"(Paragraph compressedSourceCodeAt: #displayLines:affectedRectangle:) size 721 1921
- 	Paragraph selectors inject: 0 into: [:tot :sel | tot + (Paragraph compressedSourceCodeAt: sel) size] 13606 31450"
- 	| rawText parse |
- 	rawText := (self sourceCodeAt: selector) asString.
- 	parse := self newCompiler parse: rawText in: self notifying: nil.
- 	^ rawText compressWithTable:
- 		((selector keywords ,
- 		parse tempNames ,
- 		self instVarNames ,
- 		#(self super ifTrue: ifFalse:) ,
- 		((0 to: 7) collect:
- 			[:i | String streamContents:
- 				[:s | s cr. i timesRepeat: [s tab]]]) ,
- 		(self compiledMethodAt: selector) literalStrings)
- 			sorted: [:a :b | a size > b size])!

Item was removed:
- ----- Method: Behavior>>copyOfMethodDictionary (in category 'copying') -----
- copyOfMethodDictionary
- 	"Return a copy of the receiver's method dictionary"
- 
- 	^ self methodDict copy!

Item was removed:
- ----- Method: Behavior>>crossReference (in category 'user interface') -----
- crossReference
- 	"Answer an Array of arrays of size 2 whose first element is a message selector in the receiver's method dictionary and whose second element is a set of all message selectors in the method dictionary whose methods send a message with that selector. Subclasses are not included."
- 
- 	^self selectors asArray sort collect: [:x | Array
- 			with: (String with: Character cr), x 
- 			with: (self whichSelectorsReferTo: x)]
- 
- 	"Point crossReference."!

Item was removed:
- ----- Method: Behavior>>decompile: (in category 'compiling') -----
- decompile: selector 
- 	"Find the compiled code associated with the argument, selector, as a 
- 	message selector in the receiver's method dictionary and decompile it. 
- 	Answer the resulting source code as a string. Create an error notification 
- 	if the selector is not in the receiver's method dictionary."
- 
- 	^self decompilerClass new decompile: selector in: self!

Item was removed:
- ----- Method: Behavior>>decompilerClass (in category 'compiling') -----
- decompilerClass
- 	"Answer a decompiler class appropriate for compiled methods of this class."
- 
- 	^ self compilerClass decompilerClass!

Item was removed:
- ----- Method: Behavior>>deepCopy (in category 'copying') -----
- deepCopy
- 	"Behavior are shared rather than copied."
- 
- 	^ self!

Item was removed:
- ----- Method: Behavior>>defaultMethodTrailer (in category 'compiling') -----
- defaultMethodTrailer
- 	^ CompiledMethodTrailer empty!

Item was removed:
- ----- Method: Behavior>>defaultMethodTrailerIfLogSource: (in category 'compiling') -----
- defaultMethodTrailerIfLogSource: logSource
- 
- 	logSource ifFalse: [ ^self defaultMethodTrailer ].
- 	^CompiledMethodTrailer sourcePointerInFile: 2!

Item was removed:
- ----- Method: Behavior>>defaultNameStemForInstances (in category 'printing') -----
- defaultNameStemForInstances
- 	"Answer a basis for external names for default instances of the receiver.
- 	For classees, the class-name itself is a good one."
- 
- 	^ self name!

Item was removed:
- ----- Method: Behavior>>elementSize (in category 'accessing instances and variables') -----
- elementSize
- 	"Answer the size in bytes of an element in the receiver.  The formats are
- 			0	= 0 sized objects (UndefinedObject True False et al)
- 			1	= non-indexable objects with inst vars (Point et al)
- 			2	= indexable objects with no inst vars (Array et al)
- 			3	= indexable objects with inst vars (Context BlockClosure AdditionalMethodState et al)
- 			4	= weak indexable objects with inst vars (WeakArray et al)
- 			5	= weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
- 			6	= unused
- 			7	= immediates (SmallInteger, Character)
- 			8	= unused
- 			9	= 64-bit indexable
- 		10-11	= 32-bit indexable (Bitmap)
- 		12-15	= 16-bit indexable
- 		16-23	= 8-bit indexable
- 		24-31	= compiled methods (CompiledMethod)"
- 	| instSpec |
- 	instSpec := self instSpec.
- 	instSpec < 9 ifTrue: [^Smalltalk wordSize].
- 	instSpec >= 16 ifTrue: [^1].
- 	instSpec >= 12 ifTrue: [^2].
- 	instSpec >= 10 ifTrue: [^4].
- 	^8!

Item was removed:
- ----- Method: Behavior>>emptyMethodDictionary (in category 'initialize-release') -----
- emptyMethodDictionary
- 
- 	^ MethodDictionary new!

Item was removed:
- ----- Method: Behavior>>environment (in category 'accessing') -----
- environment
- 	"Return the environment in which the receiver is declared"
- 	^Smalltalk globals!

Item was removed:
- ----- Method: Behavior>>evaluatorClass (in category 'compiling') -----
- evaluatorClass
- 	"Answer an evaluator class appropriate for evaluating expressions in the 
- 	context of this class."
- 
- 	^Compiler!

Item was removed:
- ----- Method: Behavior>>firstCommentAt: (in category 'accessing method dictionary') -----
- firstCommentAt:  selector
- 	"Answer a string representing the first comment in the method associated with selector.  Return an empty string if the relevant source file is not available, or if the method's source code does not contain a comment.  Not smart enough to bypass quotes in string constants, but does map doubled quote into a single quote."
- 
- 	|someComments|
- 	someComments := self commentsAt: selector.
- 	^someComments isEmpty ifTrue: [''] ifFalse: [someComments first]
- 
- 
- "Behavior firstCommentAt: #firstCommentAt:"!

Item was removed:
- ----- Method: Behavior>>firstPrecodeCommentFor: (in category 'accessing method dictionary') -----
- firstPrecodeCommentFor:  selector
- 	"If there is a comment in the source code at the given selector that preceeds the body of the method, return it here, else return nil"
- 
- 	| parser source tree |
- 	"Behavior firstPrecodeCommentFor: #firstPrecodeCommentFor:"
- 	(#(Comment Definition Hierarchy) includes: selector)
- 		ifTrue:
- 			["Not really a selector"
- 			^ nil].
- 	source := self sourceCodeAt: selector asSymbol ifAbsent: [^ nil].
- 	parser := self newParser.
- 	tree := 
- 		parser
- 			parse: (ReadStream on: source)
- 			class: self
- 			noPattern: false
- 			notifying: nil
- 			ifFail: [^ nil].
- 	^ (tree comment ifNil: [^ nil]) first!

Item was removed:
- ----- Method: Behavior>>flushCache (in category 'private') -----
- flushCache
- 	"Tell the interpreter to remove the contents of its method lookup cache, if it has 
- 	one.  Essential.  See Object documentation whatIsAPrimitive."
- 
- 	<primitive: 89>
- 	self primitiveFailed!

Item was removed:
- ----- Method: Behavior>>formalHeaderPartsFor: (in category 'accessing method dictionary') -----
- "popeye" formalHeaderPartsFor: "olive oil" aSelector
- 	"RELAX!!  The warning you may have just seen about possibly having a bad source file does not apply here, because this method *intends* to have its source code start with a comment.
- 	This method returns a collection giving the parts in the formal declaration for aSelector.  This parse is in support of schemes in which adjutant properties of a method can be declared via special comments secreted in the formal header
- 	The result will have
-      	3 elements for a simple, argumentless selector.
- 		5 elements for a single-argument selector
- 		9 elements for a two-argument selector
- 		13 elements for a three-argument, selector
- 		etc...
- 
- 	The syntactic elements are:
- 
- 		1		comment preceding initial selector fragment
- 
- 		2		first selector fragment
- 		3		comment following first selector fragment  (nil if selector has no arguments)
- 
-         ----------------------  (ends here for, e.g., #copy)
- 
- 		4		first formal argument
- 		5		comment following first formal argument (nil if selector has only one argument)
- 
-         ----------------------  (ends here for, e.g., #copyFrom:)
- 
- 		6		second keyword
- 		7		comment following second keyword
- 		8		second formal argument
- 		9		comment following second formal argument (nil if selector has only two arguments)
- 
-          ----------------------  (ends here for, e.g., #copyFrom:to:)
- 
- 	Any nil element signifies an absent comment.
- 	NOTE: The comment following the final formal argument is *not* successfully retrieved by this method in its current form, though it can be obtained, if needed, by other means (e.g. calling #firstPrecodeCommentFor:).  Thus, the *final* element in the structure returned by this method is always going to be nil."
- 
- 	^ Scanner new scanMessageParts: (self methodHeaderFor: aSelector)
- 
- "
- 	Behavior class formalHeaderPartsFor: #formalHeaderPartsFor:
- "
- 
- 
- 	!

Item was removed:
- ----- Method: Behavior>>formalParametersAt: (in category 'accessing method dictionary') -----
- formalParametersAt: aSelector
- 	"Return the names of the arguments used in this method."
- 
- 	| source |
- 	source := self sourceCodeAt: aSelector ifAbsent: [^ #()].	"for now"
- 	^self newParser parseParameterNames: source!

Item was removed:
- ----- Method: Behavior>>format (in category 'accessing') -----
- format
- 	"Answer an Integer that encodes the kinds and numbers of variables of 
- 	 instances of the receiver.  The format is (currently) composed of two fields,
- 	 a 16-bit instSize, in the least significant bits, specifying the number of named
- 	 inst vars, if any, and a 5-bit format field, describing the kind of class.  c.f. instSpec.
- 		(msb)<5 bit format><16 bit #fixed fields>(lsb)"
- 
- 	^format!

Item was removed:
- ----- Method: Behavior>>formatterClass (in category 'printing') -----
- formatterClass
- 	 ^self compilerClass!

Item was removed:
- ----- Method: Behavior>>fullyImplementsVocabulary: (in category 'testing method dictionary') -----
- fullyImplementsVocabulary: aVocabulary
- 	"Answer whether instances of the receiver respond to all the messages in aVocabulary"
- 
- 	(aVocabulary encompassesAPriori: self) ifTrue: [^ true].
- 	aVocabulary allSelectorsInVocabulary do:
- 		[:aSelector | (self canUnderstand: aSelector) ifFalse: [^ false]].
- 	^ true!

Item was removed:
- ----- Method: Behavior>>handleFailingBasicNew (in category 'private') -----
- handleFailingBasicNew
- 	"handleFailingBasicNew gets sent after basicNew has failed and allowed
- 	 a scavenging garbage collection to occur.  The scavenging collection
- 	 will have happened as the VM is activating the (failing) basicNew.  If
- 	 handleFailingBasicNew fails then the scavenge failed to reclaim sufficient
- 	 space and a global garbage collection is required.  Retry after garbage
- 	 collecting and growing memory if necessary.
- 
- 	 Primitive. Answer an instance of this class with the number of indexable
- 	 variables specified by the argument, sizeRequested.  Fail if this class is not
- 	 indexable or if the argument is not a positive Integer, or if there is not
- 	 enough memory available. Essential. See Object documentation whatIsAPrimitive."
- 
- 	<primitive: 70>
- 	Smalltalk garbageCollect < 1048576 ifTrue:
- 		[Smalltalk growMemoryByAtLeast: 1048576].
- 	^self handleFailingFailingBasicNew "retry after global garbage collect"!

Item was removed:
- ----- Method: Behavior>>handleFailingBasicNew: (in category 'private') -----
- handleFailingBasicNew: sizeRequested
- 	"handleFailingBasicNew: gets sent after basicNew: has failed and allowed
- 	 a scavenging garbage collection to occur.  The scavenging collection
- 	 will have happened as the VM is activating the (failing) basicNew:.  If
- 	 handleFailingBasicNew: fails then the scavenge failed to reclaim sufficient
- 	 space and a global garbage collection is required.  Retry after garbage
- 	 collecting and growing memory if necessary.
- 
- 	 Primitive. Answer an instance of this class with the number of indexable
- 	 variables specified by the argument, sizeRequested.  Fail if this class is not
- 	 indexable or if the argument is not a positive Integer, or if there is not
- 	 enough memory available. Essential. See Object documentation whatIsAPrimitive."
- 
- 	<primitive: 71>
- 	| bytesRequested |
- 	bytesRequested := self byteSizeOfInstanceOfSize: sizeRequested.
- 	Smalltalk garbageCollect < bytesRequested ifTrue:
- 		[Smalltalk growMemoryByAtLeast: bytesRequested].
- 	"retry after global garbage collect and possible grow"
- 	^self handleFailingFailingBasicNew: sizeRequested!

Item was removed:
- ----- Method: Behavior>>handleFailingFailingBasicNew (in category 'private') -----
- handleFailingFailingBasicNew
- 	"This basicNew gets sent after handleFailingBasicNew: has done a full
- 	 garbage collection and possibly grown memory.  If this basicNew fails
- 	 then the system really is low on space, so raise the OutOfMemory signal.
- 
- 	 Primitive. Answer an instance of this class with the number of indexable
- 	 variables specified by the argument, sizeRequested.  Fail if this class is not
- 	 indexable or if the argument is not a positive Integer, or if there is not
- 	 enough memory available. Essential. See Object documentation whatIsAPrimitive."
- 
- 	<primitive: 70>
- 	"space must be low"
- 	OutOfMemory signal.
- 	^self basicNew  "retry if user proceeds"!

Item was removed:
- ----- Method: Behavior>>handleFailingFailingBasicNew: (in category 'private') -----
- handleFailingFailingBasicNew: sizeRequested
- 	"This basicNew: gets sent after handleFailingBasicNew: has done a full
- 	 garbage collection and possibly grown memory.  If this basicNew: fails
- 	 then the system really is low on space, so raise the OutOfMemory signal.
- 
- 	 Primitive. Answer an instance of this class with the number of indexable
- 	 variables specified by the argument, sizeRequested.  Fail if this class is not
- 	 indexable or if the argument is not a positive Integer, or if there is not
- 	 enough memory available. Essential. See Object documentation whatIsAPrimitive."
- 
- 	<primitive: 71>
- 	"space must be low."
- 	OutOfMemory signal.
- 	^self basicNew: sizeRequested  "retry if user proceeds"!

Item was removed:
- ----- Method: Behavior>>hasMethods (in category 'testing method dictionary') -----
- hasMethods
- 	"Answer whether the receiver has any methods in its method dictionary."
- 
- 	^ self methodDict size > 0!

Item was removed:
- ----- Method: Behavior>>hasTraitComposition (in category 'Backstop-Traits') -----
- hasTraitComposition
- 	"Backstop. When traits are unloaded we never have a trait composition"
- 	^false!

Item was removed:
- ----- Method: Behavior>>hash (in category 'comparing') -----
- hash
- 	^ self name hash!

Item was removed:
- ----- Method: Behavior>>identityHash (in category 'comparing') -----
- identityHash
- 	"Answer a SmallInteger whose value is related to the receiver's identity.
- 	 Behavior implements identityHash to allow the VM to use an object representation which
- 	 does not include a direct reference to an object's class in an object.  If the VM is using
- 	 this implementation then classes are held in a class table and instances contain the index
- 	 of their class in the table.  A class's class table index is its identityHash so that an instance
- 	 can be created without searching the table for a class's index.  The VM uses this primitive
- 	 to enter the class into the class table, assigning its identityHash with an as yet unused
- 	 class table index. If this primitive fails it means that the class table is full.  In Spur as of
- 	 2014 there are 22 bits of classTable index and 22 bits of identityHash per object.
- 
- 	 Primitive. Essential. Do not override. See Object documentation whatIsAPrimitive."
- 
- 	<primitive: 175>
- 	self primitiveFailed!

Item was removed:
- ----- Method: Behavior>>includesBehavior: (in category 'testing class hierarchy') -----
- includesBehavior: aClass
- 	^self == aClass or:[self inheritsFrom: aClass]!

Item was removed:
- ----- Method: Behavior>>includesLocalSelector: (in category 'testing method dictionary') -----
- includesLocalSelector: aSymbol
- 	^self includesSelector: aSymbol!

Item was removed:
- ----- Method: Behavior>>includesSelector: (in category 'testing method dictionary') -----
- includesSelector: aSymbol 
- 	"Answer whether the message whose selector is the argument is in the 
- 	method dictionary of the receiver's class."
- 
- 	^ self methodDict includesKey: aSymbol!

Item was removed:
- ----- Method: Behavior>>inheritsFrom: (in category 'testing class hierarchy') -----
- inheritsFrom: aClass 
- 	"Answer whether the argument, aClass, is on the receiver's superclass 
- 	chain."
- 
- 	| aSuperclass |
- 	aSuperclass := superclass.
- 	[aSuperclass == nil]
- 		whileFalse: 
- 			[aSuperclass == aClass ifTrue: [^true].
- 			aSuperclass := aSuperclass superclass].
- 	^false!

Item was removed:
- ----- Method: Behavior>>initialize (in category 'initialize-release') -----
- initialize
- 	"moved here from the class side's #new"
- 	self methodDictionary: self emptyMethodDictionary.
- 	self superclass: Object.
- 	self setFormat: Object format!

Item was removed:
- ----- Method: Behavior>>initializedInstance (in category 'instance creation') -----
- initializedInstance
- 	"Answer an instance of the receiver which in some sense is initialized.  In the case of Morphs, this will yield an instance that can be attached to the Hand after having received the same kind of basic initialization that would be obtained from an instance chosen from the 'new morph' menu.   Return nil if the receiver is reluctant for some reason to return such a thing"
- 
- 	^ self new!

Item was removed:
- ----- Method: Behavior>>instSize (in category 'testing') -----
- instSize
- 	"Answer the number of named instance variables
- 	(as opposed to indexed variables) of the receiver.
- 	 Above Cog Spur the class format is
- 		<5 bits inst spec><16 bits inst size>"
- 	^format bitAnd: 16rFFFF!

Item was removed:
- ----- Method: Behavior>>instSpec (in category 'testing') -----
- instSpec
- 	"Answer the instance specification part of the format that defines what kind of object
- 	 an instance of the receiver is.  The formats are
- 			0	= 0 sized objects (UndefinedObject True False et al)
- 			1	= non-indexable objects with inst vars (Point et al)
- 			2	= indexable objects with no inst vars (Array et al)
- 			3	= indexable objects with inst vars (Context BlockClosure AdditionalMethodState et al)
- 			4	= weak indexable objects with inst vars (WeakArray et al)
- 			5	= weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
- 			6	= unused
- 			7	= immediates (SmallInteger, Character)
- 			8	= unused
- 			9	= 64-bit indexable	(DoubleWordArray et al)
- 		10-11	= 32-bit indexable	(WordArray et al)			(includes one odd bit, unused in 32-bit instances)
- 		12-15	= 16-bit indexable	(DoubleByteArray et al)		(includes two odd bits, one unused in 32-bit instances)
- 		16-23	= 8-bit indexable	(ByteArray et al)			(includes three odd bits, one unused in 32-bit instances)
- 		24-31	= compiled code	(CompiledCode et al)		(includes three odd bits, one unused in 32-bit instances)
- 
- 	 Note that in the VM instances also have a 5 bit format field that relates to their class's format.
- 	 Formats 11, 13-15, 17-23 & 25-31 are unused in classes but used in instances to define the
- 	 number of elements missing up to the slot size.  For example, a 2-byte ByteString instance
- 	 has format 18 in 32 bits, since its size is one 32-bit slot - 2 bytes ((18 bitAnd: 3) = 2), and
- 	 22 in 64 bits, since its size is one 64-bit slot - 6 bytes ((22 bitAnd: 7) = 6).
- 	 Formats 24-31 are for compiled code which is a combination of pointers and bytes.  The number of pointers is
- 	 determined by literal count field of the method header, which is the first field of the object and must be a SmallInteger. 
- 	 The literal count field occupies the least significant 15 bits of the method header, allowing up to 32,767 pointer fields,
- 	 not including the header."
- 	^(format bitShift: -16) bitAnd: 16r1F!

Item was removed:
- ----- Method: Behavior>>instVarIndexFor:ifAbsent: (in category 'accessing instances and variables') -----
- instVarIndexFor: instVarName ifAbsent: aBlock
- 	"Answer the index of the named instance variable."
- 	
- 	^self allInstVarNames indexOf: instVarName ifAbsent: aBlock!

Item was removed:
- ----- Method: Behavior>>instVarNames (in category 'accessing instances and variables') -----
- instVarNames
- 	"Answer an Array of the instance variable names. Behaviors must make 
- 	up fake local instance variable names because Behaviors have instance 
- 	variables for the purpose of compiling methods, but these are not named 
- 	instance variables."
- 
- 	| mySize superSize |
- 	mySize := self instSize.
- 	superSize := 
- 		superclass == nil
- 			ifTrue: [0]
- 			ifFalse: [superclass instSize].
- 	mySize = superSize ifTrue: [^#()].	
- 	^(superSize + 1 to: mySize) collect: [:i | 'inst' , i printString]!

Item was removed:
- ----- Method: Behavior>>instVarNamesAndOffsetsDo: (in category 'compiling') -----
- instVarNamesAndOffsetsDo: aBinaryBlock
- 	"This is part of the interface between the compiler and a class's instance or field names.
- 	 The class should enumerate aBinaryBlock with the instance variable name strings and
- 	 their integer offsets.  The order is important. Names evaluated later will override the
- 	 same names occurring earlier."
- 
- 	"Nothing to do here; ClassDescription introduces named instance variables"
- 	^self!

Item was removed:
- ----- Method: Behavior>>instanceCount (in category 'accessing instances and variables') -----
- instanceCount
- 	"Answer the number of instances of the receiver that are currently in 
- 	use."
- 
- 	| count |
- 	count := 0.
- 	self allInstancesDo: [:x | count := count + 1].
- 	^count!

Item was removed:
- ----- Method: Behavior>>isBehavior (in category 'testing') -----
- isBehavior
- 	"Return true if the receiver is a behavior"
- 	^true!

Item was removed:
- ----- Method: Behavior>>isBits (in category 'testing') -----
- isBits
- 	"Answer whether the receiver contains just bits (not pointers).
- 	 Above Cog Spur the class format is
- 		<5 bits inst spec><16 bits inst size>
- 	 where the 5-bit inst spec is
- 			0	= 0 sized objects (UndefinedObject True False et al)
- 			1	= non-indexable objects with inst vars (Point et al)
- 			2	= indexable objects with no inst vars (Array et al)
- 			3	= indexable objects with inst vars (Context BlockClosure AdditionalMethodState et al)
- 			4	= weak indexable objects with inst vars (WeakArray et al)
- 			5	= weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
- 			6	= unused
- 			7	= immediates (SmallInteger, Character)
- 			8	= unused
- 			9	= 64-bit indexable
- 		10-11	= 32-bit indexable (Bitmap)
- 		12-15	= 16-bit indexable
- 		16-23	= 8-bit indexable
- 		24-31	= compiled methods (CompiledMethod)"
- 	^self instSpec >= 7!

Item was removed:
- ----- Method: Behavior>>isBytes (in category 'testing') -----
- isBytes
- 	"Answer whether the receiver's instances have indexed 8-bit integer instance variables.
- 	 Above Cog Spur the class format is
- 		<5 bits inst spec><16 bits inst size>
- 	 where the 5-bit inst spec is
- 			0	= 0 sized objects (UndefinedObject True False et al)
- 			1	= non-indexable objects with inst vars (Point et al)
- 			2	= indexable objects with no inst vars (Array et al)
- 			3	= indexable objects with inst vars (Context BlockClosure AdditionalMethodState et al)
- 			4	= weak indexable objects with inst vars (WeakArray et al)
- 			5	= weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
- 			6	= unused
- 			7	= immediates (SmallInteger, Character)
- 			8	= unused
- 			9	= 64-bit indexable
- 		10-11	= 32-bit indexable (Bitmap)
- 		12-15	= 16-bit indexable
- 		16-23	= 8-bit indexable
- 		24-31	= compiled methods (CompiledMethod)"
- 	^self instSpec >= 16!

Item was removed:
- ----- Method: Behavior>>isCompiledMethodClass (in category 'testing') -----
- isCompiledMethodClass
- 	"Answer whether the receiver has compiled method instances that mix pointers and bytes."
- 	^self instSpec >= 24!

Item was removed:
- ----- Method: Behavior>>isEphemeronClass (in category 'testing') -----
- isEphemeronClass
- 	"Answer whether the receiver has ephemeral instance variables.  The garbage collector will
- 	 fire (queue for finalization) any ephemeron whose first instance variable is not referenced
- 	 other than from the transitive closure of references from ephemerons. Hence referring to
- 	 an object from the first inst var of an ephemeron will cause the ephemeron to fire when
- 	 the rest of the system does not refer to the object and that object is ready to be collected.
- 	 Since references from the remaining inst vars of an ephemeron will not prevent the ephemeron
- 	 from firing, ephemerons may act as the associations in weak dictionaries such that the value
- 	 (e.g. properties attached to the key) will not prevent firing when the key is no longer referenced
- 	 other than from ephemerons.  Ephemerons can therefore be used to implement instance-based
- 	 pre-mortem finalization."
- 	^self instSpec = 5!

Item was removed:
- ----- Method: Behavior>>isFixed (in category 'testing') -----
- isFixed
- 	"Answer whether the receiver does not have a variable (indexable) part."
- 
- 	^self isVariable not!

Item was removed:
- ----- Method: Behavior>>isImmediateClass (in category 'testing') -----
- isImmediateClass
- 	"Answer whether the receiver has immediate instances.  Immediate instances
- 	 store their value in their object pointer, not in an object body.  Hence immediates
- 	 take no space and are immutable.  The immediates are distinguished by tag bits
- 	 in the pointer. They include SmallIntegers and Characters.  Hence in the 32-bit
- 	 system SmallIntegers are 31-bit signed integers and Characters are 30-bit
- 	 unsigned character codes."
- 	^self instSpec = 7!

Item was removed:
- ----- Method: Behavior>>isLongs (in category 'testing') -----
- isLongs
- 	"Answer whether the receiver's instances have indexed 64-bit integer instance variables.
- 	 Above Cog Spur the class format is
- 		<5 bits inst spec><16 bits inst size>
- 	 where the 5-bit inst spec is
- 			0	= 0 sized objects (UndefinedObject True False et al)
- 			1	= non-indexable objects with inst vars (Point et al)
- 			2	= indexable objects with no inst vars (Array et al)
- 			3	= indexable objects with inst vars (Context BlockClosure AdditionalMethodState et al)
- 			4	= weak indexable objects with inst vars (WeakArray et al)
- 			5	= weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
- 			6	= unused
- 			7	= immediates (SmallInteger, Character)
- 			8	= unused
- 			9	= 64-bit indexable
- 		10-11	= 32-bit indexable (Bitmap)
- 		12-15	= 16-bit indexable
- 		16-23	= 8-bit indexable
- 		24-31	= compiled methods (CompiledMethod)"
- 	^self instSpec = 9!

Item was removed:
- ----- Method: Behavior>>isMeta (in category 'testing') -----
- isMeta
- 	^ false!

Item was removed:
- ----- Method: Behavior>>isObsolete (in category 'testing') -----
- isObsolete
- 	"Return true if the receiver is obsolete."
- 	^self instanceCount = 0!

Item was removed:
- ----- Method: Behavior>>isPointers (in category 'testing') -----
- isPointers
- 	"Answer whether the receiver contains just pointers (not bits)."
- 
- 	^self isBits not!

Item was removed:
- ----- Method: Behavior>>isShorts (in category 'testing') -----
- isShorts
- 	"Answer whether the receiver's instances have indexed 16-bit integer instance variables.
- 	 Above Cog Spur the class format is
- 		<5 bits inst spec><16 bits inst size>
- 	 where the 5-bit inst spec is
- 			0	= 0 sized objects (UndefinedObject True False et al)
- 			1	= non-indexable objects with inst vars (Point et al)
- 			2	= indexable objects with no inst vars (Array et al)
- 			3	= indexable objects with inst vars (Context BlockClosure AdditionalMethodState et al)
- 			4	= weak indexable objects with inst vars (WeakArray et al)
- 			5	= weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
- 			6	= unused
- 			7	= immediates (SmallInteger, Character)
- 			8	= unused
- 			9	= 64-bit indexable
- 		10-11	= 32-bit indexable (Bitmap)
- 		12-15	= 16-bit indexable
- 		16-23	= 8-bit indexable
- 		24-31	= compiled methods (CompiledMethod)"
- 	^self instSpec = 12!

Item was removed:
- ----- Method: Behavior>>isVariable (in category 'testing') -----
- isVariable
- 	"Answer whether the receiver has indexable variables.
- 	 Above Cog Spur the class format is
- 		<5 bits inst spec><16 bits inst size>
- 	 where the 5-bit inst spec is
- 			0	= 0 sized objects (UndefinedObject True False et al)
- 			1	= non-indexable objects with inst vars (Point et al)
- 			2	= indexable objects with no inst vars (Array et al)
- 			3	= indexable objects with inst vars (Context BlockClosure AdditionalMethodState et al)
- 			4	= weak indexable objects with inst vars (WeakArray et al)
- 			5	= weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
- 			6	= unused
- 			7	= immediates (SmallInteger, Character)
- 			8	= unused
- 			9	= 64-bit indexable
- 		10-11	= 32-bit indexable (Bitmap)
- 		12-15	= 16-bit indexable
- 		16-23	= 8-bit indexable
- 		24-31	= compiled methods (CompiledMethod)"
- 	| instSpec |
- 	instSpec := self instSpec.
- 	^instSpec >= 2 and: [instSpec <= 4 or: [instSpec >= 9]]!

Item was removed:
- ----- Method: Behavior>>isWeak (in category 'testing') -----
- isWeak
- 	"Answer whether the receiver has contains weak references."
- 	^ self instSpec = 4!

Item was removed:
- ----- Method: Behavior>>isWords (in category 'testing') -----
- isWords
- 	"Answer whether the receiver's instances have indexed 32-bit integer instance variables.
- 	 Above Cog Spur the class format is
- 		<5 bits inst spec><16 bits inst size>
- 	 where the 5-bit inst spec is
- 			0	= 0 sized objects (UndefinedObject True False et al)
- 			1	= non-indexable objects with inst vars (Point et al)
- 			2	= indexable objects with no inst vars (Array et al)
- 			3	= indexable objects with inst vars (Context BlockClosure AdditionalMethodState et al)
- 			4	= weak indexable objects with inst vars (WeakArray et al)
- 			5	= weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
- 			6	= unused
- 			7	= immediates (SmallInteger, Character)
- 			8	= unused
- 			9	= 64-bit indexable
- 		10-11	= 32-bit indexable (Bitmap)
- 		12-15	= 16-bit indexable
- 		16-23	= 8-bit indexable
- 		24-31	= compiled methods (CompiledMethod)"
- 	^self instSpec = 10!

Item was removed:
- ----- Method: Behavior>>kindOfSubclass (in category 'testing class hierarchy') -----
- kindOfSubclass
- 	"Answer a String that is the keyword that describes the receiver's kind of subclass,
- 	 either a regular subclass, a variableSubclass, a variableByteSubclass,
- 	 a variableWordSubclass, a weakSubclass, an ephemeronSubclass or an immediateSubclass.
- 	 c.f. typeOfClass & instSpec"
- 	^(#(' subclass: '
- 		' subclass: '
- 		' variableSubclass: '
- 		' variableSubclass: '
- 		' weakSubclass: '
- 		' ephemeronSubclass: '
- 		nil
- 		' immediateSubclass: '
- 		nil
- 		' variableDoubleWordSubclass: '
- 		' variableWordSubclass: '		nil
- 		' variableDoubleByteSubclass: '	nil nil nil
- 		' variableByteSubclass: '		nil nil nil nil nil nil nil
- 		' variableByteSubclass: '		nil nil nil nil nil nil nil )
- 			at: self instSpec + 1) ifNil:
- 				[self error: 'invalid class type']!

Item was removed:
- ----- Method: Behavior>>literalScannedAs:environment:notifying: (in category 'printing') -----
- literalScannedAs: scannedLiteral environment: anEnvironment notifying: requestor
- 	"Postprocesses a literal scanned by Scanner scanToken (esp. xLitQuote).
- 	If scannedLiteral is not an association, answer it.
- 	Else, if it is of the form:
- 		nil->#NameOfMetaclass
- 	answer nil->theMetaclass, if any has that name, else report an error.
- 	Else, if it is of the form:
- 		#NameOfGlobalVariable->anythiEng
- 	answer the global, class, or pool association with that nameE, if any, else
- 	add it to Undeclared a answer the new Association."
- 
- 	| key value |
- 	(scannedLiteral isVariableBinding)
- 		ifFalse: [^ scannedLiteral].
- 	key := scannedLiteral key.
- 	value := scannedLiteral value.
- 	key ifNil: "###<metaclass soleInstance name>"
- 		[(self bindingOf: value environment: anEnvironment) ifNotNil:
- 			[:assoc|
- 			(assoc value isKindOf: Behavior) ifTrue: 
- 				[^ nil->assoc value class]].
- 			 requestor notify: 'No such metaclass'.
- 			 ^false].
- 	(key isSymbol) ifTrue: "##<global var name>"
- 		[(self bindingOf: key environment: anEnvironment) ifNotNil:
- 			[:assoc | ^assoc].
- 		^ anEnvironment undeclared: key].
- 	requestor notify: '## must be followed by a non-local variable name'.
- 	^false
- 
- "	Form literalScannedAs: 14 notifying: nil 14
- 	Form literalScannedAs: #OneBitForm notiEfying: nil  OneBitForm
- 	Form literalScannedAs: ##OneBitForm notifying: nil  OneBitForm->a Form
- 	Form literalScannedAs: ##Form notifying: nil   Form->Form
- 	Form literalScannedAs: ###Form notifying: nil   nilE->Form class
- "!

Item was removed:
- ----- Method: Behavior>>localSelectors (in category 'adding/removing methods') -----
- localSelectors
- 	"Return a set of selectors defined locally."
- 	^ self selectors
- !

Item was removed:
- ----- Method: Behavior>>longPrintOn: (in category 'printing') -----
- longPrintOn: aStream
- 	"Append to the argument, aStream, the names and values of all of the receiver's instance variables.  But, not useful for a class with a method dictionary."
- 
- 	aStream nextPutAll: '<<too complex to show>>'; cr.!

Item was removed:
- ----- Method: Behavior>>lookupSelector: (in category 'accessing method dictionary') -----
- lookupSelector: selector
- 	"Look up the given selector in my methodDictionary.
- 	Return the corresponding method if found.
- 	Otherwise chase the superclass chain and try again.
- 	Return nil if no method is found."
- 	| lookupClass |
- 	lookupClass := self.
- 	[lookupClass == nil]
- 		whileFalse: 
- 			[(lookupClass includesSelector: selector)
- 				ifTrue: [^ lookupClass compiledMethodAt: selector].
- 			lookupClass := lookupClass superclass].
- 	^ nil!

Item was removed:
- ----- Method: Behavior>>methodDict (in category 'accessing') -----
- methodDict
- 	methodDict == nil ifTrue: [self recoverFromMDFaultWithTrace].
- 	^ methodDict!

Item was removed:
- ----- Method: Behavior>>methodDict: (in category 'accessing method dictionary') -----
- methodDict: aDictionary
- 	methodDict := aDictionary!

Item was removed:
- ----- Method: Behavior>>methodDictionary (in category 'accessing method dictionary') -----
- methodDictionary
- 	"Convenience"
- 	^self methodDict!

Item was removed:
- ----- Method: Behavior>>methodDictionary: (in category 'accessing method dictionary') -----
- methodDictionary: aDictionary
- 	self methodDict: aDictionary!

Item was removed:
- ----- Method: Behavior>>methodHeaderFor: (in category 'accessing method dictionary') -----
- methodHeaderFor: selector 
- 	"Answer the string corresponding to the method header for the given selector"
- 
- 	| sourceString parser |
- 	sourceString := self ultimateSourceCodeAt: selector ifAbsent: [self standardMethodHeaderFor: selector].
- 	(parser := self newParser) parseSelector: sourceString.
- 	^ sourceString asString copyFrom: 1 to: (parser endOfLastToken min: sourceString size)
- 
- 	"Behavior methodHeaderFor: #methodHeaderFor: "
- !

Item was removed:
- ----- Method: Behavior>>methodsDo: (in category 'accessing method dictionary') -----
- methodsDo: aBlock
- 	"Evaluate aBlock for all the compiled methods in my method dictionary."
- 
- 	^ self methodDict valuesDo: aBlock!

Item was removed:
- ----- Method: Behavior>>modificationForbiddenAdopting: (in category 'read-only objects') -----
- modificationForbiddenAdopting: anObject
- 	^(BinaryModificationForbidden new
- 		mirror: self
- 		object: anObject
- 		index: nil
- 		newValue: nil
- 		retrySelector: #adoptInstance:) signal!

Item was removed:
- ----- Method: Behavior>>name (in category 'accessing') -----
- name
- 	"Answer a String that is the name of the receiver."
- 	^'a subclass of ', superclass name!

Item was removed:
- ----- Method: Behavior>>new (in category 'instance creation') -----
- new
- 	"Answer a new initialized instance of the receiver (which is a class) with no indexable variables. Fail if the class is indexable."
- 
- 	^ self basicNew initialize
- !

Item was removed:
- ----- Method: Behavior>>new: (in category 'instance creation') -----
- new: sizeRequested 
- 	"Answer an initialized instance of this class with the number of indexable
- 	variables specified by the argument, sizeRequested."
- 
- 	^ (self basicNew: sizeRequested) initialize  !

Item was removed:
- ----- Method: Behavior>>newCompiler (in category 'compiling') -----
- newCompiler
- 	"Answer a Compiler suitable for compiling this Behavior"
- 	^self compilerClass new parser: self newParser!

Item was removed:
- ----- Method: Behavior>>newParser (in category 'compiling') -----
- newParser
- 	"Answer a Parser suitable for parsing source code in this Behavior"
- 	^self parserClass new!

Item was removed:
- ----- Method: Behavior>>nextQuotePosIn:startingFrom: (in category 'accessing method dictionary') -----
- nextQuotePosIn: sourceString startingFrom: commentStart
- 	| pos nextQuotePos |
- 	pos := commentStart + 1.
- 	[((nextQuotePos := sourceString findString: '"' startingAt: pos) == (sourceString findString: '""' startingAt: pos)) and: [nextQuotePos ~= 0]]
- 		whileTrue:
- 			[pos := nextQuotePos + 2].
- 	^nextQuotePos!

Item was removed:
- ----- Method: Behavior>>nonObsoleteClass (in category 'initialize-release') -----
- nonObsoleteClass
- 	"Attempt to find and return the current version of this obsolete class"
- 
- 	| obsName |
- 	obsName := self name.
- 	[obsName beginsWith: 'AnObsolete']
- 		whileTrue: [obsName := obsName copyFrom: 'AnObsolete' size + 1 to: obsName size].
- 	^ self environment at: obsName asSymbol!

Item was removed:
- ----- Method: Behavior>>obsolete (in category 'initialize-release') -----
- obsolete
- 	"Invalidate and recycle local methods,
- 	e.g., zap the method dictionary if can be done safely."
- 	self canZapMethodDictionary
- 		ifTrue: [self methodDict: self emptyMethodDictionary].!

Item was removed:
- ----- Method: Behavior>>obsoleteSubclasses (in category 'obsolete subclasses') -----
- obsoleteSubclasses
- 	"Return all the weakly remembered obsolete subclasses of the receiver"
- 	| obs |
- 	obs := ObsoleteSubclasses at: self ifAbsent: [^ #()].
- 	^ obs copyWithout: nil!

Item was removed:
- ----- Method: Behavior>>parserClass (in category 'compiling') -----
- parserClass
- 	"Answer a parser class to use for parsing method headers."
- 
- 	^self compilerClass parserClass!

Item was removed:
- ----- Method: Behavior>>postCopy (in category 'copying') -----
- postCopy
- 	super postCopy.
- 	self methodDict: self methodDict copy!

Item was removed:
- ----- Method: Behavior>>precodeCommentOrInheritedCommentFor: (in category 'accessing method dictionary') -----
- precodeCommentOrInheritedCommentFor: selector 
- 	"Answer a string representing the first comment in the method associated 
- 	with selector, considering however only comments that occur before the 
- 	beginning of the actual code. If the version recorded in the receiver is 
- 	uncommented, look up the inheritance chain. Return nil if none found."
- 	| aSuper aComment |
- 	^ (aComment := self firstPrecodeCommentFor: selector) isEmptyOrNil
- 		ifTrue: [(self == Behavior
- 					or: [superclass == nil
- 							or: [(aSuper := superclass whichClassIncludesSelector: selector) == nil]])
- 				ifFalse: [aSuper precodeCommentOrInheritedCommentFor: selector]
- 			"ActorState precodeCommentOrInheritedCommentFor: #printOn:"]
- 		ifFalse: [aComment]!

Item was removed:
- ----- Method: Behavior>>prettyPrinterClass (in category 'printing') -----
- prettyPrinterClass
- 	^self compilerClass!

Item was removed:
- ----- Method: Behavior>>printHierarchy (in category 'printing') -----
- printHierarchy
- 	"Answer a description containing the names and instance variable names 
- 	of all of the subclasses and superclasses of the receiver."
- 
- 	| aStream index |
- 	index := 0.
- 	aStream := WriteStream on: (String new: 16).
- 	self allSuperclasses reverseDo: 
- 		[:aClass | 
- 		aStream crtab: index.
- 		index := index + 1.
- 		aStream nextPutAll: aClass name.
- 		aStream space.
- 		aStream print: aClass instVarNames].
- 	aStream cr.
- 	self printSubclassesOn: aStream level: index.
- 	^aStream contents!

Item was removed:
- ----- Method: Behavior>>printOn: (in category 'printing') -----
- printOn: aStream 
- 	"Refer to the comment in Object|printOn:." 
- 
- 	aStream nextPutAll: 'a descendent of '.
- 	superclass printOn: aStream!

Item was removed:
- ----- Method: Behavior>>printWithClosureAnalysisOn: (in category 'printing') -----
- printWithClosureAnalysisOn: aStream 
- 	"Refer to the comment in Object|printOn:." 
- 
- 	aStream nextPutAll: 'a descendent of '.
- 	superclass printWithClosureAnalysisOn: aStream!

Item was removed:
- ----- Method: Behavior>>recompile: (in category 'compiling') -----
- recompile: selector
- 	"Compile the method associated with selector in the receiver's method dictionary."
- 	^self recompile: selector from: self!

Item was removed:
- ----- Method: Behavior>>recompile:from: (in category 'compiling') -----
- recompile: selector from: oldClass
- 	"Compile the method associated with selector in the receiver's method dictionary."
- 	"ar 7/10/1999: Use oldClass compiledMethodAt: not self compiledMethodAt:"
- 	| method trailer methodNode |
- 	method := oldClass compiledMethodAt: selector.
- 	trailer := method trailer.
- 	methodNode := self newCompiler
- 				compile: (oldClass sourceCodeAt: selector)
- 				in: self
- 				notifying: nil
- 				ifFail: [^ self].   "Assume OK after proceed from SyntaxError"
- 	selector == methodNode selector ifFalse: [self error: 'selector changed!!'].
- 	self basicAddSelector: selector withMethod: (methodNode generate: trailer).
- !

Item was removed:
- ----- Method: Behavior>>recompileChanges (in category 'compiling') -----
- recompileChanges
- 	"Compile all the methods that are in the changes file.
- 	This validates sourceCode and variable references and forces
- 	methods to use the current bytecode set"
- 
- 	self selectorsAndMethodsDo:
- 		[:sel :m | m fileIndex > 1 ifTrue:
- 			[self recompile: sel from: self]]!

Item was removed:
- ----- Method: Behavior>>recompileNonResidentMethod:atSelector:from: (in category 'compiling') -----
- recompileNonResidentMethod: method atSelector: selector from: oldClass
- 	"Recompile the method supplied in the context of this class."
- 
- 	| trailer methodNode |
- 	trailer := method trailer.
- 	methodNode := self newCompiler
- 			compile: (method getSourceFor: selector in: oldClass)
- 			in: self
- 			notifying: nil
- 			ifFail: ["We're in deep doo-doo if this fails (syntax error).
- 				Presumably the user will correct something and proceed,
- 				thus installing the result in this methodDict.  We must
- 				retrieve that new method, and restore the original (or remove)
- 				and then return the method we retrieved."
- 				^ self error: 'see comment'].
- 	selector == methodNode selector ifFalse: [self error: 'selector changed!!'].
- 	^ methodNode generate: trailer
- !

Item was removed:
- ----- Method: Behavior>>removeAllObsoleteSubclasses (in category 'obsolete subclasses') -----
- removeAllObsoleteSubclasses
- 	"Remove all the obsolete subclasses of the receiver"
- 	ObsoleteSubclasses removeKey: self ifAbsent: [].
- !

Item was removed:
- ----- Method: Behavior>>removeObsoleteSubclass: (in category 'obsolete subclasses') -----
- removeObsoleteSubclass: aClass
- 	"Remove aClass from the weakly remembered obsolete subclasses"
- 	| obs |
- 	obs := ObsoleteSubclasses at: self ifAbsent:[^ self].
- 	(obs includes: aClass) ifFalse:[^self].
- 	obs := obs copyWithout: aClass.
- 	obs := obs copyWithout: nil.
- 	ObsoleteSubclasses at: self put: obs!

Item was removed:
- ----- Method: Behavior>>removeSelector: (in category 'adding/removing methods') -----
- removeSelector: aSelector 
- 	"Assuming that the argument, selector (a Symbol), is a message selector 
- 	in my method dictionary, remove it and its method."
- 	^self basicRemoveSelector: aSelector
- !

Item was removed:
- ----- Method: Behavior>>removeSelectorSilently: (in category 'adding/removing methods') -----
- removeSelectorSilently: selector 
- 	"Remove selector without sending system change notifications"
- 
- 	^ SystemChangeNotifier uniqueInstance doSilently: [self removeSelector: selector].!

Item was removed:
- ----- Method: Behavior>>rootStubInImageSegment: (in category 'accessing method dictionary') -----
- rootStubInImageSegment: imageSegment 
- 
- 	^ ImageSegmentRootStub new
- 		xxSuperclass: superclass
- 		format: format
- 		segment: imageSegment!

Item was removed:
- ----- Method: Behavior>>selectSubclasses: (in category 'enumerating') -----
- selectSubclasses: aBlock 
- 	"Evaluate the argument, aBlock, with each of the receiver's (next level) 
- 	subclasses as its argument. Collect into a Set only those subclasses for 
- 	which aBlock evaluates to true. In addition, evaluate aBlock for the 
- 	subclasses of each of these successful subclasses and collect into the set 
- 	those for which aBlock evaluates true. Answer the resulting set."
- 
- 	| aSet |
- 	aSet := Set new.
- 	self allSubclasses do: 
- 		[:aSubclass | 
- 		(aBlock value: aSubclass) ifTrue: [aSet add: aSubclass]].
- 	^aSet!

Item was removed:
- ----- Method: Behavior>>selectSuperclasses: (in category 'enumerating') -----
- selectSuperclasses: aBlock 
- 	"Evaluate the argument, aBlock, with the receiver's superclasses as the 
- 	argument. Collect into an OrderedCollection only those superclasses for 
- 	which aBlock evaluates to true. In addition, evaluate aBlock for the 
- 	superclasses of each of these successful superclasses and collect into the 
- 	OrderedCollection ones for which aBlock evaluates to true. Answer the 
- 	resulting OrderedCollection."
- 
- 	| aSet |
- 	aSet := Set new.
- 	self allSuperclasses do: 
- 		[:aSuperclass | 
- 		(aBlock value: aSuperclass) ifTrue: [aSet add: aSuperclass]].
- 	^aSet!

Item was removed:
- ----- Method: Behavior>>selectors (in category 'accessing method dictionary') -----
- selectors
- 	"Answer a collection of all the message selectors specified in the receiver's 
- 	method dictionary."
- 
- 	^ self methodDict keys!

Item was removed:
- ----- Method: Behavior>>selectorsAndMethodsDo: (in category 'accessing method dictionary') -----
- selectorsAndMethodsDo: selectorAndMethodBlock
- 	"Evaluate the two argument selectorAndMethodBlock for all the selector/method pairs in my method dictionary."
- 
- 	^ self methodDict keysAndValuesDo: selectorAndMethodBlock!

Item was removed:
- ----- Method: Behavior>>selectorsDo: (in category 'accessing method dictionary') -----
- selectorsDo: selectorBlock
- 	"Evaluate selectorBlock for all the message selectors in my method dictionary."
- 
- 	^ self methodDict keysDo: selectorBlock!

Item was removed:
- ----- Method: Behavior>>selectorsWithArgs: (in category 'accessing method dictionary') -----
- selectorsWithArgs: numberOfArgs
- 	"Return all selectors defined in this class that take this number of arguments"
- 
- 	^ self selectors select: [:selector | selector numArgs = numberOfArgs]!

Item was removed:
- ----- Method: Behavior>>setFormat: (in category 'private') -----
- setFormat: aFormatInstanceDescription
- 	"only use this method with extreme care since it modifies the format of the class 
-      ie a description of the number of instance variables and whether the class is
-      compact, variable sized"
- 
- 	format := aFormatInstanceDescription
- 
- !

Item was removed:
- ----- Method: Behavior>>sharedPools (in category 'accessing instances and variables') -----
- sharedPools
- 	"Answer a Set of the names of the pools (Dictionaries) that the receiver 
- 	shares.
- 	9/12/96 tk  sharedPools have an order now"
- 
- 	^ OrderedCollection new!

Item was removed:
- ----- Method: Behavior>>shouldNotBeRedefined (in category 'testing') -----
- shouldNotBeRedefined
- 	"Answer if the receiver should not be redefined.
- 	 The assumption is that classes in Smalltalk specialObjects and 
- 	 instance-specific Behaviors should not be redefined"
- 
- 	^(Smalltalk specialObjectsArray
- 		identityIndexOf: self
- 		ifAbsent: [(self isKindOf: self) ifTrue: [1] ifFalse: [0]]) ~= 0!

Item was removed:
- ----- Method: Behavior>>shutDown (in category 'system startup') -----
- shutDown
- 	"This message is sent on system shutdown to registered classes"
- !

Item was removed:
- ----- Method: Behavior>>shutDown: (in category 'system startup') -----
- shutDown: quitting
- 	"This message is sent on system shutdown to registered classes"
- 	^self shutDown.!

Item was removed:
- ----- Method: Behavior>>someInstance (in category 'accessing instances and variables') -----
- someInstance
- 	"Primitive. Answer the first instance in the enumeration of all instances 
- 	of the receiver. Fails if there are none. Essential. See Object 
- 	documentation whatIsAPrimitive."
- 
- 	<primitive: 77>
- 	^nil!

Item was removed:
- ----- Method: Behavior>>sourceCodeAt: (in category 'accessing method dictionary') -----
- sourceCodeAt: selector
- 
- 	^ (self methodDict at: selector) getSourceFor: selector in: self!

Item was removed:
- ----- Method: Behavior>>sourceCodeAt:ifAbsent: (in category 'accessing method dictionary') -----
- sourceCodeAt: selector ifAbsent: aBlock
- 
- 	^ (self methodDict at: selector ifAbsent: [^ aBlock value]) getSourceFor: selector in: self!

Item was removed:
- ----- Method: Behavior>>sourceCodeTemplate (in category 'compiling') -----
- sourceCodeTemplate
- 	"Answer an expression to be edited and evaluated in order to define 
- 	methods in this class or trait."
- 
- 	^'message selector and argument names
- 	"comment stating purpose of message"
- 
- 	| temporary variable names |
- 	statements'!

Item was removed:
- ----- Method: Behavior>>sourceMatchesBytecodeAt: (in category 'testing') -----
- sourceMatchesBytecodeAt: selector
- 	"Answers true if the source code at the selector compiles to the bytecode at the selector, and false otherwise. Implemented to detect an error where Monticello did not recompile sources when the class shape changed"
- 	"This code was copied from #recompile:from:, with few changes. Several methods would benefit from a method which turned a selector and class into a CompiledMethod, without  installing it into the methodDictionary"
- 
- 	| method trailer methodNode |
- 	method := self compiledMethodAt: selector.
- 	trailer := method trailer.
- 	methodNode := self newCompiler
- 				compile: (self sourceCodeAt: selector)
- 				in: self
- 				notifying: nil
- 				ifFail: [^ false].   "Assume OK after proceed from SyntaxError"
- 	selector == methodNode selector ifFalse: [self error: 'selector changed!!'].
- 	^ (methodNode generate: trailer) = method!

Item was removed:
- ----- Method: Behavior>>sourceMethodAt: (in category 'accessing method dictionary') -----
- sourceMethodAt: selector 
- 	"Answer the paragraph corresponding to the source code for the 
- 	argument."
- 
- 	^(self sourceCodeAt: selector) asText makeSelectorBoldIn: self!

Item was removed:
- ----- Method: Behavior>>sourceMethodAt:ifAbsent: (in category 'accessing method dictionary') -----
- sourceMethodAt: selector ifAbsent: aBlock
- 	"Answer the paragraph corresponding to the source code for the 
- 	argument."
- 
- 	^ (self sourceCodeAt: selector ifAbsent: [^ aBlock value]) asText makeSelectorBoldIn: self!

Item was removed:
- ----- Method: Behavior>>spaceUsed (in category 'private') -----
- 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 methodsDo: [:method |
- 		space := space + 16.  "dict and org'n space"
- 		space := space + (method size + 6 "hdr + avg pad").
- 		method literalsDo: [: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!

Item was removed:
- ----- Method: Behavior>>standardMethodHeaderFor: (in category 'accessing method dictionary') -----
- standardMethodHeaderFor: aSelector
- 	| args |
- 	args := (1 to: aSelector numArgs)	collect:[:i| 'arg', i printString].
- 	args size = 0 ifTrue:[^aSelector asString].
- 	args size = 1 ifTrue:[^aSelector,' arg1'].
- 	^String streamContents:[:s|
- 		(aSelector findTokens:':') with: args do:[:tok :arg|
- 			s nextPutAll: tok; nextPutAll:': '; nextPutAll: arg; nextPutAll:' '.
- 		].
- 	].
- !

Item was removed:
- ----- Method: Behavior>>startUp (in category 'system startup') -----
- startUp
- 	"This message is sent to registered classes when the system is coming up."
- !

Item was removed:
- ----- Method: Behavior>>startUp: (in category 'system startup') -----
- startUp: resuming
- 	"This message is sent to registered classes when the system is coming up.
- 	 resuming will be true if a snapshot is being resumed.  resuming will be false
- 	 if the system is merely reinitializing after writing a snapshot."
- 	^self startUp!

Item was removed:
- ----- Method: Behavior>>startUpFrom: (in category 'system startup') -----
- startUpFrom: endiannessHasToBeFixed
- 	"Override this when a per-instance startUp message needs to be sent.  For example, to correct the order of 16-bit non-pointer data when it came from a different endian machine."
- 
- 	^ nil!

Item was removed:
- ----- Method: Behavior>>storeLiteral:on: (in category 'printing') -----
- storeLiteral: aCodeLiteral on: aStream
- 	"Store aCodeLiteral on aStream, changing an Association to ##GlobalName
- 	 or ###MetaclassSoleInstanceName format if appropriate"
- 	| key value |
- 	(aCodeLiteral isVariableBinding)
- 		ifFalse:
- 			[aCodeLiteral storeOn: aStream.
- 			 ^self].
- 	key := aCodeLiteral key.
- 	(key isNil and: [(value := aCodeLiteral value) isMemberOf: Metaclass])
- 		ifTrue:
- 			[aStream nextPutAll: '###'; nextPutAll: value soleInstance name.
- 			 ^self].
- 	(key isSymbol and: [(self bindingOf: key) notNil])
- 		ifTrue:
- 			[aStream nextPutAll: '##'; nextPutAll: key.
- 			 ^self].
- 	aCodeLiteral storeOn: aStream!

Item was removed:
- ----- Method: Behavior>>subclassDefinerClass (in category 'accessing') -----
- subclassDefinerClass
- 	"Answer an evaluator class appropriate for evaluating definitions of new 
- 	subclasses of this class."
- 
- 	^Compiler!

Item was removed:
- ----- Method: Behavior>>subclassInstVarNames (in category 'accessing instances and variables') -----
- subclassInstVarNames
- 	"Answer a Set of the names of the receiver's subclasses' instance 
- 	variables."
- 	| vars |
- 	vars := Set new.
- 	self allSubclasses do: [:aSubclass | vars addAll: aSubclass instVarNames].
- 	^vars!

Item was removed:
- ----- Method: Behavior>>subclasses (in category 'accessing class hierarchy') -----
- subclasses
- 	"slow implementation since Behavior does not keep trace of subclasses"
- 	
- 	^ self class allInstances  select: [:each | each superclass = self ]!

Item was removed:
- ----- Method: Behavior>>superclass (in category 'accessing class hierarchy') -----
- superclass
- 	"Answer the receiver's superclass, a Class."
- 
- 	^superclass!

Item was removed:
- ----- Method: Behavior>>superclass: (in category 'accessing class hierarchy') -----
- superclass: aClass 
- 	"Change the receiver's superclass to be aClass."
- 	"Note: Do not use 'aClass isKindOf: Behavior' here
- 		in case we recompile from Behavior itself."
- 	(aClass == nil or: [aClass isBehavior])
- 		ifTrue: [superclass := aClass.
- 				Object flushCache]
- 		ifFalse: [self error: 'superclass must be a class-describing object']!

Item was removed:
- ----- Method: Behavior>>superclass:methodDictionary:format: (in category 'initialize-release') -----
- superclass: aClass methodDictionary: mDict format: fmt
- 	"Basic initialization of the receiver.
- 	Must only be sent to a new instance; else we would need Object flushCache."
- 	superclass := aClass.
- 	format := fmt.
- 	methodDict := mDict.!

Item was removed:
- ----- Method: Behavior>>supermostPrecodeCommentFor: (in category 'accessing method dictionary') -----
- supermostPrecodeCommentFor: selector 
- 	"Answer a string representing the precode comment in the most distant 
- 	superclass's implementation of the selector. Return nil if none found."
- 	| aSuper superComment |
- 	(self == Behavior
- 			or: [superclass == nil
- 					or: [(aSuper := superclass whichClassIncludesSelector: selector) == nil]])
- 		ifFalse: ["There is a super implementor"
- 			superComment := aSuper supermostPrecodeCommentFor: selector].
- 	^ superComment
- 		ifNil: [self firstPrecodeCommentFor: selector
- 			"ActorState supermostPrecodeCommentFor: #printOn:"]!

Item was removed:
- ----- Method: Behavior>>traitComposition (in category 'Backstop-Traits') -----
- traitComposition
- 	"Backstop. When traits are unloaded we never have a trait composition"
- 	^#()!

Item was removed:
- ----- Method: Behavior>>traitCompositionString (in category 'Backstop-Traits') -----
- traitCompositionString
- 	"Backstop. Monticello needs a traitCompositionString even with traits unloaded"
- 	^'{}'!

Item was removed:
- ----- Method: Behavior>>typeOfClass (in category 'accessing') -----
- typeOfClass
- 	"Answer a symbol uniquely describing the type of the receiver. c.f. kindOfSubclass, instSpec"
- 	^(#(normal
- 		normal
- 		variable
- 		variable
- 		weak
- 		ephemeron
- 		nil
- 		immediate
- 		nil
- 		longs
- 		words				nil
- 		shorts				nil nil nil
- 		bytes				nil nil nil nil nil nil nil
- 		compiledMethod	nil nil nil nil nil nil nil)
- 			at: self instSpec + 1) ifNil:
- 				[self error: 'invalid class type']!

Item was removed:
- ----- Method: Behavior>>ultimateSourceCodeAt:ifAbsent: (in category 'accessing method dictionary') -----
- ultimateSourceCodeAt: selector ifAbsent: aBlock
- 	"Return the source code at selector, deferring to superclass if necessary"
- 	^ self sourceCodeAt: selector ifAbsent:
- 		[superclass
- 			ifNil:
- 				[aBlock value]
- 			 ifNotNil:
- 				[superclass ultimateSourceCodeAt: selector ifAbsent: aBlock]]!

Item was removed:
- ----- Method: Behavior>>unreferencedInstanceVariables (in category 'user interface') -----
- unreferencedInstanceVariables
- 	"Return a list of the instance variables defined in the receiver which are not referenced in the receiver or any of its subclasses."
- 
- 	^ self instVarNames select:
- 		[:ivn |
- 		self withAllSubclasses allSatisfy:
- 			[:class |  (class whichSelectorsAccess: ivn) isEmpty]]!

Item was removed:
- ----- Method: Behavior>>variablesAndOffsetsDo: (in category 'compiling') -----
- variablesAndOffsetsDo: aBinaryBlock
- 	"This is the interface between the compiler and a class's instance or field names.  The
- 	 class should enumerate aBinaryBlock with the field definitions (with nil offsets) followed
- 	 by the instance variable name strings and their integer offsets (1-relative).  The order is
- 	 important; names evaluated later will override the same names occurring earlier."
- 
- 	"Only need to do instance variables here.  CProtoObject introduces field definitions."
- 	self instVarNamesAndOffsetsDo: aBinaryBlock!

Item was removed:
- ----- Method: Behavior>>veryDeepCopyWith: (in category 'copying') -----
- veryDeepCopyWith: deepCopier
- 	"Return self.  Must be created, not copied.  Do not record me."!

Item was removed:
- ----- Method: Behavior>>whichClassDefinesClassVar: (in category 'queries') -----
- whichClassDefinesClassVar: aString 
- 
- 	^(Symbol lookup: aString) ifNotNil: [ :aSymbol |
- 		^self whichSuperclassSatisfies: 
- 			[:aClass | 
- 			aClass classVarNames anySatisfy: [:each | each = aSymbol]]]!

Item was removed:
- ----- Method: Behavior>>whichClassDefinesInstVar: (in category 'queries') -----
- whichClassDefinesInstVar: aString 
- 	^self 
- 		whichSuperclassSatisfies: [:aClass | aClass instVarNames includes: aString]!

Item was removed:
- ----- Method: Behavior>>whichClassIncludesSelector: (in category 'testing method dictionary') -----
- whichClassIncludesSelector: aSymbol 
- 	"Answer the class on the receiver's superclass chain where the 
- 	argument, aSymbol (a message selector), will be found. Answer nil if none found."
- 	"Rectangle whichClassIncludesSelector: #inspect."
- 	(self includesSelector: aSymbol)
- 		ifTrue: [^ self].
- 	superclass == nil
- 		ifTrue: [^ nil].
- 	^ superclass whichClassIncludesSelector: aSymbol!

Item was removed:
- ----- Method: Behavior>>whichMethodsStoreInto: (in category 'testing method dictionary') -----
- whichMethodsStoreInto: instVarName 
- 	"Answer a collection of CompiledMethod whose methods access the argument, instVarName, as a named instance variable."
- 	
- 	| instVarIndex |
- 	instVarIndex := self instVarIndexFor: instVarName ifAbsent: [ ^Array new ].
- 	^self methodDict values select: [:eachMethod | eachMethod writesField: instVarIndex ]
- 	
- 	"Point whichMethodsStoreInto: 'x'."!

Item was removed:
- ----- Method: Behavior>>whichSelectorsAccess: (in category 'testing method dictionary') -----
- whichSelectorsAccess: instVarName 
- 	"Answer a collection of selectors whose methods access the argument, instVarName, as a named instance variable."
- 	"Point whichSelectorsAccess: 'x'."
- 	
- 	| instVarIndex |
- 	instVarIndex := self instVarIndexFor: instVarName ifAbsent: [ ^Array new ].
- 	^Array streamContents: [ :stream |
- 		self selectorsAndMethodsDo: [ :selector :method |
- 			((method readsField: instVarIndex) or: [
- 				method writesField: instVarIndex ]) ifTrue: [
- 					stream nextPut: selector ] ] ]
- !

Item was removed:
- ----- Method: Behavior>>whichSelectorsRead: (in category 'queries') -----
- whichSelectorsRead: instVarName 
- 	"Answer a Set of selectors whose methods access the argument, 
- 	instVarName, as a named instance variable."
- 	^self whichSelectorsAccess: instVarName!

Item was removed:
- ----- Method: Behavior>>whichSelectorsReferTo: (in category 'testing method dictionary') -----
- whichSelectorsReferTo: literal 
- 	"Answer a Set of selectors whose methods access the argument as a literal. Note that we cannot use #systemNavigation because this method should not depend on the 'System' package."
- 
- 	| who canBeSpecial |
- 	canBeSpecial := BytecodeEncoder canBeSpecialLiteral: literal.
- 	who := IdentitySet new.
- 	self selectorsAndMethodsDo: [:selector :method |
- 		(method hasLiteral: literal scanForSpecial: canBeSpecial)
- 			ifTrue: [who add: selector]].
- 	^ who
- 
- 	"Rectangle whichSelectorsReferTo: #+."!

Item was removed:
- ----- Method: Behavior>>whichSelectorsStoreInto: (in category 'testing method dictionary') -----
- whichSelectorsStoreInto: instVarName 
- 	"Answer a collection of selectors whose methods access the argument, instVarName, as a named instance variable."
- 	
- 	| instVarIndex |
- 	instVarIndex := self instVarIndexFor: instVarName ifAbsent: [ ^Array new ].
- 	^ self methodDict keys select: 
- 		[:sel | (self methodDict at: sel) writesField: instVarIndex]
- 
- 	"Point whichSelectorsStoreInto: 'x'."!

Item was removed:
- ----- Method: Behavior>>whichSuperclassSatisfies: (in category 'queries') -----
- whichSuperclassSatisfies: aBlock 
- 	(aBlock value: self) ifTrue: [^self].
- 	^superclass isNil 
- 		ifTrue: [nil]
- 		ifFalse: [superclass whichSuperclassSatisfies: aBlock]!

Item was removed:
- ----- Method: Behavior>>withAllSubAndSuperclassesDo: (in category 'user interface') -----
- withAllSubAndSuperclassesDo: aBlock
- 
- 	self withAllSubclassesDo: aBlock.
- 	self allSuperclassesDo: aBlock.
- !

Item was removed:
- ----- Method: Behavior>>withAllSubclasses (in category 'accessing class hierarchy') -----
- withAllSubclasses
- 	"Answer a Collection of the receiver, the receiver's descendent's, and the  
- 	receiver's descendent's subclasses."
- 
- 	^ self allSubclasses addFirst: self;
- 		 yourself!

Item was removed:
- ----- Method: Behavior>>withAllSubclassesDo: (in category 'enumerating') -----
- withAllSubclassesDo: aBlock 
- 	"Evaluate the argument, aBlock, for the receiver and each of its 
- 	subclasses."
- 
- 	aBlock value: self.
- 	self allSubclassesDo: aBlock!

Item was removed:
- ----- Method: Behavior>>withAllSuperAndSubclassesDo: (in category 'enumerating') -----
- withAllSuperAndSubclassesDo: aBlock
- 	self allSuperclassesDo: aBlock.
- 	aBlock value: self.
- 	self allSubclassesDo: aBlock!

Item was removed:
- ----- Method: Behavior>>withAllSuperAndSubclassesDoGently: (in category 'enumerating') -----
- withAllSuperAndSubclassesDoGently: aBlock
- 	self allSuperclassesDo: aBlock.
- 	aBlock value: self.
- 	self allSubclassesDoGently: aBlock!

Item was removed:
- ----- Method: Behavior>>withAllSuperclasses (in category 'accessing class hierarchy') -----
- withAllSuperclasses
- 	"Answer an OrderedCollection of the receiver and the receiver's 
- 	superclasses. The first element is the receiver, 
- 	followed by its superclass; the last element is Object."
- 
- 	| temp |
- 	temp := self allSuperclasses.
- 	temp addFirst: self.
- 	^ temp!

Item was removed:
- ----- Method: Behavior>>withAllSuperclassesDo: (in category 'enumerating') -----
- withAllSuperclassesDo: aBlock 
- 	"Evaluate the argument, aBlock, for each of the receiver's superclasses."
- 	aBlock value: self.
- 	superclass == nil
- 		ifFalse: [superclass withAllSuperclassesDo: aBlock]!

Item was removed:
- ----- Method: Behavior>>zapAllMethods (in category 'accessing method dictionary') -----
- zapAllMethods
- 	"Remove all methods in this class which is assumed to be obsolete"
- 
- 	methodDict := self emptyMethodDictionary.
- 	self class isMeta ifTrue: [self class zapAllMethods]!

Item was removed:
- ModificationForbidden subclass: #BinaryModificationForbidden
- 	instanceVariableNames: ''
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'Kernel-Exceptions'!
- 
- !BinaryModificationForbidden commentStamp: 'eem 3/11/2020 15:56' prior: 0!
- A BinaryModificationForbidden is a variation of ModificationForbidden for messages that need neither fieldIndex nor newObject, such as elementsExchangeIdentityWith: and adoptInstance:. It overrides the retryModification method.
- 
- Instance Variables
- !

Item was removed:
- ----- Method: BinaryModificationForbidden>>retryModification (in category 'retrying') -----
- retryModification
- 	mirror perform: retrySelector with: object.
- 	self resume: resumptionValue!

Item was removed:
- ----- Method: BinaryModificationForbidden>>retryModificationNoResume (in category 'retrying') -----
- retryModificationNoResume
- 	mirror perform: retrySelector with: object!

Item was removed:
- Error subclass: #BlockCannotReturn
- 	instanceVariableNames: 'result deadHome'
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'Kernel-Exceptions'!
- 
- !BlockCannotReturn commentStamp: '<historical>' prior: 0!
- This class is private to the EHS implementation.  Its use allows for ensured execution to survive code such as:
- 
- [self doThis.
- ^nil]
- 	ensure: [self doThat]
- 
- Signaling or handling this exception is not recommended.!

Item was removed:
- ----- Method: BlockCannotReturn>>deadHome (in category 'accessing') -----
- deadHome
- 
- 	^ deadHome!

Item was removed:
- ----- Method: BlockCannotReturn>>deadHome: (in category 'accessing') -----
- deadHome: context
- 
- 	deadHome := context!

Item was removed:
- ----- Method: BlockCannotReturn>>defaultAction (in category 'exceptionDescription') -----
- defaultAction
- 
- 	self messageText: 'Block cannot return'.
- 	^super defaultAction!

Item was removed:
- ----- Method: BlockCannotReturn>>isResumable (in category 'exceptionDescription') -----
- isResumable
- 
- 	^true!

Item was removed:
- ----- Method: BlockCannotReturn>>result (in category 'accessing') -----
- result
- 
- 	^result!

Item was removed:
- ----- Method: BlockCannotReturn>>result: (in category 'accessing') -----
- result: r
- 
- 	result := r!

Item was removed:
- Object variableSubclass: #BlockClosure
- 	instanceVariableNames: 'outerContext startpcOrMethod numArgs'
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'Kernel-Methods'!
- 
- !BlockClosure commentStamp: 'eem 5/1/2020 10:04' prior: 0!
- Instances of BlockClosure represent blocks, a sequence of statements inside square brackets that can be evaluated at any time via one of the value messages (value, value:, value:value:, ... valueWithArguments:), which answer their last statement.  Blocks therefore allow deferred evaluation and so are used to build control structures where a sequence of statements are evaluated or not depending on other values in the program.
- 
- Blocks can close over variables in their enclosing method or block.  The method in which a block is nested is called its home method.  Blocks can return from their home method via an up-arrow return, and return to the sender of the message that created the home method, just like a return from the method itself.  BlockClosures are fully first-class objects; they can outlive their enclosing method activation and be answered as results and/or assigned to variables.
- 
- BlockClosures are central to the implementation of control structures in Smalltalk.  The arguments to the conditional message ifTrue:ifFalse: are zero-argument blocks; the receiver of ifTrue:ifFalse: is a boolean which responds by evaluating ether the first argument or the second.  The bytecode compiler inlines blocks for certain selectors, compiling to conditional branch and branch bytecodes.  This is done for efficiency.  The full list of inlined messages can be found in MessageNode's MacroSelectors class variable (at time of writing ther=se are ifTrue:, ifFalse:, ifTrue:ifFalse:, ifFalse:ifTrue:, and:, or:, whileFalse:, whileTrue:, whileFalse, whileTrue, to:do:, to:by:do:, caseOf:, caseOf:otherwise:, ifNil:, ifNotNil:, ifNil:ifNotNil:, ifNotNil:ifNil: and repeat.
- 
- Examples (more can be found in BlockClosureTest's class comment):
- 	[1 at 2] value
- 
- 	| counter |
- 	counter := 0.
- 	{ counter. (1 to: 10) collect: [:n| counter := counter + 1. n + counter]. counter }
- 
- 	| fibonacciBlock |
- 	fibonacciBlock := [:n|
- 					n > 1 ifTrue: [(fibonacciBlock value: n - 1) + (fibonacciBlock value: n - 2)] ifFalse: [1]].
- 	(1 to: 10) collect: fibonacciBlock
- 
- 	| randomNumbers |
- 	randomNumbers := Random new next: 20.
- 	{ randomNumbers. randomNumbers sorted: [:a :b| a > b] }
- 
- Implementation:
- BlockClosure implements blocks that are nested within an enclosing method or block context.  Further, the bytecodes for the block are embedded within the home method.  BlockClosure's subclass FullBlockClosure has an independent CompiledBlock as its method, and may or may not have an outerContext.
- 
- Instance Variables
- 	numArgs:			<Integer>
- 	outerContext:		<Context>
- 	startpcOrMethod:	<Integer|CompiledBlock>
- 
- numArgs
- 	- the number of arguments the block expects
- 
- outerContext
- 	- the Context of the method or block activation in which the receiver is created
- 
- startpcOrMethod
- 	- in BlockClosure this is the pc of the first bytecode of the block.  Its bytecodes are embedded in the bytecodes of the home method.  In FullBlockClosure this is the block's method.!

Item was removed:
- ----- Method: BlockClosure class>>outerContext:startpc:numArgs:copiedValues: (in category 'instance creation') -----
- outerContext: aContext startpc: aStartpc numArgs: argCount copiedValues: anArrayOrNil
- 	^(self new: anArrayOrNil basicSize)
- 		outerContext: aContext
- 		startpc: aStartpc
- 		numArgs: argCount
- 		copiedValues: anArrayOrNil!

Item was removed:
- ----- Method: BlockClosure>>= (in category 'comparing') -----
- = aClosure
- 	self == aClosure ifTrue: [^true].
- 	aClosure class = self class ifFalse: [^false].
- 	(self method == aClosure method and: [self startpc = aClosure startpc and: [self isClean]])
- 		ifTrue: [^true].
- 	^outerContext = aClosure outerContext and: [self startpc = aClosure startpc]!

Item was removed:
- ----- Method: BlockClosure>>abstractBytecodeMessagesDo: (in category 'scanning') -----
- abstractBytecodeMessagesDo: aBlock
- 	"Evaluate aBlock with the sequence of abstract bytecodes in the receiver."
- 	self method
- 		abstractBytecodeMessagesFrom: startpcOrMethod
- 		to: self endPC
- 		do: aBlock
- 
- 	"| msgs |
- 	 msgs := OrderedCollection new.
- 	 (SortedCollection sortBlock: [:a :b| a compare: b caseSensitive: false]) sortBlock
- 		abstractBytecodeMessagesDo: [:msg| msgs add: msg selector].
- 	 msgs"!

Item was removed:
- ----- Method: BlockClosure>>argumentCount (in category 'accessing') -----
- argumentCount
- 	"Answers the number of arguments needed to evaluate the receiver.
- 	For ansi compatibility."
- 	^ self numArgs!

Item was removed:
- ----- Method: BlockClosure>>asContext (in category 'scheduling') -----
- asContext
- 	"Create a Context that is ready to execute self.  Assumes self takes no args (if it does the args will be nil)"
- 
- 	^self asContextWithSender: nil!

Item was removed:
- ----- Method: BlockClosure>>asContextWithSender: (in category 'private') -----
- asContextWithSender: aContext
- 	"Inner private support method for evaluation.  Do not use unless you know what you're doing."
- 
- 	^(Context newForMethod: outerContext method)
- 		setSender: aContext
- 		receiver: outerContext receiver
- 		method: outerContext method
- 		closure: self
- 		startpc: startpcOrMethod;
- 		privRefresh!

Item was removed:
- ----- Method: BlockClosure>>asMinimalRepresentation (in category 'events-support') -----
- asMinimalRepresentation
- 	"For use in the when:evaluate: protocol, i.e.,
- 		foo when: #bar evaluate:[self handleBar].
- 	Return the receiver."
- 	^self!

Item was removed:
- ----- Method: BlockClosure>>assert (in category 'exceptions') -----
- assert
- 	self assert: self!

Item was removed:
- ----- Method: BlockClosure>>blockCreationBytecodeMessage (in category 'scanning') -----
- blockCreationBytecodeMessage
- 	"Answer the abstract bytecode message that created the receiver."
- 	^self method abstractBytecodeMessageAt: self blockCreationPC
- 
- 	"(SortedCollection sortBlock: [:a :b| a compare: b caseSensitive: false]) sortBlock blockCreationBytecodeMessage"!

Item was removed:
- ----- Method: BlockClosure>>blockCreationPC (in category 'scanning') -----
- blockCreationPC
- 	"Answer the pc for the bytecode that created the receiver."
- 	| method |
- 	method := self method.
- 	^method encoderClass
- 		pcOfBlockCreationBytecodeForBlockStartingAt: startpcOrMethod
- 		in: method!

Item was removed:
- ----- Method: BlockClosure>>copiedValueAt: (in category 'accessing') -----
- copiedValueAt: i
- 	<primitive: 60>
- 	^self basicAt: i!

Item was removed:
- ----- Method: BlockClosure>>copyForSaving (in category 'private') -----
- copyForSaving
- 	"Answer a copy of the receiver suitable for serialization.
- 	 Notionally, if the receiver's outerContext has been returned from then nothing
- 	 needs to be done and we can use the receiver. But there's a race condition
- 	 determining if the receiver has been returned from (it could be executing in a
- 	 different process). So answer a copy anyway."
- 	^self shallowCopy postCopy!

Item was removed:
- ----- Method: BlockClosure>>cull: (in category 'evaluating') -----
- cull: firstArg
- 	"Activate the receiver, with one or zero arguments."
- 	<primitive: 202> "Handle the one argument case primitively"
- 	numArgs >= 1 ifTrue: [ ^self value: firstArg ].
- 	^self value!

Item was removed:
- ----- Method: BlockClosure>>cull:cull: (in category 'evaluating') -----
- cull: firstArg cull: secondArg
- 	"Activate the receiver, with two or less arguments."
- 	<primitive: 203> "Handle the two argument case primitively"
- 	numArgs >= 2 ifTrue: [ ^self value: firstArg value: secondArg ].	
- 	numArgs = 1 ifTrue: [ ^self value: firstArg ].
- 	^self value!

Item was removed:
- ----- Method: BlockClosure>>cull:cull:cull: (in category 'evaluating') -----
- cull: firstArg cull: secondArg cull: thirdArg
- 	"Activate the receiver, with three or less arguments."
- 	<primitive: 204> "Handle the three argument case primitively"
- 	numArgs >= 2 ifTrue: [ 
- 		numArgs >= 3 ifTrue: [ ^self value: firstArg value: secondArg value: thirdArg ].
- 		^self value: firstArg value: secondArg ].
- 	numArgs = 1 ifTrue: [ ^self value: firstArg ].
- 	^self value!

Item was removed:
- ----- Method: BlockClosure>>cull:cull:cull:cull: (in category 'evaluating') -----
- cull: firstArg cull: secondArg cull: thirdArg cull: fourthArg
- 	"Activate the receiver, with four or less arguments."
- 	<primitive: 205> "Handle the four argument case primitively"
- 	numArgs >= 3 ifTrue: [
- 		numArgs >= 4 ifTrue: [
- 			^self value: firstArg value: secondArg value: thirdArg value: fourthArg ].
- 		^self value: firstArg value: secondArg value: thirdArg ].
- 	numArgs = 2 ifTrue: [ ^self value: firstArg value: secondArg ].	
- 	numArgs = 1 ifTrue: [ ^self value: firstArg ].
- 	^self value!

Item was removed:
- ----- Method: BlockClosure>>cull:cull:cull:cull:cull: (in category 'evaluating') -----
- cull: firstArg cull: secondArg cull: thirdArg cull: fourthArg cull: fifthArg
- 	"Activate the receiver, with five or less arguments."
- 	<primitive: 206> "Handle the five argument case primitively"
- 
- 	^ numArgs
- 		caseOf: {
- 			[5] -> [self value: firstArg value: secondArg value: thirdArg value: fourthArg value: fifthArg].
- 			[4] -> [self value: firstArg value: secondArg value: thirdArg value: fourthArg].
- 			[3] -> [self value: firstArg value: secondArg value: thirdArg].
- 			[2] -> [self value: firstArg value: secondArg].
- 			[1] -> [self value: firstArg].
- 			[0] -> [self value] }
- 		otherwise: [self numArgsError: numArgs]!

Item was removed:
- ----- Method: BlockClosure>>decompile (in category 'printing') -----
- decompile
- 	^Decompiler new decompileBlock: self!

Item was removed:
- ----- Method: BlockClosure>>doWhileFalse: (in category 'controlling') -----
- doWhileFalse: conditionBlock
- 	"Evaluate the receiver once, then again as long the value of conditionBlock is false."
-  
- 	| result |
- 	[result := self value.
- 	conditionBlock value] whileFalse.
- 
- 	^ result!

Item was removed:
- ----- Method: BlockClosure>>doWhileTrue: (in category 'controlling') -----
- doWhileTrue: conditionBlock
- 	"Evaluate the receiver once, then again as long the value of conditionBlock is true."
-  
- 	| result |
- 	[result := self value.
- 	conditionBlock value] whileTrue.
- 
- 	^ result!

Item was removed:
- ----- Method: BlockClosure>>endPC (in category 'accessing') -----
- endPC
- 	^self blockCreationBytecodeMessage arguments last + startpcOrMethod - 1!

Item was removed:
- ----- Method: BlockClosure>>ensure: (in category 'exceptions') -----
- ensure: aBlock
- 	"Evaluate a termination block after evaluating the receiver, regardless of
- 	 whether the receiver's evaluation completes.  N.B.  This method is *not*
- 	 implemented as a primitive.  Primitive 198 always fails.  The VM uses prim
- 	 198 in a context's method as the mark for an ensure:/ifCurtailed: activation."
- 
- 	| complete returnValue |
- 	<primitive: 198>
- 	returnValue := self valueNoContextSwitch.
- 	complete ifNil:[
- 		complete := true.
- 		aBlock value.
- 	].
- 	^ returnValue!

Item was removed:
- ----- Method: BlockClosure>>fixTemps (in category 'private') -----
- fixTemps
- 	"Fix the values of the temporary variables used in the block that
- 	 are  ordinarily shared with the method in which the block is defined.
- 	 This is a no-op for closures, provided for backward-compatibility with
- 	 old BlockContexts that needed the fixTemps hack to persist."!

Item was removed:
- ----- Method: BlockClosure>>fork (in category 'scheduling') -----
- fork
- 	"Create and schedule a Process running the code in the receiver."
- 
- 	^ self newProcess resume!

Item was removed:
- ----- Method: BlockClosure>>forkAndWait (in category 'scheduling') -----
- forkAndWait
- 	"Suspend current process and execute self in new process, when it completes resume current process"
- 
- 	| semaphore |
- 	semaphore := Semaphore new.
- 	[self ensure: [semaphore signal]] fork.
- 	semaphore wait.
- !

Item was removed:
- ----- Method: BlockClosure>>forkAt: (in category 'scheduling') -----
- forkAt: priority 
- 	"Create and schedule a Process running the code in the receiver at the given priority. Answer the newly created process."
- 
- 	^ self newProcess
- 		priority: priority;
- 		resume!

Item was removed:
- ----- Method: BlockClosure>>forkAt:named: (in category 'scheduling') -----
- forkAt: priority named: name
- 
- 	"Create and schedule a Process running the code in the receiver at the
- 
- 	given priority and having the given name. Answer the newly created 
- 
- 	process."
- 
- 
- 
- 	| forkedProcess |
- 
- 	forkedProcess := self newProcess.
- 
- 	forkedProcess priority: priority.
- 
- 	forkedProcess name: name.
- 
- 	^ forkedProcess resume!

Item was removed:
- ----- Method: BlockClosure>>forkNamed: (in category 'scheduling') -----
- forkNamed: aString
- 
- 	"Create and schedule a Process running the code in the receiver and
- 
- 	having the given name."
- 
- 
- 
- 	^ self newProcess name: aString; resume!

Item was removed:
- ----- Method: BlockClosure>>fullPrintOn: (in category 'printing') -----
- fullPrintOn: aStream 
- 	aStream
- 		 print: self ;
- 		 cr.
- 	self printSourceOn: aStream!

Item was removed:
- ----- Method: BlockClosure>>hasMethodReturn (in category 'testing') -----
- hasMethodReturn
- 	"Answer whether the receiver has a method-return ('^') in its code."
- 	| scanner endpc |
- 	scanner := InstructionStream new method: outerContext method pc: startpcOrMethod.
- 	endpc := self endPC.
- 	scanner scanFor: [:byte | (byte between: 120 and: 124) or: [scanner pc > endpc]].
- 	^scanner pc <= endpc!

Item was removed:
- ----- Method: BlockClosure>>hash (in category 'comparing') -----
- hash
- 	^(self method hash + startpcOrMethod hash) hashMultiply!

Item was removed:
- ----- Method: BlockClosure>>home (in category 'accessing') -----
- home
- 	^outerContext home!

Item was removed:
- ----- Method: BlockClosure>>homeMethod (in category 'accessing') -----
- homeMethod
- 	^outerContext method!

Item was removed:
- ----- Method: BlockClosure>>ifCurtailed: (in category 'exceptions') -----
- ifCurtailed: aBlock
- 	"Evaluate the receiver with an abnormal termination action.
- 	 Evaluate aBlock only if execution is unwound during execution
- 	 of the receiver.  If execution of the receiver finishes normally do
- 	 not evaluate aBlock.  N.B.  This method is *not* implemented as a
- 	 primitive.  Primitive 198 always fails.  The VM uses prim 198 in a
- 	 context's method as the mark for an ensure:/ifCurtailed: activation."
- 	| complete result |
- 	<primitive: 198>
- 	result := self valueNoContextSwitch.
- 	complete := true.
- 	^result!

Item was removed:
- ----- Method: BlockClosure>>ifError: (in category 'evaluating') -----
- ifError: errorHandlerBlock
- 	"Evaluate the block represented by the receiver, and normally return it's value.  If an error occurs, the errorHandlerBlock is evaluated, and it's value is instead returned.  The errorHandlerBlock must accept zero, one, or two parameters (the error message and the receiver)."
- 	"Examples:
- 		[1 whatsUpDoc] ifError: [:err :rcvr | 'huh?'].
- 		[1 / 0] ifError: [:err :rcvr |
- 			'ZeroDivide' = err
- 				ifTrue: [Float infinity]
- 				ifFalse: [self error: err]]
- "
- 
- 	^ self on: Error do: [:ex |
- 		errorHandlerBlock cull: ex description cull: ex receiver ]!

Item was removed:
- ----- Method: BlockClosure>>isBlock (in category 'accessing') -----
- isBlock
- 
- 	^ true!

Item was removed:
- ----- Method: BlockClosure>>isClean (in category 'testing') -----
- isClean
- 	"Answer if the receiver does not close-over any variables other than globals, and does
- 	 not ^-return (does not close over the home context).  Clean blocks are amenable to
- 	 being created at compile-time."
- 	self numCopiedValues > 0 ifTrue:
- 		[^false].
- 	self abstractBytecodeMessagesDo:
- 		[:msg|
- 		(#(	pushReceiver
- 			pushReceiverVariable: popIntoReceiverVariable: storeIntoReceiverVariable:
- 			methodReturnConstant: methodReturnReceiver methodReturnTop)
- 				includes: msg selector) ifTrue:
- 					[^false]].
- 	^true
- 
- 	"clean:"
- 		"[] isClean"
- 		"[:a :b| a < b] isClean"
- 	"unclean"
- 		"[^nil] isClean"
- 		"[self class] isClean"
- 		"| v | v := 0.
- 		 [v class] isClean"!

Item was removed:
- ----- Method: BlockClosure>>isClosure (in category 'testing') -----
- isClosure
- 	^true!

Item was removed:
- ----- Method: BlockClosure>>isDead (in category 'testing') -----
- isDead
- 	"Has self finished"
- 	^false!

Item was removed:
- ----- Method: BlockClosure>>isFullBlock (in category 'testing') -----
- isFullBlock
- 	^false!

Item was removed:
- ----- Method: BlockClosure>>isNestedWithin: (in category 'testing') -----
- isNestedWithin: aContextOrBlock
- 	"Answer if the receiver is nested within aContextOrBlock, which may be ither a Context, or a BlockClosure."
- 	aContextOrBlock ifNotNil:
- 		[self outerContextsDo:
- 			[:ctxt|
- 			 (ctxt == aContextOrBlock
- 			  or: [ctxt closure = aContextOrBlock]) ifTrue: [^true]]].
- 	^false!

Item was removed:
- ----- Method: BlockClosure>>isReceiverOrAnyArgumentGarbage (in category 'events-support') -----
- isReceiverOrAnyArgumentGarbage
- 	"For use in the when:evaluate: protocol, i.e.,
- 		foo when: #bar evaluate:[self handleBar].."
- 	^false!

Item was removed:
- ----- Method: BlockClosure>>method (in category 'accessing') -----
- method
- 	^outerContext method!

Item was removed:
- ----- Method: BlockClosure>>newProcess (in category 'scheduling') -----
- newProcess
- 	"Answer a Process running the code in the receiver. The process is not scheduled."
- 	^Process
- 		forContext: 
- 			[self value.
- 			"Since control is now at the bottom, there is no need to terminate (which runs unwinds) since all unwinds have been run.  Simply suspend.
- 			 Note that we must use this form rather than e.g. Processor suspendActive so that isTerminated answers true.  isTerminated requires that if there is a suspended context it is the bottom-most, but using a send would result in the process's suspendedContext /not/ being the bottom-most."
- 			Processor activeProcess suspend] asContext
- 		priority: Processor activePriority!

Item was removed:
- ----- Method: BlockClosure>>newProcessWith: (in category 'scheduling') -----
- newProcessWith: anArray 
- 	"Answer a Process running the code in the receiver. The receiver's block arguments are bound to the contents of the argument, anArray. The process is not scheduled."
- 	^Process
- 		forContext: 
- 			[self valueWithArguments: anArray.
- 			"Since control is now at the bottom, there is no need to terminate (which runs unwinds) since all unwinds have been run.  Simply suspend.
- 			 Note that we must use this form rather than e.g. Processor suspendActive so that isTerminated answers true.  isTerminated requires that if there is a suspended context it is the bottom-most, but using a send would result in the process's suspendedContext /not/ being the bottom-most."
- 			Processor activeProcess suspend] asContext
- 		priority: Processor activePriority!

Item was removed:
- ----- Method: BlockClosure>>numArgs (in category 'accessing') -----
- numArgs
- 	"Answer the number of arguments that must be used to evaluate this block"
- 
- 	^numArgs!

Item was removed:
- ----- Method: BlockClosure>>numArgsError: (in category 'error handing') -----
- numArgsError: numArgsForInvocation
- 
- 	| printNArgs |
- 	printNArgs := [:n| n printString, ' argument', (n = 1 ifTrue: [''] ifFalse:['s'])]. 
- 	self error: 
- 			'This block accepts ', (printNArgs value: numArgs), 
- 			', but was called with ', (printNArgs value: numArgsForInvocation), '.'!

Item was removed:
- ----- Method: BlockClosure>>numCopiedValues (in category 'accessing') -----
- numCopiedValues
- 	"Answer the number of copied values of the receiver.  Since these are
- 	 stored in the receiver's indexable fields this is the receiver's basic size.
- 	 Primitive. Answer the number of indexable variables in the receiver. 
- 	 This value is the same as the largest legal subscript."
- 
- 	<primitive: 62>
- 	^self basicSize!

Item was removed:
- ----- Method: BlockClosure>>numTemps (in category 'accessing') -----
- numTemps
- 	"Answer the number of temporaries for the receiver; this includes
- 	 the number of arguments and the number of copied values."
- 	^self numCopiedValues
- 	 + self numArgs
- 	 + (BlockLocalTempCounter
- 			tempCountForBlockStartingAt: startpcOrMethod
- 			in: self method)!

Item was removed:
- ----- Method: BlockClosure>>on:do: (in category 'exceptions') -----
- on: exceptionOrExceptionSet do: handlerAction
- 	"Evaluate the receiver in the scope of an exception handler."
- 
- 	| handlerActive handlerRearmed |
- 	<primitive: 199>  "just a marker, fail and execute the following"
- 	handlerActive := true.
- 	handlerRearmed := false.
- 	^ self value!

Item was removed:
- ----- Method: BlockClosure>>on:do:on:do: (in category 'exceptions') -----
- on: exception1 do: block1 on: exception2 do: block2
- 
- 	^[
- 		self
- 			on: exception1
- 			do: block1 ]
- 		on: exception2
- 		do: block2!

Item was removed:
- ----- Method: BlockClosure>>on:do:on:do:on:do: (in category 'exceptions') -----
- on: exception1 do: block1 on: exception2 do: block2 on: exception3 do: block3
- 
- 	^[
- 		self
- 			on: exception1
- 			do: block1 ]
- 		on: exception2
- 		do: block2
- 		on: exception3
- 		do: block3!

Item was removed:
- ----- Method: BlockClosure>>on:ensure: (in category 'exceptions') -----
- on: exceptionOrExceptionSet ensure: aBlock
- 
- 	^ self
- 		on: exceptionOrExceptionSet
- 		do: [:exception | 
- 			aBlock value.
- 			exception pass]!

Item was removed:
- ----- Method: BlockClosure>>on:ensure:on:ensure: (in category 'exceptions') -----
- on: anException1 ensure: aBlock1 on: anException2 ensure: aBlock2
- 
- 	^ [self on: anException1 ensure: aBlock1]
- 		on: anException2
- 		ensure: aBlock2!

Item was removed:
- ----- Method: BlockClosure>>on:ensure:on:ensure:on:ensure: (in category 'exceptions') -----
- on: anException1 ensure: aBlock1 on: anException2 ensure: aBlock2 on: anException3 ensure: aBlock3
- 
- 	^ [self on: anException1 ensure: aBlock1]
- 		on: anException2
- 		ensure: aBlock2
- 		on: anException3
- 		ensure: aBlock3!

Item was removed:
- ----- Method: BlockClosure>>onDNU:do: (in category 'exceptions') -----
- onDNU: selector do: handleBlock
- 	"Catch MessageNotUnderstood exceptions but only those of the given selector (DNU stands for doesNotUnderstand:)"
- 
- 	^ self on: MessageNotUnderstood do: [:exception |
- 		exception message selector = selector
- 			ifTrue: [handleBlock cull: exception]
- 			ifFalse: [exception pass]
- 	  ]!

Item was removed:
- ----- Method: BlockClosure>>once (in category 'evaluating') -----
- once
- 	"Evaluate the receiver exactly once, so that repeated evaluations
- 	 answer exactly the same object as the first evaluation.  This
- 	 allows one to intern values with the idiom
- 		myResourceMethod
- 			^[expression] once"
- 
- 	| cache |
- 	cache := self method
- 				propertyValueAt: #onceCache
- 				ifAbsent: [self method propertyValueAt: #onceCache put: IdentityDictionary new].
- 	^cache at: startpcOrMethod ifAbsentPut: [self value]!

Item was removed:
- ----- Method: BlockClosure>>outerContext (in category 'accessing') -----
- outerContext
- 	^outerContext!

Item was removed:
- ----- Method: BlockClosure>>outerContext:startpc:numArgs:copiedValues: (in category 'initialize-release') -----
- outerContext: aContext startpc: aStartpc numArgs: argCount copiedValues: anArrayOrNil
- 	outerContext := aContext.
- 	startpcOrMethod := aStartpc.
- 	numArgs := argCount.
- 	1 to: self numCopiedValues do:
- 		[:i|
- 		self at: i put: (anArrayOrNil at: i)]!

Item was removed:
- ----- Method: BlockClosure>>outerContextsDo: (in category 'private') -----
- outerContextsDo: aBlock
- 	"Evaluate aBlock with all the outer contexts along the receiver's static chain."
- 	| outer |
- 	outer := outerContext.
- 	[outer notNil] whileTrue:
- 		[aBlock value: outer.
- 		 outer := outer closure ifNotNil: [:outerClosure| outerClosure outerContext]]!

Item was removed:
- ----- Method: BlockClosure>>printOn: (in category 'printing') -----
- printOn: aStream
- 	aStream nextPutAll: '[closure] in '.
- 	outerContext printOn: aStream!

Item was removed:
- ----- Method: BlockClosure>>printSourceOn: (in category 'printing') -----
- printSourceOn: aStream 
- 	self decompile
- 		ifNil: [ aStream nextPutAll: '--source missing--' ]
- 		ifNotNil: [ : blockNode | blockNode printOn: aStream indent: 0 ]!

Item was removed:
- ----- Method: BlockClosure>>receiver (in category 'accessing') -----
- receiver
- 	^outerContext receiver!

Item was removed:
- ----- Method: BlockClosure>>reentrant (in category 'private') -----
- reentrant
- 	"Answer a version of the recever that can be reentered.
- 	 Closures are reentrant (unlike BlockContext), so simply answer self."
- 	^self!

Item was removed:
- ----- Method: BlockClosure>>repeat (in category 'controlling') -----
- repeat
- 	"Evaluate the receiver repeatedly, ending only if the block explicitly returns."
- 
- 	[self value. true] whileTrue!

Item was removed:
- ----- Method: BlockClosure>>repeatWithGCIf: (in category 'controlling') -----
- repeatWithGCIf: testBlock
- 	| ans |
- 	"run the receiver, and if testBlock returns true, garbage collect and run the receiver again"
- 	ans := self value.
- 	(testBlock value: ans) ifTrue: [ Smalltalk garbageCollect. ans := self value ].
- 	^ans!

Item was removed:
- ----- Method: BlockClosure>>sender (in category 'debugger access') -----
- sender
- 	"Answer the context that sent the message that created the receiver."
- 
- 	^outerContext sender!

Item was removed:
- ----- Method: BlockClosure>>simulateValueWithArguments:caller: (in category 'system simulation') -----
- simulateValueWithArguments: anArray caller: aContext
- 	"Simulate the valueWithArguments: primitive. Fail if anArray is not an array of the right arity."
- 	| newContext sz |
- 	newContext := (Context newForMethod: outerContext method)
- 						setSender: aContext
- 						receiver: outerContext receiver
- 						method: outerContext method
- 						closure: self
- 						startpc: startpcOrMethod.
- 	((newContext objectClass: anArray) ~~ Array
- 	 or: [numArgs ~= anArray size]) ifTrue:
- 		[^Context primitiveFailTokenFor: nil].
- 	sz := self basicSize.
- 	newContext stackp: sz + numArgs.
- 	1 to: numArgs do:
- 		[:i| newContext at: i put: (anArray at: i)].
- 	1 to: sz do:
- 		[:i| newContext at: i + numArgs put: (self at: i)].
- 	^newContext!

Item was removed:
- ----- Method: BlockClosure>>size (in category 'accessing') -----
- size
- 	"Extract this closure's bytecode size (number of bytes) by accessing
- 	 the closure creation bytecode in the enclosing method."
- 	
- 	^self blockCreationBytecodeMessage arguments last!

Item was removed:
- ----- Method: BlockClosure>>sourceString (in category 'printing') -----
- sourceString
- 	^ String streamContents: [ : stream | self printSourceOn: stream ]!

Item was removed:
- ----- Method: BlockClosure>>startpc (in category 'accessing') -----
- startpc
- 	^startpcOrMethod!

Item was removed:
- ----- Method: BlockClosure>>storeDataOn: (in category 'objects from disk') -----
- storeDataOn: aDataStream
- 	"Blocks are allowed go to out in DataStreams, but only without home senders."
- 
- 	| contexts |
- 	contexts := IdentitySet new.
- 	aDataStream insideASegment ifFalse:
- 		[self outerContextsDo:
- 			[:ctxt|
- 			 contexts add: ctxt.
- 			 aDataStream replace: ctxt sender with: nil]].
- 	^[super storeDataOn: aDataStream]
- 		on: Notification
- 		do: [:ex|
- 			(contexts includes: ex tag)
- 				ifTrue: [ex resume: ex tag]
- 				ifFalse: [ex pass]]!

Item was removed:
- ----- Method: BlockClosure>>value (in category 'evaluating') -----
- value
- 	"Activate the receiver, creating a closure activation (Context)
- 	 whose closure is the receiver and whose caller is the sender of this
- 	 message. Supply the copied values to the activation as its copied
- 	 temps. Primitive. Essential."
- 	<primitive: 201>
- 	numArgs ~= 0 ifTrue:
- 		[self numArgsError: 0].
- 	^self primitiveFailed!

Item was removed:
- ----- Method: BlockClosure>>value: (in category 'evaluating') -----
- value: firstArg
- 	"Activate the receiver, creating a closure activation (Context)
- 	 whose closure is the receiver and whose caller is the sender of this
- 	 message. Supply the argument and copied values to the activation
- 	 as its argument and copied temps. Primitive. Essential."
- 	<primitive: 202>
- 	numArgs ~= 1 ifTrue:
- 		[self numArgsError: 1].
- 	^self primitiveFailed!

Item was removed:
- ----- Method: BlockClosure>>value:value: (in category 'evaluating') -----
- value: firstArg value: secondArg
- 	"Activate the receiver, creating a closure activation (Context)
- 	 whose closure is the receiver and whose caller is the sender of this
- 	 message. Supply the arguments and copied values to the activation
- 	 as its arguments and copied temps. Primitive. Essential."
- 	<primitive: 203>
- 	numArgs ~= 2 ifTrue:
- 		[self numArgsError: 2].
- 	^self primitiveFailed!

Item was removed:
- ----- Method: BlockClosure>>value:value:value: (in category 'evaluating') -----
- value: firstArg value: secondArg value: thirdArg
- 	"Activate the receiver, creating a closure activation (Context)
- 	 whose closure is the receiver and whose caller is the sender of this
- 	 message. Supply the arguments and copied values to the activation
- 	 as its arguments and copied temps. Primitive. Essential."
- 	<primitive: 204>
- 	numArgs ~= 3 ifTrue:
- 		[self numArgsError: 3].
- 	^self primitiveFailed!

Item was removed:
- ----- Method: BlockClosure>>value:value:value:value: (in category 'evaluating') -----
- value: firstArg value: secondArg value: thirdArg value: fourthArg
- 	"Activate the receiver, creating a closure activation (Context)
- 	 whose closure is the receiver and whose caller is the sender of this
- 	 message. Supply the arguments and copied values to the activation
- 	 as its arguments and copied temps. Primitive. Essential."
- 	<primitive: 205>
- 	numArgs ~= 4 ifTrue:
- 		[self numArgsError: 4].
- 	^self primitiveFailed!

Item was removed:
- ----- Method: BlockClosure>>value:value:value:value:value: (in category 'evaluating') -----
- value: firstArg value: secondArg value: thirdArg value: fourthArg value: fifthArg
- 	"Activate the receiver, creating a closure activation (Context)
- 	 whose closure is the receiver and whose caller is the sender of this
- 	 message. Supply the arguments and copied values to the activation
- 	 as its arguments and copied temps. Primitive. Essential."
- 	<primitive: 205>
- 	numArgs ~= 5 ifTrue:
- 		[self numArgsError: 5].
- 	^self primitiveFailed!

Item was removed:
- ----- Method: BlockClosure>>valueAt: (in category 'evaluating') -----
- valueAt: blockPriority 
- 	"Evaluate the receiver (block), with another priority as the actual one 
- 	and restore it afterwards. The caller should be careful with using 
- 	higher priorities."
- 	| activeProcess result outsidePriority |
- 	activeProcess := Processor activeProcess.
- 	outsidePriority := activeProcess priority.
- 	activeProcess priority: blockPriority.
- 	result := self ensure: [activeProcess priority: outsidePriority].
- 	"Yield after restoring lower priority to give the preempted processes a  
- 	chance to run."
- 	blockPriority > outsidePriority
- 		ifTrue: [Processor yield].
- 	^ result!

Item was removed:
- ----- Method: BlockClosure>>valueNoContextSwitch (in category 'evaluating') -----
- valueNoContextSwitch
- 	"An exact copy of BlockClosure>>value except that this version will not preempt
- 	 the current process on block activation if a higher-priority process is runnable.
- 	 Primitive. Essential."
- 	<primitive: 221>
- 	numArgs ~= 0 ifTrue:
- 		[self numArgsError: 0].
- 	self primitiveFailed!

Item was removed:
- ----- Method: BlockClosure>>valueNoContextSwitch: (in category 'evaluating') -----
- valueNoContextSwitch: anArg
- 	"An exact copy of BlockClosure>>value: except that this version will not preempt
- 	 the current process on block activation if a higher-priority process is runnable.
- 	 Primitive. Essential."
- 	<primitive: 222>
- 	numArgs ~= 1 ifTrue:
- 		[self numArgsError: 1].
- 	self primitiveFailed!

Item was removed:
- ----- Method: BlockClosure>>valueOtherwise: (in category 'evaluating') -----
- valueOtherwise: aBlock
- 	"Send the message and answer the return value"
- 
- 	^self value!

Item was removed:
- ----- Method: BlockClosure>>valueSupplyingAnswer: (in category 'evaluating') -----
- valueSupplyingAnswer: anObject
- 
- 	^ (anObject isCollection and: [anObject isString not])
- 		ifTrue: [self valueSupplyingAnswers: {anObject}]
- 		ifFalse: [self valueSupplyingAnswers: {{'*'. anObject}}]!

Item was removed:
- ----- Method: BlockClosure>>valueSupplyingAnswers: (in category 'evaluating') -----
- valueSupplyingAnswers: aListOfPairs
- 	"Evaluate the receiver using a list of questions / answers that might be called upon to automatically respond to Object>>confirm: or FillInTheBlank requests"
- 
- 	^ self on: ProvideAnswerNotification do: [ :notification |
- 		| caption |
- 		caption := notification messageText withSeparatorsCompacted. "to remove new lines"
- 		aListOfPairs
- 			detect: [ :each |
- 				caption = each first
- 					or: [ (caption includesSubstring: each first caseSensitive: false)
- 					or: [ (each first match: caption)
- 					or: [ (caption respondsTo: #matchesRegex:) 
- 						and: [ [caption matchesRegex: each first] ifError: [false] ] ] ] ] ]
- 			ifFound: [ :answer | notification resume: answer second ]
- 			ifNone: [ notification pass ] ]!

Item was removed:
- ----- Method: BlockClosure>>valueSuppressingAllMessages (in category 'evaluating') -----
- valueSuppressingAllMessages
- 
- 	^ self valueSuppressingMessages: #('*')!

Item was removed:
- ----- Method: BlockClosure>>valueSuppressingMessages: (in category 'evaluating') -----
- valueSuppressingMessages: aListOfStrings
- 
- 	^ self
- 		valueSuppressingMessages: aListOfStrings
- 		supplyingAnswers: #()!

Item was removed:
- ----- Method: BlockClosure>>valueSuppressingMessages:supplyingAnswers: (in category 'evaluating') -----
- valueSuppressingMessages: aListOfStrings supplyingAnswers: aListOfPairs
- 
- 	^ self valueSupplyingAnswers: aListOfPairs, (aListOfStrings collect: [:each | {each. true}])!

Item was removed:
- ----- Method: BlockClosure>>valueUninterruptably (in category 'exceptions') -----
- valueUninterruptably
- 	"Prevent remote returns from escaping the sender.  Even attempts to terminate (unwind) this process will be halted and the process will resume here.  A terminate message is needed for every one of these in the sender chain to get the entire process unwound."
- 
- 	^ self ifCurtailed: [^ self]!

Item was removed:
- ----- Method: BlockClosure>>valueUnpreemptively (in category 'private') -----
- valueUnpreemptively
- 	"Evaluate the receiver (block), without the possibility of preemption by higher priority processes. Use this facility VERY sparingly!!"
- 	"Think about using Block>>valueUninterruptably first, and think about using Semaphore>>critical: before that, and think about redesigning your application even before that!! 
- 	After you've done all that thinking, go right ahead and use it..."
- 	| activeProcess oldPriority result |
- 	activeProcess := Processor activeProcess.
- 	oldPriority := activeProcess priority.
- 	activeProcess priority: Processor highestPriority.
- 	result := self ensure: [activeProcess priority: oldPriority].
- 	"Yield after restoring priority to give the preempted processes a chance to run"
- 	Processor yield.
- 	^result!

Item was removed:
- ----- Method: BlockClosure>>valueWithArguments: (in category 'evaluating') -----
- valueWithArguments: anArray
- 	"Activate the receiver, creating a closure activation (Context)
- 	 whose closure is the receiver and whose caller is the sender of this
- 	 message. Supply the arguments in an anArray and copied values to
- 	 the activation as its arguments and copied temps. Primitive. Essential."
- 	<primitive: 206>
- 	numArgs ~= anArray size ifTrue:
- 		[self numArgsError: anArray size].
- 	^self primitiveFailed!

Item was removed:
- ----- Method: BlockClosure>>valueWithArguments:otherwise: (in category 'evaluating') -----
- valueWithArguments: anArray otherwise: aBlock
- 
- 	^ self valueWithArguments: anArray!

Item was removed:
- ----- Method: BlockClosure>>valueWithEnoughArguments: (in category 'evaluating') -----
- valueWithEnoughArguments: anArray
- 	"call me with enough arguments from anArray"
- 	| args |
- 	(anArray size == self numArgs)
- 		ifTrue: [ ^self valueWithArguments: anArray ].
- 
- 	args := Array new: self numArgs.
- 	args replaceFrom: 1
- 		to: (anArray size min: args size)
- 		with: anArray
- 		startingAt: 1.
- 
- 	^ self valueWithArguments: args!

Item was removed:
- ----- Method: BlockClosure>>valueWithExit (in category 'evaluating') -----
- valueWithExit
- 	"Provides an exit block to the receiver. Use it to break out of the control flow with an early return. Examples below.
- 		[:break | 1 to: 10 do: [:each | each > 5 ifTrue: [break value]]] valueWithExit.
- 		1 to: 10 do: [:each | [:continue | each > 5 ifTrue: [continue value]] valueWithExit]."
- 	^self value: [ ^nil ]!

Item was removed:
- ----- Method: BlockClosure>>valueWithPossibleArgs: (in category 'evaluating') -----
- valueWithPossibleArgs: anArray 
- 
- 	^numArgs = 0
- 		ifTrue: [self value]
- 		ifFalse:
- 			[self valueWithArguments:
- 				(numArgs = anArray size
- 					ifTrue: [anArray]
- 					ifFalse:
- 						[numArgs > anArray size
- 							ifTrue: [anArray, (Array new: numArgs - anArray size)]
- 							ifFalse: [anArray copyFrom: 1 to: numArgs]])]!

Item was removed:
- ----- Method: BlockClosure>>valueWithPossibleArgument: (in category 'evaluating') -----
- valueWithPossibleArgument: anArg 
- 	"Evaluate the block represented by the receiver. If the block requires one argument, use anArg, if it requires more than one, fill up the rest with nils. See also #cull: if you want to raise an exception for incompatible blocks instead."
- 
- 	| a |
- 	numArgs = 0 ifTrue: [^self value].
- 	numArgs = 1 ifTrue: [^self value: anArg].
- 	a := Array new: numArgs.
- 	a at: 1 put: anArg.
- 	^self valueWithArguments: a!

Item was removed:
- ----- Method: BlockClosure>>whileFalse (in category 'controlling') -----
- whileFalse
- 	"Ordinarily compiled in-line, and therefore not overridable.
- 	This is in case the message is sent to other than a literal block.
- 	Evaluate the receiver, as long as its value is false."
-  
- 	^ [self value] whileFalse: []!

Item was removed:
- ----- Method: BlockClosure>>whileFalse: (in category 'controlling') -----
- whileFalse: aBlock 
- 	"Ordinarily compiled in-line, and therefore not overridable.
- 	This is in case the message is sent to other than a literal block.
- 	Evaluate the argument, aBlock, as long as the value of the receiver is false."
- 
- 	^ [self value] whileFalse: [aBlock value]!

Item was removed:
- ----- Method: BlockClosure>>whileNil (in category 'controlling') -----
- whileNil
- 	"Unlike #whileTrue/False this is not compiled inline."
- 	| result |
- 	[(result := self value) isNil] whileTrue.
- 	^ result
- 	!

Item was removed:
- ----- Method: BlockClosure>>whileNil: (in category 'controlling') -----
- whileNil: aBlock 
- 	"Unlike #whileTrue/False: this is not compiled inline."
- 	| result |
- 	[(result := self value) isNil] whileTrue: [aBlock value].
- 	^ result
- 	!

Item was removed:
- ----- Method: BlockClosure>>whileNotNil: (in category 'controlling') -----
- whileNotNil: aBlock 
- 	"Unlike #whileTrue/False: this is not compiled inline."
- 	^ [self value notNil] whileTrue: [aBlock value]
- 	!

Item was removed:
- ----- Method: BlockClosure>>whileTrue (in category 'controlling') -----
- whileTrue
- 	"Ordinarily compiled in-line, and therefore not overridable.
- 	This is in case the message is sent to other than a literal block.
- 	Evaluate the receiver, as long as its value is true."
-  
- 	^ [self value] whileTrue: []!

Item was removed:
- ----- Method: BlockClosure>>whileTrue: (in category 'controlling') -----
- whileTrue: aBlock 
- 	"Ordinarily compiled in-line, and therefore not overridable.
- 	This is in case the message is sent to other than a literal block.
- 	Evaluate the argument, aBlock, as long as the value of the receiver is true."
- 
- 	^ [self value] whileTrue: [aBlock value]!

Item was removed:
- InstructionClient subclass: #BlockLocalTempCounter
- 	instanceVariableNames: 'stackPointer scanner blockEnd joinOffsets'
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'Kernel-Methods'!
- 
- !BlockLocalTempCounter commentStamp: 'eem 1/11/2018 08:30' prior: 0!
- I am a support class for the decompiler that is used to find the number of local temps in a block by finding out what the stack offset is at the end of a block.  I am necessary because in the EncoderForV3PlusClosures bytecode set the only way to initialize block-local temporaries is with pushConstant: nil bytecodes, but such bytecodes are ambiguous with a pushConstant: nil used to pass nil as a parameter or answer it as a result.  By scanning through to the end of the block these can be disambiguated by tracking the stack depth.!

Item was removed:
- ----- Method: BlockLocalTempCounter class>>tempCountForBlockAt:in: (in category 'instance creation') -----
- tempCountForBlockAt: pc in: method
- 	^self new tempCountForBlockAt: pc in: method!

Item was removed:
- ----- Method: BlockLocalTempCounter class>>tempCountForBlockStartingAt:in: (in category 'instance creation') -----
- tempCountForBlockStartingAt: startpc in: method
- 	^self new
- 		tempCountForBlockAt: (method encoderClass pcOfBlockCreationBytecodeForBlockStartingAt: startpc in: method)
- 		in: method!

Item was removed:
- ----- Method: BlockLocalTempCounter>>blockReturnConstant: (in category 'instruction decoding') -----
- blockReturnConstant: value
- 	"Return Constant From Block bytecode."
- 	scanner pc < blockEnd ifTrue:
- 		[self doJoin]!

Item was removed:
- ----- Method: BlockLocalTempCounter>>blockReturnTop (in category 'instruction decoding') -----
- blockReturnTop
- 	"Return Top Of Stack bytecode."
- 	stackPointer := stackPointer - 1.
- 	scanner pc < blockEnd ifTrue:
- 		[self doJoin]!

Item was removed:
- ----- Method: BlockLocalTempCounter>>directedSuperSend:numArgs: (in category 'instruction decoding') -----
- directedSuperSend: selector numArgs: numArgs
- 	"Send Message Above Specific Class With Selector, selector, bytecode.
- 	 Start the lookup above the class that is the value of the association on
- 	 top of stack. The arguments  of the message are found in the top numArgs
- 	 stack locations beneath the association, and the receiver just below them."
- 
- 	stackPointer := stackPointer - (numArgs + 1)!

Item was removed:
- ----- Method: BlockLocalTempCounter>>doDup (in category 'instruction decoding') -----
- doDup
- 	"Duplicate Top Of Stack bytecode."
- 	stackPointer := stackPointer + 1!

Item was removed:
- ----- Method: BlockLocalTempCounter>>doJoin (in category 'private') -----
- doJoin
- 	scanner pc < blockEnd ifTrue:
- 		[stackPointer := joinOffsets at: scanner pc ifAbsent: [scanner followingPc]]
- 
- 	"the ifAbsent: handles a caseOf:otherwise: where all cases return, which results
- 	 in the branch around the otherwise being unreached.  e.g. in the following
- 		jumpTo: L2
- 	 is unreached.
- 
- 		| t |
- 		t caseOf: { [nil] -> [^thisContext method abstractSymbolic] }
- 		  otherwise: ['Oh no Mr Bill!!']
- 
- 		pushTemp: 0
- 		pushConstant: nil
- 		send: #= (1 arg)
- 		jumpFalseTo: L1
- 		pushThisContext: 
- 		send: #method (0 args)
- 		send: #abstractSymbolic (0 args)
- 		returnTop
- 		jumpTo: L2
- 	L1:
- 		pushConstant: 'Oh no Mr Bill!!'
- 	L2:
- 		returnTop"!

Item was removed:
- ----- Method: BlockLocalTempCounter>>doPop (in category 'instruction decoding') -----
- doPop
- 	"Remove Top Of Stack bytecode."
- 	stackPointer := stackPointer - 1!

Item was removed:
- ----- Method: BlockLocalTempCounter>>jump: (in category 'instruction decoding') -----
- jump: offset
- 	"Unconditional Jump bytecode."
- 	offset > 0 ifTrue:
- 		[joinOffsets at: scanner pc + offset put: stackPointer.
- 		 self doJoin]!

Item was removed:
- ----- Method: BlockLocalTempCounter>>jump:if: (in category 'instruction decoding') -----
- jump: offset if: condition 
- 	"Conditional Jump bytecode."
- 	stackPointer := stackPointer - 1.
- 	offset > 0 ifTrue:
- 		[joinOffsets at: scanner pc + offset put: stackPointer]!

Item was removed:
- ----- Method: BlockLocalTempCounter>>methodReturnConstant: (in category 'instruction decoding') -----
- methodReturnConstant: value 
- 	"Return Constant bytecode."
- 	self doJoin!

Item was removed:
- ----- Method: BlockLocalTempCounter>>methodReturnReceiver (in category 'instruction decoding') -----
- methodReturnReceiver
- 	"Return Self bytecode."
- 	self doJoin!

Item was removed:
- ----- Method: BlockLocalTempCounter>>methodReturnTop (in category 'instruction decoding') -----
- methodReturnTop
- 	"Return Top Of Stack bytecode."
- 	stackPointer := stackPointer - 1.
- 	self doJoin!

Item was removed:
- ----- Method: BlockLocalTempCounter>>popIntoLiteralVariable: (in category 'instruction decoding') -----
- popIntoLiteralVariable: anAssociation 
- 	"Remove Top Of Stack And Store Into Literal Variable bytecode."
- 	stackPointer := stackPointer - 1!

Item was removed:
- ----- Method: BlockLocalTempCounter>>popIntoReceiverVariable: (in category 'instruction decoding') -----
- popIntoReceiverVariable: offset 
- 	"Remove Top Of Stack And Store Into Instance Variable bytecode."
- 	stackPointer := stackPointer - 1!

Item was removed:
- ----- Method: BlockLocalTempCounter>>popIntoRemoteTemp:inVectorAt: (in category 'instruction decoding') -----
- popIntoRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
- 	"Remove Top Of Stack And Store Into Offset of Temp Vector bytecode."
- 	stackPointer := stackPointer - 1!

Item was removed:
- ----- Method: BlockLocalTempCounter>>popIntoTemporaryVariable: (in category 'instruction decoding') -----
- popIntoTemporaryVariable: offset 
- 	"Remove Top Of Stack And Store Into Temporary Variable bytecode."
- 	stackPointer := stackPointer - 1!

Item was removed:
- ----- Method: BlockLocalTempCounter>>pushActiveContext (in category 'instruction decoding') -----
- pushActiveContext
- 	"Push Active Context On Top Of Its Own Stack bytecode."
- 	stackPointer := stackPointer + 1!

Item was removed:
- ----- Method: BlockLocalTempCounter>>pushClosureCopyNumCopiedValues:numArgs:blockSize: (in category 'instruction decoding') -----
- pushClosureCopyNumCopiedValues: numCopied numArgs: numArgs blockSize: blockSize
- 	"Push Closure bytecode.  Either compute the end of the block if this is
- 	 the block we're analysing, or skip it, adjusting the stack as appropriate."
- 	blockEnd
- 		ifNil: [blockEnd := scanner pc + blockSize]
- 		ifNotNil:
- 			[stackPointer := stackPointer - numCopied + 1.
- 			 scanner pc: scanner pc + blockSize]!

Item was removed:
- ----- Method: BlockLocalTempCounter>>pushConsArrayWithElements: (in category 'instruction decoding') -----
- pushConsArrayWithElements: numElements
- 	"Push Cons Array of size numElements popping numElements items from the stack into the array bytecode."
- 	stackPointer := stackPointer - numElements + 1!

Item was removed:
- ----- Method: BlockLocalTempCounter>>pushConstant: (in category 'instruction decoding') -----
- pushConstant: value
- 	"Push Constant, value, on Top Of Stack bytecode."
- 	stackPointer := stackPointer + 1!

Item was removed:
- ----- Method: BlockLocalTempCounter>>pushFullClosure:numCopied: (in category 'instruction decoding') -----
- pushFullClosure: aCompiledBlock numCopied: numCopied
- 	"Push Full Closure bytecode."
- 	self error: 'BlockLocalTempCounter should not be used with full block compiled methods.  A full block''s numTemps is accessible directly from its method.'!

Item was removed:
- ----- Method: BlockLocalTempCounter>>pushLiteralVariable: (in category 'instruction decoding') -----
- pushLiteralVariable: anAssociation
- 	"Push Contents Of anAssociation On Top Of Stack bytecode."
- 	stackPointer := stackPointer + 1!

Item was removed:
- ----- Method: BlockLocalTempCounter>>pushNewArrayOfSize: (in category 'instruction decoding') -----
- pushNewArrayOfSize: numElements 
- 	"Push New Array of size numElements bytecode."
- 	stackPointer := stackPointer + 1!

Item was removed:
- ----- Method: BlockLocalTempCounter>>pushReceiver (in category 'instruction decoding') -----
- pushReceiver
- 	"Push Active Context's Receiver on Top Of Stack bytecode."
- 	stackPointer := stackPointer + 1!

Item was removed:
- ----- Method: BlockLocalTempCounter>>pushReceiverVariable: (in category 'instruction decoding') -----
- pushReceiverVariable: offset
- 	"Push Contents Of the Receiver's Instance Variable Whose Index 
- 	is the argument, offset, On Top Of Stack bytecode."
- 	stackPointer := stackPointer + 1!

Item was removed:
- ----- Method: BlockLocalTempCounter>>pushRemoteTemp:inVectorAt: (in category 'instruction decoding') -----
- pushRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
- 	"Push Contents at Offset in Temp Vector bytecode."
- 	stackPointer := stackPointer + 1!

Item was removed:
- ----- Method: BlockLocalTempCounter>>pushTemporaryVariable: (in category 'instruction decoding') -----
- pushTemporaryVariable: offset
- 	"Push Contents Of Temporary Variable Whose Index Is the 
- 	argument, offset, On Top Of Stack bytecode."
- 	stackPointer := stackPointer + 1!

Item was removed:
- ----- Method: BlockLocalTempCounter>>send:super:numArgs: (in category 'instruction decoding') -----
- send: selector super: supered numArgs: numberArguments
- 	"Send Message With Selector, selector, bytecode. The argument, 
- 	supered, indicates whether the receiver of the message is specified with 
- 	'super' in the source method. The arguments of the message are found in 
- 	the top numArguments locations on the stack and the receiver just 
- 	below them."
- 
- 	stackPointer := stackPointer - numberArguments!

Item was removed:
- ----- Method: BlockLocalTempCounter>>tempCountForBlockAt:in: (in category 'initialize-release') -----
- tempCountForBlockAt: pc in: method
- 	"Compute the number of local temporaries in a block.
- 	 If the block begins with a sequence of push: nil bytecodes then some of
- 	 These could be initializing local temps.  We can only reliably disambuguate
- 	 them from other uses of nil by parsing the stack and seeing what the offset
- 	 of the stack pointer is at the end of the block.
- 
- 	 There are short-cuts.  The ones we take here are
- 		- if there is no sequence of push nils there can be no local temps
- 		- we follow forward jumps to shorten the amount of scanning"
- 	stackPointer := 0.
- 	scanner := InstructionStream new method: method pc: pc.
- 	scanner interpretNextInstructionFor: self.
- 	blockEnd ifNil:
- 		[self error: 'pc is not that of a block'].
- 	scanner nextByte = method encoderClass pushNilCode ifTrue:
- 		[joinOffsets := Dictionary new.
- 		 [scanner pc < blockEnd] whileTrue:
- 			[scanner interpretNextInstructionFor: self]].
- 	^stackPointer!

Item was removed:
- ----- Method: BlockLocalTempCounter>>testTempCountForBlockAt:in: (in category 'initialize-release') -----
- testTempCountForBlockAt: startPc in: method
- 	"Compute the number of local temporaries in a block.
- 	 If the block begins with a sequence of push: nil bytecodes then some of
- 	 These could be initializing local temps.  We can only reliably disambuguate
- 	 them from other uses of nil by parsing the stack and seeing what the offset
- 	 of the stack pointer is at the end of the block.There are short-cuts.  The only
- 	 one we take here is
- 		- if there is no sequence of push nils there can be no local temps"
- 
- 	| symbolicLines line prior thePc |
- 	symbolicLines := Dictionary new.
- 	method symbolicLinesDo:
- 		[:pc :lineForPC| symbolicLines at: pc put: lineForPC].
- 	stackPointer := 0.
- 	scanner := InstructionStream new method: method pc: startPc.
- 	scanner interpretNextInstructionFor: self.
- 	blockEnd ifNil:
- 		[self error: 'pc is not that of a block'].
- 	scanner nextByte = method encoderClass pushNilCode ifTrue:
- 		[joinOffsets := Dictionary new.
- 		 [scanner pc < blockEnd] whileTrue:
- 			[line := symbolicLines at: scanner pc.
- 			 prior := stackPointer.
- 			 thePc := scanner pc.
- 			 scanner interpretNextInstructionFor: self.
- 			 Transcript cr; print: prior; nextPutAll: '->'; print: stackPointer;  tab; print: thePc; tab; nextPutAll: line; flush]].
- 	^stackPointer!

Item was removed:
- Object subclass: #Boolean
- 	instanceVariableNames: ''
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'Kernel-Objects'!
- 
- !Boolean commentStamp: '<historical>' prior: 0!
- Boolean is an abstract class defining the protocol for logic testing operations and conditional control structures for the logical values represented by the instances of its subclasses True and False.
- 
- Boolean redefines #new so no instances of Boolean can be created. It also redefines several messages in the 'copying' protocol to ensure that only one instance of each of its subclasses True (the global true, logical assertion) and False (the global false, logical negation) ever exist in the system.!

Item was removed:
- ----- Method: Boolean class>>initializedInstance (in category 'instance creation') -----
- initializedInstance
- 	^ nil!

Item was removed:
- ----- Method: Boolean class>>isAbstract (in category 'testing') -----
- isAbstract
- 	^self = Boolean!

Item was removed:
- ----- Method: Boolean class>>new (in category 'instance creation') -----
- new
- 	self error: 'You may not create any more Booleans - this is two-valued logic'!

Item was removed:
- ----- Method: Boolean>>& (in category 'logical operations') -----
- & aBoolean 
- 	"Evaluating conjunction. Evaluate the argument. Then answer true if 
- 	both the receiver and the argument are true."
- 
- 	self subclassResponsibility!

Item was removed:
- ----- Method: Boolean>>==> (in category 'logical operations') -----
- ==> aBlock
- 	"this is material implication, a ==> b, also known as:
- 			b if a 
- 			a implies b
- 			if a then b
- 			b is a consequence of a
- 			a therefore b (but note: 'it is raining therefore it is cloudy' is implication; 'it is autumn therefore the leaves are falling' is equivalence).
- 		
- 	Here is the truth table for material implication (view in a monospaced font):
- 	
- 	   p   |   q   |   p ==> q
- 	-------|-------|-------------
- 	   T   |   T   |      T
- 	   T   |   F   |      F
- 	   F   |   T   |      T
- 	   F   |   F   |      T
- 	"
- 
- 	self subclassResponsibility!

Item was removed:
- ----- Method: Boolean>>and: (in category 'controlling') -----
- and: alternativeBlock 
- 	"Nonevaluating conjunction. If the receiver is true, answer the value of 
- 	the argument, alternativeBlock; otherwise answer false without 
- 	evaluating the argument."
- 
- 	self subclassResponsibility!

Item was removed:
- ----- Method: Boolean>>and:and: (in category 'controlling') -----
- and: block1 and: block2
- 	"Nonevaluating conjunction without deep nesting.
- 	The receiver is evaluated, followed by the blocks in order.
- 	If any of these evaluates as false, then return false immediately,
- 		without evaluating any further blocks.
- 	If all return true, then return true."
- 
- 	self ifFalse: [^ false].
- 	block1 value ifFalse: [^ false].
- 	block2 value ifFalse: [^ false].
- 	^ true!

Item was removed:
- ----- Method: Boolean>>and:and:and: (in category 'controlling') -----
- and: block1 and: block2 and: block3
- 	"Nonevaluating conjunction without deep nesting.
- 	The receiver is evaluated, followed by the blocks in order.
- 	If any of these evaluates as false, then return false immediately,
- 		without evaluating any further blocks.
- 	If all return true, then return true."
- 
- 	self ifFalse: [^ false].
- 	block1 value ifFalse: [^ false].
- 	block2 value ifFalse: [^ false].
- 	block3 value ifFalse: [^ false].
- 	^ true!

Item was removed:
- ----- Method: Boolean>>and:and:and:and: (in category 'controlling') -----
- and: block1 and: block2 and: block3 and: block4
- 	"Nonevaluating conjunction without deep nesting.
- 	The receiver is evaluated, followed by the blocks in order.
- 	If any of these evaluates as false, then return false immediately,
- 		without evaluating any further blocks.
- 	If all return true, then return true."
- 
- 	self ifFalse: [^ false].
- 	block1 value ifFalse: [^ false].
- 	block2 value ifFalse: [^ false].
- 	block3 value ifFalse: [^ false].
- 	block4 value ifFalse: [^ false].
- 	^ true!

Item was removed:
- ----- Method: Boolean>>asBit (in category 'printing') -----
- asBit
- 	"My numerical interpretation, as one-bit number. This extends nicely to n-bit numbers,
- 	as long as they treat 0 as false, and anything else as true"
- 	^ self subclassResponsibility!

Item was removed:
- ----- Method: Boolean>>asInteger (in category 'converting') -----
- asInteger
- 	"It is sufficient to treat this boolean as bit so as to interpret it as a number"
- 	^ self asBit!

Item was removed:
- ----- Method: Boolean>>asNumber (in category 'converting') -----
- asNumber
- 	"It is sufficient to treat this boolean as bit so as to interpret it as a number"
- 	^ self asBit!

Item was removed:
- ----- Method: Boolean>>deepCopy (in category 'copying') -----
- deepCopy 
- 	"Receiver has two concrete subclasses, True and False.
- 	Only one instance of each should be made, so return self."!

Item was removed:
- ----- Method: Boolean>>eqv: (in category 'logical operations') -----
- eqv: aBoolean 
- 	"Answer true if the receiver is equivalent to aBoolean."
- 
- 	^self == aBoolean!

Item was removed:
- ----- Method: Boolean>>ifFalse: (in category 'controlling') -----
- ifFalse: alternativeBlock 
- 	"If the receiver is true (i.e., the condition is true), then the value is the 
- 	true alternative, which is nil. Otherwise answer the result of evaluating 
- 	the argument, alternativeBlock. Create an error notification if the 
- 	receiver is nonBoolean. Execution does not actually reach here because 
- 	the expression is compiled in-line."
- 
- 	self subclassResponsibility!

Item was removed:
- ----- Method: Boolean>>ifFalse:ifTrue: (in category 'controlling') -----
- ifFalse: falseAlternativeBlock ifTrue: trueAlternativeBlock 
- 	"Same as ifTrue:ifFalse:."
- 
- 	self subclassResponsibility!

Item was removed:
- ----- Method: Boolean>>ifTrue: (in category 'controlling') -----
- ifTrue: alternativeBlock 
- 	"If the receiver is false (i.e., the condition is false), then the value is the 
- 	false alternative, which is nil. Otherwise answer the result of evaluating 
- 	the argument, alternativeBlock. Create an error notification if the 
- 	receiver is nonBoolean. Execution does not actually reach here because 
- 	the expression is compiled in-line."
- 
- 	self subclassResponsibility!

Item was removed:
- ----- Method: Boolean>>ifTrue:ifFalse: (in category 'controlling') -----
- ifTrue: trueAlternativeBlock ifFalse: falseAlternativeBlock
- 	"If the receiver is true (i.e., the condition is true), then answer the value 
- 	of the argument trueAlternativeBlock. If the receiver is false, answer the 
- 	result of evaluating the argument falseAlternativeBlock. If the receiver 
- 	is a nonBoolean then create an error notification. Execution does not 
- 	actually reach here because the expression is compiled in-line."
- 
- 	self subclassResponsibility!

Item was removed:
- ----- Method: Boolean>>isBoolean (in category 'testing') -----
- isBoolean
- 	^ true!

Item was removed:
- ----- Method: Boolean>>isLiteral (in category 'printing') -----
- isLiteral 
- 	^ true!

Item was removed:
- ----- Method: Boolean>>not (in category 'logical operations') -----
- not
- 	"Negation. Answer true if the receiver is false, answer false if the 
- 	receiver is true."
- 
- 	self subclassResponsibility!

Item was removed:
- ----- Method: Boolean>>or: (in category 'controlling') -----
- or: alternativeBlock 
- 	"Nonevaluating disjunction. If the receiver is false, answer the value of 
- 	the argument, alternativeBlock; otherwise answer true without 
- 	evaluating the argument."
- 
- 	self subclassResponsibility!

Item was removed:
- ----- Method: Boolean>>or:or: (in category 'controlling') -----
- or: block1 or: block2
- 	"Nonevaluating alternation without deep nesting.
- 	The receiver is evaluated, followed by the blocks in order.
- 	If any of these evaluates as true, then return true immediately,
- 		without evaluating any further blocks.
- 	If all return false, then return false."
- 
- 	self ifTrue: [^ true].
- 	block1 value ifTrue: [^ true].
- 	block2 value ifTrue: [^ true].
- 	^ false!

Item was removed:
- ----- Method: Boolean>>or:or:or: (in category 'controlling') -----
- or: block1 or: block2 or: block3
- 	"Nonevaluating alternation without deep nesting.
- 	The receiver is evaluated, followed by the blocks in order.
- 	If any of these evaluates as true, then return true immediately,
- 		without evaluating any further blocks.
- 	If all return false, then return false."
- 
- 	self ifTrue: [^ true].
- 	block1 value ifTrue: [^ true].
- 	block2 value ifTrue: [^ true].
- 	block3 value ifTrue: [^ true].
- 	^ false!

Item was removed:
- ----- Method: Boolean>>or:or:or:or: (in category 'controlling') -----
- or: block1 or: block2 or: block3 or: block4
- 	"Nonevaluating alternation without deep nesting.
- 	The receiver is evaluated, followed by the blocks in order.
- 	If any of these evaluates as true, then return true immediately,
- 		without evaluating any further blocks.
- 	If all return false, then return false."
- 
- 	self ifTrue: [^ true].
- 	block1 value ifTrue: [^ true].
- 	block2 value ifTrue: [^ true].
- 	block3 value ifTrue: [^ true].
- 	block4 value ifTrue: [^ true].
- 	^ false!

Item was removed:
- ----- Method: Boolean>>or:or:or:or:or: (in category 'controlling') -----
- or: block1 or: block2 or: block3 or: block4 or: block5
- 	"Nonevaluating alternation without deep nesting.
- 	The receiver is evaluated, followed by the blocks in order.
- 	If any of these evaluates as true, then return true immediately,
- 		without evaluating any further blocks.
- 	If all return false, then return false."
- 
- 	self ifTrue: [^ true].
- 	block1 value ifTrue: [^ true].
- 	block2 value ifTrue: [^ true].
- 	block3 value ifTrue: [^ true].
- 	block4 value ifTrue: [^ true].
- 	block5 value ifTrue: [^ true].
- 	^ false!

Item was removed:
- ----- Method: Boolean>>printAsLiteralOn: (in category 'printing') -----
- printAsLiteralOn: aStream
- 	^self printOn: aStream!

Item was removed:
- ----- Method: Boolean>>shallowCopy (in category 'copying') -----
- shallowCopy 
- 	"Receiver has two concrete subclasses, True and False.
- 	Only one instance of each should be made, so return self."!

Item was removed:
- ----- Method: Boolean>>storeOn: (in category 'printing') -----
- storeOn: aStream 
- 	"Refer to the comment in Object|storeOn:."
- 
- 	self printOn: aStream!

Item was removed:
- ----- Method: Boolean>>veryDeepCopy (in category 'copying') -----
- veryDeepCopy
- 	"Overridden for performance to avoid #fixDependents."
- 	^ self!

Item was removed:
- ----- Method: Boolean>>veryDeepCopyWith: (in category 'copying') -----
- veryDeepCopyWith: deepCopier
- 	"Return self.  I can't be copied.  Do not record me."!

Item was removed:
- ----- Method: Boolean>>xor: (in category 'logical operations') -----
- xor: aBoolean 
- 	"Exclusive OR. Answer true if the receiver is not equivalent to aBoolean."
- 
- 	^(self == aBoolean) not!

Item was removed:
- ----- Method: Boolean>>| (in category 'logical operations') -----
- | aBoolean 
- 	"Evaluating disjunction (OR). Evaluate the argument. Then answer true 
- 	if either the receiver or the argument is true."
- 
- 	self subclassResponsibility!

Item was removed:
- Float variableWordSubclass: #BoxedFloat64
- 	instanceVariableNames: ''
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'Kernel-Numbers'!
- 
- !BoxedFloat64 commentStamp: 'eem 11/25/2014 07:54' prior: 0!
- My instances hold 64-bit Floats in heap objects.  This is the only representation on 32-bit systems.  But on 64-bit systems SmallFloat64 holds a subset of the full 64-bit double-precision range in immediate objects.!

Item was removed:
- ----- Method: BoxedFloat64 class>>basicNew (in category 'instance creation') -----
- basicNew
- 	^self basicNew: 2!

Item was removed:
- ----- Method: BoxedFloat64 class>>basicNew: (in category 'instance creation') -----
- basicNew: sizeRequested 
- 	"Primitive. Answer an instance of this class with the number
- 	 of indexable variables specified by the argument, sizeRequested.
- 	 Fail if this class is not indexable or if the argument is not a
- 	 positive Integer, or if there is not enough memory available. 
- 	 Essential. See Object documentation whatIsAPrimitive."
- 
- 	<primitive: 71>
- 	sizeRequested isInteger ifTrue:
- 		[^sizeRequested = 2
- 			ifTrue: "arg okay; space must be low."
- 				[OutOfMemory signal.
- 				 self basicNew: sizeRequested]  "retry if user proceeds"
- 			ifFalse:
- 				[self error: 'a Float shall always have two slots']].
- 	self primitiveFailed!

Item was removed:
- ----- Method: BoxedFloat64>>* (in category 'arithmetic') -----
- * aNumber 
- 	"Primitive. Answer the result of multiplying the receiver by aNumber.
- 	Fail if the argument is not a Float. Essential. See Object documentation
- 	whatIsAPrimitive."
- 
- 	<primitive: 49>
- 	^ aNumber adaptToFloat: self andSend: #*!

Item was removed:
- ----- Method: BoxedFloat64>>+ (in category 'arithmetic') -----
- + aNumber 
- 	"Primitive. Answer the sum of the receiver and aNumber. Essential.
- 	Fail if the argument is not a Float. See Object documentation
- 	whatIsAPrimitive."
- 
- 	<primitive: 41>
- 	^ aNumber adaptToFloat: self andSend: #+!

Item was removed:
- ----- Method: BoxedFloat64>>- (in category 'arithmetic') -----
- - aNumber 
- 	"Primitive. Answer the difference between the receiver and aNumber.
- 	Fail if the argument is not a Float. Essential. See Object documentation
- 	whatIsAPrimitive."
- 
- 	<primitive: 42>
- 	^ aNumber adaptToFloat: self andSend: #-!

Item was removed:
- ----- Method: BoxedFloat64>>/ (in category 'arithmetic') -----
- / aNumber 
- 	"Primitive. Answer the result of dividing receiver by aNumber.
- 	Fail if the argument is not a Float. Essential. See Object documentation
- 	whatIsAPrimitive."
- 
- 	<primitive: 50>
- 	aNumber isZero ifTrue: [^(ZeroDivide dividend: self) signal].
- 	^ aNumber adaptToFloat: self andSend: #/!

Item was removed:
- ----- Method: BoxedFloat64>>< (in category 'comparing') -----
- < aNumber 
- 	"Primitive. Compare the receiver with the argument and return true
- 	if the receiver is less than the argument. Otherwise return false.
- 	Fail if the argument is not a Float. Essential. See Object documentation
- 	whatIsAPrimitive."
- 
- 	<primitive: 43>
- 	^ aNumber adaptToFloat: self andCompare: #<!

Item was removed:
- ----- Method: BoxedFloat64>><= (in category 'comparing') -----
- <= aNumber 
- 	"Primitive. Compare the receiver with the argument and return true
- 	if the receiver is less than or equal to the argument. Otherwise return
- 	false. Fail if the argument is not a Float. Optional. See Object
- 	documentation whatIsAPrimitive."
- 
- 	<primitive: 45>
- 	^ aNumber adaptToFloat: self andCompare: #<=!

Item was removed:
- ----- Method: BoxedFloat64>>= (in category 'comparing') -----
- = aNumber 
- 	"Primitive. Compare the receiver with the argument and return true
- 	if the receiver is equal to the argument. Otherwise return false.
- 	Fail if the argument is not a Float. Essential. See Object documentation
- 	whatIsAPrimitive."
- 
- 	<primitive: 47>
- 	aNumber isNumber ifFalse: [^ false].
- 	^ aNumber adaptToFloat: self andCompare: #=!

Item was removed:
- ----- Method: BoxedFloat64>>> (in category 'comparing') -----
- > aNumber 
- 	"Primitive. Compare the receiver with the argument and return true
- 	if the receiver is greater than the argument. Otherwise return false.
- 	Fail if the argument is not a Float. Essential. See Object documentation
- 	whatIsAPrimitive."
- 
- 	<primitive: 44>
- 	^ aNumber adaptToFloat: self andCompare: #>!

Item was removed:
- ----- Method: BoxedFloat64>>>= (in category 'comparing') -----
- >= aNumber 
- 	"Primitive. Compare the receiver with the argument and return true
- 	if the receiver is greater than or equal to the argument. Otherwise return
- 	false. Fail if the argument is not a Float. Optional. See Object documentation 
- 	whatIsAPrimitive. "
- 
- 	<primitive: 46>
- 	^ aNumber adaptToFloat: self andCompare: #>=!

Item was removed:
- ----- Method: BoxedFloat64>>arcTan (in category 'mathematical functions') -----
- arcTan
- 	"Answer the angle in radians.
- 	 Optional. See Object documentation whatIsAPrimitive."
- 
- 	| theta eps step sinTheta cosTheta |
- 	<primitive: 57>
- 
- 	"Newton-Raphson"
- 	self < 0.0 ifTrue: [ ^ 0.0 - (0.0 - self) arcTan ].
- 
- 	"first guess"
- 	theta := (self * Halfpi) / (self + 1.0).
- 
- 	"iterate"
- 	eps := Halfpi * Epsilon.
- 	step := theta.
- 	[(step * step) > eps] whileTrue: [
- 		sinTheta := theta sin.
- 		cosTheta := theta cos.
- 		step := (sinTheta * cosTheta) - (self * cosTheta * cosTheta).
- 		theta := theta - step].
- 	^ theta!

Item was removed:
- ----- Method: BoxedFloat64>>exp (in category 'mathematical functions') -----
- exp
- 	"Answer E raised to the receiver power.
- 	 Optional. See Object documentation whatIsAPrimitive." 
- 
- 	| base fract correction delta div |
- 	<primitive: 59>
- 
- 	"Taylor series"
- 	"check the special cases"
- 	self < 0.0 ifTrue: [^ (self negated exp) reciprocal].
- 	self = 0.0 ifTrue: [^ 1].
- 	self abs > MaxValLn ifTrue: [self error: 'exp overflow'].
- 
- 	"get first approximation by raising e to integer power"
- 	base := E raisedToInteger: (self truncated).
- 
- 	"now compute the correction with a short Taylor series"
- 	"fract will be 0..1, so correction will be 1..E"
- 	"in the worst case, convergance time is logarithmic with 1/Epsilon"
- 	fract := self fractionPart.
- 	fract = 0.0 ifTrue: [ ^ base ].  "no correction required"
- 
- 	correction := 1.0 + fract.
- 	delta := fract * fract / 2.0.
- 	div := 2.0.
- 	[delta > Epsilon] whileTrue: [
- 		correction := correction + delta.
- 		div := div + 1.0.
- 		delta := delta * fract / div].
- 	correction := correction + delta.
- 	^ base * correction!

Item was removed:
- ----- Method: BoxedFloat64>>exponent (in category 'truncation and round off') -----
- exponent
- 	"Primitive. Consider the receiver to be represented as a power of two
- 	multiplied by a mantissa (between one and two). Answer with the
- 	SmallInteger to whose power two is raised. Optional. See Object
- 	documentation whatIsAPrimitive."
- 
- 	<primitive: 53>
- 	^self exponentFromBitPattern!

Item was removed:
- ----- Method: BoxedFloat64>>fractionPart (in category 'truncation and round off') -----
- fractionPart
- 	"Primitive. Answer a Float whose value is the difference between the 
- 	receiver and the receiver's asInteger value. Optional. See Object 
- 	documentation whatIsAPrimitive."
- 
- 	<primitive: 52>
- 	^self - self truncated asFloat!

Item was removed:
- ----- Method: BoxedFloat64>>ln (in category 'mathematical functions') -----
- ln
- 	"Answer the natural logarithm of the receiver.
- 	 Optional. See Object documentation whatIsAPrimitive."
- 
- 	| expt n mant x div pow delta sum eps |
- 	<primitive: 58>
- 
- 	"Taylor series"
- 	self <= 0.0 ifTrue: [DomainError signal: 'ln is only defined for x > 0.0'].
- 
- 	"get a rough estimate from binary exponent"
- 	expt := self exponent.
- 	n := Ln2 * expt.
- 	mant := self timesTwoPower: 0 - expt.
- 
- 	"compute fine correction from mantinssa in Taylor series"
- 	"mant is in the range [0..2]"
- 	"we unroll the loop to avoid use of abs"
- 	x := mant - 1.0.
- 	div := 1.0.
- 	pow := delta := sum := x.
- 	x := x negated.  "x <= 0"
- 	eps := Epsilon * (n abs + 1.0).
- 	[delta > eps] whileTrue: [
- 		"pass one: delta is positive"
- 		div := div + 1.0.
- 		pow := pow * x.
- 		delta := pow / div.
- 		sum := sum + delta.
- 		"pass two: delta is negative"
- 		div := div + 1.0.
- 		pow := pow * x.
- 		delta := pow / div.
- 		sum := sum + delta].
- 
- 	^ n + sum
- 
- 	"2.718284 ln 1.0"!

Item was removed:
- ----- Method: BoxedFloat64>>sin (in category 'mathematical functions') -----
- sin
- 	"Answer the sine of the receiver taken as an angle in radians.
- 	 Optional. See Object documentation whatIsAPrimitive."
- 
- 	| sum delta self2 i |
- 	<primitive: 56>
- 
- 	"Taylor series"
- 	"normalize to the range [0..Pi/2]"
- 	self < 0.0 ifTrue: [^ (0.0 - ((0.0 - self) sin))].
- 	self > Twopi ifTrue: [^ (self \\ Twopi) sin].
- 	self > Pi ifTrue: [^ (0.0 - (self - Pi) sin)].
- 	self > Halfpi ifTrue: [^ (Pi - self) sin].
- 
- 	"unroll loop to avoid use of abs"
- 	sum := delta := self.
- 	self2 := 0.0 - (self * self).
- 	i := 2.0.
- 	[delta > Epsilon] whileTrue: [
- 		"once"
- 		delta := (delta * self2) / (i * (i + 1.0)).
- 		i := i + 2.0.
- 		sum := sum + delta.
- 		"twice"
- 		delta := (delta * self2) / (i * (i + 1.0)).
- 		i := i + 2.0.
- 		sum := sum + delta].
- 	^ sum!

Item was removed:
- ----- Method: BoxedFloat64>>sqrt (in category 'mathematical functions') -----
- sqrt
- 	"Answer the square root of the receiver. 
- 	 Optional. See Object documentation whatIsAPrimitive."
- 	<primitive: 55>
- 	^super sqrt!

Item was removed:
- ----- Method: BoxedFloat64>>timesTwoPower: (in category 'mathematical functions') -----
- timesTwoPower: anInteger 
- 	"Primitive. Answer with the receiver multiplied by 2.0 raised
- 	to the power of the argument.
- 	Optional. See Object documentation whatIsAPrimitive."
- 
- 	<primitive: 54>
- 	^super timesTwoPower: anInteger!

Item was removed:
- ----- Method: BoxedFloat64>>truncated (in category 'truncation and round off') -----
- truncated
- 	"Answer with a SmallInteger equal to the value of the receiver without 
- 	its fractional part. The primitive fails if the truncated value cannot be 
- 	represented as a SmallInteger. In that case, the code below will compute 
- 	a LargeInteger truncated value.
- 	Essential. See Object documentation whatIsAPrimitive. "
- 
- 	<primitive: 51>
- 	self isFinite ifFalse: [self error: 'Cannot truncate this number'].
- 	self abs <  4.503599627370496e15
- 			"Float maxExactInteger/2 =  (1.0 timesTwoPower: Float precision - 1)"
- 			"Every Float bigger than or equal to that has ulp >= 1, thus no fractionPart"
- 		ifTrue: ["Fastest way when it may not be an integer"
- 				"This branch is unreachable in 64 bits image"
- 				| di df q r |
- 				di := 1 + (SmallInteger maxVal bitShift: -1).
- 				df := di asFloat.
- 				q := self quo: df.
- 				r := self - (q asFloat * df).
- 				^q * di + r truncated]
- 		ifFalse: [^ self asTrueFraction.  "Extract all bits of the significand and shift if necessary"]
- 
- 		
- 
- 		!

Item was removed:
- ----- Method: BoxedFloat64>>~= (in category 'comparing') -----
- ~= aNumber 
- 	"Primitive. Compare the receiver with the argument and return true
- 	if the receiver is not equal to the argument. Otherwise return false.
- 	Fail if the argument is not a Float. Optional. See Object documentation
- 	whatIsAPrimitive."
- 
- 	<primitive: 48>
- 	^super ~= aNumber!

Item was removed:
- Error subclass: #BrokenPromise
- 	instanceVariableNames: 'promise'
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'Kernel-Exceptions'!
- 
- !BrokenPromise commentStamp: 'tonyg 2/17/2017 13:53' prior: 0!
- I am signalled when, during a Promise>>wait, the promise is rejected.
- 	promise:		the promise itself.
- !

Item was removed:
- ----- Method: BrokenPromise>>defaultAction (in category 'as yet unclassified') -----
- defaultAction
- 	self messageText: 'Promise was rejected'.
- 	^super defaultAction!

Item was removed:
- ----- Method: BrokenPromise>>isResumable (in category 'as yet unclassified') -----
- isResumable
- 	^ true!

Item was removed:
- ----- Method: BrokenPromise>>promise (in category 'as yet unclassified') -----
- promise
- 	^ promise!

Item was removed:
- ----- Method: BrokenPromise>>promise: (in category 'as yet unclassified') -----
- promise: aPromise
- 	promise := aPromise!

Item was removed:
- Object subclass: #Categorizer
- 	instanceVariableNames: 'categoryArray categoryStops elementArray'
- 	classVariableNames: 'Default NullCategory'
- 	poolDictionaries: ''
- 	category: 'Kernel-Classes'!
- 
- !Categorizer commentStamp: 'nice 5/6/2010 21:10' prior: 0!
- A Categorizer goal is to classify the elements of a collection into categories.
- It is typically used to classify methods of class into categories (also named protocols in this case).
- 
- Instance Variables
- 	categoryArray:		<SequenceableCollection of: Object>
- 	categoryStops:		<SequenceableCollection of: Integer>
- 	elementArray:		<SequenceableCollection of: Object>
- 
- categoryArray
- 	- holds the list of categories.
- 	A category could be any Object but is generally a String or Symbol.
- 	Categories should be unique (categoryArray asSet size = categoryArray size)
- 
- categoryStops
- 	- holds the index of last element belonging to each category.
- 	There should be a category stop for each category (categoryStops size = categoryArray size).
- 	The categoryStops should be sorted (categoryStops sorted = categoryStops).
- 	A category stop equal to its predecessor (= 0 for the first category stop) denotes an empty category.
- 
- elementArray
- 	- holds the elements to be classified. The elements are sorted by category.
- 
- Class variables
- 	Default is the default category used to classify yet unclassified methods of a class
- 	NullCategory is the category to be displayed in a Browser for a class having no method.
- !

Item was removed:
- ----- Method: Categorizer class>>allCategory (in category 'class initialization') -----
- allCategory
- 	"Return a symbol that represents the virtual all methods category."
- 
- 	^#'-- all --'!

Item was removed:
- ----- Method: Categorizer class>>default (in category 'class initialization') -----
- default 
- 	^ Default!

Item was removed:
- ----- Method: Categorizer class>>defaultList: (in category 'instance creation') -----
- defaultList: aSortedCollection 
- 	"Answer an instance of me with initial elements from the argument, 
- 	aSortedCollection."
- 
- 	^self new setDefaultList: aSortedCollection!

Item was removed:
- ----- Method: Categorizer class>>documentation (in category 'documentation') -----
- documentation
- 	"Instances consist of an Array of category names (categoryArray), each of 
- 	which refers to an Array of elements (elementArray). This association is 
- 	made through an Array of stop indices (categoryStops), each of which is 
- 	the index in elementArray of the last element (if any) of the 
- 	corresponding category. For example: categories := Array with: 'firstCat' 
- 	with: 'secondCat' with: 'thirdCat'. stops := Array with: 1 with: 4 with: 4. 
- 	elements := Array with: #a with: #b with: #c with: #d. This means that 
- 	category firstCat has only #a, secondCat has #b, #c, and #d, and 
- 	thirdCat has no elements. This means that stops at: stops size must be the 
- 	same as elements size." !

Item was removed:
- ----- Method: Categorizer class>>initialize (in category 'class initialization') -----
- initialize
- 	"	self  initialize	"
- 	
- 	Default := 'as yet unclassified' asSymbol.
- 	NullCategory := 'no messages' asSymbol.!

Item was removed:
- ----- Method: Categorizer class>>nullCategory (in category 'class initialization') -----
- nullCategory
- 	^ NullCategory!

Item was removed:
- ----- Method: Categorizer class>>sortAllCategories (in category 'housekeeping') -----
- sortAllCategories
- 
- 	self allSubInstances
- 		do: [:x | x sortCategories]!

Item was removed:
- ----- Method: Categorizer>>addCategory: (in category 'accessing') -----
- addCategory: newCategory
- 	^ self addCategory: newCategory before: nil !

Item was removed:
- ----- Method: Categorizer>>addCategory:before: (in category 'accessing') -----
- addCategory: catString before: nextCategory
- 	"Add a new category named heading.
- 	If default category exists and is empty, remove it.
- 	If nextCategory is nil, then add the new one at the end,
- 	otherwise, insert it before nextCategory."
- 	| index newCategory |
- 	newCategory := catString asSymbol.
- 	(categoryArray indexOf: newCategory) > 0
- 		ifTrue: [^self].	"heading already exists, so done"
- 	(self isSpecialCategoryName: newCategory)
- 		ifTrue: [^self inform: 'This category name is system reserved' translated].
- 	index := categoryArray indexOf: nextCategory
- 		ifAbsent: [categoryArray size + 1].
- 	categoryArray := categoryArray
- 		copyReplaceFrom: index
- 		to: index-1
- 		with: (Array with: newCategory).
- 	categoryStops := categoryStops
- 		copyReplaceFrom: index
- 		to: index-1
- 		with: (Array with: (index = 1
- 				ifTrue: [0]
- 				ifFalse: [categoryStops at: index-1])).
- 	"remove empty default category"
- 	(newCategory ~= Default
- 			and: [(self listAtCategoryNamed: Default) isEmpty])
- 		ifTrue: [self removeCategory: Default]!

Item was removed:
- ----- Method: Categorizer>>allElements (in category 'accessing') -----
- allElements
- 
- 	^ elementArray copy!

Item was removed:
- ----- Method: Categorizer>>allMethodSelectors (in category 'accessing') -----
- allMethodSelectors
- 	"give a list of all method selectors."
- 
- 	^ self allElements sort!

Item was removed:
- ----- Method: Categorizer>>assertInvariant (in category 'private') -----
- assertInvariant
- 	self assert: (elementArray size = categoryStops last)!

Item was removed:
- ----- Method: Categorizer>>basicRemoveElement: (in category 'private') -----
- basicRemoveElement: element 
- 	"Remove the selector, element, from all categories."
- 	| categoryIndex elementIndex nextStop newElements |
- 	categoryIndex := 1.
- 	elementIndex := 0.
- 	nextStop := 0.
- 	"nextStop keeps track of the stops in the new element array"
- 	newElements := WriteStream on: (Array new: elementArray size).
- 	[(elementIndex := elementIndex + 1) <= elementArray size]
- 		whileTrue: 
- 			[[elementIndex > (categoryStops at: categoryIndex)]
- 				whileTrue: 
- 					[categoryStops at: categoryIndex put: nextStop.
- 					categoryIndex := categoryIndex + 1].
- 			(elementArray at: elementIndex) = element
- 				ifFalse: 
- 					[nextStop := nextStop + 1.
- 					newElements nextPut: (elementArray at: elementIndex)]].
- 	[categoryIndex <= categoryStops size]
- 		whileTrue: 
- 			[categoryStops at: categoryIndex put: nextStop.
- 			categoryIndex := categoryIndex + 1].
- 	elementArray := newElements contents.
- 	self assertInvariant.!

Item was removed:
- ----- Method: Categorizer>>categories (in category 'accessing') -----
- categories
- 	"Answer an Array of categories (names)."
- 	categoryArray isNil ifTrue: [^ nil].
- 	self isEmpty ifTrue: [^Array with: NullCategory].
- 	^categoryArray!

Item was removed:
- ----- Method: Categorizer>>categories: (in category 'accessing') -----
- categories: anArray
- 	"Reorder my categories to be in order of the argument, anArray. If the 
- 	resulting organization does not include all elements, then give an error."
- 
- 	| newCategories newStops newElements catName list runningTotal | 
- 	
- 	anArray size < 2 ifTrue: [ ^ self ].
- 	
- 	newCategories := Array new: anArray size.
- 	newStops := Array new: anArray size.
- 	newElements := Array new: 0.
- 	runningTotal := 0.
- 	1 to: anArray size do:
- 		[:i |
- 		catName := (anArray at: i) asSymbol.
- 		list := self listAtCategoryNamed: catName.
- 				newElements := newElements, list.
- 				newCategories at: i put: catName.
- 				newStops at: i put: (runningTotal := runningTotal + list size)].
- 	elementArray do:
- 		[:element | "check to be sure all elements are included"
- 		(newElements includes: element)
- 			ifFalse: [^self error: 'New categories must match old ones']].
- 	"Everything is good, now update my three arrays."
- 	categoryArray := newCategories.
- 	categoryStops := newStops.
- 	elementArray := newElements!

Item was removed:
- ----- Method: Categorizer>>categoryOfElement: (in category 'accessing') -----
- categoryOfElement: element 
- 	"Answer the category associated with the argument, element."
- 
- 	| index |
- 	index := self numberOfCategoryOfElement: element.
- 	index = 0
- 		ifTrue: [^nil]
- 		ifFalse: [^categoryArray at: index]!

Item was removed:
- ----- Method: Categorizer>>changeFromCategorySpecs: (in category 'accessing') -----
- changeFromCategorySpecs: categorySpecs 
- 	"Tokens is an array of categorySpecs as scanned from a browser 'reorganize' pane, or built up by some other process, such as a scan of an environment."
- 
- 	| newCategories newStops cc currentStop oldElements newElements |
- 	oldElements := elementArray asSet.
- 	newCategories := Array new: categorySpecs size.
- 	newStops := Array new: categorySpecs size.
- 	currentStop := 0.
- 	newElements := WriteStream on: (Array new: 16).
- 	1 to: categorySpecs size do: 
- 		[:i | | catSpec |
- 		catSpec := categorySpecs at: i.
- 		newCategories at: i put: catSpec first asSymbol.
- 		catSpec allButFirst
- 			replace: [ :each | 
- 				each isSymbol
- 					ifTrue: [each]
- 					ifFalse: [each printString asSymbol ] ];
- 			sort;
- 			do: [ :elem |
- 				(oldElements remove: elem ifAbsent: nil) ifNotNil: [
- 					newElements nextPut: elem.
- 					currentStop := currentStop+1]].
- 		newStops at: i put: currentStop].
- 
- 	"Ignore extra elements but don't lose any existing elements!!"
- 	oldElements := oldElements collect:
- 		[:elem | Array with: (self categoryOfElement: elem) with: elem].
- 	newElements := newElements contents.
- 	categoryArray := newCategories.
- 	(cc := categoryArray asSet) size = categoryArray size ifFalse: ["has duplicate element"
- 		| uniqueElements |
- 		uniqueElements := cc copy.
- 		categoryArray withIndexDo: [ :dup :ii |
- 			uniqueElements remove: dup ifAbsent: [ "real duplicate"
- 				| dup2 num | 
- 				num := 2.
- 				[dup2 := (dup,' #', num printString) asSymbol.  cc includes: dup2] whileTrue: [num := num + 1].
- 				cc add: dup2.
- 				categoryArray at: ii put: dup2 ] ] ].
- 	categoryStops := newStops.
- 	elementArray := newElements.
- 	oldElements do: [:pair | self classify: pair last under: pair first].!

Item was removed:
- ----- Method: Categorizer>>changeFromString: (in category 'accessing') -----
- changeFromString: aString 
- 	"Parse the argument, aString, and make this be the receiver's structure."
- 
- 	| categorySpecs |
- 	categorySpecs := Scanner new scanTokens: aString.
- 	"If nothing was scanned and I had no elements before, then default me"
- 	(categorySpecs isEmpty and: [elementArray isEmpty])
- 		ifTrue: [^ self setDefaultList: Array new].
- 
- 	^ self changeFromCategorySpecs: categorySpecs!

Item was removed:
- ----- Method: Categorizer>>classify:under: (in category 'classifying') -----
- classify: element under: heading 
- 	self classify: element under: heading suppressIfDefault: true!

Item was removed:
- ----- Method: Categorizer>>classify:under:suppressIfDefault: (in category 'classifying') -----
- classify: element under: heading suppressIfDefault: aBoolean
- 	"Store the argument, element, in the category named heading.   If aBoolean is true, then invoke special logic such that the classification is NOT done if the new heading is the Default and the element already had a non-Default classification -- useful for filein"
- 
- 	| catName catIndex elemIndex realHeading |
- 	realHeading := (heading isNil or: [self isSpecialCategoryName: heading])
- 		ifTrue: [Default]
- 		ifFalse: [heading asSymbol].
- 	(catName := self categoryOfElement: element) = realHeading
- 		ifTrue: [^ self].  "done if already under that category"
- 
- 	catName ifNotNil: [
- 		(aBoolean and: [realHeading = Default])
- 				ifTrue: [^ self].	  "return if non-Default category already assigned in memory"
- 		self basicRemoveElement: element].	"remove if in another category"
- 
- 	(categoryArray indexOf: realHeading) = 0 ifTrue: [self addCategory: realHeading].
- 
- 	catIndex := categoryArray indexOf: realHeading.
- 	elemIndex := 
- 		catIndex > 1
- 			ifTrue: [categoryStops at: catIndex - 1]
- 			ifFalse: [0].
- 	[(elemIndex := elemIndex + 1) <= (categoryStops at: catIndex) 
- 		and: [element >= (elementArray at: elemIndex)]] whileTrue.
- 
- 	"elemIndex is now the index for inserting the element. Do the insertion before it."
- 	elementArray := elementArray copyReplaceFrom: elemIndex to: elemIndex-1
- 						with: (Array with: element).
- 
- 	"add one to stops for this and later categories"
- 	catIndex to: categoryArray size do: 
- 		[:i | categoryStops at: i put: (categoryStops at: i) + 1].
- 
- 	((categoryArray includes: Default)
- 		and: [(self listAtCategoryNamed: Default) size = 0]) ifTrue: [self removeCategory: Default].
- 		
- 	self assertInvariant.!

Item was removed:
- ----- Method: Categorizer>>classifyAll:under: (in category 'classifying') -----
- classifyAll: aCollection under: heading
- 
- 	aCollection do:
- 		[:element | self classify: element under: heading]!

Item was removed:
- ----- Method: Categorizer>>elementArray (in category 'private') -----
- elementArray
- 
- 	^ elementArray!

Item was removed:
- ----- Method: Categorizer>>elementCategoryDict (in category 'accessing') -----
- elementCategoryDict
- 	| dict firstIndex lastIndex |
- 	elementArray isNil ifTrue: [^ nil].
- 	dict := Dictionary new: elementArray size.
- 	1to: categoryStops size do: [:cat |
- 		firstIndex := self firstIndexOfCategoryNumber: cat.
- 		lastIndex := self lastIndexOfCategoryNumber: cat.
- 		firstIndex to: lastIndex do: [:el |
- 			dict at: (elementArray at: el) put: (categoryArray at: cat)].
- 	].
- 	^ dict.!

Item was removed:
- ----- Method: Categorizer>>firstIndexOfCategoryNumber: (in category 'private') -----
- firstIndexOfCategoryNumber: anInteger
- 	anInteger < 1 ifTrue: [^ nil].
- 	^ (anInteger > 1
- 			ifTrue: [(categoryStops at: anInteger - 1) + 1]
- 			ifFalse: [1]).!

Item was removed:
- ----- Method: Categorizer>>isEmpty (in category 'testing') -----
- isEmpty
- 
- 	^ (categoryArray size = 1 
- 		and: [categoryArray first = Default & (elementArray size = 0)])!

Item was removed:
- ----- Method: Categorizer>>isEmptyCategoryNamed: (in category 'accessing') -----
- isEmptyCategoryNamed: categoryName
- 	| i |
- 	i := categoryArray indexOf: categoryName ifAbsent: [^false].
- 	^self isEmptyCategoryNumber: i!

Item was removed:
- ----- Method: Categorizer>>isEmptyCategoryNumber: (in category 'accessing') -----
- isEmptyCategoryNumber: anInteger
- 
- 	| firstIndex lastIndex |
- 	(anInteger < 1 or: [anInteger > categoryStops size])
- 		ifTrue: [^ true].
- 	firstIndex := self firstIndexOfCategoryNumber: anInteger.
- 	lastIndex :=  self lastIndexOfCategoryNumber: anInteger.
- 	^ firstIndex > lastIndex!

Item was removed:
- ----- Method: Categorizer>>isSpecialCategoryName: (in category 'testing') -----
- isSpecialCategoryName: aName
- 
- 	^ aName = self class nullCategory
- 		or: [aName = self class allCategory]!

Item was removed:
- ----- Method: Categorizer>>lastIndexOfCategoryNumber: (in category 'private') -----
- lastIndexOfCategoryNumber: anInteger
- 	anInteger > categoryStops size ifTrue: [^ nil].
- 	^ categoryStops at: anInteger!

Item was removed:
- ----- Method: Categorizer>>listAtCategoryNamed: (in category 'accessing') -----
- listAtCategoryNamed: categoryName
- 	"Answer the array of elements associated with the name, categoryName."
- 
- 	| i |
- 	i := categoryArray indexOf: categoryName ifAbsent: [^Array new].
- 	^self listAtCategoryNumber: i!

Item was removed:
- ----- Method: Categorizer>>listAtCategoryNumber: (in category 'accessing') -----
- listAtCategoryNumber: anInteger 
- 	"Answer the array of elements stored at the position indexed by anInteger.  Answer nil if anInteger is larger than the number of categories."
- 
- 	| firstIndex lastIndex |
- 	(anInteger < 1 or: [anInteger > categoryStops size])
- 		ifTrue: [^ nil].
- 	firstIndex := self firstIndexOfCategoryNumber: anInteger.
- 	lastIndex :=  self lastIndexOfCategoryNumber: anInteger.
- 	^elementArray copyFrom: firstIndex to: lastIndex!

Item was removed:
- ----- Method: Categorizer>>numberOfCategoryOfElement: (in category 'accessing') -----
- numberOfCategoryOfElement: element 
- 	"Answer the index of the category with which the argument, element, is 
- 	associated."
- 
- 	| categoryIndex elementIndex elementArraySize |
- 	categoryIndex := 1.
- 	elementIndex := 0.
- 	elementArraySize := elementArray size.
- 	[(elementIndex := elementIndex + 1) <= elementArraySize]
- 		whileTrue: 
- 			["point to correct category"
- 			[elementIndex > (categoryStops at: categoryIndex)]
- 				whileTrue: [categoryIndex := categoryIndex + 1].
- 			"see if this is element"
- 			element = (elementArray at: elementIndex) ifTrue: [^categoryIndex]].
- 	^0!

Item was removed:
- ----- Method: Categorizer>>printOn: (in category 'printing') -----
- printOn: aStream 
- 	"Refer to the comment in Object|printOn:."
- 
- 	| elementIndex |
- 	elementIndex := 1.
- 	1 to: categoryArray size do: 
- 		[:i | 
- 		aStream nextPut: $(.
- 		(categoryArray at: i) asString printOn: aStream.
- 		[elementIndex <= (categoryStops at: i)]
- 			whileTrue: 
- 				[aStream space; nextPutAll: (elementArray at: elementIndex).
- 				elementIndex := elementIndex + 1].
- 		aStream nextPut: $); cr]!

Item was removed:
- ----- Method: Categorizer>>printString (in category 'printing') -----
- printString
- 	^self fullPrintString!

Item was removed:
- ----- Method: Categorizer>>removeCategory: (in category 'accessing') -----
- removeCategory: cat 
- 	"Remove the category named, cat. Create an error notificiation if the 
- 	category has any elements in it."
- 
- 	| index lastStop |
- 	index := categoryArray indexOf: cat ifAbsent: [^self].
- 	lastStop := 
- 		index = 1
- 			ifTrue: [0]
- 			ifFalse: [categoryStops at: index - 1].
- 	(categoryStops at: index) - lastStop > 0 
- 		ifTrue: [^self error: 'cannot remove non-empty category'].
- 	categoryArray := categoryArray copyReplaceFrom: index to: index with: Array new.
- 	categoryStops := categoryStops copyReplaceFrom: index to: index with: Array new.
- 	categoryArray size = 0
- 		ifTrue:
- 			[categoryArray := Array with: Default.
- 			categoryStops := Array with: 0]
- !

Item was removed:
- ----- Method: Categorizer>>removeElement: (in category 'accessing') -----
- removeElement: element 
- 	^ self basicRemoveElement: element!

Item was removed:
- ----- Method: Categorizer>>removeEmptyCategories (in category 'accessing') -----
- removeEmptyCategories
- 	"Remove empty categories."
- 
- 	| categoryIndex currentStop keptCategories keptStops |
- 	keptCategories := WriteStream on: (Array new: 16).
- 	keptStops := WriteStream on: (Array new: 16).
- 	currentStop := categoryIndex := 0.
- 	[(categoryIndex := categoryIndex + 1) <= categoryArray size]
- 		whileTrue: 
- 			[(categoryStops at: categoryIndex) > currentStop
- 				ifTrue: 
- 					[keptCategories nextPut: (categoryArray at: categoryIndex).
- 					keptStops nextPut: (currentStop := categoryStops at: categoryIndex)]].
- 	categoryArray := keptCategories contents.
- 	categoryStops := keptStops contents.
- 	categoryArray size = 0
- 		ifTrue:
- 			[categoryArray := Array with: Default.
- 			categoryStops := Array with: 0]
- 
- 	"ClassOrganizer allInstancesDo: [:co | co removeEmptyCategories]."!

Item was removed:
- ----- Method: Categorizer>>renameCategory:toBe: (in category 'accessing') -----
- renameCategory: oldCatString toBe: newCatString
- 	"Rename a category. No action if new name already exists, or if old name does not exist."
- 	| index oldCategory newCategory |
- 	oldCategory := oldCatString asSymbol.
- 	newCategory := newCatString asSymbol.
- 	(categoryArray indexOf: newCategory) > 0
- 		ifTrue: [^ self].	"new name exists, so no action"
- 	(index := categoryArray indexOf: oldCategory) = 0
- 		ifTrue: [^ self].	"old name not found, so no action"
- 	categoryArray := categoryArray copy.  "need to change identity so smart list update will notice the change"
- 	categoryArray at: index put: newCategory!

Item was removed:
- ----- Method: Categorizer>>scanFrom: (in category 'fileIn/Out') -----
- scanFrom: aStream
- 	"Reads in the organization from the next chunk on aStream.
- 	Categories or elements not found in the definition are not affected.
- 	New elements are ignored."
- 
- 	self changeFromString: aStream nextChunk.
- 	aStream skipStyleChunk.!

Item was removed:
- ----- Method: Categorizer>>scanFrom:environment: (in category 'fileIn/Out') -----
- scanFrom: aStream environment: anEnvironment
- 	^ self scanFrom: aStream!

Item was removed:
- ----- Method: Categorizer>>setDefaultList: (in category 'private') -----
- setDefaultList: aSortedCollection
- 
- 	categoryArray := Array with: Default.
- 	categoryStops := Array with: aSortedCollection size.
- 	elementArray := aSortedCollection asArray!

Item was removed:
- ----- Method: Categorizer>>sortCategories (in category 'accessing') -----
- sortCategories
- 	| privateCategories publicCategories newCategories |
- 
- 	privateCategories := self categories select:
- 		[:one | (one findString: 'private' startingAt: 1 caseSensitive: false) = 1].
- 	publicCategories := self categories copyWithoutAll: privateCategories.
- 	newCategories := publicCategories asArray sort , privateCategories asArray sort.
- 	self categories: newCategories!

Item was removed:
- ClassDescription subclass: #Class
- 	instanceVariableNames: 'subclasses name classPool sharedPools environment category'
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'Kernel-Classes'!
- 
- !Class commentStamp: '<historical>' prior: 0!
- I add a number of facilities to those in ClassDescription:
- 	A set of all my subclasses (defined in ClassDescription, but only used here and below)
- 	A name by which I can be found in a SystemDictionary
- 	A classPool for class variables shared between this class and its metaclass
- 	A list of sharedPools which probably should be supplanted by some better mechanism.
- 
- My instances describe the representation and behavior of objects. I add more comprehensive programming support facilities to the basic attributes of Behavior and the descriptive facilities of ClassDescription.
- 
- The slot 'subclasses' is a redundant structure.  It is never used during execution, but is used by the development system to simplify or speed certain operations.  !

Item was removed:
- ----- Method: Class class>>fileOutPool: (in category 'fileIn/Out') -----
- fileOutPool: aString
- 	"file out the global pool named aString"
- 	
- 	| internalStream |
- 	internalStream := WriteStream on: (String new: 1000).
- 	self new fileOutPool: (self environment at: aString asSymbol) onFileStream: internalStream.
- 
- 	FileStream writeSourceCodeFrom: internalStream baseName: aString isSt: true useHtml: false.!

Item was removed:
- ----- Method: Class class>>rootsOfTheWorld (in category 'inquiries') -----
- rootsOfTheWorld
- 	"return a collection of classes which have a nil superclass"
- 	^Smalltalk globals rootClasses!

Item was removed:
- ----- Method: Class class>>template: (in category 'instance creation') -----
- template: aSystemCategoryName 
- 	"Answer an expression that can be edited and evaluated in order to define a new class."
- 
- 	^ self templateForSubclassOf: Object name category: aSystemCategoryName !

Item was removed:
- ----- Method: Class class>>templateForSubclassOf:category: (in category 'instance creation') -----
- templateForSubclassOf: priorClassName category: systemCategoryName 
- 	"Answer an expression that can be edited and evaluated in order to define a new class, given that the class previously looked at was as given"
- 
- 	^priorClassName asString, ' subclass: #NameOfSubclass
- 	instanceVariableNames: ''''
- 	classVariableNames: ''''
- 	poolDictionaries: ''''
- 	category: ''' , systemCategoryName asString , ''''!

Item was removed:
- ----- Method: Class>>addClassVarName: (in category 'class variables') -----
- addClassVarName: aString 
- 	"Add the argument, aString, as a class variable of the receiver.
- 	Signal an error if the first character of aString is not capitalized,
- 	or if it is already a variable named in the class."
- 	| symbol oldState |
- 	oldState := self copy.
- 	aString first canBeGlobalVarInitial
- 		ifFalse: [^self error: aString, ' class variable name should be capitalized; proceed to include anyway.'].
- 	symbol := aString asSymbol.
- 	self withAllSubclasses do: 
- 		[:subclass | 
- 		(self canFindWithoutEnvironment: symbol) ifTrue: [
- 			(DuplicateVariableError new)
- 				superclass: superclass; "fake!!!!!!"
- 				variable: aString;
- 				signal: aString, ' is already defined']].
- 	classPool == nil ifTrue: [classPool := Dictionary new].
- 	(classPool includesKey: symbol) ifFalse: 
- 		["Pick up any refs in Undeclared"
- 		classPool declare: symbol from: self environment undeclared.
- 		SystemChangeNotifier uniqueInstance classDefinitionChangedFrom: oldState to: self]!

Item was removed:
- ----- Method: Class>>addInstVarName: (in category 'instance variables') -----
- addInstVarName: aString
- 	"Add the argument, aString, as one of the receiver's instance variables."
- 	^(ClassBuilder new)
- 		name: self name
- 		inEnvironment: self environment
- 		subclassOf: self superclass
- 		type: self typeOfClass
- 		instanceVariableNames: self instanceVariablesString, ' ', aString
- 		classVariableNames: self classVariablesString
- 		poolDictionaries: self sharedPoolsString
- 		category: self category
- !

Item was removed:
- ----- Method: Class>>addSharedPool: (in category 'pool variables') -----
- addSharedPool: aSharedPool 
- 	"Add the argument, aSharedPool, as one of the receiver's shared pools. 
- 	Create an error if the shared pool is already one of the pools.
- 	This method will work with shared pools that are plain Dictionaries or thenewer SharedPool subclasses"
- 
- 	(self sharedPools includes: aSharedPool)
- 		ifTrue: [^self error: 'This is already in my shared pool list'].
- 	sharedPools == nil
- 		ifTrue: [sharedPools := OrderedCollection with: aSharedPool]
- 		ifFalse: [sharedPools add: aSharedPool]!

Item was removed:
- ----- Method: Class>>addSubclass: (in category 'accessing class hierarchy') -----
- addSubclass: aSubclass 
- 	"Make the argument, aSubclass, be one of the subclasses of the receiver. 
- 	Create an error notification if the argument's superclass is not the receiver."
- 	
- 	aSubclass superclass ~~ self 
- 		ifTrue: [^self error: aSubclass name , ' is not my subclass'].
- 	subclasses == nil
- 		ifTrue:	[subclasses := Array with: aSubclass.
- 				^self].
- 	subclasses do:[:cl| cl == aSubclass ifTrue:[^self]]. "Already my subclass"
- 	subclasses := subclasses copyWith: aSubclass.!

Item was removed:
- ----- Method: Class>>allClassVarNames (in category 'class variables') -----
- allClassVarNames
- 	"Answer a Set of the names of the receiver's class variables, including those defined in the superclasses of the receiver."
- 	| aSet |
- 	^ self superclass == nil
- 		ifTrue: 
- 			[self classVarNames asSet]  "This is the keys so it is a new Set."
- 		ifFalse: 
- 			[aSet := self superclass allClassVarNames.
- 			aSet addAll: self classVarNames.
- 			aSet]!

Item was removed:
- ----- Method: Class>>allSharedPools (in category 'pool variables') -----
- allSharedPools
- 	"Answer a Set of the pools the receiver shares, including those defined  
- 	in the superclasses of the receiver."
- 	| aSet | 
- 	^self superclass == nil
- 		ifTrue: [self sharedPools copy]
- 		ifFalse: [aSet := self superclass allSharedPools.
- 			aSet addAll: self sharedPools.
- 			aSet]!

Item was removed:
- ----- Method: Class>>binding (in category 'compiling') -----
- binding
- 	"Answer a binding for the receiver, sharing if possible"
- 	(self environment bindingOf: name ifAbsent: nil) ifNotNil:
- 		[:bindingOrNil|
- 		bindingOrNil value == self ifTrue:
- 			[^bindingOrNil]].
- 	^ClassBinding key: nil value: self!

Item was removed:
- ----- Method: Class>>bindingOf: (in category 'compiling') -----
- bindingOf: varName
- 	^ self bindingOf: varName environment: self environment!

Item was removed:
- ----- Method: Class>>bindingOf:environment: (in category 'compiling') -----
- bindingOf: varName environment: anEnvironment
- 	"Answer the binding of some variable resolved in the scope of the receiver"
- 	| aSymbol binding |
- 	aSymbol := varName asSymbol.
- 
- 	"First look in local classVar dictionary."
- 	binding := self classPool bindingOf: aSymbol.
- 	binding ifNotNil:[^binding].
- 
- 	"Next look in local shared pools."
- 	self sharedPools do:[:pool | 
- 		binding := pool bindingOf: aSymbol.
- 		binding ifNotNil:[^binding].
- 	].
- 
- 	"Next look into superclass pools"
- 	superclass ifNotNil: [^ superclass bindingOf: aSymbol environment: anEnvironment].
- 	
- 	"No more superclass... Last look in declared environment."
- 	^anEnvironment bindingOf: aSymbol
- 
- !

Item was removed:
- ----- Method: Class>>canFindWithoutEnvironment: (in category 'compiling') -----
- canFindWithoutEnvironment: varName
- 	"This method is used for analysis of system structure -- see senders."
- 	"Look up varName, in the context of the receiver. Return true if it can be found without using the declared environment."
- 
- 	"First look in classVar dictionary."
- 	(self classPool bindingOf: varName) ifNotNil:[^true].
- 
- 	"Next look in shared pools."
- 	self sharedPools do:[:pool | 
- 		(pool bindingOf: varName) ifNotNil:[^true].
- 	].
- 
- 	"Finally look higher up the superclass chain and fail at the end."
- 	superclass == nil
- 		ifTrue: [^ false]
- 		ifFalse: [^ superclass canFindWithoutEnvironment: varName].
- 
- !

Item was removed:
- ----- Method: Class>>category (in category 'organization') -----
- category
- 	"Answer the system organization category for the receiver. First check whether the
- 	category name stored in the ivar is still correct and only if this fails look it up
- 	(latter is much more expensive)"
- 
- 	category ifNotNil: [ :symbol |
- 		((self environment organization listAtCategoryNamed: symbol) includes: self name)
- 			ifTrue: [ ^symbol ] ].
- 	category := self environment organization categoryOfElement: self name.
- 	^category!

Item was removed:
- ----- Method: Class>>category: (in category 'organization') -----
- category: aString 
- 	"Categorize the receiver under the system category, aString, removing it from 
- 	any previous categorization."
- 
- 	| oldCategory |
- 	oldCategory := category.
- 	aString isString
- 		ifTrue: [
- 			category := aString asSymbol.
- 			self environment organization classify: self name under: category ]
- 		ifFalse: [self errorCategoryName]!

Item was removed:
- ----- Method: Class>>classPool (in category 'accessing') -----
- classPool
- 	"Answer the dictionary of class variables."
- 
- 	classPool == nil
- 		ifTrue: [^Dictionary new]
- 		ifFalse: [^classPool]!

Item was removed:
- ----- Method: Class>>classPool: (in category 'accessing') -----
- classPool: aDictionary
- 	classPool := aDictionary!

Item was removed:
- ----- Method: Class>>classPoolFrom: (in category 'accessing') -----
- classPoolFrom: aClass
- 	"share the classPool with aClass."
- 
- 	classPool := aClass classPool!

Item was removed:
- ----- Method: Class>>classVarNames (in category 'class variables') -----
- classVarNames
- 	"Answer a collection of the names of the class variables defined in the receiver."
- 
- 	^self classPool keys asArray sort!

Item was removed:
- ----- Method: Class>>compileAllFrom: (in category 'compiling') -----
- compileAllFrom: oldClass
- 	"Recompile all the methods in the receiver's method dictionary (not the
- 	subclasses). Also recompile the methods in the metaclass."
- 
- 	super compileAllFrom: oldClass.
- 	self class compileAllFrom: oldClass class!

Item was removed:
- ----- Method: Class>>copy (in category 'copying') -----
- copy 
- 	"Answer a copy of the receiver without a list of subclasses.
- 	 This copy is used by the ClassBuilder when mutating classes on redefinition.
- 	 (SystemNavigation new browseAllCallsOn: #copy localTo: ClassBuilder)"
- 	| newClass |
- 	newClass := self class copy new
- 		superclass: superclass
- 		methodDict: self methodDict copy
- 		format: format
- 		name: name
- 		organization: self organization copy
- 		instVarNames: instanceVariables copy
- 		classPool: classPool copy
- 		sharedPools: sharedPools copy.
- 	Class instSize+1 to: self class instSize do:
- 		[:offset | newClass instVarAt: offset put: (self instVarAt: offset)].
- 	^ newClass!

Item was removed:
- ----- Method: Class>>deactivate (in category 'initialize-release') -----
- deactivate
- 	"A remnant from the 3.3a modules work, retained . Does nothing, but may be overridden in Metaclasses."!

Item was removed:
- ----- Method: Class>>declare: (in category 'initialize-release') -----
- declare: varString 
- 	"Declare class variables common to all instances. Answer whether 
- 	recompilation is advisable."
- 
- 	| newVars conflicts |
- 	
- 	newVars := 
- 		(Scanner new scanFieldNames: varString)
- 			collect: [:x | x asSymbol].
- 	newVars do:
- 		[:var | var first canBeGlobalVarInitial
- 			ifFalse: [self error: var, ' class variable name should be capitalized; proceed to include anyway.']].
- 	conflicts := false.
- 	classPool == nil 
- 		ifFalse: [(classPool keys reject: [:x | newVars includes: x]) do: 
- 					[:var | self removeClassVarName: var]].
- 	(newVars reject: [:var | self classPool includesKey: var])
- 		do: [:var | "adding"
- 			"check if new vars defined elsewhere"
- 			(self canFindWithoutEnvironment: var) ifTrue: [
- 					(DuplicateVariableError new)
- 						superclass: superclass; "fake!!!!!!"
- 						variable: var;
- 						signal: var, ' is already defined'.
- 					conflicts := true]].
- 	newVars size > 0
- 		ifTrue: 
- 			[classPool := self classPool.
- 			"in case it was nil"
- 			newVars do: [:var | classPool declare: var from: self environment undeclared]].
- 	^conflicts!

Item was removed:
- ----- Method: Class>>ensureClassPool (in category 'class variables') -----
- ensureClassPool
- 
- 	^classPool ifNil: [classPool := Dictionary new].!

Item was removed:
- ----- Method: Class>>environment (in category 'organization') -----
- environment
- 
- 	environment == nil ifTrue: [^ super environment].
- 	^ environment!

Item was removed:
- ----- Method: Class>>environment: (in category 'organization') -----
- environment: anEnvironment
- 
- 	environment := anEnvironment!

Item was removed:
- ----- Method: Class>>ephemeronSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'subclass creation') -----
- ephemeronSubclass: t instanceVariableNames: f classVariableNames: d poolDictionaries: s category: cat 
- 	"This is the standard initialization message for creating a new class as a 
- 	subclass of an existing class (the receiver) in which the subclass is to 
- 	have ephemeron semantics, i.e. where the object will be queued for
- 	finalization when the key (first) inst var is not reachable other than through
- 	the other fields of ephemerons with unreachable keys."
- 	^ClassBuilder new
- 		superclass: self
- 		ephemeronSubclass: t
- 		instanceVariableNames: f
- 		classVariableNames: d
- 		poolDictionaries: s
- 		category: cat!

Item was removed:
- ----- Method: Class>>externalName (in category 'class name') -----
- externalName
- 	"Answer a name by which the receiver can be known."
- 
- 	^ name!

Item was removed:
- ----- Method: Class>>fileOut (in category 'fileIn/Out') -----
- fileOut
- 	"Create a file whose name is the name of the receiver with '.st' as the 
- 	extension, and file a description of the receiver onto it."
- 	^ self fileOutAsHtml: false!

Item was removed:
- ----- Method: Class>>fileOutAsHtml: (in category 'fileIn/Out') -----
- fileOutAsHtml: useHtml
- 	"File a description of the receiver onto a new file whose base name is the name of the receiver."
- 
- 	| internalStream |
- 	internalStream := WriteStream on: (String new: 100).
- 	internalStream header; timeStamp.
- 
- 	self sharedPools size > 0 ifTrue: [
- 		self shouldFileOutPools
- 			ifTrue: [self fileOutSharedPoolsOn: internalStream]].
- 	self fileOutOn: internalStream moveSource: false toFile: 0.
- 	internalStream trailer.
- 
- 	FileStream writeSourceCodeFrom: internalStream baseName: self name isSt: true useHtml: useHtml.
- !

Item was removed:
- ----- Method: Class>>fileOutInitializerOn: (in category 'fileIn/Out') -----
- fileOutInitializerOn: aStream
- 	^self class fileOutInitializerOn: aStream!

Item was removed:
- ----- Method: Class>>fileOutOn:moveSource:toFile: (in category 'fileIn/Out') -----
- fileOutOn: aFileStream moveSource: moveSource toFile: fileIndex 
- 	"File a description of the receiver on aFileStream. If the boolean argument,
- 	moveSource, is true, then set the trailing bytes to the position of aFileStream and
- 	to fileIndex in order to indicate where to find the source code."
- 	^self fileOutOn: aFileStream moveSource: moveSource toFile: fileIndex initializing: true!

Item was removed:
- ----- Method: Class>>fileOutOn:moveSource:toFile:initializing: (in category 'fileIn/Out') -----
- fileOutOn: aFileStream moveSource: moveSource toFile: fileIndex initializing: aBool
- 	"File a description of the receiver on aFileStream. If the boolean argument,
- 	moveSource, is true, then set the trailing bytes to the position of aFileStream and
- 	to fileIndex in order to indicate where to find the source code."
- 
- 	Transcript cr; show: self name.
- 	super
- 		fileOutOn: aFileStream
- 		moveSource: moveSource
- 		toFile: fileIndex.
- 	self class nonTrivial
- 		ifTrue:
- 			[aFileStream cr; nextPutAll: '"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!!'; cr; cr.
- 			self class
- 				fileOutOn: aFileStream
- 				moveSource: moveSource
- 				toFile: fileIndex
- 				initializing: aBool]!

Item was removed:
- ----- Method: Class>>fileOutPool:onFileStream: (in category 'fileIn/Out') -----
- fileOutPool: aPool onFileStream: aFileStream 
- 	| aPoolName |
- 	(aPool  isKindOf: SharedPool class) ifTrue:[^self notify: 'we do not fileout SharedPool type shared pools for now'].
- 	aPoolName := self environment keyAtIdentityValue: aPool.
- 	Transcript cr; show: aPoolName.
- 	aFileStream nextPutAll: 'Transcript show: ''' , aPoolName , '''; cr!!'; cr.
- 	aFileStream nextPutAll: 'Smalltalk at: #' , aPoolName , ' put: Dictionary new!!'; cr.
- 	aPool keys asArray sort do: [ :aKey |
- 		| aValue |
- 		aValue := aPool at: aKey.
- 		aFileStream nextPutAll: aPoolName , ' at: #''' , aKey asString , '''', ' put:  '.
- 		(aValue isKindOf: Number)
- 			ifTrue: [aValue printOn: aFileStream]
- 			ifFalse: [aFileStream nextPutAll: '('.
- 					aValue printOn: aFileStream.
- 					aFileStream nextPutAll: ')'].
- 		aFileStream nextPutAll: '!!'; cr].
- 	aFileStream cr!

Item was removed:
- ----- Method: Class>>fileOutSharedPoolsOn: (in category 'fileIn/Out') -----
- fileOutSharedPoolsOn: aFileStream
- 	"file out the shared pools of this class after prompting the user about each pool"
- 	| poolsToFileOut |
- 	poolsToFileOut := self sharedPools select: 
- 		[:aPool | (self shouldFileOutPool: (self environment keyAtIdentityValue: aPool))].
- 	poolsToFileOut do: [:aPool | self fileOutPool: aPool onFileStream: aFileStream].
- 	!

Item was removed:
- ----- Method: Class>>hasMethods (in category 'testing') -----
- hasMethods
- 	"Answer a Boolean according to whether any methods are defined for the 
- 	receiver (includes whether there are methods defined in the receiver's 
- 	metaclass)."
- 
- 	^super hasMethods or: [self class hasMethods]!

Item was removed:
- ----- Method: Class>>immediateSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'subclass creation') -----
- immediateSubclass: t instanceVariableNames: f classVariableNames: d poolDictionaries: s category: cat 
- 	"This is the standard initialization message for creating a new
- 	 immediate class as a subclass of an existing class (the receiver)."
- 	^ClassBuilder new
- 		superclass: self
- 		immediateSubclass: t
- 		instanceVariableNames: f
- 		classVariableNames: d
- 		poolDictionaries: s
- 		category: cat!

Item was removed:
- ----- Method: Class>>isAbstract (in category 'testing') -----
- isAbstract
- 	"Answer true if I am to be considered an abstract class.
- 	An abstract class shall better not be instantiated.
- 	Or its instances may miss some important behavior.
- 	Typically, a class with methods sending #subclassResponsibility might be considered abstract.
- 	But we can't erect this as a general rule, it might be that the message is never sent.
- 	By default, all classes are concrete, up to each one to declare itself abstract."
- 	
- 	^false!

Item was removed:
- ----- Method: Class>>isDeprecated (in category 'testing') -----
- isDeprecated
- 	"Check for \d\d(Deprecated).* name. Optimized for speed. Accept false-positives if category cache is not valid anymore. See #category."
- 	
- 	^ ((category ifNil: [self category]) findString: 'Deprecated' startingAt: 3 caseSensitive: true) > 0!

Item was removed:
- ----- Method: Class>>isObsolete (in category 'testing') -----
- isObsolete
- 	"Return true if the receiver is obsolete."
- 	^(self environment at: name ifAbsent: [nil]) ~~ self!

Item was removed:
- ----- Method: Class>>isSystemDefined (in category 'testing') -----
- isSystemDefined
- 	"Answer true if the receiver is a system-defined class, and not a UniClass (an instance-specific lightweight class)"
- 
- 	^ self == self officialClass!

Item was removed:
- ----- Method: Class>>metaCompilerClass (in category 'compiling') -----
- metaCompilerClass
- 	"BE CAREFUL!! If you provide your own class to treat class-side (resp. meta) methods, you MUST account for the #meta*Class selector to use the default implementation in that case. That is, the methods behind #meta*Class MUST always get the default Smalltalk treatment."
- 	
- 	^ super compilerClass!

Item was removed:
- ----- Method: Class>>metaDecompilerClass (in category 'compiling') -----
- metaDecompilerClass
- 	"BE CAREFUL!! If you provide your own class to treat class-side (resp. meta) methods, you MUST account for the #meta*Class selector to use the default implementation in that case. That is, the methods behind #meta*Class MUST always get the default Smalltalk treatment."
- 
- 	^ super decompilerClass!

Item was removed:
- ----- Method: Class>>metaEvaluatorClass (in category 'compiling') -----
- metaEvaluatorClass
- 	"BE CAREFUL!! If you provide your own class to treat class-side (resp. meta) methods, you MUST account for the #meta*Class selector to use the default implementation in that case. That is, the methods behind #meta*Class MUST always get the default Smalltalk treatment."
- 
- 	^ super evaluatorClass!

Item was removed:
- ----- Method: Class>>metaFormatterClass (in category 'printing') -----
- metaFormatterClass
- 	"BE CAREFUL!! If you provide your own class to treat class-side (resp. meta) methods, you MUST account for the #meta*Class selector to use the default implementation in that case. That is, the methods behind #meta*Class MUST always get the default Smalltalk treatment."
- 
- 	^ super formatterClass!

Item was removed:
- ----- Method: Class>>metaParserClass (in category 'compiling') -----
- metaParserClass
- 	"BE CAREFUL!! If you provide your own class to treat class-side (resp. meta) methods, you MUST account for the #meta*Class selector to use the default implementation in that case. That is, the methods behind #meta*Class MUST always get the default Smalltalk treatment."
- 
- 	^ super parserClass!

Item was removed:
- ----- Method: Class>>metaPrettyPrinterClass (in category 'printing') -----
- metaPrettyPrinterClass
- 	"BE CAREFUL!! If you provide your own class to treat class-side (resp. meta) methods, you MUST account for the #meta*Class selector to use the default implementation in that case. That is, the methods behind #meta*Class MUST always get the default Smalltalk treatment."
- 
- 	^ super prettyPrinterClass!

Item was removed:
- ----- Method: Class>>name (in category 'accessing') -----
- name
- 	"Answer the name of the receiver."
- 
- 	name == nil
- 		ifTrue: [^super name]
- 		ifFalse: [^name]!

Item was removed:
- ----- Method: Class>>nameForViewer (in category 'class name') -----
- nameForViewer
- 	"Answer the name to be shown in the header of a viewer looking at the receiver"
- 
- 	^ self name ifNil: ['Unnamed class']!

Item was removed:
- ----- Method: Class>>newEnvironment (in category 'subclass creation') -----
- newEnvironment
- 	
- 	self flag: #uniclasses.
- 	^ (Environment withName: 'EnvironmentForUniClass')
- 		at: self name asSymbol put: self;
- 		importSelf;
- 		yourself!

Item was removed:
- ----- Method: Class>>newSubclass (in category 'subclass creation') -----
- newSubclass
- 
- 	self flag: #uniclasses.	
- 	^ self newUniqueClassInstVars: '' classInstVars: ''
- 
- "Point newSubclass new"!

Item was removed:
- ----- Method: Class>>objectForDataStream: (in category 'fileIn/Out') -----
- objectForDataStream: refStrm
- 	"I am about to be written on an object file.  Write a reference to a class in Smalltalk instead."
- 
- 	refStrm insideASegment
- 		ifFalse: ["Normal use"
- 			^ DiskProxy global: self theNonMetaClass name selector: #withClassVersion:
- 				args: {self classVersion}]
- 		ifTrue: ["recording objects to go into an ImageSegment"
- 			self isSystemDefined ifFalse: [^ self].		"do trace Player classes"
- 			(refStrm rootObject includes: self) ifTrue: [^ self].
- 				"is in roots, intensionally write out, ^ self"
- 			
- 			"A normal class.  remove it from references.  Do not trace."
- 			refStrm references removeKey: self ifAbsent: []. 	"already there"
- 			^ nil]
- !

Item was removed:
- ----- Method: Class>>obsolete (in category 'initialize-release') -----
- obsolete
- 	"Change the receiver and all of its subclasses to an obsolete class."
- 	self == Object 
- 		ifTrue: [^self error: 'Object is NOT obsolete'].
- 	self setName: 'AnObsolete' , self name.
- 	Object class instSize + 1 to: self class instSize do:
- 		[:i | self instVarAt: i put: nil]. "Store nil over class instVars."
- 	self classPool: nil.
- 	self sharedPools: nil.
- 	self class obsolete.
- 	super obsolete.!

Item was removed:
- ----- Method: Class>>officialClass (in category 'testing') -----
- officialClass
- 	"I am not a UniClass.  (See Player officialClass).  Return the class you use to make new subclasses."
- 
- 	^ self!

Item was removed:
- ----- Method: Class>>possibleVariablesFor:continuedFrom: (in category 'compiling') -----
- possibleVariablesFor: misspelled continuedFrom: oldResults
- 
- 	| results |
- 	results := misspelled correctAgainstDictionary: self classPool continuedFrom: oldResults.
- 	self sharedPools do: [:pool | 
- 		results := misspelled correctAgainstDictionary: pool continuedFrom: results ].
- 	superclass == nil
- 		ifTrue: 
- 			[ ^ misspelled correctAgainstDictionary: self environment continuedFrom: results ]
- 		ifFalse:
- 			[ ^ superclass possibleVariablesFor: misspelled continuedFrom: results ]!

Item was removed:
- ----- Method: Class>>reformatAll (in category 'fileIn/Out') -----
- reformatAll 
- 	"Reformat all methods in this class.
- 	Leaves old code accessible to version browsing"
- 	super reformatAll.		"me..."
- 	self class reformatAll	"...and my metaclass"!

Item was removed:
- ----- Method: Class>>removeClassVarName: (in category 'class variables') -----
- removeClassVarName: aString 
- 	"Remove the class variable whose name is the argument, aString, from 
- 	the names defined in the receiver, a class. Create an error notification if 
- 	aString is not a class variable or if it is still being used in the code of 
- 	the class."
- 
- 	| aSymbol |
- 	aSymbol := aString asSymbol.
- 	(classPool includesKey: aSymbol)
- 		ifFalse: [^self error: aString, ' is not a class variable'].
- 	self withAllSubclasses do:[:subclass |
- 		(Array with: subclass with: subclass class) do:[:classOrMeta |
- 			(classOrMeta whichSelectorsReferTo: (classPool associationAt: aSymbol))
- 				isEmpty ifFalse: [
- 					InMidstOfFileinNotification signal ifTrue: [
- 						Transcript cr; show: self name, ' (' , aString , ' is Undeclared) '.
- 						^self environment undeclare: aSymbol from: classPool].
- 					(self confirm: (aString,' is still used in code of class ', classOrMeta name,
- 						'.\Is it okay to move it to Undeclared?') withCRs)
- 						ifTrue:[^ self environment undeclare: aSymbol from: classPool]
- 						ifFalse:[^self]]]].
- 	classPool removeKey: aSymbol.
- 	classPool isEmpty ifTrue: [classPool := nil].
- !

Item was removed:
- ----- Method: Class>>removeFromChanges (in category 'fileIn/Out') -----
- removeFromChanges
- 	"References to the receiver, a class, and its metaclass should no longer be included in the system ChangeSet.
- 	7/18/96 sw: call removeClassAndMetaClassChanges:"
- 
- 	ChangeSet current removeClassAndMetaClassChanges: self!

Item was removed:
- ----- Method: Class>>removeFromSystem (in category 'initialize-release') -----
- removeFromSystem
- 	"Forget the receiver from the Smalltalk global dictionary. Any existing 
- 	instances will refer to an obsolete version of the receiver."
- 	self removeFromSystem: true.!

Item was removed:
- ----- Method: Class>>removeFromSystem: (in category 'initialize-release') -----
- removeFromSystem: logged
- 	"Forget the receiver from the Smalltalk global dictionary. Any existing 
- 	instances will refer to an obsolete version of the receiver."
- 	
- 	"keep the class name and category for triggering the system change message. If we wait to long, then we get obsolete information which is not what we want."
- 
- 	"tell class to deactivate and unload itself-- two separate events in the module system"
- 	self deactivate; unload.
- 	self superclass ifNotNil:
- 		["If we have no superclass there's nothing to be remembered"
- 		self superclass addObsoleteSubclass: self].
- 	self environment forgetClass: self logged: logged.
- 	self obsolete.!

Item was removed:
- ----- Method: Class>>removeFromSystemUnlogged (in category 'initialize-release') -----
- removeFromSystemUnlogged
- 	"Forget the receiver from the Smalltalk global dictionary. Any existing instances will refer to an obsolete version of the receiver.  Do not log the removal either to the current change set nor to the system changes log"
- 	^self removeFromSystem: false!

Item was removed:
- ----- Method: Class>>removeInstVarName: (in category 'instance variables') -----
- removeInstVarName: aString 
- 	"Remove the argument, aString, as one of the receiver's instance variables."
- 
- 	| newInstVarString |
- 	(self instVarNames includes: aString)
- 		ifFalse: [self error: aString , ' is not one of my instance variables'].
- 	newInstVarString := ''.
- 	(self instVarNames copyWithout: aString) do: 
- 		[:varName | newInstVarString := newInstVarString , ' ' , varName].
- 	^(ClassBuilder new)
- 		name: self name
- 		inEnvironment: self environment
- 		subclassOf: self superclass
- 		type: self typeOfClass
- 		instanceVariableNames: newInstVarString
- 		classVariableNames: self classVariablesString
- 		poolDictionaries: self sharedPoolsString
- 		category: self category!

Item was removed:
- ----- Method: Class>>removeSharedPool: (in category 'pool variables') -----
- removeSharedPool: aDictionary 
- 	"Remove the pool dictionary, aDictionary, as one of the receiver's pool 
- 	dictionaries. Create an error notification if the dictionary is not one of 
- 	the pools.
- 	: Note that it removes the wrong one if there are two empty Dictionaries in the list."
- 
- 	| satisfiedSet workingSet aSubclass |
- 	(self sharedPools includes: aDictionary)
- 		ifFalse: [^self error: 'the dictionary is not in my pool'].
- 
- 	"first see if it is declared in a superclass in which case we can remove it."
- 	(self selectSuperclasses: [:class | class sharedPools includes: aDictionary]) isEmpty
- 		ifFalse: [sharedPools remove: aDictionary.
- 				sharedPools isEmpty ifTrue: [sharedPools := nil].
- 				^self]. 
- 
- 	"second get all the subclasses that reference aDictionary through me rather than a 
- 	superclass that is one of my subclasses."
- 
- 	workingSet := self subclasses asOrderedCollection.
- 	satisfiedSet := Set new.
- 	[workingSet isEmpty] whileFalse:
- 		[aSubclass := workingSet removeFirst.
- 		(aSubclass sharedPools includes: aDictionary)
- 			ifFalse: 
- 				[satisfiedSet add: aSubclass.
- 				workingSet addAll: aSubclass subclasses]].
- 
- 	"for each of these, see if they refer to any of the variables in aDictionary because 
- 	if they do, we can not remove the dictionary."
- 	satisfiedSet add: self.
- 	satisfiedSet do: 
- 		[:sub | 
- 		aDictionary associationsDo: 
- 			[:aGlobal | 
- 			(sub whichSelectorsReferTo: aGlobal) isEmpty 
- 				ifFalse: [^self error: aGlobal key 
- 								, ' is still used in code of class '
- 								, sub name]]].
- 	sharedPools remove: aDictionary.
- 	sharedPools isEmpty ifTrue: [sharedPools := nil]!

Item was removed:
- ----- Method: Class>>removeSubclass: (in category 'accessing class hierarchy') -----
- removeSubclass: aSubclass 
- 	"If the argument, aSubclass, is one of the receiver's subclasses, remove it."
- 
- 	subclasses == nil ifFalse:
- 		[subclasses :=  subclasses copyWithout: aSubclass.
- 		subclasses isEmpty ifTrue: [subclasses := nil]].
- !

Item was removed:
- ----- Method: Class>>rename: (in category 'class name') -----
- rename: aString 
- 	"The new name of the receiver is the argument, aString."
- 
- 	| oldName newName |
- 	(newName := aString asSymbol) = (oldName := self name)
- 		ifTrue: [^ self].
- 	(self environment includesKey: newName)
- 		ifTrue: [^ self error: newName , ' already exists'].
- 	((self environment undeclared includesKey: newName)
- 		and: [(self environment undeclared unreferencedKeys includes: newName) not])
- 		ifTrue: [RemarkNotification signal: 'There are references to ' , aString printString , '
- from Undeclared. Check them after this change.'].
- 	name := newName.
- 	self environment renameClass: self from: oldName!

Item was removed:
- ----- Method: Class>>setName: (in category 'private') -----
- setName: aSymbol
- 	"Private - set the name of the class"
- 	name := aSymbol.!

Item was removed:
- ----- Method: Class>>sharedPools (in category 'pool variables') -----
- sharedPools
- 	"Answer a Set of the pool dictionaries declared in the receiver."
- 
- 	sharedPools == nil
- 		ifTrue: [^OrderedCollection new]
- 		ifFalse: [^sharedPools]!

Item was removed:
- ----- Method: Class>>sharedPools: (in category 'pool variables') -----
- sharedPools: aCollection
- 	sharedPools := aCollection!

Item was removed:
- ----- Method: Class>>sharing: (in category 'initialize-release') -----
- sharing: poolString 
- 	"Set up sharedPools. Answer whether recompilation is advisable."
- 	| oldPools |
- 	oldPools := self sharedPools.
- 	sharedPools := OrderedCollection new.
- 	(Scanner new scanFieldNames: poolString) do: 
- 		[:poolName | 
- 		sharedPools add: (self environment at: poolName asSymbol ifAbsent:[
- 			(self confirm: 'The pool dictionary ', poolName,' does not exist.',
- 						'\Do you want it automatically created?' withCRs)
- 				ifTrue:[self environment at: poolName asSymbol put: Dictionary new]
- 				ifFalse:[^self error: poolName,' does not exist']])].
- 	sharedPools isEmpty ifTrue: [sharedPools := nil].
- 	oldPools do: [:pool |
- 				| found |
- 				found := self sharedPools anySatisfy: [:p | p == pool].
- 				found ifFalse: [^ true "A pool got deleted"]].
- 	^ false!

Item was removed:
- ----- Method: Class>>shouldFileOutPool: (in category 'fileIn/Out') -----
- shouldFileOutPool: aPoolName
- 	"respond with true if the user wants to file out aPoolName"
- 	^self confirm: ('FileOut the sharedPool ', aPoolName, '?')!

Item was removed:
- ----- Method: Class>>shouldFileOutPools (in category 'fileIn/Out') -----
- shouldFileOutPools
- 	"respond with true if the user wants to file out the shared pools"
- 	^self confirm: 'FileOut selected sharedPools?'!

Item was removed:
- ----- Method: Class>>spaceUsed (in category 'private') -----
- spaceUsed
- 
- 	"Object spaceUsed"
- 	^ super spaceUsed + self class spaceUsed!

Item was removed:
- ----- Method: Class>>storeDataOn: (in category 'fileIn/Out') -----
- storeDataOn: aDataStream
- 	"I don't get stored.  Use a DiskProxy"
- 
- 	(aDataStream insideASegment and: [self isSystemDefined not]) ifTrue: [
- 		^ super storeDataOn: aDataStream].	"do trace me"
- 	self error: 'use a DiskProxy to store a Class'!

Item was removed:
- ----- Method: Class>>subclass:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'subclass creation') -----
- subclass: t instanceVariableNames: f classVariableNames: d poolDictionaries: s category: cat 
- 	"This is the standard initialization message for creating a new class as a 
- 	subclass of an existing class (the receiver)."
- 	^(ClassBuilder new)
- 		superclass: self
- 		subclass: t
- 		instanceVariableNames: f
- 		classVariableNames: d
- 		poolDictionaries: s
- 		category: cat
- !

Item was removed:
- ----- Method: Class>>subclass:uses:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'subclass creation') -----
- subclass: t uses: aTraitCompositionOrArray instanceVariableNames: f classVariableNames: d poolDictionaries: s category: cat 
- 	| newClass copyOfOldClass |
- 	copyOfOldClass := self copy.
- 	newClass := self
- 		subclass: t
- 		instanceVariableNames: f
- 		classVariableNames: d
- 		poolDictionaries: s
- 		category: cat.
- 		
- 	
- 	newClass setTraitComposition: aTraitCompositionOrArray asTraitComposition.
- 	SystemChangeNotifier uniqueInstance
- 		classDefinitionChangedFrom: copyOfOldClass to: newClass.
- 	^newClass!

Item was removed:
- ----- Method: Class>>subclasses (in category 'accessing class hierarchy') -----
- subclasses
- 	"Answer a Set containing the receiver's subclasses."
- 
- 	^subclasses == nil
- 		ifTrue: [#()]
- 		ifFalse: [subclasses copy]!

Item was removed:
- ----- Method: Class>>subclassesDo: (in category 'accessing class hierarchy') -----
- subclassesDo: aBlock 
- 	"Evaluate the argument, aBlock, for each of the receiver's immediate subclasses."
- 	subclasses == nil 
- 		ifFalse:[subclasses do: aBlock]!

Item was removed:
- ----- Method: Class>>subclassesDoGently: (in category 'accessing class hierarchy') -----
- subclassesDoGently: aBlock 
- 	"Evaluate the argument, aBlock, for each of the receiver's immediate subclasses."
- 	subclasses == nil 
- 		ifFalse: [subclasses do: aBlock]!

Item was removed:
- ----- Method: Class>>superclass:methodDict:format:name:organization:instVarNames:classPool:sharedPools: (in category 'initialize-release') -----
- superclass: sup methodDict: md format: ft name: nm organization: org instVarNames: nilOrArray classPool: pool sharedPools: poolSet 
- 	"Answer an instance of me, a new class, using the arguments of the 
- 	message as the needed information.
- 	Must only be sent to a new instance; else we would need Object flushCache."
- 
- 	superclass := sup.
- 	methodDict := md.
- 	format := ft.
- 	name := nm.
- 	instanceVariables := nilOrArray.
- 	classPool := pool.
- 	sharedPools := poolSet.
- 	self organization: org.!

Item was removed:
- ----- Method: Class>>superclass:methodDictionary:format: (in category 'initialize-release') -----
- superclass: aClass methodDictionary: mDict format: fmt
- 	"Basic initialization of the receiver"
- 	super superclass: aClass methodDictionary: mDict format: fmt.
- 	subclasses := nil. "Important for moving down the subclasses field into Class"
- !

Item was removed:
- ----- Method: Class>>unload (in category 'initialize-release') -----
- unload
- 	"Sent when a the class is removed.  Does nothing, but may be overridden by (class-side) subclasses."
- !

Item was removed:
- ----- Method: Class>>variableByteSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'subclass creation') -----
- variableByteSubclass: t instanceVariableNames: f 
- 	classVariableNames: d poolDictionaries: s category: cat
- 	"This is the standard initialization message for creating a new class as a 
- 	subclass of an existing class (the receiver) in which the subclass is to 
- 	have indexable 8-bit byte-sized nonpointer variables."
- 	^ClassBuilder new
- 		superclass: self
- 		variableByteSubclass: t
- 		instanceVariableNames: f
- 		classVariableNames: d
- 		poolDictionaries: s
- 		category: cat!

Item was removed:
- ----- Method: Class>>variableByteSubclass:uses:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'subclass creation') -----
- variableByteSubclass: t uses: aTraitCompositionOrArray instanceVariableNames: f 
- 	classVariableNames: d poolDictionaries: s category: cat
- 	"This is the standard initialization message for creating a new class as a 
- 	subclass of an existing class (the receiver) in which the subclass is to 
- 	have indexable 8-bit byte-sized nonpointer variables."
- 	
- 	| newClass copyOfOldClass |
- 	copyOfOldClass := self copy.
- 	newClass := self
- 		variableByteSubclass: t 
- 		instanceVariableNames: f
- 		classVariableNames: d
- 		poolDictionaries: s
- 		category: cat.
- 	
- 	newClass setTraitComposition: aTraitCompositionOrArray asTraitComposition.
- 	SystemChangeNotifier uniqueInstance
- 		classDefinitionChangedFrom: copyOfOldClass to: newClass.
- 	^newClass!

Item was removed:
- ----- Method: Class>>variableDoubleByteSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'subclass creation') -----
- variableDoubleByteSubclass: t instanceVariableNames: f 
- 	classVariableNames: d poolDictionaries: s category: cat
- 	"This is the standard initialization message for creating a new class as a 
- 	subclass of an existing class (the receiver) in which the subclass is to 
- 	have indexable 16-bit double byte-sized nonpointer variables."
- 	^ClassBuilder new
- 		superclass: self
- 		variableDoubleByteSubclass: t
- 		instanceVariableNames: f
- 		classVariableNames: d
- 		poolDictionaries: s
- 		category: cat!

Item was removed:
- ----- Method: Class>>variableDoubleByteSubclass:uses:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'subclass creation') -----
- variableDoubleByteSubclass: t uses: aTraitCompositionOrArray instanceVariableNames: f 
- 	classVariableNames: d poolDictionaries: s category: cat
- 	"This is the standard initialization message for creating a new class as a 
- 	subclass of an existing class (the receiver) in which the subclass is to 
- 	have indexable 16-bit double byte-sized nonpointer variables."
- 	
- 	| newClass copyOfOldClass |
- 	copyOfOldClass := self copy.
- 	newClass := self
- 		variableDoubleByteSubclass: t 
- 		instanceVariableNames: f
- 		classVariableNames: d
- 		poolDictionaries: s
- 		category: cat.
- 	
- 	newClass setTraitComposition: aTraitCompositionOrArray asTraitComposition.
- 	SystemChangeNotifier uniqueInstance
- 		classDefinitionChangedFrom: copyOfOldClass to: newClass.
- 	^newClass!

Item was removed:
- ----- Method: Class>>variableDoubleWordSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'subclass creation') -----
- variableDoubleWordSubclass: t instanceVariableNames: f 
- 	classVariableNames: d poolDictionaries: s category: cat
- 	"This is the standard initialization message for creating a new class as a 
- 	subclass of an existing class (the receiver) in which the subclass is to 
- 	have indexable 64-bit word-sized nonpointer variables."
- 	^ClassBuilder new
- 		superclass: self
- 		variableDoubleWordSubclass: t
- 		instanceVariableNames: f
- 		classVariableNames: d
- 		poolDictionaries: s
- 		category: cat!

Item was removed:
- ----- Method: Class>>variableDoubleWordSubclass:uses:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'subclass creation') -----
- variableDoubleWordSubclass: t uses: aTraitCompositionOrArray instanceVariableNames: f 
- 	classVariableNames: d poolDictionaries: s category: cat
- 	"This is the standard initialization message for creating a new class as a 
- 	subclass of an existing class (the receiver) in which the subclass is to 
- 	have indexable 64-bit word-sized nonpointer variables."
- 	
- 	| newClass copyOfOldClass |
- 	copyOfOldClass := self copy.
- 	newClass := self
- 		variableDoubleWordSubclass: t 
- 		instanceVariableNames: f
- 		classVariableNames: d
- 		poolDictionaries: s
- 		category: cat.
- 	
- 	newClass setTraitComposition: aTraitCompositionOrArray asTraitComposition.
- 	SystemChangeNotifier uniqueInstance
- 		classDefinitionChangedFrom: copyOfOldClass to: newClass.
- 	^newClass!

Item was removed:
- ----- Method: Class>>variableSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'subclass creation') -----
- variableSubclass: t instanceVariableNames: f 
- 	classVariableNames: d poolDictionaries: s category: cat
- 	"This is the standard initialization message for creating a new class as a 
- 	subclass of an existing class (the receiver) in which the subclass is to 
- 	have indexable pointer variables."
- 	^(ClassBuilder new)
- 		superclass: self
- 		variableSubclass: t
- 		instanceVariableNames: f
- 		classVariableNames: d
- 		poolDictionaries: s
- 		category: cat
- !

Item was removed:
- ----- Method: Class>>variableSubclass:uses:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'subclass creation') -----
- variableSubclass: t uses: aTraitCompositionOrArray instanceVariableNames: f 
- 	classVariableNames: d poolDictionaries: s category: cat
- 	"This is the standard initialization message for creating a new class as a 
- 	subclass of an existing class (the receiver) in which the subclass is to 
- 	have indexable pointer variables."
- 	
- 	| newClass copyOfOldClass |
- 	copyOfOldClass := self copy.
- 	newClass := self
- 		variableSubclass: t 
- 		instanceVariableNames: f
- 		classVariableNames: d
- 		poolDictionaries: s
- 		category: cat.
- 	
- 	newClass setTraitComposition: aTraitCompositionOrArray asTraitComposition.
- 	SystemChangeNotifier uniqueInstance
- 		classDefinitionChangedFrom: copyOfOldClass to: newClass.
- 	^newClass	!

Item was removed:
- ----- Method: Class>>variableWordSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'subclass creation') -----
- variableWordSubclass: t instanceVariableNames: f 
- 	classVariableNames: d poolDictionaries: s category: cat
- 	"This is the standard initialization message for creating a new class as a 
- 	subclass of an existing class (the receiver) in which the subclass is to 
- 	have indexable 32-bit word-sized nonpointer variables."
- 	^ClassBuilder new
- 		superclass: self
- 		variableWordSubclass: t
- 		instanceVariableNames: f
- 		classVariableNames: d
- 		poolDictionaries: s
- 		category: cat!

Item was removed:
- ----- Method: Class>>variableWordSubclass:uses:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'subclass creation') -----
- variableWordSubclass: t uses: aTraitCompositionOrArray instanceVariableNames: f 
- 	classVariableNames: d poolDictionaries: s category: cat
- 	"This is the standard initialization message for creating a new class as a 
- 	subclass of an existing class (the receiver) in which the subclass is to 
- 	have indexable 32-bit word-sized nonpointer variables."
- 	
- 	| newClass copyOfOldClass |
- 	copyOfOldClass := self copy.
- 	newClass := self
- 		variableWordSubclass: t 
- 		instanceVariableNames: f
- 		classVariableNames: d
- 		poolDictionaries: s
- 		category: cat.
- 	
- 	newClass setTraitComposition: aTraitCompositionOrArray asTraitComposition.
- 	SystemChangeNotifier uniqueInstance
- 		classDefinitionChangedFrom: copyOfOldClass to: newClass.
- 	^newClass	!

Item was removed:
- ----- Method: Class>>weakSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'subclass creation') -----
- weakSubclass: t instanceVariableNames: f 
- 	classVariableNames: d poolDictionaries: s category: cat
- 	"This is the standard initialization message for creating a new class as a 
- 	subclass of an existing class (the receiver) in which the subclass is to 
- 	have weak indexable pointer variables."
- 	^(ClassBuilder new)
- 		superclass: self
- 		weakSubclass: t
- 		instanceVariableNames: f
- 		classVariableNames: d
- 		poolDictionaries: s
- 		category: cat!

Item was removed:
- ----- Method: Class>>weakSubclass:uses:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'subclass creation') -----
- weakSubclass: t uses: aTraitCompositionOrArray instanceVariableNames: f 
- 	classVariableNames: d poolDictionaries: s category: cat
- 	"This is the standard initialization message for creating a new class as a 
- 	subclass of an existing class (the receiver) in which the subclass is to 
- 	have weak indexable pointer variables."
- 	
- 	| newClass copyOfOldClass |
- 	copyOfOldClass := self copy.
- 	newClass := self
- 		weakSubclass: t 
- 		instanceVariableNames: f
- 		classVariableNames: d
- 		poolDictionaries: s
- 		category: cat.
- 	
- 	newClass setTraitComposition: aTraitCompositionOrArray asTraitComposition.
- 	SystemChangeNotifier uniqueInstance
- 		classDefinitionChangedFrom: copyOfOldClass to: newClass.
- 	^newClass	
- !

Item was removed:
- ----- Method: Class>>whichSelectorsStoreInto: (in category 'testing') -----
- whichSelectorsStoreInto: varName 
- 	"Answer a collection of selectors whose methods access the argument, varName, as a named class variable. Or let super try with a named instance variable."
- 	| ref |
- 	ref := self classPool
- 		associationAt: varName
- 		ifAbsent: [ ^ super whichSelectorsStoreInto: varName ].
- 	^self methodDict keys select: [:aSelector | (self methodDict at: aSelector) writesRef: ref ]!

Item was removed:
- ----- Method: Class>>withClassVersion: (in category 'fileIn/Out') -----
- withClassVersion: aVersion
- 	aVersion = self classVersion ifTrue:[^self].
- 	^self error: 'Invalid class version'!

Item was removed:
- Object subclass: #ClassBuilder
- 	instanceVariableNames: 'environ classMap instVarMap progress maxClassIndex currentClassIndex'
- 	classVariableNames: 'QuietMode'
- 	poolDictionaries: ''
- 	category: 'Kernel-Classes'!
- 
- !ClassBuilder commentStamp: 'ar 2/27/2003 22:55' prior: 0!
- Responsible for creating a new class or changing the format of an existing class (from a class definition in a browser or a fileIn). This includes validating the definition, computing the format of instances, creating or modifying the accompanying Metaclass, setting up the class and metaclass objects themselves, registering the class as a global, recompiling methods, modifying affected subclasses, mutating existing instances to the new format, and more.
- 
- You typically only need to use or modify this class, or even know how it works, when making fundamental changes to how the Smalltalk system and language works.
- 
- Implementation notes:
- ClassBuilder relies on the assumption that it can see ALL subclasses of some class. If there are any existing subclasses of some class, regardless of whether they have instances or not, regardless of whether they are considered obsolete or not, ClassBuilder MUST SEE THEM.
- !

Item was removed:
- ----- Method: ClassBuilder class>>beSilent: (in category 'accessing') -----
- beSilent: aBool
- 	"ClassDefiner beSilent: true"
- 	"ClassDefiner beSilent: false"
- 	QuietMode := aBool.!

Item was removed:
- ----- Method: ClassBuilder class>>beSilentDuring: (in category 'accessing') -----
- beSilentDuring: aBlock
- 	"Temporarily suppress information about what is going on"
- 	| wasSilent result |
- 	wasSilent := self isSilent.
- 	self beSilent: true.
- 	result := aBlock value.
- 	self beSilent: wasSilent.
- 	^result!

Item was removed:
- ----- Method: ClassBuilder class>>checkClassHierarchyConsistency (in category 'cleanup obsolete classes') -----
- checkClassHierarchyConsistency
- 	"Check the consistency of the class hierarchy. The class hierarchy is consistent if the following
- 	two logical equivalences hold for classes A and B:
- 	- B is obsolete and 'B superclass' yields A  <-->  'A obsoleteSubclasses' contains B
- 	- B is not obsolete and 'B superclass' yields A  <-->  'A subclasses' contains B"
- 	self informUserDuring:[:bar|
- 		self checkClassHierarchyConsistency: bar.
- 	].!

Item was removed:
- ----- Method: ClassBuilder class>>checkClassHierarchyConsistency: (in category 'cleanup obsolete classes') -----
- checkClassHierarchyConsistency: informer
- 	"Check the consistency of the class hierarchy. The class hierarchy is consistent if the following
- 	two logical equivalences hold for classes A and B:
- 	- B is obsolete and 'B superclass' yields A  <-->  'A obsoleteSubclasses' contains B
- 	- B is not obsolete and 'B superclass' yields A  <-->  'A subclasses' contains B"
- 	| classes |
- 	Transcript cr; show: 'Start checking the class hierarchy...'.
- 	Smalltalk garbageCollect.
- 	classes := Metaclass allInstances.
- 	classes keysAndValuesDo: [:index :meta |
- 		informer value:'Validating class hierarchy ', (index * 100 // classes size) printString,'%'.
- 		meta allInstances do: [:each | self checkClassHierarchyConsistencyFor: each].
- 		self checkClassHierarchyConsistencyFor: meta.
- 	].
- 	Transcript show: 'OK'.!

Item was removed:
- ----- Method: ClassBuilder class>>checkClassHierarchyConsistencyFor: (in category 'cleanup obsolete classes') -----
- checkClassHierarchyConsistencyFor: aClassDescription
- 	"Check whether aClassDescription has a consistent superclass and consistent regular and obsolete
- 	subclasses"
- 
- 	| mySuperclass |
- 	mySuperclass := aClassDescription superclass.
- 	(mySuperclass subclasses includes: aClassDescription) = aClassDescription isObsolete
- 			ifTrue: [self error: 'Something wrong!!'].
- 	mySuperclass ifNil: [^ self].  "Obsolete subclasses of nil cannot be stored"
- 	(mySuperclass obsoleteSubclasses includes: aClassDescription) = aClassDescription isObsolete
- 			ifFalse: [self error: 'Something wrong!!'].
- 
- 	aClassDescription subclasses do: [:each |
- 		each isObsolete ifTrue: [self error: 'Something wrong!!'].
- 		each superclass == aClassDescription ifFalse: [self error: 'Something wrong!!']
- 	].
- 	aClassDescription obsoleteSubclasses do: [:each |
- 		each isObsolete ifFalse: [self error: 'Something wrong!!'].
- 		each superclass == aClassDescription ifFalse: [self error: 'Something wrong!!']
- 	].!

Item was removed:
- ----- Method: ClassBuilder class>>cleanupAndCheckClassHierarchy (in category 'cleanup obsolete classes') -----
- cleanupAndCheckClassHierarchy
- 	"Makes the class hierarchy consistent and removes obsolete classes from the SystemDictionary.
- 	Afterwards it checks whether the hierarchy is really consistent."
- 	self informUserDuring:[:bar|
- 		self cleanupAndCheckClassHierarchy: bar.
- 	].
- !

Item was removed:
- ----- Method: ClassBuilder class>>cleanupAndCheckClassHierarchy: (in category 'cleanup obsolete classes') -----
- cleanupAndCheckClassHierarchy: informer
- 	"Makes the class hierarchy consistent and removes obsolete classes from the SystemDictionary.
- 	Afterwards it checks whether the hierarchy is really consistent."
- 
- 	Transcript cr; show: '*** Before cleaning up ***'.
- 	self countReallyObsoleteClassesAndMetaclasses.
- 	self cleanupClassHierarchy: informer.
- 	self checkClassHierarchyConsistency: informer.
- 	Transcript cr; cr; show: '*** After cleaning up ***'.
- 	self countReallyObsoleteClassesAndMetaclasses.!

Item was removed:
- ----- Method: ClassBuilder class>>cleanupClassHierarchy (in category 'cleanup obsolete classes') -----
- cleanupClassHierarchy
- 	"Makes the class hierarchy consistent and removes obsolete classes from the SystemDictionary."
- 	self informUserDuring:[:bar|
- 		self cleanupClassHierarchy: bar.
- 	].!

Item was removed:
- ----- Method: ClassBuilder class>>cleanupClassHierarchy: (in category 'cleanup obsolete classes') -----
- cleanupClassHierarchy: informer
- 	"Makes the class hierarchy consistent and removes obsolete classes from the SystemDictionary."
- 	| classes |
- 	Transcript cr; show: 'Start fixing the class hierarchy and cleaning up...'.
- 	Smalltalk garbageCollect.
- 	classes := Metaclass allInstances.
- 	classes keysAndValuesDo: [:index :meta |
- 		informer value:'Fixing  class hierarchy ', (index * 100 // classes size) printString,'%'.
- 		"Check classes before metaclasses (because Metaclass>>isObsolete
- 		checks whether the related class is obsolete)"
- 		meta allInstances do: [:each | self cleanupClassHierarchyFor: each].
- 		self cleanupClassHierarchyFor: meta.
- 	].
- 	Transcript show: 'DONE'.!

Item was removed:
- ----- Method: ClassBuilder class>>cleanupClassHierarchyFor: (in category 'cleanup obsolete classes') -----
- cleanupClassHierarchyFor: aClassDescription
- 	
- 	| myName mySuperclass |
- 	mySuperclass := aClassDescription superclass.
- 	(self isReallyObsolete: aClassDescription) ifTrue: [
- 		
- 		"Remove class >>>from SystemDictionary if it is obsolete"
- 		myName := aClassDescription name asString.
- 		Smalltalk globals keys do: [:each | 
- 			(each asString = myName and: [(Smalltalk at: each) == aClassDescription])
- 				ifTrue: [Smalltalk globals removeKey: each]].
- 
- 		"Make class officially obsolete if it is not"
- 		(aClassDescription name asString beginsWith: 'AnObsolete')
- 			ifFalse: [aClassDescription obsolete].
- 
- 		aClassDescription isObsolete 
- 			ifFalse: [self error: 'Something wrong!!'].
- 
- 		"Add class to obsoleteSubclasses of its superclass"
- 		mySuperclass
- 			ifNil: [self error: 'Obsolete subclasses of nil cannot be stored'].
- 		(mySuperclass obsoleteSubclasses includes: aClassDescription)
- 			ifFalse: [mySuperclass addObsoleteSubclass: aClassDescription].
- 	] ifFalse:[
- 		"check if superclass has aClassDescription in its obsolete subclasses"
- 		mySuperclass ifNil:[mySuperclass := Class]. "nil subclasses"
- 		mySuperclass removeObsoleteSubclass: aClassDescription.
- 	].
- 	"And remove its obsolete subclasses if not actual superclass"
- 	aClassDescription obsoleteSubclasses do:[:obs|
- 		obs superclass == aClassDescription ifFalse:[
- 			aClassDescription removeObsoleteSubclass: obs]].
- !

Item was removed:
- ----- Method: ClassBuilder class>>countReallyObsoleteClassesAndMetaclasses (in category 'cleanup obsolete classes') -----
- countReallyObsoleteClassesAndMetaclasses
- 	"Counting really obsolete classes and metaclasses"
- 
- 	| metaSize classSize |
- 	Smalltalk garbageCollect.
- 	metaSize := self reallyObsoleteMetaclasses size.
- 	Transcript cr; show: 'Really obsolete metaclasses: ', metaSize printString.
- 	classSize := self reallyObsoleteClasses size.
- 	Transcript cr; show: 'Really obsolete classes: ', classSize printString; cr.
- 	"Metaclasses must correspond to classes!!"
- 	metaSize ~= classSize 
- 		ifTrue: [self error: 'Serious metalevel inconsistency!!!!'].!

Item was removed:
- ----- Method: ClassBuilder class>>isReallyObsolete: (in category 'cleanup obsolete classes') -----
- isReallyObsolete: aClassDescription
- 	"Returns whether the argument class is *really* obsolete. (Due to a bug, the method isObsolete
- 	isObsolete does not always return the right answer"
- 
- 	^ aClassDescription isObsolete or: [(aClassDescription superclass subclasses includes: aClassDescription) not]!

Item was removed:
- ----- Method: ClassBuilder class>>isSilent (in category 'accessing') -----
- isSilent
- 	^QuietMode == true!

Item was removed:
- ----- Method: ClassBuilder class>>reallyObsoleteClasses (in category 'cleanup obsolete classes') -----
- reallyObsoleteClasses
- 	| obsoleteClasses |
- 	obsoleteClasses := OrderedCollection new.
- 	Metaclass allInstances do: [:meta | meta allInstances do: [:each | 
- 		(self isReallyObsolete: each) ifTrue: [obsoleteClasses add: each]]].
- 	^ obsoleteClasses!

Item was removed:
- ----- Method: ClassBuilder class>>reallyObsoleteMetaclasses (in category 'cleanup obsolete classes') -----
- reallyObsoleteMetaclasses
- 	^ Metaclass allInstances select: [:each | self isReallyObsolete: each].!

Item was removed:
- ----- Method: ClassBuilder>>class:instanceVariableNames: (in category 'public') -----
- class: oldClass instanceVariableNames: instVarString
- 	"This is the basic initialization message to change the definition of
- 	an existing Metaclass"
- 	oldClass isMeta ifFalse:[^self error: oldClass name, 'is not a Metaclass'].
- 	^self class: oldClass instanceVariableNames: instVarString unsafe: false!

Item was removed:
- ----- Method: ClassBuilder>>class:instanceVariableNames:unsafe: (in category 'class definition') -----
- class: oldClass instanceVariableNames: instVarString unsafe: unsafe
- 	"This is the basic initialization message to change the definition of
- 	an existing Metaclass"
- 	| instVars newClass needNew copyOfOldClass |
- 	environ := oldClass environment.
- 	instVars := Scanner new scanFieldNames: instVarString.
- 	unsafe ifFalse:[
- 		"Run validation checks so we know that we have a good chance for recompilation"
- 		(self validateInstvars: instVars from: oldClass forSuper: oldClass superclass) ifFalse:[^nil].
- 		(self validateSubclassFormat: oldClass typeOfClass from: oldClass forSuper: oldClass superclass extra: instVars size) ifFalse:[^nil]].
- 	"See if we need a new subclass or not"
- 	needNew := self needsSubclassOf: oldClass superclass type: oldClass typeOfClass instanceVariables: instVars from: oldClass.
- 	needNew ifNil:[^nil]. "some error"
- 	needNew ifFalse:[^oldClass]. "no new class needed"
- 
- 	"Create the new class"
- 	copyOfOldClass := oldClass copy.
- 	newClass := self 
- 		newSubclassOf: oldClass superclass 
- 		type: oldClass typeOfClass
- 		instanceVariables: instVars
- 		from: oldClass.
- 		
- 	newClass := self recompile: false from: oldClass to: newClass mutate: false.
- 	self doneCompiling: newClass.
- 	SystemChangeNotifier uniqueInstance classDefinitionChangedFrom: copyOfOldClass to: newClass.
- 	^newClass!

Item was removed:
- ----- Method: ClassBuilder>>computeFormat:instSize:forSuper: (in category 'class format') -----
- computeFormat: type instSize: newInstSize forSuper: newSuper
- 	"Compute the new format for making oldClass a subclass of newSuper.
- 	 Answer the format or nil if there is any problem."
- 	| instSize isVar isPointers isWeak bitsUnitSize |
- 	type == #compiledMethod ifTrue:
- 		[newInstSize > 0 ifTrue:
- 			[self error: 'A compiled method class cannot have named instance variables'.
- 			^nil].
- 		^CompiledMethod format].
- 	instSize := newInstSize + (newSuper ifNil:[0] ifNotNil:[newSuper instSize]).
- 	instSize > 65535 ifTrue:
- 		[self error: 'Class has too many instance variables (', instSize printString,')'.
- 		^nil].
- 	type == #normal ifTrue:[isVar := isWeak := false. isPointers := true].
- 	type == #bytes ifTrue:[isVar := true. bitsUnitSize := 1. isPointers := isWeak := false].
- 	type == #shorts ifTrue:[isVar := true. bitsUnitSize := 2. isPointers := isWeak := false].
- 	type == #words ifTrue:[isVar := true. bitsUnitSize := 4. isPointers := isWeak := false].
- 	type == #longs ifTrue:[isVar := true. bitsUnitSize := 8. isPointers := isWeak := false].
- 	type == #variable ifTrue:[isVar := isPointers := true. isWeak := false].
- 	type == #weak ifTrue:[isVar := isWeak := isPointers := true].
- 	type == #ephemeron ifTrue:[isVar := false. isWeak := isPointers := true].
- 	type == #immediate ifTrue:[isVar := isWeak := isPointers := false].
- 	(isPointers not and: [instSize > 0]) ifTrue:
- 		[self error: 'A non-pointer class cannot have named instance variables'.
- 		^nil].
- 	^self format: instSize variable: isVar bitsUnitSize: bitsUnitSize pointers: isPointers weak: isWeak!

Item was removed:
- ----- Method: ClassBuilder>>doneCompiling: (in category 'initialize') -----
- doneCompiling: aClass
- 	"The receiver has finished modifying the class hierarchy.
- 	Do any necessary cleanup."
- 	aClass doneCompiling.
- 	Behavior flushObsoleteSubclasses.!

Item was removed:
- ----- Method: ClassBuilder>>format:variable:bitsUnitSize:pointers:weak: (in category 'class format') -----
- format: nInstVars variable: isVar bitsUnitSize: bitsUnitSize pointers: isPointers weak: isWeak
- 	"Compute the format for the given instance specfication.
- 	 Above Cog Spur the class format is
- 		<5 bits inst spec><16 bits inst size>
- 	 where the 5-bit inst spec is
- 			0	= 0 sized objects (UndefinedObject True False et al)
- 			1	= non-indexable objects with inst vars (Point et al)
- 			2	= indexable objects with no inst vars (Array et al)
- 			3	= indexable objects with inst vars (Context BlockClosure AdditionalMethodState et al)
- 			4	= weak indexable objects with inst vars (WeakArray et al)
- 			5	= weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
- 			6	= unused
- 			7	= immediates (SmallInteger, Character, SmallFloat64)
- 			8	= unused
- 			9	= 64-bit indexable
- 		10-11	= 32-bit indexable (Bitmap, WideString)
- 		12-15	= 16-bit indexable
- 		16-23	= 8-bit indexable (ByteString)
- 		24-31	= compiled methods (CompiledMethod)"
- 	| instSpec |
- 	instSpec := isWeak
- 					ifTrue:
- 						[isVar
- 							ifTrue: [4]
- 							ifFalse: [5]]
- 					ifFalse:
- 						[isPointers
- 							ifTrue:
- 								[isVar
- 									ifTrue: [nInstVars > 0 ifTrue: [3] ifFalse: [2]]
- 									ifFalse: [nInstVars > 0 ifTrue: [1] ifFalse: [0]]]
- 							ifFalse:
- 								[isVar
- 									ifTrue: [bitsUnitSize caseOf: {
- 											[1] -> [16].
- 											[2] -> [12].
- 											[4] -> [10].
- 											[8] -> [9] }]
- 									ifFalse: [7]]].
- 	^(instSpec bitShift: 16) + nInstVars!

Item was removed:
- ----- Method: ClassBuilder>>informUserDuring: (in category 'private') -----
- informUserDuring: aBlock
- 	self class isSilent ifTrue:[^aBlock value].
- 	UIManager default informUserDuring:[:bar|
- 		progress := bar.
- 		aBlock value].
- 	progress := nil.!

Item was removed:
- ----- Method: ClassBuilder>>initialize (in category 'initialize') -----
- initialize
- 	environ := Smalltalk.
- 	instVarMap := IdentityDictionary new.!

Item was removed:
- ----- Method: ClassBuilder>>moveInstVarNamed:from:to:after: (in category 'public') -----
- moveInstVarNamed: instVarName from: srcClass to: dstClass after: prevInstVarName
- 	"Move the given instVar from srcClass to dstClass"
- 	(srcClass instVarNames includes: instVarName)
- 		ifFalse:[^self error: instVarName,' is not an instance variable of ', srcClass name].
- 	(prevInstVarName isNil or:[dstClass instVarNames includes: prevInstVarName])
- 		ifFalse:[^self error: prevInstVarName, 'is not an instance variable of', dstClass name].
- 	(srcClass inheritsFrom: dstClass) ifTrue:[
- 		"Move the instvar up the hierarchy."
- 		(self validateClass: srcClass forMoving: instVarName upTo: dstClass)
- 			ifFalse:[^false].
- 	].
- 	(dstClass inheritsFrom: srcClass) ifTrue:[
- 		"Move the instvar down the hierarchy"
- 		(self validateClass: srcClass forMoving: instVarName downTo: dstClass)
- 			ifFalse:[^false].
- 	].
- 	^self silentlyMoveInstVarNamed: instVarName from: srcClass to: dstClass after: prevInstVarName!

Item was removed:
- ----- Method: ClassBuilder>>mutate:to: (in category 'class mutation') -----
- 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|
- 		oldSubclass ifNotNil:[
- 			| newSubclass |
- 			newSubclass := self reshapeClass: oldSubclass toSuper: newClass.
- 			self mutate: oldSubclass to: newSubclass.
- 		].
- 	].
- 	self update: oldClass to: newClass.
- 	^newClass!

Item was removed:
- ----- Method: ClassBuilder>>name:inEnvironment:subclassOf:type:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'class definition') -----
- name: className inEnvironment: env subclassOf: newSuper type: type instanceVariableNames: instVarString classVariableNames: classVarString poolDictionaries: poolString category: category
- 	"Define a new class in the given environment"
- 	^self 
- 		name: className 
- 		inEnvironment: env 
- 		subclassOf: newSuper 
- 		type: type 
- 		instanceVariableNames: instVarString 
- 		classVariableNames: classVarString 
- 		poolDictionaries: poolString 
- 		category: category
- 		unsafe: false!

Item was removed:
- ----- Method: ClassBuilder>>name:inEnvironment:subclassOf:type:instanceVariableNames:classVariableNames:poolDictionaries:category:unsafe: (in category 'class definition') -----
- name: className inEnvironment: env subclassOf: newSuper type: type instanceVariableNames: instVarString classVariableNames: classVarString poolDictionaries: poolString category: category unsafe: unsafe
- 	"Define a new class in the given environment.
- 	If unsafe is true do not run any validation checks.
- 	This facility is provided to implement important system changes."
- 	| oldClass instVars classVars copyOfOldClass newClass |
-  
- 	environ := env.
- 	instVars := Scanner new scanFieldNames: instVarString.
- 	classVars := (Scanner new scanFieldNames: classVarString) collect: [:x | x asSymbol].
- 
- 	"Validate the proposed name"
- 	unsafe ifFalse:[(self validateClassName: className) ifFalse:[^nil]].
- 	oldClass := env at: className ifAbsent:[nil].
- 	oldClass isBehavior 
- 		ifFalse: [oldClass := nil]  "Already checked in #validateClassName:"
- 		ifTrue: [
- 			copyOfOldClass := oldClass copy.
- 			copyOfOldClass superclass addSubclass: copyOfOldClass].
- 	
- 	
- 	[ | newCategory needNew force organization oldCategory |
- 	unsafe ifFalse:[
- 		"Run validation checks so we know that we have a good chance for recompilation"
- 		(self validateSuperclass: newSuper forSubclass: oldClass) ifFalse:[^nil].
- 		(self validateInstvars: instVars from: oldClass forSuper: newSuper) ifFalse:[^nil].
- 		(self validateClassvars: classVars from: oldClass forSuper: newSuper) ifFalse:[^nil].
- 		(self validateSubclassFormat: type from: oldClass forSuper: newSuper extra: instVars size) ifFalse:[^nil]].
- 
- 	"See if we need a new subclass"
- 	needNew := self needsSubclassOf: newSuper type: type instanceVariables: instVars from: oldClass.
- 	needNew == nil ifTrue:[^nil]. "some error"
- 
- 	(needNew and:[unsafe not]) ifTrue:[
- 		"Make sure we don't redefine any dangerous classes"
- 		(self tooDangerousClasses includes: oldClass name) ifTrue:[
- 			self error: oldClass name, ' cannot be changed'.
- 		].
- 		"Check if the receiver should not be redefined"
- 		(oldClass ~~ nil and:[oldClass shouldNotBeRedefined]) ifTrue:[
- 			self notify: oldClass name asText allBold, 
- 						' should not be redefined. \Proceed to store over it.' withCRs]].
- 
- 	needNew ifTrue:[
- 		"Create the new class"
- 		newClass := self 
- 			newSubclassOf: newSuper 
- 			type: type 
- 			instanceVariables: instVars
- 			from: oldClass.
- 		newClass == nil ifTrue:[^nil]. "Some error"
- 		newClass setName: className.
- 		newClass environment: environ.
- 	] ifFalse:[
- 		"Reuse the old class"
- 		newClass := oldClass.
- 	].
- 
- 	"Install the class variables and pool dictionaries... "
- 	force := (newClass declare: classVarString) | (newClass sharing: poolString).
- 
- 	"... classify ..."
- 	category ifNotNil: [
- 		newCategory := category asSymbol.
- 		organization := environ ifNotNil:[environ organization].
- 		oldClass isNil ifFalse: [oldCategory := (organization categoryOfElement: oldClass name) asSymbol].
- 		organization classify: newClass name under: newCategory suppressIfDefault: true].
- 
- 	"... recompile ..."
- 	newClass := self recompile: force from: oldClass to: newClass mutate: false.
- 
- 	"... export if not yet done ..."
- 	(environ at: newClass name ifAbsent:[nil]) == newClass ifFalse:[
- 		[environ at: newClass name put: newClass]
- 			on: AttemptToWriteReadOnlyGlobal do:[:ex| ex resume: true].
- 		environ flushClassNameCache.
- 	].
- 
- 
- 	newClass doneCompiling.
- 	"... notify interested clients ..."
- 	oldClass isNil ifTrue: [
- 		SystemChangeNotifier uniqueInstance classAdded: newClass inCategory: newCategory.
- 		^ newClass].
- 	newCategory ~= oldCategory 
- 		ifTrue: [SystemChangeNotifier uniqueInstance class: newClass recategorizedFrom: oldCategory to: category]
- 		ifFalse: [SystemChangeNotifier uniqueInstance classDefinitionChangedFrom: copyOfOldClass to: newClass.].
- ] ensure: 
- 		[copyOfOldClass ifNotNil: [copyOfOldClass superclass removeSubclass: copyOfOldClass].
- 		Behavior flushObsoleteSubclasses.
- 		].
- 	^newClass!

Item was removed:
- ----- Method: ClassBuilder>>needsSubclassOf:type:instanceVariables:from: (in category 'class definition') -----
- needsSubclassOf: newSuper type: type instanceVariables: instVars from: oldClass
- 	"Answer whether we need a new subclass to conform to the requested changes"
- 	| newFormat |
- 	"Compute the format of the new class"
- 	newFormat := self computeFormat: type instSize: instVars size forSuper: newSuper.
- 	newFormat ifNil: [^nil].
- 
- 	"Check if we really need a new subclass"
- 	oldClass ifNil:[^true]. "yes, it's a new class"
- 	newSuper == oldClass superclass ifFalse:[^true]. "yes, it's a superclass change"
- 	newFormat = oldClass format ifFalse:[^true]. "yes, it's a format change"
- 	instVars = oldClass instVarNames ifFalse:[^true]. "yes, it's an iVar change"
- 
- 	^false
- !

Item was removed:
- ----- Method: ClassBuilder>>newSubclassOf:type:instanceVariables:from: (in category 'class definition') -----
- newSubclassOf: newSuper type: type instanceVariables: instVars from: oldClass
- 	"Create a new subclass of the given superclass with the given specification."
- 	| newFormat newClass |
- 	"Compute the format of the new class"
- 	newFormat := self computeFormat: type instSize: instVars size forSuper: newSuper.
- 
- 	newFormat ifNil: [^nil].
- 
- 	(oldClass == nil or:[oldClass isMeta not]) 
- 		ifTrue:[newClass := self privateNewSubclassOf: newSuper from: oldClass]
- 		ifFalse:[newClass := oldClass shallowCopy].
- 
- 	newClass 
- 		superclass: newSuper
- 		methodDictionary: (oldClass ifNil: [MethodDictionary new] ifNotNil: [oldClass methodDict copy])
- 		format: newFormat;
- 		setInstVarNames: instVars.
- 
- 	oldClass ifNotNil:[
- 		newClass organization: oldClass organization.
- 		"Recompile the new class"
- 		oldClass hasMethods 
- 			ifTrue:[newClass compileAllFrom: oldClass].
- 
- 		oldClass hasTraitComposition ifTrue: [
- 			newClass setTraitComposition: oldClass traitComposition copyTraitExpression ].
- 		oldClass class hasTraitComposition ifTrue: [
- 			newClass class setTraitComposition: oldClass class traitComposition copyTraitExpression ].
- 		
- 		self recordClass: oldClass replacedBy: newClass.
- 	].
- 
- 	(oldClass == nil or:[oldClass isObsolete not]) 
- 		ifTrue:[newSuper addSubclass: newClass]
- 		ifFalse:[newSuper addObsoleteSubclass: newClass].
- 
- 	^newClass!

Item was removed:
- ----- Method: ClassBuilder>>privateNewSubclassOf: (in category 'private') -----
- privateNewSubclassOf: newSuper
- 	"Create a new meta and non-meta subclass of newSuper"
- 	"WARNING: This method does not preserve the superclass/subclass invariant!!"
- 	| newSuperMeta newMeta |
- 	newSuperMeta := newSuper ifNil:[Class] ifNotNil:[newSuper class].
- 	newMeta := Metaclass new.
- 	newMeta 
- 		superclass: newSuperMeta 
- 		methodDictionary: MethodDictionary new 
- 		format: newSuperMeta format.
- 	^newMeta new
- !

Item was removed:
- ----- Method: ClassBuilder>>privateNewSubclassOf:from: (in category 'private') -----
- privateNewSubclassOf: newSuper from: oldClass
- 	"Create a new meta and non-meta subclass of newSuper using oldClass as template"
- 	"WARNING: This method does not preserve the superclass/subclass invariant!!"
- 	| newSuperMeta oldMeta newMeta |
- 	oldClass ifNil:[^self privateNewSubclassOf: newSuper].
- 	newSuperMeta := newSuper ifNil:[Class] ifNotNil:[newSuper class].
- 	oldMeta := oldClass class.
- 	newMeta := oldMeta shallowCopy.
- 	newMeta 
- 		superclass: newSuperMeta
- 		methodDictionary: oldMeta methodDict copy
- 		format: (self computeFormat: oldMeta typeOfClass 
- 					instSize: oldMeta instVarNames size 
- 					forSuper: newSuperMeta);
- 		setInstVarNames: oldMeta instVarNames;
- 		organization: oldMeta organization.
- 	"Recompile the meta class"
- 	oldMeta hasMethods 
- 		ifTrue:[newMeta compileAllFrom: oldMeta].
- 	"Record the meta class change"
- 	self recordClass: oldMeta replacedBy: newMeta.
- 	"And create a new instance"
- 	^newMeta adoptInstance: oldClass from: oldMeta!

Item was removed:
- ----- Method: ClassBuilder>>recompile:from:to:mutate: (in category 'class definition') -----
- recompile: force from: oldClass to: newClass mutate: forceMutation
- 	"Do the necessary recompilation after changine oldClass to newClass.
- 	If required (e.g., when oldClass ~~ newClass) mutate oldClass to newClass
- 	and all its subclasses. If forceMutation is true force a mutation even
- 	if oldClass and newClass are the same."
- 
- 	oldClass == nil ifTrue:[^ newClass].
- 
- 	(newClass == oldClass and:[force not and:[forceMutation not]]) ifTrue:[
- 		^newClass].
- 
- 	currentClassIndex := 0.
- 	maxClassIndex := oldClass withAllSubclasses size.
- 
- 	(oldClass == newClass and:[forceMutation not]) ifTrue:[
- 		"Recompile from newClass without mutating"
- 		self informUserDuring:[
- 			newClass isSystemDefined ifFalse:[progress := nil].
- 			CurrentReadOnlySourceFiles cacheDuring: [
- 				newClass withAllSubclassesDo:[:cl|
- 					self showProgressFor: cl.
- 					cl compileAll]]].
- 		^newClass].
- 	"Recompile and mutate oldClass to newClass"
- 	self informUserDuring:[
- 		newClass isSystemDefined ifFalse:[progress := nil].
- 		CurrentReadOnlySourceFiles cacheDuring: [
- 			self mutate: oldClass to: newClass].
- 	].
- 	^oldClass "now mutated to newClass"!

Item was removed:
- ----- Method: ClassBuilder>>recordClass:replacedBy: (in category 'private') -----
- recordClass: oldClass replacedBy: newClass
- 	"Keep the changes up to date when we're moving instVars around"
- 	(instVarMap includesKey: oldClass name) ifTrue:[
- 		SystemChangeNotifier uniqueInstance classDefinitionChangedFrom: oldClass to: newClass.
- 	].!

Item was removed:
- ----- Method: ClassBuilder>>reservedNames (in category 'private') -----
- reservedNames
- 	"Return a list of names that must not be used for variables"
- 	^#(self super thisContext #true #false #nil)!

Item was removed:
- ----- Method: ClassBuilder>>reshapeClass:toSuper: (in category 'class mutation') -----
- reshapeClass: oldClass toSuper: newSuper
- 	"Reshape the given class to the new super class. Recompile all the methods in the newly created class. Answer the new class."
- 	| instVars |
- 	instVars := instVarMap at: oldClass name ifAbsent: [oldClass instVarNames].
- 
- 	^self newSubclassOf: newSuper 
- 			type: oldClass typeOfClass 
- 			instanceVariables: instVars 
- 			from: oldClass!

Item was removed:
- ----- Method: ClassBuilder>>showProgressFor: (in category 'private') -----
- showProgressFor: aClass
- 	"Announce that we're processing aClass"
- 	progress == nil ifTrue:[^self].
- 	aClass isObsolete ifTrue:[^self].
- 	currentClassIndex := currentClassIndex + 1.
- 	(aClass hasMethods and: [aClass wantsRecompilationProgressReported]) ifTrue:
- 		[progress value: ('Recompiling ', aClass name,' (', currentClassIndex printString,'/', maxClassIndex printString,')')]!

Item was removed:
- ----- Method: ClassBuilder>>silentlyMoveInstVarNamed:from:to:after: (in category 'class definition') -----
- silentlyMoveInstVarNamed: instVarName from: srcClass to: dstClass after: prevInstVarName
- 	"Move the instvar from srcClass to dstClass.
- 	Do not perform any checks."
- 	| srcVars dstVars dstIndex newClass copyOfSrcClass copyOfDstClass |
- 	copyOfSrcClass := srcClass copy.
- 	copyOfDstClass := dstClass copy.
- 	
- 	srcVars := srcClass instVarNames copyWithout: instVarName.
- 	srcClass == dstClass
- 		ifTrue:[dstVars := srcVars]
- 		ifFalse:[dstVars := dstClass instVarNames].
- 	dstIndex := dstVars indexOf: prevInstVarName.
- 	dstVars := (dstVars copyFrom: 1 to: dstIndex),
- 				(Array with: instVarName),
- 				(dstVars copyFrom: dstIndex+1 to: dstVars size).
- 	instVarMap at: srcClass name put: srcVars.
- 	instVarMap at: dstClass name put: dstVars.
- 	(srcClass inheritsFrom: dstClass) ifTrue:[
- 		newClass := self reshapeClass: dstClass toSuper: dstClass superclass.
- 		self recompile: false from: dstClass to: newClass mutate: true.
- 	] ifFalse:[
- 		(dstClass inheritsFrom: srcClass) ifTrue:[
- 			newClass := self reshapeClass: srcClass toSuper: srcClass superclass.
- 			self recompile: false from: srcClass to: newClass mutate: true.
- 		] ifFalse:[ "Disjunct hierarchies"
- 			srcClass == dstClass ifFalse:[
- 				newClass := self reshapeClass: dstClass toSuper: dstClass superclass.
- 				self recompile: false from: dstClass to: newClass mutate: true.
- 			].
- 			newClass := self reshapeClass: srcClass toSuper: srcClass superclass.
- 			self recompile: false from: srcClass to: newClass mutate: true.
- 		].
- 	].
- 	self doneCompiling: srcClass.
- 	self doneCompiling: dstClass.
- 	SystemChangeNotifier uniqueInstance classDefinitionChangedFrom: copyOfSrcClass to: srcClass.
- 	SystemChangeNotifier uniqueInstance classDefinitionChangedFrom: copyOfDstClass to: dstClass.!

Item was removed:
- ----- Method: ClassBuilder>>superclass:ephemeronSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'public') -----
- superclass: aClass
- 	ephemeronSubclass: t instanceVariableNames: f 
- 	classVariableNames: d poolDictionaries: s category: cat
- 	"This is the standard initialization message for creating a new class as a 
- 	subclass of an existing class (the receiver) in which the subclass is to 
- 	have ephemeron semantics, i.e. where the object will be queued for
- 	finalization when the key (first) inst var is not reachable other than through
- 	the other fields of ephemerons with unreachable keys."
- 	| env |
- 	aClass isPointers ifFalse:
- 		[^self error: 'cannot make a pointer subclass of a class with non-pointer fields'].
- 	aClass instSize + f substrings size < 2 ifTrue:
- 		[^self error: 'cannot make an ephemeron class with less than two named instance variables'].
- 	env := CurrentEnvironment signal ifNil: [aClass environment].
- 	^self 
- 		name: t
- 		inEnvironment: env
- 		subclassOf: aClass
- 		type: #ephemeron
- 		instanceVariableNames: f
- 		classVariableNames: d
- 		poolDictionaries: s
- 		category: cat!

Item was removed:
- ----- Method: ClassBuilder>>superclass:immediateSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'public') -----
- superclass: aClass
- 	immediateSubclass: t instanceVariableNames: f 
- 	classVariableNames: d poolDictionaries: s category: cat
- 	"This is the standard initialization message for creating a
- 	 new immediate class as a subclass of an existing class."
- 	| env |
- 	aClass instSize > 0
- 		ifTrue: [^self error: 'cannot make an immediate subclass of a class with named fields'].
- 	aClass isVariable
- 		ifTrue: [^self error: 'cannot make an immediate subclass of a class with indexed instance variables'].
- 	aClass isPointers
- 		ifFalse: [^self error: 'cannot make an immediate subclass of a class without pointer fields'].
- 	"Cope with pre-environment and environment versions. Simplify asap."
- 	env := (Smalltalk classNamed: #EnvironmentRequest)
- 				ifNil: [aClass environment]
- 				ifNotNil: [:erc| erc signal ifNil: [aClass environment]].
- 	^self 
- 		name: t
- 		inEnvironment: env
- 		subclassOf: aClass
- 		type: #immediate
- 		instanceVariableNames: f
- 		classVariableNames: d
- 		poolDictionaries: s
- 		category: cat!

Item was removed:
- ----- Method: ClassBuilder>>superclass:subclass:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'public') -----
- superclass: newSuper
- 	subclass: t instanceVariableNames: f 
- 	classVariableNames: d poolDictionaries: s category: cat 
- 	"This is the standard initialization message for creating a new class as a 
- 	subclass of an existing class."
- 	| env |
- 	env := CurrentEnvironment signal ifNil: [newSuper environment].
- 	^self 
- 		name: t
- 		inEnvironment: env
- 		subclassOf: newSuper
- 		type: newSuper typeOfClass
- 		instanceVariableNames: f
- 		classVariableNames: d
- 		poolDictionaries: s
- 		category: cat!

Item was removed:
- ----- Method: ClassBuilder>>superclass:variableByteSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'public') -----
- superclass: aClass
- 	variableByteSubclass: n instanceVariableNames: f
- 	classVariableNames: d poolDictionaries: s category: cat
- 	"This is the standard initialization message for creating a new class as a subclass of an
- 	 existing class in which the subclass is to have indexable 8-bit byte-sized nonpointer variables."
- 	| existingOrSuperclass actualType env |
- 	aClass instSize > 0 ifTrue:
- 		[^self error: 'cannot make a byte subclass of a class with named fields'].
- 	(aClass isVariable and: [aClass isBytes not]) ifTrue:
- 		[^self error: 'cannot make an 8-bit byte subclass of a class with 16, 32 or 64 bit fields'].
- 	(aClass isVariable and: [aClass isPointers]) ifTrue:
- 		[^self error: 'cannot make a byte subclass of a class with pointer fields'].
- 	existingOrSuperclass := aClass environment at: n ifAbsent: [aClass].
- 	actualType := existingOrSuperclass typeOfClass == #compiledMethod
- 						ifTrue: [#compiledMethod]
- 						ifFalse: [#bytes].
- 	env := CurrentEnvironment signal ifNil: [aClass environment].
- 	^self 
- 		name: n
- 		inEnvironment: env
- 		subclassOf: aClass
- 		type: actualType
- 		instanceVariableNames: f
- 		classVariableNames: d
- 		poolDictionaries: s
- 		category: cat!

Item was removed:
- ----- Method: ClassBuilder>>superclass:variableDoubleByteSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'public') -----
- superclass: aClass
- 	variableDoubleByteSubclass: t instanceVariableNames: f
- 	classVariableNames: d poolDictionaries: s category: cat
- 	"This is the standard initialization message for creating a new class as a subclass of an
- 	 existing class in which the subclass is to have indexable 16-bit-sized nonpointer variables."
- 	| oldClassOrNil env |
- 	aClass instSize > 0
- 		ifTrue: [^self error: 'cannot make a byte subclass of a class with named fields'].
- 	(aClass isVariable and: [aClass isShorts not])
- 		ifTrue: [^self error: 'cannot make a 16-bit short subclass of a class with 8, 32 or 64 bit fields'].
- 	(aClass isVariable and: [aClass isPointers])
- 		ifTrue: [^self error: 'cannot make a byte subclass of a class with pointer fields'].
- 	oldClassOrNil := aClass environment at: t ifAbsent:[nil].
- 	env := CurrentEnvironment signal ifNil: [aClass environment].
- 	^self 
- 		name: t
- 		inEnvironment: env
- 		subclassOf: aClass
- 		type: #shorts
- 		instanceVariableNames: f
- 		classVariableNames: d
- 		poolDictionaries: s
- 		category: cat!

Item was removed:
- ----- Method: ClassBuilder>>superclass:variableDoubleWordSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'public') -----
- superclass: aClass
- 	variableDoubleWordSubclass: t instanceVariableNames: f
- 	classVariableNames: d poolDictionaries: s category: cat
- 	"This is the standard initialization message for creating a new class as a subclass of an
- 	 existing class in which the subclass is to have indexable 16-bit-sized nonpointer variables."
- 	| oldClassOrNil env |
- 	aClass instSize > 0
- 		ifTrue: [^self error: 'cannot make a byte subclass of a class with named fields'].
- 	(aClass isVariable and: [aClass isLongs not])
- 		ifTrue: [^self error: 'cannot make a 64-bit long subclass of a class with 8, 16 or 32 bit fields'].
- 	(aClass isVariable and: [aClass isPointers])
- 		ifTrue: [^self error: 'cannot make a byte subclass of a class with pointer fields'].
- 	oldClassOrNil := aClass environment at: t ifAbsent:[nil].
- 	env := CurrentEnvironment signal ifNil: [aClass environment].
- 	^self 
- 		name: t
- 		inEnvironment: env
- 		subclassOf: aClass
- 		type: #longs
- 		instanceVariableNames: f
- 		classVariableNames: d
- 		poolDictionaries: s
- 		category: cat!

Item was removed:
- ----- Method: ClassBuilder>>superclass:variableSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'public') -----
- superclass: aClass
- 	variableSubclass: t instanceVariableNames: f 
- 	classVariableNames: d poolDictionaries: s category: cat
- 	"This is the standard initialization message for creating a new class as a 
- 	subclass of an existing class in which the subclass is to 
- 	have indexable pointer variables."
- 	
- 	| env |
- 	aClass isBits ifTrue: 
- 		[^self error: 'cannot make a pointer subclass of a class with non-pointer fields'].
- 	env := CurrentEnvironment signal ifNil: [aClass environment].
- 	^self 
- 		name: t
- 		inEnvironment: env
- 		subclassOf: aClass
- 		type: #variable
- 		instanceVariableNames: f
- 		classVariableNames: d
- 		poolDictionaries: s
- 		category: cat!

Item was removed:
- ----- Method: ClassBuilder>>superclass:variableWordSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'public') -----
- superclass: aClass
- 	variableWordSubclass: t instanceVariableNames: f 
- 	classVariableNames: d poolDictionaries: s category: cat
- 	"This is the standard initialization message for creating a new class as a subclass of an
- 	 existing class in which the subclass is to have indexable 32-bit word-sized nonpointer variables."
- 	| env |
- 	aClass instSize > 0
- 		ifTrue: [^self error: 'cannot make a word subclass of a class with named fields'].
- 	(aClass isVariable and: [aClass isWords not])
- 		ifTrue: [^self error: 'cannot make a 32-bit word subclass of a class with 8, 16 or 64 bit fields'].
- 	(aClass isVariable and: [aClass isPointers])
- 		ifTrue: [^self error: 'cannot make a word subclass of a class with pointer fields'].
- 	env := CurrentEnvironment signal ifNil: [aClass environment].
- 	^self 
- 		name: t
- 		inEnvironment: env
- 		subclassOf: aClass
- 		type: #words
- 		instanceVariableNames: f
- 		classVariableNames: d
- 		poolDictionaries: s
- 		category: cat!

Item was removed:
- ----- Method: ClassBuilder>>superclass:weakSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'public') -----
- superclass: aClass
- 	weakSubclass: t instanceVariableNames: f 
- 	classVariableNames: d poolDictionaries: s category: cat
- 	"This is the standard initialization message for creating a new class as a 
- 	subclass of an existing class (the receiver) in which the subclass is to 
- 	have weak indexable pointer variables."
- 	| env |
- 	aClass isBits 
- 		ifTrue: [^self error: 'cannot make a pointer subclass of a class with non-pointer fields'].
- 	env := CurrentEnvironment signal ifNil: [aClass environment].
- 	^self 
- 		name: t
- 		inEnvironment: env
- 		subclassOf: aClass
- 		type: #weak
- 		instanceVariableNames: f
- 		classVariableNames: d
- 		poolDictionaries: s
- 		category: cat!

Item was removed:
- ----- Method: ClassBuilder>>tooDangerousClasses (in category 'private') -----
- tooDangerousClasses
- 	"Return a list of class names which will not be modified in the public interface"
- 	^#(
- 		"Object will break immediately"
- 		ProtoObject Object
- 		"Contexts and their superclasses"
- 		InstructionStream Context BlockClosure
- 		"Superclasses of basic collections"
- 		Collection SequenceableCollection ArrayedCollection
- 		"Collections known to the VM"
- 		Array Bitmap String Symbol ByteArray CompiledCode CompiledMethod CompiledBlock
- 		"Basic Numbers & Magnitudes"
- 		Magnitude Number SmallInteger Float BoxedFloat64 SmallFloat64 Character
- 		"Misc other"
- 		LookupKey Association Link Point Rectangle Behavior PositionableStream UndefinedObject
- 	)
- !

Item was removed:
- ----- Method: ClassBuilder>>update:to: (in category 'class mutation') -----
- update: oldClass to: newClass
- 	"Convert oldClass, all its instances and possibly its meta class into newClass,
- 	 instances of newClass and possibly its meta class. The process is surprisingly
- 	 simple in its implementation and surprisingly complex in its nuances and potentially
- 	 bad side effects.
- 	 We can rely on two assumptions (which are critical):
- 		#1: The method #updateInstancesFrom: will not create any lasting pointers to
- 			 'old' instances ('old' is quote on quote since #updateInstancesFrom: will do
- 			 a become of the old vs. the new instances and therefore it will not create
- 			 pointers to *new* instances before the #become: which are *old* afterwards)
- 		#2: The non-preemptive execution of the critical piece of code guarantees that
- 			 nobody can get a hold by 'other means' (such as process interruption and
- 			 reflection) on the old instances.
- 	 Given the above two, we know that after #updateInstancesFrom: there are no pointers
- 	 to any old instances. After the forwarding become there will be no pointers to the old
- 	 class or meta class either.
- 	 Andreas Raab, 2/27/2003 23:42"
- 	| meta |
- 	meta := oldClass isMeta.
- 	"Note: Everything from here on will run without the ability to get interrupted
- 	to prevent any other process to create new instances of the old class."
- 	["Note: The following removal may look somewhat obscure and needs an explanation.
- 	  When we mutate the class hierarchy we create new classes for any existing subclass.
- 	  So it may look as if we don't have to remove the old class from its superclass. However,
- 	  at the top of the hierarchy (the first class we reshape) that superclass itself is not newly
- 	  created so therefore it will hold both the oldClass and newClass in its (obsolete or not)
- 	  subclasses. Since the #become: below will transparently replace the pointers to oldClass
- 	  with newClass the superclass would have newClass in its subclasses TWICE. With rather
- 	  unclear effects if we consider that we may convert the meta-class hierarchy itself (which
- 	  is derived from the non-meta class hierarchy).
- 	  Due to this problem ALL classes are removed from their superclass just prior to converting
- 	  them. Here, breaking the superclass/subclass invariant really doesn't matter since we will
- 	  effectively remove the oldClass (becomeForward:) just a few lines below."
- 
- 		oldClass superclass removeSubclass: oldClass.
- 		oldClass superclass removeObsoleteSubclass: oldClass.
- 
- 		"make sure that the VM cache is clean"
- 		oldClass methodDict do: [:cm | cm flushCache].
- 		
- 		"Convert the instances of oldClass into instances of newClass"
- 		newClass updateInstancesFrom: oldClass.
- 
- 		meta
- 			ifTrue:
- 				[{oldClass} elementsForwardIdentityAndHashTo: {newClass}.
- 				 oldClass updateMethodBindingsTo: oldClass binding]
- 			ifFalse:
- 				[{oldClass. oldClass class} elementsForwardIdentityAndHashTo: {newClass. newClass class}.
- 				 oldClass updateMethodBindingsTo: oldClass binding.
- 				 oldClass class updateMethodBindingsTo: oldClass class binding].
- 
- 		"eem 5/31/2014 07:22 At this point there used to be a garbage collect whose purpose was
- 		 to ensure no old instances existed after the becomeForward:.  Without the GC it was possible
- 		 to resurrect old instances using e.g. allInstancesDo:.  This was because the becomeForward:
- 		 updated references from the old objects to new objects but didn't destroy the old objects.
- 		 But as of late 2013/early 2014 becomeForward: has been modified to free all the old objects."]
- 			valueUnpreemptively!

Item was removed:
- ----- Method: ClassBuilder>>validateClass:forMoving:downTo: (in category 'validation') -----
- validateClass: srcClass forMoving: iv downTo: dstClass
- 	"Make sure that we don't have any accesses to the instVar left"
- 	srcClass withAllSubclassesDo:[:cls|
- 		(cls == dstClass or:[cls inheritsFrom: dstClass]) ifFalse:[
- 			(cls whichSelectorsAccess: iv) isEmpty ifFalse:[
- 				self notify: (iv printString asText allBold), ' is still used in ', cls name asText allBold,'.
- Proceed to move it to Undeclared'.
- 			].
- 		].
- 	].
- 	^true!

Item was removed:
- ----- Method: ClassBuilder>>validateClass:forMoving:upTo: (in category 'validation') -----
- validateClass: srcClass forMoving: iv upTo: dstClass
- 	"Make sure we don't have this instvar already"
- 	dstClass withAllSubclassesDo:[:cls|
- 		(cls == srcClass or:[cls inheritsFrom: srcClass]) ifFalse:[
- 			cls isPointers ifFalse:[
- 				self error: dstClass name, ' cannot have instance variables'.
- 				^false].
- 			cls instSize >= 254 ifTrue:[
- 				self error: cls name, ' has more than 254 instance variables'.
- 				^false].
- 			(cls instVarNames includes: iv) ifTrue:[
- 				self notify: (iv printString asText allBold),' is defined in ', cls name asText allBold,'
- Proceed to move it up to ', dstClass name asText allBold,' as well'.
- 				instVarMap at: cls name put: (cls instVarNames copyWithout: iv)].
- 		].
- 	].
- 	^true!

Item was removed:
- ----- Method: ClassBuilder>>validateClassName: (in category 'validation') -----
- validateClassName: aString
- 	"Validate the new class name"
- 	aString first canBeGlobalVarInitial ifFalse:[
- 		self error: 'Class names must be capitalized'.
- 		^false].
- 	environ at: aString ifPresent:[:old|
- 		(old isKindOf: Behavior) ifFalse:[
- 			self notify: aString asText allBold, 
- 						' already exists!!\Proceed will store over it.' withCRs]].
- 	^true!

Item was removed:
- ----- Method: ClassBuilder>>validateClassvars:from:forSuper: (in category 'validation') -----
- validateClassvars: classVarArray from: oldClass forSuper: newSuper
- 	"Check if any of the classVars of oldClass conflict with the new superclass"
- 	| usedNames classVars temp |
- 	classVarArray isEmpty ifTrue:[^true]. "Okay"
- 
- 	"Validate the class var names"
- 	usedNames := classVarArray asSet.
- 	usedNames size = classVarArray size 
- 		ifFalse:[	classVarArray do:[:var|
- 					usedNames remove: var ifAbsent:[temp := var]].
- 				self error: temp,' is multiply defined'. ^false].
- 	(usedNames includesAnyOf: self reservedNames) 
- 		ifTrue:[	self reservedNames do:[:var|
- 					(usedNames includes: var) ifTrue:[temp := var]].
- 				self error: temp,' is a reserved name'. ^false].
- 
- 	newSuper == nil ifFalse:[
- 		usedNames := newSuper allClassVarNames asSet.
- 		classVarArray do:[:iv|
- 			(usedNames includes: iv) ifTrue:[
- 				newSuper withAllSuperclassesDo:[:cl|
- 					(cl classVarNames includes: iv) ifTrue:[temp := cl]].
- 				(DuplicateVariableError new)
- 					superclass: temp;
- 					variable: iv;
- 					signal: iv,' is already defined in ', temp name]]].
- 
- 	oldClass == nil ifFalse:[
- 		usedNames := Set new: 20.
- 		oldClass allSubclassesDo:[:cl| usedNames addAll: cl classVarNames].
- 		classVars := classVarArray.
- 		newSuper == nil ifFalse:[classVars := classVars, newSuper allClassVarNames asArray].
- 		classVars do:[:iv|
- 			(usedNames includes: iv) ifTrue:[
- 				(DuplicateVariableError new)
- 					superclass: oldClass;
- 					variable: iv;
- 					signal: iv, ' is already defined in a subclass of ', oldClass name]]].
- 	^true!

Item was removed:
- ----- Method: ClassBuilder>>validateInstvars:from:forSuper: (in category 'validation') -----
- validateInstvars: instVarArray from: oldClass forSuper: newSuper 
- 	"Check if any of the instVars of oldClass conflict with the new superclass"
- 	| usedNames |
- 	usedNames := instVarArray asSet.
- 	oldClass ifNotNil: [ oldClass withAllSubclassesDo: [ : each | each == oldClass ifFalse: [usedNames addAll: each instVarNames] ] ].
- 	"Anything to possibly conflict?"
- 	usedNames isEmpty ifTrue: [ ^ true ].
- 	newSuper allowsSubInstVars ifFalse:
- 		[ self error: newSuper printString , ' does not allow subclass inst vars. See allowsSubInstVars.'.
- 		^ false ].
- 	instVarArray asSet size = instVarArray size ifFalse:
- 		[ self error: instVarArray asBag sortedCounts first value, ' is multply defined.'.
- 		^ false ].
- 	(usedNames intersection: self reservedNames) ifNotEmpty:
- 		[ : reservedWords | self error: reservedWords anyOne , ' is a reserved name'.
- 		^ false ].
- 	newSuper ifNotNil:
- 		[ | offendingVars |
- 		"If any variable names in subclasses conflict names in the new superclass, report the offending class and instVar name."
- 		newSuper withAllSuperclasses
- 			detect: [ : each | (offendingVars := each instVarNames intersection: usedNames) notEmpty ]
- 			ifFound:
- 				[ : offendingSuperclass | 
- 				DuplicateVariableError new
- 					 superclass: offendingSuperclass ;
- 					 variable: offendingVars anyOne ;
- 					 signal: offendingVars anyOne , ' is already defined in ' , offendingSuperclass name ]
- 			ifNone: [ "no name conflicts" ] ].
- 	^ true!

Item was removed:
- ----- Method: ClassBuilder>>validateSubclass:canKeepLayoutFrom:forSubclassFormat: (in category 'validation') -----
- validateSubclass: subclass canKeepLayoutFrom: oldClass forSubclassFormat: newType 
- 	"Returns whether the immediate subclasses of oldClass can keep its layout"
- 	"Note: Squeak does not appear to model classFormat relationships.. so I'm putting some logic here. bkv 4/2/2003"
- 	
- 	"Only run this test for a real subclass - otherwise this prevents changing
- 	a class from #subclass: to #variableSubclass: etc."
- 	subclass = oldClass ifTrue:[^true].
- 
- 	 "isWeak implies isVariant"					
- 	 (oldClass isVariable and: [ subclass isWeak ])
- 		ifFalse: [ "In general we discourage format mis-matches"
- 				  (subclass typeOfClass == newType) 
- 				   	ifFalse: [ self error: subclass name,' cannot be recompiled'.
- 							  ^ false ]].
- 	^ true!

Item was removed:
- ----- Method: ClassBuilder>>validateSubclassFormat:from:forSuper:extra: (in category 'validation') -----
- validateSubclassFormat: newType from: oldClass forSuper: newSuper extra: newInstSize
- 	"Validate the # of instVars and the format of the subclasses"
- 	| deltaSize |
- 	oldClass == nil ifTrue: [^ true]. "No subclasses"
- 	"Compute the # of instvars needed for all subclasses"
- 	deltaSize := newInstSize.
- 	(oldClass notNil)
- 		ifTrue: [deltaSize := deltaSize - oldClass instVarNames size].
- 	(newSuper notNil)
- 		ifTrue: [deltaSize := deltaSize + newSuper instSize].
- 	(oldClass notNil and: [oldClass superclass notNil]) 
- 		ifTrue: [deltaSize := deltaSize - oldClass superclass instSize].
- 	(oldClass == nil)
- 		 ifTrue: [ (deltaSize > 254)
- 					ifTrue: [ self error: 'More than 254 instance variables'.
- 							^ false].
- 				  ^ true].
- 
- 	oldClass withAllSubclassesDo: [:sub |  ( sub instSize + deltaSize > 254 )
- 											ifTrue: [ self error: sub name,' has more than 254 instance variables'.
- 					 								^ false].
- 
- 										"If we get this far, check whether the immediate subclasses of oldClass can keep its layout."
-                							(newType ~~ #normal) 
- 											ifTrue: [ self validateSubclass: sub canKeepLayoutFrom: oldClass forSubclassFormat: newType ]].
- 
- 	^ true!

Item was removed:
- ----- Method: ClassBuilder>>validateSuperclass:forSubclass: (in category 'validation') -----
- validateSuperclass: aSuperClass forSubclass: aClass
- 	"Check if it is okay to use aSuperClass as the superclass of aClass"
- 	aClass == nil ifTrue:["New class"
- 		(aSuperClass == nil or:[aSuperClass isBehavior and:[aSuperClass isMeta not]])
- 			ifFalse:[self error: aSuperClass name,' is not a valid superclass'.
- 					^false].
- 		^true].
- 	aSuperClass == aClass superclass ifTrue:[^true]. "No change"
- 	(aClass isMeta) "Not permitted - meta class hierarchy is derived from class hierarchy"
- 		ifTrue:[^self error: aClass name, ' must inherit from ', aClass superclass name].
- 	"Check for circular references"
- 	(aSuperClass ~~ nil and:[aSuperClass == aClass or:[aSuperClass inheritsFrom: aClass]])
- 		ifTrue:[self error: aSuperClass name,' inherits from ', aClass name.
- 				^false].
- 	^true!

Item was removed:
- Object subclass: #ClassCategoryReader
- 	instanceVariableNames: 'class category changeStamp'
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'Kernel-Classes'!
- 
- !ClassCategoryReader commentStamp: '<historical>' prior: 0!
- I represent a mechanism for retrieving class descriptions stored on a file.!

Item was removed:
- ----- Method: ClassCategoryReader>>scanFrom: (in category 'fileIn/Out') -----
- scanFrom: aStream 
- 	"File in methods from the stream, aStream."
- 	| methodText |
- 	[methodText := aStream nextChunkText.
- 	 methodText size > 0]
- 		whileTrue:
- 		[class compile: methodText classified: category
- 			withStamp: changeStamp notifying: nil]!

Item was removed:
- ----- Method: ClassCategoryReader>>scanFrom:environment: (in category 'fileIn/Out') -----
- scanFrom: aStream environment: anEnvironment
- 	"File in methods from the stream, aStream."
- 	| methodText |
- 	[methodText := aStream nextChunkText.
- 	 methodText size > 0] whileTrue:
- 		[class 
- 			compile: methodText 
- 			environment: anEnvironment
- 			classified: category
- 			withStamp: changeStamp 
- 			notifying: nil]!

Item was removed:
- ----- Method: ClassCategoryReader>>scanFromNoCompile: (in category 'fileIn/Out') -----
- scanFromNoCompile: aStream 
- 	"Just move the source code for the methods from aStream."
- 	| methodText selector |
- 
- 	[methodText := aStream nextChunkText.
- 	 methodText size > 0]
- 		whileTrue:
- 		[(SourceFiles at: 2) ifNotNil: [
- 			selector := class newParser parseSelector: methodText.
- 			(class compiledMethodAt: selector) putSource: methodText 
- 				fromParseNode: nil class: class category: category
- 				withStamp: changeStamp inFile: 2 priorMethod: nil]]!

Item was removed:
- ----- Method: ClassCategoryReader>>scanFromNoCompile:forSegment: (in category 'fileIn/Out') -----
- scanFromNoCompile: aStream forSegment: anImageSegment
- 
- 	^self scanFromNoCompile: aStream 	"subclasses may care about the segment"!

Item was removed:
- ----- Method: ClassCategoryReader>>setClass:category: (in category 'private') -----
- setClass: aClass category: aCategory
- 	^ self setClass: aClass category: aCategory changeStamp: String new
- !

Item was removed:
- ----- Method: ClassCategoryReader>>setClass:category:changeStamp: (in category 'private') -----
- setClass: aClass category: aCategory changeStamp: aString
- 
- 	class := aClass.
- 	category := aCategory.
- 	changeStamp := aString
- !

Item was removed:
- ----- Method: ClassCategoryReader>>theClass (in category 'private') -----
- theClass
- 
- 	^ class!

Item was removed:
- ClassCategoryReader subclass: #ClassCommentReader
- 	instanceVariableNames: ''
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'Kernel-Classes'!

Item was removed:
- ----- Method: ClassCommentReader>>scanFrom: (in category 'filein/Out') -----
- scanFrom: aStream 
- 	"File in the class comment from aStream.  Not string-i-fied, just a text, exactly as it is in the browser.  Move to changes file."
- 
- 	class theNonMetaClass classComment: (aStream nextChunkText) stamp: changeStamp
- 		"Writes it on the disk and saves a RemoteString ref"!

Item was removed:
- ----- Method: ClassCommentReader>>scanFrom:environment: (in category 'filein/Out') -----
- scanFrom: aStream environment: anEnvironment
- 	^ self scanFrom: aStream!

Item was removed:
- ----- Method: ClassCommentReader>>scanFromNoCompile: (in category 'filein/Out') -----
- scanFromNoCompile: aStream 
- 	"File in the class comment from aStream.  Not string-i-fied, just a text, exactly as it is in the browser.  Move to changes file."
- 
- 	self scanFrom: aStream.	"for comments, the same as usual"!

Item was removed:
- Behavior subclass: #ClassDescription
- 	instanceVariableNames: 'instanceVariables organization'
- 	classVariableNames: 'AcceptsLoggingOfCompilation TraitImpl'
- 	poolDictionaries: ''
- 	category: 'Kernel-Classes'!
- 
- !ClassDescription commentStamp: '<historical>' prior: 0!
- I add a number of facilities to basic Behaviors:
- 	Named instance variables
- 	Category organization for methods
- 	The notion of a name of this class (implemented as subclass responsibility)
- 	The maintenance of a ChangeSet, and logging changes on a file
- 	Most of the mechanism for fileOut.
- 	
- I am an abstract class, in particular, my facilities are intended for inheritance by two subclasses, Class and Metaclass.
- 
- The slots 'organization' and 'methodDict' should ONLY be accessed by message in order for things to work during ImageSegment>>discoverActiveClasses (q.v.).!

Item was removed:
- ----- Method: ClassDescription class>>logCompiledSources (in category 'compiling') -----
- logCompiledSources
- 	<preference: 'Log compilations to changes file'
- 		category: 'general'
- 		description: 'If enabled, the code being compiled will get logged to the changes file. Disabling allows loading code with no changes file in use. See also #warnIfNoChangesFile and #warnIfNoSourcesFile and #readDocumentAtStartup. You can configure a silent image/DoItFirst for, e.g., server environments.'
- 		type: #Boolean>
- 
- 	^ AcceptsLoggingOfCompilation ifNil: [true]!

Item was removed:
- ----- Method: ClassDescription class>>logCompiledSources: (in category 'compiling') -----
- logCompiledSources: aBoolean
- 	^ AcceptsLoggingOfCompilation := aBoolean!

Item was removed:
- ----- Method: ClassDescription>>acceptsLoggingOfCompilation (in category 'compiling') -----
- acceptsLoggingOfCompilation
- 	"weird name is so that it will come lexically before #compile, so that a clean build can make it through.  7/7/96 sw"
- 
- 	^AcceptsLoggingOfCompilation ifNil: [true]!

Item was removed:
- ----- Method: ClassDescription>>addAndClassifySelector:withMethod:inProtocol:notifying: (in category 'accessing method dictionary') -----
- addAndClassifySelector: selector withMethod: compiledMethod inProtocol: category notifying: requestor
- 	| priorMethodOrNil |
- 	priorMethodOrNil := self compiledMethodAt: selector ifAbsent: [nil].
- 	self addSelectorSilently: selector withMethod: compiledMethod.
- 	SystemChangeNotifier uniqueInstance 
- 		doSilently: [self organization classify: selector under: category].
- 	priorMethodOrNil isNil
- 		ifTrue: [SystemChangeNotifier uniqueInstance methodAdded: compiledMethod selector: selector inProtocol: category class: self requestor: requestor]
- 		ifFalse: [SystemChangeNotifier uniqueInstance methodChangedFrom: priorMethodOrNil to: compiledMethod selector: selector inClass: self requestor: requestor].!

Item was removed:
- ----- Method: ClassDescription>>addInstVarName: (in category 'instance variables') -----
- addInstVarName: aString 
- 	"Add the argument, aString, as one of the receiver's instance variables."
- 
- 	self subclassResponsibility!

Item was removed:
- ----- Method: ClassDescription>>addSelector:withMethod:notifying: (in category 'accessing method dictionary') -----
- addSelector: selector withMethod: compiledMethod notifying: requestor
- 	| priorMethodOrNil |
- 	priorMethodOrNil := self compiledMethodAt: selector ifAbsent: [nil].
- 	self addSelectorSilently: selector withMethod: compiledMethod.
- 	priorMethodOrNil isNil
- 		ifTrue: [SystemChangeNotifier uniqueInstance methodAdded: compiledMethod selector: selector inClass: self requestor: requestor]
- 		ifFalse: [SystemChangeNotifier uniqueInstance methodChangedFrom: priorMethodOrNil to: compiledMethod selector: selector inClass: self requestor: requestor].!

Item was removed:
- ----- Method: ClassDescription>>addSelectorSilently:withMethod: (in category 'accessing method dictionary') -----
- addSelectorSilently: selector withMethod: compiledMethod
- 	super addSelectorSilently: selector withMethod: compiledMethod.
- 	self instanceSide noteAddedSelector: selector meta: self isMeta.!

Item was removed:
- ----- Method: ClassDescription>>allInstVarNamesEverywhere (in category 'instance variables') -----
- allInstVarNamesEverywhere
- 	"Answer the set of inst var names used by the receiver, all superclasses, and all subclasses"
- 
- 	| aList |
- 	aList := OrderedCollection new.
- 	(self allSuperclasses , self withAllSubclasses asOrderedCollection) do:
- 		[:cls | aList addAll: cls instVarNames].
- 	^ aList asSet
- 
- 	"BorderedMorph allInstVarNamesEverywhere"!

Item was removed:
- ----- Method: ClassDescription>>allMethodCategoriesIntegratedThrough: (in category 'accessing method dictionary') -----
- allMethodCategoriesIntegratedThrough: mostGenericClass
- 	"Answer a list of all the method categories of the receiver and all its superclasses, up through mostGenericClass"
- 
- 	| aColl |
- 	aColl := Set new.
- 	self withAllSuperclasses do:
- 		[:aClass |
- 		(aClass includesBehavior: mostGenericClass) ifTrue:
- 			[aColl addAll: aClass organization categories]].
- 	aColl remove: 'no messages' asSymbol ifAbsent: [].
- 
- 	^aColl asArray sort: [:a :b | a asLowercase < b asLowercase]
- 
- "ColorTileMorph allMethodCategoriesIntegratedThrough: TileMorph"!

Item was removed:
- ----- Method: ClassDescription>>allMethodsInCategory: (in category 'accessing method dictionary') -----
- allMethodsInCategory: aName 
- 	"Answer a list of all the method categories of the receiver and all its 
- 	superclasses "
- 	| set |
- 	set := Set new.
- 	self withAllSuperclassesDo: [:aClass |
- 		set	addAll: (
- 			aName = ClassOrganizer allCategory
- 					ifTrue: [aClass organization allMethodSelectors]
- 					ifFalse: [aClass organization listAtCategoryNamed: aName])].
- 	^set sorted
- 
- 	"TileMorph allMethodsInCategory: #initialization"!

Item was removed:
- ----- Method: ClassDescription>>category (in category 'organization') -----
- category
- 	"Answer the system organization category for the receiver."
- 
- 	^ self environment organization categoryOfElement: self name!

Item was removed:
- ----- Method: ClassDescription>>checkForInstVarsOK: (in category 'instance variables') -----
- checkForInstVarsOK: instVarString
- 	"Return true if instVarString does no include any names used in a subclass"
- 	| instVarArray |
- 	instVarArray := Scanner new scanFieldNames: instVarString.
- 	self allSubclasses do:
- 		[:cl | cl instVarNames do:
- 			[:n | (instVarArray includes: n)
- 				ifTrue: [self error: n , ' is already used in ' , cl name.
- 						^ false]]].
- 	^ true!

Item was removed:
- ----- Method: ClassDescription>>chooseInstVarAlphabeticallyThenDo: (in category 'instance variables') -----
- chooseInstVarAlphabeticallyThenDo: aBlock
- 	| allVars index |
- 	"Put up a menu of all the instance variables in the receiver, presented in alphabetical order, and when the user chooses one, evaluate aBlock with the chosen variable as its parameter."
- 
- 	allVars := self allInstVarNames.
- 	allVars isEmpty ifTrue: [^ self inform: 'There are no
- instance variables'].
- 	allVars sort.
- 
- 	index := (UIManager default chooseFrom: allVars lines: #() title: 'Instance variables in
- ', self name).
- 	index = 0 ifTrue: [^ self].
- 	aBlock value: (allVars at: index)!

Item was removed:
- ----- Method: ClassDescription>>chooseVarThenDo: (in category 'instance variables') -----
- chooseVarThenDo: 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."
- 	| lines labelStream allVars index |
- 	(self allInstVarNames size + self theNonMetaClass allClassVarNames size) = 0 ifTrue: [ ^ self inform: 'There are no variables.' ].
- 	allVars := OrderedCollection new.
- 	lines := OrderedCollection new.
- 	labelStream := WriteStream on: (String new: 200).
- 	self withAllSuperclasses do:
- 		[ : class | | vars |
- 		vars := class instVarNames , class theNonMetaClass classVarNames.
- 		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 := Project uiManager
- 		chooseFrom: (labelStream contents lines)
- 		lines: lines
- 		title: 'Variables in ' , self name.
- 	index = 0 ifTrue: [ ^ self ].
- 	aBlock value: (allVars at: index)!

Item was removed:
- ----- Method: ClassDescription>>classComment: (in category 'fileIn/Out') -----
- classComment: aString
- 	"Store the comment, aString or Text or RemoteString, associated with the class we are orgainzing.  Empty string gets stored only if had a non-empty one before."
- 	^ self classComment: aString stamp: '<historical>'!

Item was removed:
- ----- Method: ClassDescription>>classComment:stamp: (in category 'fileIn/Out') -----
- classComment: aString stamp: aStamp
- 	"Store the comment, aString or Text or RemoteString, associated with the class we are organizing.  Empty string gets stored only if had a non-empty one before."
- 
- 	| ptr header file oldCommentRemoteStr |
- 	(aString isKindOf: RemoteString) ifTrue:
- 		[SystemChangeNotifier uniqueInstance classCommented: self.
- 		^ self organization classComment: aString stamp: aStamp].
- 
- 	oldCommentRemoteStr := self organization commentRemoteStr.
- 	(aString size = 0) & (oldCommentRemoteStr == nil) ifTrue: [^ self organization classComment: nil].
- 		"never had a class comment, no need to write empty string out"
- 
- 	ptr := oldCommentRemoteStr ifNil: [0] ifNotNil: [oldCommentRemoteStr sourcePointer].
- 	SourceFiles ifNotNil: [(file := SourceFiles at: 2) ifNotNil:
- 		[file setToEnd; cr; nextPut: $!!.	"directly"
- 		"Should be saying (file command: 'H3') for HTML, but ignoring it here"
- 		header := String streamContents: [:strm | strm nextPutAll: self name;
- 			nextPutAll: ' commentStamp: '.
- 			aStamp storeOn: strm.
- 			strm nextPutAll: ' prior: '; nextPutAll: ptr printString].
- 		file nextChunkPut: header]].
- 	self organization classComment: (RemoteString newString: aString onFileNumber: 2) stamp: aStamp.
- 	file ifNotNil: [ InMidstOfFileinNotification signal ifFalse: [ file flush ] ].
- 	SystemChangeNotifier uniqueInstance classCommented: self.
- !

Item was removed:
- ----- Method: ClassDescription>>classCommentBlank (in category 'accessing comment') -----
- classCommentBlank
- 
- 	^String streamContents:
- 		[:stream|
- 		 stream
- 			nextPutAll: 'A';
- 			nextPutAll: (self name first isVowel ifTrue: ['n '] ifFalse: [' ']);
- 			nextPutAll: self name;
- 			nextPutAll: ' is xxxxxxxxx.';
- 			cr; cr;
- 			nextPutAll: 'Instance Variables'.
- 
- 		 self instVarNames sorted do: [:each |
- 			stream
- 				crtab; nextPutAll: each;
- 				nextPut: $:;
- 				tab: 2;
- 				nextPutAll: '<Object>'].
- 		  stream cr.
- 		  self instVarNames sorted do: [:each |
- 			stream
- 				cr; nextPutAll: each;
- 				crtab; nextPutAll: '- xxxxx'; cr]]!

Item was removed:
- ----- Method: ClassDescription>>classSide (in category 'accessing parallel hierarchy') -----
- classSide
- 	^self theMetaClass!

Item was removed:
- ----- Method: ClassDescription>>classThatDefinesClassVariable: (in category 'instance variables') -----
- classThatDefinesClassVariable: classVarName
- 	"Answer the class that defines the given class variable"
- 
- 	(self classPool includesKey: classVarName asSymbol) ifTrue: [^ self]. 
- 	^self superclass ifNotNil: [self superclass classThatDefinesClassVariable: classVarName]!

Item was removed:
- ----- Method: ClassDescription>>classThatDefinesInstanceVariable: (in category 'instance variables') -----
- classThatDefinesInstanceVariable: instVarName
- 	(self instVarNames notNil and: [self instVarNames includes: instVarName asString]) ifTrue: [^ self]. 
- 	^self superclass ifNotNil: [self superclass classThatDefinesInstanceVariable: instVarName]!

Item was removed:
- ----- Method: ClassDescription>>classVariablesString (in category 'printing') -----
- classVariablesString
- 	"Answer a string of my class variable names separated by spaces."
- 
- 	^String streamContents: [ :stream | 
- 		self classVarNames 
- 			do: [ :each | stream nextPutAll: each ]
- 			separatedBy: [ stream space ] ]!

Item was removed:
- ----- Method: ClassDescription>>classVersion (in category 'accessing') -----
- classVersion
- 	"Default.  Any class may return a later version to inform readers that use ReferenceStream.  8/17/96 tk"
- 	"This method allows you to distinguish between class versions when the shape of the class 
- 	hasn't changed (when there's no change in the instVar names).
- 	In the conversion methods you usually can tell by the inst var names 
- 	what old version you have. In a few cases, though, the same inst var 
- 	names were kept but their interpretation changed (like in the layoutFrame).
- 	By changing the class version when you keep the same instVars you can 
- 	warn older and newer images that they have to convert."
- 	^ 0!

Item was removed:
- ----- Method: ClassDescription>>classesThatImplementAllOf: (in category 'accessing class hierarchy') -----
- classesThatImplementAllOf: selectorSet
- 	"Return an array of any classes that implement all the messages in selectorSet."
- 
- 	| found remaining |
- 	found := OrderedCollection new.
- 	selectorSet do:
- 		[:sel | (self methodDict includesKey: sel) ifTrue: [found add: sel]].
- 	found isEmpty
- 		ifTrue: [^ self subclasses inject: Array new
- 						into: [:subsThatDo :sub |
- 							subsThatDo , (sub classesThatImplementAllOf: selectorSet)]]
- 		ifFalse: [remaining := selectorSet copyWithoutAll: found.
- 				remaining isEmpty ifTrue: [^ Array with: self].
- 				^ self subclasses inject: Array new
- 						into: [:subsThatDo :sub |
- 							subsThatDo , (sub classesThatImplementAllOf: remaining)]]!

Item was removed:
- ----- Method: ClassDescription>>comment (in category 'accessing comment') -----
- comment
- 	"Answer the receiver's comment. (If missing, supply a template) "
- 	| aString |
- 	aString := self instanceSide organization classComment.
- 	aString isEmpty ifFalse: [^ aString].
- 	^self classCommentBlank!

Item was removed:
- ----- Method: ClassDescription>>comment: (in category 'accessing comment') -----
- comment: aStringOrText
- 	"Set the receiver's comment to be the argument, aStringOrText."
- 
- 	self instanceSide classComment: aStringOrText.!

Item was removed:
- ----- Method: ClassDescription>>comment:stamp: (in category 'accessing comment') -----
- comment: aStringOrText stamp: aStamp
- 	"Set the receiver's comment to be the argument, aStringOrText."
- 
- 	self instanceSide classComment: aStringOrText stamp: aStamp.!

Item was removed:
- ----- Method: ClassDescription>>commentFollows (in category 'fileIn/Out') -----
- commentFollows 
- 	"Answer a ClassCommentReader who will scan in the comment."
- 
- 	^ ClassCommentReader new setClass: self category: #Comment
- 
- 	"False commentFollows inspect"!

Item was removed:
- ----- Method: ClassDescription>>commentInventory (in category 'accessing class hierarchy') -----
- commentInventory
- 	"Answer a string with a count of the classes with and without comments 
- 	for all the classes in the package of which this class is a member."
- 
- 	"Morph commentInventory"
- 
- 	^ SystemOrganization commentInventory: (self category copyUpTo: $-), '*'!

Item was removed:
- ----- Method: ClassDescription>>commentStamp: (in category 'fileIn/Out') -----
- commentStamp: changeStamp
- 	self organization commentStamp: changeStamp.
- 	^ self commentStamp: changeStamp prior: 0!

Item was removed:
- ----- Method: ClassDescription>>commentStamp:prior: (in category 'fileIn/Out') -----
- commentStamp: changeStamp prior: indexAndOffset
- 	"Prior source link ignored when filing in."
- 
- 	^ ClassCommentReader new setClass: self
- 				category: #Comment
- 				changeStamp: changeStamp!

Item was removed:
- ----- Method: ClassDescription>>compile:classified: (in category 'compiling') -----
- compile: code classified: heading 
- 	"Compile the argument, code, as source code in the context of the 
- 	receiver and install the result in the receiver's method dictionary under 
- 	the classification indicated by the second argument, heading. nil is to be 
- 	notified if an error occurs. The argument code is either a string or an 
- 	object that converts to a string or a PositionableStream on an object that 
- 	converts to a string."
- 
- 	^self
- 		compile: code
- 		classified: heading
- 		notifying: nil!

Item was removed:
- ----- Method: ClassDescription>>compile:classified:notifying: (in category 'compiling') -----
- compile: text classified: category notifying: requestor
- 	| stamp |
- 	stamp := self acceptsLoggingOfCompilation ifTrue: [Utilities changeStamp] ifFalse: [nil].
- 	^ self compile: text classified: category
- 		withStamp: stamp notifying: requestor!

Item was removed:
- ----- Method: ClassDescription>>compile:classified:withStamp:notifying: (in category 'compiling') -----
- compile: text classified: category withStamp: changeStamp notifying: requestor
- 	^ self compile: text classified: category withStamp: changeStamp notifying: requestor logSource: self acceptsLoggingOfCompilation!

Item was removed:
- ----- Method: ClassDescription>>compile:classified:withStamp:notifying:logSource: (in category 'compiling') -----
- compile: text classified: category withStamp: changeStamp notifying: requestor logSource: logSource 
- 
- 	^self
- 		compile: text
- 		environment: (CurrentEnvironment signal ifNil: [ self environment ])
- 		classified: category
- 		withStamp: changeStamp
- 		notifying: requestor
- 		logSource: logSource!

Item was removed:
- ----- Method: ClassDescription>>compile:environment:classified:withStamp:notifying: (in category 'compiling') -----
- compile: text environment: anEnvironment classified: category withStamp: changeStamp notifying: requestor
- 	^ self 
- 		compile: text 
- 		environment: anEnvironment 
- 		classified: category 
- 		withStamp: changeStamp 
- 		notifying: requestor 
- 		logSource: self acceptsLoggingOfCompilation!

Item was removed:
- ----- Method: ClassDescription>>compile:environment:classified:withStamp:notifying:logSource: (in category 'compiling') -----
- compile: text environment: anEnvironment classified: category withStamp: changeStamp notifying: requestor logSource: logSource
- 
- 	^self
- 		compileCue: (CompilationCue
- 						source: text
- 						class: self
- 						environment: anEnvironment
- 						requestor: requestor)
- 		classified: category
- 		withStamp: changeStamp
- 		logSource: logSource!

Item was removed:
- ----- Method: ClassDescription>>compile:notifying: (in category 'compiling') -----
- compile: code notifying: requestor 
- 	"Refer to the comment in Behavior|compile:notifying:." 
- 
- 	^self compile: code
- 		 classified: ClassOrganizer default
- 		 notifying: requestor!

Item was removed:
- ----- Method: ClassDescription>>compileCue:classified:withStamp:logSource: (in category 'compiling') -----
- compileCue: compilationCue classified: category withStamp: changeStamp logSource: logSource
- 
- 	| methodAndNode methodNode selector |
- 	methodNode := self newCompiler compile: compilationCue ifFail: [^nil].
- 	methodAndNode := CompiledMethodWithNode 
- 							generateMethodFromNode: methodNode 
- 							trailer: (compilationCue methodTrailer ifNil:
- 										[self defaultMethodTrailerIfLogSource: logSource]).
- 	selector := methodAndNode selector.
- 	logSource ifTrue:
- 		[self
- 			logMethodSource: compilationCue source
- 			forMethodWithNode: methodAndNode 
- 			inCategory: category
- 			withStamp: changeStamp
- 			notifying: compilationCue requestor.
- 		RecentMessages default
- 			recordSelector: selector
- 			forClass: methodAndNode method methodClass
- 			inEnvironment: compilationCue environment].
- 	self
- 		addAndClassifySelector: selector
- 		withMethod: methodAndNode method
- 		inProtocol: category
- 		notifying: compilationCue requestor.
- 	self instanceSide
- 		noteCompilationOf: selector
- 		meta: self isClassSide.
- 	^selector!

Item was removed:
- ----- Method: ClassDescription>>compileSilently: (in category 'compiling') -----
- compileSilently: code 
- 	"Compile the code, leaving no trail in the system log, nor in any change set, nor in the 'recent submissions' list. This should only be used when you know for sure that the compilation will succeed."
- 
- 	^ self compileSilently: code classified: ClassOrganizer default.!

Item was removed:
- ----- Method: ClassDescription>>compileSilently:classified: (in category 'compiling') -----
- compileSilently: code classified: category
- 	"Compile the code and classify the resulting method in the given category, leaving no trail in the system log, nor in any change set, nor in the 'recent submissions' list. This should only be used when you know for sure that the compilation will succeed."
- 
- 	^ self compileSilently: code classified: category notifying: nil.!

Item was removed:
- ----- Method: ClassDescription>>compileSilently:classified:notifying: (in category 'compiling') -----
- compileSilently: code classified: category notifying: requestor
- 	"Compile the code and classify the resulting method in the given category, leaving no trail in the system log, nor in any change set, nor in the 'recent submissions' list. This should only be used when you know for sure that the compilation will succeed."
- 
- 	^self
- 		compileSilently: code
- 		environment: (CurrentEnvironment signal ifNil: [ self environment ])
- 		classified: category
- 		notifying: requestor!

Item was removed:
- ----- Method: ClassDescription>>compileSilently:environment:classified:notifying: (in category 'compiling') -----
- compileSilently: code environment: anEnvironment classified: category notifying: requestor
- 	"Compile the code and classify the resulting method in the given category, leaving no trail in the system log, nor in any change set, nor in the 'recent submissions' list. This should only be used when you know for sure that the compilation will succeed."
- 
- 	^SystemChangeNotifier uniqueInstance doSilently: [
- 		self
- 			compile: code
- 			environment: anEnvironment
- 			classified: category
- 			withStamp: nil
- 			notifying: requestor
- 			logSource: false ]!

Item was removed:
- ----- Method: ClassDescription>>copy:from: (in category 'copying') -----
- copy: sel from: class 
- 	"Install the method associated with the first argument, sel, a message 
- 	selector, found in the method dictionary of the second argument, class, 
- 	as one of the receiver's methods. Classify the message under -As yet not 
- 	classified-."
- 
- 	self copy: sel
- 		from: class
- 		classified: nil!

Item was removed:
- ----- Method: ClassDescription>>copy:from:classified: (in category 'copying') -----
- copy: sel from: class classified: cat 
- 	"Install the method associated with the first arugment, sel, a message 
- 	selector, found in the method dictionary of the second argument, class, 
- 	as one of the receiver's methods. Classify the message under the third 
- 	argument, cat."
- 
- 	"Useful when modifying an existing class"
- 	(class sourceCodeAt: sel ifAbsent: []) ifNotNil:
- 		[:code| | method category |
- 		method := class compiledMethodAt: sel.
- 		category := cat == nil
- 						ifTrue: [class organization categoryOfElement: sel]
- 						ifFalse: [cat].
- 		((self methodDict includesKey: sel)
- 		 and: [code asString ~= (self sourceCodeAt: sel) asString]) ifTrue:
- 			[self error: self name , ' '  , sel  , ' will be redefined if you proceed.'].
- 		self compile: code classified: category withStamp: method timeStamp notifying: nil]!

Item was removed:
- ----- Method: ClassDescription>>copyAll:from: (in category 'copying') -----
- copyAll: selArray from: class 
- 	"Install all the methods found in the method dictionary of the second 
- 	argument, class, as the receiver's methods. Classify the messages under 
- 	-As yet not classified-."
- 
- 	self copyAll: selArray
- 		from: class
- 		classified: nil!

Item was removed:
- ----- Method: ClassDescription>>copyAll:from:classified: (in category 'copying') -----
- copyAll: selArray from: class classified: cat 
- 	"Install all the methods found in the method dictionary of the second 
- 	argument, class, as the receiver's methods. Classify the messages under 
- 	the third argument, cat."
- 
- 	selArray do: 
- 		[:s | self copy: s
- 				from: class
- 				classified: cat]!

Item was removed:
- ----- Method: ClassDescription>>copyAllCategoriesFrom: (in category 'copying') -----
- copyAllCategoriesFrom: aClass 
- 	"Specify that the categories of messages for the receiver include all of 
- 	those found in the class, aClass. Install each of the messages found in 
- 	these categories into the method dictionary of the receiver, classified 
- 	under the appropriate categories."
- 
- 	aClass organization categories do: [:cat | self copyCategory: cat from: aClass]!

Item was removed:
- ----- Method: ClassDescription>>copyAllCategoriesUnobtrusivelyFrom: (in category 'copying') -----
- copyAllCategoriesUnobtrusivelyFrom: aClass 
- 	"Specify that the categories of messages for the receiver include all of 
- 	those found in the class, aClass. Install each of the messages found in 
- 	these categories into the method dictionary of the receiver, classified 
- 	under the appropriate categories."
- 
- 	aClass organization categories do: [:cat | self copyCategoryUnobtrusively: cat from: aClass]!

Item was removed:
- ----- Method: ClassDescription>>copyAllUnobtrusively:from:classified: (in category 'copying') -----
- copyAllUnobtrusively: selArray from: class classified: cat 
- 	"Install all the methods found in the method dictionary of the second 
- 	argument, class, as the receiver's methods. Classify the messages under 
- 	the third argument, cat."
- 
- 	selArray do: 
- 		[:s | self copyUnobtrusively: s
- 				from: class
- 				classified: cat]!

Item was removed:
- ----- Method: ClassDescription>>copyCategory:from: (in category 'copying') -----
- copyCategory: cat from: class 
- 	"Specify that one of the categories of messages for the receiver is cat, as 
- 	found in the class, class. Copy each message found in this category."
- 
- 	self copyCategory: cat
- 		from: class
- 		classified: cat!

Item was removed:
- ----- Method: ClassDescription>>copyCategory:from:classified: (in category 'copying') -----
- copyCategory: cat from: aClass classified: newCat 
- 	"Specify that one of the categories of messages for the receiver is the 
- 	third argument, newCat. Copy each message found in the category cat in 
- 	class aClass into this new category."
- 
- 	self copyAll: (aClass organization listAtCategoryNamed: cat)
- 		from: aClass
- 		classified: newCat!

Item was removed:
- ----- Method: ClassDescription>>copyCategoryUnobtrusively:from: (in category 'copying') -----
- copyCategoryUnobtrusively: cat from: class 
- 	"Specify that one of the categories of messages for the receiver is cat, as 
- 	found in the class, class. Copy each message found in this category."
- 
- 	self copyUnobtrusivelyCategory: cat
- 		from: class
- 		classified: cat!

Item was removed:
- ----- Method: ClassDescription>>copyMethodDictionaryFrom: (in category 'copying') -----
- copyMethodDictionaryFrom: donorClass
- 	"Copy the method dictionary of the donor class over to the receiver"
- 
- 	self methodDict: donorClass copyOfMethodDictionary.
- 	self organization: donorClass organization deepCopy.!

Item was removed:
- ----- Method: ClassDescription>>copyUnobtrusively:from:classified: (in category 'copying') -----
- copyUnobtrusively: sel from: class classified: cat 
- 	"Install the method associated with the first arugment, sel, a message 
- 	selector, found in the method dictionary of the second argument, class, 
- 	as one of the receiver's methods. Classify the message under the third 
- 	argument, cat."
- 
- 	| code category |
- 	"Useful when modifying an existing class"
- 	code := class sourceMethodAt: sel.
- 	code == nil
- 		ifFalse: 
- 			[cat == nil
- 				ifTrue: [category := class organization categoryOfElement: sel]
- 				ifFalse: [category := cat].
- 			(self methodDict includesKey: sel)
- 				ifTrue: [].
- 			self compileSilently: code classified: category]!

Item was removed:
- ----- Method: ClassDescription>>copyUnobtrusivelyCategory:from:classified: (in category 'copying') -----
- copyUnobtrusivelyCategory: cat from: aClass classified: newCat 
- 	"Specify that one of the categories of messages for the receiver is the 
- 	third argument, newCat. Copy each message found in the category cat in 
- 	class aClass into this new category."
- 
- 	self copyAllUnobtrusively: (aClass organization listAtCategoryNamed: cat)
- 		from: aClass
- 		classified: newCat!

Item was removed:
- ----- Method: ClassDescription>>definition (in category 'fileIn/Out') -----
- definition
- 	"Answer a String that defines the receiver."
- 
- 	| aStream path |
- 	aStream := WriteStream on: (String new: 300).
- 	superclass == nil
- 		ifTrue: [aStream nextPutAll: 'ProtoObject']
- 		ifFalse: [path := ''.
- 				self environment scopeFor: superclass name from: nil
- 						envtAndPathIfFound: [:envt :remotePath | path := remotePath].
- 				aStream nextPutAll: path , superclass name].
- 	aStream nextPutAll: self kindOfSubclass;
- 			store: self name.
- 	(self hasTraitComposition and: [self traitComposition notEmpty]) ifTrue: [
- 		aStream cr; tab; nextPutAll: 'uses: ';
- 			nextPutAll: self traitCompositionString].
- 	aStream cr; tab; nextPutAll: 'instanceVariableNames: ';
- 			store: self instanceVariablesString.
- 	aStream cr; tab; nextPutAll: 'classVariableNames: ';
- 			store: self classVariablesString.
- 	aStream cr; tab; nextPutAll: 'poolDictionaries: ';
- 			store: self sharedPoolsString.
- 	aStream cr; tab; nextPutAll: 'category: ';
- 			store: (self environment organization categoryOfElement: self name) asString.
- 
- 	superclass ifNil: [ 
- 		aStream nextPutAll: '.'; cr.
- 		aStream nextPutAll: self name.
- 		aStream space; nextPutAll: 'superclass: nil'. ].
- 
- 	^ aStream contents!

Item was removed:
- ----- Method: ClassDescription>>doneCompiling (in category 'compiling') -----
- doneCompiling
- 	"A ClassBuilder has finished the compilation of the receiver.
- 	This message is a notification for a class that needs to do some
- 	cleanup / reinitialization after it has been recompiled."!

Item was removed:
- ----- Method: ClassDescription>>errorCategoryName (in category 'private') -----
- errorCategoryName
- 	self error: 'Category name must be a String'!

Item was removed:
- ----- Method: ClassDescription>>fileOutCategory: (in category 'fileIn/Out') -----
- fileOutCategory: catName 
- 	^ self fileOutCategory: catName asHtml: false!

Item was removed:
- ----- Method: ClassDescription>>fileOutCategory:asHtml: (in category 'fileIn/Out') -----
- fileOutCategory: catName asHtml: useHtml
- 	"FileOut the named category, possibly in Html format."
- 	| internalStream |
- 	internalStream := WriteStream on: (String new: 1000).
- 	internalStream header; timeStamp.
- 	self fileOutCategory: catName on: internalStream moveSource: false toFile: 0.
- 	internalStream trailer.
- 
- 	FileStream writeSourceCodeFrom: internalStream baseName: (self name , '-' , catName) isSt: true useHtml: useHtml.!

Item was removed:
- ----- Method: ClassDescription>>fileOutCategory:on:moveSource:toFile: (in category 'fileIn/Out') -----
- fileOutCategory: aSymbol on: aFileStream moveSource: moveSource toFile: fileIndex 
- 	"File a description of the receiver's category, aString, onto aFileStream. If 
- 	moveSource, is true, then set the method source pointer to the new file position.
- 	Note when this method is called with moveSource=true, it is condensing the
- 	.sources file, and should only write one preamble per method category."
- 
- 	| selectors |
- 
- 	aFileStream cr.
- 	selectors := (aSymbol asString = ClassOrganizer allCategory)
- 				ifTrue: [ self organization allMethodSelectors ]
- 				ifFalse: [ self organization listAtCategoryNamed: aSymbol ].
- 
- 	selectors := selectors select: [:each | (self includesLocalSelector: each)].
- 	
- 	"Overridden to preserve author stamps in sources file regardless"
- 	selectors do: [:sel |
- 		self printMethodChunk: sel 
- 			withPreamble: true
- 			on: aFileStream 
- 			moveSource: moveSource 
- 			toFile: fileIndex].
- 	^ self!

Item was removed:
- ----- Method: ClassDescription>>fileOutCategoryHistorically:on:moveSource:toFile: (in category 'fileIn/Out') -----
- fileOutCategoryHistorically: aSymbol on: aFileStream moveSource: moveSource toFile: fileIndex 
- 	"File a description of the receiver's category, aString, onto aFileStream, preserving direct
- 	 history, but excluding branches . If moveSource, is true, then set the method source pointer
- 	 to the new file position. Note when this method is called with moveSource=true, it is
- 	 condensing the sources file, and should only write one preamble per method category."
- 
- 	| selectors |
- 	aFileStream cr.
- 	selectors := aSymbol asString = ClassOrganizer allCategory
- 					ifTrue: [self organization allMethodSelectors]
- 					ifFalse: [self organization listAtCategoryNamed: aSymbol].
- 
- 	selectors := selectors select: [:each | self includesLocalSelector: each].
- 	
- 	"Overridden to preserve author stamps in sources file regardless."
- 	selectors do: [:sel |
- 		self printMethodChunkHistorically: sel
- 			on: aFileStream 
- 			moveSource: moveSource 
- 			toFile: fileIndex]!

Item was removed:
- ----- Method: ClassDescription>>fileOutChangedMessages:on: (in category 'fileIn/Out') -----
- fileOutChangedMessages: aSet on: aFileStream 
- 	"File a description of the messages of the receiver that have been 
- 	changed (i.e., are entered into the argument, aSet) onto aFileStream."
- 
- 	self fileOutChangedMessages: aSet
- 		on: aFileStream
- 		moveSource: false
- 		toFile: 0!

Item was removed:
- ----- Method: ClassDescription>>fileOutChangedMessages:on:moveSource:toFile: (in category 'fileIn/Out') -----
- fileOutChangedMessages: aSet on: aFileStream moveSource: moveSource toFile: fileIndex 
- 	"File a description of the messages of this class that have been 
- 	changed (i.e., are entered into the argument, aSet) onto aFileStream.  If 
- 	moveSource, is true, then set the method source pointer to the new file position.
- 	Note when this method is called with moveSource=true, it is condensing the
- 	.changes file, and should only write a preamble for every method."
- 	| org |
- 	(org := self organization) categories do: 
- 		[:cat |  | sels |
- 		sels := (org listAtCategoryNamed: cat) select: [:sel | aSet includes: sel].
- 		(moveSource == #historically
- 		 or: [moveSource and: [(cat beginsWith: '*') and: [cat endsWith: '-override']]])
- 			ifTrue: "when condensing sources/changes, preserve overridden methods"
- 				[sels do:
- 					[:sel |
- 					self printMethodChunkHistorically: sel on: aFileStream
- 						moveSource: moveSource ~~ false toFile: fileIndex]]
- 			ifFalse:
- 				[sels do:
- 					[:sel |  self printMethodChunk: sel withPreamble: true on: aFileStream
- 						moveSource: moveSource toFile: fileIndex]]]!

Item was removed:
- ----- Method: ClassDescription>>fileOutChangedMessagesHistorically:on:moveSource:toFile: (in category 'fileIn/Out') -----
- fileOutChangedMessagesHistorically: aSet on: aFileStream moveSource: moveSource toFile: fileIndex 
- 	"File all historical description of the messages of this class that have been 
- 	changed (i.e., are entered into the argument, aSet) onto aFileStream.  If 
- 	moveSource, is true, then set the method source pointer to the new file position.
- 	Note when this method is called with moveSource=true, it is condensing the
- 	.changes file, and should only write a preamble for every method."
- 	| org |
- 	(org := self organization) categories do: 
- 		[:cat | 
- 		| sels |
- 		sels := (org listAtCategoryNamed: cat) select: [:sel | aSet includes: sel].
- 		sels do:
- 			[:sel |  self printMethodChunkHistorically: sel on: aFileStream
- 							moveSource: moveSource toFile: fileIndex]]!

Item was removed:
- ----- Method: ClassDescription>>fileOutInitializerOn: (in category 'fileIn/Out') -----
- fileOutInitializerOn: aStream
- 	"If the receiver has initialization, file it out. Backstop for subclasses."!

Item was removed:
- ----- Method: ClassDescription>>fileOutMethod: (in category 'fileIn/Out') -----
- fileOutMethod: selector
- 	"Write source code of a single method on a file.  Make up a name for the file."
- 	self fileOutMethod: selector asHtml: false!

Item was removed:
- ----- Method: ClassDescription>>fileOutMethod:asHtml: (in category 'fileIn/Out') -----
- fileOutMethod: selector asHtml: useHtml
- 	"Write source code of a single method on a file in .st or .html format"
- 
- 	| internalStream |
- 	(selector == #Comment) ifTrue: [^ self inform: 'Sorry, cannot file out class comment in isolation.'].
- 	(self includesSelector: selector) ifFalse: [^ self error: 'Selector ', selector asString, ' not found'].
- 	internalStream := WriteStream on: (String new: 1000).
- 	internalStream header; timeStamp.
- 	self printMethodChunk: selector withPreamble: true
- 		on: internalStream moveSource: false toFile: 0.
- 
- 	FileStream writeSourceCodeFrom: internalStream baseName: (self name , '-' , (selector copyReplaceAll: ':' with: '')) isSt: true useHtml: useHtml.
- !

Item was removed:
- ----- Method: ClassDescription>>fileOutOn: (in category 'fileIn/Out') -----
- fileOutOn: aFileStream 
- 	"File a description of the receiver on aFileStream."
- 
- 	self fileOutOn: aFileStream
- 		moveSource: false
- 		toFile: 0!

Item was removed:
- ----- Method: ClassDescription>>fileOutOn:moveSource:toFile: (in category 'fileIn/Out') -----
- fileOutOn: aFileStream moveSource: moveSource toFile: fileIndex
- 	"File a description of the receiver on aFileStream.  moveSOurce is one of
- 	 true, false or #historically.  If the argument, moveSource, is not false, then
- 	 set the trailing bytes to the position of aFileStream and to fileIndex in order
- 	 to indicate where to find the source code.  If moveSource == #historically,
- 	 print out each method's history, excluding branches"
- 
- 	aFileStream command: 'H3'; nextChunkPut: self definition; command: '/H3'.
- 
- 	self organization
- 		putCommentOnFile: aFileStream
- 		numbered: fileIndex
- 		moveSource: moveSource ~~ false
- 		forClass: self.
- 	self organization categories do: 
- 		[:heading |
- 		moveSource == #historically
- 			ifTrue:
- 				[self fileOutCategoryHistorically: heading
- 					on: aFileStream
- 					moveSource: true
- 					toFile: fileIndex]
- 			ifFalse:
- 				[self fileOutCategory: heading
- 					on: aFileStream
- 					moveSource: moveSource
- 					toFile: fileIndex]]!

Item was removed:
- ----- Method: ClassDescription>>fileOutOn:moveSource:toFile:initializing: (in category 'fileIn/Out') -----
- fileOutOn: aFileStream moveSource: moveSource toFile: fileIndex initializing: aBool
- 	"File out the receiver. Backstop for subclasses."
- 	^self fileOutOn: aFileStream moveSource: moveSource toFile: fileIndex!

Item was removed:
- ----- Method: ClassDescription>>fileOutOrganizationOn: (in category 'fileIn/Out') -----
- fileOutOrganizationOn: aFileStream
- 	"File a description of the receiver's organization on aFileStream."
- 
- 	aFileStream cr; nextPut: $!!.
- 	aFileStream nextChunkPut: self name, ' reorganize'; cr.
- 	aFileStream nextChunkPut: self organization printString; cr!

Item was removed:
- ----- Method: ClassDescription>>forceNewFrom: (in category 'instance variables') -----
- forceNewFrom: anArray
-     "Create a new instance of the class and fill
-     its instance variables up with the array."
-     | object max |
- 
-     object := self new.
-     max := self instSize.
-     anArray withIndexDo: [:each :index |
-         index > max ifFalse:
-             [object instVarAt: index put: each]].
-     ^ object!

Item was removed:
- ----- Method: ClassDescription>>hasComment (in category 'accessing comment') -----
- hasComment
- 	"return whether this class truly has a comment other than the default"
- 	| org |
- 	org := self instanceSide organization.
- 	^org classComment isEmptyOrNil not!

Item was removed:
- ----- Method: ClassDescription>>induceMDFault (in category 'accessing method dictionary') -----
- induceMDFault
- 	"Stache a copy of the methodDict in the organization slot (hack!!),
- 	and set the methodDict to nil.  This will induce an MD fault on any message send.
- 	See: ClassDescription>>recoverFromMDFault
- 	and ImageSegment>>discoverActiveClasses."
- 
- 	organization := Array with: methodDict with: organization.
- 	methodDict := nil.
- 	self flushCache!

Item was removed:
- ----- Method: ClassDescription>>instVarIndexFor:ifAbsent: (in category 'instance variables') -----
- instVarIndexFor: instVarName ifAbsent: aBlock
- 	"Answer the index of the named instance variable."
- 
- 	| index |
- 	index := instanceVariables
- 		ifNil: [ 0 ]
- 		ifNotNil: [ instanceVariables indexOf: instVarName ].
- 	index = 0 ifTrue: [
- 		^superclass
- 			ifNil: [ aBlock value ]
- 			ifNotNil: [ superclass instVarIndexFor: instVarName ifAbsent: aBlock ] ].
- 	^superclass 
- 		ifNil: [ index ]
- 		ifNotNil: [ index + superclass instSize ]!

Item was removed:
- ----- Method: ClassDescription>>instVarMappingFrom: (in category 'private') -----
- instVarMappingFrom: oldClass
- 	"Return the mapping from instVars of oldClass to new class that is used for converting old instances of oldClass."
- 	| oldInstVarNames |
- 	oldInstVarNames := oldClass allInstVarNames.
- 	"Using #lastIndexOf: to ensure proper behavior in case where we have duplicate ivars."
- 	^self allInstVarNames collect: [:instVarName | oldInstVarNames lastIndexOf: instVarName].!

Item was removed:
- ----- Method: ClassDescription>>instVarNameForIndex: (in category 'instance variables') -----
- instVarNameForIndex: index
- 	"Answer the named instance variable with index index or nil if none."
- 
- 	| superInstSize |
- 	index > self instSize ifTrue: [^nil].
- 	superInstSize := superclass isNil ifTrue: [0] ifFalse: [superclass instSize].
- 	index > superInstSize ifTrue:
- 		[^instanceVariables at: index - superInstSize].
- 	superclass isNil ifTrue: [^nil].
- 	^superclass instVarNameForIndex: index!

Item was removed:
- ----- Method: ClassDescription>>instVarNames (in category 'instance variables') -----
- instVarNames
- 	"Answer an Array of the receiver's instance variable names."
- 
- 	instanceVariables == nil
- 		ifTrue: [^#()]
- 		ifFalse: [^instanceVariables]!

Item was removed:
- ----- Method: ClassDescription>>instVarNamesAndOffsetsDo: (in category 'compiling') -----
- instVarNamesAndOffsetsDo: aBinaryBlock
- 	"This is part of the interface between the compiler and a class's instance or field names.
- 	 The class should enumerate aBinaryBlock with the instance variable name strings and
- 	 their integer offsets.  The order is important. Names evaluated later will override the
- 	 same names occurring earlier."
- 
- 	| superInstSize |
- 	(superInstSize := superclass notNil ifTrue: [superclass instSize] ifFalse: [0]) > 0 ifTrue:
- 		[superclass instVarNamesAndOffsetsDo: aBinaryBlock].
- 	1 to: self instSize - superInstSize do:
- 		[:i| aBinaryBlock value: (instanceVariables at: i) value: i + superInstSize]!

Item was removed:
- ----- Method: ClassDescription>>instanceSide (in category 'accessing parallel hierarchy') -----
- instanceSide
- 	^ self theNonMetaClass!

Item was removed:
- ----- Method: ClassDescription>>instanceVariablesString (in category 'printing') -----
- instanceVariablesString
- 	"Answer a string of my instance variable names separated by spaces."
- 
- 	^String streamContents: [ :stream |
- 		self instVarNames 
- 			do: [ :each | stream nextPutAll: each ]
- 			separatedBy: [ stream space ] ]!

Item was removed:
- ----- Method: ClassDescription>>isClassSide (in category 'accessing parallel hierarchy') -----
- isClassSide
- 	^self isMeta!

Item was removed:
- ----- Method: ClassDescription>>isDeprecated (in category 'testing') -----
- isDeprecated
- 	"Check for \d\d(Deprecated).* name."
- 	
- 	^ (self category findString: 'Deprecated' startingAt: 3 caseSensitive: true) > 0!

Item was removed:
- ----- Method: ClassDescription>>isInstanceSide (in category 'accessing parallel hierarchy') -----
- isInstanceSide
- 	^self isClassSide not!

Item was removed:
- ----- Method: ClassDescription>>isSelectorOverridden: (in category 'testing') -----
- isSelectorOverridden: aSelector
- 
- 	(self includesSelector: aSelector)
- 		ifFalse: [^ false].
- 		
- 	self allSubclassesDo: [ :class |
- 		(class includesSelector: aSelector)
- 			ifTrue: [ ^ true ] ].
- 	^ false!

Item was removed:
- ----- Method: ClassDescription>>isSelectorOverride: (in category 'testing') -----
- isSelectorOverride: aSelector
- 
- 	(self includesSelector: aSelector)
- 		ifFalse: [^ false].
- 
- 	self allSuperclassesDo: [ :class | 
- 		(class includesSelector: aSelector) 
- 			ifTrue: [ ^ true ] ].
- 	^ false!

Item was removed:
- ----- Method: ClassDescription>>isUniClass (in category 'accessing method dictionary') -----
- isUniClass
- 	"Answer whether the receiver is a uniclass."
- 
- 	^ self name endsWithDigit!

Item was removed:
- ----- Method: ClassDescription>>linesOfCode (in category 'private') -----
- linesOfCode
- 	"An approximate measure of lines of code.
- 	Includes comments, but excludes blank lines."
- 	| lines |
- 	lines := self methodDict inject: 0 into: [:sum :each | sum + each linesOfCode].
- 	self isMeta 
- 		ifTrue: [^ lines]
- 		ifFalse: [^ lines + self class linesOfCode]!

Item was removed:
- ----- Method: ClassDescription>>logMethodSource:forMethodWithNode:inCategory:withStamp:notifying: (in category 'private') -----
- logMethodSource: aText forMethodWithNode: aCompiledMethodWithNode inCategory: category withStamp: changeStamp notifying: requestor
- 	| priorMethodOrNil newText |
- 	priorMethodOrNil := self compiledMethodAt: aCompiledMethodWithNode selector ifAbsent: [].
- 	(priorMethodOrNil notNil and: [priorMethodOrNil hasBreakpoint]) ifTrue:
- 		[priorMethodOrNil := priorMethodOrNil getAndForgetUnbreakpointedOriginal].
- 	newText := (requestor notNil and: [Preferences confirmFirstUseOfStyle])
- 					ifTrue: [aText askIfAddStyle: priorMethodOrNil req: requestor]
- 					ifFalse: [aText].
- 	aCompiledMethodWithNode method
- 		putSource: newText
- 		fromParseNode: aCompiledMethodWithNode node
- 		class: self
- 		category: category
- 		withStamp: changeStamp 
- 		inFile: 2
- 		priorMethod: priorMethodOrNil!

Item was removed:
- ----- Method: ClassDescription>>methods (in category 'fileIn/Out') -----
- methods
- 	"Answer a ClassCategoryReader for compiling messages that are not classified, as in fileouts made with Smalltalk/V"
- 
- 	^ ClassCategoryReader new setClass: self category: ClassOrganizer default!

Item was removed:
- ----- Method: ClassDescription>>methodsFor: (in category 'fileIn/Out') -----
- methodsFor: categoryName 
- 	"Answer a ClassCategoryReader for compiling the messages in the category, categoryName, of the receiver."
- 
- 	^ ClassCategoryReader new setClass: self category: categoryName asSymbol
- 
- 	"(False methodsFor: 'logical operations') inspect"!

Item was removed:
- ----- Method: ClassDescription>>methodsFor:priorSource:inFile: (in category 'fileIn/Out') -----
- methodsFor: aString priorSource: sourcePosition inFile: fileIndex
- 	"Prior source pointer ignored when filing in."
- 	^ self methodsFor: aString!

Item was removed:
- ----- Method: ClassDescription>>methodsFor:stamp: (in category 'fileIn/Out') -----
- methodsFor: categoryName stamp: changeStamp 
- 	^ self methodsFor: categoryName stamp: (Utilities fixStamp: changeStamp) prior: 0!

Item was removed:
- ----- Method: ClassDescription>>methodsFor:stamp:prior: (in category 'fileIn/Out') -----
- methodsFor: categoryName stamp: changeStamp prior: indexAndOffset
- 	"Prior source link ignored when filing in."
- 	^ ClassCategoryReader new setClass: self
- 				category: categoryName asSymbol
- 				changeStamp: changeStamp
- 
- "Most importantly, return the new ClassCategoryReader, so a fileIn will let it seize control.  So method will be placed in the proper category.  See the transfer of control where ReadWriteStream fileIn calls scanFrom:"!

Item was removed:
- ----- Method: ClassDescription>>methodsInCategory: (in category 'accessing method dictionary') -----
- methodsInCategory: aName 
- 	"Answer a list of the methods of the receiver that are in category named aName"
- 	
- 	| aColl |
- 	aColl := Set withAll: (aName = ClassOrganizer allCategory
- 			ifTrue: [self organization allMethodSelectors]
- 			ifFalse: [self organization listAtCategoryNamed: aName]).
- 	^ aColl asArray sort!

Item was removed:
- ----- Method: ClassDescription>>moveChangesTo: (in category 'fileIn/Out') -----
- moveChangesTo: newFile 
- 	"Used in the process of condensing changes, this message requests that 
- 	the source code of all methods of the receiver that have been changed 
- 	should be moved to newFile."
- 
- 	| changes |
- 	changes := self methodDict keys select:
- 					[:sel | (self compiledMethodAt: sel) fileIndex > 1].
- 	changes isEmpty ifTrue:
- 		[^self].
- 	newFile cr; cr; command: 'H3'; nextChunkPut: self definition; command: '/H3'; cr.
- 	self
- 		fileOutChangedMessages: changes
- 		on: newFile
- 		moveSource: #historically
- 		toFile: 2!

Item was removed:
- ----- Method: ClassDescription>>moveChangesWithVersionsTo: (in category 'filein/out') -----
- moveChangesWithVersionsTo: newFile 
- 	"Used in the process of condensing changes, this message requests that 
- 	the source code of all methods of the receiver that have been changed 
- 	should be moved to newFile."
- 
- 	| changes |
- 	changes := self selectors select: [:sel | (self methodDict at: sel) fileIndex > 1].
- 	self fileOutChangedMessagesHistorically: changes
- 		on: newFile
- 		moveSource: true
- 		toFile: 2!

Item was removed:
- ----- Method: ClassDescription>>moveClassCommentTo:fileIndex: (in category 'fileIn/Out') -----
- moveClassCommentTo: aFileStream fileIndex: newFileIndex
- 	"Called when condensing changes.  If the receiver has a class comment, and if that class comment does not reside in the .sources file, then write it to the given filestream, with the resulting RemoteString being reachable from the source file fileIndex.  Note that any existing backpointer into the .sources file is lost by this process -- a situation that maybe should be fixed someday."
- 
- 	| header aStamp aCommentRemoteStr |
- 	self isMeta ifTrue: [^ self].  "bulletproofing only"
- 	((aCommentRemoteStr := self organization commentRemoteStr) isNil or:
- 		[aCommentRemoteStr sourceFileNumber = 1]) ifTrue: [^ self].
- 
- 	aFileStream cr; nextPut: $!!.
- 	header := String streamContents: [:strm | strm nextPutAll: self name;
- 		nextPutAll: ' commentStamp: '.
- 		(aStamp := self organization commentStamp ifNil: ['<historical>']) storeOn: strm.
- 		strm nextPutAll: ' prior: 0'].
- 	aFileStream nextChunkPut: header.
- 	aFileStream cr.
- 	self organization classComment: (RemoteString newString: self organization classComment onFileNumber: newFileIndex toFile: aFileStream) stamp: aStamp!

Item was removed:
- ----- Method: ClassDescription>>moveInstVarNamed:to:after: (in category 'compiling') -----
- moveInstVarNamed: instVarName to: anotherClass after: prevInstVarName
- 	"Move the given instance variable to another class."
- 	self == anotherClass ifFalse:[
- 		self notify:'Warning:' asText allBold,' moving ', instVarName printString,' from ', self name,' to ', anotherClass name,' will not be recorded in the change set correctly.
- Proceed to do it anyways.'].
- 	^(ClassBuilder new)
- 		moveInstVarNamed: instVarName 
- 		from: self 
- 		to: anotherClass 
- 		after: prevInstVarName!

Item was removed:
- ----- Method: ClassDescription>>newInstanceFrom:variable:size:map: (in category 'private') -----
- newInstanceFrom: oldInstance variable: variable size: instSize map: map
- 	"Create a new instance of the receiver based on the given old instance.
- 	The supplied map contains a mapping of the old instVar names into
- 	the receiver's instVars"
- 	| new |
- 	variable
- 		ifTrue: [new := self basicNew: oldInstance basicSize]
- 		ifFalse: [new := self basicNew].
- 	1 to: instSize do: 
- 		[:offset |  (map at: offset) > 0 ifTrue:
- 			[new instVarAt: offset
- 					put: (oldInstance instVarAt: (map at: offset))]].
- 	variable 
- 		ifTrue: [1 to: oldInstance basicSize do: 
- 					[:offset |
- 					new basicAt: offset put: (oldInstance basicAt: offset)]].
- 	^new!

Item was removed:
- ----- Method: ClassDescription>>noteAddedSelector:meta: (in category 'accessing method dictionary') -----
- noteAddedSelector: aSelector meta: isMeta
- 	"A hook allowing some classes to react to adding of certain selectors"!

Item was removed:
- ----- Method: ClassDescription>>noteCompilationOf:meta: (in category 'compiling') -----
- noteCompilationOf: aSelector meta: isMeta
- 	"A hook allowing some classes to react to recompilation of certain selectors"!

Item was removed:
- ----- Method: ClassDescription>>notifyOfRecategorizedSelector:from:to: (in category 'organization') -----
- notifyOfRecategorizedSelector: element from: oldCategory to: newCategory
- 	SystemChangeNotifier uniqueInstance selector: element recategorizedFrom: oldCategory to: newCategory inClass: self!

Item was removed:
- ----- Method: ClassDescription>>obsolete (in category 'initialize-release') -----
- obsolete
- 	"Make the receiver obsolete."
- 	self hasTraitComposition ifTrue: [
- 		self traitComposition do: [:each |
- 			each removeTraitUser: self]].
- 	superclass removeSubclass: self.
- 	self organization: nil.
- 	super obsolete.!

Item was removed:
- ----- Method: ClassDescription>>organization (in category 'organization') -----
- organization
- 	"Answer the instance of ClassOrganizer that represents the organization 
- 	of the messages of the receiver."
- 
- 	organization ifNil: [
- 		self organization: (ClassOrganizer defaultList: self methodDict keys sort) ].
- 	(organization isMemberOf: Array) ifTrue: [
- 		self recoverFromMDFaultWithTrace ].
- 	
- 	"Making sure that subject is set correctly. It should not be necessary."
- 	organization ifNotNil: [ organization setSubject: self ].
- 	^organization!

Item was removed:
- ----- Method: ClassDescription>>organization: (in category 'organization') -----
- organization: aClassOrg
- 	"Install an instance of ClassOrganizer that represents the organization of the messages of the receiver."
- 
- 	aClassOrg ifNotNil: [aClassOrg setSubject: self].
- 	organization := aClassOrg!

Item was removed:
- ----- Method: ClassDescription>>printCategoryChunk:on: (in category 'fileIn/Out') -----
- printCategoryChunk: categoryName on: aFileStream
- 	^ self printCategoryChunk: categoryName withStamp: '' on: aFileStream!

Item was removed:
- ----- Method: ClassDescription>>printCategoryChunk:on:priorMethod: (in category 'fileIn/Out') -----
- printCategoryChunk: category on: aFileStream priorMethod: priorMethod
- 	^ self printCategoryChunk: category on: aFileStream
- 		withStamp: Utilities changeStamp priorMethod: priorMethod!

Item was removed:
- ----- Method: ClassDescription>>printCategoryChunk:on:withStamp:priorMethod: (in category 'fileIn/Out') -----
- printCategoryChunk: category on: aFileStream withStamp: changeStamp priorMethod: priorMethod 
- 	"Print a method category preamble.  This must have a category name.
- 	It may have an author/date stamp, and it may have a prior source link.
- 	If it has a prior source link, it MUST have a stamp, even if it is empty."
- 
- "The current design is that changeStamps and prior source links are preserved in the changes file.  All fileOuts include changeStamps.  Condensing sources, however, eliminates all stamps (and links, natch)."
- 
- 	aFileStream cr; command: 'H3'; nextPut: $!!.
- 	aFileStream nextChunkPut: (String streamContents:
- 		[:strm |
- 		strm nextPutAll: self name; nextPutAll: ' methodsFor: '; print: category asString.
- 		(changeStamp ~~ nil and:
- 			[changeStamp size > 0 or: [priorMethod ~~ nil]]) ifTrue:
- 			[strm nextPutAll: ' stamp: '; print: changeStamp].
- 		priorMethod ~~ nil ifTrue:
- 			[strm nextPutAll: ' prior: '; print: priorMethod sourcePointer]]).
- 	aFileStream command: '/H3'.!

Item was removed:
- ----- Method: ClassDescription>>printCategoryChunk:withStamp:on: (in category 'fileIn/Out') -----
- printCategoryChunk: categoryName withStamp: changeStamp on: aFileStream
- 	^ self printCategoryChunk: categoryName on: aFileStream withStamp: changeStamp
- 		priorMethod: nil!

Item was removed:
- ----- Method: ClassDescription>>printMethodChunk:withPreamble:on:moveSource:toFile: (in category 'fileIn/Out') -----
- printMethodChunk: selector withPreamble: doPreamble on: outStream
- 		moveSource: moveSource toFile: fileIndex
- 	"Copy the source code for the method associated with selector onto the fileStream.  If moveSource true, then also set the source code pointer of the method."
- 	| preamble method oldPos newPos sourceFile endPos |
- 	doPreamble 
- 		ifTrue: [preamble := self name , ' methodsFor: ' ,
- 					(self organization categoryOfElement: selector) asString printString]
- 		ifFalse: [preamble := ''].
- 	method := self methodDict at: selector ifAbsent:
- 		[outStream nextPutAll: selector; cr.
- 		outStream tab; nextChunkPut: '** ERROR!!  THIS SCRIPT IS MISSING ** ' translated; cr; cr.
- 		outStream nextPutAll: '  '.
- 		^ outStream].
- 
- 	((method fileIndex = 0
- 		or: [(SourceFiles at: method fileIndex) == nil])
- 		or: [(oldPos := method filePosition) = 0])
- 		ifTrue:
- 		["The source code is not accessible.  We must decompile..."
- 		preamble size > 0 ifTrue: [outStream cr; nextPut: $!!; nextChunkPut: preamble; cr].
- 		outStream nextChunkPut: method decompileString]
- 		ifFalse:
- 		[sourceFile := SourceFiles at: method fileIndex.
- 		preamble size > 0
- 			ifTrue:    "Copy the preamble"
- 				[outStream copyPreamble: preamble from: sourceFile at: oldPos]
- 			ifFalse:
- 				[sourceFile position: oldPos].
- 		"Copy the method chunk"
- 		newPos := outStream position.
- 		outStream copyMethodChunkFrom: sourceFile.
- 		sourceFile skipSeparators.      "The following chunk may have ]style["
- 		sourceFile peek == $] ifTrue: [
- 			outStream cr; copyMethodChunkFrom: sourceFile].
- 		moveSource ifTrue:    "Set the new method source pointer"
- 			[endPos := outStream position.
- 			method checkOKToAdd: endPos - newPos at: newPos.
- 			method setSourcePosition: newPos inFile: fileIndex]].
- 	preamble size > 0 ifTrue: [outStream nextChunkPut: ' '].
- 	^ outStream cr!

Item was removed:
- ----- Method: ClassDescription>>printMethodChunkHistorically:on:moveSource:toFile: (in category 'fileIn/Out') -----
- printMethodChunkHistorically: selector on: outStream moveSource: moveSource toFile: fileIndex
- 	"Copy all source codes historically for the method associated with selector onto the 
- 	 fileStream.  If moveSource is true, then also set the source code pointer of the method.
- 	 N.B. fileIndex is interpreted as follows, 0 => just a fileOut; 1 => condensing sources;
- 	 2 => condensing changes; therefore only changes on the chnages file before the last
- 	 version in the sources file are recorded."
- 
- 	| preamble method newPos category changeList priorPos index |
- 	category := self organization categoryOfElement: selector.
- 	preamble := self name , ' methodsFor: ', category asString printString.
- 	method := self methodDict at: selector.
- 	(method filePosition = 0
- 	 or: [method fileIndex = 0
- 	 or: [(SourceFiles at: method fileIndex) isNil]])
- 		ifTrue: "no source; must decompile"
- 			[outStream cr; nextPut: $!!; nextChunkPut: preamble; cr.
- 			outStream nextChunkPut: method decompileString.
- 			outStream nextChunkPut: ' '; cr]
- 		ifFalse:
- 			[changeList := ChangeSet directAncestryOfVersions: (ChangeSet
- 																	scanVersionsOf: method 
- 																	class: self 
- 																	meta: self isMeta
- 																	category: category 
- 																	selector: selector).
- 			newPos := priorPos := nil.
- 			(fileIndex = 2 "condensing changes; select changes file code and find last sources file change"
- 			 and: [(index := changeList findFirst: [:chgRec| chgRec fileIndex = 1]) > 0]) ifTrue:
- 				[priorPos := SourceFiles 
- 								sourcePointerFromFileIndex: 1
- 								andPosition: (changeList at: index) position.
- 				 changeList := changeList copyFrom: 1 to: index - 1].
- 			changeList reverseDo:
- 				[:chgRec|
- 				chgRec file closed ifTrue:
- 					[chgRec file reopen; setToEnd].
- 				outStream copyPreamble: preamble from: chgRec file at: chgRec position.
- 				priorPos ifNotNil:
- 					[outStream
- 						position: outStream position - 2;
- 						nextPutAll: ' prior: '; print: priorPos; nextPut: $!!; cr].
- 				"Copy the method chunk"
- 				newPos := outStream position.
- 				outStream copyMethodChunkFrom: chgRec file at: chgRec position.
- 				chgRec file skipSeparators.      "The following chunk may have ]style["
- 				chgRec file peek == $] ifTrue:
- 					[outStream cr; copyMethodChunkFrom: chgRec file].
- 				outStream nextChunkPut: ' '; cr.
- 				chgRec position: newPos.
- 				priorPos := SourceFiles 
- 								sourcePointerFromFileIndex: fileIndex
- 								andPosition: newPos].
- 			moveSource ifTrue:
- 				[method setSourcePosition: newPos inFile: fileIndex]].
- 	^outStream!

Item was removed:
- ----- Method: ClassDescription>>printOn: (in category 'printing') -----
- printOn: aStream 
- 	aStream nextPutAll: self name!

Item was removed:
- ----- Method: ClassDescription>>printSubclassesOn:level: (in category 'accessing class hierarchy') -----
- printSubclassesOn: aStream level: level 
- 	"As part of the algorithm for printing a description of the receiver, print the
- 	subclass on the file stream, aStream, indenting level times."
- 
- 	| subclassNames |
- 	aStream crtab: level.
- 	aStream nextPutAll: self name.
- 	aStream space; print: self instVarNames.
- 	self == Class
- 		ifTrue: 
- 			[aStream crtab: level + 1; nextPutAll: '[ ... all the Metaclasses ... ]'.
- 			^self].
- 	subclassNames := self subclasses sort:[:c1 :c2| c1 name <= c2 name].
- 	"Print subclasses in alphabetical order"
- 	subclassNames do:
- 		[:subclass | subclass printSubclassesOn: aStream level: level + 1]!

Item was removed:
- ----- Method: ClassDescription>>printWithClosureAnalysisOn: (in category 'printing') -----
- printWithClosureAnalysisOn: aStream 
- 
- 	aStream nextPutAll: self name!

Item was removed:
- ----- Method: ClassDescription>>putClassCommentToCondensedChangesFile: (in category 'fileIn/Out') -----
- putClassCommentToCondensedChangesFile: aFileStream
- 	"Called when condensing changes.  If the receiver has a class comment, and if that class comment does not reside in the .sources file, then write it to the given filestream, with the resulting RemoteString being reachable from the source file #2.  Note that any existing backpointer into the .sources file is lost by this process -- a situation that maybe should be fixed someday."
- 	^self moveClassCommentTo: aFileStream fileIndex: 2!

Item was removed:
- ----- Method: ClassDescription>>recoverFromMDFault (in category 'accessing method dictionary') -----
- recoverFromMDFault
- 	"This method handles methodDict faults to support, eg, discoverActiveClasses (qv)."
- 	(organization isMemberOf: Array) ifFalse: [^ self error: 'oops'].
- 	methodDict := organization first.
- 	organization := organization second.
- !

Item was removed:
- ----- Method: ClassDescription>>recoverFromMDFaultWithTrace (in category 'accessing method dictionary') -----
- recoverFromMDFaultWithTrace
- 	"This method handles emthodDict faults to support, eg, discoverActiveClasses (qv)."
- 	self recoverFromMDFault.
- 	self environment at: #MDFaultDict ifPresent:
- 		[:faultDict | faultDict at: self name put:
- 			(String streamContents:
- 				[:strm | (thisContext stackOfSize: 20) do: [:item | strm print: item; cr]])]
- 
- "Execute the following statement to induce MD fault tracing.  This means that, not only will all active classes be recorded but, after a test run, MDFaultDict will contain, for every class used, a stack trace showing how it came to be used.  This statement should be executed just prior to any such text, in order to clear the traces.
- 
- 	Smalltalk at: #MDFaultDict put: Dictionary new.
- 
- "!

Item was removed:
- ----- Method: ClassDescription>>reformatAll (in category 'compiling') -----
- reformatAll
- 	"Reformat all methods in this class.
- 	Leaves old code accessible to version browsing"
- 	self selectorsDo: [:sel | self reformatMethodAt: sel]!

Item was removed:
- ----- Method: ClassDescription>>reformatMethodAt: (in category 'compiling') -----
- reformatMethodAt: selector
- 	| newCodeString method |
- 	newCodeString := self prettyPrinterClass 
- 				format: (self sourceCodeAt: selector)
- 				in: self
- 				notifying: nil
- 				decorated: false.
- 	method := self compiledMethodAt: selector.
- 	method 
- 		putSource: newCodeString
- 		fromParseNode: nil
- 		class: self
- 		category: (self organization categoryOfElement: selector)
- 		inFile: 2
- 		priorMethod: method
- !

Item was removed:
- ----- Method: ClassDescription>>removeCategory: (in category 'accessing method dictionary') -----
- removeCategory: aString 
- 	"Remove each of the messages categorized under aString in the method 
- 	dictionary of the receiver. Then remove the category aString."
- 	| categoryName |
- 	categoryName := aString asSymbol.
- 	(self organization listAtCategoryNamed: categoryName) do:
- 		[:sel | self removeSelector: sel].
- 	self organization removeCategory: categoryName!

Item was removed:
- ----- Method: ClassDescription>>removeInstVarName: (in category 'instance variables') -----
- removeInstVarName: aString 
- 	"Remove the argument, aString, as one of the receiver's instance 
- 	variables. Create an error notification if the argument is not found."
- 
- 	self subclassResponsibility!

Item was removed:
- ----- Method: ClassDescription>>removeSelector: (in category 'accessing method dictionary') -----
- removeSelector: selector 
- 	"Remove the message whose selector is given from the method 
- 	dictionary of the receiver, if it is there. Answer nil otherwise."
- 
- 	| priorMethod priorProtocol | 
- 	priorMethod := self compiledMethodAt: selector ifAbsent: [^ nil].
- 	priorProtocol := self whichCategoryIncludesSelector: selector.
- 
- 	SystemChangeNotifier uniqueInstance doSilently: [
- 		self organization removeElement: selector].
- 
- 	super removeSelector: selector.
- 
- 	SystemChangeNotifier uniqueInstance 
- 			methodRemoved: priorMethod selector: selector inProtocol: priorProtocol class: self.!

Item was removed:
- ----- Method: ClassDescription>>removeUninstantiatedSubclassesSilently (in category 'accessing class hierarchy') -----
- removeUninstantiatedSubclassesSilently
- 	"Remove the classes of any subclasses that have neither instances nor subclasses.  Answer the number of bytes reclaimed"
- 	"self removeUninstantiatedSubclassesSilently"
- 
- 	| oldFree |
- 	oldFree := Smalltalk garbageCollect.
- 	
- 	self subclasses
- 		select: [:c | (c isSystemDefined not and: [c instanceCount = 0]) and: [c subclasses isEmpty]]
- 		thenDo: [:c | c removeFromSystem].
- 	
- 	^ Smalltalk garbageCollect - oldFree!

Item was removed:
- ----- Method: ClassDescription>>renameInstVar:to: (in category 'instance variables') -----
- renameInstVar: oldName to: newName
- 
- 	(self confirm: 'WARNING: Renaming of instance variables
- is subject to substitution ambiguities.
- Do you still wish to attempt it?') ifFalse: [self halt].
- 	"...In other words, this does a dumb text search-and-replace,
- 	which might improperly alter, eg, a literal string.  As long as
- 	the oldName is unique, everything should work jes' fine. - di"
- 
- 	^ self renameSilentlyInstVar: oldName to: newName!

Item was removed:
- ----- Method: ClassDescription>>renameSilentlyInstVar:to: (in category 'instance variables') -----
- renameSilentlyInstVar: old to: new
- 	| i oldName newName |
- 	oldName := old asString.
- 	newName := new asString.
- 	(i := self instVarNames indexOf: oldName) = 0 ifTrue:
- 		[self error: oldName , ' is not defined in ', self name].
- 	self allSuperclasses , self withAllSubclasses asOrderedCollection do:
- 		[:cls | (cls instVarNames includes: newName) ifTrue:
- 			[self error: newName , ' is already used in ', cls name]].
- 
- 	self instVarNames replaceFrom: i to: i with: (Array with: newName).
- 	self replaceSilently: oldName to: newName.	"replace in text body of all methods"!

Item was removed:
- ----- Method: ClassDescription>>reorganize (in category 'organization') -----
- reorganize
- 	"During fileIn, !!Rectangle reorganize!! allows Rectangle to seize control and treat the next chunk as its organization.  See the transfer of control where ReadWriteStream fileIn calls scanFrom:"
- 
- 	^self organization!

Item was removed:
- ----- Method: ClassDescription>>replaceSilently:to: (in category 'instance variables') -----
- replaceSilently: old to: new
- 	"text-replace any part of a method.  Used for class and pool variables.  Don't touch the header.  Not guaranteed to work if name appears in odd circumstances"
- 	| oldName newName |
- 	oldName := old asString.
- 	newName := new asString.
- 	self withAllSubclasses do:
- 		[:cls |
- 		| sels |
- 		sels := cls selectors copyWithoutAll: #(DoIt DoItIn:).
- 		sels do:
- 			[:sel |
- 			| oldCode newCode parser header body |
- 			oldCode := cls sourceCodeAt: sel.
- 			"Don't make changes in the method header"
- 			(parser := cls newParser) parseSelector: oldCode.
- 			header := oldCode copyFrom: 1 to: (parser endOfLastToken min: oldCode size).
- 			body := header size > oldCode size
- 					ifTrue: ['']
- 					ifFalse: [oldCode copyFrom: header size+1 to: oldCode size].
- 			newCode := header , (body copyReplaceTokens: oldName with: newName).
- 			newCode ~= oldCode ifTrue:
- 				[cls compile: newCode
- 					classified: (cls organization categoryOfElement: sel)
- 					notifying: nil]].
- 		cls isMeta ifFalse:
- 			[| oldCode newCode |
- 			oldCode := cls comment.
- 			newCode := oldCode copyReplaceTokens: oldName with: newName.
- 			newCode ~= oldCode ifTrue:
- 				[cls comment: newCode]]]!

Item was removed:
- ----- Method: ClassDescription>>setInstVarNames: (in category 'private') -----
- setInstVarNames: instVarArray
- 	"Private - for class initialization only"
- 	| required |
- 	required := self instSize.
- 	superclass notNil ifTrue:[required := required - superclass instSize].
- 	instVarArray size = required
- 		ifFalse:[^self error: required printString, ' instvar names are required'].
- 	instVarArray isEmpty
- 		ifTrue:[instanceVariables := nil]
- 		ifFalse:[instanceVariables := instVarArray asArray].!

Item was removed:
- ----- Method: ClassDescription>>sharedPoolsString (in category 'printing') -----
- sharedPoolsString
- 	"Answer a string of my shared pool names separated by spaces."
- 
- 	^String streamContents: [ :stream |
- 		self sharedPools 
- 			do: [ :each |
- 				stream nextPutAll: (self environment 
- 					keyAtIdentityValue: each 
- 					ifAbsent: [ 'private' ]) ]
- 			separatedBy: [ stream space ] ]!

Item was removed:
- ----- Method: ClassDescription>>storeOn: (in category 'printing') -----
- storeOn: aStream
- 	"Classes and Metaclasses have global names."
- 
- 	aStream nextPutAll: self name!

Item was removed:
- ----- Method: ClassDescription>>subclasses (in category 'accessing class hierarchy') -----
- subclasses
- 	^ Array new!

Item was removed:
- ----- Method: ClassDescription>>subclassesDo: (in category 'accessing class hierarchy') -----
- subclassesDo: aBlock
- 	"Evaluate the argument, aBlock, for each of the receiver's immediate subclasses."
- 	^self subclasses do: aBlock!

Item was removed:
- ----- Method: ClassDescription>>superclass:methodDictionary:format: (in category 'initialize-release') -----
- superclass: aClass methodDictionary: mDict format: fmt
- 	"Basic initialization of the receiver"
- 	super superclass: aClass methodDictionary: mDict format: fmt.
- 	instanceVariables := nil.
- 	self organization: nil.!

Item was removed:
- ----- Method: ClassDescription>>theMetaClass (in category 'accessing parallel hierarchy') -----
- theMetaClass
- 	"Sent to a class or metaclass, always return the metaclass"
- 
- 	^self class!

Item was removed:
- ----- Method: ClassDescription>>theNonMetaClass (in category 'accessing parallel hierarchy') -----
- theNonMetaClass
- 	"Sent to a class or metaclass, always return the class"
- 
- 	^self!

Item was removed:
- ----- Method: ClassDescription>>updateInstances:from:isMeta: (in category 'initialize-release') -----
- updateInstances: oldInstances from: oldClass isMeta: isMeta
- 	"Recreate any existing instances of the argument, oldClass, as instances of the receiver,
- 	 which is a newly changed class. Permute variables as necessary, and forward old instances
- 	 to new instances.  Answer nil to defeat old clients that expect an array of old instances.
- 	 The old behaviour, which necessitated a global GC, exchanged identities and answered
- 	 the old instances.  But no clients used the result.  This way we avoid the unnecessary GC,"
- 	| map variable instSize newInstances |
- 
- 	oldInstances isEmpty ifTrue:
- 		[^nil]. "no instances to convert"
- 	isMeta ifTrue:
- 		[(oldInstances size = 1
- 		  and: [self soleInstance class == self
- 				or: [self soleInstance class == oldClass]]) ifFalse:
- 			[^self error: 'Metaclasses can only have one instance']].
- 	map := self instVarMappingFrom: oldClass.
- 	variable := self isVariable.
- 	instSize := self instSize.
- 	newInstances := Array new: oldInstances size.
- 	1 to: oldInstances size do:
- 		[:i|
- 		newInstances
- 			at: i
- 			put: (self newInstanceFrom: (oldInstances at: i) variable: variable size: instSize map: map)].
- 	"Now perform a bulk mutation of old instances into new ones"
- 	oldInstances elementsForwardIdentityAndHashTo: newInstances.
- 	^nil!

Item was removed:
- ----- Method: ClassDescription>>updateInstancesFrom: (in category 'initialize-release') -----
- updateInstancesFrom: oldClass
- 	"Recreate any existing instances of the argument, oldClass, as instances of 
- 	 the receiver, which is a newly changed class. Permute variables as necessary,
- 	 and forward old instances to new instances.. Answer nil to defeat any clients
- 	 that expected the old behaviour of answering the array of old instances."
- 	"ar 7/15/1999: The updating below is possibly dangerous. If there are any
- 	contexts having an old instance as receiver it might crash the system if
- 	the new receiver in which the context is executed has a different layout.
- 	See bottom below for a simple example:"
- 	self updateInstances: oldClass allInstances asArray from: oldClass isMeta: self isMeta.
- 	^nil
- 
- "This attempts to crash the VM by stepping off the end of an instance.
-  As the doctor says, do not do this."
- "	| crashingBlock class |
- 	class := Object subclass: #CrashTestDummy
- 		instanceVariableNames: 'instVar'
- 		classVariableNames: ''
- 		poolDictionaries: ''
- 		category: 'Crash-Test'.
- 	class compile:'instVar: value instVar := value'.
- 	class compile:'crashingBlock ^[instVar]'.
- 	crashingBlock := (class new) instVar: 42; crashingBlock.
- 	Object subclass: #CrashTestDummy
- 		instanceVariableNames: ''
- 		classVariableNames: ''
- 		poolDictionaries: ''
- 		category: 'Crash-Test'.
- 	crashingBlock value"!

Item was removed:
- ----- Method: ClassDescription>>updateMethodBindingsTo: (in category 'initialize-release') -----
- updateMethodBindingsTo: aBinding
- 	"ClassBuilder support for maintaining valid method bindings."
- 	methodDict do: [:method| method methodClassAssociation: aBinding]!

Item was removed:
- ----- Method: ClassDescription>>version (in category 'accessing') -----
- version
- 	"Allows polymoprhism with TraitDescription>>version"
- 
- 	^ self classVersion!

Item was removed:
- ----- Method: ClassDescription>>wantsChangeSetLogging (in category 'compiling') -----
- wantsChangeSetLogging
- 	"Answer whether code submitted for the receiver should be remembered by the changeSet mechanism.  7/12/96 sw"
- 
- 	^ true!

Item was removed:
- ----- Method: ClassDescription>>wantsRecompilationProgressReported (in category 'compiling') -----
- wantsRecompilationProgressReported
- 	"Answer whether the receiver would like progress of its recompilation reported interactively to the user."
- 
- 	^ true!

Item was removed:
- ----- Method: ClassDescription>>whichCategoryIncludesSelector: (in category 'organization') -----
- whichCategoryIncludesSelector: aSelector 
- 	"Answer the category of the argument, aSelector, in the organization of 
- 	the receiver, or answer nil if the receiver does not inlcude this selector."
- 
- 	(self includesSelector: aSelector)
- 		ifTrue: [^ self organization categoryOfElement: aSelector]
- 		ifFalse: [^nil]!

Item was removed:
- ----- Method: ClassDescription>>whichMethodsStoreInto: (in category 'testing') -----
- whichMethodsStoreInto: varName 
- 	"Answer a collection of CompiledMethod whose methods access the argument, varName,
- 	 as a named class or pool variable. Or let super try with a named instance variable."
- 	^(self bindingOf: varName)
- 		ifNil: [super whichMethodsStoreInto: varName]
- 		ifNotNil: [:ref| self methodDict values select: [:eachMethod| eachMethod writesRef: ref]]!

Item was removed:
- ----- Method: ClassDescription>>zapOrganization (in category 'organization') -----
- zapOrganization
- 	"Remove the organization of this class by message categories.
- 	This is typically done to save space in small systems.  Classes and methods
- 	created or filed in subsequently will, nonetheless, be organized"
- 
- 	self hasTraitComposition ifFalse:[
- 		self organization: nil.
- 		self isClassSide ifFalse: [self classSide zapOrganization]
- 	].!

Item was removed:
- BasicClassOrganizer subclass: #ClassOrganizer
- 	instanceVariableNames: ''
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'Kernel-Classes'!
- 
- !ClassOrganizer commentStamp: 'NS 4/6/2004 16:13' prior: 0!
- I represent method categorization information for classes.  The handling of class comments has gone through a tortuous evolution.   Grandfathered class comments (before late aug 98) have no time stamps, and historically, fileouts of class comments always substituted the timestamp reflecting the author and date/time at the moment of fileout; and historically any timestamps in a filed out class comment were dropped on the floor, with the author & time prevailing at the moment of filein being substituted.   Such grandfathered comments now go out on fileouts with '<historical>' timestamp; class comments created after the 8/98 changes will have their correct timestamps preserved, though there is not yet a decent ui for reading those stamps other than filing out and looking at the file; nor is there yet any ui for browsing and recovering past versions of such comments.  Everything in good time!!!

Item was removed:
- ----- Method: ClassOrganizer class>>cleanUp: (in category 'class initialization') -----
- cleanUp: aggressive
- 	"Remove empty method categories when cleaning aggressively"
- 
- 	aggressive ifTrue: [
- 		SystemChangeNotifier uniqueInstance doSilently: [
- 			Smalltalk removeEmptyMessageCategories]].
- !

Item was removed:
- ----- Method: ClassOrganizer>>addCategory:before: (in category 'accessing') -----
- addCategory: catString before: nextCategory
- 	SystemChangeNotifier uniqueInstance
- 		doSilently: [super addCategory: catString before: nextCategory];
- 		protocolAdded: catString inClass: self subject!

Item was removed:
- ----- Method: ClassOrganizer>>changeFromCategorySpecs: (in category 'accessing') -----
- changeFromCategorySpecs: categorySpecs
- 	| oldDict oldCategories |
- 	oldDict := self elementCategoryDict.
- 	oldCategories := self categories copy.
- 	SystemChangeNotifier uniqueInstance doSilently: [
- 		super changeFromCategorySpecs: categorySpecs].
- 	self notifyOfChangedSelectorsOldDict: oldDict newDict: self elementCategoryDict.
- 	self notifyOfChangedCategoriesFrom: oldCategories to: self categories.!

Item was removed:
- ----- Method: ClassOrganizer>>classComment: (in category 'accessing') -----
- classComment: aString
- 	"Guards against setting the comment in a metaclass which is invalid"
- 	subject isMeta ifTrue:[^self error: 'Cannot set metaclass comments'].
- 	^super classComment: aString!

Item was removed:
- ----- Method: ClassOrganizer>>classComment:stamp: (in category 'accessing') -----
- classComment: aString  stamp: aStamp
- 	"Guards against setting the comment in a metaclass which is invalid"
- 	subject isMeta ifTrue:[^self error: 'Cannot set metaclass comments'].
- 	^super classComment: aString  stamp: aStamp!

Item was removed:
- ----- Method: ClassOrganizer>>classify:under:logged: (in category 'classifying') -----
- classify: element under: heading logged: aBoolean
- 	self classify: element under: heading suppressIfDefault: true logged: aBoolean
- !

Item was removed:
- ----- Method: ClassOrganizer>>classify:under:suppressIfDefault: (in category 'classifying') -----
- classify: element under: heading suppressIfDefault: aBoolean
- 	self classify: element under: heading suppressIfDefault: aBoolean logged: false
- !

Item was removed:
- ----- Method: ClassOrganizer>>classify:under:suppressIfDefault:logged: (in category 'classifying') -----
- classify: element under: heading suppressIfDefault: aBoolean logged: logged 
- 	| oldCat newCat |
- 	oldCat := self categoryOfElement: element.
- 	SystemChangeNotifier uniqueInstance doSilently: [
- 		super classify: element under: heading suppressIfDefault: aBoolean].
- 	newCat := self categoryOfElement: element.
- 	self notifyOfChangedSelector: element from: oldCat to: newCat.
- 	logged ifTrue: [self logChangedSelector: element category: newCat].
- !

Item was removed:
- ----- Method: ClassOrganizer>>classifyAllUnclassified (in category 'classifying') -----
- classifyAllUnclassified
- 
- 	| organizers |
- 	organizers := self subject withAllSuperclasses collect: [:ea | ea organization].
- 	(self listAtCategoryNamed: ClassOrganizer default) do: [:sel | | found |
- 		found := (organizers collect: [ :org | org categoryOfElement: sel])
- 			detect: [:ea | ea ~= ClassOrganizer default and: [ ea ~= nil]]
- 			ifNone: [].
- 		found ifNotNil: [self classify: sel under: found]].
- !

Item was removed:
- ----- Method: ClassOrganizer>>logChangedSelector:category: (in category 'private') -----
- logChangedSelector: element category: newCategory
- 	"make an entry in the changes to record the changed category"
- 	| method |	
- 	"if we do not have a changes file, the code below would try to make a new method"
- 	(subject == nil or: [SourceFiles == nil or: [(SourceFiles at: 2) == nil]]) ifTrue: [^self].
- 	method := subject compiledMethodAt: element ifAbsent: [^self].
- 	subject logMethodSource: (method getSourceFor: element in: subject)
- 		forMethodWithNode: (CompiledMethodWithNode method: method node: method) 
- 		inCategory: newCategory withStamp: method timeStamp notifying: nil.
- !

Item was removed:
- ----- Method: ClassOrganizer>>logSelectorsInChangedCategory: (in category 'private') -----
- logSelectorsInChangedCategory: newCategory
- 	"make an entry in the changes file for each method in the changed category"
- 	(self listAtCategoryNamed: newCategory) do: [:element |
- 		self logChangedSelector: element category: newCategory].
- !

Item was removed:
- ----- Method: ClassOrganizer>>notifyOfChangedCategoriesFrom:to: (in category 'private') -----
- notifyOfChangedCategoriesFrom: oldCollectionOrNil to: newCollectionOrNil
- 	(self hasSubject and: [oldCollectionOrNil ~= newCollectionOrNil]) 
- 		ifTrue: [SystemChangeNotifier uniqueInstance classReorganized: self subject].!

Item was removed:
- ----- Method: ClassOrganizer>>notifyOfChangedSelector:from:to: (in category 'private') -----
- notifyOfChangedSelector: element from: oldCategory to: newCategory
- 	(self hasSubject and: [(oldCategory ~= newCategory)]) ifTrue: [
- 		self subject notifyOfRecategorizedSelector: element from: oldCategory to: newCategory.
- 	].!

Item was removed:
- ----- Method: ClassOrganizer>>notifyOfChangedSelectorsOldDict:newDict: (in category 'private') -----
- 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.
- 	].!

Item was removed:
- ----- Method: ClassOrganizer>>removeCategory: (in category 'accessing') -----
- removeCategory: cat 
- 	SystemChangeNotifier uniqueInstance
- 		doSilently: [super removeCategory: cat];
- 		protocolRemoved: cat inClass: self subject!

Item was removed:
- ----- Method: ClassOrganizer>>removeElement: (in category 'accessing') -----
- removeElement: element
- 	| oldCat |
- 	oldCat := self categoryOfElement: element.
- 	SystemChangeNotifier uniqueInstance doSilently: [
- 		super removeElement: element].
- 	self notifyOfChangedSelector: element from: oldCat to: (self categoryOfElement: element).!

Item was removed:
- ----- Method: ClassOrganizer>>removeEmptyCategories (in category 'accessing') -----
- removeEmptyCategories
- 	| oldCategories |
- 	oldCategories := self categories copy.
- 	SystemChangeNotifier uniqueInstance doSilently: [
- 		super removeEmptyCategories].
- 	self notifyOfChangedCategoriesFrom: oldCategories to: self categories.!

Item was removed:
- ----- Method: ClassOrganizer>>renameCategory:toBe: (in category 'accessing') -----
- renameCategory: oldCatString toBe: newCatString
- 	SystemChangeNotifier uniqueInstance
- 		doSilently: [super renameCategory: oldCatString toBe: newCatString];
- 		protocolRenamedFrom: oldCatString asSymbol to: newCatString asSymbol inClass: self subject.
- 	self logSelectorsInChangedCategory: newCatString.
- !

Item was removed:
- ----- Method: ClassOrganizer>>setDefaultList: (in category 'accessing') -----
- setDefaultList: aSortedCollection
- 	| oldDict oldCategories |
- 	oldDict := self elementCategoryDict.
- 	oldCategories := self categories copy.
- 	SystemChangeNotifier uniqueInstance doSilently: [
- 		super setDefaultList: aSortedCollection].
- 	self notifyOfChangedSelectorsOldDict: oldDict newDict: self elementCategoryDict.
- 	self notifyOfChangedCategoriesFrom: oldCategories to: self categories.!

Item was removed:
- ----- Method: ClassOrganizer>>sortCategories (in category 'accessing') -----
- sortCategories
- 	| oldCategories |
- 	oldCategories := self categories copy.
- 	SystemChangeNotifier uniqueInstance doSilently: [
- 		super sortCategories].
- 	self notifyOfChangedCategoriesFrom: oldCategories to: self categories.!

Item was removed:
- InstructionClient subclass: #ClosureExtractor
- 	instanceVariableNames: 'action scanner currentContext'
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'Kernel-Methods'!
- 
- !ClosureExtractor commentStamp: 'mha 9/21/2010 11:16' prior: 0!
- A ClosureExtractor is a utility class that is used to extract all BlockClosures from a CompiledMethod. It inherits from InstructionClient and understands only one single message, namely that corresponding to the push closure bytecode instruction. Being sent this message, a ClosureExtractor will create a BlockClosure instance and evaluate the block it holds as an instance variable with that closure as parameter.!

Item was removed:
- ----- Method: ClosureExtractor class>>withAction:andScanner: (in category 'instance creation') -----
- withAction: aBlock andScanner: anInstructionStream
- 	"The passed block must accept one value, which will be a BlockClosure."
- 	^ self new action: aBlock; scanner: anInstructionStream!

Item was removed:
- ----- Method: ClosureExtractor>>action (in category 'accessing') -----
- action
- 	^ action!

Item was removed:
- ----- Method: ClosureExtractor>>action: (in category 'accessing') -----
- action: aBlock
- 	action := aBlock!

Item was removed:
- ----- Method: ClosureExtractor>>blockReturnConstant: (in category 'instruction decoding') -----
- blockReturnConstant: value
- 	currentContext := currentContext sender!

Item was removed:
- ----- Method: ClosureExtractor>>blockReturnTop (in category 'instruction decoding') -----
- blockReturnTop
- 	currentContext := currentContext sender!

Item was removed:
- ----- Method: ClosureExtractor>>pushClosureCopyNumCopiedValues:numArgs:blockSize: (in category 'instruction decoding') -----
- pushClosureCopyNumCopiedValues: numCopied numArgs: numArgs blockSize: blockSize
- 	"Create a BlockClosure corresponding to the closure bytecode
- 	 and execute the action block with it. The created BlockClosure is only a pseudo value,
- 	 it is not populated with meaningful context and argument information."
- 	| block |
- 	block := BlockClosure
- 				outerContext: currentContext
- 				startpc: scanner pc
- 				numArgs: numArgs
- 				copiedValues: (Array new: numCopied)..
- 	currentContext := block asContextWithSender: currentContext.
- 	action value: block!

Item was removed:
- ----- Method: ClosureExtractor>>pushFullClosure:numCopied: (in category 'instruction decoding') -----
- pushFullClosure: aCompiledBlock numCopied: numCopied
- 	"Create a BlockClosure corresponding to the closure bytecode
- 	 and execute the action block with it. The created BlockClosure is only a pseudo value,
- 	 it is not populated with meaningful context and argument information."
- 	self pushFullClosure: aCompiledBlock numCopied: numCopied receiverOnStack: false ignoreOuterContext: false!

Item was removed:
- ----- Method: ClosureExtractor>>pushFullClosure:numCopied:receiverOnStack:ignoreOuterContext: (in category 'instruction decoding') -----
- pushFullClosure: aCompiledBlock numCopied: numCopied receiverOnStack: rcvrOnStack ignoreOuterContext: ignoreOuterContext
- 	"Create a BlockClosure corresponding to the closure bytecode
- 	 and execute the action block with it. The created BlockClosure is only a pseudo value,
- 	 it is not populated with meaningful context and argument information."
- 	| block encoderClass endPC extractor subScanner |
- 	block := FullBlockClosure
- 				receiver: (rcvrOnStack ifTrue: [#onStackReceiver])
- 				outerContext: (ignoreOuterContext ifFalse: [currentContext])
- 				method: aCompiledBlock
- 				copiedValues: (Array new: numCopied).
- 	currentContext := block asContextWithSender: currentContext.
- 	action value: block.
- 	subScanner := aCompiledBlock scanner.
- 	extractor := self class withAction: action andScanner: subScanner.
- 	endPC := aCompiledBlock endPC.
- 	encoderClass := aCompiledBlock encoderClass.
- 	[subScanner pc <= endPC] whileTrue:
- 		[encoderClass interpretNextInstructionFor: extractor in: subScanner]!

Item was removed:
- ----- Method: ClosureExtractor>>scanner (in category 'accessing') -----
- scanner
- 	^ scanner!

Item was removed:
- ----- Method: ClosureExtractor>>scanner: (in category 'accessing') -----
- scanner: anInstructionStream
- 	scanner := anInstructionStream.
- 	currentContext := Context
- 							sender: nil
- 							receiver: nil
- 							method: scanner method
- 							arguments: (Array new: scanner method numArgs)!

Item was removed:
- CompiledCode variableByteSubclass: #CompiledBlock
- 	instanceVariableNames: ''
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'Kernel-Methods'!
- 
- !CompiledBlock commentStamp: 'eem 2/27/2018 12:27' prior: 0!
- CompiledBlock instances are blocks suitable for interpretation by the virtual machine.  They are a specialization of CompiledCode.  This requires both bytecode set and compiler support.  The V3 bytecode (EncoderForV3PlusClosures) does not provide support for CompiledBlock.  The SistaV1 set does (EncoderForSistaV1).
- 
- The last literal in a CompiledBlock is reserved for a reference to its enclosing CompiledBlock or CompiledMethod.  Super sends in CompiledBlocks must use the directed super send bytecode.  
- 
- By convention the penultimate literal of a method is either its selector or an instance of AdditionalMethodState.  AdditionalMethodState may be used to add instance variables to a method, albeit ones held in the method's AdditionalMethodState.  Subclasses of CompiledBlock that want to add state should subclass AdditionalMethodState to add the state they want, and implement methodPropertiesClass on the class side of the CompiledBlock subclass to answer the specialized subclass of AdditionalMethodState.  Enterprising programmers are encouraged to try and implement this support automatically through suitable modifications to the compiler and class builder.!

Item was removed:
- ----- Method: CompiledBlock>>anyAndAllMessages (in category 'literals') -----
- anyAndAllMessages
- 	^self homeMethod anyAndAllMessages!

Item was removed:
- ----- Method: CompiledBlock>>codeLiteralsDo: (in category 'literals') -----
- codeLiteralsDo: aBlock
- 	"Overwritten to not cause infinite loop."
- 
- 	aBlock value: self.
- 
- 	self literalsDo: [:literal |
- 		(literal isCompiledCode and: [literal ~~ self outerCode]) ifTrue: [
- 			literal codeLiteralsDo: aBlock]].!

Item was removed:
- ----- Method: CompiledBlock>>copyWithOuterCode: (in category 'private-copying') -----
- copyWithOuterCode: aCompiledCode
- 	"Private; answer a shallow copy of the receiver updated with deep copies of
- 	 embedded block methods and a reference to aCompiledCode as the outer code."
- 	| numLiterals copy |
- 	copy := self shallowCopy.
- 	1 to: (numLiterals := self numLiterals) - 1 do:
- 		[:i| | lit |
- 		(lit := copy literalAt: i) isCompiledCode ifTrue:
- 			[copy literalAt: i put: (lit copyWithOuterCode: copy)]].
- 	copy literalAt: numLiterals put: aCompiledCode.
- 	^copy!

Item was removed:
- ----- Method: CompiledBlock>>encoderClass (in category 'accessing') -----
- encoderClass
- 	"Answer the encoder class that encoded the bytecodes in this method.
- 	 The sign flag bit is used by the VM to select a bytecode set.  This formulation
- 	 may seem odd but this has to be fast, so no property probe unless needed."
- 
- 	^self header >= 0
- 		ifTrue: 
- 			[PrimaryBytecodeSetEncoderClass]
- 		ifFalse:
- 			[PrimaryBytecodeSetEncoderClass == SecondaryBytecodeSetEncoderClass
- 				ifTrue: "Support for testing prior to installing another set"
- 					[(self homeMethod propertyValueAt: #encoderClass) ifNil: [SecondaryBytecodeSetEncoderClass]]
- 				ifFalse:
- 					[SecondaryBytecodeSetEncoderClass]]!

Item was removed:
- ----- Method: CompiledBlock>>hasSameLiteralsAs: (in category 'comparing') -----
- hasSameLiteralsAs: aMethod
- 	"Answer whether the receiver has the same sequence of literals as the argument.
- 	 Do not fully compare the last literal as this is the outerCode back pointer to the
- 	 containing method or block, and following it would cause infinite recursion.  In any
- 	 case this is a useful definition because it considers identical block methods in other-
- 	 wise different containing blocks or methods to be the same, which makes sense."
- 	| numLits |
- 	numLits := self numLiterals.
- 	numLits = aMethod numLiterals ifFalse: [^false].
- 	1 to: numLits - 1 do:
- 		[:i| | lit1 lit2 |
- 		lit1 := self literalAt: i.
- 		lit2 := aMethod literalAt: i.
- 		(lit1 == lit2 or: [lit1 literalEqual: lit2]) ifFalse:
- 			[^false]].
- 	^(self literalAt: numLits) isCompiledCode = (aMethod literalAt: numLits) isCompiledCode!

Item was removed:
- ----- Method: CompiledBlock>>headerDescription (in category 'printing') -----
- headerDescription
- 	"Answer a description containing the information about the form of the
- 	 receiver and the form of the context needed to run the receiver."
- 
- 	^(ByteString new: 128) writeStream
- 		print: self header; cr;
- 		nextPutAll: '"block full'; cr;
- 		nextPutAll: ' numArgs: '; print: self numArgs; cr;
- 		nextPutAll: ' numTemps: '; print: self numTemps; cr;
- 		nextPutAll: ' numLiterals: '; print: self numLiterals; cr;
- 		nextPutAll: ' frameSize: '; print: self frameSize; cr;
- 		nextPutAll: ' bytecodeSet: '; nextPutAll: self bytecodeSetName;
- 		nextPut: $"; cr;
- 		contents!

Item was removed:
- ----- Method: CompiledBlock>>holdsTempNames (in category 'source code management') -----
- holdsTempNames
- 	^self homeMethod holdsTempNames!

Item was removed:
- ----- Method: CompiledBlock>>homeMethod (in category 'accessing') -----
- homeMethod
- 	"answer the compiled method that I am installed in, or nil if none."
- 	^self outerCode homeMethod!

Item was removed:
- ----- Method: CompiledBlock>>isCompiledBlock (in category 'testing') -----
- isCompiledBlock
- 	^true!

Item was removed:
- ----- Method: CompiledBlock>>isQuick (in category 'testing') -----
- isQuick
- 	^false!

Item was removed:
- ----- Method: CompiledBlock>>longPrintOn:indent: (in category 'printing') -----
- longPrintOn: aStream indent: tabs
- 	"List of all the byte codes in a method with a short description of each"
- 	(InstructionPrinter on: self) indent: tabs; printInstructionsOn: aStream!

Item was removed:
- ----- Method: CompiledBlock>>method (in category 'accessing') -----
- method
- 	"answer the compiled method that I am installed in, or nil if none."
- 	^self outerCode method!

Item was removed:
- ----- Method: CompiledBlock>>methodClass (in category 'accessing') -----
- methodClass
- 	"Answer the class that I am installed in."
- 	^self homeMethod methodClass!

Item was removed:
- ----- Method: CompiledBlock>>methodForDecompile (in category 'decompiling') -----
- methodForDecompile
- 	^self homeMethod methodForDecompile!

Item was removed:
- ----- Method: CompiledBlock>>methodNode (in category 'accessing') -----
- methodNode
- 	^ self homeMethod methodNode!

Item was removed:
- ----- Method: CompiledBlock>>numCopiedValues (in category 'accessing') -----
- numCopiedValues
- 	"Answer the number of copied values the receiver expects.
- 	 This is not fast as it is not expected to be needed from the
- 	 compiled block itself.  It is available cheaply from a block
- 	 closure for the method."
- 
- 	| locator scanner pc |
- 	locator := BlockStartLocator new.
- 	scanner := InstructionStream on: self outerCode.
- 	[pc := scanner pc.
- 	 self == (scanner interpretNextInstructionFor: locator) ifTrue:
- 		[^(self outerCode abstractBytecodeMessageAt: pc) arguments second].
- 	 scanner atEnd] whileFalse.
- 	self error: 'cannot find the block creation bytecode for this compiled block in its outer code.'!

Item was removed:
- ----- Method: CompiledBlock>>outerCode (in category 'accessing') -----
- outerCode
- 	"answer the compiled code that I am installed in, or nil if none."
- 	^self literalAt: self numLiterals!

Item was removed:
- ----- Method: CompiledBlock>>outerCode: (in category 'accessing') -----
- outerCode: aCompiledCode
- 	^self literalAt: self numLiterals put: aCompiledCode!

Item was removed:
- ----- Method: CompiledBlock>>postCopy (in category 'copying') -----
- postCopy
- 	1 to: self numLiterals - 1 do:
- 		[:index| | lit |
- 		 (lit := self literalAt: index) isCompiledCode ifTrue:
- 			[lit outerCode: self; postCopy]]!

Item was removed:
- ----- Method: CompiledBlock>>pragmaAt: (in category 'accessing-pragmas & properties') -----
- pragmaAt: aKey
- 	"Answer the pragma with selector aKey, or nil if none."
- 	^self homeMethod pragmaAt: aKey!

Item was removed:
- ----- Method: CompiledBlock>>pragmas (in category 'accessing-pragmas & properties') -----
- pragmas
- 	^self homeMethod pragmas!

Item was removed:
- ----- Method: CompiledBlock>>pragmasAt: (in category 'accessing-pragmas & properties') -----
- pragmasAt: aSelector
- 	"Answer all pragmas with selector aSelector."
- 	^self homeMethod pragmasAt: aSelector!

Item was removed:
- ----- Method: CompiledBlock>>primitive (in category 'accessing') -----
- primitive
- 	^0!

Item was removed:
- ----- Method: CompiledBlock>>printReferenceOn: (in category 'printing') -----
- printReferenceOn: aStream
- 	"Override to indicate that this is a block, and to print a null reference when
- 	 the CompiledBlock is only partially initialized, as it is during compilation."
- 	aStream nextPutAll: '[] in '.
- 	self outerCode isVariableBinding
- 		ifTrue: [aStream nextPutAll: ' (as yet unbound)']
- 		ifFalse: [super printReferenceOn: aStream]!

Item was removed:
- ----- Method: CompiledBlock>>propertyKeysAndValuesDo: (in category 'accessing-pragmas & properties') -----
- propertyKeysAndValuesDo: aBlock
- 	"Enumerate the receiver with all the keys and values."
- 	^self homeMethod propertyKeysAndValuesDo: aBlock!

Item was removed:
- ----- Method: CompiledBlock>>propertyValueAt: (in category 'accessing-pragmas & properties') -----
- propertyValueAt: propName
- 	^self homeMethod propertyValueAt: propName!

Item was removed:
- ----- Method: CompiledBlock>>propertyValueAt:ifAbsent: (in category 'accessing-pragmas & properties') -----
- propertyValueAt: propName ifAbsent: aBlock
- 	^self homeMethod propertyValueAt: propName ifAbsent: aBlock!

Item was removed:
- ----- Method: CompiledBlock>>propertyValueAt:put: (in category 'accessing-pragmas & properties') -----
- propertyValueAt: propName put: propValue
- 	"Set or add the property with key propName and value propValue.
- 	 If the receiver does not yet have a method properties create one and replace
- 	 the selector with it.  Otherwise, either relace propValue in the method properties
- 	 or replace method properties with one containing the new property."
- 	^self homeMethod propertyValueAt: propName put: propValue!

Item was removed:
- ----- Method: CompiledBlock>>removeProperty: (in category 'accessing-pragmas & properties') -----
- removeProperty: propName
- 	"Remove the property propName if it exists.
- 	 Do _not_ raise an error if the property is missing."
- 	^self homeMethod removeProperty: propName!

Item was removed:
- ----- Method: CompiledBlock>>removeProperty:ifAbsent: (in category 'accessing-pragmas & properties') -----
- removeProperty: propName ifAbsent: aBlock
- 	"Remove the property propName if it exists.
- 	 Answer the evaluation of aBlock if the property is missing."
- 	^self homeMethod removeProperty: propName ifAbsent: aBlock!

Item was removed:
- ----- Method: CompiledBlock>>selector (in category 'accessing') -----
- selector
- 	^ self homeMethod selector!

Item was removed:
- ByteArray variableByteSubclass: #CompiledCode
- 	instanceVariableNames: ''
- 	classVariableNames: 'LargeFrame PreferredBytecodeSetEncoderClass PrimaryBytecodeSetEncoderClass SecondaryBytecodeSetEncoderClass SmallFrame'
- 	poolDictionaries: ''
- 	category: 'Kernel-Methods'!
- 
- !CompiledCode commentStamp: 'eem 2/27/2018 12:23' prior: 0!
- CompiledCode instances are methods suitable for execution by the virtual machine.  Instances of CompiledCode and its subclasses are the only objects in the system that have both indexable pointer fields and indexable 8-bit integer fields.  The pointer fields are used for literals and metadata, and the bytes are used for bytecodes and a variety of encoded informaton such as source code, source code position, etc.  The first part of a CompiledCode object is pointers, the second part is bytes.  CompiledCode inherits from ByteArray to avoid duplicating some of ByteArray's methods, not because a CompiledCode is-a ByteArray.
- 
- Instance variables: *indexed* (no named inst vars)
- 
- Class variables:
- SmallFrame								- the number of stack slots in a small frame Context
- LargeFrame							- the number of stack slots in a large frame Context
- PrimaryBytecodeSetEncoderClass		- the encoder class that defines the primary instruction set
- SecondaryBytecodeSetEncoderClass	- the encoder class that defines the secondary instruction set
- 
- The current format of a CompiledCode object is as follows:
- 
- 	header (4 or 8 bytes, SmallInteger)
- 	literals (4 or 8 bytes each, Object, see "The last literal..." below)
- 	bytecodes  (variable, bytes)
- 	trailer (variable, bytes)
- 
- The header is a SmallInteger (which in the 32-bit system has 31 bits, and in the 64-bit system, 61 bits) in the following format:
- 
- 	(index 0)		15 bits:	number of literals (#numLiterals)
- 	(index 15)		  1 bit:	jit without counters - reserved for methods that have been optimized by Sista
- 	(index 16)		  1 bit:	has primitive
- 	(index 17)		  1 bit:	whether a large frame size is needed (#frameSize => either SmallFrame or LargeFrame)
- 	(index 18)		  6 bits:	number of temporary variables (#numTemps)
- 	(index 24)		  4 bits:	number of arguments to the method (#numArgs)
- 	(index 28)		  2 bits:	reserved for an access modifier (00-unused, 01-private, 10-protected, 11-public), although accessors for bit 29 exist (see #flag).
- 	sign bit:		  1 bit: selects the instruction set, >= 0 Primary, < 0 Secondary (#signFlag)
- 
- If the method has a primitive then the first bytecode of the method must be a callPrimitive: bytecode that encodes the primitive index.  This bytecode can encode a primitive index from 0 to 65535.
- 
- The trailer is an encoding of an instance of CompiledMethodTrailer.  It is typically used to encode the index into the source files array of the method's source, but may be used to encode other values, e.g. tempNames, source as a string, etc.  See the class CompiledMethodTrailer.
- 
- While there are disadvantages to this "flat" representation (it is impossible to add named instance variables to CompiledCode or its subclasses, but it is possible indirectly; see AdditionalMethodState) it is effective for interpreters.  It means that both bytecodes and literals can be fetched directly from a single method object, and that only one object, the method, must be saved and restored on activation and return.  A more natural representation, in which there are searate instance variables for the bytecode, and (conveniently) the literals, requires either much more work on activation and return setting up references to the literals and bytecodes, or slower access to bytecodes and literals, indirecting on each access.
- 
- The last literal of a CompiledCode object is reserved for special use by the kernel and/or the virtual machine.  In CompiledMethod instances it must either be the methodClassAssociation, used to implement super sends, or nil, if the method is anonymous. In CompiledBlock it is to be used for a reference to the enclosing method or block object.
- 
- By convention, the penultimate literal is reserved for special use by the kernel. In CompiledMethod instances it must either be the method selector, or an instance of AdditionalMethodState which holds the selector and any pragmas or properties in the method.  In CompiledBlock it is reserved for use for an AdditionalMethodState.
- 
- Note that super sends in CompiledBlock instances do not use a methodClass association, but expect a directed supersend bytecode, in which the method class (the subclass of the class in which to start the lookup) is a literal.  Logically when we switch to a bytecode set that supports the directed super send bytecode, and discard the old super send bytecodes, we can use the last literal to store the selector or the enclosing method/block or an AdditionalMethodState, and the AdditionalMethodState can hold the selector and/or the enclosing method/block.!

Item was removed:
- ----- Method: CompiledCode class>>basicNew (in category 'instance creation') -----
- basicNew
- 	^self newMethodViaNewError!

Item was removed:
- ----- Method: CompiledCode class>>basicNew: (in category 'instance creation') -----
- basicNew: size
- 	^self newMethodViaNewError!

Item was removed:
- ----- Method: CompiledCode class>>byteCodeSetsKnownToTheVM (in category 'method encoding') -----
- byteCodeSetsKnownToTheVM
- 	"Answer the encoder names for the bytecode sets reported to be supported
- 	by the virtual machine. Informational, failure indicates only that the VM does
- 	not support the primitive query."
- 
- 	"CompiledCode byteCodeSetsKnownToTheVM"
- 
- 	<primitive: 'primitiveBytecodeSetsAvailable'>
- 	^ self primitiveFailed
- !

Item was removed:
- ----- Method: CompiledCode class>>fullFrameSize (in category 'constants') -----
- fullFrameSize  "CompiledMethod fullFrameSize"
- 	^ LargeFrame!

Item was removed:
- ----- Method: CompiledCode class>>handleFailingFailingNewMethod:header: (in category 'private') -----
- handleFailingFailingNewMethod: numberOfBytes header: headerWord
- 	"This newMethod:header: gets sent after handleFailingBasicNew: has done a full
- 	 garbage collection and possibly grown memory.  If this basicNew: fails then the
- 	 system really is low on space, so raise the OutOfMemory signal.
- 
- 	 Primitive. Answer an instance of this class with the number of indexable variables
- 	 specified by the argument, headerWord, and the number of bytecodes specified
- 	 by numberOfBytes.  Fail if this if the arguments are not Integers, or if numberOfBytes
- 	 is negative, or if the receiver is not a CompiledMethod class, or if there is not enough
- 	 memory available. Essential. See Object documentation whatIsAPrimitive."
- 
- 	<primitive: 79>
- 	"space must be low."
- 	OutOfMemory signal.
- 	"retry if user proceeds"
- 	^self newMethod: numberOfBytes header: headerWord!

Item was removed:
- ----- Method: CompiledCode class>>handleFailingNewMethod:header: (in category 'private') -----
- handleFailingNewMethod: numberOfBytes header: headerWord
- 	"This newMethod:header: gets sent after newMethod:header: has failed
- 	 and allowed a scavenging garbage collection to occur.  The scavenging
- 	 collection will have happened as the VM is activating the (failing) basicNew:.
- 	 If handleFailingBasicNew: fails then the scavenge failed to reclaim sufficient
- 	 space and a global garbage collection is required.  Retry after garbage
- 	 collecting and growing memory if necessary.
- 
- 	 Primitive. Answer an instance of this class with the number of indexable variables
- 	 specified by the argument, headerWord, and the number of bytecodes specified
- 	 by numberOfBytes.  Fail if this if the arguments are not Integers, or if numberOfBytes
- 	 is negative, or if the receiver is not a CompiledMethod class, or if there is not enough
- 	 memory available. Essential. See Object documentation whatIsAPrimitive."
- 
- 	<primitive: 79>
- 	| bytesRequested |
- 	bytesRequested := (headerWord bitAnd: 16rFFFF) + 1 * Smalltalk wordSize + numberOfBytes + 16.
- 	Smalltalk garbageCollect < bytesRequested ifTrue:
- 		[Smalltalk growMemoryByAtLeast: bytesRequested].
- 	"retry after global garbage collect and possible grow"
- 	^self handleFailingFailingNewMethod: numberOfBytes header: headerWord!

Item was removed:
- ----- Method: CompiledCode class>>headerFlagForEncoder: (in category 'method encoding') -----
- headerFlagForEncoder: anEncoder
- 	"This allows subclasses for compiler variants such as the ScriptEncoder in EToys
- 	 to continue to function."
- 	(anEncoder isKindOf: PrimaryBytecodeSetEncoderClass) ifTrue:
- 		[^0].
- 	(anEncoder isKindOf: SecondaryBytecodeSetEncoderClass) ifTrue:
- 		[^SmallInteger minVal].
- 	self error: 'The encoder is not one of the two installed bytecode sets'!

Item was removed:
- ----- Method: CompiledCode class>>initialize (in category 'class initialization') -----
- initialize    "CompiledMethod initialize"
- 	"Initialize class variables specifying the size of the temporary frame
- 	needed to run instances of me."
- 
- 	SmallFrame := 16.	"Context range for temps+stack"
- 	LargeFrame := 56.
- 	PrimaryBytecodeSetEncoderClass ifNil:
- 		[PrimaryBytecodeSetEncoderClass := EncoderForV3PlusClosures].
- 	SecondaryBytecodeSetEncoderClass ifNil:
- 		[SecondaryBytecodeSetEncoderClass := EncoderForSistaV1]!

Item was removed:
- ----- Method: CompiledCode class>>initializedInstance (in category 'instance creation') -----
- initializedInstance
- 	"Don't even think of it.
- 	This low level machinery is not for general use."
- 	
- 	^nil!

Item was removed:
- ----- Method: CompiledCode class>>installPrimaryBytecodeSet: (in category 'class initialization') -----
- installPrimaryBytecodeSet: aBytecodeEncoderSubclass
- 	PrimaryBytecodeSetEncoderClass == aBytecodeEncoderSubclass ifTrue:
- 		[^self].
- 	(aBytecodeEncoderSubclass inheritsFrom: BytecodeEncoder) ifFalse:
- 		[self error: 'A bytecode set encoder is expected to be a subclass of BytecodeEncoder'].
- 	(self allSubInstances
- 			detect: [:m| m header >= 0 and: [m encoderClass ~~ aBytecodeEncoderSubclass]]
- 			ifNone: []) ifNotNil:
- 		[Warning signal: 'There are existing CompiledMethods with a different encoderClass.'].
- 	PrimaryBytecodeSetEncoderClass := aBytecodeEncoderSubclass!

Item was removed:
- ----- Method: CompiledCode class>>installSecondaryBytecodeSet: (in category 'class initialization') -----
- installSecondaryBytecodeSet: aBytecodeEncoderSubclass
- 	PrimaryBytecodeSetEncoderClass == aBytecodeEncoderSubclass ifTrue:
- 		[^self].
- 	(aBytecodeEncoderSubclass inheritsFrom: BytecodeEncoder) ifFalse:
- 		[self error: 'A bytecode set encoder is expected to be a subclass of BytecodeEncoder'].
- 	(self allSubInstances
- 			detect: [:m| m header < 0 and: [m encoderClass ~~ aBytecodeEncoderSubclass]]
- 			ifNone: []) ifNotNil:
- 		[Warning signal: 'There are existing CompiledMethods with a different encoderClass.'].
- 	SecondaryBytecodeSetEncoderClass := aBytecodeEncoderSubclass!

Item was removed:
- ----- Method: CompiledCode class>>isCompiledCodeClass (in category 'testing') -----
- isCompiledCodeClass
- 	^true!

Item was removed:
- ----- Method: CompiledCode class>>maxNumLiterals (in category 'constants') -----
- maxNumLiterals
- 	"The current header format and the VM's interpretation of it allows for a maximum of 32767 literals."
- 	^32767!

Item was removed:
- ----- Method: CompiledCode class>>multipleBytecodeSetsActive (in category 'method encoding') -----
- multipleBytecodeSetsActive
- 	"Answer if the VM supports multiple bytecode sets, typically the Sista bytecodes
- 	in addition to the traditional V3 bytecode set."
- 
- 	<primitive: 'primitiveMultipleBytecodeSetsActive'>
- 	self primitiveFailed
- !

Item was removed:
- ----- Method: CompiledCode class>>multipleBytecodeSetsActive: (in category 'method encoding') -----
- multipleBytecodeSetsActive: aBoolean
- 	"Inform the VM when multiple bytecode sets, typically the Sista bytecodes
- 	in addition to the traditional V3 bytecode set, are now in use is this image.
- 	The VM may use this information to update the image format number when
- 	saving the image to the file system."
- 
- 	<primitive: 'primitiveMultipleBytecodeSetsActive'>
- !

Item was removed:
- ----- Method: CompiledCode class>>new (in category 'instance creation') -----
- new
- 	^self newMethodViaNewError!

Item was removed:
- ----- Method: CompiledCode class>>new: (in category 'instance creation') -----
- new: size
- 	^self newMethodViaNewError!

Item was removed:
- ----- Method: CompiledCode class>>newBytes:trailerBytes:nArgs:nTemps:nStack:nLits:primitive: (in category 'instance creation') -----
- newBytes: numberOfBytes trailerBytes: trailer nArgs: nArgs nTemps: nTemps nStack: stackSize nLits: nLits primitive: primitiveIndex
- 	"Answer an instance of me. The header is specified by the message 
- 	 arguments. The remaining parts are not as yet determined."
- 	| method pc |
- 	nArgs > 15 ifTrue:
- 		[^self error: 'Cannot compile -- too many arguments'].
- 	nTemps > 63 ifTrue:
- 		[^self error: 'Cannot compile -- too many temporary variables'].	
- 	nLits > 32767 ifTrue:
- 		[^self error: 'Cannot compile -- too many literals'].
- 
- 	method := trailer
- 				createMethod: numberOfBytes
- 				class: self
- 				header:    (nArgs bitShift: 24)
- 						+ (nTemps bitShift: 18)
- 						+ ((nTemps + stackSize) > SmallFrame ifTrue: [1 bitShift: 17] ifFalse: [0])
- 						+ nLits
- 						+ (primitiveIndex > 0 ifTrue: [1 bitShift: 16] ifFalse: [0]).
- 	primitiveIndex > 0 ifTrue:
- 		[pc := method initialPC.
- 		 method
- 			at: pc + 0 put: method encoderClass callPrimitiveCode;
- 			at: pc + 1 put: (primitiveIndex bitAnd: 16rFF);
- 			at: pc + 2 put: (primitiveIndex bitShift: -8)].
- 	^method!

Item was removed:
- ----- Method: CompiledCode class>>newBytes:trailerBytes:nArgs:nTemps:nStack:nLits:primitive:flag: (in category 'instance creation') -----
- newBytes: numberOfBytes trailerBytes: trailer nArgs: nArgs nTemps: nTemps nStack: stackSize nLits: nLits primitive: primitiveIndex flag: flag
- 	"Answer an instance of me. The header is specified by the message 
- 	 arguments. The remaining parts are not as yet determined."
- 	| method pc |
- 	nArgs > 15 ifTrue:
- 		[^self error: 'Cannot compile -- too many arguments'].
- 	nTemps > 63 ifTrue:
- 		[^self error: 'Cannot compile -- too many temporary variables'].	
- 	nLits > 32767 ifTrue:
- 		[^self error: 'Cannot compile -- too many literals'].
- 
- 	method := trailer
- 				createMethod: numberOfBytes
- 				class: self
- 				header:    (nArgs bitShift: 24)
- 						+ (nTemps bitShift: 18)
- 						+ ((nTemps + stackSize) > SmallFrame ifTrue: [1 bitShift: 17] ifFalse: [0])
- 						+ nLits
- 						+ (primitiveIndex > 0 ifTrue: [1 bitShift: 16] ifFalse: [0])
- 						+ (flag ifTrue: [1 bitShift: 29] ifFalse: [0]).
- 	primitiveIndex > 0 ifTrue:
- 		[pc := method initialPC.
- 		 method
- 			at: pc + 0 put: method encoderClass callPrimitiveCode;
- 			at: pc + 1 put: (primitiveIndex bitAnd: 16rFF);
- 			at: pc + 2 put: (primitiveIndex bitShift: -8)].
- 	^method!

Item was removed:
- ----- Method: CompiledCode class>>newFrom: (in category 'instance creation') -----
- newFrom: aCompiledMethod
- 	"Clone the argument, aCompiledMethod"
- 	| inst |
- 	"CompiledMethod newFrom: CompiledMethod class >> #newFrom:"
- 	inst := self newMethod: aCompiledMethod basicSize - aCompiledMethod initialPC + 1
- 				header: aCompiledMethod header.
- 	1 to: aCompiledMethod numLiterals do:
- 		[:index|
- 		inst literalAt: index put: (aCompiledMethod literalAt: index)].
- 	aCompiledMethod initialPC to: aCompiledMethod size do:
- 		[:index |
- 		inst at: index put: (aCompiledMethod at: index)].
- 	inst postCopy.
- 	^inst!

Item was removed:
- ----- Method: CompiledCode class>>newInstanceFrom:variable:size:map: (in category 'instance creation') -----
- newInstanceFrom: oldInstance variable: variable size: instSize map: map
- 	"Create a new instance of the receiver based on the given old instance.
- 	The supplied map contains a mapping of the old instVar names into
- 	the receiver's instVars"
- 	| new |
- 	new := self newFrom: oldInstance.
- 	1 to: instSize do: 
- 		[:offset |  (map at: offset) > 0 ifTrue:
- 			[new instVarAt: offset
- 					put: (oldInstance instVarAt: (map at: offset))]].
- 	^new!

Item was removed:
- ----- Method: CompiledCode class>>newMethod:header: (in category 'instance creation') -----
- newMethod: numberOfBytes header: headerWord
- 	"Primitive. Answer an instance of me. The number of literals (and other 
- 	 information) is specified by the headerWord (see my class comment).
- 	 The first argument specifies the number of fields for bytecodes in the
- 	 method. Fail if either argument is not a SmallInteger, or if numberOfBytes
- 	 is negative, or if memory is low. Once the header of a method is set by
- 	 this primitive, it cannot be changed to change the number of literals.
- 	 Essential. See Object documentation whatIsAPrimitive."
- 
- 	<primitive: 79 error: ec>
- 	ec == #'insufficient object memory' ifTrue:
- 		[^self handleFailingNewMethod: numberOfBytes header: headerWord].
- 	^self primitiveFailed!

Item was removed:
- ----- Method: CompiledCode class>>newMethodViaNewError (in category 'private') -----
- newMethodViaNewError
- 
- 	^self error: self class name, 's may only be created with newMethod:header:'!

Item was removed:
- ----- Method: CompiledCode class>>preferredBytecodeSetEncoderClass (in category 'preferences') -----
- preferredBytecodeSetEncoderClass
- 	<preference: 'Preferred bytecode set encoder class'
- 	  category: 'Compiler'
- 	  description: 'The system supports up to two bytecode sets; select the preferred one to use here.  See CompiledCode class variables PrimaryBytecodeSetEncoderClass and SecondaryBytecodeSetEncoderClass.'
- 	  type: #Class>
- 	^PreferredBytecodeSetEncoderClass ifNil: [SecondaryBytecodeSetEncoderClass]!

Item was removed:
- ----- Method: CompiledCode class>>preferredBytecodeSetEncoderClass: (in category 'preferences') -----
- preferredBytecodeSetEncoderClass: aBytecodeEncoderSubclass
- 	"Set the class that determines the bytecode set used to compile methods with.
- 			[| nPrimary nSecondary |
- 			nPrimary := nSecondary := 0.
- 			self allSubInstancesDo:
- 				[:cm|
- 				cm header >= 0
- 					ifTrue: [nPrimary := nPrimary + 1]
- 					ifFalse: [nSecondary := nSecondary + 1]].
- 			{nPrimary. nSecondary}]"
- 	| nPrimary nSecondary |
- 	aBytecodeEncoderSubclass ifNil: [ "Use default value."
- 		PreferredBytecodeSetEncoderClass := nil.
- 		^ self preferredBytecodeSetEncoderClass: self preferredBytecodeSetEncoderClass].
- 	self assert: (aBytecodeEncoderSubclass includesBehavior: BytecodeEncoder).
- 	(aBytecodeEncoderSubclass == PrimaryBytecodeSetEncoderClass
- 	 or: [aBytecodeEncoderSubclass == SecondaryBytecodeSetEncoderClass]) ifTrue:
- 		[PreferredBytecodeSetEncoderClass := aBytecodeEncoderSubclass.
- 		 ^self].
- 	nPrimary := nSecondary := 0.
- 	self allSubInstancesDo:
- 		[:cm|
- 		 cm header >= 0
- 			ifTrue: [nPrimary := nPrimary + 1]
- 			ifFalse: [nSecondary := nSecondary + 1]].
- 	nPrimary = 0 ifTrue:
- 		[self installPrimaryBytecodeSet: aBytecodeEncoderSubclass.
- 		 ^self preferredBytecodeSetEncoderClass: aBytecodeEncoderSubclass].
- 	nSecondary = 0 ifTrue:
- 		[self installSecondaryBytecodeSet: aBytecodeEncoderSubclass.
- 		 ^self preferredBytecodeSetEncoderClass: aBytecodeEncoderSubclass].
- 	self error: 'Cannot set preferred bytecode set.  Both of the current sets appear to be in use.'!

Item was removed:
- ----- Method: CompiledCode class>>primaryBytecodeSetEncoderClass (in category 'method encoding') -----
- primaryBytecodeSetEncoderClass
- 	^PrimaryBytecodeSetEncoderClass!

Item was removed:
- ----- Method: CompiledCode class>>scanBlocksForLiteral:do: (in category 'scanning') -----
- scanBlocksForLiteral: aLiteral do: aBinaryBlock
- 	"Evaluate aBinaryBlock with the literal scanners for aLiteral (which will be nil
- 	 if there are no special bytecodes that access aLiteral), and answer its value."
- 	^aBinaryBlock
- 		value: (PrimaryBytecodeSetEncoderClass scanBlockOrNilForLiteral: aLiteral)
- 		value: (SecondaryBytecodeSetEncoderClass scanBlockOrNilForLiteral: aLiteral)!

Item was removed:
- ----- Method: CompiledCode class>>secondaryBytecodeSetEncoderClass (in category 'method encoding') -----
- secondaryBytecodeSetEncoderClass
- 	^SecondaryBytecodeSetEncoderClass!

Item was removed:
- ----- Method: CompiledCode class>>smallFrameSize (in category 'constants') -----
- smallFrameSize
- 
- 	^ SmallFrame!

Item was removed:
- ----- Method: CompiledCode class>>useSistaBytecodeSet: (in category 'method encoding') -----
- useSistaBytecodeSet: useSistaEncoder
- 	"Switch to or from the Sista bytecode encoder, and recompile the system
- 	using that encoder. Assumes that Compiler recompileAll is working for the
- 	existing system. Assumes that the currently available primary and secondary
- 	bytecode encoders are EncoderForV3PlusClosures and EncoderForSistaV1.
- 	This is a convenience method that must be updated as the available encoders
- 	are changed."
- 
- 	"CompiledCode useSistaBytecodeSet: true"
- 	"CompiledCode useSistaBytecodeSet: false"
- 
- 	| standardEncoder sistaEncoder activeEncoder |
- 	standardEncoder := Smalltalk classNamed: #EncoderForV3PlusClosures.
- 	sistaEncoder := Smalltalk classNamed: #EncoderForSistaV1.
- 	activeEncoder := self preferredBytecodeSetEncoderClass.
- 	useSistaEncoder
- 		ifTrue: [sistaEncoder ifNil: [self error: 'EncoderForSistaV1 not present in this image'].
- 			self preferredBytecodeSetEncoderClass: sistaEncoder.
- 			activeEncoder ~= sistaEncoder
- 				ifTrue: [(Smalltalk classNamed: #Compiler) recompileAll.
- 			self multipleBytecodeSetsActive: true "VM should support Sista plus V3" ]]
- 		ifFalse: [standardEncoder ifNil: [self error: 'EncoderForV3PlusClosures not present in this image'].
- 			self preferredBytecodeSetEncoderClass: standardEncoder.
- 			activeEncoder ~= standardEncoder
- 				ifTrue: [(Smalltalk classNamed: #Compiler) recompileAll.
- 			self multipleBytecodeSetsActive: false "VM needs to support V3 only" ]].
- 
- !

Item was removed:
- ----- Method: CompiledCode>>= (in category 'comparing') -----
- = aMethod
- 	"Answer whether the receiver implements the same code as the argument, aMethod.
- 	 Here ``same code'' means that if the receiver's source is compiled with the same
- 	 compiler it should produce the same sequence of bytecodes and literals, same
- 	 trailer and same properties.  Hence this definition of #= (only one of many plausible
- 	 definitions) can be used to quickly identify changes in the compiler's output."
- 	self == aMethod ifTrue:
- 		[^true].
- 	(aMethod isCompiledCode
- 	 and: [self size = aMethod size
- 	 and: [self header = aMethod header]]) ifFalse:"N.B. includes numLiterals comparison."
- 		[^false].
- 	self initialPC to: self endPC do:
- 		[:i | (self at: i) = (aMethod at: i) ifFalse: [^false]].
- 	^self hasSameLiteralsAs: aMethod!

Item was removed:
- ----- Method: CompiledCode>>abstractBytecodeMessageAt: (in category 'scanning') -----
- abstractBytecodeMessageAt: pc
- 	"Answer the abstract bytecode message at pc in the receiver."
- 	^[(InstructionStream new method: self pc: pc) interpretNextInstructionFor: ImplicitLiteralInstructionClientHook new]
- 		on: MessageNotUnderstood
- 		do: [:ex| ex message]!

Item was removed:
- ----- Method: CompiledCode>>abstractBytecodeMessagesAndPCs (in category 'scanning') -----
- abstractBytecodeMessagesAndPCs
- 	"Answer the receiver's sequence of abstract bytecodes as a sequence of tuples of bytecode message and pc."
- 	"(CompiledCode >> #abstractBytecodeMessagesAndPCs) abstractBytecodeMessagesAndPCs"
- 	| msgs initial endpc pc scanner encoderClass implciitLiteralHook |
- 	scanner := InstructionStream new method: self pc: (initial := self initialPC).
- 	msgs := OrderedCollection new: (endpc  := self endPC) - initial.
- 	encoderClass := self encoderClass.
- 	implciitLiteralHook := ImplicitLiteralInstructionClientHook new.
- 	[(pc := scanner pc) <= endpc] whileTrue:
- 		"i.e. nil will not understand any message and so the exception block will collect all of them."
- 		[[encoderClass interpretNextInstructionFor: implciitLiteralHook in: scanner]
- 			on: MessageNotUnderstood
- 			do: [:ex| msgs addLast: { ex message. pc }]].
- 	^msgs!

Item was removed:
- ----- Method: CompiledCode>>abstractBytecodeMessagesDo: (in category 'scanning') -----
- abstractBytecodeMessagesDo: aBlock
- 	"Evaluate aBlock with the sequence of abstract bytecodes in the receiver"
- 	self abstractBytecodeMessagesFrom: self initialPC
- 		to: self endPC
- 		do: aBlock
- 
- 	"| msgs |
- 	 msgs := OrderedCollection new.
- 	 CompiledCode >> #abstractBytecodeMessagesFrom:to: abstractBytecodeMessagesDo:
- 		[:msg| msgs addLast: msg selector].
- 	 msgs"!

Item was removed:
- ----- Method: CompiledCode>>abstractBytecodeMessagesFrom:to:do: (in category 'scanning') -----
- abstractBytecodeMessagesFrom: startpc to: endpc do: aBlock
- 	"Evaluate aBlock with the sequence of abstract bytecodes from startpc through endpc in the receiver"
- 	| scanner encoderClass implciitLiteralHook |
- 	scanner := InstructionStream new method: self pc: startpc.
- 	encoderClass := self encoderClass.
- 	implciitLiteralHook := ImplicitLiteralInstructionClientHook new.
- 	[scanner pc <= endpc] whileTrue:
- 		"i.e. nil will not understand any message and so the exception block will collect all of them."
- 		[[encoderClass interpretNextInstructionFor: implciitLiteralHook in: scanner]
- 			on: MessageNotUnderstood
- 			do: [:ex| aBlock value: ex message]]
- 
- 	"| m msgs |
- 	 msgs := OrderedCollection new.
- 	 (m := CompiledCode >> #abstractBytecodeMessagesFrom:to:do:)
- 		abstractBytecodeMessagesFrom: m initialPC
- 		to: m endPC
- 		do: [:msg| msgs add: msg selector].
- 	 msgs"!

Item was removed:
- ----- Method: CompiledCode>>allLiterals (in category 'literals') -----
- allLiterals
- 	"Skip compiled-code objects. Keep literal arrays, bindings, etc."
- 	
- 	^ Array streamContents: [:result |
- 		self allLiteralsDo: [:literal | result nextPut: literal]]!

Item was removed:
- ----- Method: CompiledCode>>allLiteralsDo: (in category 'literals') -----
- allLiteralsDo: aBlock
- 	"Enumerate all literals thoroughly. Follow nested instances of CompiledCode. Do not treat compiled code as literals here."
- 	
- 	self codeLiteralsDo:
- 		[:compiledCode |
- 		compiledCode literalsDo:
- 			[:literal |
- 			literal isCompiledCode ifFalse:
- 				[literal allLiteralsDo: aBlock]].
- 		compiledCode implicitLiteralsDo: aBlock]!

Item was removed:
- ----- Method: CompiledCode>>asString (in category 'converting') -----
- asString
- 
- 	^self printString!

Item was removed:
- ----- Method: CompiledCode>>at:ifAbsent: (in category 'accessing') -----
- at: index ifAbsent: exceptionBlock 
- 	"Answer the element at my position index. If I do not contain an element 
- 	at index, answer the result of evaluating the argument, exceptionBlock."
- 
- 	(index <= self size  and: [self initialPC <= index]) ifTrue: [^self at: index].
- 	^exceptionBlock value!

Item was removed:
- ----- Method: CompiledCode>>bytecodeSetName (in category 'accessing') -----
- bytecodeSetName
- 	^self encoderClass bytecodeSetName!

Item was removed:
- ----- Method: CompiledCode>>clearFlag (in category 'accessing') -----
- clearFlag
- 	"Clear the user-level flag bit"
- 
- 	self objectAt: 1 put: (self header bitAnd: (1 << 29) bitInvert)!

Item was removed:
- ----- Method: CompiledCode>>clearSignFlag (in category 'accessing') -----
- clearSignFlag
- 	"Clear the sign flag bit.  The sign flag bit may be
- 	 used by the VM to select an alternate bytecode set."
- 
- 	self signFlag ifTrue:
- 		[self objectAt: 1 put: self header - SmallInteger minVal]!

Item was removed:
- ----- Method: CompiledCode>>codeLiterals (in category 'literals') -----
- codeLiterals
- 
- 	^ Array streamContents: [:stream |
- 		self codeLiteralsDo: [:compiledCode | stream nextPut: compiledCode]]!

Item was removed:
- ----- Method: CompiledCode>>codeLiteralsDo: (in category 'literals') -----
- codeLiteralsDo: aBlock
- 	"Enumerate all literals that represent instances of CompiledCode. This is especially required for SistaV1."
- 	
- 	aBlock value: self.
- 	
- 	self literalsDo: [:literal | literal isCompiledCode ifTrue: [
- 		literal codeLiteralsDo: aBlock]].!

Item was removed:
- ----- Method: CompiledCode>>copyFrom: (in category 'copying') -----
- copyFrom: anotherObject
- 	"Copy to myself all instance variables I have in common with anotherObject.
- 	 This is dangerous because it ignores an object's control over its own inst vars."
- 
- 	<primitive: 168>
- 	anotherObject isCompiledCode
- 		ifTrue:
- 			[1 to: self numLiterals do:
- 				[:i| self literalAt: i put: (anotherObject literalAt: i)]]
- 		ifFalse:
- 			[1 to: self numLiterals do:
- 				[:i| self literalAt: i put: (anotherObject at: i)]].
- 	self initialPC to: (self basicSize min: anotherObject basicSize) do:
- 		[:i|
- 		 self basicAt: i put: (anotherObject basicAt: i)]!

Item was removed:
- ----- Method: CompiledCode>>decompile (in category 'decompiling') -----
- decompile
- 	"Return the decompiled parse tree that represents self"
- 
- 	|  class selector |
- 	class := self methodClass ifNil: [Object].
- 	selector := self selector ifNil: [self defaultSelector].
- 	^class decompilerClass new decompile: selector in: class method: self methodForDecompile!

Item was removed:
- ----- Method: CompiledCode>>decompileWithTemps (in category 'decompiling') -----
- decompileWithTemps
- 	"Answer the decompiled parse tree that represents self, but with the temp names obtained
- 	 either by compiling the source code, or directly if the method has temps in its trailer."
- 
- 	^self homeMethod decompileWithTemps!

Item was removed:
- ----- Method: CompiledCode>>encoderClass (in category 'accessing') -----
- encoderClass
- 	"Answer the encoder class that encoded the bytecodes in this method.
- 	 The sign flag bit is used by the VM to select a bytecode set.  This formulation
- 	 may seem odd but this has to be fast, so no property probe unless needed."
- 
- 	^self header >= 0
- 		ifTrue: 
- 			[PrimaryBytecodeSetEncoderClass]
- 		ifFalse:
- 			[PrimaryBytecodeSetEncoderClass == SecondaryBytecodeSetEncoderClass
- 				ifTrue: "Support for testing prior to installing another set"
- 					[(self propertyValueAt: #encoderClass) ifNil: [SecondaryBytecodeSetEncoderClass]]
- 				ifFalse:
- 					[SecondaryBytecodeSetEncoderClass]]!

Item was removed:
- ----- Method: CompiledCode>>endPC (in category 'accessing') -----
- endPC
- 	"Answer the index of the last bytecode."
- 	^ self trailer endPC
- !

Item was removed:
- ----- Method: CompiledCode>>flag (in category 'accessing') -----
- flag
- 	"Answer the user-level flag bit"
- 
- 	^((self header bitShift: -29) bitAnd: 1) = 1!

Item was removed:
- ----- Method: CompiledCode>>flushCache (in category 'cleaning') -----
- flushCache
- 	"Tell the virtual machine to remove all references to this method from its method
- 	 lookup cache(s), if it has them. This is provided for backwards compatibility.
- 	 When a method is redefined (added to, removed from, or replaced in, a method
- 	 dictionary) then Symbol flushCache should be used. This is because adding or
- 	 removing a method may alter the method that a given selector should invoke
- 	 for methods other than the receiver.  For example, if a subclass inherits a
- 	 method and this is overridden, flushing the new method will not flush the existing
- 	 method.
- 
- 	 If a method is modified in-place (for example, some bytecode is replaced by
- 	 bytecode that effects a breakpoint) then voidCogVMState should be used."
- 
- 	<primitive: 116>!

Item was removed:
- ----- Method: CompiledCode>>frameSize (in category 'accessing') -----
- frameSize
- 	"Answer the size of temporary frame needed to run the receiver."
- 	"NOTE:  Versions 2.7 and later use two sizes of contexts."
- 
- 	(self header noMask: 16r20000)
- 		ifTrue: [^ SmallFrame]
- 		ifFalse: [^ LargeFrame]
- !

Item was removed:
- ----- Method: CompiledCode>>getSource (in category 'source code management') -----
- getSource
- 	^ self getSourceFor: self selector in:self methodClass.!

Item was removed:
- ----- Method: CompiledCode>>getSourceFor:in: (in category 'source code management') -----
- getSourceFor: selector in: class
- 	"Retrieve or reconstruct the source code for this method."
- 
- 	^self method getSourceFor: selector in: class!

Item was removed:
- ----- Method: CompiledCode>>hasBreakpoint (in category '*Kernel-tool support') -----
- hasBreakpoint
- 	^ self class environment
- 		at: #BreakpointManager
- 		ifPresent: [:bpm | bpm methodHasBreakpoint: self]
- 		ifAbsent: [false]!

Item was removed:
- ----- Method: CompiledCode>>hasLiteral: (in category 'literals') -----
- hasLiteral: aLiteral
- 	"Overwrite this method to invoke the bytecode encoder scanner explicitly. This might be removed if there would be a way to enumerate special literals in a compiled-code object. See #allLiteralsDo:."
- 
- 	^ self
- 		hasLiteral: aLiteral
- 		scanForSpecial: (self encoderClass canBeSpecialLiteral: aLiteral)!

Item was removed:
- ----- Method: CompiledCode>>hasLiteral:scanForSpecial: (in category 'literals') -----
- hasLiteral: aLiteral scanForSpecial: aBoolean
- 	"Like #hasLiteral: but can scan for encoder-specific special literals. Not that scanning has a noticeable performance impact."
- 
- 	| scanBlock |
- 	(super hasLiteral: aLiteral) ifTrue: [^ true].
- 	
- 	aBoolean ifFalse: [^ false].
- 
- 	scanBlock := self class
- 		scanBlocksForLiteral: aLiteral
- 		do: [:primaryScanner :secondaryScanner |
- 			"E.g., scanner for SistaV1 or scanner for V3PlusClosures"
- 			self signFlag ifTrue: [secondaryScanner] ifFalse: [primaryScanner]].
- 	
- 	self codeLiteralsDo: [:compiledCode |
- 		(compiledCode scanFor: scanBlock) ifTrue: [^ true]].
- 
- 	^ false!

Item was removed:
- ----- Method: CompiledCode>>hasMethodReturn (in category 'testing') -----
- hasMethodReturn
- 	"Answer whether the receiver has a method-return ('^') in its code."
- 
- 	| scanner |
- 	self codeLiteralsDo: [:compiledCode | 
- 		scanner := InstructionStream on: compiledCode.
- 		(scanner scanFor: [:x | (scanner willReturn
- 				and: [scanner willBlockReturn not])
- 				"and: [scanner willReturnTopFromMethod not]" "-> Not supported in EncoderForSistaV1"])
- 			ifTrue: [^ true]].
- 	^ false!

Item was removed:
- ----- Method: CompiledCode>>hasNoCountersFlag (in category 'accessing') -----
- hasNoCountersFlag
- 	"The Cog Sista VMs interpret bit 16 of the method header as suppressing the generation of performance counters."
- 	^self header anyMask: 16r8000!

Item was removed:
- ----- Method: CompiledCode>>hasSameLiteralsAs: (in category 'comparing') -----
- hasSameLiteralsAs: aMethod
- 	"Answer whether the receiver has the same sequence of literals as the argument."
- 	self subclassResponsibility!

Item was removed:
- ----- Method: CompiledCode>>hash (in category 'comparing') -----
- hash
- 	"CompiledCode>>#= compares code, i.e. same literals and same bytecode.
- 	 So we look at the size, the header and some bytes between initialPC and endPC,
- 	 but neither selector nor methodClass because the #= does not either..
- 	 Note that we must override ByteArray>>#hash which looks at all bytes of the receiver.
- 	 Using bytes from the pointer part of a CompiledCode can lead to a variable hash
- 	 if and when when the GC moves literals in the receiver."
- 
- 	| initialPC endPC hash |
- 	initialPC := self initialPC.
- 	endPC := self endPC.
- 	hash := (((self size hashMultiply + self header) hashMultiply + initialPC) hashMultiply + endPC) hashMultiply.
- 	"sample approximately 20 bytes"
- 	initialPC to: endPC by: (endPC - initialPC // 20 max: 1) do:
- 		[:i| hash := (hash + (self at: i)) hashMultiply].
- 	^hash
- 
- 	"(CompiledCode>>#hash) hash"!

Item was removed:
- ----- Method: CompiledCode>>header (in category 'literals') -----
- header
- 	"Answer the word containing the information about the form of the 
- 	 receiver and the form of the context needed to run the receiver.
- 
- 		sign:1 29-28:accessModifier 27-24:numArgs 23-18:numTemps 17:largeFrameFlag 16:hasPrimitive 15:isOptimized 14-0:numLits"
- 
- 	^self objectAt: 1!

Item was removed:
- ----- Method: CompiledCode>>headerDescription (in category 'printing') -----
- headerDescription
- 	"Answer a description containing the information about the form of the
- 	 receiver and the form of the context needed to run the receiver."
- 
- 	self subclassResponsibility!

Item was removed:
- ----- Method: CompiledCode>>homeMethod (in category 'accessing') -----
- homeMethod
- 	"Answer the home method associated with the receiver."
- 
- 	^self subclassResponsibility!

Item was removed:
- ----- Method: CompiledCode>>implicitLiteralsDo: (in category 'literals') -----
- implicitLiteralsDo: aBlock
- 	"Enumerate the implicit literals in bytecodes of the receiver."
- 	
- 	| stream client encoderClass endPC |
- 	"Enumerate special selectors & special literals such as true and false."
- 	stream := InstructionStream on: self.
- 	encoderClass := self encoderClass.
- 	"cache endPC for methods with embedded source; finding out the endPC is very slow in this case..."
- 	endPC := self endPC.
- 	client := ImplicitLiteralFinder new.
- 	[stream pc <= endPC] whileTrue:
- 		[| literalOrClient |
- 		literalOrClient := encoderClass interpretNextInstructionFor: client in: stream.
- 		literalOrClient ~~ client ifTrue:
- 			[aBlock value: literalOrClient]]!

Item was removed:
- ----- Method: CompiledCode>>indexOfLiteral: (in category 'literals') -----
- indexOfLiteral: literal
- 	"Answer the literal index of the argument, literal, or zero if none."
- 	2 to: self numLiterals - 1 "exclude selector/properties + methodClass"
- 	   do:
- 		[:index |
- 		literal == (self objectAt: index) ifTrue: [^index - 1]].
- 	^0!

Item was removed:
- ----- Method: CompiledCode>>initialPC (in category 'accessing') -----
- initialPC
- 	"Answer the program counter for the receiver's first bytecode."
- 
- 	^ (self numLiterals + 1) * Smalltalk wordSize + 1
- !

Item was removed:
- ----- Method: CompiledCode>>isCompiledBlock (in category 'testing') -----
- isCompiledBlock
- 	^false!

Item was removed:
- ----- Method: CompiledCode>>isCompiledCode (in category 'testing') -----
- isCompiledCode
- 	^true!

Item was removed:
- ----- Method: CompiledCode>>isCompiledMethod (in category 'testing') -----
- isCompiledMethod
- 	^false!

Item was removed:
- ----- Method: CompiledCode>>isQuick (in category 'testing') -----
- isQuick
- 
- 	self subclassResponsibility.!

Item was removed:
- ----- Method: CompiledCode>>literalAt: (in category 'literals') -----
- literalAt: index 
- 	"Answer the literal indexed by the argument."
- 
- 	^self objectAt: index + 1!

Item was removed:
- ----- Method: CompiledCode>>literalAt:put: (in category 'literals') -----
- literalAt: index put: value 
- 	"Replace the literal indexed by the first argument with the second 
- 	argument. Answer the second argument."
- 
- 	^self objectAt: index + 1 put: value!

Item was removed:
- ----- Method: CompiledCode>>literals (in category 'literals') -----
- literals
- 	
- 	^ Array streamContents: [:result |
- 		self literalsDo: [:lit | result nextPut: lit]]!

Item was removed:
- ----- Method: CompiledCode>>literalsDo: (in category 'literals') -----
- literalsDo: aBlock
- 	"Evaluate aBlock for each of the literals referenced by the receiver. Note that this (raw) enumeration addresses *all* objects stored *after* the method header and *before* the first byte code. If you require a deep and meaningful enumeration of literals use #allLiteralsDo: or #codeLiteralsDo:."
- 	
- 	1 to: self numLiterals do: [:index |
- 		aBlock value: (self literalAt: index)].!

Item was removed:
- ----- Method: CompiledCode>>longPrintOn: (in category 'printing') -----
- longPrintOn: aStream
- 	"List of all the byte codes in a method with a short description of each" 
- 
- 	self longPrintOn: aStream indent: 0!

Item was removed:
- ----- Method: CompiledCode>>messages (in category 'scanning') -----
- messages
- 	"Answer a Set of all the message selectors sent by this method."
- 
- 	| result |
- 	result := Set new.
- 	self selectorsDo: [:selector | result add: selector].
- 	^ result!

Item was removed:
- ----- Method: CompiledCode>>messagesSequence (in category 'scanning') -----
- messagesSequence
- 	"Answer a sequence of all the message selectors sent by this method in the order they are sent. Unlike #messages this may include duplicates. Note that both the sources and the decompiled sources might suggest different results. The returned information reflect the actual bytecode."
- 
- 	^ Array streamContents: [:result |
- 		self selectorsDo: [:selector | result nextPut: selector]]!

Item was removed:
- ----- Method: CompiledCode>>method (in category 'accessing') -----
- method
- 	"Answer the home method associated with the receiver."
- 
- 	^self subclassResponsibility!

Item was removed:
- ----- Method: CompiledCode>>methodClass (in category 'accessing') -----
- methodClass
- 	"Answer the class that I am installed in."
- 	^self subclassResponsibility!

Item was removed:
- ----- Method: CompiledCode>>needsFrameSize: (in category 'initialize-release') -----
- needsFrameSize: newFrameSize
- 	"Set the largeFrameBit to accomodate the newFrameSize"
- 	| largeFrameBit header |
- 	largeFrameBit := 16r20000.
- 	(self numTemps + newFrameSize) > LargeFrame ifTrue:
- 		[^ self error: 'Cannot compile -- stack including temps is too deep'].
- 	header := self objectAt: 1.
- 	(header bitAnd: largeFrameBit) ~= 0
- 		ifTrue: [header := header - largeFrameBit].
- 	self objectAt: 1 put: header
- 			+ ((self numTemps + newFrameSize) > SmallFrame
- 					ifTrue: [largeFrameBit]
- 					ifFalse: [0])!

Item was removed:
- ----- Method: CompiledCode>>numArgs (in category 'accessing') -----
- numArgs
- 	"Answer the number of arguments the receiver takes."
- 
- 	^ (self header bitShift: -24) bitAnd: 16r0F!

Item was removed:
- ----- Method: CompiledCode>>numLiterals (in category 'accessing') -----
- numLiterals
- 	"Answer the number of literals used by the receiver."
- 	^self header bitAnd: 16r7FFF!

Item was removed:
- ----- Method: CompiledCode>>numTemps (in category 'accessing') -----
- numTemps
- 	"Answer the number of temporary variables used by the receiver."
- 	
- 	^ (self header bitShift: -18) bitAnd: 16r3F!

Item was removed:
- ----- Method: CompiledCode>>objectAt: (in category 'literals') -----
- objectAt: index 
- 	"Primitive. Answer the method header (if index=1) or a literal (if index 
- 	>1) from the receiver. Essential. See Object documentation 
- 	whatIsAPrimitive."
- 
- 	<primitive: 68>
- 	self primitiveFailed!

Item was removed:
- ----- Method: CompiledCode>>objectAt:put: (in category 'literals') -----
- objectAt: index put: value 
- 	"Primitive. Store the value argument into a literal in the receiver. An 
- 	index of 2 corresponds to the first literal. Fails if the index is less than 2 
- 	or greater than the number of literals. Answer the value as the result. 
- 	Normally only the compiler sends this message, because only the 
- 	compiler stores values in CompiledMethods. Essential. See Object 
- 	documentation whatIsAPrimitive."
- 
- 	<primitive: 69>
- 	self primitiveFailed!

Item was removed:
- ----- Method: CompiledCode>>outboundPointersDo: (in category 'tracing') -----
- outboundPointersDo: aBlock
- 
- 	| numLiterals |
- 	aBlock value: self class.
- 	numLiterals := self numLiterals.
- 	1 to: numLiterals do: [:i | aBlock value: (self literalAt: i)]!

Item was removed:
- ----- Method: CompiledCode>>pcPreviousTo: (in category 'scanning') -----
- pcPreviousTo: thePC
- 	"Answer the pc of the bytecode before the bytecode at thePC."
- 	| pc prevPc byte encoderClass |
- 	thePC > self endPC ifTrue: [^self endPC].
- 	pc := self initialPC.
- 	encoderClass := self encoderClass.
- 	[pc < thePC] whileTrue:
- 		[byte := self at: (prevPc := pc).
- 		 [pc := pc + (encoderClass bytecodeSize: byte).
- 		  encoderClass isExtension: byte] whileTrue:
- 			[byte := self at: pc]].
- 	^prevPc!

Item was removed:
- ----- Method: CompiledCode>>printOn: (in category 'printing') -----
- printOn: aStream 
- 	"Overrides method inherited from the byte arrayed collection."
- 	aStream nextPut: $(.
- 	self printReferenceOn: aStream.
- 	aStream space; nextPut: $".
- 	self printNameOn: aStream.
- 	aStream nextPut: $(;
- 		 print: self identityHash;
- 		 nextPut: $);
- 		 nextPut: $";
- 		 nextPut: $)!

Item was removed:
- ----- Method: CompiledCode>>printReferenceOn: (in category 'printing') -----
- printReferenceOn: aStream 
- 	"Print a string that can be used to access the currently installed method."
- 	aStream print: self methodClass;
- 		 nextPutAll: '>>';
- 		 nextPutAll: self selector storeString!

Item was removed:
- ----- Method: CompiledCode>>protocol (in category 'accessing') -----
- protocol
- 	^self methodClass ifNotNil:
- 		[:class|
- 		self selector ifNotNil:
- 			[:selector|
- 			class whichCategoryIncludesSelector: selector]]!

Item was removed:
- ----- Method: CompiledCode>>readDataFrom:size: (in category 'file in/out') -----
- readDataFrom: aDataStream size: varsOnDisk
- 	"Fill in my fields.  My header and number of literals are already installed.  Must read both objects for the literals and bytes for the bytecodes."
- 
- 	self error: 'Must use readMethod'.!

Item was removed:
- ----- Method: CompiledCode>>reference (in category 'printing') -----
- reference
- 	^ String streamContents: [ : stream | self printReferenceOn: stream ]!

Item was removed:
- ----- Method: CompiledCode>>referredInstVars (in category 'accessing') -----
- referredInstVars
- 	"Answer a Set of the inst var names the receiver accesses."
- 	| allInstVarNames instVarNames |
- 	allInstVarNames := self methodClass allInstVarNames.
- 	self isReturnField ifTrue:
- 		[^Set with: (allInstVarNames at: self returnField + 1)].
- 	instVarNames := Set new.
- 	self abstractBytecodeMessagesDo:
- 		[:msg|
- 		(#(#popIntoReceiverVariable:
- 		    #pushReceiverVariable:
- 		    #storeIntoReceiverVariable:) includes: msg selector) ifTrue:
- 			[instVarNames add: (allInstVarNames at: msg argument + 1)]].
- 	^instVarNames
- 
- 	"Dictionary newFromPairs: (Point selectors collect: [:s| { s. (Point >> s) referredInstVars}])"!

Item was removed:
- ----- Method: CompiledCode>>scanFor: (in category 'scanning') -----
- scanFor: byteOrClosure
- 	"Answer whether the receiver contains the argument as a bytecode, if it is a number,
- 	 or evaluates to true if a block.  If a block it can take from one to four bytes."
- 	| s end |
- 	^(s := InstructionStream on: self)
- 		scanFor: (byteOrClosure isBlock
- 					ifTrue: [byteOrClosure numArgs caseOf: {
- 							[1] -> [byteOrClosure].
- 							[2] -> [[:byte| byteOrClosure value: byte value: s secondByte]].
- 							[3] -> [end := self endPC - 2.
- 									[:byte|
- 									s pc <= end
- 									and: [byteOrClosure
- 											value: byte
- 											value: s secondByte
- 											value: s thirdByte]]].
- 							[4] -> [end := self endPC - 3.
- 									[:byte|
- 									s pc <= end
- 									and: [byteOrClosure
- 											value: byte
- 											value: s secondByte
- 											value: s thirdByte
- 											value: s fourthByte]]] }]
- 					ifFalse: [[:instr | instr = byteOrClosure]])
- "
- SystemNavigation default browseAllSelect: [:m | m scanFor: 134]
- "!

Item was removed:
- ----- Method: CompiledCode>>scanner (in category 'accessing') -----
- scanner
- 
- 	^ InstructionStream on: self!

Item was removed:
- ----- Method: CompiledCode>>selector (in category 'accessing') -----
- selector
- 	^self subclassResponsibility!

Item was removed:
- ----- Method: CompiledCode>>selectorsDo: (in category 'scanning') -----
- selectorsDo: workBlock
- 	"Evaluate aBlock with all the message selectors sent by me. Duplicate selectors are possible."
- 
- 	| encoderClass |
- 	self isQuick ifTrue: [^self].
- 	encoderClass := self encoderClass.
- 	self codeLiteralsDo:
- 		[:compiledCode | | scanner limit |
- 		limit := compiledCode size - 1.
- 		(scanner := InstructionStream on: compiledCode) scanFor:
- 			[:byte| | selector |
- 			(selector := scanner selectorToSendOrSelf) ~~ scanner ifTrue:
- 				[workBlock value: selector].
- 			((encoderClass isExtension: byte)
- 			 and: [scanner pc < limit]) ifTrue:
- 				[scanner pc: scanner pc + (encoderClass bytecodeSize: (compiledCode at: scanner pc + 2))].
- 			false "keep scanning"]]!

Item was removed:
- ----- Method: CompiledCode>>sendsSelector: (in category 'testing') -----
- sendsSelector: aSelector 
- 	"Answer if the receiver sends a message whose selector is aSelector."
- 
- 	self selectorsDo:
- 		[:selector | selector = aSelector ifTrue: [^true]].
- 	self flag: #todo. "The use of #= instead of #== is extremely dubious, and IMO erroneous. eem 2/18/2020"
- 	^false!

Item was removed:
- ----- Method: CompiledCode>>sendsToSuper (in category 'testing') -----
- sendsToSuper
- 	"Answer whether the receiver sends any message to super."
- 
- 	| scanner |
- 	self codeLiteralsDo: [:compiledCode | 
- 		scanner := InstructionStream on: compiledCode.
- 		(scanner scanFor: (self encoderClass superSendScanBlockUsing: scanner))
- 			ifTrue: [^ true]].
- 	^ false!

Item was removed:
- ----- Method: CompiledCode>>setHasNoCountersFlag (in category 'accessing') -----
- setHasNoCountersFlag
- 	"The Cog Sista VMs interpret bit 16 of the method header as suppressing the generation of performance counters."
- 	self objectAt: 1 put: (self header bitOr: 16r8000)!

Item was removed:
- ----- Method: CompiledCode>>setSignFlag (in category 'accessing') -----
- setSignFlag
- 	"Set the sign flag bit.  The sign flag bit may be
- 	 used by the VM to select an alternate bytecode set."
- 
- 	self signFlag ifFalse:
- 		[self objectAt: 1 put: self header + SmallInteger minVal]!

Item was removed:
- ----- Method: CompiledCode>>signFlag (in category 'accessing') -----
- signFlag
- 	"Answer the sign flag bit.  The sign flag bit may be
- 	 used by the VM to select an alternate bytecode set."
- 
- 	^self header < 0!

Item was removed:
- ----- Method: CompiledCode>>storeDataOn: (in category 'file in/out') -----
- storeDataOn: aDataStream
- 	"Store myself on a DataStream.  I am a mixture of objects and raw data bytes.  Only use this for blocks.  Normal methodDictionaries should not be put out using ReferenceStreams.  Their fileOut should be attached to the beginning of the file."
- 
- 	| byteLength lits |
- 	"No inst vars of the normal type"
- 	byteLength := self basicSize.
- 	aDataStream
- 		beginInstance: self class
- 		size: byteLength.
- 	lits := self numLiterals + 1.	"counting header"
- 	1 to: lits do:
- 		[:ii | aDataStream nextPut: (self objectAt: ii)].
- 	self initialPC to: byteLength do:
- 		[:ii | aDataStream byteStream nextPut: (self basicAt: ii)].
- 			"write bytes straight through to the file"!

Item was removed:
- ----- Method: CompiledCode>>storeOn: (in category 'printing') -----
- storeOn: aStream
- 	| noneYet |
- 	aStream nextPutAll: '(('.
- 	aStream nextPutAll: self class name.
- 	aStream nextPutAll: ' newMethod: '.
- 	aStream store: self size - self initialPC + 1.
- 	aStream nextPutAll: ' header: '.
- 	aStream store: self header.
- 	aStream nextPut: $).
- 	noneYet := self storeElementsFrom: self initialPC to: self endPC on: aStream.
- 	1 to: self numLiterals do:
- 		[:index |
- 		noneYet
- 			ifTrue: [noneYet := false]
- 			ifFalse: [aStream nextPut: $;].
- 		aStream nextPutAll: ' literalAt: '.
- 		aStream store: index.
- 		aStream nextPutAll: ' put: '.
- 		aStream store: (self literalAt: index)].
- 	noneYet ifFalse: [aStream nextPutAll: '; yourself'].
- 	aStream nextPut: $)!

Item was removed:
- ----- Method: CompiledCode>>symbolic (in category 'printing') -----
- symbolic
- 	"Answer a String that contains a list of all the byte codes in a method 
- 	with a short description of each."
- 
- 	| aStream |
- 	aStream := WriteStream on: (String new: 1000).
- 	self longPrintOn: aStream.
- 	^aStream contents!

Item was removed:
- ----- Method: CompiledCode>>symbolicLinesDo: (in category 'printing') -----
- symbolicLinesDo: aBlock
- 	"Evaluate aBlock with each of the lines in the symbolic output."
- 
- 	| aStream pc |
- 	aStream := (String new: 64) writeStream.
- 	self isQuick ifTrue:
- 		[self longPrintOn: aStream.
- 		 aBlock value: 0 value: aStream contents.
- 		 ^self].
- 
- 	self primitive ~= 0 ifTrue:
- 		[self printPrimitiveOn: aStream.
- 		 aBlock value: 1 value: aStream contents.
- 		 aStream resetContents].
- 
- 	pc := self initialPC.
- 	(InstructionPrinter on: self)
- 		indent: 0;
- 		printPC: false; "explorer provides pc anyway"
- 		printInstructionsOn: aStream
- 		do:	[:printer :scanner :stream| | line index |
- 			line := stream contents allButLast.
- 			(line includes: Character cr) ifTrue:
- 				[line := (line copyUpTo: Character cr), '...'' (continues)'].
- 			(index := line indexOf: $>) > 0 ifTrue:
- 				[[(line at: index + 1) isSeparator] whileTrue: [index := index + 1].
- 				 line := ((line copyFrom: 1 to: index) copyReplaceAll: (String with: Character tab) with: (String new: 8 withAll: Character space)),
- 						(line copyFrom: index + 1 to: line size)].
- 			aBlock value: pc value: line.
- 			pc := scanner pc.
- 			stream resetContents]!

Item was removed:
- ----- Method: CompiledCode>>trailer (in category 'accessing') -----
- trailer
- 	"Answer the receiver's trailer"
- 	^ CompiledMethodTrailer new method: self
- !

Item was removed:
- ----- Method: CompiledCode>>veryDeepCopyWith: (in category 'file in/out') -----
- veryDeepCopyWith: deepCopier
- 	"Return self.  I am always shared.  Do not record me.  Only use this for blocks.  Normally methodDictionaries should not be copied this way."!

Item was removed:
- ----- Method: CompiledCode>>voidCogVMState (in category 'cleaning') -----
- voidCogVMState
- 	"Tell the VM to remove all references to any machine code form of the method.
- 	 This primitive must be called whenever a method is in use and modified.  This is
- 	 more aggressive (and *much* more costly) than flushCache since it must search
- 	 through all context objects, making sure that none have a (hidden) machine code pc
- 	 in the receiver.  Since modifying a method will likely change the generated machine code,
- 	 modifying a method (rather than redefining it) requires this more aggressive flush."
- 
- 	<primitive: 215>
- 	^self flushCache!

Item was removed:
- CompiledCode variableByteSubclass: #CompiledMethod
- 	instanceVariableNames: ''
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'Kernel-Methods'!
- 
- !CompiledMethod commentStamp: 'eem 2/27/2018 12:48' prior: 0!
- CompiledMethod instances are methods suitable for interpretation by the virtual machine.  They are a specialization of CompiledCode.  They represent methods, and may also, depending on the bytecode set, include nested blocks.  Bytecode sets that support non-nested blocks use CompiledBlock instances to implement nested block methods, that are separate from their enclosing method.  Bytecode sets that do not support non-nested blocks require the literals and bytecodes for a block to occur within the literals and bytecodes of a single CompiledMethod.  For example, the inject:into: method in the EncoderForV3PlusClosures bytecode set is as follows
- 
- Collection>>#inject:into:
- 	header	((primitive: 0) (numArgs: 2) (numTemps: 3) (numLiterals: 3) (frameSize: 16) (bytecodeSet: V3PlusClosures))
- 	literal1	#value:value:
- 	literal2	#inject:into:
- 	literal3	#Collection=>Collection
- 	33	<8A 01> push: (Array new: 1)
- 	35	<6A> popIntoTemp: 2
- 	36	<10> pushTemp: 0
- 	37	<8E 00 02> popIntoTemp: 0 inVectorAt: 2
- 	40	<70> self
- 	41	<11> pushTemp: 1
- 	42	<12> pushTemp: 2
- 	43	<8F 21 00 0A> closureNumCopied: 2 numArgs: 1 bytes 47 to 56
- 	47	        <11> pushTemp: 1
- 	48	        <8C 00 02> pushTemp: 0 inVectorAt: 2
- 	51	        <10> pushTemp: 0
- 	52	        <F0> send: value:value:
- 	53	        <8D 00 02> storeIntoTemp: 0 inVectorAt: 2
- 	56	        <7D> blockReturn
- 	57	<CB> send: do:
- 	58	<87> pop
- 	59	<8C 00 02> pushTemp: 0 inVectorAt: 2
- 	62	<7C> returnTop
- 
- whereas using the encoderForSistaV1 bytecode set it is
- 
- Collection>>#inject:into:
- 	header	((primitive: 0) (numArgs: 2) (numTemps: 3) (numLiterals: 3) (frameSize: 16) (bytecodeSet: #SistaV1))
- 	literal1	([] in Collection>>#inject:into: "a CompiledBlock(3755867)")
- 	literal2	#inject:into:
- 	literal3	#Collection=>Collection
- 	33	<E7 01> push: (Array new: 1)
- 	35	<D2> popIntoTemp: 2
- 	36	<40> pushTemp: 0
- 	37	<FD 00 02> popIntoTemp: 0 inVectorAt: 2
- 	40	<4C> self
- 	41	<41> pushTemp: 1
- 	42	<42> pushTemp: 2
- 	43	<F9 00 02> closureNumCopied: 2 numArgs: 1
- 	46	<7B> send: do:
- 	47	<D8> pop
- 	48	<FB 00 02> pushTemp: 0 inVectorAt: 2
- 	51	<5C> returnTop
- 
- [] in Collection>>#inject:into: "a CompiledBlock(3755867)"
- 	header	((block #full) (numArgs: 1) (numTemps: 3) (numLiterals: 3) (frameSize: 16) (bytecodeSet: #SistaV1))
- 	literal1	#value:value:
- 	literal2	nil
- 	literal3	(Collection>>#inject:into: "a CompiledMethod(736427)")
- 	33	<41> pushTemp: 1
- 	34	<FB 00 02> pushTemp: 0 inVectorAt: 2
- 	37	<40> pushTemp: 0
- 	38	<A0> send: value:value:
- 	39	<FC 00 02> storeIntoTemp: 0 inVectorAt: 2
- 	42	<5E> blockReturn
- 
- The last literal in a CompiledMethod must be its methodClassAssociation, a binding whose value is the class the method is installed in.  The methodClassAssociation is used to implement super sends.  If a method contains no super send then its methodClassAssociation may be nil (as would be the case for example of methods providing a pool of inst var accessors).  
- 
- By convention the penultimate literal of a method is either its selector or an instance of AdditionalMethodState.  AdditionalMethodState holds the method's selector and any pragmas and properties of the method.  AdditionalMethodState may also be used to add instance variables to a method, albeit ones held in the method's AdditionalMethodState.  Subclasses of CompiledMethod that want to add state should subclass AdditionalMethodState to add the state they want, and implement methodPropertiesClass on the class side of the CompiledMethod subclass to answer the specialized subclass of AdditionalMethodState.  Enterprising programmers are encouraged to try and implement this support automatically through suitable modifications to the compiler and class builder.!

Item was removed:
- ----- Method: CompiledMethod class>>abstractMarkers (in category 'constants') -----
- abstractMarkers
- 	^ #(subclassResponsibility shouldNotImplement)!

Item was removed:
- ----- Method: CompiledMethod class>>addCompiledCodeAndCompiledBlock (in category 'full block bootstrap') -----
- addCompiledCodeAndCompiledBlock
- 	| cmHash cmInstCount cc |
- 	"Ensure that
- 		- CompiledMethod is a subclass of CompiledCode
- 		- CompiledMethod has a sibling called CompiledBlock,
- 		- CompiledMethod's class vars are moved to CompiledCode
- 		- CompiledMethod preserves its identityHash and instances"
- 	self compiledCodeAndCompiledBlockArePresent ifTrue:
- 		[^self].
- 	cmHash := CompiledMethod identityHash.
- 	cmInstCount := CompiledMethod instanceCount.
- 	cc := CompiledMethod variableByteSubclass: #CompiledCode
- 			instanceVariableNames: ''
- 			classVariableNames: ''
- 			poolDictionaries: ''
- 			category: 'Kernel-Methods'.
- 	self assert: cc == (ByteArray variableByteSubclass: #CompiledCode
- 		instanceVariableNames: ''
- 		classVariableNames: ''
- 		poolDictionaries: ''
- 		category: 'Kernel-Methods').
- 	self assert: cc typeOfClass == #compiledMethod.
- 	cc ensureClassPool.
- 	CompiledMethod classPool keys do:
- 		[:classVar|
- 		cc classPool declare: classVar from: CompiledMethod classPool].
- 	self assert: CompiledMethod classPool isEmpty.
- 	CompiledMethod superclass: cc.
- 	CompiledMethod class superclass: cc class.
- 	cc addSubclass: CompiledMethod.
- 	self assert: cmHash = CompiledMethod identityHash.
- 	self assert: cmInstCount = CompiledMethod instanceCount.
- 	self assert: (CompiledMethod inheritsFrom: cc).
- 	self assert: (CompiledMethod class inheritsFrom: cc class).
- 	cc variableByteSubclass: #CompiledBlock
- 		instanceVariableNames: ''
- 		classVariableNames: ''
- 		poolDictionaries: ''
- 		category: 'Kernel-Methods'.
- 	self assert: self compiledCodeAndCompiledBlockArePresent!

Item was removed:
- ----- Method: CompiledMethod class>>compiledCodeAndCompiledBlockArePresent (in category 'full block bootstrap') -----
- compiledCodeAndCompiledBlockArePresent
- 	^((Smalltalk classNamed: #CompiledCode) notNil
- 	   and: [((Smalltalk classNamed: #CompiledCode) subclasses collect: [:ea| ea name])
- 						= #(CompiledMethod CompiledBlock)])!

Item was removed:
- ----- Method: CompiledMethod class>>disabledMarker (in category 'constants') -----
- disabledMarker
- 	^ #shouldNotImplement!

Item was removed:
- ----- Method: CompiledMethod class>>methodPropertiesClass (in category 'accessing class hierarchy') -----
- methodPropertiesClass
- 	"Answer the class to use to create a method's properties, which can be a poor man's way
- 	 to add instance variables to subclassses of CompiledMethod.  Subclasses of CompiledMethod
- 	 should define a corresponding subclass of AdditionalMethodState that adds any instance variables
- 	 required, and override this method to answer that class."
- 	^AdditionalMethodState!

Item was removed:
- ----- Method: CompiledMethod class>>primitive:numArgs:numTemps:stackSize:literals:bytecodes:trailer: (in category 'instance creation') -----
- primitive: primNum numArgs: numArgs numTemps: numTemps stackSize: stackSize literals: literals bytecodes: bytecodes trailer: trailerBytes
- 	"Create method with given attributes.  numTemps includes numArgs.  stackSize does not include numTemps."
- 
- 	| compiledMethod |
- 	compiledMethod := self
- 		newBytes: bytecodes size
- 		trailerBytes: trailerBytes 
- 		nArgs: numArgs
- 		nTemps: numTemps
- 		nStack: stackSize
- 		nLits: literals size
- 		primitive: primNum.
- 	(WriteStream with: compiledMethod)
- 		position: compiledMethod initialPC - 1;
- 		nextPutAll: bytecodes.
- 	literals withIndexDo: [:obj :i | compiledMethod literalAt: i put: obj].
- 	^ compiledMethod!

Item was removed:
- ----- Method: CompiledMethod class>>receiver:withArguments:executeMethod: (in category 'evaluating') -----
- receiver: receiver withArguments: argArray executeMethod: compiledMethod
- 	"Execute compiledMethod against the receiver and the arguments in argArray"
- 
- 	<primitive: 188 error: ec>
- 	self primitiveFailed!

Item was removed:
- ----- Method: CompiledMethod class>>subclassResponsibilityMarker (in category 'constants') -----
- subclassResponsibilityMarker
- 	^ #subclassResponsibility!

Item was removed:
- ----- Method: CompiledMethod class>>toReturnConstant:trailerBytes: (in category 'instance creation') -----
- toReturnConstant: index trailerBytes: trailer
- 	"Answer an instance of me that is a quick return of the constant
- 	indexed in (true false nil -1 0 1 2)."
- 
- 	^self newBytes: 3 trailerBytes: trailer nArgs: 0 nTemps: 0 nStack: 0 nLits: 2 primitive: 256 + index!

Item was removed:
- ----- Method: CompiledMethod class>>toReturnField:trailerBytes: (in category 'instance creation') -----
- toReturnField: field trailerBytes: trailer
- 	"Answer an instance of me that is a quick return of the instance variable 
- 	indexed by the argument, field."
- 
- 	^self newBytes: 3 trailerBytes: trailer nArgs: 0 nTemps: 0 nStack: 0 nLits: 2 primitive: 264 + field!

Item was removed:
- ----- Method: CompiledMethod class>>toReturnSelf (in category 'instance creation') -----
- toReturnSelf
- 	"Answer an instance of me that is a quick return of the instance (^self)."
- 
- 	^ self toReturnSelfTrailerBytes: CompiledMethodTrailer empty!

Item was removed:
- ----- Method: CompiledMethod class>>toReturnSelfTrailerBytes: (in category 'instance creation') -----
- toReturnSelfTrailerBytes: trailer
- 	"Answer an instance of me that is a quick return of the instance (^self)."
- 
- 	^self newBytes: 3 trailerBytes: trailer nArgs: 0 nTemps: 0 nStack: 0 nLits: 2 primitive: 256!

Item was removed:
- ----- Method: CompiledMethod>>abstractSymbolic (in category 'printing') -----
- abstractSymbolic
- 	"Answer a String that contains a list of all the byte codes in a method with a
- 	 short description of each, using relative addresses and not including code bytes."
- 
- 	| aStream |
- 	aStream := WriteStream on: (String new: 1000).
- 	self longPrintRelativeOn: aStream indent: 0.
- 	^aStream contents!

Item was removed:
- ----- Method: CompiledMethod>>allLiteralsDo: (in category 'literals') -----
- allLiteralsDo: aBlock
- 	"Overwritten to skip certain (raw) literals."
- 		
- 	" Exclude method selector (or properties) and the method's class."
- 	1 to: self numLiterals - 2 do: [:index |
- 		(self literalAt: index) allLiteralsDo: aBlock].
- 
- 	"Enumerate the implicit literals in bytecodes of the receiver."
- 	self implicitLiteralsDo: aBlock.
- 
- 	"Enumerate method selector only through additional method state."
- 	self penultimateLiteral isMethodProperties
- 		ifTrue: [self penultimateLiteral allLiteralsDo: aBlock]!

Item was removed:
- ----- Method: CompiledMethod>>anyAndAllMessages (in category 'literals') -----
- anyAndAllMessages
- 	"Answer a Set of all the message selectors sent by this method, and all literals that look like message selectors."
- 
- 	| result |
- 	result := Set new.
- 	self anyAndAllSelectorsDo: [:selector | result add: selector].
- 	^result!

Item was removed:
- ----- Method: CompiledMethod>>anyAndAllSelectorsDo: (in category 'literals') -----
- anyAndAllSelectorsDo: workBlock
- 	"Evaluate aBlock with all the message selectors sent by me, including
- 	 my literals that look like selectors, and selectors in my pragmas.
- 	 Duplicate selectors are possible."
- 
- 	| encoderClass selectorLiteralCollector |
- 	encoderClass := self encoderClass.
- 	selectorLiteralCollector := [:literal|
- 								literal isCollection ifTrue:
- 									[literal isSymbol
- 										ifTrue:
- 											[literal isMessageSelector ifTrue:
- 												[workBlock value: literal]]
- 										ifFalse:
- 											[literal isArray ifTrue:
- 												[literal do: selectorLiteralCollector]]]].
- 	self pragmas do:
- 		[:pragma|
- 		selectorLiteralCollector
- 			value: pragma keyword;
- 			value: pragma arguments].
- 	self isQuick ifTrue: [^self].
- 	self codeLiteralsDo:
- 		[:compiledCode | | scanner limit |
- 		limit := compiledCode size - 1.
- 		(scanner := InstructionStream on: compiledCode) scanFor:
- 			[:byte| | selector |
- 			(selector := scanner selectorToSendOrSelf) ~~ scanner ifTrue:
- 				[workBlock value: selector].
- 			((encoderClass isExtension: byte)
- 			 and: [scanner pc < limit]) ifTrue:
- 				[scanner pc: scanner pc + (encoderClass bytecodeSize: (compiledCode at: scanner pc + 2))].
- 			false "keep scanning"].
- 		compiledCode literalsDo: selectorLiteralCollector]!

Item was removed:
- ----- Method: CompiledMethod>>checkOKToAdd:at: (in category 'source code management') -----
- checkOKToAdd: size at: filePosition
- 	"Issue several warnings if the end of the changes file is approaching
- 	a fixed size limit, and finally halt with an error if the limit is reached."
- 
- 	^ SourceFiles checkOKToAdd: size at: filePosition
- !

Item was removed:
- ----- Method: CompiledMethod>>compilerClass (in category 'decompiling') -----
- compilerClass
- 	^self methodClass 
- 		ifNil: [Compiler] 
- 		ifNotNil: [:class | class compilerClass].!

Item was removed:
- ----- Method: CompiledMethod>>containsBlockClosures (in category 'closures') -----
- containsBlockClosures
- 	^self scanner scanFor: self encoderClass createClosureScanBlock!

Item was removed:
- ----- Method: CompiledMethod>>copyWithSourceCode: (in category 'source code management') -----
- copyWithSourceCode: sourceCode
- 	"Create a copy of the receiver whose source is embedded in the method.  Used for breakpoints."
- 	^self copyWithTrailerBytes: (CompiledMethodTrailer new sourceCode: sourceCode)!

Item was removed:
- ----- Method: CompiledMethod>>copyWithTempNames: (in category 'source code management') -----
- copyWithTempNames: tempNames
- 	"Minimal temp name copy that only works for methods containing no temporaries or blocks with arguments.
- 	Used by the Traits system for creating conflict and required methdos that generate warnings.
- 	For generic use use copyWithTempsFromMethodNode:"
- 	| tempString |
- 	tempString := String streamContents:
- 					[:str|
- 					tempNames
- 						do: [:temp| str nextPutAll: temp]
- 						separatedBy: [str space].
- 					str space].
- 	^self copyWithTrailerBytes: (CompiledMethodTrailer new tempNames: tempString)				
- !

Item was removed:
- ----- Method: CompiledMethod>>copyWithTempsFromMethodNode: (in category 'source code management') -----
- copyWithTempsFromMethodNode: aMethodNode
- 	^self copyWithTrailerBytes: (
- 		CompiledMethodTrailer new tempNames: aMethodNode schematicTempNamesString)!

Item was removed:
- ----- Method: CompiledMethod>>copyWithTrailerBytes: (in category 'copying') -----
- copyWithTrailerBytes: trailer
- 	"Testing:
- 		CompiledMethod >> #copyWithTrailerBytes:
- 			copyWithTempsFromMethodNode: (CompiledMethod >> #copyWithTrailerBytes:) methodNode"
- 	| copy end start |
- 	start := self initialPC.
- 	end := self endPC.
- 	copy := trailer createMethod: end - start + 1 class: self class header: self header.
- 	1 to: self numLiterals do:
- 		[:i | | lit |
- 		lit := self literalAt: i.
- 		copy literalAt: i put: ((lit isCompiledCode and: [lit isCompiledBlock])
- 								ifTrue: [lit copyWithOuterCode: copy]
- 								ifFalse: [lit])].
- 	start to: end do: [:i | copy at: i put: (self at: i)].
- 	copy postCopy.
- 	^copy!

Item was removed:
- ----- Method: CompiledMethod>>dateMethodLastSubmitted (in category 'printing') -----
- dateMethodLastSubmitted
- 	"Answer a Date object indicating when a method was last submitted.  If there is no date stamp, return nil"
- 	"(CompiledMethod compiledMethodAt: #dateMethodLastSubmitted) dateMethodLastSubmitted"
- 
- 	| aStamp tokens |
- 	aStamp := self timeStamp.
- 	tokens := aStamp findBetweenSubStrs: ' 
- '.  "space is expected delimiter, but cr is sometimes seen, though of mysterious provenance"
- 	^ tokens size > 1
- 		ifTrue:
- 			[[tokens second asDate] ifError: [nil]]
- 		ifFalse:
- 			[nil]!

Item was removed:
- ----- Method: CompiledMethod>>decompileString (in category 'printing') -----
- decompileString
- 	^self decompile decompileString!

Item was removed:
- ----- Method: CompiledMethod>>decompileWithTemps (in category 'decompiling') -----
- decompileWithTemps
- 	"Return the decompiled parse tree that represents self, but with the temp names obtained
- 	 either by compiling the sourcecode, or directly if the method has temps in its trailer."
- 
- 	| class selector tempNames source |
- 	class := self methodClass ifNil: [Object].
- 	selector := self selector ifNil: [self defaultSelector].
- 
- 	self holdsTempNames
- 		ifTrue: [tempNames := self tempNamesString]
- 		ifFalse:
- 			[| compiler |
- 			 "No source file or no source (e.g. doits) and no temp names
- 			 -- decompile without temp names "
- 			((self fileIndex > 0 and: [(SourceFiles at: self fileIndex) isNil])
- 			or: [(source := self getSourceFromFile) isNil]) ifTrue:
- 				[^self decompile].
- 			compiler := class newCompiler.
- 			compiler parser encoderClass: self encoderClass.
- 			tempNames := [(compiler
- 								parse: source asString
- 								in: class
- 								notifying: nil)
- 									generate: CompiledMethodTrailer empty;
- 									schematicTempNamesString] on: SyntaxErrorNotification do: [:ex | nil].
- 			tempNames ifNil: ["broken source, give up tempNames" ^self decompile]].
- 
- 	^(self decompilerClass new withTempNames: tempNames)
- 		decompile: selector
- 		in: class
- 		method: self methodForDecompile!

Item was removed:
- ----- Method: CompiledMethod>>decompilerClass (in category 'decompiling') -----
- decompilerClass
- 	^self compilerClass decompilerClass!

Item was removed:
- ----- Method: CompiledMethod>>defaultSelector (in category 'accessing') -----
- defaultSelector 
- 	"Invent and answer an appropriate message selector (a Symbol) for me, 
- 	that is, one that will parse with the correct number of arguments."
- 
- 	^#DoIt numArgs: self numArgs!

Item was removed:
- ----- Method: CompiledMethod>>dragLabel (in category 'accessing') -----
- dragLabel
- 	"The label we use for dragging compiled methods"
- 	^self methodClass name, '>>', self selector!

Item was removed:
- ----- Method: CompiledMethod>>embeddedBlockClosures (in category 'closures') -----
- embeddedBlockClosures
- 	| bms extractor scanner endPC encoderClass |
- 	bms := OrderedCollection new.
- 	scanner := self scanner.
- 	extractor := ClosureExtractor withAction: [:c| bms add: c] andScanner: scanner.
- 	endPC := self endPC.
- 	encoderClass := self encoderClass.
- 	[scanner pc <= endPC] whileTrue:
- 		[encoderClass interpretNextInstructionFor: extractor in: scanner].
- 	^bms!

Item was removed:
- ----- Method: CompiledMethod>>equivalentTo: (in category 'comparing') -----
- equivalentTo: aCompiledMethod
- 	| parseTree |
- 	^self = aCompiledMethod
- 	or: [self class == aCompiledMethod class
- 		and: [self numArgs = aCompiledMethod numArgs
- 		and: [self numLiterals = aCompiledMethod numLiterals
- 		and: [parseTree := self decompile.
- 			(parseTree isKindOf: MethodNode)
- 				ifTrue: [parseTree asString = aCompiledMethod decompile asString "Standard compiler"]
- 				ifFalse: [parseTree = aCompiledMethod decompile "RB parse trees, we hope"]]]]]!

Item was removed:
- ----- Method: CompiledMethod>>fileIndex (in category 'source code management') -----
- fileIndex
- 	^SourceFiles fileIndexFromSourcePointer: self sourcePointer!

Item was removed:
- ----- Method: CompiledMethod>>filePosition (in category 'source code management') -----
- filePosition
- 	^SourceFiles filePositionFromSourcePointer: self sourcePointer!

Item was removed:
- ----- Method: CompiledMethod>>getPreambleFrom:at: (in category 'source code management') -----
- getPreambleFrom: aFileStream at: endPosition
- 	| chunk |
- 	aFileStream position: endPosition + 2.
- 	[(chunk := aFileStream backChunk) beginsWith: ']lang['] whileTrue.
- 	^ chunk!

Item was removed:
- ----- Method: CompiledMethod>>getSourceFor:in: (in category 'source code management') -----
- getSourceFor: selector in: class
- 	"Retrieve or reconstruct the source code for this method."
- 	| trailer source |
- 	(self properties includesKey: #source) ifTrue:
- 		[^self properties at: #source].
- 	trailer := self trailer.
- 
- 	trailer tempNames ifNotNil: [:namesString | 
- 		"Magic sources -- decompile with temp names"
- 		^ ((class decompilerClass new withTempNames: namesString)
- 				decompile: selector in: class method: self methodForDecompile)
- 			decompileString].
- 	
- 	trailer sourceCode ifNotNil: [:code | ^ code ].
- 	
- 	trailer hasSourcePointer ifFalse: [
- 		"No source pointer -- decompile without temp names"
- 		^ (class decompilerClass new decompile: selector in: class method: self methodForDecompile)
- 			decompileString].
- 
- 	"Situation normal;  read the sourceCode from the file"
- 	source := [self getSourceFromFileAt: trailer sourcePointer]
- 				on: Error
- 		"An error can happen here if, for example, the changes file has been truncated by an aborted download.  The present solution is to ignore the error and fall back on the decompiler.  A more thorough solution should probably trigger a systematic invalidation of all source pointers past the end of the changes file.  Consider that, as time goes on, the changes file will eventually grow large enough to cover the lost code, and then instead of falling into this error case, random source code will get returned."
- 				do: [ :ex | ex return: nil].
- 		
- 	^source ifNil: [
- 			"Something really wrong -- decompile blind (no temps)"
- 			 (class decompilerClass new decompile: selector in: class method: self methodForDecompile)
- 				decompileString]!

Item was removed:
- ----- Method: CompiledMethod>>getSourceFromFile (in category 'source code management') -----
- getSourceFromFile
- 	
- 	^self getSourceFromFileAt: self sourcePointer!

Item was removed:
- ----- Method: CompiledMethod>>getSourceFromFileAt: (in category 'source code management') -----
- getSourceFromFileAt: sourcePointer
- 	
- 	| position index |
- 	position := SourceFiles filePositionFromSourcePointer: sourcePointer.
- 	position = 0 ifTrue: [ ^nil ].
- 	index := SourceFiles fileIndexFromSourcePointer: sourcePointer.
- 	^(RemoteString newFileNumber: index position: position)
- 		text!

Item was removed:
- ----- Method: CompiledMethod>>hasInstVarRef (in category 'scanning') -----
- hasInstVarRef
- 	"Answer whether the method references an instance variable."
- 
- 	| scanner end printer |
- 
- 	scanner := InstructionStream on: self.
- 	printer := InstVarRefLocator new.
- 	end := self endPC.
- 
- 	[scanner pc <= end] whileTrue: [
- 		(printer interpretNextInstructionUsing: scanner) ifTrue: [^true].
- 	].
- 	^false!

Item was removed:
- ----- Method: CompiledMethod>>hasPragma: (in category 'accessing-pragmas & properties') -----
- hasPragma: aSymbol
- 
- 	^ (self pragmaAt: aSymbol) notNil!

Item was removed:
- ----- Method: CompiledMethod>>hasReportableSlip (in category 'testing') -----
- hasReportableSlip
- 	"Answer whether the receiver contains anything that should be brought 
- 	to the attention of the author when filing out. Customize the lists here 
- 	to suit your preferences. If slips do not get reported in spite of your 
- 	best efforts here, make certain that the Preference 'checkForSlips' is set 
- 	to true."
- 	#(#doOnlyOnce: #halt #halt: #hottest #printDirectlyToDisplay #toRemove #personal #urgent  #haltOnce #haltOnce: #haltIf: )
- 		do: [:aLit | (self hasLiteral: aLit)
- 				ifTrue: [^ true]].
- 	#(#Transcript #AA #BB #CC #DD #EE )
- 		do: [:aSymbol |
- 			| assoc |
- 			(assoc := Smalltalk globals
- 						associationAt: aSymbol
- 						ifAbsent: [])
- 				ifNotNil: [(self hasLiteral: assoc)
- 						ifTrue: [^ true]]].
- 	^ false!

Item was removed:
- ----- Method: CompiledMethod>>hasSameLiteralsAs: (in category 'comparing') -----
- hasSameLiteralsAs: aMethod
- 	"Answer whether the receiver has the same sequence of literals as the argument.
- 	 Compare the last literal, which is the class association, specially so as not to
- 	 differentiate between otherwise identical methods installed in different classes.
- 	 Compare the first literal carefully if it is the binding informaiton for an FFI or
- 	 external primitive call.  Don't compare all of the state so that linked and unlinked
- 	 methods are still considered equal."
- 	| numLits |
- 	numLits := self numLiterals.
- 	numLits = aMethod numLiterals ifFalse: [^false].
- 	1 to: numLits do:
- 		[:i| | lit1 lit2 |
- 		lit1 := self literalAt: i.
- 		lit2 := aMethod literalAt: i.
- 		(lit1 == lit2 or: [lit1 literalEqual: lit2]) ifFalse:
- 			[(i = 1 and: [#(117 120) includes: self primitive])
- 				ifTrue:
- 					[lit1 isArray
- 						ifTrue:
- 							[(lit2 isArray and: [(lit1 first: 2) = (lit2 first: 2)]) ifFalse:
- 								[^false]]
- 						ifFalse: "ExternalLibraryFunction"
- 							[(lit1 analogousCodeTo: lit2) ifFalse:
- 								[^false]]]
- 				ifFalse:
- 					[i = (numLits - 1)
- 						ifTrue: "properties"
- 							[(self properties analogousCodeTo: aMethod properties)
- 								ifFalse: [^false]]
- 						ifFalse: "last literal (methodClassAssociation) of class-side methods is not unique"
- 								"last literal of CompiledBlock is outerMethod and may not be unique."
- 							[(self isCompiledBlock
- 							  and: [lit1 isCompiledCode
- 							  and: [lit2 isCompiledCode]]) ifTrue:
- 								[^true].
- 							(i = numLits
- 							 and: [lit1 isVariableBinding and: [lit1 value isBehavior
- 							 and: [lit2 isVariableBinding and: [lit2 value isBehavior]]]]) ifFalse:
- 								[^false]]]]].
- 	^true!

Item was removed:
- ----- Method: CompiledMethod>>headerDescription (in category 'printing') -----
- headerDescription
- 	"Answer a description containing the information about the form of the
- 	 receiver and the form of the context needed to run the receiver."
- 
- 	^(ByteString new: 128) writeStream
- 		print: self header; cr;
- 		nextPutAll: '"primitive: '; print: self primitive; cr;
- 		nextPutAll: ' numArgs: '; print: self numArgs; cr;
- 		nextPutAll: ' numTemps: '; print: self numTemps; cr;
- 		nextPutAll: ' numLiterals: '; print: self numLiterals; cr;
- 		nextPutAll: ' frameSize: '; print: self frameSize; cr;
- 		nextPutAll: ' bytecodeSet: '; nextPutAll: self bytecodeSetName;
- 		nextPut: $"; cr;
- 		contents!

Item was removed:
- ----- Method: CompiledMethod>>holdsTempNames (in category 'source code management') -----
- holdsTempNames
- 	"Are tempNames stored in trailer bytes"
- 
- 	^ self trailer hasTempNames!

Item was removed:
- ----- Method: CompiledMethod>>homeMethod (in category 'accessing') -----
- homeMethod
- 	"Answer the home method associated with the receiver.
- 	 This is polymorphic with closure, CompiledBlock, Context etc"
- 
- 	^self!

Item was removed:
- ----- Method: CompiledMethod>>isAbstract (in category 'testing') -----
- isAbstract
- 	| marker |
- 	marker := self markerOrNil.
- 	^ marker notNil and: [self class abstractMarkers includes: marker].!

Item was removed:
- ----- Method: CompiledMethod>>isBlueBookCompiled (in category 'testing') -----
- isBlueBookCompiled
- 	"Answer whether the receiver was compiled using the old Smalltalk-80 blocks
- 	 compiler.  This is used to help DebuggerMethodMap choose which mechanisms
- 	 to use to inspect (debug) activations of the receiver."
- 
- 	^self encoderClass supportsClosures not!

Item was removed:
- ----- Method: CompiledMethod>>isClosureCompiled (in category 'testing') -----
- isClosureCompiled
- 	"Answer whether the receiver was compiled using the closure compiler.
- 	 This is used to help DebuggerMethodMap choose which mechanisms to
- 	 use to inspect (debug) activations of the receiver."
- 
- 	^self encoderClass supportsClosures!

Item was removed:
- ----- Method: CompiledMethod>>isCompiledMethod (in category 'testing') -----
- isCompiledMethod
- 
- 	^ true!

Item was removed:
- ----- Method: CompiledMethod>>isDeprecated (in category 'testing') -----
- isDeprecated
- 	"Note that #literalsDo: is faster than #hasLiteral: (and #hasLiteral:scanForSpecial:). We already know that 'self deprecated' should be the first statement in a deprecated method, which is directly accessible in this method's literals. No need to check compiled blocks or other nested structures. We expand the implementation of #literalsDo: here to gain twice the speed.
- 	
- 	Note that both #isQuick and is-this-method check make no sense performance-wise. Maybe bench again in the future."
- 	
- 	| literal |
- 	1 to: self numLiterals do: [:index |
- 		((literal := self literalAt: index) == #deprecated: or: [ literal == #deprecated ])
- 			ifTrue: [ ^true ] ].
- 	^ false!

Item was removed:
- ----- Method: CompiledMethod>>isDisabled (in category 'testing') -----
- isDisabled
- 	^ self isDisabled: self markerOrNil!

Item was removed:
- ----- Method: CompiledMethod>>isDisabled: (in category 'testing') -----
- isDisabled: marker
- 	^ marker == self class disabledMarker!

Item was removed:
- ----- Method: CompiledMethod>>isImplicitlyRequired (in category 'testing') -----
- isImplicitlyRequired
- 	^ self isImplicitlyRequired: self markerOrNil!

Item was removed:
- ----- Method: CompiledMethod>>isInstalled (in category 'testing') -----
- isInstalled
- 	self methodClass ifNotNil:
- 		[:class|
- 		self selector ifNotNil:
- 			[:selector|
- 			^self == (class methodDict at: selector ifAbsent: [])]].
- 	^false!

Item was removed:
- ----- Method: CompiledMethod>>isLinkedNamedPrimitive (in category 'testing') -----
- isLinkedNamedPrimitive
- 	"Answer if the receiver invokes a named primitive, and the method is linked to an actual primitive.
- 	 For example if the method hasn't yet been used in the current session, it won't be linked"
- 	^self isNamedPrimitive and: [(self literalAt: 1) fourth ~= 0]
- 	
- 	"self systemNavigation browseAllSelect: [:m| m isLinkedNamedPrimitive]"!

Item was removed:
- ----- Method: CompiledMethod>>isNamedPrimitive (in category 'testing') -----
- isNamedPrimitive
- 	"Answer if the receiver invokes a named primitive."
- 	^self primitive = 117
- 	
- 	"self systemNavigation browseAllSelect: [:m| m isNamedPrimitive]"!

Item was removed:
- ----- Method: CompiledMethod>>isQuick (in category 'testing') -----
- isQuick
- 	"Answer whether the receiver is a quick return (of self or of an instance 
- 	variable)."
- 	^ self primitive between: 256 and: 519!

Item was removed:
- ----- Method: CompiledMethod>>isReturnField (in category 'testing') -----
- isReturnField
- 	"Answer whether the receiver is a quick return of an instance variable."
- 	^ self primitive between: 264 and: 519!

Item was removed:
- ----- Method: CompiledMethod>>isReturnSelf (in category 'testing') -----
- isReturnSelf
- 	"Answer whether the receiver is a quick return of self."
- 
- 	^ self primitive = 256!

Item was removed:
- ----- Method: CompiledMethod>>isReturnSpecial (in category 'testing') -----
- isReturnSpecial
- 	"Answer whether the receiver is a quick return of self or constant."
- 
- 	^ self primitive between: 256 and: 263!

Item was removed:
- ----- Method: CompiledMethod>>isSubclassResponsibility (in category 'testing') -----
- isSubclassResponsibility
- 	^ self isSubclassResponsibility: self markerOrNil!

Item was removed:
- ----- Method: CompiledMethod>>isSubclassResponsibility: (in category 'testing') -----
- isSubclassResponsibility: marker
- 	^ marker == self class subclassResponsibilityMarker!

Item was removed:
- ----- Method: CompiledMethod>>linesOfCode (in category 'source code management') -----
- linesOfCode
- 	"An approximate measure of lines of code.
- 	Includes comments, but excludes empty lines."
- 	| lines |
- 	lines := 0.
- 	self getSource asString lineIndicesDo: [:start :endWithoutDelimiters :end |
- 		endWithoutDelimiters > start ifTrue: [lines := lines+1]].
- 	^lines!

Item was removed:
- ----- Method: CompiledMethod>>literalStrings (in category 'literals') -----
- literalStrings
- 	| litStrs |
- 	litStrs := OrderedCollection new: self numLiterals.
- 	self literalsDo:
- 		[:lit | 
- 		(lit isVariableBinding)
- 			ifTrue: [litStrs addLast: lit key]
- 			ifFalse: [(lit isSymbol)
- 				ifTrue: [litStrs addAll: lit keywords]
- 				ifFalse: [litStrs addLast: lit printString]]].
- 	^ litStrs!

Item was removed:
- ----- Method: CompiledMethod>>longPrintOn:indent: (in category 'printing') -----
- longPrintOn: aStream indent: tabs
- 	"List of all the byte codes in a method with a short description of each" 
- 
- 	self isQuick ifTrue: 
- 		[self isReturnSpecial ifTrue:
- 			[^ aStream tab: tabs; nextPutAll: 'Quick return ' , 
- 				(#('self' 'true' 'false' 'nil' '-1' '0' '1' '2') at: self primitive - 255)].
- 		^ aStream nextPutAll: 'Quick return field ' , self returnField printString , ' (0-based)'].
- 
- 	self primitive = 0 ifFalse: [
- 		aStream tab: tabs.
- 		self printPrimitiveOn: aStream.
- 	].
- 	(InstructionPrinter on: self) indent: tabs; printInstructionsOn: aStream.
- !

Item was removed:
- ----- Method: CompiledMethod>>longPrintRelativeOn:indent: (in category 'printing') -----
- longPrintRelativeOn: aStream indent: tabs
- 	"List of all the byte codes in a method with a short description of each" 
- 
- 	self isQuick ifTrue: 
- 		[^self longPrintOn: aStream indent: tabs].
- 	self primitive = 0 ifFalse:
- 		[aStream tab: tabs. self printPrimitiveOn: aStream].
- 	(RelativeInstructionPrinter on: self)
- 		indent: tabs;
- 		printCode: false;
- 		printInstructionsOn: aStream.
- !

Item was removed:
- ----- Method: CompiledMethod>>markerOrNil (in category 'private') -----
- markerOrNil
- 	"If I am a marker method, answer the symbol used to mark me.  Otherwise
- 	 answer nil. What is a marker method?  It is method with body like 
- 		'self subclassResponsibility' or '^ self subclassResponsibility' 
- 	used to indicate ('mark') a special property."
- 
- 	^self encoderClass markerOrNilFor: self!

Item was removed:
- ----- Method: CompiledMethod>>method (in category 'accessing') -----
- method
- 	"Answer the home method associated with the receiver.
- 	 This is polymorphic with closure, CompiledBlock, Context etc"
- 
- 	^self!

Item was removed:
- ----- Method: CompiledMethod>>methodClass (in category 'accessing') -----
- methodClass
- 	"answer the class that I am installed in"
- 	^(self literalAt: self numLiterals) value.!

Item was removed:
- ----- Method: CompiledMethod>>methodClass: (in category 'accessing') -----
- methodClass: aClass
- 	"set the class binding in the last literal to aClass"
- 	self literalAt: self numLiterals put: aClass binding!

Item was removed:
- ----- Method: CompiledMethod>>methodClassAssociation (in category 'accessing') -----
- methodClassAssociation
- 	"answer the association to the class that I am installed in, or nil if none."
- 	^self literalAt: self numLiterals!

Item was removed:
- ----- Method: CompiledMethod>>methodClassAssociation: (in category 'accessing') -----
- methodClassAssociation: aBinding
- 	"sets the association to the class that I am installed in"
- 	^self literalAt: self numLiterals put: aBinding!

Item was removed:
- ----- Method: CompiledMethod>>methodForDecompile (in category 'decompiling') -----
- methodForDecompile
- 	"This is a hook to allow recursive methods like MwMethodWrapper to avoid infinite recursion."
- 	^self!

Item was removed:
- ----- Method: CompiledMethod>>methodHome (in category 'accessing') -----
- methodHome
- 	"The behavior (trait/class) this method was originally defined in. 
- 	Can be different from methodClass if the method was recompiled."
- 	^self properties methodHome!

Item was removed:
- ----- Method: CompiledMethod>>methodNode (in category 'decompiling') -----
- methodNode
- 	"Return the parse tree that represents self. If parsing fails, decompile the method."
- 	| aClass source |
- 	aClass := self methodClass.
- 	source := self
- 				getSourceFor: (self selector ifNil: [self defaultSelector])
- 				in: aClass.
- 	^[(aClass newParser
- 		encoderClass: self encoderClass;
- 		parse: source class: aClass)
- 			sourceText: source;
- 			yourself]
- 		on: SyntaxErrorNotification
- 		do: [:ex | ex return: self decompileWithTemps]!

Item was removed:
- ----- Method: CompiledMethod>>methodNodeFormattedAndDecorated: (in category 'decompiling') -----
- methodNodeFormattedAndDecorated: decorate
- 	"Answer a method node made from pretty-printed (and colorized, if decorate is true) 
- 	 source text."
- 
- 	| class source node  |
- 	
- 	source := self getSourceFromFile.
- 	class := self methodClass ifNil: [self sourceClass].
- 	source ifNil: [^self decompile].
- 	source := class prettyPrinterClass 
- 				format: source
- 				in: class
- 				notifying: nil
- 				decorated: decorate.
- 	node := class newParser parse: source class: class.
- 	node sourceText: source.
- 	^node!

Item was removed:
- ----- Method: CompiledMethod>>nestedBlockMethods (in category 'closures') -----
- nestedBlockMethods
- 	"Answer a collection of the block methods of blocks within the receiver, if any."
- 	| nestedBlockMethods iterator |
- 	nestedBlockMethods := OrderedCollection new.
- 	iterator := [:m| | nLits |
- 				nLits := m numLiterals.
- 				2 to: (m isCompiledBlock ifTrue: [nLits] ifFalse: [nLits - 1]) do:
- 					[:index | | lit |
- 					lit := m objectAt: index.
- 					lit isCompiledCode ifTrue:
- 						[iterator value: (nestedBlockMethods add: lit)]]].
- 	iterator value: self.
- 	^nestedBlockMethods
- !

Item was removed:
- ----- Method: CompiledMethod>>objectForDataStream: (in category 'file in/out') -----
- objectForDataStream: refStrm
- 	"Reconfigure pragma. Example: #(#FFTPlugin #primitiveFFTTransformData 0 0). See FFT >> #pluginTransformData:."
- 
- 	self primitive = 117 ifTrue: [(self literalAt: 1) at: 4 put: 0].!

Item was removed:
- ----- Method: CompiledMethod>>parserClass (in category 'decompiling') -----
- parserClass
- 	^self methodClass 
- 		ifNil: [Compiler parserClass] 
- 		ifNotNil: [:class | class parserClass].!

Item was removed:
- ----- Method: CompiledMethod>>penultimateLiteral (in category 'private') -----
- penultimateLiteral
- 	"Answer the penultimate literal of the receiver, which holds either
- 	 the receiver's selector or its properties (which will hold the selector)."
- 	| pIndex |
- 	^(pIndex := self numLiterals - 1) > 0 
- 		ifTrue: [self literalAt: pIndex]
- 		ifFalse: [nil]!

Item was removed:
- ----- Method: CompiledMethod>>penultimateLiteral: (in category 'private') -----
- penultimateLiteral: anObject
- 	"Set the penultimate literal of the receiver, which holds either the
- 	 receiver's selector or its properties (which will hold the selector).
- 	 If it is an AdditionalMethodState set the state's ownership to this
- 	 method"
- 	| pIndex |
- 	(pIndex := self numLiterals - 1) <= 0 ifTrue:
- 		[self error: 'insufficient literals'].
- 	self literalAt: pIndex put: anObject.
- 	anObject isMethodProperties ifTrue:
- 		[(anObject method ~~ nil
- 		  and: [anObject method ~~ self
- 		  and: [anObject method penultimateLiteral == anObject]]) ifTrue:
- 			[self error: 'a method''s AdditionalMethodState should not be shared'].
- 		 anObject setMethod: self.
- 		 anObject pragmas do: [:p| p setMethod: self]]!

Item was removed:
- ----- Method: CompiledMethod>>postCopy (in category 'copying') -----
- postCopy
- 	| penultimateLiteral |
- 	(penultimateLiteral := self penultimateLiteral) isMethodProperties ifTrue:
- 		[self penultimateLiteral: penultimateLiteral copy].
- 	self encoderClass supportsFullBlocks ifTrue:
- 		[1 to: self numLiterals - 2 do:
- 			[:index| | lit |
- 			 (lit := self literalAt: index) isCompiledCode ifTrue:
- 				[lit outerCode: self; postCopy]]]!

Item was removed:
- ----- Method: CompiledMethod>>pragmaAt: (in category 'accessing-pragmas & properties') -----
- pragmaAt: aKey
- 	"Answer the pragma with selector aKey, or nil if none."
- 	| propertiesOrSelector |
- 	^(propertiesOrSelector := self penultimateLiteral) isMethodProperties
- 		ifTrue: [propertiesOrSelector at: aKey ifAbsent: nil]
- 		ifFalse: [nil]!

Item was removed:
- ----- Method: CompiledMethod>>pragmas (in category 'accessing-pragmas & properties') -----
- pragmas
- 	| selectorOrProperties |
- 	^(selectorOrProperties := self penultimateLiteral) isMethodProperties
- 		ifTrue: [selectorOrProperties pragmas]
- 		ifFalse: [#()]!

Item was removed:
- ----- Method: CompiledMethod>>pragmasAt: (in category 'accessing-pragmas & properties') -----
- pragmasAt: aSelector
- 	^self pragmas select: [:p| p keyword = aSelector]!

Item was removed:
- ----- Method: CompiledMethod>>preamble (in category 'printing') -----
- preamble
- 	"Return the preamble of this method stored in the source files."
- 
- 	^SourceFiles
- 		fileIndexAndPositionFromSourcePointer: self sourcePointer
- 		do: [ :fileIndex :filePosition |
- 			fileIndex = 0
- 				ifTrue: [ String new "no source pointer for this method" ]
- 				ifFalse: [
- 					(CurrentReadOnlySourceFiles at: fileIndex)
- 						ifNil: [ String new "sources file not available" ]
- 						ifNotNil: [ :file |
- 							self
- 								getPreambleFrom: file
- 								at: (0 max: filePosition - 3) ] ] ]!

Item was removed:
- ----- Method: CompiledMethod>>primitive (in category 'accessing') -----
- primitive
- 	"Answer the primitive index associated with the receiver.
- 	 Zero indicates that this is not a primitive method."
- 	| initialPC |
- 	^(self header anyMask: 65536) "Is the hasPrimitive? flag set?"
- 		ifTrue: [(self at: (initialPC := self initialPC) + 1) + ((self at: initialPC + 2) bitShift: 8)]
- 		ifFalse: [0]!

Item was removed:
- ----- Method: CompiledMethod>>primitiveErrorVariableName (in category 'printing') -----
- primitiveErrorVariableName
- 	"Answer the primitive error code temp name, or nil if none."
- 	self primitive > 0 ifTrue:
- 		[self pragmas do:
- 			[:pragma| | kwds ecIndex |
- 			((kwds := pragma keyword keywords) first = 'primitive:'
- 			and: [(ecIndex := kwds indexOf: 'error:') > 0]) ifTrue:
- 				[^pragma argumentAt: ecIndex]]].
- 	^nil!

Item was removed:
- ----- Method: CompiledMethod>>printPrimitiveOn: (in category 'printing') -----
- printPrimitiveOn: aStream
- 	"Print the primitive on aStream"
- 	| primIndex primDecl |
- 	(primIndex := self primitive) = 0 ifTrue:
- 		[^self].
- 	primIndex = 120 ifTrue: "External call spec"
- 		[^aStream print: (self literalAt: 1); cr].
- 	aStream nextPutAll: '<primitive: '.
- 	primIndex = 117
- 		ifTrue:
- 			[primDecl := self literalAt: 1.
- 			 (primDecl at: 2) asString printOn: aStream.
- 			 (primDecl at: 1) ifNotNil:
- 				[:moduleName|
- 				aStream nextPutAll:' module: '.
- 				moduleName asString printOn: aStream]]
- 		ifFalse:
- 			[aStream print: primIndex].
- 	self primitiveErrorVariableName ifNotNil:
- 		[:primitiveErrorVariableName|
- 		 aStream nextPutAll: ' error: '; nextPutAll: primitiveErrorVariableName].
- 	aStream nextPut: $>; cr!

Item was removed:
- ----- Method: CompiledMethod>>properties (in category 'accessing') -----
- properties
- 	"Answer the method properties of the receiver."
- 	| propertiesOrSelector |
- 	^(propertiesOrSelector := self penultimateLiteral) isMethodProperties
- 		ifTrue: [propertiesOrSelector]
- 		ifFalse: [self class methodPropertiesClass forMethod: self selector: propertiesOrSelector]!

Item was removed:
- ----- Method: CompiledMethod>>properties: (in category 'accessing') -----
- properties: aMethodProperties
- 	"Set the method-properties of the receiver to aMethodProperties."
- 	self literalAt: self numLiterals - 1
- 		put: (aMethodProperties isEmpty
- 				ifTrue: [aMethodProperties selector]
- 				ifFalse: [aMethodProperties
- 							setMethod: self;
- 							yourself])!

Item was removed:
- ----- Method: CompiledMethod>>propertyKeysAndValuesDo: (in category 'accessing-pragmas & properties') -----
- propertyKeysAndValuesDo: aBlock
- 	"Enumerate the receiver with all the keys and values."
- 
- 	| propertiesOrSelector |
- 	(propertiesOrSelector := self penultimateLiteral) isMethodProperties ifTrue:
- 		[propertiesOrSelector propertyKeysAndValuesDo: aBlock]!

Item was removed:
- ----- Method: CompiledMethod>>propertyValueAt: (in category 'accessing-pragmas & properties') -----
- propertyValueAt: propName
- 	| propertiesOrSelector |
- 	^(propertiesOrSelector := self penultimateLiteral) isMethodProperties
- 		ifTrue: [propertiesOrSelector propertyValueAt: propName ifAbsent: nil]
- 		ifFalse: [nil]!

Item was removed:
- ----- Method: CompiledMethod>>propertyValueAt:ifAbsent: (in category 'accessing-pragmas & properties') -----
- propertyValueAt: propName ifAbsent: aBlock
- 	| propertiesOrSelector |
- 	^(propertiesOrSelector := self penultimateLiteral) isMethodProperties
- 		ifTrue: [propertiesOrSelector propertyValueAt: propName ifAbsent: aBlock]
- 		ifFalse: [aBlock value]!

Item was removed:
- ----- Method: CompiledMethod>>propertyValueAt:put: (in category 'accessing-pragmas & properties') -----
- propertyValueAt: propName put: propValue
- 	"Set or add the property with key propName and value propValue.
- 	 If the receiver does not yet have a method properties create one and replace
- 	 the selector with it.  Otherwise, either relace propValue in the method properties
- 	 or replace method properties with one containing the new property."
- 	| propertiesOrSelector |
- 	(propertiesOrSelector := self penultimateLiteral) isMethodProperties ifFalse:
- 		[self penultimateLiteral: (self class methodPropertiesClass
- 									selector: propertiesOrSelector
- 									with: (Association
- 											key: propName asSymbol
- 											value: propValue)).
- 		^propValue].
- 	(propertiesOrSelector includesProperty: propName) ifTrue:
- 		[^propertiesOrSelector at: propName put: propValue].
- 	self penultimateLiteral: (propertiesOrSelector
- 								copyWith: (Association
- 											key: propName asSymbol
- 											value: propValue)).
- 	^propValue!

Item was removed:
- ----- Method: CompiledMethod>>putSource:fromParseNode:class:category:inFile:priorMethod: (in category 'source code management') -----
- putSource: sourceStr fromParseNode: methodNode class: class category: catName
- 	inFile: fileIndex priorMethod: priorMethod
- 
- 	^ self putSource: sourceStr fromParseNode: methodNode inFile: fileIndex withPreamble:
- 			[:file | class printCategoryChunk: catName on: file priorMethod: priorMethod.
- 			file cr]!

Item was removed:
- ----- Method: CompiledMethod>>putSource:fromParseNode:class:category:withStamp:inFile:priorMethod: (in category 'source code management') -----
- putSource: sourceStr fromParseNode: methodNode class: class category: catName
- 	withStamp: changeStamp inFile: fileIndex priorMethod: priorMethod
- 
- 	^ self putSource: sourceStr fromParseNode: methodNode inFile: fileIndex withPreamble:
- 			[:file |
- 			class printCategoryChunk: catName on: file
- 				withStamp: changeStamp priorMethod: priorMethod.
- 			file cr]!

Item was removed:
- ----- Method: CompiledMethod>>putSource:fromParseNode:inFile:withPreamble: (in category 'source code management') -----
- putSource: sourceStr fromParseNode: methodNode inFile: fileIndex withPreamble: preambleBlock
- 	"Store the source code for the receiver on an external file.
- 	If no sources are available, i.e., SourceFile is nil, then store
- 	temp names for decompilation at the end of the method.
- 	If the fileIndex is 1, print on *.sources;  if it is 2, print on *.changes,
- 	in each case, storing a 4-byte source code pointer at the method end."
- 
- 	| file remoteString |
- 	(SourceFiles == nil or: [(file := SourceFiles at: fileIndex) == nil]) ifTrue:
- 		[^self becomeForward: (self copyWithTempsFromMethodNode: methodNode)].
- 
- 	Smalltalk assureStartupStampLogged.
- 	file setToEnd.
- 
- 	preambleBlock value: file.  "Write the preamble"
- 	remoteString := RemoteString newString: sourceStr onFileNumber: fileIndex toFile: file.
- 	file nextChunkPut: ' '.
- 	InMidstOfFileinNotification signal ifFalse: [file flush].
- 	self checkOKToAdd: sourceStr size at: remoteString position.
- 	self setSourcePosition: remoteString position inFile: fileIndex!

Item was removed:
- ----- Method: CompiledMethod>>readsField: (in category 'scanning') -----
- readsField: varIndex 
- 	"Answer whether the receiver loads the instance variable indexed by the argument."
- 
- 	| varIndexCode scanner |
- 	varIndexCode := varIndex - 1.
- 	self isQuick ifTrue: [^ self isReturnField and: [self returnField = varIndexCode]].
- 	
- 	self codeLiteralsDo: [:compiledCode | 
- 		scanner := InstructionStream on: compiledCode.
- 		(scanner scanFor: (self encoderClass instVarReadScanBlockFor: varIndexCode using: scanner))
- 			ifTrue: [^ true]].
- 
- 	^ false!

Item was removed:
- ----- Method: CompiledMethod>>readsRef: (in category 'scanning') -----
- readsRef: variableBinding 
- 	"Answer whether the receiver reads the value of the argument."
- 
- 	self codeLiteralsDo: [:compiledCode |
- 		| litIndex scanner |
- 		(litIndex := compiledCode indexOfLiteral: variableBinding) = 0
- 			ifFalse:
- 				[scanner := InstructionStream on: compiledCode.
- 				(scanner scanFor: (compiledCode encoderClass bindingReadScanBlockFor: litIndex - 1 using: scanner))
- 					ifTrue: [^ true]]].
- 	
- 	^ false!

Item was removed:
- ----- Method: CompiledMethod>>removeProperty: (in category 'accessing-pragmas & properties') -----
- removeProperty: propName
- 	"Remove the property propName if it exists.
- 	 Do _not_ raise an error if the property is missing."
- 	| value newAdditionalState |
- 	value := self propertyValueAt: propName ifAbsent: [^nil].
- 	newAdditionalState := self penultimateLiteral copyWithout:
- 									(Association
- 										key: propName
- 										value: value).
- 	self penultimateLiteral: (newAdditionalState isEmpty
- 								ifTrue: [newAdditionalState selector]
- 								ifFalse: [newAdditionalState]).
- 	^value!

Item was removed:
- ----- Method: CompiledMethod>>removeProperty:ifAbsent: (in category 'accessing-pragmas & properties') -----
- removeProperty: propName ifAbsent: aBlock
- 	"Remove the property propName if it exists.
- 	 Answer the evaluation of aBlock if the property is missing."
- 	| value newAdditionalState |
- 	value := self propertyValueAt: propName ifAbsent: [^aBlock value].
- 	newAdditionalState := self penultimateLiteral copyWithout:
- 									(Association
- 										key: propName
- 										value: value).
- 	self penultimateLiteral: (newAdditionalState isEmpty
- 								ifTrue: [newAdditionalState selector]
- 								ifFalse: [newAdditionalState]).
- 	^value!

Item was removed:
- ----- Method: CompiledMethod>>replace:with:in: (in category 'private') -----
- replace: oldSelector with: newSelector in: aText
- 	| oldKeywords newKeywords args newSelectorWithArgs startOfSource lastSelectorToken |
- 	oldKeywords := oldSelector keywords.
- 	newKeywords := (newSelector ifNil: [self defaultSelector]) keywords.
- 	self assert: oldKeywords size = newKeywords size.
- 	args := self methodClass newParser parseParameterNames: aText string.
- 	newSelectorWithArgs := String streamContents: [:stream |
- 		newKeywords withIndexDo: [:keyword :index |
- 			stream nextPutAll: keyword.
- 			stream space.
- 			args size >= index ifTrue: [
- 				stream nextPutAll: (args at: index); space]]].
- 	lastSelectorToken := args isEmpty
- 		ifFalse: [args last]
- 		ifTrue: [oldKeywords last].
- 	startOfSource := (aText string
- 		indexOfSubCollection: lastSelectorToken startingAt: 1) + lastSelectorToken size.
- 	^newSelectorWithArgs withBlanksTrimmed asText , (aText copyFrom: startOfSource to: aText size)!

Item was removed:
- ----- Method: CompiledMethod>>returnField (in category 'accessing') -----
- returnField
- 	"Answer the index of the instance variable returned by a quick return 
- 	method."
- 	| prim |
- 	prim := self primitive.
- 	prim < 264
- 		ifTrue: [self error: 'only meaningful for quick-return']
- 		ifFalse: [^ prim - 264]!

Item was removed:
- ----- Method: CompiledMethod>>scanForInstructionPattern: (in category 'scanning') -----
- scanForInstructionPattern: tuple
- 	"Convenient use of scanForInstructionSequence:
- 	 e.g. self systemNavigation browseAllSelect: [:m| m scanForInstructionPattern: #((pushConstant: true) (send:super:numArgs: spilled: false 1))]
- 	        self systemNavigation browseAllSelect: [:m| m scanForInstructionPattern: #((send:super:numArgs: arguments false 0) (send:super:numArgs: = false 1))]"
- 	| first firstArgs second secondArgs third thirdArgs |
- 	^(InstructionStream on: self) scanForInstructionSequence:
- 		(tuple size caseOf: {
- 			[1]	-> [first := tuple first.
- 					firstArgs := first allButFirst.
- 					first := first first.
- 					[:a|
- 					 a selector == first and: [a arguments = firstArgs]]].
- 			[2]	-> [first := tuple first.
- 					firstArgs := first allButFirst.
- 					second := tuple second.
- 					secondArgs := second allButFirst.
- 					first := first first.
- 					second := second first.
- 					[:a :b|
- 					 a selector == first and: [a arguments = firstArgs
- 					 and: [b selector == second and: [b arguments = secondArgs]]]]].
- 			[3]	-> [first := tuple first.
- 					firstArgs := first allButFirst.
- 					second := tuple second.
- 					secondArgs := second allButFirst.
- 					third := tuple third.
- 					thirdArgs := third allButFirst.
- 					first := first first.
- 					second := second first.
- 					third := third first.
- 					[:a :b :c|
- 					 a selector == first and: [a arguments = firstArgs
- 					 and: [b selector == second and: [b arguments = secondArgs
- 					 and: [c selector == third and: [c arguments = thirdArgs]]]]]]] })!

Item was removed:
- ----- Method: CompiledMethod>>scanForInstructionSequence: (in category 'scanning') -----
- scanForInstructionSequence: naryBlock
- 	"naryBlock is a block taking one or more arguments.
- 	 Evaluate it for each sequence of instructions of length
- 	 n in the receiver until naryBlock evaluates to true.
- 	 Answer if naryBlock evaluated to true."
- 	^(InstructionStream on: self) scanForInstructionSequence: naryBlock
- "
- self systemNavigation browseAllSelect: [:m | m scanForInstructionSequence: [:msg| msg selector = #send:super:numArgs: and: [msg arguments second]]] localTo: thisContext class
- "!

Item was removed:
- ----- Method: CompiledMethod>>searchForClass (in category 'accessing') -----
- searchForClass
- 	"search me in all classes, if found, return my class. Slow!!"
- 	self systemNavigation allBehaviorsDo: [:class | 
- 		(class methodDict keyAtIdentityValue: self ifAbsent: [nil]) ifNotNil: [^class]].
- 	^nil.!

Item was removed:
- ----- Method: CompiledMethod>>searchForSelector (in category 'accessing') -----
- searchForSelector
- 	"search me in all classes, if found, return my selector. Slow!!"
- 	self systemNavigation allBehaviorsDo: [:class | 
- 		| selector |
- 		(selector := class methodDict keyAtIdentityValue: self ifAbsent: [nil]) ifNotNil: [^selector]].
- 	^nil.!

Item was removed:
- ----- Method: CompiledMethod>>selector (in category 'accessing') -----
- selector
- 	"Answer a method's selector.  This is either the penultimate literal,
- 	 or, if the method has any properties or pragmas, the selector of
- 	 the AdditionalMethodState stored in the penultimate literal."
- 	| penultimateLiteral | 
- 	^(penultimateLiteral := self penultimateLiteral) isMethodProperties
- 		ifTrue: [penultimateLiteral selector]
- 		ifFalse: [penultimateLiteral]!

Item was removed:
- ----- Method: CompiledMethod>>selector: (in category 'accessing') -----
- selector: aSelector
- 	"Set a method's selector.  This is either the penultimate literal,
- 	 or, if the method has any properties or pragmas, the selector of
- 	 the MethodProperties stored in the penultimate literal."
- 	| penultimateLiteral nl | 
- 	(penultimateLiteral := self penultimateLiteral) isMethodProperties
- 		ifTrue: [penultimateLiteral selector: aSelector]
- 		ifFalse: [(nl := self numLiterals) < 2 ifTrue:
- 					[self error: 'insufficient literals to hold selector'].
- 				self literalAt: nl - 1 put: aSelector]!

Item was removed:
- ----- Method: CompiledMethod>>setSourcePointer: (in category 'source code management') -----
- setSourcePointer: srcPointer
- 	"We can't necessarily change the trailer of existing method, since
- 	 it could have a completely different format. If so, generate a copy
- 	 with a new trailer, containing a srcPointer, and then become it."
- 	| newTrailer myTrailer |
- 	myTrailer := self trailer.
- 	srcPointer = 0
- 		ifTrue: "catch the common case of setting the source pointer to 0 when already 0"
- 			[myTrailer sourcePointer = 0 ifTrue:
- 				[^self].
- 			 newTrailer := CompiledMethodTrailer empty]
- 		ifFalse:
- 			[newTrailer := CompiledMethodTrailer new sourcePointer: srcPointer].
- 	(myTrailer size = newTrailer size
- 	 and: [myTrailer kind = newTrailer kind]) ifTrue:
- 		[^newTrailer copyToMethod: self].
- 
- 	^self becomeForward: (self copyWithTrailerBytes: newTrailer)!

Item was removed:
- ----- Method: CompiledMethod>>setSourcePosition:inFile: (in category 'source code management') -----
- setSourcePosition: position inFile: fileIndex 
- 	self setSourcePointer: (SourceFiles sourcePointerFromFileIndex: fileIndex andPosition: position)!

Item was removed:
- ----- Method: CompiledMethod>>sourceClass (in category 'source code management') -----
- sourceClass
- 	"Get my receiver class (method class) from the preamble of my source.  Return nil if not found."
- 
- 	^ [(Compiler evaluate: (self sourceFileStream backChunk "blank"; backChunk "preamble")) theClass] on: Error do: [nil]!

Item was removed:
- ----- Method: CompiledMethod>>sourceFileStream (in category 'source code management') -----
- sourceFileStream 
- 	"Answer the sources file stream with position set at the beginning of my source string"
- 
- 	| pos |
- 	(pos := self filePosition) = 0 ifTrue: [^ nil].
- 	^ (RemoteString newFileNumber: self fileIndex position: pos) fileStream!

Item was removed:
- ----- Method: CompiledMethod>>sourcePointer (in category 'source code management') -----
- sourcePointer
- 	"Answer the integer which can be used to find the source file and position for this method.
- 	The actual interpretation of this number is up to the SourceFileArray stored in the global variable SourceFiles."
- 
- 	^ self trailer sourcePointer
- !

Item was removed:
- ----- Method: CompiledMethod>>sourceSelector (in category 'source code management') -----
- sourceSelector
- 	"Answer my selector extracted from my source.  If no source answer nil"
- 
- 	| sourceString |
- 	sourceString := self getSourceFromFile ifNil: [^ nil].
- 	^self methodClass newParser parseSelector: sourceString!

Item was removed:
- ----- Method: CompiledMethod>>storeLiteralsOn:forClass: (in category 'printing') -----
- storeLiteralsOn: aStream forClass: aBehavior
- 	"Store the literals referenced by the receiver on aStream, each terminated by a space."
- 
- 	| literal |
- 	2 to: self numLiterals + 1 do:
- 		[:index |
- 		 aBehavior storeLiteral: (self objectAt: index) on: aStream.
- 		 aStream space]!

Item was removed:
- ----- Method: CompiledMethod>>tempNames (in category 'source code management') -----
- tempNames
- 	^self debuggerMap tempNamesForMethod: self!

Item was removed:
- ----- Method: CompiledMethod>>tempNamesString (in category 'source code management') -----
- tempNamesString
- 	"Answer the schematicTempNames string, or nil if receiver has no temps names encoded in trailer"
- 	^ self trailer tempNames!

Item was removed:
- ----- Method: CompiledMethod>>timeStamp (in category 'printing') -----
- timeStamp
- 	"Answer the authoring time-stamp for the given method, retrieved from the sources or changes file. Answer the empty string if no time stamp is available."
- 	"(CompiledMethod compiledMethodAt: #timeStamp) timeStamp"
- 
- 	| preamble stamp tokens tokenCount |
- 	stamp := nil.
- 	preamble := self preamble.
- 	tokens := (preamble findString: 'methodsFor:' startingAt: 1) > 0
- 		ifTrue: [Scanner new scanTokens: preamble]
- 		ifFalse: [#()  "ie cant be back ref"].
- 	(((tokenCount := tokens size) between: 7 and: 8) and: [(tokens at: tokenCount - 5) == #methodsFor:])
- 		ifTrue:
- 			[(tokens at: tokenCount - 3) == #stamp:
- 				ifTrue: ["New format gives change stamp and unified prior pointer"
- 						stamp := tokens at: tokenCount - 2]].
- 	((tokenCount between: 5 and: 6) and: [(tokens at: tokenCount - 3) == #methodsFor:])
- 		ifTrue:
- 			[(tokens at: tokenCount  - 1) == #stamp:
- 				ifTrue: ["New format gives change stamp and unified prior pointer"
- 					stamp := tokens at: tokenCount]].
- 	^stamp ifNil: [ String new ]
- !

Item was removed:
- ----- Method: CompiledMethod>>usesClosureBytecodes (in category 'testing') -----
- usesClosureBytecodes
- 	"Answer whether the receiver was compiled using the closure compiler.
- 	 This is used to help DebuggerMethodMap choose which mechanisms to
- 	 use to inspect activations of the receiver.
- 	 This method answers false negatives in that it only identifies methods
- 	 that use the new BlockClosure bytecodes.
- 	 But since methods that don't create blocks have essentially the same
- 	 code when compiled with either compiler this makes little difference."
- 
- 	^self encoderClass supportsClosures!

Item was removed:
- ----- Method: CompiledMethod>>valueWithReceiver:arguments: (in category 'evaluating') -----
- valueWithReceiver: aReceiver arguments: anArray 
- 
- 	^self class receiver: aReceiver withArguments: anArray executeMethod: self!

Item was removed:
- ----- Method: CompiledMethod>>withoutPrimitive (in category 'converting') -----
- withoutPrimitive
- 	"Answers a copy of self without primitive call.
- 	That may serve for example for testing fallback code."
- 	
- 	| copy skipPrimitiveCall |
- 	self primitive = 0 ifTrue: [^self].
- 	skipPrimitiveCall := 3.
- 	copy := CompiledMethod 
- 		newMethod: self basicSize - self initialPC + 1 - skipPrimitiveCall
- 		header: (self header bitClear: 16r10000).
- 	1 to: self numLiterals do: [:index| copy literalAt: index put: (self literalAt: index)].
- 	self initialPC + skipPrimitiveCall to: self size do: [:index | copy at: index - skipPrimitiveCall put: (self at: index)].
- 	copy postCopy.
- 	^copy!

Item was removed:
- ----- Method: CompiledMethod>>writesField: (in category 'scanning') -----
- writesField: varIndex
- 	"Answer whether the receiver stores into the instance variable indexed by the argument."
- 
- 	| varIndexCode scanner |
- 	self isQuick ifTrue: [^ false].
- 	varIndexCode := varIndex - 1.
- 	
- 	self codeLiteralsDo: [:compiledCode | 
- 		scanner := InstructionStream on: compiledCode.
- 		(scanner scanFor: (self encoderClass instVarWriteScanBlockFor: varIndex - 1 using: scanner))
- 			ifTrue: [^ true]].
- 	
- 	^ false!

Item was removed:
- ----- Method: CompiledMethod>>writesRef: (in category 'scanning') -----
- writesRef: variableBinding 
- 	"Answer whether the receiver writes the value of the argument."
- 
- 	self codeLiteralsDo: [:compiledCode | 
- 		| litIndex scanner |
- 		(litIndex := compiledCode indexOfLiteral: variableBinding) = 0
- 			ifFalse:
- 				[scanner := InstructionStream on: compiledCode.
- 				(scanner scanFor: (compiledCode encoderClass bindingWriteScanBlockFor: litIndex - 1 using: scanner))
- 					ifTrue: [^ true]]].
- 	
- 	^ false!

Item was removed:
- ----- Method: CompiledMethod>>zapSourcePointer (in category 'file in/out') -----
- zapSourcePointer
- 
- 	"clobber the source pointer since it will be wrong"
- 	| copy |
- 	copy := self copyWithTrailerBytes: CompiledMethodTrailer empty.
- 	self becomeForward: copy.
- 	^ copy
- !

Item was removed:
- Object subclass: #CompiledMethodTrailer
- 	instanceVariableNames: 'data encodedData kind size method'
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'Kernel-Methods'!
- 
- !CompiledMethodTrailer commentStamp: 'ul 12/31/2009 19:03' prior: 0!
- I am responsible for encoding and decoding various kinds of compiled method trailer data.
- I should not expose any binary data outside of myself, so all tools which working with compiled methods
- should ask me to encode the meta-data, they want to be added to the compiled method trailer, as well as retrieve it.
- 
- To add a new kind of trailer, you should give it a proper name and define it in the #trailerKinds method at my class side.
- Then you need to implement a corresponding #encode<your name> and #decode<your name> methods at instance side. Then add any public accessor methods, which will use a newly introduced trailer kind for communicating with outer layer(s). And finally evaluate: self generateTrailerKindDecoders.
- 
- An encodeXXX methods should store result (byte array) into encodedData instance variable.
- 
- A decodeXXX methods should read the data from compiled method instance, held by 'method' ivar,
- and always set 'size' ivar (denoting a total length of trailer in compiled method) and optionally 'data' ivar which should keep a decoded data, ready to be used by outer layer(s) using accessor method(s) you providing.
- 
- The kind of compiled method trailer is determined by the last byte of compiled method.
- 
- The byte format used is following: 
- 	"2rkkkkkkdd"
- 
- where 'k' bits stands for 'kind' , allowing totally 64 different kinds of method trailer
- and 'd' bits is data.
- 
- Following is the list of currently defined trailer kinds:
- 
- NoTrailer , k = 000000, dd unused
- method has no trailer, and total trailer size bytes is always 1
- 
- ClearedTrailer, k = 000001, 
- method has cleared trailer (it was set to something else, but then cleared) 
- dd+1  determines the number of bytes for size field, and size is a total length of trailer bytes
- So a total length of trailer is: 1 + (dd + 1) + size
- 
- TempsNamesQCompress, k = 000010
- the trailer contains a list of method temp names,  compressed using qCompress: method. 
- dd+1  determines the number of bytes for size field, and size is a number of bytes of compressed buffer.
- So a total length of trailer is:  1 + (dd + 1) + size
- 
- TempsNamesZip, k = 000011
- the trailer contains a list of method temp names,  compressed using GZIP compression method. 
- dd+1  determines the number of bytes for size field, and size is a number of bytes of compressed buffer
- So a total length of trailer is: 1 + (dd + 1) + size
- 
- SourceBySelector, k = 000100
- the trailer indicates , that method source is determined by a class + selector where it is installed to. 
- Trailer size = 1.
- 
- SourceByStringIdentifier, k = 000101
- the trailer indicates , that method source is determined by a class + some ByteString identifier. 
- dd+1  determines the number of bytes for size of ByteString identifier, and size is number of bytes of string.
- A total length of trailer is:  1 + (dd + 1) + size
- 
- EmbeddedSourceQCompress, k = 000110
- the trailer contains an utf-8 encoded method source code, compressed using qCompress method
- dd+1  determines the number of bytes for size field, and size is a number of bytes of compressed source code
- A total length of trailer is:  1 + (dd + 1) + size
- 
- EmbeddedSourceZip, k = 000111
- the trailer contains an utf-8 encoded method source code, comressed using GZIP 
- dd+1  determines the number of bytes for size field, and size is a number of bytes of compressed buffer
- A total length of trailer is:  1 + (dd + 1) + size
- 
- VarLengthSourcePointer, k = 001000
- the trailer is variable-length encoded source pointer. 
- dd bits is unused.
- 
- ExtendedKind, k = 001001
- the next byte of trailer (one that prepends the last byte of compiled method)
- denotes an extended kind of trailer, allowing to use additional 256 kinds of encoding method's trailer in future. 
- 
- SourcePointer, k = 111111 
- the trailer is encoded source pointer. Total trailer size is 4-bytes 
- (this kind of encoding is backwards compatible with most of existing compiled methods)
- 
- !

Item was removed:
- ----- Method: CompiledMethodTrailer class>>empty (in category 'as yet unclassified') -----
- empty
- 	"answer the empty trailer"
- 	^ self new!

Item was removed:
- ----- Method: CompiledMethodTrailer class>>generateTrailerKindDecoders (in category 'as yet unclassified') -----
- generateTrailerKindDecoders
- 
- 	self class
- 		compile: (String streamContents: [ :stream |
- 			stream
- 				nextPutAll: 'trailerKindDecoders'; cr;
- 				cr;
- 				tab; nextPut: $^; print: (
- 					self trailerKinds collect: [ :each | 
- 						('decode', each) asSymbol ]) ])
- 		classified: 'generated'
- 		!

Item was removed:
- ----- Method: CompiledMethodTrailer class>>sourcePointerInFile: (in category 'as yet unclassified') -----
- sourcePointerInFile: fileIndex
- 
- 	^self new
- 		sourcePointer: (SourceFiles
- 			sourcePointerFromFileIndex: fileIndex
- 			andPosition: (SourceFiles at: fileIndex) position);
- 		yourself
- 		!

Item was removed:
- ----- Method: CompiledMethodTrailer class>>trailerKindDecoders (in category 'generated') -----
- trailerKindDecoders
- 
- 	^#(#decodeNoTrailer #decodeClearedTrailer #decodeTempsNamesQCompress #decodeTempsNamesZip #decodeSourceBySelector #decodeSourceByStringIdentifier #decodeEmbeddedSourceQCompress #decodeEmbeddedSourceZip #decodeVarLengthSourcePointer #decodeExtendedKind #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndef
 ined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeUndefined #decodeSourcePointer)!

Item was removed:
- ----- Method: CompiledMethodTrailer class>>trailerKinds (in category 'as yet unclassified') -----
- trailerKinds
- 	" see class comment for description. If you change this method, evaluate this:
- 	self generateTrailerKindDecoders"
- 	
- 	^#(
- "000000" #NoTrailer
- "000001" #ClearedTrailer
- "000010" #TempsNamesQCompress
- "000011" #TempsNamesZip
- "000100" #SourceBySelector
- "000101" #SourceByStringIdentifier
- "000110" #EmbeddedSourceQCompress
- "000111" #EmbeddedSourceZip
- "001000" #VarLengthSourcePointer
- "001001" #ExtendedKind
- "001010" #Undefined
- "001011" #Undefined
- "001100" #Undefined
- "001101" #Undefined
- "001110" #Undefined
- "001111" #Undefined
- "010000" #Undefined
- "010001" #Undefined
- "010010" #Undefined
- "010011" #Undefined
- "010100" #Undefined
- "010101" #Undefined
- "010110" #Undefined
- "010111" #Undefined
- "011000" #Undefined
- "011001" #Undefined
- "011010" #Undefined
- "011011" #Undefined
- "011100" #Undefined
- "011101" #Undefined
- "011110" #Undefined
- "011111" #Undefined
- "100000" #Undefined
- "100001" #Undefined
- "100010" #Undefined
- "100011" #Undefined
- "100100" #Undefined
- "100101" #Undefined
- "100110" #Undefined
- "100111" #Undefined
- "101000" #Undefined
- "101001" #Undefined
- "101010" #Undefined
- "101011" #Undefined
- "101100" #Undefined
- "101101" #Undefined
- "101110" #Undefined
- "101111" #Undefined
- "110000" #Undefined
- "110001" #Undefined
- "110010" #Undefined
- "110011" #Undefined
- "110100" #Undefined
- "110101" #Undefined
- "110110" #Undefined
- "110111" #Undefined
- "111000" #Undefined
- "111001" #Undefined
- "111010" #Undefined
- "111011" #Undefined
- "111100" #Undefined
- "111101" #Undefined
- "111110" #Undefined
- "111111" #SourcePointer
- 	)!

Item was removed:
- ----- Method: CompiledMethodTrailer>>clear (in category 'initialize-release') -----
- clear
- 	kind := #NoTrailer.
- 	size := 1.
- 	data := encodedData := method := nil!

Item was removed:
- ----- Method: CompiledMethodTrailer>>compiledMethodClass (in category 'creating a method') -----
- compiledMethodClass
- 	"Allow subclasses to create instyances of classes other than CompiledMethod."
- 
- 	^CompiledMethod!

Item was removed:
- ----- Method: CompiledMethodTrailer>>copyToMethod: (in category 'creating a method') -----
- copyToMethod: aCompiledMethod
- 	"Copy the encoded trailer data to aCompiledMethod. Answer aCompiledMethod."
- 	| delta |
- 	delta := aCompiledMethod size - self size.
- 	1 to: size do:
- 		[:i | aCompiledMethod at: delta + i put: (encodedData at: i)].
- 	^aCompiledMethod!

Item was removed:
- ----- Method: CompiledMethodTrailer>>createMethod:class:header: (in category 'creating a method') -----
- createMethod: numberOfBytesForAllButTrailer class: aCompiledMethodClass header: headerWord
- 	"Answer a new compiled method of the given class, headerWord (which defines the number of literals)
- 	 and with the receiver asd its encoded trailer."
- 	^self copyToMethod: (aCompiledMethodClass newMethod: numberOfBytesForAllButTrailer + self size header: headerWord)!

Item was removed:
- ----- Method: CompiledMethodTrailer>>decodeClearedTrailer (in category 'decoding') -----
- decodeClearedTrailer
- 	"Size is set in #decodeLengthField"
- 
- 	self decodeLengthField.
- !

Item was removed:
- ----- Method: CompiledMethodTrailer>>decodeEmbeddedSourceQCompress (in category 'decoding') -----
- decodeEmbeddedSourceQCompress
- 
- 	"data is string with method's source code, encoded using qCompress method"
- 	self qDecompress.!

Item was removed:
- ----- Method: CompiledMethodTrailer>>decodeExtendedKind (in category 'encoding') -----
- decodeExtendedKind
- 
- 	"reserved for future use"
- 	self shouldBeImplemented.
- !

Item was removed:
- ----- Method: CompiledMethodTrailer>>decodeLengthField (in category 'private') -----
- decodeLengthField
- 
- 	"used in various encodings, where length field is preceeding the last trailer byte.
- 	Two least significant bits in last byte denoting the number of bytes for length field"
- 	
- 	| numBytes pos length |
- 
- 	pos := method size.
- 	numBytes := ((method at: pos) bitAnd: 3) + 1.
- 	
- 	length := 0.
- 	1 to: numBytes do: [:i |
- 		length := length << 8 + (method at: pos - i ).
- 		].
- 	size := 1 + numBytes + length.
- 	
- 	^ length!

Item was removed:
- ----- Method: CompiledMethodTrailer>>decodeNoTrailer (in category 'decoding') -----
- decodeNoTrailer
- 	"Not much to decode here"
- 	size := 1. !

Item was removed:
- ----- Method: CompiledMethodTrailer>>decodeSourceBySelector (in category 'decoding') -----
- decodeSourceBySelector
- 
- 	"no data, size = 1"
- 	
- 	size := 1.!

Item was removed:
- ----- Method: CompiledMethodTrailer>>decodeSourceByStringIdentifier (in category 'decoding') -----
- decodeSourceByStringIdentifier
- 
- 	"A method source is determined by a class + string identifier"
- 	| len |
- 	
- 	len := self decodeLengthField.
- 
- 	data := (ReadStream on: method from: method size - size+1 to: method size - size + len) contents asString convertFromEncoding: 'utf8'!

Item was removed:
- ----- Method: CompiledMethodTrailer>>decodeSourcePointer (in category 'decoding') -----
- decodeSourcePointer
- 
- 	"Trailer is a source pointer"
- 	| msz |
- 	
- 	size := 4.
- 	msz := method size.
- 	data := (method at: msz) - 251 << 8 + (method at: msz-1) << 8
- 	 + (method at: msz-2) << 8 + (method at: msz-3).
- 	
- !

Item was removed:
- ----- Method: CompiledMethodTrailer>>decodeTempsNamesQCompress (in category 'decoding') -----
- decodeTempsNamesQCompress
- 
- 	"data is string with method's temporary names, encoded using qCompress method"
- 	self qDecompress.!

Item was removed:
- ----- Method: CompiledMethodTrailer>>decodeUndefined (in category 'decoding') -----
- decodeUndefined
- 	self error: 'undefined method encoding'!

Item was removed:
- ----- Method: CompiledMethodTrailer>>decodeVarLengthSourcePointer (in category 'decoding') -----
- decodeVarLengthSourcePointer
- 
- 	| pos shift |
- 	
- 	pos := method size-1.
- 	shift := data := 0.
- 	
- 	[ | value | 
- 		value := method at: pos.
- 		data := (value bitAnd: 16r7F) << shift + data.
- 		pos := pos - 1.
- 		shift := shift + 7.
- 		value > 127 ] whileTrue.
- 
- 	size := method size - pos.!

Item was removed:
- ----- Method: CompiledMethodTrailer>>encode (in category 'encoding') -----
- encode
- 
- 	encodedData := nil.
- 	
- 	"encode the trailer into byte array"
- 	self perform: ('encode' , kind) asSymbol.
- 
- 	self assert: (encodedData notNil and: [encodedData size > 0 ]).
- 	
- 	"set the size"
- 	size := encodedData size.!

Item was removed:
- ----- Method: CompiledMethodTrailer>>encodeClearedTrailer (in category 'encoding') -----
- encodeClearedTrailer
- 
- 	"A cleared trailer is replaced by #NoTrailer, when used for encoding"
- 	self clear.
- 	kind := #NoTrailer.
- 	
- 	^ self encode!

Item was removed:
- ----- Method: CompiledMethodTrailer>>encodeEmbeddedSourceQCompress (in category 'encoding') -----
- encodeEmbeddedSourceQCompress
- 
- 	"data is string with method's source code, encode it using qCompress method"
- 	self encodeUsingQCompress
- !

Item was removed:
- ----- Method: CompiledMethodTrailer>>encodeExtendedKind (in category 'encoding') -----
- encodeExtendedKind
- 
- 	"reserved for future use"
- 	self error: 'Not yet implemented'.
- !

Item was removed:
- ----- Method: CompiledMethodTrailer>>encodeLengthField: (in category 'private') -----
- encodeLengthField: integer
- 
- 	| bytes value |
- 	self assert: (integer > 0).
- 
- 	value := integer.
- 	
- 	bytes := ByteArray streamContents: [:str |
- 		[ value > 0 ] whileTrue: [
- 			str nextPut: (value bitAnd: 255).
- 			value := value >> 8 ]].
- 
- 	"no more than 4 bytes for length field"
- 	self assert: (bytes size <=4).
- 
- 	^ bytes!

Item was removed:
- ----- Method: CompiledMethodTrailer>>encodeNoTrailer (in category 'encoding') -----
- encodeNoTrailer
- 
- 	encodedData := ByteArray with: self kindAsByte!

Item was removed:
- ----- Method: CompiledMethodTrailer>>encodeSourceBySelector (in category 'encoding') -----
- encodeSourceBySelector
- 
- 	"A method source is determined by a class + selector where it is installed to"
- 	encodedData := ByteArray with: self kindAsByte!

Item was removed:
- ----- Method: CompiledMethodTrailer>>encodeSourceByStringIdentifier (in category 'encoding') -----
- encodeSourceByStringIdentifier
- 
- 	"A method source is determined by a class + string identifier"
- 	
- 	self assert: (data isString).
- 	
- 	encodedData := ByteArray streamContents: [:str |
- 		| utf8str len |
- 		utf8str := (data convertToEncoding: 'utf8') asByteArray.
- 		str nextPutAll: utf8str.
- 		len := self encodeLengthField: utf8str size.
- 		str nextPutAll: len.
- 		str nextPut: self kindAsByte + (len size -1)
- 	]!

Item was removed:
- ----- Method: CompiledMethodTrailer>>encodeSourcePointer (in category 'encoding') -----
- encodeSourcePointer
- 
- 	encodedData := ByteArray new: 4.
- 	encodedData at: 4 put: (data >> 24) + 251.
- 
- 	1 to: 3 do: [:i |
- 		encodedData at: 4-i put: ((data bitShift: (i-3)*8) bitAnd: 16rFF)]!

Item was removed:
- ----- Method: CompiledMethodTrailer>>encodeTempsNamesQCompress (in category 'encoding') -----
- encodeTempsNamesQCompress
- 
- 	"data is string with method's temporary names, encode it using qCompress method"
- 	self encodeUsingQCompress
- !

Item was removed:
- ----- Method: CompiledMethodTrailer>>encodeUndefined (in category 'encoding') -----
- encodeUndefined
- 
- 	self error: 'use of an undefined kind of trailer encoding'!

Item was removed:
- ----- Method: CompiledMethodTrailer>>encodeUsingQCompress (in category 'encoding') -----
- encodeUsingQCompress
- 
- 	"data is string, encode it using qCompress method"
- 	| str length encodedLength |
- 
- 	self assert: data isString.
- 	str := self qCompress: data.
- 	length := str position.
- 	encodedLength := self encodeLengthField: length.
- 
- 	str nextPutAll: encodedLength.
- 	"trailing byte"
- 	str nextPut: (self kindAsByte + encodedLength size - 1).
- 	
- 	encodedData := str contents
- 	!

Item was removed:
- ----- Method: CompiledMethodTrailer>>encodeVarLengthSourcePointer (in category 'encoding') -----
- encodeVarLengthSourcePointer
- 
- 	"source pointer must be >=0"
- 	[data >= 0] assert.
- 	
- 	encodedData := 
- 		data = 0 ifTrue: [ #[0] ] 
- 		ifFalse: [ ByteArray streamContents: [:str |
- 		| value |
- 		value := data.
- 		[value > 0] whileTrue: [
- 			value > 127 ifTrue: [ str nextPut: 128 + (value bitAnd: 16r7F) ]
- 				ifFalse: [ str nextPut: value. ].
- 			value := value >> 7.
- 			].
- 		]].
- 	encodedData := encodedData reversed copyWith: (self kindAsByte)!

Item was removed:
- ----- Method: CompiledMethodTrailer>>endPC (in category 'accessing') -----
- endPC
- 	"Answer the index of the last bytecode."
- 	
- 	method ifNil: [ self error: 'Cannot determine the endPC without compiled method' ].
- 	
- 	"if method set, then size should be set as well"
- 	^ method size - size!

Item was removed:
- ----- Method: CompiledMethodTrailer>>hasSourcePointer (in category 'testing') -----
- hasSourcePointer
- 	^  kind == #SourcePointer or: [ kind == #VarLengthSourcePointer ] !

Item was removed:
- ----- Method: CompiledMethodTrailer>>hasTempNames (in category 'testing') -----
- hasTempNames
- 	^ kind == #TempsNamesQCompress or: [ kind == #TempsNamesZip ]!

Item was removed:
- ----- Method: CompiledMethodTrailer>>initialize (in category 'initialize-release') -----
- initialize
- 	self clear!

Item was removed:
- ----- Method: CompiledMethodTrailer>>isEmpty (in category 'testing') -----
- isEmpty
- 	^ kind == #NoTrailer or: [ kind == #ClearedTrailer ]!

Item was removed:
- ----- Method: CompiledMethodTrailer>>kind (in category 'accessing') -----
- kind
- 	"Answer a symbolic name of trailer kind.
- 	See #trailerKinds on class side and class comment for details"
- 	
- 	^ kind!

Item was removed:
- ----- Method: CompiledMethodTrailer>>kindAsByte (in category 'private') -----
- kindAsByte
- 	| index |
- 	index := self class trailerKinds indexOf: kind.
- 	self assert: (index ~= 0).
- 
- 	^ (index - 1) << 2!

Item was removed:
- ----- Method: CompiledMethodTrailer>>method: (in category 'initialize-release') -----
- method: aMethod
- 
- 	| flagByte index |
- 	data := size := nil.
- 	method := aMethod.
- 	flagByte := method at: method size.
- 
- 	"trailer kind encoded in 6 high bits of last byte"
- 	index := flagByte >> 2 + 1.
- 	kind := self class trailerKinds at: index.
- 
- 	"decode the trailer bytes"
- 	self perform: (self class trailerKindDecoders at: index).
- 	
- 	"after decoding the trailer, size must be set"
- 	self assert: size notNil
- 	
- !

Item was removed:
- ----- Method: CompiledMethodTrailer>>qCompress: (in category 'private') -----
- qCompress: string
- 	"A very simple text compression routine designed for method temp names.
- 	 Most common 11 chars get values 1-11 packed in one 4-bit nibble;
- 	 the next most common get values 12-15 (2 bits) * 16 plus next nibble;
- 	 unusual ones get three nibbles, the first being the escape nibble 0.
- 
- 	Answer the write stream with compressed data inside"
- 
- 	| utf8str stream oddNibble |
- 
- 	string isEmpty ifTrue:
- 		[^self qCompress: ' '].
- 	utf8str := string convertToEncoding: 'utf8'.
- 
- 	stream := WriteStream on: (ByteArray new: utf8str size).
- 	oddNibble := nil.
- 
- 	utf8str do:	[:char | | ix |
- 		ix := 'ear tonsilcmbdfghjkpquvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ012345[]()'
- 			indexOf: char.
- 		(ix = 0
- 			ifTrue:
- 				[{ 0. char asInteger // 16. char asInteger \\ 16 }]
- 			ifFalse:
- 				[ix <= 11
- 					ifTrue: [{ ix }]
- 					ifFalse: [{ ix//16+12. ix\\16 }]])
- 				do: [:nibble |
- 					oddNibble
- 						ifNotNil: [stream nextPut: oddNibble*16 + nibble. oddNibble := nil]
- 						ifNil: [oddNibble := nibble]]].
- 	oddNibble ifNotNil: "4 = 'ear tonsil' indexOf: Character space"
- 		[stream nextPut: oddNibble * 16 + 4].
- 	^ stream
- !

Item was removed:
- ----- Method: CompiledMethodTrailer>>qDecompress (in category 'decoding') -----
- qDecompress 
- 	"Trailer is compressed string using qCompress method + length field + 1 byte
- 	
- 	Decompress strings compressed by qCompress:.
- 	Most common 11 chars get values 0-10 packed in one 4-bit nibble;
- 	next most common 52 get values 12-15 (2 bits) * 16 plus next nibble;
- 	escaped chars get three nibbles"
- 	| len str input |
- 	
- 	len := self decodeLengthField.
-  	input := (ReadStream on: method from: method size - size+1 to: method size - size + len).
- 	
- 	str := String streamContents:
- 		[:strm | | nextNibble nibble peek charTable |
- 		charTable :=  "Character encoding table must match qCompress:"
- 		'ear tonsilcmbdfghjkpquvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ012345[]()'.
- 		peek := true.
- 		nextNibble := [peek
- 						ifTrue: [peek := false. input peek ifNil: [0] ifNotNil: [:b| b // 16]]
- 						ifFalse: [peek := true. input next ifNil: [0] ifNotNil: [:b| b \\ 16]]].
- 		[input atEnd] whileFalse:
- 			[(nibble := nextNibble value) = 0
- 				ifTrue: [input atEnd ifFalse:
- 						[strm nextPut: (Character value: nextNibble value * 16 + nextNibble value)]]
- 				ifFalse:
- 					[nibble <= 11
- 						ifTrue:
- 							[strm nextPut: (charTable at: nibble)]
- 						ifFalse:
- 							[strm nextPut: (charTable at: nibble-12 * 16 + nextNibble value)]]]].
- 			
- 	data := str convertFromEncoding: 'utf8'!

Item was removed:
- ----- Method: CompiledMethodTrailer>>setSourceBySelector (in category 'accessing') -----
- setSourceBySelector
- 
- 	"Trailer is used to indicate that method's source code can be retrieved by 
- 	sending #getSourceCodeBySelector: message to method's class" 
- 	
- 	self clear.
- 	kind := #SourceBySelector!

Item was removed:
- ----- Method: CompiledMethodTrailer>>size (in category 'accessing') -----
- size
- 	"Answer the size of method's trailer , in bytes"
- 	encodedData ifNil: [self encode].
- 	^size!

Item was removed:
- ----- Method: CompiledMethodTrailer>>sourceCode (in category 'accessing') -----
- sourceCode
- 	"Answer the source code of compiled method.
- 	Note: it does not attempts to read from source files using sourcePointer,
- 	nor reconstruct the source code using temp names"
- 	
- 	(kind == #EmbeddedSourceQCompress or: [ kind == #EmbeddedSourceZip ]) ifTrue: [
- 		^ data ].
- 	
- 	kind == #SourceBySelector ifTrue: [
- 		^ method methodClass getSourceCodeBySelector: method selector ].
- 	
- 	kind == #SourceByStringIdentifier ifTrue: [
- 		^ method methodClass getSourceCodeByIdentifier: data ].
- 
- 	^ nil!

Item was removed:
- ----- Method: CompiledMethodTrailer>>sourceCode: (in category 'accessing') -----
- sourceCode: aString
- 	"Embed the source code into compiled method trailer, 
- 	pick best compression method"
- 	| temp |
- 	self clear.
- 	kind := #EmbeddedSourceQCompress.
- 	data := aString asString. "add Text support in future?"
- 	
- 	self encode.
- 	temp := encodedData.
- 
- 	kind := #EmbeddedSourceZip.
- 	self encode.
- 	encodedData size > temp size ifTrue: [
- 		encodedData := temp.
- 		kind := #EmbeddedSourceQCompress.
- 		size := encodedData size.
- 		]!

Item was removed:
- ----- Method: CompiledMethodTrailer>>sourceIdentifier (in category 'accessing') -----
- sourceIdentifier
- 	"Trailer is used to indicate that method's source code can be retrieved by 
- 	sending #getSourceCodeByIdentifier: message to method's class" 
- 
- 	^ (kind == #SourceByStringIdentifier) ifTrue: [ data ] ifFalse: [ nil ].
- 
- !

Item was removed:
- ----- Method: CompiledMethodTrailer>>sourceIdentifier: (in category 'accessing') -----
- sourceIdentifier: aString
- 
- 	"Trailer is used to indicate that method's source code can be retrieved by 
- 	sending #getSourceCodeByIdentifier: message to method's class" 
- 	
- 	self clear.
- 	data := aString.
- 	kind := #SourceByStringIdentifier.
- 	self encode.
- !

Item was removed:
- ----- Method: CompiledMethodTrailer>>sourcePointer (in category 'accessing') -----
- sourcePointer
- 
- 	^ (kind == #SourcePointer or: [ kind == #VarLengthSourcePointer ] )
- 		ifTrue: [ data ]
- 		ifFalse: [ 0 ]
- !

Item was removed:
- ----- Method: CompiledMethodTrailer>>sourcePointer: (in category 'accessing') -----
- sourcePointer: ptr
- 
- 	self clear.
- 	data := ptr.
- 	"see if we can encode pointer using 4-byte trailer"
- 	kind := (ptr between: 16r1000000 and: 16r4FFFFFF) 
- 		ifTrue: [ #SourcePointer ] ifFalse: [ #VarLengthSourcePointer ].
- 	!

Item was removed:
- ----- Method: CompiledMethodTrailer>>tempNames (in category 'accessing') -----
- tempNames
- 	"Answer the string, containing the temps names or nil "
- 	^ (kind == #TempsNamesQCompress or: [ kind == #TempsNamesZip ]) 
- 		ifTrue: [ data ] ifFalse: [ nil ]!

Item was removed:
- ----- Method: CompiledMethodTrailer>>tempNames: (in category 'accessing') -----
- tempNames: aString
- 	"Embed the temp names string into compiled method trailer, 
- 	pick best compression method"
- 	| temp |
- 	self clear.
- 	kind := #TempsNamesQCompress.
- 	data := aString.
- 	
- 	self encode.
- 	temp := encodedData.
- 
- 	kind := #TempsNamesZip.
- 	self encode.
- 	encodedData size > temp size ifTrue: [
- 		encodedData := temp.
- 		kind := #TempsNamesQCompress.
- 		size := encodedData size.
- 		]!

Item was removed:
- ----- Method: CompiledMethodTrailer>>testEncoding (in category 'testing') -----
- testEncoding
- 
- 	"Since we are using basic protocol (#at:, #at:put: , #size) for accessing compiled method data,
- 	we can pass the ByteArray instance into #method: accessor and check if encoding/decoding 
- 	operations	is symmetrical.
- 	Use this method only for unit-testing purposes"
- 	
- 	encodedData ifNil: [ self encode ].
- 	^ CompiledMethodTrailer new method: encodedData!

Item was removed:
- Object subclass: #Complex
- 	instanceVariableNames: 'real imaginary'
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'Kernel-Numbers'!
- 
- !Complex commentStamp: 'mk 10/31/2003 22:19' prior: 0!
- I represent a complex number.
- 
- real			--	real part of the complex number
- imaginary	--	imaginary part of the complex number
- 
- Complex number constructors:
- 
- 	5 i
- 	6 + 7 i.
- 	5.6 - 8 i.
- 	Complex real: 10 imaginary: 5.
- 	Complex abs: 5 arg: (Float pi / 4)
- 
- Arithmetic operation with other complex or non-complex numbers work.
- 
- 	(5 - 6 i) + (-5 + 8 i).			"Arithmetic between two complex numbers."
- 	5 * (5 - 6 i).				"Arithmetic between a non-complex and a complex number."
- 					
- It is also possible to perform arithmetic operations between a complex number
- and a array of (complex) numbers:
- 
- 	2 * {1 + 2i.
- 	     3 + 4i.
- 	     5 + 6i}
- 
- 	5 + 5i * {1 + 2i.
- 	          3.
- 	          5 + 6i}
- 
- It behaves analogously as it is with normal numbers and an array.
- 
- NOTE: Although Complex something similiar to the Smalltalk's Number class, it would
- not be a good idea to make a Complex to be a subclass of a Number because:
- - Number is subclass of Magnitude and Complex is certainly not a magnitude.
-   Complex does not behave very well as a Magnitude. Operations such as
- 	<
- 	>
- 	<=
- 	>=
-   do not have sense in case of complex numbers.
- - Methods in the following Number methods' categories do not have sense for a Complex numbers
- 	trucation and round off
- 	testing
- 	intervals
- 	comparing
- - However the following Number methods' categories do have sense for a Complex number
- 	arithmetic (with the exception of operation
- 		//
- 		\\
- 		quo:
- 		rem:	
- 	mathematical functions
- 
- Thus Complex is somewhat similar to a Number but it is not a subclass of it. Some operations
- we would like to inherit (e.g. #abs, #negated, #reciprocal) but some of the Number operation
- do not have sens to inherit or to overload. Classes are not always neat mechanism.
- 
- !!!!!! We had to COPY the implementation of the
- 		abs
- 		negated
- 		reciprocal
- 		log:
- 		isZero
- 		reciprocal
- 		...
- 	methods from the Number class to the Complex class. Awful solution. Now I begin to
- 	appreciate the Self.
- 
- Missing methods
- 	String | converting | asComplex
- 	Complex | mathematical functions | arcSin
- 	Complex | mathematical functions | arcCos
- 	Complex | mathematical functions | arcTan!

Item was removed:
- ----- Method: Complex class>>abs:arg: (in category 'instance creation') -----
- abs: aNumber1 arg: aNumber2
- 	^self
- 		real: aNumber1 * aNumber2 cos
- 		imaginary: aNumber1 * aNumber2 sin!

Item was removed:
- ----- Method: Complex class>>new (in category 'instance creation') -----
- new
- 	^ self real: 0 imaginary: 0!

Item was removed:
- ----- Method: Complex class>>one (in category 'instance creation') -----
- one
- 	^ self real: 1 imaginary: 0!

Item was removed:
- ----- Method: Complex class>>real:imaginary: (in category 'instance creation') -----
- real: aNumber1 imaginary: aNumber2
- 	^self basicNew	real: aNumber1 imaginary: aNumber2!

Item was removed:
- ----- Method: Complex class>>zero (in category 'instance creation') -----
- zero
- 	^ self real: 0 imaginary: 0!

Item was removed:
- ----- Method: Complex>>* (in category 'arithmetic') -----
- * anObject
- 	"Answer the result of multiplying the receiver by aNumber."
- 	| a b c d x y newReal newImaginary |
- 	anObject isComplex
- 		ifTrue:
- 			[a := self real.
- 			b := self imaginary.
- 			c := anObject real.
- 			d := anObject imaginary.
- 			newReal := (a * c) - (b * d).
- 			newImaginary := (a * d) + (b * c).
- 			((newReal isFinite not or: [newImaginary isFinite not]) and: [self isZero not and: [anObject isZero not]])
- 				ifTrue:
- 					["intermediate computations do overflow, but the product may be finite, retry with scaling"
- 					x := a abs max: b abs.
- 					y := c abs max: d abs.
- 					a := a / x.
- 					b := b / x.
- 					c := c / y.
- 					d := d / y.
- 					newReal := (a * c) - (b * d) * x * y.
- 					newImaginary := (a * d) + (b * c) * x * y].
- 			^ Complex real: newReal imaginary: newImaginary]
- 		ifFalse:
- 			[^ anObject adaptToComplex: self andSend: #*]!

Item was removed:
- ----- Method: Complex>>+ (in category 'arithmetic') -----
- + anObject
- 	"Answer the sum of the receiver and aNumber."
- 	| a b c d newReal newImaginary |
- 	anObject isComplex
- 		ifTrue:
- 			[a := self real.
- 			b := self imaginary.
- 			c := anObject real.
- 			d := anObject imaginary.
- 			newReal := a + c.
- 			newImaginary := b + d.
- 			^ Complex real: newReal imaginary: newImaginary]
- 		ifFalse:
- 			[^ anObject adaptToComplex: self andSend: #+]!

Item was removed:
- ----- Method: Complex>>- (in category 'arithmetic') -----
- - anObject
- 	"Answer the difference between the receiver and aNumber."
- 	| a b c d newReal newImaginary |
- 	anObject isComplex
- 		ifTrue:
- 			[a := self real.
- 			b := self imaginary.
- 			c := anObject real.
- 			d := anObject imaginary.
- 			newReal := a - c.
- 			newImaginary := b - d.
- 			^ Complex real: newReal imaginary: newImaginary]
- 		ifFalse:
- 			[^ anObject adaptToComplex: self andSend: #-]!

Item was removed:
- ----- Method: Complex>>/ (in category 'arithmetic') -----
- / anObject
- 	"Answer the result of dividing receiver by aNumber"
- 	| a b c d newReal newImaginary denom |
- 	anObject isComplex ifTrue:
- 		[a := self real.
- 		b := self imaginary.
- 		c := anObject real.
- 		d := anObject imaginary.
- 		denom := c squared + d squared.
- 		[newReal := ((a * c) + (b * d)) / denom.
- 		newImaginary := ((b * c) - (a * d)) / denom]
- 			on: ZeroDivide do:
- 				[:exc |
- 				"This might be a case of underflow - resume with a value that will result in a secured retry"
- 				exc resume: Float infinity].
- 		(denom isFinite and: [newReal isFinite and: [newImaginary isFinite]])
- 			ifFalse:
- 				["case of overflow, retry securedly"
- 				^self divideSecureBy: anObject].
- 		^ Complex real: newReal imaginary: newImaginary].
- 	^ anObject adaptToComplex: self andSend: #/.!

Item was removed:
- ----- Method: Complex>>= (in category 'comparing') -----
- = anObject
- 	anObject isNumber ifFalse: [^false].
- 	anObject isComplex
- 		ifTrue: [^ (real = anObject real) & (imaginary = anObject imaginary)]
- 		ifFalse: [^ anObject adaptToComplex: self andSend: #=]!

Item was removed:
- ----- Method: Complex>>abs (in category 'arithmetic') -----
- abs
- 	"Answer the distance of the receiver from zero (0 + 0 i)."
- 
- 	^ ((real * real) + (imaginary * imaginary)) sqrt!

Item was removed:
- ----- Method: Complex>>absSecure (in category 'arithmetic') -----
- absSecure
- 	"Answer the distance of the receiver from zero (0 + 0 i).
- 	Try avoiding overflow and/or underflow"
- 
- 	| scale |
- 	scale := real abs max: imaginary abs.
- 	^scale isZero 
- 		ifTrue: [scale]
- 		ifFalse: [(self class real: real / scale imaginary: imaginary / scale) squaredNorm sqrt * scale]!

Item was removed:
- ----- Method: Complex>>adaptToCollection:andSend: (in category 'converting') -----
- adaptToCollection: rcvr andSend: selector
- 	"If I am involved in arithmetic with a Collection, return a Collection of
- 	the results of each element combined with me in that expression."
- 
- 	^ rcvr collect: [:element | element perform: selector with: self]!

Item was removed:
- ----- Method: Complex>>adaptToFloat:andSend: (in category 'converting') -----
- adaptToFloat: rcvr andSend: selector
- 	"If I am involved in arithmetic with a Float, convert it to a Complex number."
- 	^ rcvr asComplex perform: selector with: self!

Item was removed:
- ----- Method: Complex>>adaptToFraction:andSend: (in category 'converting') -----
- adaptToFraction: rcvr andSend: selector
- 	"If I am involved in arithmetic with a Fraction, convert it to a Complex number."
- 	^ rcvr asComplex perform: selector with: self!

Item was removed:
- ----- Method: Complex>>adaptToInteger:andSend: (in category 'converting') -----
- adaptToInteger: rcvr andSend: selector
- 	"If I am involved in arithmetic with an Integer, convert it to a Complex number."
- 	^ rcvr asComplex perform: selector with: self!

Item was removed:
- ----- Method: Complex>>arCosh (in category 'mathematical functions') -----
- arCosh
- 	"Answer receiver's area hyperbolic cosine.
- 	That is the inverse function of cosh.
- 	Some possible implementations:
- 	^imaginary > 0 
- 		ifTrue: [(self + (self * self - 1) sqrt) ln]
- 		ifFalse: [(self + (self * self - 1) sqrt) ln negated]
- 	^self arcCos i
- 	This implementation provides an answer with a positive real part.
- 	It also avoids creating intermediate Complex."
- 	
- 	| x y tmp sh2x shx delta ch2x chx |
- 	imaginary = 0 ifTrue: [real abs > 1
- 			ifTrue: 
- 				[y := real < 0
- 					ifTrue: [Float pi]
- 					ifFalse: [0].
- 				x := real abs arCosh.
- 				^self class real: x imaginary: y]
- 			ifFalse: [^self class real: 0 imaginary: real arcCos]].
- 	tmp := self squaredNorm - 1 / 2.
- 	delta := tmp squared + imaginary squared.
- 	sh2x := tmp + delta sqrt.
- 	shx := sh2x sqrt.
- 	ch2x := 1 + sh2x.
- 	chx := ch2x sqrt.
- 	x := shx arSinh.
- 	y := imaginary copySignTo: (real / chx) arcCos.
- 	^self class real: x imaginary: y!

Item was removed:
- ----- Method: Complex>>arSinh (in category 'mathematical functions') -----
- arSinh
- 	"Answer receiver's area hyperbolic sine.
- 	That is the inverse function of sinh."
- 
- 	"Some possible implementation:
- 
- 	^imaginary * real < 0 
- 		ifTrue: [(self + (self * self + 1) sqrt) ln]
- 		ifFalse: [(self - (self * self + 1) sqrt) ln]"
- 
- 	^self i arcSin i negated!

Item was removed:
- ----- Method: Complex>>arTanh (in category 'mathematical functions') -----
- arTanh
- 	"Answer receiver's area hyperbolic tangent.
- 	That is the inverse function of tanh."
- 
- 	"Some other possible implementation:
- 
- 	^((1 + self) / (1 - self)) ln / 2"
- 
- 	^self i arcTan i negated!

Item was removed:
- ----- Method: Complex>>arcCos (in category 'mathematical functions') -----
- arcCos
- 	"Answer the arc cosine of the receiver.
- 	This is the inverse function of cos."
- 
- 	| x y tmp sh2y shy delta ch2y chy |
- 	imaginary = 0 ifTrue: [real abs > 1
- 			ifTrue: 
- 				[x := real < 0
- 					ifTrue: [Float pi]
- 					ifFalse: [0].
- 				y := real copySignTo: real abs arCosh.
- 				^self class real: x imaginary: y]
- 			ifFalse: [^self class real: real arcCos imaginary: 0]].
- 	tmp := self squaredNorm - 1 / 2.
- 	delta := tmp squared + imaginary squared.
- 	sh2y := tmp + delta sqrt.
- 	shy := sh2y sqrt.
- 	ch2y := 1 + sh2y.
- 	chy := ch2y sqrt.
- 	y := imaginary copySignTo: shy arSinh.
- 	x := (real / chy) arcCos.
- 	^self class real: x imaginary: y negated!

Item was removed:
- ----- Method: Complex>>arcSin (in category 'mathematical functions') -----
- arcSin
- 	"Answer the arc sine of the receiver.
- 	This is the inverse function of sin."
- 
- 	| x y tmp delta sh2y shy ch2y chy |
- 	imaginary = 0 
- 		ifTrue: 
- 			[real abs > 1 
- 				ifTrue: 
- 					[x := Float pi / 2 * real sign.
- 					y := (real copySignTo: real abs arCosh) negated.
- 					^self class real: x imaginary: y]
- 				ifFalse: [^self class real: real arcSin imaginary: 0]].
- 	tmp := (self squaredNorm - 1) / 2.
- 	delta := tmp squared + imaginary squared.
- 	sh2y := tmp + delta sqrt.
- 	shy := sh2y sqrt.
- 	ch2y := 1 + sh2y.
- 	chy := ch2y sqrt.
- 	y := imaginary copySignTo: shy arSinh.
- 	x := (real / chy) arcSin.
- 	^self class real: x imaginary: y!

Item was removed:
- ----- Method: Complex>>arcTan (in category 'mathematical functions') -----
- arcTan
- 	"Answer the arc tangent of the receiver.
- 	This is the inverse function of tan."
- 
- 	| r2 |
- 	r2 := self squaredNorm.
- 	^self class
- 		real: (real * 2 arcTan: 1 - r2) / 2
- 		imaginary: ((r2 + (imaginary * 2) + 1) / (r2 - (imaginary * 2) + 1)) ln / 4!

Item was removed:
- ----- Method: Complex>>arcTan: (in category 'mathematical functions') -----
- arcTan: denominator 
- 	"Answer the  four quadrants arc tangent of receiver over denominator."
- 
- 	^denominator isZero 
- 		ifTrue: 
- 			[self isZero 
- 				ifTrue: 
- 					["shouldn't it be an error ? ^DomainError signal: '0 arcTan: 0'"
- 					^self class real: 0 imaginary: 0]
- 				ifFalse: 
- 					[self class
- 						real: Float pi / (real copySignTo: 2)
- 						imaginary: 0]]
- 		ifFalse: 
- 			[| res |
- 			res := (self / denominator) arcTan.
- 			denominator real < 0 ifTrue: [res := res + Float pi].
- 			res real > Float pi 
- 				ifTrue: [res := res - (Float pi * 2)].
- 			res]!

Item was removed:
- ----- Method: Complex>>arg (in category 'arithmetic') -----
- arg
- 	"Answer the argument of the receiver."
- 
- 	self isZero ifTrue: [self error: 'zero has no argument.'].
- 	^imaginary arcTan: real!

Item was removed:
- ----- Method: Complex>>asComplex (in category 'converting') -----
- asComplex
- 	^self!

Item was removed:
- ----- Method: Complex>>conjugated (in category 'arithmetic') -----
- conjugated
- 	"Return the complex conjugate of this complex number."
- 
- 	^self class real: real imaginary: imaginary negated!

Item was removed:
- ----- Method: Complex>>cos (in category 'mathematical functions') -----
- cos
- 	"Answer receiver's cosine."
- 
- 	^self i cosh!

Item was removed:
- ----- Method: Complex>>cosh (in category 'mathematical functions') -----
- cosh
- 	"Answer receiver's hyperbolic cosine.
- 	Hyperbolic cosine is defined by same power serie expansion as for real numbers, that is in term of exponential:
- 	^ (self exp + self negated exp) / 2.
- 	This implementation avoids creating intermediate objects."
- 	
- 	^self class
- 		real: real cosh * imaginary cos
- 		imaginary: real sinh * imaginary sin!

Item was removed:
- ----- Method: Complex>>divideFastAndSecureBy: (in category 'arithmetic') -----
- divideFastAndSecureBy: anObject
- 	"Answer the result of dividing receiver by aNumber"
- 	" Both operands are scaled to avoid arithmetic overflow. 
- 	  This algorithm works for a wide range of values, and it needs only three divisions.
- 	  Note: #reciprocal uses #/ for devision "
- 	 
- 	| r d newReal newImaginary |
- 	anObject isComplex ifTrue:
- 		[anObject real abs > anObject imaginary abs
- 		  ifTrue:
- 		    [r := anObject imaginary / anObject real.
- 			d := r*anObject imaginary + anObject real.
- 			newReal := r*imaginary + real/d.
- 			newImaginary := r negated * real + imaginary/d.
- 		    ]
- 		  ifFalse:
- 		    [r := anObject real / anObject imaginary.
- 			d := r*anObject real + anObject imaginary.
- 			newReal := r*real + imaginary/d.
- 			newImaginary := r*imaginary - real/d.
- 		    ].
- 		
- 		^ Complex real: newReal imaginary: newImaginary].
- 	^ anObject adaptToComplex: self andSend: #/.!

Item was removed:
- ----- Method: Complex>>divideSecureBy: (in category 'arithmetic') -----
- divideSecureBy: anObject
- 	"Answer the result of dividing receiver by aNumber"
- 	" Both operands are scaled to avoid arithmetic overflow. This algorithm 
- 	  works for a wide range of values, but it requires six divisions.  
- 	  #divideFastAndSecureBy:  is also quite good, but it uses only 3 divisions.
- 	   Note: #reciprocal uses #/ for division"
- 	 
- 	| s ars ais brs bis newReal newImaginary |
- 	anObject isComplex ifTrue:
- 		[s := anObject real abs max: anObject imaginary abs.
- 		 ars := self real / s.
- 		 ais := self imaginary / s.
- 		 brs := anObject real / s.
- 		 bis := anObject imaginary / s.
- 		 s := brs squared + bis squared.
- 		 brs := brs / s.
- 		 bis := bis / s.
- 		
- 		newReal := ars*brs + (ais*bis).
- 		newImaginary := ais*brs - (ars*bis).
- 		^ Complex real: newReal imaginary: newImaginary].
- 	^ anObject adaptToComplex: self andSend: #/.!

Item was removed:
- ----- Method: Complex>>exp (in category 'mathematical functions') -----
- exp
- 	"Answer the exponential of the receiver."
- 
- 	^ real exp * (imaginary cos + imaginary sin i)!

Item was removed:
- ----- Method: Complex>>hash (in category 'comparing') -----
- hash
- 	"Hash is reimplemented because = is implemented."
- 	
- 	^ real hash bitXor: imaginary hash.!

Item was removed:
- ----- Method: Complex>>i (in category 'arithmetic') -----
- i
- 	"Answer the result of multiplying the receiver with pure imaginary.
- 		^self * 1 i
- 	This is an obvious extension of method i implemented in Number."
- 
- 	^self class real: imaginary negated imaginary: real!

Item was removed:
- ----- Method: Complex>>imaginary (in category 'accessing') -----
- imaginary
- 	^ imaginary!

Item was removed:
- ----- Method: Complex>>isComplex (in category 'testing') -----
- isComplex
- 	^ true!

Item was removed:
- ----- Method: Complex>>isNumber (in category 'testing') -----
- isNumber
- 	^ true!

Item was removed:
- ----- Method: Complex>>isZero (in category 'testing') -----
- isZero
- 	^ real isZero and: [imaginary isZero]!

Item was removed:
- ----- Method: Complex>>ln (in category 'mathematical functions') -----
- ln
- 	"Answer the natural log of the receiver."
- 
- 	^ self abs ln + self arg i!

Item was removed:
- ----- Method: Complex>>log: (in category 'mathematical functions') -----
- log: aNumber 
- 	"Answer the log base aNumber of the receiver."
- 
- 	^self ln / aNumber ln!

Item was removed:
- ----- Method: Complex>>negated (in category 'arithmetic') -----
- negated
- 	"Answer a Number that is the negation of the receiver."
- 
- 	^self class real: real negated imaginary: imaginary negated!

Item was removed:
- ----- Method: Complex>>printOn: (in category 'printing') -----
- printOn: aStream
- 	real printOn: aStream.
- 	aStream nextPut: Character space.
- 	imaginary signBit = 0
- 		ifTrue: [aStream nextPut: $+]
- 		ifFalse: [aStream nextPut: $-].
- 	aStream nextPut: Character space.
- 	imaginary abs printOn: aStream.
- 	aStream nextPut: Character space.
- 	aStream nextPut: $i
- !

Item was removed:
- ----- Method: Complex>>printOn:showingDecimalPlaces: (in category 'printing') -----
- printOn: aStream showingDecimalPlaces: placesDesired
- 	real printOn: aStream showingDecimalPlaces: placesDesired.
- 	aStream nextPut: Character space.
- 	imaginary signBit = 0
- 		ifTrue: [aStream nextPut: $+]
- 		ifFalse: [aStream nextPut: $-].
- 	aStream nextPut: Character space.
- 	imaginary abs printOn: aStream showingDecimalPlaces: placesDesired.
- 	aStream nextPut: Character space.
- 	aStream nextPut: $i
- !

Item was removed:
- ----- Method: Complex>>raisedTo: (in category 'mathematical functions') -----
- raisedTo: aNumber 
- 	"Answer the receiver raised to aNumber."
- 
- 	aNumber isInteger ifTrue:
- 		["Do the special case of integer power"
- 		^ self raisedToInteger: aNumber].
- 	
- 	0 = aNumber ifTrue: [^ self class one].	"Special case of exponent=0"
- 	1 = aNumber ifTrue: [^ self].	"Special case of exponent=1"
- 	0 = self ifTrue: [				"Special case of self = 0"
- 		aNumber < 0
- 			ifTrue: [^ (ZeroDivide dividend: self) signal]
- 			ifFalse: [^ self]].
- 	^ (aNumber * self ln) exp		"Otherwise use logarithms"!

Item was removed:
- ----- Method: Complex>>raisedToInteger: (in category 'mathematical functions') -----
- raisedToInteger: operand 
- 	"Answer the receiver raised to the power operand, an Integer."
- 
- 	"implementation note: this code is copied from Number.
- 	This suggest that both Number and Complex should have an
- 	ArithmeticValue common superclass like in Visualworks.
- 	Or maybe should it be a Traits (a property of fields ?)"
- 
- 	| count result |
- 	operand isInteger ifFalse: [^ ArithmeticError signal: 'parameter is not an Integer'].
- 	operand = 0 ifTrue: [^ self class one].
- 	operand = 1 ifTrue: [^ self].
- 	operand < 0 ifTrue: [^ (self raisedToInteger: operand negated) reciprocal].
- 	count := 1 bitShift: (operand-1) highBit.
- 	result := self class one.
- 	[count > 0]
- 		whileTrue: 
- 			[result := result squared.
- 			(operand bitAnd: count)
- 				= 0 ifFalse: [result := result * self].
- 			count := count bitShift: -1].
- 	^ result!

Item was removed:
- ----- Method: Complex>>real (in category 'accessing') -----
- real
- 	^ real!

Item was removed:
- ----- Method: Complex>>real:imaginary: (in category 'private') -----
- real: aNumber1 imaginary: aNumber2
- 	"Private - initialize the real and imaginary parts of a Complex"
- 	real := aNumber1.
- 	imaginary := aNumber2.!

Item was removed:
- ----- Method: Complex>>reciprocal (in category 'arithmetic') -----
- reciprocal
- 	"Answer 1 divided by the receiver. Create an error notification if the 
- 	receiver is 0."
- 
- 	self = 0
- 		ifTrue: [^ (ZeroDivide dividend: 1) signal]
- 		ifFalse: [^1 / self]
- 		!

Item was removed:
- ----- Method: Complex>>sin (in category 'mathematical functions') -----
- sin
- 	"Answer receiver's sine."
- 
- 	^self i sinh i negated!

Item was removed:
- ----- Method: Complex>>sinh (in category 'mathematical functions') -----
- sinh
- 	"Answer receiver's hyperbolic sine.
- 	Hyperbolic sine is defined by same power serie expansion as for real numbers, that is in term of exponential:
- 	^ (self exp - self negated exp) / 2.
- 	This implementation avoids creating intermediate objects."
- 	
- 	^self class
- 		real: real sinh * imaginary cos
- 		imaginary: real cosh * imaginary sin!

Item was removed:
- ----- Method: Complex>>sqrt (in category 'mathematical functions') -----
- sqrt
- 	"Return the square root of the receiver with a positive real part.
- 	This is the same as (Complex abs: self abs sqrt arg: self arg / 2).
- 	Implementation notes:
- 	the formulation used ensure a protection against floating point overflow/underflow.
- 	it also result in a reasonable precision (around 3 ulp).
- 	It is inspired by following reference, except that it uses pre-scaling rather than eception handling:
- 	Implementing Complex Elementary Function Using Exception Handling
- 	ACM Transactions on Mathematical Software - October 1994
- 	Ping Tang and 3 other authors"
- 
- 	| x y r s t scale |
- 	real isZero
- 		ifTrue:
- 			[t := imaginary abs sqrt / 2 sqrt.
- 			^self class real: t imaginary: (imaginary copySignTo: t)].
- 	scale := real abs max: imaginary abs.
- 	x := real / scale.
- 	y := imaginary / scale.
- 	r := (x squared + y squared) sqrt.
- 	s := scale sqrt.
- 	t := (r + x abs * 2) sqrt.
- 	^real > 0
- 		ifTrue: [self class real: t * s / 2 imaginary: y * s / t]
- 		ifFalse: [self class real: y abs * s / t imaginary: (y copySignTo: t * s / 2)]!

Item was removed:
- ----- Method: Complex>>squared (in category 'mathematical functions') -----
- squared
- 	"Answer the receiver multipled by itself."
- 
- 	^self * self!

Item was removed:
- ----- Method: Complex>>squaredNorm (in category 'arithmetic') -----
- squaredNorm
- 	"Answer the square of receiver norm."
- 
- 	^real * real + (imaginary * imaginary)!

Item was removed:
- ----- Method: Complex>>stringForReadout (in category 'printing') -----
- stringForReadout
- 
- 	^ String streamContents: [:stream |
- 		self printOn: stream showingDecimalPlaces: 0]!

Item was removed:
- ----- Method: Complex>>tan (in category 'mathematical functions') -----
- tan
- 	"Answer receivers tangent."
- 
- 	^ self sin / self cos!

Item was removed:
- ----- Method: Complex>>tanh (in category 'mathematical functions') -----
- tanh
- 	"Answer receiver's hyperbolic tangent."
- 
- 	"Some possible implementation are:
- 
- 	^self sinh / self cosh
- 
- 	| tr ti |
- 	tr := real tanh.
- 	ti := imaginary tan i.
- 	^(tr + ti) / (tr * ti + 1)"
- 
- 	^self i tan i negated!

Item was removed:
- InstructionStream variableSubclass: #Context
- 	instanceVariableNames: 'stackp method closureOrNil receiver'
- 	classVariableNames: 'MaxLengthForASingleDebugLogReport MaxStackDepthForASingleDebugLogReport PrimitiveFailToken QuickStep ValueIndex'
- 	poolDictionaries: ''
- 	category: 'Kernel-Methods'!
- 
- !Context commentStamp: 'eem 4/4/2017 17:45' prior: 0!
- My instances hold all the dynamic state associated with the execution of either a method activation resulting from a message send or a block activation resulting from a block evaluation.  In addition to their inherited state, this includes the receiver (self), the closure for a BlockClosure activation (which is nil for a method activation), a CompiledMethod, and space in the variable part of the context for arguments, temporary variables, and intermediate results, and the stack pointer to the top of stack in this variable part.
- 
- Contexts are created automatically (at least conceptually (*)) whenever a message send activates a method, or a block evaluation activates a block.  The current context can always be accessed via the thisContext pseudo-variable.  For example, explore the following:
- 	{ thisContext. thisContext copy. thisContext method. thisContext pc. thisContext receiver. thisContext stackPtr. thisContext sender }.
- 
- Contexts refer to the context in which they were created via the sender inst var.  An execution stack is made up of of a linked list of contexts, linked through their sender inst var. Returning involves returning back to the sender.  When a context is returned from its sender and pc are nilled, and, if the context is still referred to, the virtual machine guarantees to preserve only the arguments after a return.  A Smalltalk Process is simply a chain of contexts specific to that process.  The debugger is essentially a Process inspector.  Stepping in the debugger is done by sending messages to contexts to get them to execute their bytecodes.  See methods in the instruction decoding protocol.
- 
- Contexts, though normal in their variable size, are actually only used in two sizes, small and large, which are determined by the temporary space required by the method being executed.
- 
- Contexts must only be created using the method newForMethod:.  Note that it is impossible to determine the real object size of a Context except by asking for the frameSize of its method.  Any fields above the stack pointer (stackp) are truly invisible -- even (and especially!!) to the garbage collector.  Any store into stackp other than by the primitive method stackp: is potentially fatal.
- 
- (*) efficient virtual machines create contexts lazily on demand, avoiding the overhead of creating them on every message send and of copying receiver and arguments from sender context to caller context.  This optimization is invisible to the Smalltalk system.!

Item was removed:
- ----- Method: Context class>>allInstances (in category 'enumerating') -----
- allInstances
- 	"Answer all instances of the receiver."
- 	<primitive: 177>
- 	"The primitive can fail because memory is low.  If so, fall back on the old
- 	 enumeration code, which gives the system a chance to GC and/or grow.
- 	 Because aBlock might change the class of inst (for example, using become:),
- 	 it is essential to compute next before aBlock value: inst.
- 	 Only count until thisContext since this context has been created only to
- 	 compute the existing instances."
- 	| inst insts next |
- 	insts := WriteStream on: (Array new: 64).
- 	inst := self someInstance.
- 	[inst == thisContext or: [inst == nil]] whileFalse:
- 		[next := inst nextInstance.
- 		 insts nextPut: inst.
- 		 inst := next].
- 	^insts contents!

Item was removed:
- ----- Method: Context class>>allInstancesDo: (in category 'private') -----
- allInstancesDo: aBlock
- 	"Evaluate aBlock with each of the current instances of the receiver."
- 	| instances inst next |
- 	instances := self allInstancesOrNil.
- 	instances ifNotNil:
- 		[instances do: aBlock.
- 		 ^self].
- 	"allInstancesOrNil can fail because memory is low.  If so, fall back on the old
- 	 enumeration code.  Because aBlock might change the class of inst (for example,
- 	 using become:), it is essential to compute next before aBlock value: inst.
- 	 Only count until thisContext since evaluation of aBlock will create new contexts."
- 	inst := self someInstance.
- 	[inst == thisContext or: [inst == nil]] whileFalse:
- 		[next := inst nextInstance.
- 		 aBlock value: inst.
- 		 inst := next]!

Item was removed:
- ----- Method: Context class>>basicNew: (in category 'instance creation') -----
- basicNew: size 
- 	^ (size = CompiledMethod smallFrameSize or: [ size = CompiledMethod fullFrameSize ])
- 		ifTrue: [ super basicNew: size ]
- 		ifFalse: [ self error: 'Contexts must be ' , CompiledMethod smallFrameSize , ' or ' , CompiledMethod fullFrameSize , ' bytes.' ]!

Item was removed:
- ----- Method: Context class>>carefullyPrint:on: (in category 'private') -----
- carefullyPrint: anObject on: aStream
- 	aStream nextPutAll: ([anObject printString]
- 		on: Error
- 		do: ['unprintable ' , anObject class name])!

Item was removed:
- ----- Method: Context class>>contextEnsure: (in category 'special context creation') -----
- contextEnsure: block
- 	"Create an #ensure: context that is ready to return from executing its receiver.
- 	
- 	As ctxt is *not* a top context as required by #jump, we need to put a (fake) return value (nil) on its stack. Otherwise, #jump will pop something different from the stack. Concretely, this caused the bug described in [1] (Scenario 1) because the latest stack top was the closure vector {chain}. This closure vector was accidently popped away so that in the final return statement, #pushRemoteTemp:inVectorAt: raised an error subscript bounds (because the next stack item was not variable). Read the linked bug report for more details.
- 
- 	[1] http://forum.world.st/BUG-s-in-Context-control-jump-runUntilErrorOrReturnFrom-td5107263.html"
- 
- 	| ctxt chain |
- 	ctxt := thisContext.
- 	[chain := thisContext sender cut: ctxt.
- 	ctxt push: nil. "fake return value"
- 	ctxt jump] ensure: block.
- 	"jump above will resume here without unwinding chain"
- 	^ chain!

Item was removed:
- ----- Method: Context class>>contextOn:do: (in category 'special context creation') -----
- contextOn: exceptionClass do: block
- 	"Create an #on:do: context that is ready to return from executing its receiver.
- 	
- 	As ctxt is *not* a top context as required by #jump, we need to put a (fake) return value (nil) on its stack. Otherwise, #jump will pop something different from the stack. Concretely, this caused the bug described in [1] (Scenario 1) because the latest stack top was the closure vector {chain}. This closure vector was accidently popped away so that in the final return statement, #pushRemoteTemp:inVectorAt: raised an error subscript bounds (because the next stack item was not variable). Read the linked bug report for more details.
- 
- 	[1] http://forum.world.st/BUG-s-in-Context-control-jump-runUntilErrorOrReturnFrom-td5107263.html"
- 
- 	| ctxt chain |
- 	ctxt := thisContext.
- 	[chain := thisContext sender cut: ctxt.
- 	ctxt push: nil. "fake return value"
- 	ctxt jump] on: exceptionClass do: block.
- 	"jump above will resume here without unwinding chain"
- 	^ chain!

Item was removed:
- ----- Method: Context class>>initialize (in category 'class initialization') -----
- initialize
- 	ValueIndex := 2.
- 	self assert: (Association instVarNameForIndex:ValueIndex) = 'value'.
- 	PrimitiveFailToken class ~~ Object ifTrue:
- 		[PrimitiveFailToken := Object new]!

Item was removed:
- ----- Method: Context class>>initializedInstance (in category 'instance creation') -----
- initializedInstance
- 	^ nil!

Item was removed:
- ----- Method: Context class>>isContextClass (in category 'private') -----
- isContextClass
- 	^true!

Item was removed:
- ----- Method: Context class>>maxLengthForASingleDebugLogReport (in category 'preferences') -----
- maxLengthForASingleDebugLogReport
- 	<preference: 'Max. Debug Report Length'
- 		category: 'debug'
- 		description: 'The description of an Exception stack will be truncated so as to not exceed this value'
- 		type: #Number>
- 	^MaxLengthForASingleDebugLogReport ifNil: [40000]!

Item was removed:
- ----- Method: Context class>>maxLengthForASingleDebugLogReport: (in category 'preferences') -----
- maxLengthForASingleDebugLogReport: anInteger
- 	MaxLengthForASingleDebugLogReport := anInteger!

Item was removed:
- ----- Method: Context class>>maxStackDepthForASingleDebugLogReport (in category 'preferences') -----
- maxStackDepthForASingleDebugLogReport
- 	<preference: 'Max. Debug Report Stack Depth'
- 		category: 'debug'
- 		description: 'In an exception stack, any sender deeper than this value will not be logged.'
- 		type: #Number>
- 	^MaxStackDepthForASingleDebugLogReport ifNil: [60]!

Item was removed:
- ----- Method: Context class>>maxStackDepthForASingleDebugLogReport: (in category 'preferences') -----
- maxStackDepthForASingleDebugLogReport: anInteger
- 	MaxStackDepthForASingleDebugLogReport := anInteger!

Item was removed:
- ----- Method: Context class>>new (in category 'instance creation') -----
- new
- 
- 	self error: 'Contexts must only be created with newForMethod:'!

Item was removed:
- ----- Method: Context class>>new: (in category 'instance creation') -----
- new: size
- 
- 	self error: 'Contexts must only be created with newForMethod:'!

Item was removed:
- ----- Method: Context class>>newForMethod: (in category 'instance creation') -----
- newForMethod: aMethod
- 	"This is the only method for creating new contexts, other than primitive cloning.
- 	Any other attempts, such as inherited methods like shallowCopy, should be
- 	avoided or must at least be rewritten to determine the proper size from the
- 	method being activated.  This is because asking a context its size (even basicSize!!)
- 	will not return the real object size but only the number of fields currently
- 	accessible, as determined by stackp."
- 
- 	^ super basicNew: aMethod frameSize!

Item was removed:
- ----- Method: Context class>>primitiveFailToken (in category 'simulation') -----
- primitiveFailToken
- 
- 	^ PrimitiveFailToken!

Item was removed:
- ----- Method: Context class>>primitiveFailTokenFor: (in category 'simulation') -----
- primitiveFailTokenFor: errorCode
- 
- 	^{PrimitiveFailToken. errorCode}!

Item was removed:
- ----- Method: Context class>>runSimulated: (in category 'simulation') -----
- runSimulated: aBlock
- 	"Simulate the execution of aBlock, until it ends or is curtailed. Answer the result it returns."
- 
- 	^thisContext
- 		runSimulated: aBlock
- 		contextAtEachStep: []
- 
- 	"Context runSimulated: [Pen new ifNotNil: [:pen| pen defaultNib: 5. 4 timesRepeat: [pen go: 100; turn: 90]]]"
- 
- 	"Here's a fun example, reaching into the computation to squash the Display>>fillWhite that mandala: begins with..."
- 	"thisContext
- 		runSimulated: [Pen new mandala: 45]
- 		contextAtEachStep: [:ctxt| ctxt selector == #fillWhite ifTrue: [ctxt scanFor: [:ign| ctxt willReturn]]]"!

Item was removed:
- ----- Method: Context class>>sender:receiver:method:arguments: (in category 'instance creation') -----
- sender: s receiver: r method: m arguments: args 
- 	"Answer an instance of me with attributes set to the arguments."
- 
- 	^(self newForMethod: m) setSender: s receiver: r method: m arguments: args!

Item was removed:
- ----- Method: Context class>>tallyInstructions: (in category 'examples') -----
- tallyInstructions: aBlock
- 	"This method uses the simulator to count the number of occurrences of
- 	each of the Smalltalk instructions executed during evaluation of aBlock.
- 	Results appear in order of the byteCode set."
- 	| tallies |
- 	tallies := Bag new.
- 	thisContext
- 		runSimulated: aBlock
- 		contextAtEachStep:
- 			[:current | tallies add: current nextByte].
- 	^tallies sortedElements
- 
- 	"Context tallyInstructions: [3.14159 printString]"!

Item was removed:
- ----- Method: Context class>>tallyMethods: (in category 'examples') -----
- tallyMethods: aBlock
- 	"This method uses the simulator to count the number of calls on each method
- 	invoked in evaluating aBlock. Results are given in order of decreasing counts."
- 	| prev tallies |
- 	tallies := Bag new.
- 	prev := aBlock.
- 	thisContext
- 		runSimulated: aBlock
- 		contextAtEachStep:
- 			[:current |
- 			current == prev ifFalse: "call or return"
- 				[prev sender == nil ifFalse: "call only"
- 					[tallies add: current printString].
- 				prev := current]].
- 	^tallies sortedCounts
- 
- 	"Context tallyMethods: [3.14159 printString]"!

Item was removed:
- ----- Method: Context class>>theReturnMethod (in category 'special context creation') -----
- theReturnMethod
- 
- 	| meth |
- 	meth := self lookupSelector: #return:.
- 	meth primitive = 0 ifFalse: [^ self error: 'expected #return: to not be a primitive'].
- 	^ meth!

Item was removed:
- ----- Method: Context class>>trace: (in category 'examples') -----
- trace: aBlock		"Context trace: [3 factorial]"
- 	"This method uses the simulator to print calls and returned values in the Transcript."
- 
- 	Transcript clear.
- 	^ self trace: aBlock on: Transcript!

Item was removed:
- ----- Method: Context class>>trace:on: (in category 'examples') -----
- trace: aBlock on: aStream		"Context trace: [3 factorial]"
- 	"This method uses the simulator to print calls to a file."
- 	| prev |
- 	prev := aBlock.
- 	^thisContext
- 		runSimulated: aBlock
- 		contextAtEachStep:
- 			[:current |
- 			Sensor anyButtonPressed ifTrue: [^nil].
- 			current == prev ifFalse:
- 				[prev sender ifNil:
- 					[aStream space; nextPut: $^.
- 					 self carefullyPrint: current top on: aStream].
- 				aStream cr.
- 				(current depthBelow: aBlock) timesRepeat: [aStream space].
- 				self carefullyPrint: current receiver on: aStream.
- 				aStream space; nextPutAll: current selector; flush.
- 				prev := current]]!

Item was removed:
- ----- Method: Context class>>trace:onFileNamed: (in category 'examples') -----
- trace: aBlock onFileNamed: fileName
- 	"Context trace: [3 factorial] onFileNamed: 'trace'"
- 	"This method uses the simulator to print calls to a file."
- 
- 	^FileStream fileNamed: fileName do: [ :file |
- 		self trace: aBlock on: file ]!

Item was removed:
- ----- Method: Context>>aboutToReturn:through: (in category 'private') -----
- aboutToReturn: result through: firstUnwindContext 
- 	"Called from VM when an unwindBlock is found between self and its home.
- 	 Return to home's sender, executing unwind blocks on the way."
- 
- 	self methodReturnContext return: result through: firstUnwindContext!

Item was removed:
- ----- Method: Context>>activateMethod:withArgs:receiver: (in category 'controlling') -----
- activateMethod: newMethod withArgs: args receiver: rcvr
- 	"Answer a Context initialized with the arguments."
- 
- 	^Context 
- 		sender: self
- 		receiver: rcvr
- 		method: newMethod
- 		arguments: args!

Item was removed:
- ----- Method: Context>>activateMethod:withArgs:receiver:class: (in category 'controlling') -----
- activateMethod: newMethod withArgs: args receiver: rcvr class: class
- 
- 	self deprecated.
- 	^ self activateMethod: newMethod withArgs: args receiver: rcvr!

Item was removed:
- ----- Method: Context>>activateReturn:value: (in category 'private') -----
- activateReturn: aContext value: value
- 	"Activate 'aContext return: value' in place of self, so execution will return to aContext's sender"
- 
- 	^Context 
- 		sender: self
- 		receiver: aContext
- 		method: Context theReturnMethod
- 		arguments: {value}!

Item was removed:
- ----- Method: Context>>activeHome (in category 'accessing') -----
- activeHome
- 	"If executing closure, search senders for the activation of the original
- 	 (outermost) method that (indirectly) created my closure (the closureHome).
- 	 If the closureHome is not found on the sender chain answer nil."
- 
- 	| methodReturnContext |
- 	self isExecutingBlock ifFalse: [^self].
- 	self sender ifNil: [^nil].
- 	methodReturnContext := self methodReturnContext.
- 	^self sender findContextSuchThat: [:ctxt | ctxt = methodReturnContext]!

Item was removed:
- ----- Method: Context>>activeOuterContext (in category 'accessing') -----
- activeOuterContext
- 	"If executing closure, search senders for the activation in which the receiver's
- 	 closure was created (the receiver's outerContext).  If the outerContext is not
- 	 found on the sender chain answer nil."
- 
- 	| outerContext |
- 	self isExecutingBlock ifFalse: [^self].
- 	self sender ifNil: [^nil].
- 	outerContext := self outerContext.
- 	^self sender findContextSuchThat: [:ctxt | ctxt = outerContext]!

Item was removed:
- ----- Method: Context>>actualStackSize (in category 'private-debugger') -----
- actualStackSize "For use only by Debugger, Inspectors etc"
- 	^ stackp - method numTemps!

Item was removed:
- ----- Method: Context>>arguments (in category 'accessing') -----
- arguments
- 	"Answer the receiver's arguments as an Array.
- 	 We could use simply ^(1 to: self numArgs) collect: [:i| self tempAt: i]
- 	 but for performance and minimality we use the implementation below."
- 	| n args |
- 	args := Array new: (n := self numArgs).
- 	1 to: n do: [:i| args at: i put: (self tempAt: i)].
- 	^args!

Item was removed:
- ----- Method: Context>>asContext (in category 'closure support') -----
- asContext
- 
- 	^ self!

Item was removed:
- ----- Method: Context>>asContextWithSender: (in category 'closure support') -----
- asContextWithSender: aContext
- 	self privSender: aContext.
- 	^ self!

Item was removed:
- ----- Method: Context>>asMessage (in category 'converting') -----
- asMessage
- 	| selector args |
- 	selector := sender method selector.
- 	args := Array new: selector numArgs.
- 	1 to: selector numArgs do: [ :i | args at: i put: (sender tempAt: i)].
- 	^ Message selector: selector arguments: args.!

Item was removed:
- ----- Method: Context>>at: (in category 'accessing') -----
- at: index
- 	"Primitive. Assumes receiver is indexable. Answer the value of an
- 	 indexable element in the receiver. Fail if the argument index is not an
- 	 Integer or is out of bounds. Essential. See Object documentation
- 	 whatIsAPrimitive.  Override the default primitive to give latitude to
- 	 the VM in context management."
- 
- 	<primitive: 210>
- 	index isInteger ifTrue:
- 		[self errorSubscriptBounds: index].
- 	index isNumber
- 		ifTrue: [^self at: index asInteger]
- 		ifFalse: [self errorNonIntegerIndex]!

Item was removed:
- ----- Method: Context>>at:put: (in category 'accessing') -----
- at: index put: value
- 	"Primitive. Assumes receiver is indexable. Answer the value of an
- 	 indexable element in the receiver. Fail if the argument index is not
- 	 an Integer or is out of bounds. Essential. See Object documentation
- 	 whatIsAPrimitive.  Override the default primitive to give latitude to
- 	 the VM in context management."
- 
- 	<primitive: 211>
- 	index isInteger ifTrue:
- 		[self errorSubscriptBounds: index].
- 	index isNumber
- 		ifTrue: [^self at: index asInteger put: value]
- 		ifFalse: [self errorNonIntegerIndex]!

Item was removed:
- ----- Method: Context>>atEnd (in category 'testing') -----
- atEnd
- 	^ self isExecutingBlock
- 		ifTrue: [ self closure startpc + self closure size - 1 = self pc ]
- 		ifFalse: [ self pc >= self method endPC ]!

Item was removed:
- ----- Method: Context>>attemptToAssign:to:withIndex: (in category 'read-only objects') -----
- attemptToAssign: value to: anObject withIndex: index
- 	"Sent by the execution simulation machinery when attempting to assign an instance
- 	 variable of an read-only object.  This mimics the VM's send of attemptToAssign:withIndex:
- 	 when trying to do the same. Upon return, executing will resume *after* the inst var assignment.
- 	 This method differs from Object>>attemptToAssign:withIndex: in not doing a Context>>jump,
- 	 which does not simulate properly."
- 	
- 	self modificationForbiddenFor: anObject instVarAt: index put: value!

Item was removed:
- ----- Method: Context>>basicAt: (in category 'accessing') -----
- basicAt: index
- 	"Primitive. Assumes receiver is indexable. Answer the value of an
- 	 indexable element in the receiver. Fail if the argument index is not an
- 	 Integer or is out of bounds. Essential. See Object documentation
- 	 whatIsAPrimitive.  Override the default primitive to give latitude to
- 	 the VM in context management."
- 
- 	<primitive: 210>
- 	index isInteger ifTrue:
- 		[self errorSubscriptBounds: index].
- 	index isNumber
- 		ifTrue: [^self at: index asInteger]
- 		ifFalse: [self errorNonIntegerIndex]!

Item was removed:
- ----- Method: Context>>basicAt:put: (in category 'accessing') -----
- basicAt: index put: value
- 	"Primitive. Assumes receiver is indexable. Answer the value of an
- 	 indexable element in the receiver. Fail if the argument index is not
- 	 an Integer or is out of bounds. Essential. See Object documentation
- 	 whatIsAPrimitive.  Override the default primitive to give latitude to
- 	 the VM in context management."
- 
- 	<primitive: 211>
- 	index isInteger ifTrue:
- 		[self errorSubscriptBounds: index].
- 	index isNumber
- 		ifTrue: [^self at: index asInteger put: value]
- 		ifFalse: [self errorNonIntegerIndex]!

Item was removed:
- ----- Method: Context>>basicSize (in category 'accessing') -----
- basicSize
- 	"Primitive. Answer the number of indexable variables in the receiver. 
- 	This value is the same as the largest legal subscript. Essential. Do not 
- 	override in any subclass. See Object documentation whatIsAPrimitive.  Override the default primitive to give latitude to
- 	 the VM in context management."
- 
- 	<primitive: 212>
- 	"The number of indexable fields of fixed-length objects is 0"
- 	^self primitiveFailed!

Item was removed:
- ----- Method: Context>>blockReturnConstant: (in category 'instruction decoding') -----
- blockReturnConstant: value
- 	"Simulate the interpreter's action when a ReturnConstantToCaller bytecode is 
- 	 encountered in the receiver.  This should only happen in a closure activation."
- 	self assert: closureOrNil isClosure.
- 	^self return: value from: self!

Item was removed:
- ----- Method: Context>>blockReturnTop (in category 'instruction decoding') -----
- blockReturnTop
- 	"Simulate the interpreter's action when a ReturnTopOfStackToCaller bytecode is 
- 	 encountered in the receiver.  This should only happen in a closure activation."
- 	self assert: closureOrNil isClosure.
- 	^self return: self pop from: self!

Item was removed:
- ----- Method: Context>>bottomContext (in category 'query') -----
- bottomContext
- 	"Return the last context (the first context invoked) in my sender chain"
- 
- 	^ self findContextSuchThat: [:c | c sender isNil]!

Item was removed:
- ----- Method: Context>>callPrimitive: (in category 'instruction decoding') -----
- callPrimitive: primNumber
- 	"Evaluate the primitive, either normal or inlined, and answer the new context resulting from that
- 	 (either the sender if a successful non-inlined primitive, or the current context, if not)."
- 	| maybePrimFailToken |
- 	primNumber >= (1 << 15) ifTrue: "Inlined primitive, cannot fail"
- 		[^self callInlinedPrimitive: primNumber].
- 	maybePrimFailToken := self doPrimitive: primNumber
- 								method: method
- 								receiver: receiver
- 								args: self arguments.
- 	"Normal primitive. Always at the beginning of methods."
- 	(self isPrimFailToken: maybePrimFailToken) ifFalse: "On success return the result"
- 		[^self methodReturnTop].
- 	"On failure, store the error code if appropriate and keep interpreting the method"
- 	(method encoderClass isStoreAt: pc in: method) ifTrue:
- 		[self at: stackp put: maybePrimFailToken last].
- 	^self!

Item was removed:
- ----- Method: Context>>canHandleSignal: (in category 'private-exceptions') -----
- canHandleSignal: exception
- 	"Sent to handler (on:do:) contexts only.  If my exception class (first arg) handles exception then return true, otherwise forward this message to the next handler context.  If none left, return false (see nil>>canHandleSignal:)"
- 
- 	^ (self willHandleSignal: exception)
- 		or: [self nextHandlerContext canHandleSignal: exception].
- !

Item was removed:
- ----- Method: Context>>cannotReturn: (in category 'private-exceptions') -----
- cannotReturn: result
- 
- 	closureOrNil ifNotNil: [^ self cannotReturn: result to: self home sender].
- 	Processor debugWithTitle: 'Computation has been terminated!!' translated full: false.!

Item was removed:
- ----- Method: Context>>cannotReturn:to: (in category 'private') -----
- cannotReturn: result to: homeContext
- 	"The receiver tried to return result to homeContext that no longer exists."
- 
- 	^ BlockCannotReturn new
- 		result: result;
- 		deadHome: homeContext;
- 		signal!

Item was removed:
- ----- Method: Context>>client (in category 'accessing') -----
- client
- 	"Answer the client, that is, the object that sent the message that created this context."
- 
- 	^sender receiver!

Item was removed:
- ----- Method: Context>>closure (in category 'accessing') -----
- closure
- 	^closureOrNil!

Item was removed:
- ----- Method: Context>>completeCallee: (in category 'system simulation') -----
- completeCallee: aContext
- 	"Simulate the execution of bytecodes until a return to the receiver."
- 	| ctxt current ctxt1 |
- 	ctxt := aContext.
- 	[ctxt == current or: [ctxt hasSender: self]]
- 		whileTrue: 
- 			[current := ctxt.
- 			ctxt1 := ctxt quickStep.
- 			ctxt1 ifNil: [self halt].
- 			ctxt := ctxt1].
- 	^self stepToSendOrReturn!

Item was removed:
- ----- Method: Context>>contextForLocalVariables (in category 'accessing') -----
- contextForLocalVariables
- 	"Answer the context in which local variables (temporaries) are stored."
- 
- 	self flag: #ct. "Deprecate?"
- 	self subclassResponsibility!

Item was removed:
- ----- Method: Context>>contextStack (in category 'debugger access') -----
- contextStack 
- 	"Answer an Array of the contexts on the receiver's sender chain."
- 
- 	^self stackOfSize: 100000!

Item was removed:
- ----- Method: Context>>contextTag (in category 'closure support') -----
- contextTag
- 	"Context tags may be used for referring to contexts instead of contexts themselves as they can be copied and will continue to work in other processes (continuations). By default, we use the context itself to as its tag."
- 	^self!

Item was removed:
- ----- Method: Context>>copyStack (in category 'query') -----
- copyStack
- 
- 	^ self copyTo: nil!

Item was removed:
- ----- Method: Context>>copyTo: (in category 'query') -----
- copyTo: aContext
- 	"Copy self and my sender chain down to, but not including, aContext. End of copied chain will have nil sender. Assume that there is no loop in the context chain."
- 
- 	| currentContext senderContext copy |
- 	self == aContext ifTrue: [ ^nil ].
- 	currentContext := copy := self copy.
- 	[ 
- 		senderContext := currentContext sender ifNil: [ ^copy ].
- 		senderContext == aContext ifTrue: [ 
- 			currentContext privSender: nil.
- 			^copy ].
- 		senderContext := senderContext copy.
- 		currentContext privSender: senderContext.
- 		currentContext := senderContext ] repeat!

Item was removed:
- ----- Method: Context>>copyTo:bottomContextDo: (in category 'query') -----
- copyTo: aContext bottomContextDo: aBlock
- 	"Copy self and my sender chain down to, but not including, aContext.  End of copied chain will have nil sender. Evaluate aBlock with the copy of bottom context when it still points to the original sender."
- 
- 	| copy |
- 	self == aContext ifTrue: [ ^nil ].
- 	copy := self copy.
- 	sender
- 		ifNil: [ aBlock value: copy ]
- 		ifNotNil: [
- 			sender == aContext ifTrue: [ aBlock value: copy ].
- 			copy privSender: (sender copyTo: aContext bottomContextDo: aBlock) ].
- 	^copy!

Item was removed:
- ----- Method: Context>>cut: (in category 'private') -----
- cut: aContext
- 	"Cut aContext and its senders from my sender chain"
- 
- 	| ctxt callee |
- 	ctxt := self.
- 	[ctxt == aContext] whileFalse: [
- 		callee := ctxt.
- 		ctxt := ctxt sender.
- 		ctxt ifNil: [aContext ifNotNil: [self error: 'aContext not a sender']].
- 	].
- 	callee privSender: nil.
- !

Item was removed:
- ----- Method: Context>>deactivateHandler (in category 'private-exceptions') -----
- deactivateHandler
- 	"Private - sent to exception handler context only (on:do:)"
- 	
- 	stackp >= 3 ifTrue: [self tempAt: 3 put: false] "this is temporary handlerActive in #on:do:"!

Item was removed:
- ----- Method: Context>>depthBelow: (in category 'debugger access') -----
- depthBelow: aContext
- 	"Answer how many calls there are between this and aContext."
- 
- 	| this depth |
- 	this := self.
- 	depth := 0.
- 	[this == aContext or: [this == nil]]
- 		whileFalse:
- 			[this := this sender.
- 			depth := depth + 1].
- 	^depth!

Item was removed:
- ----- Method: Context>>directedSuperSend:numArgs: (in category 'instruction decoding') -----
- directedSuperSend: selector numArgs: numArgs
- 	"Simulate the action of bytecodes that send a message with selector, selector,
- 	 starting the message lookup in the superclass of the class on top of stack.
- 	 The arguments of the message are found in the next numArgs locations on
- 	 the stack and the receiver just below them."
- 
- 	| class receiver arguments |
- 	class := self pop.
- 	arguments := Array new: numArgs.
- 	numArgs to: 1 by: -1 do: [ :i | arguments at: i put: self pop].
- 	receiver := self pop.
- 	QuickStep == self ifTrue:
- 		[QuickStep := nil.
- 		^self quickSend: selector to: receiver with: arguments lookupIn: class superclass].
- 	^self send: selector to: receiver with: arguments lookupIn: class superclass!

Item was removed:
- ----- Method: Context>>disarmHandler (in category 'private-exceptions') -----
- disarmHandler
- 	"Private - sent to exception handler context only (on:do:)"
- 	
- 	stackp >= 4 ifTrue: [self tempAt: 4 put: false] "this is temporary handlerRearmed in #on:do:"!

Item was removed:
- ----- Method: Context>>doDup (in category 'instruction decoding') -----
- doDup
- 	"Simulate the action of a 'duplicate top of stack' bytecode."
- 
- 	self push: self top!

Item was removed:
- ----- Method: Context>>doPop (in category 'instruction decoding') -----
- doPop
- 	"Simulate the action of a 'remove top of stack' bytecode."
- 
- 	self pop!

Item was removed:
- ----- Method: Context>>doPrimitive:method:receiver:args: (in category 'private') -----
- doPrimitive: primitiveIndex method: meth receiver: receiver args: arguments
- 	"Simulate a primitive method whose index is primitiveIndex.  The simulated receiver and
- 	 arguments are given as arguments to this message. If successful, push result and return
- 	 resuming context, else ^ {errCode, PrimitiveFailToken}. Any primitive which provokes
- 	 execution needs to be intercepted and simulated to avoid execution running away."
- 
- 	| value |
- 	"Judicious use of primitive 19 (a null primitive that doesn't do anything) prevents
- 	 the debugger from entering various run-away activities such as spawning a new
- 	 process, etc.  Injudicious use results in the debugger not being able to debug
- 	 interesting code, such as the debugger itself.  Hence use primitive 19 with care :-)"
- 	"SystemNavigation new browseAllSelect: [:m| m primitive = 19]"
- 	primitiveIndex = 19 ifTrue: [
- 		[self notify: ('The code being simulated is trying to control a process ({1}). Process controlling cannot be simulated. If you proceed, things may happen outside the observable area of the simulator.' translated format: {meth reference})]
- 			ifCurtailed: [self push: nil "Cheap fix of the context's internal state"]].
- 	
- 	((primitiveIndex between: 201 and: 222)
- 	 and: [(self objectClass: receiver) includesBehavior: BlockClosure]) ifTrue:
- 		[(primitiveIndex = 206
- 		  or: [primitiveIndex = 208]) ifTrue:						"[Full]BlockClosure>>valueWithArguments:"
- 			[^receiver simulateValueWithArguments: arguments first caller: self].
- 		 ((primitiveIndex between: 201 and: 209)			 "[Full]BlockClosure>>value[:value:...]"
- 		  or: [primitiveIndex between: 221 and: 222]) ifTrue: "[Full]BlockClosure>>valueNoContextSwitch[:]"
- 			[^receiver simulateValueWithArguments: arguments caller: self]].
- 
- 	primitiveIndex = 83 ifTrue: "afr 9/11/1998 19:50" "Object>>perform:[with:...]"
- 		[| selector |
- 		selector := arguments at: 1 ifAbsent:
- 			[^ self class primitiveFailTokenFor: #'bad argument'].
- 		arguments size - 1 = selector numArgs ifFalse:
- 			[^ self class primitiveFailTokenFor: #'bad number of arguments'].
- 		^self send: selector to: receiver with: arguments allButFirst].
- 	primitiveIndex = 84 ifTrue: "afr 9/11/1998 19:50 & eem 8/18/2009 17:04" "Object>>perform:withArguments:"
- 		[| selector args |
- 		arguments size = 2 ifFalse:
- 			[^ self class primitiveFailTokenFor: #'bad argument'].
- 		selector := arguments first.
- 		args := arguments second.
- 		args isArray ifFalse:
- 			[^ self class primitiveFailTokenFor: #'bad argument'].
- 		args size = selector numArgs ifFalse:
- 			[^ self class primitiveFailTokenFor: #'bad number of arguments'].
- 		^self send: selector to: receiver with: args].
- 	primitiveIndex = 100 ifTrue: "eem 8/18/2009 16:57" "Object>>perform:withArguments:inSuperclass:"
- 		[| rcvr selector args superclass |
- 		arguments size
- 			caseOf: {
- 				[3] -> [
- 					rcvr := receiver.
- 					selector := arguments first.
- 					args := arguments second.
- 					superclass := arguments third].
- 				[4] -> ["mirror primitive"
- 					rcvr := arguments first.
- 					selector := arguments second.
- 					args := arguments third.
- 					superclass := arguments fourth] }
- 			otherwise: [^ self class primitiveFailTokenFor: #'bad number of arguments'].
- 		args isArray ifFalse:
- 			[^ self class primitiveFailTokenFor: #'bad argument'].
- 		args size = selector numArgs ifFalse:
- 			[^ self class primitiveFailTokenFor: #'bad number of arguments'].
- 		((self objectClass: rcvr) includesBehavior: superclass) ifFalse:
- 			[^ self class primitiveFailTokenFor: #'bad argument'].
- 		^self send: selector to: rcvr with: args lookupIn: superclass].
- 
- 	"Mutex>>primitiveEnterCriticalSection
- 	 Mutex>>primitiveTestAndSetOwnershipOfCriticalSection"
- 	(primitiveIndex = 186 or: [primitiveIndex = 187]) ifTrue:
- 		[| effective |
- 		 effective := Processor activeProcess effectiveProcess.
- 		 "active == effective"
- 		 value := primitiveIndex = 186
- 					ifTrue: [receiver primitiveEnterCriticalSectionOnBehalfOf: effective]
- 					ifFalse: [receiver primitiveTestAndSetOwnershipOfCriticalSectionOnBehalfOf: effective].
- 		 ^(self isPrimFailToken: value)
- 			ifTrue: [value]
- 			ifFalse: [self push: value]].
- 
- 	primitiveIndex = 188 ifTrue:	"Object>>withArgs:executeMethod:
- 									CompiledMethod class>>receiver:withArguments:executeMethod:
- 									VMMirror>>ifFail:object:with:executeMethod: et al"
- 		[| n args methodArg thisReceiver |
- 		 ((n := arguments size) between: 2 and: 4) ifFalse:
- 			[^self class primitiveFailTokenFor: #'unsupported operation'].
- 		 ((self objectClass: (args := arguments at: n - 1)) == Array
- 		  and: [(self objectClass: (methodArg := arguments at: n)) includesBehavior: CompiledMethod]) ifFalse:
- 			[^self class primitiveFailTokenFor: #'bad argument'].
- 		 methodArg numArgs = args size ifFalse:
- 			[^self class primitiveFailTokenFor: #'bad number of arguments'].
- 		 thisReceiver := arguments at: n - 2 ifAbsent: [receiver].
- 		 methodArg primitive > 0 ifTrue:
- 			[methodArg isQuick ifTrue:
- 				[^self push: (methodArg valueWithReceiver: thisReceiver arguments: args)].
- 			 ^self doPrimitive: methodArg primitive method: meth receiver: thisReceiver args: args].
- 		 ^self
- 			activateMethod: methodArg
- 			withArgs: args
- 			receiver: thisReceiver].
- 
- 	primitiveIndex = 118 ifTrue: "[receiver:]tryPrimitive:withArgs:; avoid recursing in the VM"
- 		[(arguments size = 3
- 		  and: [(self objectClass: arguments second) == SmallInteger
- 		  and: [(self objectClass: arguments last) == Array]]) ifTrue:
- 			[^self doPrimitive: arguments second method: meth receiver: arguments first args: arguments last].
- 		 (arguments size = 2
- 		 and: [(self objectClass: arguments first) == SmallInteger
- 		 and: [(self objectClass: arguments last) == Array]]) ifFalse:
- 			[^self class primitiveFailTokenFor: nil].
- 		 ^self doPrimitive: arguments first method: meth receiver: receiver args: arguments last].
- 
- 	value := primitiveIndex = 120 "FFI method"
- 				ifTrue: [(meth literalAt: 1) tryInvokeWithArguments: arguments]
- 				ifFalse:
- 					[primitiveIndex = 117 "named primitives"
- 						ifTrue: [self tryNamedPrimitiveIn: meth for: receiver withArgs: arguments]
- 						ifFalse: "should use self receiver: receiver tryPrimitive: primitiveIndex withArgs: arguments but this is only in later VMs (and appears to be broken)"
- 							[receiver tryPrimitive: primitiveIndex withArgs: arguments]].
- 
- 	^(self isPrimFailToken: value)
- 		ifTrue: [value]
- 		ifFalse: [self push: value]!

Item was removed:
- ----- Method: Context>>endPC (in category 'private') -----
- endPC
- 	^closureOrNil
- 		ifNil:	[self method endPC]
- 		ifNotNil: [closureOrNil endPC]!

Item was removed:
- ----- Method: Context>>exceptionMessage (in category 'accessing') -----
- exceptionMessage
- 	^ self selector caseOf: {
- 			[#doesNotUnderstand:] -> [self tempAt: 1].
- 			[#notYetImplemented] -> [self asMessage].
- 			[#shouldBeImplemented] -> [self asMessage].
- 			[#subclassResponsibility] -> [self asMessage]}
- 		otherwise: [self error: 'This context is not the result of a message exception.'].!

Item was removed:
- ----- Method: Context>>failPrimitiveWith: (in category 'system simulation') -----
- failPrimitiveWith: maybePrimFailToken
- 	"The receiver is a freshly-created context on a primitive method.  Skip the callPrimitive:
- 	 bytecode and store the primitive fail code if there is one and the method consumes it."
- 	self skipCallPrimitive.
- 	((self isPrimFailToken: maybePrimFailToken)
- 	  and: [method encoderClass isStoreAt: pc in: method]) ifTrue:
- 		[self at: stackp put: maybePrimFailToken last]!

Item was removed:
- ----- Method: Context>>findContextSuchThat: (in category 'query') -----
- findContextSuchThat: testBlock
- 	"Search self and my sender chain for first one that satisfies testBlock.  Return nil if none satisfy"
- 
- 	| ctxt |
- 	ctxt := self.
- 	[ctxt isNil] whileFalse: [
- 		(testBlock value: ctxt) ifTrue: [^ ctxt].
- 		ctxt := ctxt sender.
- 	].
- 	^ nil!

Item was removed:
- ----- Method: Context>>findNextHandlerContext (in category 'private-exceptions') -----
- findNextHandlerContext
- 	"find next context marked with <primitive: 199>.
- 	This can be either a handler context (on:do:),
- 	or a handling context (handleSignal:)"
- 
- 	^ self sender ifNotNil: [:ctx | ctx findNextHandlerContextStarting]!

Item was removed:
- ----- Method: Context>>findNextHandlerContextStarting (in category 'private-exceptions') -----
- findNextHandlerContextStarting
- 	"Return the next handler marked context, returning nil if there is none.  Search starts with self and proceeds up to nil."
- 
- 	| ctx |
- 	<primitive: 197>
- 	ctx := self.
- 		[ctx isHandlerContext ifTrue:[^ctx].
- 		(ctx := ctx sender) == nil ] whileFalse.
- 	^nil!

Item was removed:
- ----- Method: Context>>findNextUnwindContextUpTo: (in category 'private-exceptions') -----
- findNextUnwindContextUpTo: aContext
- 	"Return the next unwind marked above the receiver, returning nil if there is none.  Search proceeds up to but not including aContext."
- 
- 	| ctx |
- 	<primitive: 195>
- 	ctx := self.
- 	[(ctx := ctx sender) == nil or: [ctx == aContext]] whileFalse:
- 		[ ctx isUnwindContext ifTrue: [^ctx]].
- 	^nil!

Item was removed:
- ----- Method: Context>>findSecondToOldestSimilarSender (in category 'query') -----
- findSecondToOldestSimilarSender
- 	"Search the stack for the second-to-oldest occurance of self's method.  Very useful for an infinite recursion.  Gets back to the second call so you can see one complete recursion cycle, and how it was called at the beginning."
- 
- 	| sec ctxt bot |
- 	sec := self.
- 	ctxt := self.
- 	[	bot := ctxt findSimilarSender.
- 		bot isNil
- 	] whileFalse: [
- 		sec := ctxt.
- 		ctxt := bot.
- 	].
- 	^ sec
- !

Item was removed:
- ----- Method: Context>>findSimilarSender (in category 'query') -----
- findSimilarSender
- 	"Return the closest sender with the same method, return nil if none found"
- 
- 	| meth |
- 	meth := self method.
- 	self sender ifNil: [^nil].
- 	^ self sender findContextSuchThat: [:c | c method == meth]!

Item was removed:
- ----- Method: Context>>fireHandlerActionForSignal: (in category 'private-exceptions') -----
- fireHandlerActionForSignal: exception
- 	"Sent to handler (on:do:) contexts only.
- 	Perform the second argument, which is the handler action"
- 
- 	^(self tempAt: 2) cull: exception!

Item was removed:
- ----- Method: Context>>handleSignal: (in category 'private-exceptions') -----
- handleSignal: exception
- 	"Sent to handler (on:do:) contexts only.
- 	Execute the handler action block"
- 
- 	| val |
- 	<primitive: 199>  "just a marker, fail and execute the following"
- 	exception privHandlerContext: self contextTag.
- 	self deactivateHandler. "Prevent re-entering the action block, unless it is explicitely rearmed"
- 	val := [self fireHandlerActionForSignal: exception] ensure: [self reactivateHandler].
- 	self return: val  "return from self if not otherwise directed in handle block"!

Item was removed:
- ----- Method: Context>>hasContext: (in category 'query') -----
- hasContext: aContext 
- 	"Answer whether aContext is me or one of my senders"
- 
- 	^ (self findContextSuchThat: [:c | c == aContext]) notNil!

Item was removed:
- ----- Method: Context>>hasInstVarRef (in category 'accessing') -----
- hasInstVarRef
- 	"Answer whether the receiver references an instance variable."
- 
- 	^self method hasInstVarRef.!

Item was removed:
- ----- Method: Context>>hasMethodReturn (in category 'accessing') -----
- hasMethodReturn
- 	^closureOrNil hasMethodReturn!

Item was removed:
- ----- Method: Context>>hasSender: (in category 'controlling') -----
- hasSender: context 
- 	"Answer whether the receiver is strictly above context on the stack."
- 
- 	| s |
- 	self == context ifTrue: [^false].
- 	s := sender.
- 	[s == nil]
- 		whileFalse: 
- 			[s == context ifTrue: [^true].
- 			s := s sender].
- 	^false!

Item was removed:
- ----- Method: Context>>home (in category 'accessing') -----
- home 
- 	"Answer the context in which the receiver was defined."
- 
- 	closureOrNil == nil ifTrue:
- 		[^self].
- 	^closureOrNil outerContext home!

Item was removed:
- ----- Method: Context>>homeMethod (in category 'accessing') -----
- homeMethod
- 	"Answer the home method associated with the receiver.
- 	 This is polymorphic with BlockClosure, CompiledCode, etc"
- 	^method homeMethod!

Item was removed:
- ----- Method: Context>>insertSender: (in category 'private') -----
- insertSender: aContext
- 	"Insert aContext and its sender chain between me and my sender.  Return new callee of my original sender."
- 
- 	| ctxt |
- 	ctxt := aContext bottomContext.
- 	ctxt privSender: self sender.
- 	self privSender: aContext.
- 	^ ctxt!

Item was removed:
- ----- Method: Context>>instVarAt:put: (in category 'private') -----
- instVarAt: index put: value
- 	index = 3 ifTrue: [self stackp: value. ^ value].
- 	^ super instVarAt: index put: value!

Item was removed:
- ----- Method: Context>>isBottomContext (in category 'query') -----
- isBottomContext
- 	"Answer if this is the last context (the first context invoked) in my sender chain"
- 
- 	^sender isNil!

Item was removed:
- ----- Method: Context>>isClosureContext (in category 'closure support') -----
- isClosureContext
- 	^closureOrNil ~~ nil!

Item was removed:
- ----- Method: Context>>isContext (in category 'query') -----
- isContext
- 	^true!

Item was removed:
- ----- Method: Context>>isDead (in category 'query') -----
- isDead
- 	"Has self finished"
- 
- 	^ pc isNil!

Item was removed:
- ----- Method: Context>>isExecutingBlock (in category 'accessing') -----
- isExecutingBlock
- 	"Is this executing a block versus a method?  In the new closure
- 	 implemetation this is true if closureOrNil is not nil, in which case
- 	 it should be holding a BlockClosure."
- 
- 	^closureOrNil isClosure!

Item was removed:
- ----- Method: Context>>isHandlerActive (in category 'private-exceptions') -----
- isHandlerActive
- 	"Private - sent to exception handler context only (on:do:)"
- 	
- 	^stackp >= 3 and: [(self tempAt: 3) == true] "this is temporary handlerActive in #on:do:"!

Item was removed:
- ----- Method: Context>>isHandlerContext (in category 'private-exceptions') -----
- isHandlerContext
- 	"Answer if the receiver is for a method that is marked as an exception handler.
- 	 BlockClosure>>#on:do: uses this primitive to identify itself to the VM
- 	 as an exception handler method, which the VM uses in primitive 197
- 	 Context>>#findNextHandlerContextStarting, primitiveFindHandlerContext,
- 	 to accelerate the search for exception handlers."
- 	^method primitive = 199!

Item was removed:
- ----- Method: Context>>isHandlerRearmed (in category 'private-exceptions') -----
- isHandlerRearmed
- 	"Private - sent to exception handler context only (on:do:)"
- 	
- 	^stackp >= 4 and: [(self tempAt: 4) == true] "this is temporary handlerRearmed in #on:do:"!

Item was removed:
- ----- Method: Context>>isMethodContext (in category 'testing') -----
- isMethodContext
- 	^closureOrNil == nil!

Item was removed:
- ----- Method: Context>>isPrimFailToken: (in category 'private') -----
- isPrimFailToken: contextOrPrimFailToken
- 	"Answer if contextOrPrimFailToken, which will either be a Context object or
- 	 a primitive fail token (a tuple of the PrimitiveFailToken unique object and
- 	 a primitive failure code), is the latter. This should only be used with the
- 	 (possibly indirect) results of Context>>doPrimitive:method:receiver:args:"
- 	^ (self objectClass: contextOrPrimFailToken) == Array
- 	  and: [contextOrPrimFailToken size = 2
- 	  and: [(contextOrPrimFailToken at: 1) == PrimitiveFailToken]]!

Item was removed:
- ----- Method: Context>>isUnwindContext (in category 'private-exceptions') -----
- isUnwindContext
- 	"Answer if the receiver is for a method that is marked as a non-local return/exception unwind protect.
- 	 BlockClosure>>#ensure: and BlockClosure>>#ifCurtailed: use this primitive to identify
- 	 themseves to the VM as unwind protect methods. The VM uses this in primitive 195
- 	 Context>>#findNextUnwindContextUpTo:, primitiveFindNextUnwindContext, to
- 	 accelerate the search for unwind protects."
- 	^method primitive = 198!

Item was removed:
- ----- Method: Context>>jump (in category 'controlling') -----
- jump
- 	"Abandon thisContext and resume self instead (using the same current process).  You may want to save thisContext's sender before calling this so you can jump back to it.
- 	Self MUST BE a top context (ie. a suspended context or a abandoned context that was jumped out of).  A top context already has its return value on its stack (see Interpreter>>primitiveSuspend and other suspending primitives).
- 	thisContext's sender is converted to a top context (by pushing a nil return value on its stack) so it can be jump back to."
- 
- 	| top |
- 	"Make abandoned context a top context (has return value (nil)) so it can be jumped back to"
- 	thisContext sender push: nil.
- 
- 	"Pop self return value then return it to self (since we jump to self by returning to it)"
- 	stackp = 0 ifTrue: [self stepToSendOrReturn].
- 	stackp = 0 ifTrue: [self push: nil].  "must be quick return self/constant"
- 	top := self pop.
- 	thisContext privSender: self.
- 	^ top!

Item was removed:
- ----- Method: Context>>jump: (in category 'instruction decoding') -----
- jump: distance 
- 	"Simulate the action of a 'unconditional jump' bytecode whose offset is 
- 	the argument, distance."
- 
- 	pc := pc + distance!

Item was removed:
- ----- Method: Context>>jump:if: (in category 'instruction decoding') -----
- jump: distance if: condition 
- 	"Simulate the action of a 'conditional jump' bytecode whose offset is the 
- 	 argument, distance, and whose condition is the argument, condition."
- 
- 	| bool |
- 	bool := self pop.
- 	condition == bool
- 		ifTrue: [self jump: distance]
- 		ifFalse:
- 			[(true == bool or: [false == bool]) ifFalse:
- 				[^self send: #mustBeBooleanIn: to: bool with: {self}]]!

Item was removed:
- ----- Method: Context>>longStack (in category 'debugger access') -----
- longStack
- 	"Answer a String showing the top 100 contexts on my sender chain."
- 
- 	^ String streamContents:
- 		[:strm |
- 		(self stackOfSize: 100)
- 			do: [:item | strm print: item; cr]]!

Item was removed:
- ----- Method: Context>>method (in category 'accessing') -----
- method
- 
- 	^method!

Item was removed:
- ----- Method: Context>>methodClass (in category 'accessing') -----
- methodClass 
- 	"Answer the class in which the receiver's method was found."
- 	
- 	^self method methodClass ifNil: [self objectClass: self receiver].!

Item was removed:
- ----- Method: Context>>methodNode (in category 'accessing') -----
- methodNode
- 	^ self method methodNode.!

Item was removed:
- ----- Method: Context>>methodNodeFormattedAndDecorated: (in category 'accessing') -----
- methodNodeFormattedAndDecorated: decorate
- 	"Answer a method node made from pretty-printed (and colorized, if decorate is true) 
- 	 source text."
- 
- 	^ self method methodNodeFormattedAndDecorated: decorate.!

Item was removed:
- ----- Method: Context>>methodReturnConstant: (in category 'instruction decoding') -----
- methodReturnConstant: value
- 	"Simulate the action of a 'return constant' bytecode whose value is the
- 	 argument, value. This corresponds to a source expression like '^0'."
- 
- 	^self return: value from: self methodReturnContext!

Item was removed:
- ----- Method: Context>>methodReturnContext (in category 'accessing') -----
- methodReturnContext
- 	"Answer the context from which an ^-return should return from."
- 
- 	closureOrNil == nil ifTrue:
- 		[^self].
- 	^closureOrNil outerContext methodReturnContext!

Item was removed:
- ----- Method: Context>>methodReturnReceiver (in category 'instruction decoding') -----
- methodReturnReceiver
- 	"Simulate the action of a 'return receiver' bytecode. This corresponds to
- 	 the source expression '^self'."
- 
- 	^self return: self receiver from: self methodReturnContext!

Item was removed:
- ----- Method: Context>>methodReturnTop (in category 'instruction decoding') -----
- methodReturnTop
- 	"Simulate the action of a 'return top of stack' bytecode. This corresponds
- 	 to source expressions like '^something'."
- 
- 	^self return: self pop from: self methodReturnContext!

Item was removed:
- ----- Method: Context>>modificationForbiddenFor:at:put: (in category 'read-only objects') -----
- modificationForbiddenFor: target at: index put: anObject
- 	^(ModificationForbidden new
- 		mirror: self
- 		object: target
- 		index: index
- 		newValue: anObject
- 		retrySelector: #object:basicAt:put:) signal!

Item was removed:
- ----- Method: Context>>modificationForbiddenFor:at:putCharacter: (in category 'read-only objects') -----
- modificationForbiddenFor: target at: index putCharacter: aCharacter
- 	"eem 3/11/2020 13:09 this may be a mistake.  Instead perhaps String clients should
- 	 send asInteger and use modificationForbiddenFor:at:put:.  Opinions appreciated."
- 	^(ModificationForbidden new
- 		mirror: self
- 		object: target
- 		index: index
- 		newValue: (aCharacter isCharacter ifTrue: [aCharacter asInteger] ifFalse: [aCharacter])
- 		retrySelector: #object:basicAt:put:) signal!

Item was removed:
- ----- Method: Context>>modificationForbiddenFor:instVarAt:put: (in category 'read-only objects') -----
- modificationForbiddenFor: target instVarAt: index put: anObject
- 	^(ModificationForbidden new
- 		mirror: self
- 		object: target
- 		index: index
- 		newValue: anObject
- 		retrySelector: #object:instVarAt:put:) signal!

Item was removed:
- ----- Method: Context>>nextHandlerContext (in category 'private-exceptions') -----
- nextHandlerContext
- 	"Answer the next handler context (on:do:) in the call chain.
- 	Answer nil if none found"
- 	
- 	| handler |
- 	handler := self findNextHandlerContext.
- 	[handler ifNil: [^nil].
- 	handler selector == #handleSignal:]
- 		whileTrue: [handler := handler findNextHandlerContext].
- 	^handler!

Item was removed:
- ----- Method: Context>>nextHandlerContextForSignal: (in category 'private-exceptions') -----
- nextHandlerContextForSignal: exception
- 	"Answer the handler context (on:do:) for this exception
- 	Answer nil if none found"
- 	
- 	| handler priorHandler |
- 	handler := self.
- 	[(handler := handler findNextHandlerContext) ifNil: [^nil].
- 	handler selector == #handleSignal:]
- 		whileFalse: [(handler willHandleSignal: exception) ifTrue: [^handler]].
- 
- 	"exception has been signalled in the scope of another signal handler (while #handleSignal:)
- 	Check for a rearmed inner handler. If none, jump to outer handler context."
- 	priorHandler := (handler tempAt: 1) "the exception argument to handleSignal:"
- 		privHandlerContext.
- 	
- 	[(handler := handler nextHandlerContext) ifNil: [^nil].
- 	(handler isHandlerRearmed and: [handler willHandleSignal: exception]) ifTrue: [^handler].
- 	handler == priorHandler] whileFalse.
- 
- 	^priorHandler nextHandlerContextForSignal: exception!

Item was removed:
- ----- Method: Context>>numArgs (in category 'accessing') -----
- numArgs
- 	"Answer the number of arguments for this activation."
- 	^closureOrNil
- 		ifNil: [method numArgs]
- 		ifNotNil: [closureOrNil numArgs]!

Item was removed:
- ----- Method: Context>>numTemps (in category 'accessing') -----
- numTemps
- 	"Answer the number of temporaries for this activation; this includes
- 	 the number of arguments, and for blocks, the number of copied values."
- 	^closureOrNil
- 		ifNil: [method numTemps]
- 		ifNotNil: [closureOrNil numTemps]!

Item was removed:
- ----- Method: Context>>object:basicAt: (in category 'mirror primitives') -----
- object: anObject basicAt: index 
- 	"Answer the value of an indexable element in the argument anObject without sending
- 	 it a message. Fail if the argument index is not an Integer or is out of bounds, or if
- 	 anObject is not indexable. This mimics the action of the VM when it indexes an object.
- 	 Used to simulate the execution machinery by, for example, the debugger.
- 	 Primitive.  See Object documentation whatIsAPrimitive."
- 
- 	<primitive: 60>
- 	index isInteger ifTrue: [self errorSubscriptBounds: index].
- 	index isNumber
- 		ifTrue: [^self object: anObject basicAt: index asInteger]
- 		ifFalse: [self errorNonIntegerIndex]!

Item was removed:
- ----- Method: Context>>object:basicAt:put: (in category 'mirror primitives') -----
- object: anObject basicAt: index put: value 
- 	"Store the last argument value in the indexable element of the argument anObject
- 	 indicated by index without sending anObject a message. Fail if the argument index
- 	 is not an Integer or is out of bounds, or if anObject is not indexable, or if anObject is
- 	 read-only, or if value is an inappropriate value for anObject's indexable slots.
- 	 This mimics the action of the VM when it indexes an object. Used to simulate
- 	 the execution machinery by, for example, the debugger.
- 	 Primitive.  See Object documentation whatIsAPrimitive."
- 
- 	<primitive: 61 error: ec>
- 	index isInteger ifTrue:
- 		[(index >= 1 and: [index <= (self objectSize: anObject)])
- 			ifTrue:
- 				[ec == #'no modification' ifTrue:
- 					[^self modificationForbiddenFor: anObject at: index put: value].
- 				 self errorImproperStore]
- 			ifFalse: [self errorSubscriptBounds: index]].
- 	index isNumber ifTrue:
- 		[^self object: anObject basicAt: index asInteger put: value].
- 	self errorNonIntegerIndex!

Item was removed:
- ----- Method: Context>>object:eqeq: (in category 'mirror primitives') -----
- object: anObject eqeq: anOtherObject 
- 	"Answer whether the first and second arguments are the same object (have the
- 	 same object pointer) without sending a message to the first argument.  This
- 	 mimics the action of the VM when it compares two object pointers.  Used to
- 	 simulate the execution machinery by, for example, the debugger.
- 	 Primitive.  See Object documentation whatIsAPrimitive."
- 
- 	<primitive: 110>
- 	self primitiveFailed!

Item was removed:
- ----- Method: Context>>object:instVarAt: (in category 'mirror primitives') -----
- object: anObject instVarAt: anIndex
- 	"Primitive. Answer a fixed variable in an object. The numbering of the 
- 	 variables corresponds to the named instance variables. Fail if the index 
- 	 is not an Integer or is not the index of a fixed variable. Essential for the
- 	 debugger. See  Object documentation whatIsAPrimitive."
- 
- 	<primitive: 173 error: ec>
- 	self primitiveFailed!

Item was removed:
- ----- Method: Context>>object:instVarAt:put: (in category 'mirror primitives') -----
- object: anObject instVarAt: anIndex put: aValue 
- 	"Primitive. Store a value into a fixed variable in the argument anObject.
- 	 The numbering of the variables corresponds to the named instance
- 	 variables.  Fail if the index is not an Integer or is not the index of a
- 	 fixed variable, or if anObject is read-only.  Answer the value stored as
- 	 the result. Using this message violates the  principle that each object
- 	 has sovereign control over the storing of values into its instance variables.
- 	 Essential for the debugger. See Object documentation whatIsAPrimitive."
- 
- 	<primitive: 174 error: ec>
- 	ec == #'no modification' ifTrue:
- 		[^self modificationForbiddenFor: anObject instVarAt: anIndex put: aValue].
- 	self primitiveFailed!

Item was removed:
- ----- Method: Context>>object:perform:withArguments:inClass: (in category 'mirror primitives') -----
- object: anObject perform: selector withArguments: argArray inClass: lookupClass
- 	"Send the selector, aSymbol, to anObject with arguments in argArray.
- 	 Fail if the number of arguments expected by the selector 
- 	 does not match the size of argArray, or if lookupClass
- 	 cannot be found among the anObject's superclasses.
- 	 Primitive. Essential for the debugger."
- 
- 	<primitive: 100 error: error>
- 	(selector isSymbol) ifFalse:
- 		[^self error: 'selector argument must be a Symbol'].
- 	(argArray isMemberOf: Array) ifFalse:
- 		[^self error: 'argArray must be an Array'].
- 	(selector numArgs = argArray size)
- 		ifFalse: [^self error: 'incorrect number of arguments'].
- 	((self objectClass: anObject) == lookupClass
- 	 or: [(self objectClass: anObject) inheritsFrom: lookupClass]) ifFalse:
- 		[^self error: 'lookupClass is not in anObject''s inheritance chain'].
- 	self primitiveFailed!

Item was removed:
- ----- Method: Context>>objectClass: (in category 'mirror primitives') -----
- objectClass: anObject
- 	"Answer the class of the argument anObject without sending it a message.
- 	 This mimics the action of the VM when it fetches an object's class.  Used to
- 	 simulate the execution machinery by, for example, the debugger.
- 	 Primitive.  See Object documentation whatIsAPrimitive."
- 
- 	<primitive: 111>
- 	self primitiveFailed!

Item was removed:
- ----- Method: Context>>objectSize: (in category 'mirror primitives') -----
- objectSize: anObject
- 	"Answer the number of indexable variables in the argument anObject without sending
- 	 it a message. This mimics the action of the VM when it fetches an object's variable size.
- 	 Used to simulate the execution machinery by, for example, the debugger.
- 	 Primitive.  See Object documentation whatIsAPrimitive."
- 
- 	<primitive: 62>
- 	"The number of indexable fields of fixed-length objects is 0"
- 	^0!

Item was removed:
- ----- Method: Context>>outerContext (in category 'accessing') -----
- outerContext
- 	"Answer the context within which the receiver is nested."
- 
- 	^closureOrNil ifNotNil:
- 		[closureOrNil outerContext]!

Item was removed:
- ----- Method: Context>>pc (in category 'accessing') -----
- pc
- 	"Answer the index of the next bytecode to be executed."
- 
- 	^pc!

Item was removed:
- ----- Method: Context>>pop (in category 'controlling') -----
- pop
- 	"Answer the top of the receiver's stack and remove the top of the stack."
- 	| val |
- 	val := self at: stackp.
- 	self stackp: stackp - 1.
- 	^ val!

Item was removed:
- ----- Method: Context>>popIntoLiteralVariable: (in category 'instruction decoding') -----
- popIntoLiteralVariable: value 
- 	"Simulate the action of bytecode that removes the top of the stack and 
- 	 stores it into a literal variable of my method. If the receiver is read-only
- 	 this will provoke a send of #attemptToAssign:withIndex:"
- 
- 	| top result |
- 	top := self pop.
- 	result := self simulatedObject: value instVarAt: ValueIndex put: top.
- 	^(self object: result eqeq: top)
- 		ifTrue: [self]
- 		ifFalse: [result]!

Item was removed:
- ----- Method: Context>>popIntoReceiverVariable: (in category 'instruction decoding') -----
- popIntoReceiverVariable: offset 
- 	"Simulate the action of bytecode that removes the top of the stack and 
- 	 stores it into an instance variable of my receiver. If the receiver is read-only
- 	 this will provoke a send of #attemptToAssign:withIndex:"
- 
- 	| top result |
- 	top := self pop.
- 	result := self simulatedObject: self receiver instVarAt: offset + 1 put: top.
- 	^(self object: result eqeq: top)
- 		ifTrue: [self]
- 		ifFalse: [result]!

Item was removed:
- ----- Method: Context>>popIntoRemoteTemp:inVectorAt: (in category 'instruction decoding') -----
- popIntoRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
- 	"Simulate the action of bytecode that removes the top of the stack and  stores
- 	 it into an offset in one of my local variables being used as a remote temp vector."
- 
- 	self object: (self at: tempVectorIndex + 1) basicAt: remoteTempIndex + 1 put: self pop!

Item was removed:
- ----- Method: Context>>popIntoTemporaryVariable: (in category 'instruction decoding') -----
- popIntoTemporaryVariable: offset 
- 	"Simulate the action of bytecode that removes the top of the stack and 
- 	stores it into one of my temporary variables."
- 
- 	self at: offset + 1 put: self pop!

Item was removed:
- ----- Method: Context>>printDetails: (in category 'printing') -----
- printDetails: strm
- 	"Put my class>>selector and instance variables and arguments and temporaries on the stream.  Protect against errors during printing."
- 
- 	| pe str pos |
- 	self printOn: strm.
- 	strm cr.
- 	strm tab; nextPutAll: 'Receiver: '.
- 	pe := '<<error during printing>>'.
- 	strm nextPutAll: ([receiver printStringLimitedTo: 90] ifError: [:err :rcvr | pe]).
- 
- 	strm cr; tab; nextPutAll: 'Arguments and temporary variables: '; cr.
- 	str := [(self tempsAndValuesLimitedTo: 80 indent: 2) 
- 				padded: #right to: 1 with: $x] ifError: [:err :rcvr | pe].
- 	strm nextPutAll: (str allButLast).
- 
- 	strm cr; tab; nextPutAll: 'Receiver''s instance variables: '; cr.
- 	pos := strm position.
- 	[receiver longPrintOn: strm limitedTo: 80 indent: 2] ifError: [:err :rcvr | 
- 				strm nextPutAll: pe].
- 	pos = strm position ifTrue: ["normal printString for an Array (it has no inst vars)"
- 		strm nextPutAll: ([receiver printStringLimitedTo: 90] ifError: [:err :rcvr | pe])].
- 	strm peekLast == Character cr ifFalse: [strm cr].!

Item was removed:
- ----- Method: Context>>printOn: (in category 'printing') -----
- printOn: aStream
- 	| class mclass selector |
- 	method ifNil:
- 		[^super printOn: aStream].
- 
- 	closureOrNil ifNotNil:
- 		[aStream nextPutAll: '[] in '.
- 		 closureOrNil outerContext ifNotNil:
- 			[:outer|
- 			 outer printOn: aStream.
- 			 ^self]].
- 
- 	class := self objectClass: self receiver.
- 	mclass := method methodClass.
- 	selector := method selector ifNil: [method defaultSelector].
- 
- 	aStream nextPutAll: class name.
- 	mclass ~~ class ifTrue:
- 		[aStream nextPut: $(; nextPutAll: mclass name; nextPut: $)].
- 	aStream nextPutAll: '>>'; nextPutAll: selector.
- 
- 	(selector == #doesNotUnderstand:
- 	 and: [(self objectClass: (self tempAt: 1)) == Message]) ifTrue:
- 		[aStream space.
- 		(self tempAt: 1) selector printOn: aStream]!

Item was removed:
- ----- Method: Context>>printString (in category 'printing') -----
- printString
- 	"Answer an emphasized string in case of a breakpoint method"
- 
- 	^(self method notNil and: [self method hasBreakpoint])
- 		ifTrue:[(super printString , ' [break]') asText allBold]
- 		ifFalse:[super printString]!

Item was removed:
- ----- Method: Context>>privRefresh (in category 'initialize-release') -----
- privRefresh
- 	"Reinitialize the receiver so that it is in the state it was at its creation."
- 
- 	closureOrNil
- 		ifNotNil:
- 			[closureOrNil isFullBlock
- 				ifTrue:
- 					[pc := method initialPC.
- 					 self stackp: method numTemps.
- 					 closureOrNil numArgs + closureOrNil numCopiedValues + 1 to: method numTemps do:
- 						[:i | self tempAt: i put: nil]]
- 				ifFalse: "In non-full blocks temps are established by push btecodes"
- 					[pc := closureOrNil startpc.
- 					 self stackp: closureOrNil numArgs + closureOrNil numCopiedValues].
- 			 1 to: closureOrNil numCopiedValues do:
- 				[:i | self tempAt: closureOrNil numArgs + i put: (closureOrNil at: i)]]
- 		ifNil:
- 			[pc := method initialPC.
- 			 self stackp: method numTemps.
- 			 method numArgs + 1 to: method numTemps do:
- 				[:i | self tempAt: i put: nil]]!

Item was removed:
- ----- Method: Context>>privRefreshWith: (in category 'initialize-release') -----
- privRefreshWith: aCompiledMethod 
- 	"Reinitialize the receiver as though it had been for a different method. 
- 	 Used by a Debugger when one of the methods to which it refers is 
- 	 recompiled."
- 
- 	aCompiledMethod isCompiledMethod ifFalse:
- 		[self error: 'method can only be set to aCompiledMethod'].
- 	method := aCompiledMethod.
- 	self assert: closureOrNil == nil.
- 	"was: receiverMap := nil."
- 	self privRefresh!

Item was removed:
- ----- Method: Context>>privSender: (in category 'private') -----
- privSender: aContext 
- 
- 	sender := aContext!

Item was removed:
- ----- Method: Context>>push: (in category 'controlling') -----
- push: val 
- 	"Push val on the receiver's stack."
- 
- 	self stackp: stackp + 1.
- 	self at: stackp put: val!

Item was removed:
- ----- Method: Context>>push:fromIndexable: (in category 'private') -----
- push: numObjects fromIndexable: anIndexableCollection
- 	"Push the elements of anIndexableCollection onto the receiver's stack.
- 	 Do not call directly.  Called indirectly by {1. 2. 3} constructs."
- 
- 	1 to: numObjects do:
- 		[:i | self push: (anIndexableCollection at: i)]!

Item was removed:
- ----- Method: Context>>pushActiveContext (in category 'instruction decoding') -----
- pushActiveContext
- 	"Simulate the action of bytecode that pushes the the active context on the 
- 	top of its own stack."
- 
- 	self push: self!

Item was removed:
- ----- Method: Context>>pushArgs:from: (in category 'system simulation') -----
- pushArgs: args "<Array>" from: sendr "<Context>" 
- 	"Helps simulate action of the value primitive for closures.
- 	 This is used by ContextPart>>runSimulated:contextAtEachStep:"
- 
- 	closureOrNil
- 		ifNil: [self error: 'context needs a closure!!']
- 		ifNotNil:
- 			["See BlockClosure>>asContextWithSender:"
- 			 stackp ~= (closureOrNil numArgs + closureOrNil numCopiedValues) ifTrue:
- 				[self error: 'stack pointer is incorrect!!'].].
- 
- 	1 to: closureOrNil numArgs do:
- 		[:i| self at: i put: (args at: i)].
- 	sender := sendr!

Item was removed:
- ----- Method: Context>>pushClosureCopyNumCopiedValues:numArgs:blockSize: (in category 'instruction decoding') -----
- pushClosureCopyNumCopiedValues: numCopied numArgs: numArgs blockSize: blockSize
- 	"Simulate the action of a 'closure copy' bytecode whose result is the
- 	 new BlockClosure for the following code"
- 	| copiedValues |
- 	numCopied > 0
- 		ifTrue:
- 			[copiedValues := Array new: numCopied.
- 			 numCopied to: 1 by: -1 do:
- 				[:i|
- 				copiedValues at: i put: self pop]]
- 		ifFalse:
- 			[copiedValues := nil].
- 	self push: ((BlockClosure new: numCopied)
- 				outerContext: self
- 				startpc: pc
- 				numArgs: numArgs
- 				copiedValues: copiedValues).
- 	self jump: blockSize!

Item was removed:
- ----- Method: Context>>pushConsArrayWithElements: (in category 'instruction decoding') -----
- pushConsArrayWithElements: numElements 
- 	| array |
- 	array := Array new: numElements.
- 	numElements to: 1 by: -1 do:
- 		[:i|
- 		array at: i put: self pop].
- 	self push: array!

Item was removed:
- ----- Method: Context>>pushConstant: (in category 'instruction decoding') -----
- pushConstant: value 
- 	"Simulate the action of bytecode that pushes the constant, value, on the 
- 	top of the stack."
- 
- 	self push: value!

Item was removed:
- ----- Method: Context>>pushFullClosure:numCopied: (in category 'instruction decoding') -----
- pushFullClosure: aCompiledBlock numCopied: numCopied
- 	"Simulate the action of a 'closure copy' bytecode whose result is the
- 	 new FullBlockClosure for the supplied compiled block."
- 	| copiedValues |
- 	numCopied > 0
- 		ifTrue:
- 			[copiedValues := Array new: numCopied.
- 			 numCopied to: 1 by: -1 do:
- 				[:i|
- 				copiedValues at: i put: self pop]]
- 		ifFalse:
- 			[copiedValues := nil].
- 	self push: ((FullBlockClosure new: numCopied)
- 				receiver: receiver
- 				outerContext: self
- 				method: aCompiledBlock
- 				copiedValues: copiedValues)!

Item was removed:
- ----- Method: Context>>pushLiteralVariable: (in category 'instruction decoding') -----
- pushLiteralVariable: value 
- 	"Simulate the action of bytecode that pushes the contents of the literal 
- 	variable whose index is the argument, index, on the top of the stack."
- 
- 	self push: (self object: value instVarAt: ValueIndex)!

Item was removed:
- ----- Method: Context>>pushNewArrayOfSize: (in category 'instruction decoding') -----
- pushNewArrayOfSize: arraySize 
- 	self push: (Array new: arraySize)!

Item was removed:
- ----- Method: Context>>pushReceiver (in category 'instruction decoding') -----
- pushReceiver
- 	"Simulate the action of bytecode that pushes the active context's receiver 
- 	on the top of the stack."
- 
- 	self push: self receiver!

Item was removed:
- ----- Method: Context>>pushReceiverVariable: (in category 'instruction decoding') -----
- pushReceiverVariable: offset 
- 	"Simulate the action of bytecode that pushes the contents of the receiver's 
- 	instance variable whose index is the argument, index, on the top of the 
- 	stack."
- 
- 	self push: (self object: self receiver instVarAt: offset + 1)!

Item was removed:
- ----- Method: Context>>pushRemoteTemp:inVectorAt: (in category 'instruction decoding') -----
- pushRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
- 	"Simulate the action of bytecode that pushes the value at remoteTempIndex
- 	 in one of my local variables being used as a remote temp vector."
- 	self push: (self object: (self at: tempVectorIndex + 1) basicAt: remoteTempIndex + 1)!

Item was removed:
- ----- Method: Context>>pushSpecialConstant: (in category 'instruction decoding implicit literals') -----
- pushSpecialConstant: value 
- 	"Simulate the action of bytecode that pushes the constant, value, on the 
- 	top of the stack."
- 
- 	self push: value!

Item was removed:
- ----- Method: Context>>pushTemporaryVariable: (in category 'instruction decoding') -----
- pushTemporaryVariable: offset 
- 	"Simulate the action of bytecode that pushes the contents of the 
- 	temporary variable whose index is the argument, index, on the top of 
- 	the stack."
- 
- 	self push: (self at: offset + 1)!

Item was removed:
- ----- Method: Context>>quickSend:to:with:lookupIn: (in category 'controlling') -----
- quickSend: selector to: rcvr with: arguments lookupIn: lookupClass
- 	"Send the given selector with arguments in an environment which closely resembles
- 	 the non-simulating environment, with an interjected unwind-protected block to catch
- 	 nonlocal returns.  Attention: don't get lost!!  This beautiful method is originally due to
- 	 Hans-Martin Mosner."
- 	| oldSender contextToReturnTo result |
- 	contextToReturnTo := self.
- 	[oldSender := thisContext sender swapSender: self.
- 	 result := self object: rcvr perform: selector withArguments: arguments inClass: lookupClass.
- 	 thisContext sender swapSender: oldSender] ifCurtailed:
- 		[contextToReturnTo := thisContext sender receiver.	"The block context returning nonlocally"
- 		contextToReturnTo pc: contextToReturnTo previousPc.	"skip to front of return bytecode causing this unwind"
- 		contextToReturnTo willReturnTopFromMethod ifTrue:
- 			"If it was a returnTop, push the value to be returned.
- 			Otherwise the value is implicit in the bytecode"
- 			[contextToReturnTo push: (thisContext sender tempAt: 1)].
- 		thisContext swapSender: thisContext home sender.	"Make this block return to the method's sender"
- 		contextToReturnTo].
- 	contextToReturnTo push: result.
- 	^contextToReturnTo!

Item was removed:
- ----- Method: Context>>quickStep (in category 'system simulation') -----
- quickStep
- 	"If the next instruction is a send, just perform it.
- 	Otherwise, do a normal step."
- 
- 	self willReallySend ifTrue: [QuickStep := self].
- 	^self step!

Item was removed:
- ----- Method: Context>>reactivateHandler (in category 'private-exceptions') -----
- reactivateHandler
- 	"Private - sent to exception handler context only (on:do:)"
- 	
- 	stackp >= 3 ifTrue: [self tempAt: 3 put: true] "this is temporary handlerActive in #on:do:"!

Item was removed:
- ----- Method: Context>>readDataFrom:size: (in category 'objects from disk') -----
- readDataFrom: aDataStream size: varsOnDisk
- 	"Fill in the fields of self based on the contents of aDataStream.  Answer self.
- 	 Read in the instance-variables written by Object>>storeDataOn:.
- 	 NOTE: This method must send beginReference: before reading any objects from aDataStream that might reference it.
- 	 Allow aDataStream to have fewer inst vars.  See SmartRefStream.
- 	 Override to not store nil stack contents beyond stack pointer."
- 	| cntInstVars cntIndexedVars |
- 
- 	cntInstVars := self class instSize.
- 	cntIndexedVars := varsOnDisk - cntInstVars.
- 	cntIndexedVars < 0 ifTrue:
- 		[self error: 'Class has changed too much.  Define a convertxxx method'].
- 
- 	aDataStream beginReference: self.
- 	1 to: cntInstVars do:
- 		[:i | self instVarAt: i put: aDataStream next].
- 	1 to: stackp do:
- 		[:i | self basicAt: i put: aDataStream next].
- 	stackp + 1 to: cntIndexedVars do:
- 		[:i | aDataStream next ~~ nil ifTrue:
- 			[self error: 'Reading a Context''s contents expects only nil beyond top of stack']].
- 	"Total number read MUST be equal to varsOnDisk!!"
- 	^self	"If we ever answer something other than self, fix calls 
- 			on (super readDataFrom: aDataStream size: anInteger)"!

Item was removed:
- ----- Method: Context>>rearmHandler (in category 'private-exceptions') -----
- rearmHandler
- 	"Private - sent to exception handler context only (on:do:)"
- 	
- 	self reactivateHandler.
- 	stackp >= 4 ifTrue: [self tempAt: 4 put: true] "this is temporary handlerRearmed in #on:do:"!

Item was removed:
- ----- Method: Context>>rearmHandlerDuring: (in category 'private-exceptions') -----
- rearmHandlerDuring: aBlock
- 	"Sent to handler (on:do:) contexts only. Makes me re-entrant for the duration of aBlock. Only works in a closure-enabled image"
- 
- 	^ [self rearmHandler. aBlock value]
- 		ensure: [self disarmHandler]!

Item was removed:
- ----- Method: Context>>receiver (in category 'accessing') -----
- receiver
- 	"Answer the receiver of the message that created this context."
- 
- 	^receiver!

Item was removed:
- ----- Method: Context>>receiver: (in category 'private-exceptions') -----
- receiver: r
- 
- 	receiver := r!

Item was removed:
- ----- Method: Context>>receiver:tryPrimitive:withArgs: (in category 'private') -----
- receiver: receiver tryPrimitive: primIndex withArgs: argumentArray
- 	"Invoke the primitive with number primIndex, with the receiver and arguments
- 	 supplied, answering its result, or, if the primiitve fails, the error code."
- 
- 	<primitive: 118 error: errorCode>
- 	^self class primitiveFailTokenFor: errorCode!

Item was removed:
- ----- Method: Context>>release (in category 'debugger access') -----
- release
- 	"Remove information from the receiver and all of the contexts on its 
- 	sender chain in order to break circularities."
- 
- 	self releaseTo: nil!

Item was removed:
- ----- Method: Context>>releaseTo: (in category 'debugger access') -----
- releaseTo: caller 
- 	"Remove information from the receiver and the contexts on its sender 
- 	chain up to caller in order to break circularities."
- 
- 	| c s |
- 	c := self.
- 	[c == nil or: [c == caller]]
- 		whileFalse: 
- 			[s := c sender.
- 			c singleRelease.
- 			c := s]!

Item was removed:
- ----- Method: Context>>removeSelf (in category 'accessing') -----
- removeSelf
- 	"Nil the receiver pointer and answer its former value."
- 
- 	| tempSelf |
- 	tempSelf := receiver.
- 	receiver := nil.
- 	^tempSelf!

Item was removed:
- ----- Method: Context>>restart (in category 'controlling') -----
- restart
- 	"Unwind thisContext to self and resume from beginning.  Execute unwind blocks when unwinding.  ASSUMES self is a sender of thisContext"
- 
- 	| ctxt unwindBlock |
- 	self isDead ifTrue: [self cannotReturn: nil to: self].
- 	self privRefresh.
- 	ctxt := thisContext.
- 	[	ctxt := ctxt findNextUnwindContextUpTo: self.
- 		ctxt isNil
- 	] whileFalse: [
- 		(ctxt tempAt: 2) ifNil:[
- 			ctxt tempAt: 2 put: true.
- 			unwindBlock := ctxt tempAt: 1.
- 			thisContext terminateTo: ctxt.
- 			unwindBlock value].
- 	].
- 	thisContext terminateTo: self.
- 	self jump.
- !

Item was removed:
- ----- Method: Context>>restartWithNewReceiver: (in category 'private-exceptions') -----
- restartWithNewReceiver: obj
- 	receiver := obj.
- 	self restart!

Item was removed:
- ----- Method: Context>>resume (in category 'controlling') -----
- resume
- 	"Roll back thisContext to self and resume.  Execute unwind blocks when rolling back.  ASSUMES self is a sender of thisContext"
- 
- 	self resume: nil!

Item was removed:
- ----- Method: Context>>resume: (in category 'controlling') -----
- resume: value
- 	"Unwind thisContext to self and resume with value as result of last send.  Execute unwind blocks when unwinding.  ASSUMES self is a sender of thisContext"
- 
- 	^self resumeEvaluating: [value]
- !

Item was removed:
- ----- Method: Context>>resume:through: (in category 'controlling') -----
- resume: value through: firstUnwindCtxt
- 	"Unwind thisContext to self and resume with value as result of last send.
- 	 Execute any unwind blocks while unwinding.
- 	 ASSUMES self is a sender of thisContext."
- 
- 	| ctxt unwindBlock |
- 	self isDead ifTrue: [self cannotReturn: value to: self].
- 	ctxt := firstUnwindCtxt.
- 	[ctxt isNil] whileFalse:
- 		[(ctxt tempAt: 2) ifNil:
- 			[ctxt tempAt: 2 put: true.
- 			 unwindBlock := ctxt tempAt: 1.
- 			 thisContext terminateTo: ctxt.
- 			 unwindBlock value].
- 		 ctxt := ctxt findNextUnwindContextUpTo: self].
- 	thisContext terminateTo: self.
- 	^value
- !

Item was removed:
- ----- Method: Context>>resumeEvaluating: (in category 'controlling') -----
- resumeEvaluating: aBlock
- 	"Unwind thisContext to self and resume with value as result of last send. 
- 	Execute unwind blocks when unwinding.
- 	ASSUMES self is a sender of thisContext"
- 
- 	| ctxt unwindBlock |
- 	self isDead ifTrue: [self cannotReturn: aBlock value to: self].
- 	ctxt := thisContext.
- 	[	ctxt := ctxt findNextUnwindContextUpTo: self.
- 		ctxt isNil
- 	] whileFalse: [
- 		(ctxt tempAt: 2) ifNil:[
- 			"(tempAt: 2) refers to complete temporary in ensure: and ifCurtailed:
- 			or any other method marked with <primitive: 198>"
- 			ctxt tempAt: 2 put: true.
- 			unwindBlock := ctxt tempAt: 1.
- 			thisContext terminateTo: ctxt.
- 			unwindBlock value].
- 	].
- 	thisContext terminateTo: self.
- 	^ aBlock value
- !

Item was removed:
- ----- Method: Context>>return (in category 'controlling') -----
- return
- 	"Unwind until my sender is on top"
- 
- 	self return: self receiver!

Item was removed:
- ----- Method: Context>>return: (in category 'controlling') -----
- return: value
- 	"Unwind thisContext to self and return value to self's sender.  Execute any unwind blocks while unwinding.  ASSUMES self is a sender of thisContext"
- 
- 	sender ifNil: [self cannotReturn: value to: sender].
- 	sender resume: value!

Item was removed:
- ----- Method: Context>>return:from: (in category 'instruction decoding') -----
- return: value from: aSender 
- 	"For simulation.  Roll back self to aSender and return value from it.  Execute any unwind blocks on the way.  ASSUMES aSender is a sender of self"
- 
- 	| newTop |
- 	aSender isDead ifTrue:
- 		[^self send: #cannotReturn: to: self with: {value}].
- 	newTop := aSender sender.
- 	(self findNextUnwindContextUpTo: newTop) ifNotNil:
- 		[:unwindProtectCtxt|
- 		 self flag: #knownBug. "Cannot #stepOver '^2' in example '[^2] ensure: []'.
- 		 See http://lists.squeakfoundation.org/pipermail/squeak-dev/2022-June/220975.html"
- 		 ^self send: #aboutToReturn:through: to: self with: {value. unwindProtectCtxt}].
- 	self releaseTo: newTop.
- 	newTop ifNotNil: [newTop push: value].
- 	^newTop!

Item was removed:
- ----- Method: Context>>return:through: (in category 'controlling') -----
- return: value through: firstUnwindContext
- 	"Unwind thisContext to self and return value to self's sender.
- 	 Execute any unwind blocks while unwinding.
- 	 ASSUMES self is a sender of thisContext."
- 
- 	sender ifNil: [self cannotReturn: value to: sender].
- 	sender resume: value through: firstUnwindContext!

Item was removed:
- ----- Method: Context>>return:to: (in category 'controlling') -----
- return: value to: sendr 
- 	"Simulate the return of value to sendr."
- 
- 	self releaseTo: sendr.
- 	sendr ifNil: [^ nil].
- 	^ sendr push: value!

Item was removed:
- ----- Method: Context>>returnEvaluating: (in category 'controlling') -----
- returnEvaluating: aBlock
- 	"Unwind thisContext to self and return aBlock value to self's sender.
- 	Execute any unwind blocks while unwinding.
- 	ASSUMES self is a sender of thisContext"
- 
- 	sender ifNil: [self cannotReturn: aBlock value to: sender].
- 	sender resumeEvaluating: aBlock!

Item was removed:
- ----- Method: Context>>runSimulated:contextAtEachStep: (in category 'system simulation') -----
- runSimulated: aBlock contextAtEachStep: anotherBlock
- 	"Simulate the execution of the argument, aBlock, until it ends or is curtailed. If any exception is signaled during the execution, simulate it being handled on the present caller stack. Evaluate anotherBlock with the current context prior to each instruction executed. Answer the simulated value of aBlock."
- 
- 	| current resume ensure |
- 	resume := false.
- 	"Affect the context stack of the receiver during the simulation of aBlock."
- 	current := aBlock asContextWithSender: self.
- 	"Insert outer context denoting the end of the simulation."
- 	ensure := (ensure := current) insertSender: (Context contextEnsure:
- 		[resume := true.
- 		ensure privSender: thisContext home sender]).
- 	
- 	(anotherBlock numArgs = 0
- 		ifTrue: ["optimized" [resume]]
- 		ifFalse: ["stop execution on time, don't expose simulation details to caller"
- 			[current == ensure or: 
- 				["Context >> #resume:"
- 				current size >= 2 and: 
- 					[(current at: 2) == ensure]]]	])
- 		whileFalse:
- 			[anotherBlock cull: current.
- 			current := current step].
- 	
- 	"Continue with the execution in the previous context."
- 	^ current jump!

Item was removed:
- ----- Method: Context>>runUntilErrorOrReturnFrom: (in category 'controlling') -----
- runUntilErrorOrReturnFrom: aSender 
- 	"ASSUMES aSender is a sender of self.  Execute self's stack until aSender returns or an unhandled exception is raised.  Return a pair containing the new top context and a possibly nil exception.  The exception is not nil if it was raised before aSender returned and it was not handled.  The exception is returned rather than openning the debugger, giving the caller the choice of how to handle it."
- 	"Self is run by jumping directly to it (the active process abandons thisContext and executes self).  However, before jumping to self we insert an ensure block under aSender that jumps back to thisContext when evaluated.  We also insert an exception handler under aSender that jumps back to thisContext when an unhandled exception is raised.  In either case, the inserted ensure and exception handler are removed once control jumps back to thisContext."
- 
- 	| error ctxt here topContext |
- 	here := thisContext.
- 
- 	"Insert ensure and exception handler contexts under aSender"
- 	error := nil.
- 	ctxt := aSender insertSender: (Context
- 		contextOn: UnhandledError do: [:ex |
- 			error ifNil: [
- 				error := ex exception.
- 				topContext := thisContext.
- 				ex resumeUnchecked: here jump]
- 			ifNotNil: [ex pass]
- 		]).
- 	ctxt := ctxt insertSender: (Context
- 		contextEnsure: [error ifNil: [
- 				topContext := thisContext.
- 				here jump]
- 		]).
- 	self jump.  "Control jumps to self"
- 
- 	"Control resumes here once above ensure block or exception handler is executed"
- 	^ error ifNil: [
- 		"No error was raised, remove ensure context by stepping until popped"
- 		[ctxt isDead] whileFalse: [topContext := topContext stepToCallee].
- 		{topContext. nil}
- 
- 	] ifNotNil: [
- 		"Error was raised, remove inserted above contexts then return signaler context"
- 		aSender terminateTo: ctxt sender.  "remove above ensure and handler contexts"
- 		{topContext. error}
- 	]!

Item was removed:
- ----- Method: Context>>runUntilReturnFrom: (in category 'private-exceptions') -----
- runUntilReturnFrom: aContext
- 	"Run the receiver (which must be its stack top context) until aContext returns. Avoid a context that cannot return.
- 	 Note: to avoid infinite recursion of MNU error inside unwind blocks, implement e.g. a wrapper around the message
- 	 sentTo: receiver in #doesNotUnderstand:. Note: This method is a trivialized version of #runUntilErrorOrReturnFrom:
- 	 and was intended to be used by #unwindTo as a helper method to unwind non-local returns inside unwind blocks."
- 
- 	| here unwindBottom newTop |
- 	here := thisContext.
- 	"Avoid a context that cannot return between self and aContext (see Note 1 below)."
- 	unwindBottom := self findContextSuchThat: [:ctx | ctx == aContext or: [ctx selector = #cannotReturn:]].
- 	newTop := unwindBottom sender.
- 	"Insert ensure context under unwindBottom in self's stack (see Note 2 below)"
- 	unwindBottom insertSender: (Context contextEnsure: [here jump]).
- 	self jump.  "Control jumps to the receiver's stack (see Note 2 below)"
- 	"Control resumes here once the above inserted ensure block is executed (see #jump comments)"
- 	^newTop  "Return the new top context (see Note 3 below)"
- 
- 	"Note 1: returning from #cannotReturn's sender would crash the VM so we install a guard ensure context right
- 	 above it; after returning here the unwind will continue safely. Try running and debugging this example
- 	 (avoid Proceeding the BCR error though; it may indeed crash the image):
- 	 [[[] ensure: [^2]] ensure: [^42]] fork"
- 
- 	"Note 2: the receiver (self) is run by jumping directly to it (the active process abandons thisContext and executes
- 	 self on its own stack; self must be its top context). However, before jumping to self we insert an ensure block under
- 	 unwindBottom context that will execute a jump back to thisContext when evaluated. The inserted guard ensure
- 	 context is removed once control jumps back to thisContext."
- 
- 	"Note 3: it doesn't matter newTop is not a proper stack top context because #unwindTo will only use it as a starting
- 	 point in the search for the next unwind context and the computation will never return here. We could make newTop
- 	 a proper top context by pushing nil to its stack (^newTop push: nil) if need be (see #jump comments).
- 	 Cf. the pattern in #runUntilErrorOrReturnFrom:: removing the inserted ensure context by stepping until popped
- 	 when executing non-local returns wouldn't work here and would fail tests testTerminateInNestedEnsureWithReturn1
- 	 through 4."!

Item was removed:
- ----- Method: Context>>secondFromBottom (in category 'query') -----
- secondFromBottom
- 	"Return the second from bottom of my sender chain"
- 
- 	self sender ifNil: [^ nil].
- 	^ self findContextSuchThat: [:c | c sender sender isNil]!

Item was removed:
- ----- Method: Context>>selector (in category 'accessing') -----
- selector
- 	"Answer the selector of the method that created the receiver."
- 
- 	^self method selector ifNil: [self method defaultSelector].!

Item was removed:
- ----- Method: Context>>selectorCategory (in category 'accessing') -----
- selectorCategory
- 	"Answer the category to which this message belongs (relative to the receiver).
- 	 If no superclass categorises this message, use the default."
- 	| rcvrClass organizers |
- 	rcvrClass := self objectClass: self receiver.
- 	organizers := rcvrClass withAllSuperclasses collect: [:ea | ea organization].
- 	organizers addFirst: rcvrClass organization.
- 	^(organizers collect: [ :org | org categoryOfElement: self selector])
- 			detect: [:ea | ea ~= ClassOrganizer default and: [ea ~= nil]]
- 			ifNone: [ClassOrganizer default]!

Item was removed:
- ----- Method: Context>>send:super:numArgs: (in category 'instruction decoding') -----
- send: selector super: superFlag numArgs: numArgs
- 	"Simulate the action of bytecodes that send a message with selector, 
- 	 selector. The argument, superFlag, tells whether the receiver of the 
- 	 message was specified with 'super' in the source method. The arguments 
- 	 of the message are found in the top numArgs locations on the stack and 
- 	 the receiver just below them."
- 
- 	| thisReceiver arguments lookupClass |
- 	arguments := Array new: numArgs.
- 	numArgs to: 1 by: -1 do: [ :i | arguments at: i put: self pop].
- 	thisReceiver := self pop.
- 	lookupClass := superFlag
- 					ifTrue: [method methodClassAssociation value superclass]
- 					ifFalse: [self objectClass: thisReceiver].
- 	QuickStep == self ifTrue:
- 		[QuickStep := nil.
- 		^self quickSend: selector to: thisReceiver with: arguments lookupIn: lookupClass].
- 	^self send: selector to: thisReceiver with: arguments lookupIn: lookupClass!

Item was removed:
- ----- Method: Context>>send:to:with: (in category 'controlling') -----
- send: selector to: rcvr with: arguments
- 	"Simulate the action of sending a message with selector arguments to rcvr."
- 
- 	^self send: selector to: rcvr with: arguments lookupIn: (self objectClass: rcvr)!

Item was removed:
- ----- Method: Context>>send:to:with:lookupIn: (in category 'controlling') -----
- send: selector to: rcvr with: arguments lookupIn: lookupClass
- 	"Simulate the action of sending a message with selector and arguments to rcvr. The argument, lookupClass, is the class in which to lookup the message. This is the receiver's class for normal messages, but for super messages it will be some specific class related to the source method."
- 
- 	| meth primIndex val ctxt |
- 	(meth := lookupClass lookupSelector: selector) ifNil:
- 		[selector == #doesNotUnderstand: ifTrue:
- 			[self error: 'Recursive message not understood!!' translated].
- 		^self send: #doesNotUnderstand:
- 				to: rcvr
- 				with: {(Message selector: selector arguments: arguments) lookupClass: lookupClass}
- 				lookupIn: lookupClass].
- 	
- 	(self objectClass: meth) isCompiledCodeClass ifFalse:
- 		["Object as Methods (OaM) protocol: 'The contract is that, when the VM encounters an ordinary object (rather than a compiled method) in the method dictionary during lookup, it sends it the special selector #run:with:in: providing the original selector, arguments, and receiver.'. DOI: 10.1145/2991041.2991062."
- 		^self send: #run:with:in:
- 			to: meth
- 			with: {selector. arguments. rcvr}].
- 	
- 	meth numArgs = arguments size ifFalse:
- 		[^ self error: ('Wrong number of arguments in simulated message {1}' translated format: {selector})].
- 	(primIndex := meth primitive) > 0 ifTrue:
- 		[val := self doPrimitive: primIndex method: meth receiver: rcvr args: arguments.
- 		(self isPrimFailToken: val) ifFalse:
- 			[^val]].
- 	
- 	ctxt := self activateMethod: meth withArgs: arguments receiver: rcvr.
- 	(primIndex isInteger and: [primIndex > 0]) ifTrue:
- 		[ctxt failPrimitiveWith: val].
- 	
- 	^ctxt!

Item was removed:
- ----- Method: Context>>sendSpecial:numArgs: (in category 'instruction decoding implicit literals') -----
- sendSpecial: selector numArgs: numArgs
- 	"Simulate the action of bytecodes that send a message with selector, 
- 	 selector. The arguments  of the message are found in the top numArgs
- 	 locations on the stack and the receiver just below them."
- 
- 	| thisReceiver arguments lookupClass |
- 	arguments := Array new: numArgs.
- 	numArgs to: 1 by: -1 do: [ :i | arguments at: i put: self pop].
- 	thisReceiver := self pop.
- 	lookupClass := self objectClass: thisReceiver.
- 	QuickStep == self ifTrue:
- 		[QuickStep := nil.
- 		^self quickSend: selector to: thisReceiver with: arguments lookupIn: lookupClass].
- 	^self send: selector to: thisReceiver with: arguments lookupIn: lookupClass!

Item was removed:
- ----- Method: Context>>sender (in category 'accessing') -----
- sender
- 	"Answer the context that sent the message that created the receiver."
- 
- 	^sender!

Item was removed:
- ----- Method: Context>>setSender:receiver:method:arguments: (in category 'private') -----
- setSender: s receiver: r method: m arguments: args 
- 	"Create the receiver's initial state."
- 
- 	sender := s.
- 	receiver := r.
- 	method := m.
- 	closureOrNil := nil.
- 	pc := method initialPC.
- 	self stackp: method numTemps.
- 	1 to: args size do: [:i | self at: i put: (args at: i)]!

Item was removed:
- ----- Method: Context>>setSender:receiver:method:closure:startpc: (in category 'private') -----
- setSender: s receiver: r method: m closure: c startpc: startpc
- 	"Create the receiver's initial state."
- 
- 	sender := s.
- 	receiver := r.
- 	method := m.
- 	closureOrNil := c.
- 	pc := startpc.
- 	stackp := 0!

Item was removed:
- ----- Method: Context>>shortStack (in category 'debugger access') -----
- shortStack
- 	"Answer a String showing the top ten contexts on my sender chain."
- 
- 	^ String streamContents:
- 		[:strm |
- 		(self stackOfSize: 10)
- 			do: [:item | strm print: item; cr]]!

Item was removed:
- ----- Method: Context>>simulatedObject:instVarAt:put: (in category 'read-only objects') -----
- simulatedObject: anObject instVarAt: anIndex put: aValue 
- 	"Primitive. Store a value into a fixed variable in the argument anObject.
- 	 The numbering of the variables corresponds to the named instance
- 	 variables.  Fail if the index is not an Integer or is not the index of a
- 	 fixed variable, or if anObject is read-only. This version correctly simulates
- 	 assigning to a read-only object. Answer the value stored as the result.
- 	 Using this message violates the  principle that each object has sovereign
- 	 control over the storing of values into its instance variables. Essential for
- 	 the debugger. See Object documentation whatIsAPrimitive."
- 
- 	<primitive: 174 error: ec>
- 	ec == #'no modification' ifTrue:
- 		[^self send: #attemptToAssign:to:withIndex: to: self with: {aValue. anObject. anIndex} lookupIn: self class].
- 	self primitiveFailed!

Item was removed:
- ----- Method: Context>>singleRelease (in category 'debugger access') -----
- singleRelease
- 	"Remove information from the receiver in order to break circularities."
- 
- 	stackp == nil ifFalse: [1 to: stackp do: [:i | self at: i put: nil]].
- 	sender := nil.
- 	pc := nil.
- !

Item was removed:
- ----- Method: Context>>size (in category 'accessing') -----
- size
- 	"Primitive. Answer the number of indexable variables in the receiver. 
- 	This value is the same as the largest legal subscript. Essential. See Object 
- 	documentation whatIsAPrimitive.  Override the default primitive to give latitude to
- 	 the VM in context management."
- 
- 	<primitive: 212>
- 	"The number of indexable fields of fixed-length objects is 0"
- 	^self primitiveFailed!

Item was removed:
- ----- Method: Context>>sourceCode (in category 'accessing') -----
- sourceCode
- 	^self method getSource.
- 	
- 	"Note: The above is a bit safer than
- 		^ methodClass sourceCodeAt: selector
- 	which may fail if the receiver's method has been changed in
- 	the debugger (e.g., the method is no longer in the methodDict
- 	and thus the above selector is something like #Doit:with:with:with:)
- 	but the source code is still available."!

Item was removed:
- ----- Method: Context>>stack (in category 'debugger access') -----
- stack 
- 	"Answer an Array of the contexts on the receiver's sender chain."
- 
- 	^self stackOfSize: 9999!

Item was removed:
- ----- Method: Context>>stackOfSize: (in category 'debugger access') -----
- stackOfSize: limit 
- 	"Answer an OrderedCollection of the top 'limit' contexts
- 	 on the receiver's sender chain."
- 
- 	| stack ctxt |
- 	stack := OrderedCollection new.
- 	stack addLast: (ctxt := self).
- 	[(ctxt := ctxt sender) ~~ nil
- 	 and: [stack size < limit]] whileTrue:
- 		[stack addLast: ctxt].
- 	^stack!

Item was removed:
- ----- Method: Context>>stackPtr (in category 'private') -----
- stackPtr  "For use only by the SystemTracer and the Debugger, Inspectors etc"
- 	^ stackp!

Item was removed:
- ----- Method: Context>>stackp: (in category 'private') -----
- stackp: newStackp
- 	"Storing into the stack pointer is a potentially dangerous thing.
- 	This primitive stores nil into any cells that become accessible as a result,
- 	and it performs the entire operation atomically."
- 	"Once this primitive is implemented, failure code should cause an error"
- 
- 	<primitive: 76>
- 	self error: 'stackp store failure'.
- "
- 	stackp == nil ifTrue: [stackp := 0].
- 	newStackp > stackp  'effectively checks that it is a number'
- 		ifTrue: [oldStackp := stackp.
- 				stackp := newStackp.
- 				'Nil any newly accessible cells'
- 				oldStackp + 1 to: stackp do: [:i | self at: i put: nil]]
- 		ifFalse: [stackp := newStackp]
- "!

Item was removed:
- ----- Method: Context>>startpc (in category 'private') -----
- startpc
- 	^closureOrNil
- 		ifNil:	[self method initialPC]
- 		ifNotNil: [closureOrNil startpc]!

Item was removed:
- ----- Method: Context>>step (in category 'system simulation') -----
- step
- 	"Simulate the execution of the receiver's next bytecode. Answer the 
- 	context that would be the active context after this bytecode."
- 
- 	^self interpretNextInstructionFor: self!

Item was removed:
- ----- Method: Context>>stepToCallee (in category 'system simulation') -----
- stepToCallee
- 	"Step to callee or sender"
- 
- 	| ctxt |
- 	ctxt := self.
- 	[(ctxt := ctxt step) == self] whileTrue.
- 	^ ctxt!

Item was removed:
- ----- Method: Context>>stepToSendOrReturn (in category 'system simulation') -----
- stepToSendOrReturn
- 	"Simulate the execution of bytecodes until either sending a message or 
- 	 returning a value to the receiver (that is, until switching contexts)."
- 
- 	| ctxt |
- 	[self willReallySend or: [self willReturn or: [self willReallyStore]]] whileFalse:
- 		[ctxt := self step.
- 		 ctxt == self ifFalse:
- 			[self halt. 
- 			 "Caused by mustBeBoolean handling"
- 			 ^ctxt]]!

Item was removed:
- ----- Method: Context>>storeDataOn: (in category 'objects from disk') -----
- storeDataOn: aDataStream
- 	"Contexts are not always allowed go to out in DataStreams.  They must be included inside an ImageSegment,
- 	 or be being saved for a closure."
- 	| cntInstVars cntIndexedVars |
- 
- 	(aDataStream insideASegment
- 	 or: [(Notification new tag: self; signal) == self]) ifFalse: "or perhaps ImageSegments were not used at all"
- 		[self error: 'This Context was not included in the ImageSegment'].
- 
- 	cntInstVars := self class instSize.
- 	cntIndexedVars := self method frameSize.
- 	aDataStream
- 		beginInstance: self class
- 		size: cntInstVars + cntIndexedVars.
- 	 1 to: cntInstVars do:
- 		[:i | aDataStream nextPut: (self instVarAt: i)].
- 	1 to: stackp do:
- 		[:i | aDataStream nextPut: (self basicAt: i)].
- 	stackp + 1 to: cntIndexedVars do:
- 		[:i | aDataStream nextPut: nil]!

Item was removed:
- ----- Method: Context>>storeIntoLiteralVariable: (in category 'instruction decoding') -----
- storeIntoLiteralVariable: value 
- 	"Simulate the action of bytecode that stores the top of the stack into a 
- 	literal variable of my method. If the receiver is read-only
- 	 this will provoke a send of #attemptToAssign:withIndex:"
- 
- 	| top result |
- 	top := self top.
- 	result := self simulatedObject: value instVarAt: ValueIndex put: top.
- 	^(self object: result eqeq: top)
- 		ifTrue: [self]
- 		ifFalse: [result]!

Item was removed:
- ----- Method: Context>>storeIntoReceiverVariable: (in category 'instruction decoding') -----
- storeIntoReceiverVariable: offset 
- 	"Simulate the action of bytecode that stores the top of the stack into an 
- 	instance variable of my receiver. If the receiver is read-only
- 	 this will provoke a send of #attemptToAssign:withIndex:"
- 
- 	| top result |
- 	top := self top.
- 	result := self simulatedObject: self receiver instVarAt: offset + 1 put: top.
- 	^(self object: result eqeq: top)
- 		ifTrue: [self]
- 		ifFalse: [result]!

Item was removed:
- ----- Method: Context>>storeIntoRemoteTemp:inVectorAt: (in category 'instruction decoding') -----
- storeIntoRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
- 	"Simulate the action of bytecode that stores the top of the stack at
- 	 an offset in one of my local variables being used as a remote temp vector."
- 
- 	self object: (self at: tempVectorIndex + 1) basicAt: remoteTempIndex + 1 put: self top!

Item was removed:
- ----- Method: Context>>storeIntoTemporaryVariable: (in category 'instruction decoding') -----
- storeIntoTemporaryVariable: offset 
- 	"Simulate the action of bytecode that stores the top of the stack into one 
- 	of my temporary variables."
- 
- 	self at: offset + 1 put: self top!

Item was removed:
- ----- Method: Context>>swapReceiver: (in category 'private-exceptions') -----
- swapReceiver: r
- 	| oldReceiver |
- 	oldReceiver := receiver.
- 	receiver := r.
- 	^oldReceiver!

Item was removed:
- ----- Method: Context>>swapSender: (in category 'debugger access') -----
- swapSender: coroutine 
- 	"Replace the receiver's sender with coroutine and answer the receiver's 
- 	previous sender. For use in coroutining."
- 
- 	| oldSender |
- 	oldSender := sender.
- 	sender := coroutine.
- 	^oldSender!

Item was removed:
- ----- Method: Context>>tempAt: (in category 'accessing') -----
- tempAt: index 
- 	"Answer the value of the temporary variable whose index is the 
- 	 argument, index.  Primitive. Assumes receiver is indexable. Answer the
- 	 value of an indexable element in the receiver. Fail if the argument index
- 	 is not an Integer or is out of bounds. Essential. See Object documentation
- 	 whatIsAPrimitive.  Override the default at: primitive to give latitude to the
- 	 VM in context management."
- 
- 	<primitive: 210>
- 	^self at: index!

Item was removed:
- ----- Method: Context>>tempAt:put: (in category 'accessing') -----
- tempAt: index put: value 
- 	"Store the argument, value, as the temporary variable whose index is the 
- 	 argument, index.  Primitive. Assumes receiver is indexable. Answer the
- 	 value of an indexable element in the receiver. Fail if the argument index
- 	 is not an Integer or is out of bounds. Essential. See Object documentation
- 	 whatIsAPrimitive.  Override the default at:put: primitive to give latitude to
- 	 the VM in context management."
- 
- 	<primitive: 211>
- 	^self at: index put: value!

Item was removed:
- ----- Method: Context>>terminate (in category 'controlling') -----
- terminate
- 	"Make myself unresumable."
- 
- 	sender := nil.
- 	pc := nil.
- !

Item was removed:
- ----- Method: Context>>terminateTo: (in category 'controlling') -----
- terminateTo: previousContext
- 	"Terminate all the Contexts between me and previousContext, if previousContext is on my Context stack. Make previousContext my sender."
- 
- 	| currentContext sendingContext |
- 	<primitive: 196>
- 	(self hasSender: previousContext) ifTrue: [
- 		currentContext := sender.
- 		[currentContext == previousContext] whileFalse: [
- 			sendingContext := currentContext sender.
- 			currentContext terminate.
- 			currentContext := sendingContext]].
- 	sender := previousContext!

Item was removed:
- ----- Method: Context>>top (in category 'controlling') -----
- top
- 	"Answer the top of the receiver's stack."
- 
- 	^self at: stackp!

Item was removed:
- ----- Method: Context>>tryNamedPrimitiveIn:for:withArgs: (in category 'private') -----
- tryNamedPrimitiveIn: aCompiledMethod for: aReceiver withArgs: arguments
- 	"Invoke the named primitive for aCompiledMethod, answering its result, or,
- 	 if the primiitve fails, answering the error code."
- 	<primitive: 218 error: ec>
- 	ec ifNotNil:
- 		["If ec is an integer other than -1 there was a problem with primitive 218,
- 		  not with the external primitive itself.  -1 indicates a generic failure (where
- 		  ec should be nil) but ec = nil means primitive 218 is not implemented.  So
- 		  interpret -1 to mean the external primitive failed with a nil error code."
- 		 ec isInteger ifTrue:
- 			[ec = -1
- 				ifTrue: [ec := nil]
- 				ifFalse: [self primitiveFailed]]].
- 	^self class primitiveFailTokenFor: ec!

Item was removed:
- ----- Method: Context>>unwindTo: (in category 'private-exceptions') -----
- unwindTo: aContext
- 	"Unwind the receiver to aContext to execute all pending unwind blocks."
- 
- 	self unwindTo: aContext safely: true!

Item was removed:
- ----- Method: Context>>unwindTo:safely: (in category 'private-exceptions') -----
- unwindTo: aContext safely: aBoolean
- 	"Unwind self to aContext to execute pending #ensure:/#ifCurtailed: argument blocks between self
- 	 and aContext. If aBoolean is false, unwind only blocks that have not run yet, otherwise complete all
- 	 pending unwind blocks including those currently in the middle of their execution; these blocks will
- 	 just finish their execution. Run all unwinds on their original stack using #runUntilReturnFrom:."
- 	
- 	| top ctx |
- 	ctx := top := self.
- 	aBoolean ifTrue: [
- 	"If self is the top context of a stack already halfways through an unwind block, complete the outer-most
- 	 unfinished unwind block first; all nested pending unwind blocks will be completed in the process;
- 	 see testTerminationDuringUnwind and tests in ProcessTest/UnwindTest.
- 	 Note: Halfway-through blocks have already set the complete variable (ctxt tempAt: 2) in their
- 	 defining #ensure:/#ifCurtailed contexts from nil to true; we'll search for the bottom-most one."
- 		| outerMost |
- 		ctx isUnwindContext ifFalse: [ctx := ctx findNextUnwindContextUpTo: aContext].
- 		[ctx isNil] whileFalse: [
- 			(ctx tempAt: 2) ifNotNil: [
- 				outerMost := ctx].
- 			ctx := ctx findNextUnwindContextUpTo: aContext].
- 		outerMost ifNotNil: [top := top runUntilReturnFrom: outerMost]].
- 		"By now no halfway-through unwind blocks are on the stack. 
- 		 Note: top points to the former outerMost sender now, i.e. to the next context to be explored."
- 
- 	ctx := top ifNil: [^self].
- 	"#findNextUnwindContextUpTo: starts searching from the receiver's sender so we must check
- 	 the receiver explicitly whether it is an unwind context; see testTerminateEnsureAsStackTop.
- 	 Create a new top context (i.e. a new branch off the original stack) for each pending unwind block
- 	 (ctxt tempAt: 1) and execute it on the unwind block's stack to evaluate non-local returns correctly."
- 	ctx isUnwindContext ifFalse: [ctx := ctx findNextUnwindContextUpTo: aContext].
- 	[ctx isNil] whileFalse: [
- 		(ctx tempAt: 2) ifNil: [
- 			ctx tempAt: 2 put: true.
- 			top := (ctx tempAt: 1) asContextWithSender: ctx.
- 			top runUntilReturnFrom: top].
- 		ctx := ctx findNextUnwindContextUpTo: aContext]
- 	"Note: Cf. the unwind pattern in the previous versions of unwindTo: (1999-2021). Using #value
- 	 instead of #runUntilReturnFrom: lead to a failure to evaluate some non-local returns correctly;
- 	 a non-local return must be evaluated in the evaluation context (sender chain) in which it was defined."!

Item was removed:
- ----- Method: Context>>willHandleSignal: (in category 'private-exceptions') -----
- willHandleSignal: exception
- 	"Sent to handler (on:do:) contexts only."
- 
- 	^self isHandlerActive and: [(self tempAt: 1) handles: exception]
- !

Item was removed:
- Object subclass: #Delay
- 	instanceVariableNames: 'delayDuration resumptionTime delaySemaphore beingWaitedOn'
- 	classVariableNames: 'AccessProtect ActiveDelay DelaySuspended FinishedDelay RunTimerEventLoop ScheduledDelay SuspendedDelays TimerEventLoop TimingSemaphore'
- 	poolDictionaries: ''
- 	category: 'Kernel-Processes'!
- 
- !Delay commentStamp: 'eem 1/5/2016 11:58' prior: 0!
- I am the main way that a process may pause for some amount of time.  The simplest usage is like this:
- 
- 	(Delay forSeconds: 5) wait.
- 
- An instance of Delay responds to the message 'wait' by suspending the caller's process for a certain amount of time. The duration of the pause is specified when the Delay is created with the message forMilliseconds: or forSeconds:. A Delay can be used again when the current wait has finished. For example, a clock process might repeatedly wait on a one-second Delay.
- 
- A delay in progress when an image snapshot is saved is resumed when the snapshot is re-started.
- For a more complex example, see  #testDelayOf:for:rect: .
- 
- A word of advice:
- This is THE highest priority code which is run in Squeak, in other words it is time-critical. The speed of this code is critical for accurate responses, it is critical for network services, it affects every last part of the system.
- 
- In short: Don't fix it if it ain't broken!! This code isn't supposed to be beautiful, it's supposed to be fast!! The reason for duplicating code is to make it fast. The reason for not using ifNil:[]ifNotNil:[] is that the compiler may not inline those. Since the effect of changes are VERY hard to predict it is best to leave things as they are for now unless there is an actual need to change anything
- 
- 
- Instance Variables
- 	beingWaitedOn:		<UndefinedObject|Boolean>
- 	delayDuration:			<Integer>
- 	delaySemaphore:		<Semaphore>
- 	resumptionTime:		<Integer>
- 
- beingWaitedOn
- 	- this is set when the delay is being waited on or is unscheduled.
- 
- delayDuration
- 	- the duration of the delay in milliseconds
- 
- delaySemaphore
- 	- the semaphore used to suspend process(es) waiting on this delay
- 
- resumptionTime
- 	- the value of the UTC miscrosecond clock at which the delay should resume processes waiting on it'!

Item was removed:
- ----- Method: Delay class>>anyActive (in category 'testing') -----
- anyActive
- 	"Return true if there is any delay currently active"
- 	^ActiveDelay notNil!

Item was removed:
- ----- Method: Delay class>>cleanUp (in category 'class initialization') -----
- cleanUp
- 
- 	self initialize.!

Item was removed:
- ----- Method: Delay class>>forDuration: (in category 'instance creation') -----
- forDuration: aDuration
- 
- 	^ self forMilliseconds: aDuration asMilliSeconds
- !

Item was removed:
- ----- Method: Delay class>>forMilliseconds: (in category 'instance creation') -----
- forMilliseconds: anInteger
- 	"Return a new Delay for the given number of milliseconds. Sending 'wait' to this Delay will cause the sender's process to be suspended for approximately that length of time."
- 
- 	anInteger < 0 ifTrue: [self error: 'delay times cannot be negative'].
- 	^ self new
- 		setDelay: anInteger asInteger
- 		forSemaphore: Semaphore new
- !

Item was removed:
- ----- Method: Delay class>>forSeconds: (in category 'instance creation') -----
- forSeconds: aNumber
- 	"Return a new Delay for the given number of seconds. Sending 'wait' to this Delay will cause the sender's process to be suspended for approximately that length of time."
- 
- 	aNumber < 0 ifTrue: [self error: 'delay times cannot be negative'].
- 	^ self new
- 		setDelay: (aNumber * 1000) asInteger
- 		forSemaphore: Semaphore new
- !

Item was removed:
- ----- Method: Delay class>>handleTimerEvent (in category 'timer process') -----
- handleTimerEvent
- 	"Handle a timer event; which can be either:
- 		- a schedule request (ScheduledDelay notNil)
- 		- an unschedule request (FinishedDelay notNil)
- 		- a timer signal (not explicitly specified)
- 	We check for timer expiry every time we get a signal."
- 	| nowTick nextTick |
- 	"Wait until there is work to do."
- 	TimingSemaphore wait.
- 	nowTick := Time utcMicrosecondClock.
- 
- 	"Process any schedule requests"
- 	ScheduledDelay ifNotNil:
- 		[self scheduleDelay: ScheduledDelay from: nowTick.
- 		 ScheduledDelay := nil].
- 
- 	"Process any unschedule requests"
- 	FinishedDelay ifNotNil:
- 		[self unscheduleDelay: FinishedDelay.
- 		 FinishedDelay := nil].
- 
- 	"Signal any expired delays"
- 	[ActiveDelay notNil
- 	 and: [nowTick >= ActiveDelay resumptionTime]] whileTrue:
- 		[ActiveDelay signalWaitingProcess.
- 		 ActiveDelay := SuspendedDelays isEmpty ifFalse:
- 							[SuspendedDelays removeFirst]].
- 
- 	"And signal when the next request is due. We sleep at most 1sec here
- 	 as a soft busy-loop so that we don't accidentally miss signals."
- 	nextTick := nowTick + 1000000.
- 	ActiveDelay ifNotNil:
- 		[nextTick := nextTick min: ActiveDelay resumptionTime].
- 
- 	"Since we have processed all outstanding requests, reset the timing semaphore so
- 	 that only new work will wake us up again. Do this RIGHT BEFORE setting the next
- 	 wakeup call from the VM because it is only signaled once so we mustn't miss it."
- 	TimingSemaphore initSignals.
- 	Delay primSignal: TimingSemaphore atUTCMicroseconds: nextTick!

Item was removed:
- ----- Method: Delay class>>initialize (in category 'class initialization') -----
- initialize
- 	"Delay initialize."
- 	self startTimerEventLoop.!

Item was removed:
- ----- Method: Delay class>>nextWakeUpTime (in category 'testing') -----
- nextWakeUpTime
- 	^ AccessProtect
- 		critical: [ActiveDelay isNil
- 				ifTrue: [0]
- 				ifFalse: [ActiveDelay resumptionTime]]!

Item was removed:
- ----- Method: Delay class>>primSignal:atUTCMicroseconds: (in category 'primitives') -----
- primSignal: aSemaphore atUTCMicroseconds: anInteger
- 	"Signal the semaphore when the UTC microsecond clock reaches the value of the second argument.
- 	 Fail if the first argument is neither a Semaphore nor nil, or if the second argument is not an integer.
- 	 Essential. See Object documentation whatIsAPrimitive."
- 	<primitive: 242>
- 	^self primitiveFailed!

Item was removed:
- ----- Method: Delay class>>restoreResumptionTimes (in category 'timer process') -----
- restoreResumptionTimes
- 	"Private!! Restore the resumption times of all scheduled Delays after a snapshot.
- 	 This method should be called only while the AccessProtect semaphore is held."
- 
- 	| newBaseTime |
- 	newBaseTime := Time utcMicrosecondClock.
- 	SuspendedDelays do:
- 		[:d | d adjustResumptionTimeOldBase: 0 newBase: newBaseTime].
- 	ActiveDelay ifNotNil:
- 		[ActiveDelay adjustResumptionTimeOldBase: 0 newBase: newBaseTime]!

Item was removed:
- ----- Method: Delay class>>runTimerEventLoop (in category 'timer process') -----
- runTimerEventLoop
- 	"Run the timer event loop."
- 	[RunTimerEventLoop] whileTrue: [self handleTimerEvent]!

Item was removed:
- ----- Method: Delay class>>saveResumptionTimes (in category 'timer process') -----
- saveResumptionTimes
- 	"Private!! Record the resumption times of all Delays relative to a base time of zero.
- 	 This is done prior to snapshotting. This method should be called only while the
- 	 AccessProtect semaphore is held."
- 
- 	| oldBaseTime |
- 	oldBaseTime := Time utcMicrosecondClock.
- 	ActiveDelay ifNotNil:
- 		[ActiveDelay adjustResumptionTimeOldBase: oldBaseTime newBase: 0].
- 	SuspendedDelays do:
- 		[:d | d adjustResumptionTimeOldBase: oldBaseTime newBase: 0]!

Item was removed:
- ----- Method: Delay class>>scheduleDelay:from: (in category 'timer process') -----
- scheduleDelay: aDelay from: nowUsecs
- 	"Private. Schedule this Delay."
- 	
- 	aDelay
- 		resumptionTime: nowUsecs + aDelay microsecondDelayDuration;
- 		beingWaitedOn: true.
- 	ActiveDelay 
- 		ifNil: [ActiveDelay := aDelay]
- 		ifNotNil:
- 			[aDelay resumptionTime < ActiveDelay resumptionTime
- 				ifTrue: [SuspendedDelays add: ActiveDelay.
- 						ActiveDelay := aDelay]
- 				ifFalse: [SuspendedDelays add: aDelay]]!

Item was removed:
- ----- Method: Delay class>>shutDown (in category 'snapshotting') -----
- shutDown
- 	"Suspend the active delay, if any, before snapshotting. It will be reactived when the snapshot is resumed."
- 	"Details: This prevents a timer interrupt from waking up the active delay in the midst snapshoting, since the active delay will be restarted when resuming the snapshot and we don't want to process the delay twice."
- 
- 	AccessProtect wait.
- 	self primSignal: nil atUTCMicroseconds: 0.
- 	self saveResumptionTimes.
- 	DelaySuspended := true!

Item was removed:
- ----- Method: Delay class>>startTimerEventLoop (in category 'timer process') -----
- startTimerEventLoop
- 	"Start the timer event loop"
- 	"Delay startTimerEventLoop"
- 	self stopTimerEventLoop.
- 	AccessProtect := Semaphore forMutualExclusion.
- 	SuspendedDelays := 
- 		Heap withAll: (SuspendedDelays ifNil:[#()])
- 			sortBlock: [:d1 :d2 | d1 resumptionTime <= d2 resumptionTime].
- 	TimingSemaphore := Semaphore new.
- 	RunTimerEventLoop := true.
- 	TimerEventLoop := [self runTimerEventLoop] newProcess.
- 	TimerEventLoop priority: Processor timingPriority.
- 	TimerEventLoop resume.
- 	TimingSemaphore signal "get going"!

Item was removed:
- ----- Method: Delay class>>startUp (in category 'snapshotting') -----
- startUp
- 	"Restart active delay, if any, when resuming a snapshot."
- 
- 	DelaySuspended ifFalse:[^self error: 'Trying to activate Delay twice'].
- 	DelaySuspended := false.
- 	self restoreResumptionTimes.
- 	AccessProtect signal.
- 	(Smalltalk classNamed: #DoItFirst) ifNotNil: [ :doit | doit perform: #reevaluateDebug].
- 
- 
- !

Item was removed:
- ----- Method: Delay class>>stopTimerEventLoop (in category 'timer process') -----
- stopTimerEventLoop
- 	"Stop the timer event loop"
- 	RunTimerEventLoop := false.
- 	TimingSemaphore signal.
- 	TimerEventLoop := nil.!

Item was removed:
- ----- Method: Delay class>>testDelayOf:for:rect: (in category 'example') -----
- testDelayOf: delay for: testCount rect: r
- 	"Delay testDelayOf: 100 for: 20 rect: (10 at 10 extent: 30 at 30).
- 	 Delay testDelayOf: 400 for: 20 rect: (50 at 10 extent: 30 at 30)."
- 
- 	| onDelay offDelay |
- 	onDelay := Delay forMilliseconds: 50.
- 	offDelay := Delay forMilliseconds: delay - 50.
- 	Display fillBlack: r.
- 	[1 to: testCount do: [:i |
- 		Display fillWhite: r.
- 		onDelay wait.
- 		Display reverse: r.
- 		offDelay wait].
- 	] forkAt: Processor userInterruptPriority.
- !

Item was removed:
- ----- Method: Delay class>>timeoutSemaphore:afterMSecs: (in category 'instance creation') -----
- timeoutSemaphore: aSemaphore afterMSecs: anInteger
- 	"Create and schedule a Delay to signal the given semaphore when the given number of milliseconds has elapsed. Return the scheduled Delay. The timeout can be cancelled by sending 'unschedule' to this Delay."
- 	"Details: This mechanism is used to provide a timeout when waiting for an external event, such as arrival of data over a network connection, to signal a semaphore. The timeout ensures that the semaphore will be signalled within a reasonable period of time even if the event fails to occur. Typically, the waiting process cancels the timeout request when awoken, then determines if the awaited event has actually occurred."
- 
- 	anInteger < 0 ifTrue: [self error: 'delay times cannot be negative'].
- 	^ (self new setDelay: anInteger forSemaphore: aSemaphore) schedule
- !

Item was removed:
- ----- Method: Delay class>>unscheduleDelay: (in category 'timer process') -----
- unscheduleDelay: aDelay
- 	"Private. Unschedule this Delay."
- 	aDelay beingWaitedOn ifFalse:[^self].
- 	ActiveDelay == aDelay ifTrue: [
- 		SuspendedDelays isEmpty ifTrue:[
- 			ActiveDelay := nil.
- 		] ifFalse: [
- 			ActiveDelay := SuspendedDelays removeFirst.
- 		]
- 	] ifFalse:[
- 		SuspendedDelays remove: aDelay ifAbsent: [].
- 	].
- 	aDelay beingWaitedOn: false.!

Item was removed:
- ----- Method: Delay>>adjustResumptionTimeOldBase:newBase: (in category 'private') -----
- adjustResumptionTimeOldBase: oldBaseTime newBase: newBaseTime
- 	"Private!! Adjust the value of the system's millisecond clock at which this Delay will be awoken. Used to adjust resumption times after a snapshot or clock roll-over."
- 
- 	resumptionTime := newBaseTime + (resumptionTime - oldBaseTime).
- !

Item was removed:
- ----- Method: Delay>>beingWaitedOn (in category 'public') -----
- beingWaitedOn
- 	"Answer whether this delay is currently scheduled, e.g., being waited on"
- 	^beingWaitedOn!

Item was removed:
- ----- Method: Delay>>beingWaitedOn: (in category 'public') -----
- beingWaitedOn: aBool
- 	"Indicate whether this delay is currently scheduled, e.g., being waited on"
- 	beingWaitedOn := aBool!

Item was removed:
- ----- Method: Delay>>delayDuration (in category 'public') -----
- delayDuration
- 	"Answer the receiver's duration in milliseconds."
- 	^delayDuration!

Item was removed:
- ----- Method: Delay>>delayDuration: (in category 'public') -----
- delayDuration: milliseconds
- 	"Set teh receiver's duration in milliseconds, iff it is not active."
- 	milliseconds < 0 ifTrue:
- 		[self error: 'Delay times cannot be negative!!'].
- 	beingWaitedOn == true ifTrue:
- 		[self error: 'This delay is scheduled!!'].
- 	delayDuration := milliseconds asInteger!

Item was removed:
- ----- Method: Delay>>delaySemaphore (in category 'public') -----
- delaySemaphore
- 
- 	^ delaySemaphore!

Item was removed:
- ----- Method: Delay>>isExpired (in category 'delaying') -----
- isExpired
- 
- 	^delaySemaphore isSignaled.
- !

Item was removed:
- ----- Method: Delay>>microsecondDelayDuration (in category 'public') -----
- microsecondDelayDuration
- 	"Answer the receiver's duration in microseconds."
- 	^delayDuration * 1000!

Item was removed:
- ----- Method: Delay>>printOn: (in category 'printing') -----
- printOn: aStream
- 	super printOn: aStream.
- 	aStream
- 		nextPut: $(;
- 		print: delayDuration;
- 		nextPutAll: ' msecs'.
- 	beingWaitedOn ifTrue:
- 		[aStream
- 			nextPutAll: '; ';
- 			print: resumptionTime - Time utcMicrosecondClock + 500 // 1000;
- 			nextPutAll: ' msecs remaining'].
- 	aStream nextPut: $)!

Item was removed:
- ----- Method: Delay>>resumptionTime (in category 'private') -----
- resumptionTime
- 	"Answer the value of the system's millisecondClock at which the receiver's suspended Process will resume."
- 
- 	^ resumptionTime
- !

Item was removed:
- ----- Method: Delay>>resumptionTime: (in category 'private') -----
- resumptionTime: anInteger
- 	"Private!! Set the value of the system's millisecondClock at which the receiver's suspended Process will resumed.
- 	Must only be called from the class-side #scheduleDelay:."
- 	
- 	resumptionTime := anInteger!

Item was removed:
- ----- Method: Delay>>schedule (in category 'private') -----
- schedule
- 	"Schedule this delay."
- 	
- 	beingWaitedOn ifTrue: [^self error: 'This Delay has already been scheduled.'].
- 	AccessProtect critical: [
- 		ScheduledDelay := self.
- 		TimingSemaphore signal]!

Item was removed:
- ----- Method: Delay>>setDelay:forSemaphore: (in category 'private') -----
- setDelay: millisecondCount forSemaphore: aSemaphore
- 	"Private!! Initialize this delay to signal the given semaphore after the given number of milliseconds."
- 
- 	delayDuration := millisecondCount.
- 	delaySemaphore := aSemaphore.
- 	beingWaitedOn := false.
- !

Item was removed:
- ----- Method: Delay>>signalWaitingProcess (in category 'private') -----
- signalWaitingProcess
- 	"The delay time has elapsed; signal the waiting process."
- 
- 	beingWaitedOn := false.
- 	delaySemaphore signal.
- !

Item was removed:
- ----- Method: Delay>>unschedule (in category 'private') -----
- unschedule
- 	AccessProtect critical:[
- 		FinishedDelay := self.
- 		TimingSemaphore signal.
- 	].!

Item was removed:
- ----- Method: Delay>>unscheduleEvent (in category 'private') -----
- unscheduleEvent
- 	AccessProtect critical:[
- 		FinishedDelay := self.
- 		TimingSemaphore signal.
- 	].!

Item was removed:
- ----- Method: Delay>>wait (in category 'delaying') -----
- wait
- 	"Schedule this Delay, then wait on its semaphore. The current process will be suspended for the amount of time specified when this Delay was created. NOTE THAT for delays shorter than 50 milliseconds, you might want to use #busyWait for greater precision if the higher CPU load and restricted process scheduling are not an issue. See commentary in #busyWait."
- 
- 	self schedule.
- 	[delaySemaphore wait] ifCurtailed:[self unschedule].
- !

Item was removed:
- Delay subclass: #DelayWaitTimeout
- 	instanceVariableNames: 'process expired'
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'Kernel-Processes'!
- 
- !DelayWaitTimeout commentStamp: '<historical>' prior: 0!
- DelayWaitTimeout is a special kind of Delay used in waitTimeoutMSecs: to avoid signaling the underlying semaphore when the wait times out.!

Item was removed:
- ----- Method: DelayWaitTimeout>>isExpired (in category 'testing') -----
- isExpired
- 	"Did this timeout fire before the associated semaphore was signaled?"
- 	^expired!

Item was removed:
- ----- Method: DelayWaitTimeout>>setDelay:forSemaphore: (in category 'private') -----
- setDelay: anInteger forSemaphore: aSemaphore
- 	super setDelay: anInteger forSemaphore: aSemaphore.
- 	process := Processor activeProcess.
- 	expired := false.!

Item was removed:
- ----- Method: DelayWaitTimeout>>signalWaitingProcess (in category 'signaling') -----
- signalWaitingProcess
- 	"Release the given process from the semaphore it is waiting on.
- 	This method relies on running at highest priority so that it cannot be preempted
- 	by the process being released."
- 	beingWaitedOn := false.
- 	"Release the process but only if it is still waiting on its original list"
- 	process suspendingList == delaySemaphore ifTrue:[
- 		expired := true.
- 		process suspendAndUnblock; resume.
- 	].
- !

Item was removed:
- ----- Method: DelayWaitTimeout>>wait (in category 'waiting') -----
- wait
- 	"Wait until either the semaphore is signaled or the delay times out"
- 	[self schedule.
- 	"It is critical that the following has no suspension point so that
- 	the test and the wait primitive are atomic. In addition, if the delay
- 	is no longer being waited on while entering the way we know that it 
- 	is expired because the delay has already fired."
- 	beingWaitedOn 
- 		ifTrue:[delaySemaphore wait]
- 		ifFalse:[expired := true]] ensure:[self unschedule].
- 	^self isExpired
- !

Item was removed:
- Collection weakSubclass: #DependentsArray
- 	instanceVariableNames: ''
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'Kernel-Models'!
- 
- !DependentsArray commentStamp: 'nice 11/11/2009 20:30' prior: 0!
- Act as an array of (weak) dependents of some object.
- 
- When dependents are reclaimed, they are replaced by an UndefinedObject in the DependentsArray.
- This is why instances of this class will take care to iterate only on non nil elements.
- These nil also cause loops written as (1 to: self size do: [:i | (self at: i) doSomething]) to be inefficient.
- This is because #size and #at: both require scanning for nils.
- For this reason, DependentsArray though sequenceable, is not a subclass of SequenceableCollection.!

Item was removed:
- ----- Method: DependentsArray class>>with: (in category 'instance creation') -----
- with: anObject
- 	^(self basicNew: 1) basicAt: 1 put: anObject; yourself!

Item was removed:
- ----- Method: DependentsArray class>>with:with: (in category 'instance creation') -----
- with: firstObject with: secondObject 
- 	^(self basicNew: 2)
- 		basicAt: 1 put: firstObject;
- 		basicAt: 2 put: secondObject;
- 		yourself!

Item was removed:
- ----- Method: DependentsArray class>>with:with:with: (in category 'instance creation') -----
- with: firstObject with: secondObject with: thirdObject 
- 	^(self basicNew: 3)
- 		basicAt: 1 put: firstObject;
- 		basicAt: 2 put: secondObject;
- 		basicAt: 3 put: thirdObject;
- 		yourself!

Item was removed:
- ----- Method: DependentsArray class>>with:with:with:with: (in category 'instance creation') -----
- with: firstObject with: secondObject with: thirdObject with: fourthObject 
- 	^(self basicNew: 4)
- 		basicAt: 1 put: firstObject;
- 		basicAt: 2 put: secondObject;
- 		basicAt: 3 put: thirdObject;
- 		basicAt: 4 put: fourthObject;
- 		yourself!

Item was removed:
- ----- Method: DependentsArray class>>with:with:with:with:with: (in category 'instance creation') -----
- with: firstObject with: secondObject with: thirdObject with: fourthObject with: fifthObject
- 	^(self basicNew: 5)
- 		basicAt: 1 put: firstObject;
- 		basicAt: 2 put: secondObject;
- 		basicAt: 3 put: thirdObject;
- 		basicAt: 4 put: fourthObject;
- 		basicAt: 5 put: fifthObject;
- 		yourself!

Item was removed:
- ----- Method: DependentsArray class>>with:with:with:with:with:with: (in category 'instance creation') -----
- with: firstObject with: secondObject with: thirdObject with: fourthObject with: fifthObject with: sixthObject
- 	^(self basicNew: 6)
- 		basicAt: 1 put: firstObject;
- 		basicAt: 2 put: secondObject;
- 		basicAt: 3 put: thirdObject;
- 		basicAt: 4 put: fourthObject;
- 		basicAt: 5 put: fifthObject;
- 		basicAt: 6 put: sixthObject;
- 		yourself!

Item was removed:
- ----- Method: DependentsArray class>>withAll: (in category 'instance creation') -----
- withAll: aCollection
- 	| newInstance |
- 	newInstance := self basicNew: aCollection size.
- 	1 to: aCollection size do: [:i |
- 		newInstance basicAt: i put: (aCollection at: i)].
- 	^newInstance!

Item was removed:
- ----- Method: DependentsArray>>at: (in category 'accessing') -----
- at: anIndex
- 	| basicSize counter dep |
- 	anIndex > 0 ifTrue: [
- 		basicSize := self basicSize.
- 		anIndex <= basicSize ifTrue: [
- 			counter := 0.
- 			1 to: basicSize do: [:i |
- 				(dep := self basicAt: i) == nil
- 					ifFalse: [(counter := counter + 1) = anIndex ifTrue: [^dep]]]]].
- 	self error: 'access with an index out of bounds'!

Item was removed:
- ----- Method: DependentsArray>>at:put: (in category 'accessing') -----
- at: anIndex put: anObject
- 	| basicSize counter |
- 	anIndex > 0 ifTrue: [
- 		basicSize := self basicSize.
- 		anIndex <= basicSize ifTrue: [
- 			counter := 0.
- 			1 to: basicSize do: [:i |
- 				(self basicAt: i) == nil
- 					ifFalse: [(counter := counter + 1) = anIndex ifTrue: [^self basicAt: i put: anObject]]]]].
- 	self error: 'access with an index out of bounds'!

Item was removed:
- ----- Method: DependentsArray>>basicReplaceFrom:to:with:startingAt: (in category 'private') -----
- basicReplaceFrom: start to: stop with: replacement startingAt: repStart 
- 	"Primitive. This destructively replaces elements from start to stop in the receiver starting at index, repStart, in the collection, replacement. Answer the receiver. Range checks are performed in the primitive only. Optional. See Object documentation whatIsAPrimitive."
- 	<primitive: 105>
- 	start to: stop do: [:i |
- 		self basicAt: i put: (replacement basicAt: repStart - start + i)]!

Item was removed:
- ----- Method: DependentsArray>>collect: (in category 'enumerating') -----
- collect: aBlock 
- 	"Refer to the comment in Collection|select:."
- 	| basicSize newSelf size dep selection |
- 	basicSize := self basicSize.
- 	newSelf := self species new: basicSize.
- 	size := 0.
- 	1 to: basicSize do: [:i |
- 		(dep := self basicAt: i) notNil ifTrue: [newSelf basicAt: (size := size+1) put: (aBlock value: dep)]].
- 	selection := self species new: size.
- 	selection basicReplaceFrom: 1 to: size with: newSelf startingAt: 1.
- 	^selection!

Item was removed:
- ----- Method: DependentsArray>>copyWith: (in category 'copying') -----
- copyWith: newElement 
- 	"Re-implemented to not copy any niled out dependents."
- 	| copy i |
- 	copy := self class new: self size + 1.
- 	i := 0.
- 	self do: [:item | copy basicAt: (i:=i+1) put: item].
- 	copy basicAt: (i:=i+1) put: newElement.
- 	^copy!

Item was removed:
- ----- Method: DependentsArray>>do: (in category 'enumerating') -----
- do: aBlock
- 	"Evaluate a Block on non nil elements of the receiver"
- 	| dep |
- 	1 to: self basicSize do:[:i|
- 		(dep := self basicAt: i) ifNotNil:[aBlock value: dep]].!

Item was removed:
- ----- Method: DependentsArray>>first (in category 'accessing') -----
- first
- 	self do: [:dep | ^dep].
- 	self error: 'this collection is empty'!

Item was removed:
- ----- Method: DependentsArray>>last (in category 'accessing') -----
- last
- 	self reverseDo: [:dep | ^dep].
- 	self error: 'this collection is empty'!

Item was removed:
- ----- Method: DependentsArray>>reverseDo: (in category 'enumerating') -----
- reverseDo: aBlock
- 	"Refer to the comment in Collection|do:."
- 	| dep |
- 	self basicSize to: 1 by: -1 do: [:i |
- 		(dep := self basicAt: i) ifNotNil: [aBlock value: dep]]!

Item was removed:
- ----- Method: DependentsArray>>select: (in category 'enumerating') -----
- select: aBlock 
- 	"Refer to the comment in Collection|select:."
- 	| basicSize newSelf size selection |
- 	basicSize := self basicSize.
- 	newSelf := self species new: basicSize.
- 	size := 0.
- 	1 to: basicSize do: [ :i |
- 		(self basicAt: i) ifNotNil: [ :dep |
- 			(aBlock value: dep) ifTrue: [
- 				newSelf basicAt: (size := size+1) put: dep ] ] ].
- 	selection := self species new: size.
- 	selection basicReplaceFrom: 1 to: size with: newSelf startingAt: 1.
- 	^selection!

Item was removed:
- ----- Method: DependentsArray>>size (in category 'accessing') -----
- size
- 	"count each non nil elements in self.
- 	Note: count: will use do: which will already have filtered out nil elements"
- 	
- 	^self count: [:each | true]!

Item was removed:
- Warning subclass: #Deprecation
- 	instanceVariableNames: ''
- 	classVariableNames: 'ShowDeprecationWarnings'
- 	poolDictionaries: ''
- 	category: 'Kernel-Exceptions'!
- 
- !Deprecation commentStamp: 'dew 5/21/2003 17:46' prior: 0!
- This Warning is signalled by methods which are deprecated.
- 
- The use of Object>>#deprecatedExplanation: aString and Object>>#deprecated: aBlock explanation: aString is recommended.
- 
- Idiom: Imagine I want to deprecate the message #foo.
- 
- foo
- 	^ 'foo'
- 
- I can replace it with:
- 
- foo
- 	self deprecatedExplanation: 'The method #foo was not good. Use Bar>>newFoo instead.'
- 	^ 'foo'
- 
- Or, for certain cases such as when #foo implements a primitive, #foo can be renamed to #fooDeprecated.
- 
- fooDeprecated
- 	^ <primitive>
- 
- foo
- 	^ self deprecated: [self fooDeprecated] explanation: 'The method #foo was not good. Use Bar>>newFoo instead.'
- !

Item was removed:
- ----- Method: Deprecation class>>showDeprecationWarnings (in category 'preferences') -----
- showDeprecationWarnings
- 	<preference: 'Show deprecation warnings' category: 'debug' description: 'Warn the user when a deprecated method is used.' type: #Boolean>
- 	^ ShowDeprecationWarnings ifNil: [false]!

Item was removed:
- ----- Method: Deprecation class>>showDeprecationWarnings: (in category 'preferences') -----
- showDeprecationWarnings: aBoolean
- 	ShowDeprecationWarnings := aBoolean.!

Item was removed:
- ----- Method: Deprecation class>>signalForContext:message:explanation: (in category 'instance creation') -----
- signalForContext: context message: messageString explanation: explanationString
- 
- 	 | message |
- 	message := context method reference, ' has been deprecated', messageString, '.'.
- 	explanationString ifNotEmpty: [message := message, ' ', explanationString].
- 	self signal: message.!

Item was removed:
- ----- Method: Deprecation class>>suppressed (in category 'accessing') -----
- suppressed
- 
- 	^ self showDeprecationWarnings not!

Item was removed:
- ----- Method: Deprecation class>>suppressed: (in category 'accessing') -----
- suppressed: aBoolean
- 
- 	self showDeprecationWarnings: aBoolean not.
- 	super suppressed: aBoolean.!

Item was removed:
- ArithmeticError subclass: #DomainError
- 	instanceVariableNames: ''
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'Kernel-Numbers-Exceptions'!
- 
- !DomainError commentStamp: 'nice 4/20/2011 22:13' prior: 0!
- A DomainError is an error occuring when a mathematical function is used outside its domain of validity.!

Item was removed:
- Error subclass: #DuplicateVariableError
- 	instanceVariableNames: 'superclass variable'
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'Kernel-Exceptions'!
- 
- !DuplicateVariableError commentStamp: 'ar 2/13/2010 15:05' prior: 0!
- DuplicateVariableError is signaled when a (class or instance) variable name is used in both super and subclass.!

Item was removed:
- ----- Method: DuplicateVariableError>>isResumable (in category 'testing') -----
- isResumable
- 	^true!

Item was removed:
- ----- Method: DuplicateVariableError>>superclass (in category 'accessing') -----
- superclass
- 	"The superclass in which the variable is defined"
- 	^superclass!

Item was removed:
- ----- Method: DuplicateVariableError>>superclass: (in category 'accessing') -----
- superclass: aClass
- 	"The superclass in which the variable is defined"
- 	superclass := aClass!

Item was removed:
- ----- Method: DuplicateVariableError>>variable (in category 'accessing') -----
- variable
- 	"Name of the duplicate variable"
- 	^variable!

Item was removed:
- ----- Method: DuplicateVariableError>>variable: (in category 'accessing') -----
- variable: aString
- 	"Name of the duplicate variable"
- 	variable := aString!

Item was removed:
- ProcessSpecificVariable subclass: #DynamicVariable
- 	instanceVariableNames: ''
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'Kernel-Processes-Variables'!
- 
- !DynamicVariable commentStamp: 'mvl 3/13/2007 13:55' prior: 0!
- My subclasses are dynamic variables: each subclass represents a variable
- whose value persists inside the block passed to #value:during:. There is
- no way to change the value inside such a block, but it is possible to
- temporarirly rebind it in a nested manner.!

Item was removed:
- ----- Method: DynamicVariable class>>value:during: (in category 'accessing') -----
- value: anObject during: aBlock
- 
- 	| p oldValue outerScopeWasDynamic |
- 	p := Processor activeProcess.
- 	outerScopeWasDynamic := true.
- 	oldValue := p
- 		environmentAt: self
- 		ifAbsent: [outerScopeWasDynamic := false. nil].
- 	^[
- 		p environmentAt: self put: anObject.
- 		aBlock value ] 
- 			ensure: [ outerScopeWasDynamic
- 				ifTrue: [p environmentAt: self put: oldValue]
- 				ifFalse: [p environmentRemoveKey: self ifAbsent: []] ].!

Item was removed:
- Exception subclass: #Error
- 	instanceVariableNames: ''
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'Kernel-Exceptions-Kernel'!
- 
- !Error commentStamp: 'ct 3/25/2022 21:09' prior: 0!
- >From the ANSI standard:
- This protocol describes the behavior of instances of class Error. These are used to represent error conditions that prevent the normal continuation of processing. Actual error exceptions used by an application may be subclasses of this class.
- As Error is explicitly specified  to be subclassable, conforming implementations must implement its behavior in a non-fragile manner.!

Item was removed:
- ----- Method: Error>>defaultAction (in category 'priv handling') -----
- defaultAction
- 	"No one has handled this error, but now give them a chance to decide how to debug it.  If none handle this either then open debugger (see UnhandedError-defaultAction)"
- 
- 	UnhandledError signalForException: self!

Item was removed:
- ----- Method: Error>>isResumable (in category 'priv handling') -----
- isResumable
- 	"Determine whether an exception is resumable."
- 
- 	^ false!

Item was removed:
- Object subclass: #EventSensor
- 	instanceVariableNames: 'mouseButtons mousePosition mouseWheelDelta keyboardBuffer interruptKey interruptSemaphore eventQueue inputSemaphore lastEventPoll hasInputSemaphore lastEventTime'
- 	classVariableNames: 'ButtonDecodeTable EventPollPeriod EventTicklerProcess InterruptWatcherProcess KeyDecodePreferences KeyDecodeTable VirtualKeyTable'
- 	poolDictionaries: 'EventSensorConstants'
- 	category: 'Kernel-Processes'!
- 
- !EventSensor commentStamp: 'mt 12/13/2019 14:38' prior: 0!
- An EventSensor is an interface to the user input devices.
- There is at least one instance of EventSensor named Sensor in the system.
- 
- EventSensor is a replacement for the earlier InputSensor implementation based on a set of (optional) event primitives. An EventSensor updates its state when events are received so that all state based users of Sensor (e.g., Sensor keyboard, Sensor leftShiftDown, Sensor mouseButtons) will work exactly as before, by moving the current VM mechanisms into EventSensor itself. An optional input semaphore is part of the new design.
- 
- For platforms that support true asynchronous event notification, the semaphore will be signaled to indicate pending events.
- On platforms that do not support asynchronous notifications about events, the UI will have to poll EventSensor periodically to read events from the VM.
- 
- Instance variables:
- 	mouseButtons <Integer>	- mouse button state as replacement for primMouseButtons
- 	mousePosition <Point>	- mouse position as replacement for primMousePt
- 	keyboardBuffer <SharedQueue>	- keyboard input buffer
- 	interruptKey <Integer>			- currently defined interrupt key
- 	interruptSemaphore <Semaphore>	- the semaphore signaled when the interruptKey is detected
- 	eventQueue <SharedQueue>	- an optional event queue for event driven applications
- 	inputSemaphore <Semaphore>- the semaphore signaled by the VM if asynchronous event notification is supported
- 	lastEventPoll <Integer>		- the last millisecondClockValue at which we called fetchMoreEvents
- 	hasInputSemaphore <Boolean>	- true if my inputSemaphore has actually been signaled at least once.
- 
- Class variables:
- 	ButtonDecodeTable <ByteArray> - maps mouse buttons as reported by the VM to ones reported in the events.
- 	KeyDecodeTable <Dictionary<SmallInteger->SmallInteger>> - maps some keys and their modifiers to other keys (used for instance to map Ctrl-X to Alt-X)
- 	InterruptSemaphore <Semaphore> - signalled by the the VM and/or the event loop upon receiving an interrupt keystroke.
- 	InterruptWatcherProcess <Process> - waits on the InterruptSemaphore and then responds as appropriate.
- 	EventPollPeriod <Integer>	- the number of milliseconds to wait between polling for more events in the userInterruptHandler.
- 	EventTicklerProcess <Process>	- the process that makes sure that events are polled for often enough (at least every EventPollPeriod milliseconds).
- 
- Event format:
- The current event format is very simple. Each event is recorded into an 8 element array. All events must provide some SmallInteger ID (the first field in the event buffer) and a time stamp (the second field in the event buffer), so that the difference between the time stamp of an event and the current time can be reported.
- 
- Currently, the following events are defined:
- 
- Null event
- =============
- The Null event is returned when the ST side asks for more events but no more events are available.
- Structure:
- [1]		- event type 0
- [2-8]	- unused
- 
- Mouse event structure
- ==========================
- Mouse events are generated when mouse input is detected.
- [1]	- event type 1
- [2]	- time stamp
- [3]	- mouse x position
- [4]	- mouse y position
- [5]	- button state; bitfield with the following entries:
- 		1	-	2r001	yellow (e.g., right) button
- 		2	-	2r010	blue (e.g., middle) button
- 		4	-	2r100	red (e.g., left) button
- 		[all other bits are currently undefined]
- [6]	- modifier keys; bitfield with the following entries:
- 		1	-	shift key
- 		2	-	ctrl key
- 		4	-	(Mac specific) option key
- 		8	-	Cmd/Alt key
- 		[all other bits are currently undefined]
- [7]	- reserved.
- [8]	- host window id.
- 
- Keyboard events
- ====================
- Keyboard events are generated when keyboard input is detected.
- [1]	- event type 2
- [2]	- time stamp
- [3]	- character code (Ascii)
- 		For now the character code is in Mac Roman encoding. See #macToSqueak.
- 		For key press/release (see [4]), character codes are normalized.
- [4]	- press state; integer with the following meaning
- 		0	-	character (aka. key stroke or key still pressed)
- 		1	-	key press (aka. key down)
- 		2	- 	key release (aka. key up)
- [5]	- modifier keys (same as in mouse events)
- 		For key press/release (see [4]), modifier keys are still accessible.
- [6]	- character code (Unicode UTF32)
- 		Manual decoding via KeyboardInputInterpreter possible.
- 		For key press/release (see [4]), character codes are normalized.
- [7]	- reserved.
- [8]	- host window id.
- 	
- Mouse-wheel event structure
- ==========================
- Mouse-wheel events are generated when mouse-wheel input is detected.
- [1] - event type 7
- [2] - time stamp
- [3] - horizontal scroll delta
- [4] - vertical scroll delta
- [5] - button state (same as in mouse events)
- [6] - modifier keys (same as in mouse events)
- [7] - reserved.
- [8] - host window id.
- !

Item was removed:
- ----- Method: EventSensor class>>anyMouseButtonMask (in category 'constants') -----
- anyMouseButtonMask
- 
- 	^ 2r111!

Item was removed:
- ----- Method: EventSensor class>>default (in category 'public') -----
- default
- 	"Answer the default system input sensor, Sensor."
- 
- 	^ Sensor!

Item was removed:
- ----- Method: EventSensor class>>duplicateControlAndAltKeys: (in category 'public') -----
- duplicateControlAndAltKeys: aBoolean
- 	"EventSensor duplicateControlAndAltKeys: true"
- 
- 	self flag: #deprecated.
- 	self
- 		mapControlKeysToCommandKeys: aBoolean;
- 		mapAltKeysToOptionKeys: false.!

Item was removed:
- ----- Method: EventSensor class>>eventPollPeriod (in category 'class initialization') -----
- eventPollPeriod
- 	^EventPollPeriod ifNil: [ EventPollPeriod := 500 ].!

Item was removed:
- ----- Method: EventSensor class>>eventPollPeriod: (in category 'class initialization') -----
- eventPollPeriod: msec
- 	"Set the number of milliseconds between checking for events to msec."
- 
- 	EventPollPeriod := msec max: 10.!

Item was removed:
- ----- Method: EventSensor class>>fixControlCharacters (in category 'key decode table') -----
- fixControlCharacters
- 	"Assure that all keyboard events that arrive with the CONTROL modifier actually have control characters set."
- 
- 	64 "$@" to: 95 "$_"do: [:upper |
- 		KeyDecodeTable
- 			at: { upper . 2 bitOr: 1 "ctrl+shift" }
- 			put: { upper bitAnd: 16r9F . 2 bitOr: 1 "ctrl+shift" }].
- 	96 "$`" to: 126 "$~" do: [:lower | "Ignore 127"
- 		KeyDecodeTable
- 			at: { lower . 2 "ctrl" }
- 			put: { lower bitAnd: 16r9F . 2 "ctrl" }].
- 
- 	self flag: #linuxOnly. "mt: For Linux VMs as of version 201911282316, no control characters will be sent from the VM. Avoid check for #platformName because the extra mapping will not affect others anyway."
- 	self flag: #windowsOnly. "mt: CTRL+m would not arrive as CTRL+CR, which is rather inconsistent."!

Item was removed:
- ----- Method: EventSensor class>>initialize (in category 'class initialization') -----
- initialize
- 	
- 	Smalltalk addToStartUpList: self before: ProcessorScheduler.
- 	Smalltalk addToShutDownList: self.
- 	
- 	KeyDecodePreferences := Dictionary new.
- 	
- 	self installKeyDecodeTable.
- 	self installMouseDecodeTable.
- 	self installVirtualKeyTable.!

Item was removed:
- ----- Method: EventSensor class>>install (in category 'class initialization') -----
- install	"EventSensor install"
- 	"Install an EventSensor in place of the current Sensor."
- 	| newSensor |
- 	Sensor shutDown.
- 	newSensor := self new.
- 	newSensor startUp.
- 	"Note: We must use #become: here to replace all references to the old sensor with the new one, since Sensor is referenced from all the existing controllers."
- 	Sensor becomeForward: newSensor. "done"!

Item was removed:
- ----- Method: EventSensor class>>installKeyDecodeTable (in category 'class initialization') -----
- installKeyDecodeTable
- 	"Create a decode table that swaps or duplicates some keys if the respective preference is set."
- 
- 	KeyDecodeTable := Dictionary new.
- 
- 	self mapControlKeysToCommandKeys
- 		ifTrue: [self installMappingToCommandKeys]
- 		ifFalse: [self mapControlCharactersToPrintableCharacters
- 			ifTrue: [self installMappingToPrintableCharacters]
- 			ifFalse: [self fixControlCharacters "mt: Due to platform-specific VM behavior."]].
- 
- 	self mapAltKeysToOptionKeys
- 		ifTrue: [self installMappingToOptionKeys].!

Item was removed:
- ----- Method: EventSensor class>>installMappingToCommandKeys (in category 'key decode table') -----
- installMappingToCommandKeys
- 	"Maps all keyboard events that arrive with the CONTROL modifier to also have the COMMAND modifier set. This mapping also considers the preference #mapControlCharactersToPrintableCharacters."
- 
- 	| controlMask |
- 	0 "NUL" to: 27 "ESC" do: [:control |
- 		controlMask := self mapControlCharactersToPrintableCharacters
- 			ifTrue: [16r60] ifFalse: [0].
- 		KeyDecodeTable
- 			at: { control . 2r0010 "ctrl" }
- 			put: { control bitOr: controlMask . 2r1010 "cmd+ctrl" }.
- 		controlMask := self mapControlCharactersToPrintableCharacters
- 			ifTrue: [16r40] ifFalse: [0].
- 		KeyDecodeTable
- 			at: { control . 2r0011 "ctrl+shift" }
- 			put: { control bitOr: controlMask . 2r1011 "cmd+ctrl+shift" }].	
- 
- 	28 "arrow keys" to: 126 "$~" do: [:arrowAndPrintable |
- 			KeyDecodeTable
- 				at: { arrowAndPrintable . 2r0010 "ctrl" }
- 				put: { arrowAndPrintable . 2r1010 "cmd+ctrl" }.
- 			KeyDecodeTable
- 				at: { arrowAndPrintable . 2r0011 "ctrl+shift" }
- 				put: { arrowAndPrintable . 2r1011 "cmd+ctrl+shift" }].
- 			
- 	self mapControlCharactersToPrintableCharacters ifFalse: [
- 		"See #fixControlCharacters. #linuxOnly"
- 		64 "$@" to: 95 "$_"do: [:upper |
- 			KeyDecodeTable
- 				at: { upper . 2r0011 "ctrl+shift" }
- 				put: { upper bitAnd: 16r9F . 2r1011 "cmd+ctrl+shift" }].
- 		96 "$`" to: 126 "$~" do: [:lower | "Ignore 127"
- 			KeyDecodeTable
- 				at: { lower . 2r0010 "ctrl" }
- 				put: { lower bitAnd: 16r9F . 2r1010 "cmd+ctrl" }]].!

Item was removed:
- ----- Method: EventSensor class>>installMappingToOptionKeys (in category 'key decode table') -----
- installMappingToOptionKeys
- 	"Maps all keyboard events that arrive with the COMMAND modifier to also have the OPTION modifier set. See preference #mapAltKeysToOptionKeys."
- 
- 	self flag: #windowsOnly. "mt: In Windows VMs version 202104182333, pressing the (physical) ALT key arrives as CMD modifier in the image. Should this ever change, this mapping MUST be adapted, too."
- 	self flag: #linuxOnly. "mt: See #windowsOnly."
- 	self flag: #macOSOnly. "mt: This mapping should be ignored to not overshadow events that have the actual OPTION modifier set." 
- 
- 	CharacterSet ascii do: [:character |
- 		KeyDecodeTable
- 			at: { character asInteger . 2r1000 "cmd" }
- 			put: { character asInteger . 2r1100 "cmd+opt" }.
- 		KeyDecodeTable
- 			at: { character asInteger . 2r1001 "cmd + shift" }
- 			put: { character asInteger . 2r1101 "cmd + opt + shift" }].!

Item was removed:
- ----- Method: EventSensor class>>installMappingToPrintableCharacters (in category 'key decode table') -----
- installMappingToPrintableCharacters
- 	"Only applies when the CONTROL modifier is present!! Control characters that can directly be triggered -- such as CR, ENTER, BS, DEL, POS1, END -- will not be mapped."
- 
- 	self flag: #windowsOnly. "mt: The CONTROL modifier might directly change the control character. Examples: CTRL+CR(13) arrives as CTRL+LF(10), CTRL+BS(8) arrives as CTRL+DEL(127). If you have no other means to input LF(10) or DEL(127), you might have to disable this mapping to printable characters."
- 	
- 	1 "SOH" to: 27 "ESC" do: [:control |
- 		#(2r0010 "ctrl" 2r0110 "ctrl+opt" 2r1010 "ctrl+cmd" 2r1110 "ctrl+opt+cmd")
- 			do: [:modifiers | "Note that only macOS needs those other combinations."
- 				KeyDecodeTable
- 					at: { control . modifiers }
- 					put: { control bitOr: 16r60 "+96" . modifiers }].
- 		#(2r0011 "shift+ctrl" 2r0111 "shift+ctrl+opt" 2r1011 "shift+ctrl+cmd" 2r1111 "shift+ctrl+opt+cmd")
- 			do: [:modifiers | "Note that only macOS needs those other combinations."				
- 				KeyDecodeTable
- 					at: { control . modifiers }
- 					put: { control bitOr: 16r40 "+64" . modifiers }]].
- 		
- 	self flag: #macOSOnly. "mt: Ctrl+Space arrives as NUL character, which would be mapped to $@ with the above rules. So, ensure that Ctrl+Space works across platforms."
- 	KeyDecodeTable
- 		at: { 0 "NUL" . 2r0010 "ctrl" }
- 		put: { 32 "SPACE". 2 "ctrl" }.
- 	KeyDecodeTable
- 		at: { 0 "NUL" . 2r0011 "ctrl+shift" }
- 		put: { 32 "SPACE". 2r0011 "ctrl+shift" }.!

Item was removed:
- ----- Method: EventSensor class>>installMouseDecodeTable (in category 'class initialization') -----
- installMouseDecodeTable
- 	"Create a decode table that swaps the lowest-order 2 bits if 
- 	Preferences swapMouseButtons is set"
- 	ButtonDecodeTable := Preferences swapMouseButtons
- 				ifTrue: [ByteArray withAll:
- 							((0 to: 255) collect: [:ea |
- 								((ea bitAnd: 1) << 1
- 									bitOr: (ea bitAnd: 2) >> 1)
- 										bitOr: (ea bitAnd: 16rFC) ])]
- 				ifFalse: [ByteArray
- 						withAll: (0 to: 255)]!

Item was removed:
- ----- Method: EventSensor class>>installVirtualKeyTable (in category 'class initialization') -----
- installVirtualKeyTable
- 
- 	VirtualKeyTable := Smalltalk windowSystemName
- 			caseOf: {
- 				['Windows'] -> [self virtualKeysOnWindows].
- 				['Win32' "older VMs"] -> [self virtualKeysOnWindows].
- 				['Aqua'] -> [self virtualKeysOnMacOS].
- 				['X11'] -> [self virtualKeysOnX11].
- 			} otherwise: [Dictionary new].
- 	
- 	"Shift 8 bits to not overwrite virtual-key mappings from above."
- 	self mapControlKeysToCommandKeys ifTrue: [		
- 		VirtualKeyTable
- 			at: (2r0010 "ctrl" bitShift: 8)
- 			put: (2r1010 "cmd+ctrl").
- 		VirtualKeyTable
- 			at: (2r0011 "ctrl+shift" bitShift: 8)
- 			put: (2r1011 "cmd+ctrl+shift")].
- 		
- 	self mapAltKeysToOptionKeys ifTrue: [
- 		VirtualKeyTable
- 			at: (2r1000 "cmd/alt" bitShift: 8)
- 			put: (2r1100 "cmd/alt+opt").
- 		VirtualKeyTable
- 			at: (2r1001 "cmd/alt+shift" bitShift: 8)
- 			put: (2r1101 "cmd/alt+opt+shift")].!

Item was removed:
- ----- Method: EventSensor class>>keyDecodeTable (in category 'key decode table') -----
- keyDecodeTable
- 	^KeyDecodeTable ifNil: [ self installKeyDecodeTable ]!

Item was removed:
- ----- Method: EventSensor class>>mapAltKeysToOptionKeys (in category 'preferences') -----
- mapAltKeysToOptionKeys
- 	<preference: 'Map ALT keys to OPTION keys'
- 		categoryList: #(keyboard events input)
- 		description: 'On platforms other than macOS, keystrokes involving the (physical) ALT modifier typically arrive as COMMAND modifier. If you now also map CONTROL keys to COMMAND keys, you disable potential input. If you enable this preference, you preserve the possibility of reacting to two different modifiers -- CMD and OPT -- in your code, on all platforms. (This preference replaces older duplicate/swap preferences.)'
- 		type: #Boolean>
- 		
- 	^ KeyDecodePreferences
- 		at: #mapAltKeysToOptionKeys
- 		ifAbsent: [false]!

Item was removed:
- ----- Method: EventSensor class>>mapAltKeysToOptionKeys: (in category 'preferences') -----
- mapAltKeysToOptionKeys: aBooleanOrNil
- 
- 	aBooleanOrNil = self mapAltKeysToOptionKeys
- 		ifTrue: [^ self].
- 
- 	aBooleanOrNil
- 		ifNil: [
- 			KeyDecodePreferences
- 				removeKey: #mapAltKeysToOptionKeys
- 				ifAbsent: []]
- 		ifNotNil: [
- 			KeyDecodePreferences
- 				at: #mapAltKeysToOptionKeys
- 				put: aBooleanOrNil].
- 			
- 	self installKeyDecodeTable.
- 	self installVirtualKeyTable.!

Item was removed:
- ----- Method: EventSensor class>>mapControlCharactersToPrintableCharacters (in category 'preferences') -----
- mapControlCharactersToPrintableCharacters
- 	<preference: 'Map ASCII control characters to printable characters'
- 		categoryList: #(keyboard events input)
- 		description: 'Keystrokes involving the (physical) CONTROL modifier typically have characters codes from 00 to 31 when pressing the physical keys labeled A to Z (or actually ASCII 64 to 95). This means that, for example in CTRL+C, client code cannot check for "anEvent controlKeyPressed and: [anEvent keyCharacter = $C]" but has to resort to "anEvent controlKeyPressed and: [keyCharacter = 3]." If you enable this preference all control characters will be mapped to printable characters.'
- 		type: #Boolean>
- 		
- 	^ KeyDecodePreferences
- 		at: #mapControlCharactersToPrintableCharacters
- 		ifAbsent: [true]!

Item was removed:
- ----- Method: EventSensor class>>mapControlCharactersToPrintableCharacters: (in category 'preferences') -----
- mapControlCharactersToPrintableCharacters: aBooleanOrNil
- 
- 	aBooleanOrNil
- 		ifNil: [
- 			KeyDecodePreferences
- 				removeKey: #mapControlCharactersToPrintableCharacters
- 				ifAbsent: []]
- 		ifNotNil: [
- 			KeyDecodePreferences
- 				at: #mapControlCharactersToPrintableCharacters
- 				put: aBooleanOrNil].
- 			
- 	self installKeyDecodeTable.!

Item was removed:
- ----- Method: EventSensor class>>mapControlKeysToCommandKeys (in category 'preferences') -----
- mapControlKeysToCommandKeys
- 	<preference: 'Map CONTROL keys to COMMAND keys'
- 		categoryList: #(keyboard events input)
- 		description: 'On platforms other than macOS, users use the CONTROL modifier for many common shortcuts around text editing such as CTRL+C and CTRL+V for copy and paste. For the sake of cross-platform compatibility, however, many tools in this system will check for CMD+C and CMD+V instead. Note that on Linux and Windows platforms, keystrokes involving the (physical) ALT modifier typically arrive as COMMAND modifier. Thus, enable this preference if you still want to use CONTROL key instead of the ALT key for such shortcuts. (This preference replaces older duplicate/swap preferences.)'
- 		type: #Boolean>
- 		
- 	^ KeyDecodePreferences
- 		at: #mapControlKeysToCommandKeys
- 		ifAbsent: [true]!

Item was removed:
- ----- Method: EventSensor class>>mapControlKeysToCommandKeys: (in category 'preferences') -----
- mapControlKeysToCommandKeys: aBooleanOrNil
- 
- 	aBooleanOrNil
- 		ifNil: [
- 			KeyDecodePreferences
- 				removeKey: #mapControlKeysToCommandKeys
- 				ifAbsent: []]
- 		ifNotNil: [
- 			KeyDecodePreferences
- 				at: #mapControlKeysToCommandKeys
- 				put: aBooleanOrNil].
- 
- 	self installKeyDecodeTable.
- 	self installVirtualKeyTable.!

Item was removed:
- ----- Method: EventSensor class>>numMouseButtons (in category 'constants') -----
- numMouseButtons
- 	"We support three button mice."
- 
- 	^ 3!

Item was removed:
- ----- Method: EventSensor class>>shutDown (in category 'system startup') -----
- shutDown
- 	self default shutDown.!

Item was removed:
- ----- Method: EventSensor class>>simplifyVirtualKeyCodes (in category 'preferences') -----
- simplifyVirtualKeyCodes
- 	<preference: 'Simplify virtual-key codes'
- 		categoryList: #(keyboard events input)
- 		description: 'On some platforms, virtual-key codes (aka. scan codes) depend on the language setting (e.g. US, UK, DE), which is unkown to Squeak. Enable this preference to simplify overlapping codes to common symbols #squeak1, #squeak2, etc., which improves cross-platform compatibility but reduces the number of keys available for different handlers.'
- 		type: #Boolean>
- 		
- 	^ KeyDecodePreferences
- 		at: #simplifyVirtualKeyCodes
- 		ifAbsent: [true]!

Item was removed:
- ----- Method: EventSensor class>>simplifyVirtualKeyCodes: (in category 'preferences') -----
- simplifyVirtualKeyCodes: aBooleanOrNil
- 
- 	aBooleanOrNil = self simplifyVirtualKeyCodes
- 		ifTrue: [^ self].
- 
- 	aBooleanOrNil
- 		ifNil: [
- 			KeyDecodePreferences
- 				removeKey: #simplifyVirtualKeyCodes
- 				ifAbsent: []]
- 		ifNotNil: [
- 			KeyDecodePreferences
- 				at: #simplifyVirtualKeyCodes
- 				put: aBooleanOrNil].
- 			
- 	self installVirtualKeyTable.!

Item was removed:
- ----- Method: EventSensor class>>startUp: (in category 'system startup') -----
- startUp: resuming
- 
- 	resuming ifTrue: [
- 		Smalltalk platformName = 'Mac OS'
- 			ifTrue: [
- 				self mapAltKeysToOptionKeys: false.
- 				self mapControlKeysToCommandKeys: false]
- 			ifFalse: [
- 				self mapAltKeysToOptionKeys: true.
- 				self mapControlKeysToCommandKeys: true].
- 		self installVirtualKeyTable ].
- 
- 	self default startUp.!

Item was removed:
- ----- Method: EventSensor class>>swapControlAndAltKeys: (in category 'public') -----
- swapControlAndAltKeys: aBoolean
- 
- 	self deprecated: 'You cannnot swap CONTROL and ALT modifiers anymore. Please use other key-mapping preferences to fit your needs.'.!

Item was removed:
- ----- Method: EventSensor class>>swapMouseButtons: (in category 'public') -----
- swapMouseButtons: aBoolean
- 	"EventSensor swapMouseButtons: true"
- 
- 	Preferences setPreference: #swapMouseButtons toValue: aBoolean.
- 	self installMouseDecodeTable.!

Item was removed:
- ----- Method: EventSensor class>>swapMouseButtonsChanged (in category 'preference change notification') -----
- swapMouseButtonsChanged
- 
- 	self installMouseDecodeTable.!

Item was removed:
- ----- Method: EventSensor class>>virtualKeyAt: (in category 'virtual keys') -----
- virtualKeyAt: keyCode
- 	"Answers a representation for the (non-modifier) key, which should be consistent across platforms considering its cause."
- 
- 	^ self virtualKeyTable at: keyCode!

Item was removed:
- ----- Method: EventSensor class>>virtualKeyTable (in category 'virtual keys') -----
- virtualKeyTable
- 
- 	^ VirtualKeyTable ifNil: [self installVirtualKeyTable]!

Item was removed:
- ----- Method: EventSensor class>>virtualKeysOnMacOS (in category 'virtual keys') -----
- virtualKeysOnMacOS
- 	"Based on Carbon's Events.h -- https://snipplr.com/view/42797"
- 	
- 	^ Dictionary newFromPairs: {
- 		16r00 . $A. "#'kVK_ANSI_A'"
- 		16r01 . $S. "#'kVK_ANSI_S'"
- 		16r02 . $D. "#'kVK_ANSI_D'"
- 		16r03 . $F. "#'kVK_ANSI_F'"
- 		16r04 . $H. "#'kVK_ANSI_H'"
- 		16r05 . $G. "#'kVK_ANSI_G'"
- 		16r06 . $Z. "#'kVK_ANSI_Z'"
- 		16r07 . $X. "#'kVK_ANSI_X'"
- 		16r08 . $C. "#'kVK_ANSI_C'"
- 		16r09 . $V. "#'kVK_ANSI_V'"
- 		16r0B . $B. "#'kVK_ANSI_B'"
- 		16r0C . $Q. "#'kVK_ANSI_Q'"
- 		16r0D . $W. "#'kVK_ANSI_W'"
- 		16r0E . $E. "#'kVK_ANSI_E'"
- 		16r0F . $R. "#'kVK_ANSI_R'"
- 		16r10 . $Y. "#'kVK_ANSI_Y'"
- 		16r11 . $T. "#'kVK_ANSI_T'"
- 		16r12 . $1. "#'kVK_ANSI_1'"
- 		16r13 . $2. "#'kVK_ANSI_2'"
- 		16r14 . $3. "#'kVK_ANSI_3'"
- 		16r15 . $4. "#'kVK_ANSI_4'"
- 		16r16 . $6. "#'kVK_ANSI_6'"
- 		16r17 . $5. "#'kVK_ANSI_5'"
- 		16r18 . (self simplifyVirtualKeyCodes ifTrue: [#squeak2] ifFalse: [#'kVK_ANSI_Equal']).
- 		16r19 . $9. "#'kVK_ANSI_9'"
- 		16r1A . $7. "#'kVK_ANSI_7'"
- 		16r1B . (self simplifyVirtualKeyCodes ifTrue: [#squeak1] ifFalse: [#'kVK_ANSI_Minus']).
- 		16r1C . $8. "#'kVK_ANSI_8'"
- 		16r1D . $0. "#'kVK_ANSI_0'"
- 		16r1E . (self simplifyVirtualKeyCodes ifTrue: [#squeak2] ifFalse: [#'kVK_ANSI_RightBracket']).
- 		16r1F . $O. "#'kVK_ANSI_O'"
- 		16r20 . $U. "#'kVK_ANSI_U'"
- 		16r21 . (self simplifyVirtualKeyCodes ifTrue: [#squeak1] ifFalse: [#'kVK_ANSI_LeftBracket']).
- 		16r22 . $I. "#'kVK_ANSI_I'"
- 		16r23 . $P. "#'kVK_ANSI_P'"
- 		16r25 . $L. "#'kVK_ANSI_L'"
- 		16r26 . $J. "#'kVK_ANSI_J'"
- 		16r27 . (self simplifyVirtualKeyCodes ifTrue: [#squeak3] ifFalse: [#'kVK_ANSI_Quote']).
- 		16r28 . $K. "#'kVK_ANSI_K'"
- 		16r29 . (self simplifyVirtualKeyCodes ifTrue: [#squeak1] ifFalse: [#'kVK_ANSI_Semicolon']).
- 		16r2A . (self simplifyVirtualKeyCodes ifTrue: [#squeak1] ifFalse: [#'kVK_ANSI_Backslash']).
- 		16r2B . #squeakComma. "#'kVK_ANSI_Comma'"
- 		16r2C . (self simplifyVirtualKeyCodes ifTrue: [#squeak1] ifFalse: [#'kVK_ANSI_Slash']).
- 		16r2D . $N. "#'kVK_ANSI_N'"
- 		16r2E . $M. "#'kVK_ANSI_M'"
- 		16r2F . #squeakPeriod. "#'kVK_ANSI_Period'"
- 		16r32 . (self simplifyVirtualKeyCodes ifTrue: [#squeak4] ifFalse: [#'kVK_ANSI_Grave']).
- 		16r41 . #numDec. "#'kVK_ANSI_KeypadDecimal'"
- 		16r43 . #numMul. "#'kVK_ANSI_KeypadMultiply'"
- 		16r45 . #numAdd. "#'kVK_ANSI_KeypadPlus'"
- 		16r47 . #numClr. "#'kVK_ANSI_KeypadClear'"
- 		16r4B . #numDiv. "#'kVK_ANSI_KeypadDivide'"
- 		16r4C . (self simplifyVirtualKeyCodes ifTrue: [Character return] ifFalse: [Character enter]). "#'kVK_ANSI_KeypadEnter'"
- 		16r4E . #numSub. "#'kVK_ANSI_KeypadMinus'"
- 		16r51 . #numEqu. "#'kVK_ANSI_KeypadEquals'"
- 		16r52 . #num0. "#'kVK_ANSI_Keypad0'"
- 		16r53 . #num1. "#'kVK_ANSI_Keypad1'"
- 		16r54 . #num2. "#'kVK_ANSI_Keypad2'"
- 		16r55 . #num3. "#'kVK_ANSI_Keypad3'"
- 		16r56 . #num4. "#'kVK_ANSI_Keypad4'"
- 		16r57 . #num5. "#'kVK_ANSI_Keypad5'"
- 		16r58 . #num6. "#'kVK_ANSI_Keypad6'"
- 		16r59 . #num7. "#'kVK_ANSI_Keypad7'"
- 		16r5B . #num8. "#'kVK_ANSI_Keypad8'"
- 		16r5C . #num9. "#'kVK_ANSI_Keypad9'"
- 		16r24 . Character return. "#'kVK_Return'"
- 		16r30 . Character tab. "#'kVK_Tab'"
- 		16r31 . Character space. "#'kVK_Space'"
- 		16r33 . Character backspace. "#'kVK_Delete'"
- 		16r35 . Character escape. "#'kVK_Escape'"
- 		16r36 . #command. "#'kVK_RightCommand'"
- 		16r37 . #command. "#'kVK_Command'"
- 		16r38 . #shift. "#'kVK_Shift'"
- 		16r39 . #capsLock. "#'kVK_CapsLock'"
- 		16r3A . #option. "#'kVK_Option'"
- 		16r3B . #control. "#'kVK_Control'"
- 		16r3C . #shift. "#'kVK_RightShift'"
- 		16r3D . #option. "#'kVK_RightOption'"
- 		16r3E . #control. "#'kVK_RightControl'"
- 		16r3F . #'kVK_Function'.
- 		16r40 . #F17. "#'kVK_F17'"
- 		16r48 . #'kVK_VolumeUp'.
- 		16r49 . #'kVK_VolumeDown'.
- 		16r4A . #'kVK_Mute'.
- 		16r4F . #F18. "#'kVK_F18'"
- 		16r50 . #F19. "#'kVK_F19'"
- 		16r5A . #F20. "#'kVK_F20'"
- 		16r60 . #F5. "#'kVK_F5'"
- 		16r61 . #F6. "#'kVK_F6'"
- 		16r62 . #F7. "#'kVK_F7'"
- 		16r63 . #F3. "#'kVK_F3'"
- 		16r64 . #F8. "#'kVK_F8'"
- 		16r65 . #F9. "#'kVK_F9'"
- 		16r67 . #F11. "#'kVK_F11'"
- 		16r69 . #F13. "#'kVK_F13'"
- 		16r6A . #F16. "#'kVK_F16'"
- 		16r6B . #F14. "#'kVK_F14'"
- 		16r6D . #F10. "#'kVK_F10'"
- 		16r6F . #F12. "#'kVK_F12'"
- 		16r71 . #F15. "#'kVK_F15'"
- 		16r72 . #help. "#'kVK_Help'"
- 		16r73 . Character home. "#'kVK_Home'"
- 		16r74 . Character pageUp. "#'kVK_PageUp'"
- 		16r75 . Character delete. "#'kVK_ForwardDelete'"
- 		16r76 . #F4. "#'kVK_F4'"
- 		16r77 . Character end. "#'kVK_End'"
- 		16r78 . #F2. "#'kVK_F2'"
- 		16r79 . Character pageDown. "#'kVK_PageDown'"
- 		16r7A . #F1. "#'kVK_F1'"
- 		16r7B . Character arrowLeft. "#'kVK_LeftArrow'"
- 		16r7C . Character arrowRight. "#'kVK_RightArrow'"
- 		16r7D . Character arrowDown. "#'kVK_DownArrow'"
- 		16r7E . Character arrowUp. "#'kVK_UpArrow'"
- 		16r0A . (self simplifyVirtualKeyCodes ifTrue: [#squeak1] ifFalse: [#'kVK_ISO_Section']).
- 		16r5D . #'kVK_JIS_Yen'.
- 		16r5E . #'kVK_JIS_Underscore'.
- 		16r5F . #'kVK_JIS_KeypadComma'.
- 		16r66 . #'kVK_JIS_Eisu'.
- 		16r68 . #'kVK_JIS_Kana'.
- 	}
- 
- !

Item was removed:
- ----- Method: EventSensor class>>virtualKeysOnWindows (in category 'virtual keys') -----
- virtualKeysOnWindows
- 	"https://docs.microsoft.com/en-us/windows/win32/inputdev/virtual-key-codes
- 	
- 	Tweaked to Windows 10 Version 20H2 (Build 19042.928)
- 	Microsoft Surface Pro 6 (GERMAN)"
- 
- 	| table |
- 	table := Dictionary new.	
- 	{
- 		"16r01"	Character home. "#'VK_HOME'" "Overshadows #'VK_LBUTTON' --- Left mouse button"
- 		"16r02"	#'VK_RBUTTON'. "Right mouse button"
- 		"16r03"	#'VK_CANCEL'. "Control-break processing"
- 		"16r04"	Character end. "#'VK_END'" "Overshadows #'VK_MBUTTON' --- Middle mouse button"
- 		"16r05"	Character insert. "#'VK_INSERT'" "Overshadows #'VK_XBUTTON1' --- X1 mouse button"
- 		"16r06"	#'VK_XBUTTON2'. "X2 mouse button"
- 		"16r07"	nil.
- 		"16r08"	Character backspace. "#'VK_BACK'"
- 		"16r09"	Character tab. "#'VK_TAB'"
- 		"16r0A"	nil.
- 		"16r0B"	Character pageUp. "#'VK_PRIOR'" "PAGE UP key"
- 		"16r0C"	Character pageDown. "#'VK_NEXT'" "PAGE DOWN key --- overshadows #'VK_CLEAR'"
- 		"16r0D"	Character return. "#'VK_RETURN'" "ENTER key"
- 		"16r0E"	nil.
- 		"16r0F"	nil.
- 		"16r10"	#shift. "#'VK_SHIFT'"
- 		"16r11"	(self mapControlKeysToCommandKeys ifTrue: [#command] ifFalse: [#control]). "#'VK_CONTROL'"
- 		"16r12"	(self mapAltKeysToOptionKeys ifTrue: [#option] ifFalse: [#command "aka. #alt"]). "#'VK_MENU'"
- 		"16r13"	#'VK_PAUSE'.
- 		"16r14"	#capsLock. "#'VK_CAPITAL'"
- 		"16r15"	#'VK_KANA'. "IME Kana/Hangul mode"
- 		"16r16"	#'VK_IME_ON'. "IME on"
- 		"16r17"	#'VK_JUNJA'. "IMA Junja mode"
- 		"16r18"	#'VK_FINAL'. "IME final mode"
- 		"16r19"	#'VK_KANJI'. "IME Kanji/Hanja mode"
- 		"16r1A"	#'VK_IME_OFF'. "IME off"
- 		"16r1B"	Character escape. "#'VK_ESCAPE'"
- 		"16r1C"	Character arrowLeft. "#'VK_LEFT'" "LEFT ARROW. Overshadows #'VK_CONVERT' --- IME convert"
- 		"16r1D"	Character arrowRight. "#'VK_RIGHT'" "RIGHT ARROW. Overshadows 'VK_NONCONVERT' --- IME nonconvert"
- 		"16r1E"	Character arrowUp. "#'VK_UP'" "UP ARROW. Overshadows #'VK_ACCEPT' --- IME accept"
- 		"16r1F"	Character arrowDown. "#'VK_DOWN'" "DOWN ARROW. Overshadows #'VK_MODECHANGE' --- IME mode change request"
- 		"16r20"	Character space. "#'VK_SPACE'" "SPACEBAR"
- 		"16r21"	#'VK_PRIOR'. "PAGE UP key. Not needed. See 16r0B"
- 		"16r22"	#'VK_NEXT'. "PAGE DOWN key. Not needed. See 16r0C"
- 		"16r23"	#'VK_END'. "Not needed. See 16r04"
- 		"16r24"	#'VK_HOME'. "Not needed. See 16r01"
- 		"16r25"	#'VK_LEFT'. "LEFT ARROW. Not needed. See 16r1C"
- 		"16r26"	#'VK_UP'. "UP ARROW. Not needed. See 16r1E"
- 		"16r27"	#'VK_RIGHT'. "RIGHT ARROW. Not needed. See 16r1D"
- 		"16r28"	#'VK_DOWN'. "DOWN ARROW. Not needed. See 16r1F"
- 		"16r29"	#'VK_SELECT'.
- 		"16r2A"	#'VK_PRINT'.
- 		"16r2B"	#'VK_EXECUTE'.
- 		"16r2C"	#'VK_SNAPSHOT'. "PRINT SCREEN key"
- 		"16r2D"	#'VK_INSERT'. "Not needed. See 16r05"
- 		"16r2E"	#F16. "#'VK_F16' swapped with #'VK_DELETE'. See 16r7F"
- 		"16r2F"	#help. "#'VK_HELP'"
- 		"16r30"	$0.
- 		"16r31"	$1.
- 		"16r32"	$2.
- 		"16r33"	$3.
- 		"16r34"	$4.
- 		"16r35"	$5.
- 		"16r36"	$6.
- 		"16r37"	$7.
- 		"16r38"	$8.
- 		"16r39"	$9.
- 		"16r3A"	nil.
- 		"16r3B"	nil.
- 		"16r3C"	nil.
- 		"16r3D"	nil.
- 		"16r3E"	nil.
- 		"16r3F"	nil.
- 		"16r40"	nil.
- 		"16r41"	$A.
- 		"16r42"	$B.
- 		"16r43"	$C.
- 		"16r44"	$D.
- 		"16r45"	$E.
- 		"16r46"	$F.
- 		"16r47"	$G.
- 		"16r48"	$H.
- 		"16r49"	$I.
- 		"16r4A"	$J.
- 		"16r4B"	$K.
- 		"16r4C"	$L.
- 		"16r4D"	$M.
- 		"16r4E"	$N.
- 		"16r4F"	$O.
- 		"16r50"	$P.
- 		"16r51"	$Q.
- 		"16r52"	$R.
- 		"16r53"	$S.
- 		"16r54"	$T.
- 		"16r55"	$U.
- 		"16r56"	$V.
- 		"16r57"	$W.
- 		"16r58"	$X.
- 		"16r59"	$Y.
- 		"16r5A"	$Z.
- 		"16r5B"	#'VK_LWIN'. "Left Windows key"
- 		"16r5C"	#'VK_RWIN'. "Right windows key"
- 		"16r5D"	#'VK_APPS'. "Applications key"
- 		"16r5E"	nil.
- 		"16r5F"	#'VK_SLEEP'. "Computer Sleep Key"
- 		"16r60"	#num0. "#'VK_NUMPAD0'"
- 		"16r61"	#num1. "#'VK_NUMPAD1'"
- 		"16r62"	#num2. "#'VK_NUMPAD2'"
- 		"16r63"	#num3. "#'VK_NUMPAD3'"
- 		"16r64"	#num4. "#'VK_NUMPAD4'"
- 		"16r65"	#num5. "#'VK_NUMPAD5'"
- 		"16r66"	#num6. "#'VK_NUMPAD6'"
- 		"16r67"	#num7. "#'VK_NUMPAD7'"
- 		"16r68"	#num8. "#'VK_NUMPAD8'"
- 		"16r69"	#num9. "#'VK_NUMPAD9'"
- 		"16r6A"	#numMul. "#'VK_MULTIPLY'"
- 		"16r6B"	#numAdd. "#'VK_ADD'"
- 		"16r6C"	#'VK_SEPARATOR'.
- 		"16r6D"	#numSub. "#'VK_SUBTRACT'"
- 		"16r6E"	#numDec. "#'VK_DECIMAL'"
- 		"16r6F"	#numDiv. "#'VK_DIVIDE'"
- 		"16r70"	#F1. "#'VK_F1'"
- 		"16r71"	#F2. "#'VK_F2'"
- 		"16r72"	#F3. "#'VK_F3'"
- 		"16r73"	#F4. "#'VK_F4'"
- 		"16r74"	#F5. "#'VK_F5'"
- 		"16r75"	#F6. "#'VK_F6'"
- 		"16r76"	#F7. "#'VK_F7'"
- 		"16r77"	#F8. "#'VK_F8'"
- 		"16r78"	#F9. "#'VK_F9'"
- 		"16r79"	#F10. "#'VK_F10'"
- 		"16r7A"	#F11. "#'VK_F11'"
- 		"16r7B"	#F12. "#'VK_F12'"
- 		"16r7C"	#F13. "#'VK_F13'"
- 		"16r7D"	#F14. "#'VK_F14'"
- 		"16r7E"	#F15. "#'VK_F15'"
- 		"16r7F"	Character delete. "#'VK_DELETE' swapped with #'VK_F16'. See 16r2E"
- 		"16r80"	#F17. "#'VK_F17'"
- 		"16r81"	#F18. "#'VK_F18'"
- 		"16r82"	#F19. "#'VK_F19'"
- 		"16r83"	#F20. "#'VK_F20'"
- 		"16r84"	#F21. "#'VK_F21'"
- 		"16r85"	#F22. "#'VK_F22'"
- 		"16r86"	#F23. "#'VK_F23'"
- 		"16r87"	#F24. "#'VK_F24'"
- 		"16r88"	nil.
- 		"16r89"	nil.
- 		"16r8A"	nil.
- 		"16r8B"	nil.
- 		"16r8C"	nil.
- 		"16r8D"	nil.
- 		"16r8E"	nil.
- 		"16r8F"	nil.
- 		"16r90"	#'VK_NUMLOCK'.
- 		"16r91"	#'VK_SCROLL'.
- 		"16r92"	nil.
- 		"16r93"	nil.
- 		"16r94"	nil.
- 		"16r95"	nil.
- 		"16r96"	nil.
- 		"16r97"	nil.
- 		"16r98"	nil.
- 		"16r99"	nil.
- 		"16r9A"	nil.
- 		"16r9B"	nil.
- 		"16r9C"	nil.
- 		"16r9D"	nil.
- 		"16r9E"	nil.
- 		"16r9F"	nil.
- 		"16rA0"	#'VK_LSHIFT'.
- 		"16rA1"	#'VK_RSHIFT'.
- 		"16rA2"	#'VK_LCONTROL'.
- 		"16rA3"	#'VK_RCONTROL'.
- 		"16rA4"	#'VK_LMENU'.
- 		"16rA5"	#'VK_RMENU'.
- 		"16rA6"	#'VK_BROWSER_BACK'.
- 		"16rA7"	#'VK_BROWSER_FORWARD'.
- 		"16rA8"	#'VK_BROWSER_REFRESH'.
- 		"16rA9"	#'VK_BROWSER_STOP'.
- 		"16rAA"	#'VK_BROWSER_SEARCH'.
- 		"16rAB"	#'VK_BROWSER_FAVORITES'.
- 		"16rAC"	#'VK_BROWSER_HOME'.
- 		"16rAD"	#'VK_VOLUME_MUTE'.
- 		"16rAE"	#'VK_VOLUME_DOWN'.
- 		"16rAF"	#'VK_VOLUME_UP'.
- 		"16rB0"	#'VK_MEDIA_NEXT_TRACK'.
- 		"16rB1"	#'VK_MEDIA_PREV_TRACK'.
- 		"16rB2"	#'VK_MEDIA_STOP'.
- 		"16rB3"	#'VK_MEDIA_PLAY_PAUSE'.
- 		"16rB4"	#'VK_LAUNCH_MAIL'.
- 		"16rB5"	#'VK_LAUNCH_MEDIA_SELECT'.
- 		"16rB6"	#'VK_LAUNCH_APP1'.
- 		"16rB7"	#'VK_LAUNCH_APP2'.
- 		"16rB8"	nil.
- 		"16rB9"	nil
- 	} withIndexDo: [ :val :i | table at: i put: val] .
- 
- 	{
- 		16rBA . (self simplifyVirtualKeyCodes ifTrue: [#squeak1] ifFalse: [#'VK_OEM_1']).
- 		"Used for miscellaneous characters; it can vary by keyboard. For the US standard keyboard, the ;: key"
- 	
- 		16rBB . (self simplifyVirtualKeyCodes ifTrue: [#squeak2] ifFalse: [#'VK_OEM_PLUS']).
- 		"For any country/region, the + key -- mt. Haha. You wish."
- 	
- 		16rBC . #squeakComma. "#'VK_OEM_COMMA'" "For any country/region, the , key"
- 	
- 		16rBD .  (self simplifyVirtualKeyCodes ifTrue: [#squeak1] ifFalse: [#'VK_OEM_MINUS']).
- 		"For any country/region, the - key"
- 	
- 		16rBE . #squeakPeriod. "#'VK_OEM_PERIOD'" "For any country/region, the . key"
- 	
- 		16rBF . (self simplifyVirtualKeyCodes ifTrue: [#squeak1] ifFalse: [#'VK_OEM_2']).
- 		"Used for miscellaneous characters; it can vary by keyboard. For the US standard keyboard, the /? key"
- 	
- 		16rC0 . (self simplifyVirtualKeyCodes ifTrue: [#squeak1] ifFalse: [#'VK_OEM_3']).
- 		"Used for miscellaneous characters; it can vary by keyboard. For the US standard keyboard, the `~ key'"
- 	} pairsDo: [ :i :val | table at: i put: val] .
- 
- 	16rC1	to: 16rDA
- 		do: [ :e | table at: e put: nil ].
- 
- 	{	
- 	
- 		16rDB . (self simplifyVirtualKeyCodes ifTrue: [#squeak1] ifFalse: [#'VK_OEM_4']).
- 		"Used for miscellaneous characters; it can vary by keyboard. For the US standard keyboard, the [{ key"
- 	
- 		16rDC . (self simplifyVirtualKeyCodes ifTrue: [#squeak1] ifFalse: [#'VK_OEM_5']).
- 		"Used for miscellaneous characters; it can vary by keyboard. For the US standard keyboard, the \| key"
- 	
- 		16rDD . (self simplifyVirtualKeyCodes ifTrue: [#squeak2] ifFalse: [#'VK_OEM_6']).
- 		"Used for miscellaneous characters; it can vary by keyboard. For the US standard keyboard, the ]} key"
- 	
- 		16rDE . (self simplifyVirtualKeyCodes ifTrue: [#squeak3] ifFalse: [#'VK_OEM_7']).
- 		"Used for miscellaneous characters; it can vary by keyboard. For the US standard keyboard, the single-quote/double-quote key"
- 	
- 		16rDF . #'VK_OEM_8'.
- 		"Used for miscellaneous characters; it can vary by keyboard."
- 	
- 		16rE0 . nil.
- 		16rE1 . nil.
- 	
- 		16rE2 . (self simplifyVirtualKeyCodes ifTrue: [#squeak4] ifFalse: [#'VK_OEM_102']). 
- 		"Either the angle bracket key or the backslash key on the RT 102-key keyboard"
- 	
- 		16rE3 . nil.
- 		16rE4 . nil.
- 		16rE5 . #'VK_PROCESSKEY'. "IME PROCESS key"
- 		16rE6 . nil.
- 		16rE7 . #'VK_PACKET'. "Used to pass Unicode characters as if they were keystrokes. The VK_PACKET key is the low word of a 32-bit Virtual Key value used for non-keyboard input methods."
- 	} pairsDo: [ :i :val | table at: i put: val] .
- 
- 	16rE8	to: 16rF5
- 		do: [ :e | table at: e put: nil ].
- 
- 	{
- 		16rF6 . #'VK_ATTN'.
- 		16rF7 . #'VK_CRSEL'.
- 		16rF8 . #'VK_EXSEL'.
- 		16rF9 . #'VK_EREOF'. "Erase EOF key"
- 		16rFA . #'VK_PLAY'.
- 		16rFB . #'VK_ZOOM'.
- 		16rFC . #'VK_NONAME'. "Reserved"
- 		16rFD . #'VK_PA1'.
- 		16rFE . #'VK_OEM_CLEAR'. "Clear key"
- 	
- 	} pairsDo: [ :i :val | table at: i put: val] .
- 
- 	^table
- 
- !

Item was removed:
- ----- Method: EventSensor class>>virtualKeysOnX11 (in category 'virtual keys') -----
- virtualKeysOnX11
- 	"Based on the OSVM X11 code as of 202104182333"
- 	"https://code.woboq.org/kde/include/X11/keysymdef.h.html"
- 
- 	"!!!!!! There are non-printable control keys for keyDown events on X11. Sigh."
- 	self flag: #todo. "Linux VM is broken. We need scancodes but we get actual character codes. It is really hard to determine physical keys from that."
- 
- 	^ Dictionary newFromPairs: {
- 		"Regular ASCII"
- 		16r41 . $A.
- 		16r42 . $B.
- 		16r43 . $C.
- 		16r44 . $D.
- 		16r45 . $E.
- 		16r46 . $F.
- 		16r47 . $G.
- 		16r48 . $H.
- 		16r49 . $I.
- 		16r4A . $J.
- 		16r4B . $K.
- 		16r4C . $L.
- 		16r4D . $M.
- 		16r4E . $N.
- 		16r4F . $O.
- 		16r50 . $P.
- 		16r51 . $Q.
- 		16r52 . $R.
- 		16r53 . $S.
- 		16r54 . $T.
- 		16r55 . $U.
- 		16r56 . $V.
- 		16r57 . $W.
- 		16r58 . $X.
- 		16r59 . $Y.
- 		16r5A . $Z.
- 
- 		"Regular ASCII - numbers"
- 		16r30 . $0.
- 		16r31 . $1.
- 		16r32 . $2.
- 		16r33 . $3.
- 		16r34 . $4.
- 		16r35 . $5.
- 		16r36 . $6.
- 		16r37 . $7.
- 		16r38 . $8.
- 		16r39 . $9.
- 
- 		"Mapped to uppercase when SHIFT is pressed ... sigh ..."
- 		16r61 . $A.
- 		16r62 . $B.
- 		16r63 . $C.
- 		16r64 . $D.
- 		16r65 . $E.
- 		16r66 . $F.
- 		16r67 . $G.
- 		16r68 . $H.
- 		16r69 . $I.
- 		16r6A . $J.
- 		16r6B . $K.
- 		16r6C . $L.
- 		16r6D . $M.
- 		16r6E . $N.
- 		16r6F . $O.
- 		16r70 . $P.
- 		16r71 . $Q.
- 		16r72 . $R.
- 		16r73 . $S.
- 		16r74 . $T.
- 		16r75 . $U.
- 		16r76 . $V.
- 		16r77 . $W.
- 		16r78 . $X.
- 		16r79 . $Y.
- 		16r7A . $Z.
- 
- 		"most common non-printable control characters"
- 		16r01 . Character home.
- 		16r03 . Character enter.
- 		16r04 . Character end.
- 		16r05 . Character insert.
- 		16r08 . Character backspace.
- 		16r09 . Character tab.
- 		16r0B . Character pageUp.
- 		16r0C . Character pageDown.
- 		16r0D . Character return.
- 		16r1B . Character escape.
- 		16r1C . Character arrowLeft.
- 		16r1D . Character arrowRight.
- 		16r1E . Character arrowUp.
- 		16r1F . Character arrowDown.
- 		16r20 . Character space.
- 
- 		16r7F . Character delete.
- 
- 		"Physical modifier keys"
- 		16rF7 . (self mapAltKeysToOptionKeys ifTrue: [#option] ifFalse: [#command "aka. #alt"]). "#'XK_Alt_L'"
- 		16rFE . #shift. "#'XK_Shift_R'"
- 		16rFF . #shift. "#'XK_Shift_L'."
- 		16rFA .  (self mapControlKeysToCommandKeys ifTrue: [#command] ifFalse: [#control]). "#'XK_Control_R'"
- 		16rFB .  (self mapControlKeysToCommandKeys ifTrue: [#command] ifFalse: [#control]). "#'XK_Control_L'."
- 		16rFD . #capsLock. "#'XK_Caps_Lock'."
- 
- 		"Try to make sense of some other key characters. Hmpf."
- 		16r22 . #squeak1.
- 		16r23 . #squeak1.
- 		16r27 . #squeak1.
- 		16r2D . #squeak1.
- 		16r2F . #squeak1.
- 		16r3A . #squeak1.
- 		16r3B . #squeak1.
- 		16r3C . #squeak1.
- 		16r3E . #squeak1.
- 		16r3F . #squeak1.
- 		16r5B . #squeak1.
- 		16r5C . #squeak1.
- 		16r5E . #squeak1.
- 		16r5F . #squeak1.
- 		16r60 . #squeak1.
- 		16r7B . #squeak1.
- 		16r7C . #squeak1.
- 		16r7E . #squeak1.
- 		16rC2 . #squeak1.
- 		16rC3 . #squeak1.
- 
- 		16r2A . #squeak2.
- 		16r2B . #squeak2.
- 		16r3D . #squeak2.
- 		16r5D . #squeak2.
- 		16r7D . #squeak2.
- 
- 		16r2C . #squeakComma.
- 		16r2E . #squeakPeriod.
- 	}
- 
- !

Item was removed:
- ----- Method: EventSensor>>anyButtonPressed (in category 'mouse') -----
- anyButtonPressed
- 	"Answer whether at least one mouse button is currently being pressed."
- 
- 	^ self peekButtons anyMask: 7
- !

Item was removed:
- ----- Method: EventSensor>>anyModifierKeyPressed (in category 'modifier keys') -----
- anyModifierKeyPressed
- 	"ignore, however, the shift keys 'cause that's not REALLY a modifier key"
- 
- 	^ self peekButtons anyMask: (2r1110 "cmd | opt | ctrl" bitShift: EventSensor numMouseButtons)!

Item was removed:
- ----- Method: EventSensor>>blueButtonPressed (in category 'mouse') -----
- blueButtonPressed
- 	"Answer whether only the blue mouse button is being pressed. 
- 	This is the third mouse button or cmd+click on the Mac."
- 
- 	^ (self peekButtons bitAnd: 7) = 1
- !

Item was removed:
- ----- Method: EventSensor>>commandKeyPressed (in category 'modifier keys') -----
- commandKeyPressed
- 	"Answer whether the command key on the keyboard is being held down."
- 
- 	^ self peekButtons anyMask: (2r1000 "cmd" bitShift: EventSensor numMouseButtons)!

Item was removed:
- ----- Method: EventSensor>>controlKeyPressed (in category 'modifier keys') -----
- controlKeyPressed
- 	"Answer whether the control key on the keyboard is being held down."
- 
- 	^ self peekButtons anyMask: (2r0010 "ctrl" bitShift: EventSensor numMouseButtons)!

Item was removed:
- ----- Method: EventSensor>>createMouseEvent (in category 'mouse') -----
- createMouseEvent
- 	"create and return a new mouse event from the current mouse 
- 	position; this is useful for restarting normal event queue 
- 	processing after manual polling"
- 
- 	| buttons modifiers pos mapped eventBuffer |
- 	eventBuffer := Array new: 8.
- 	buttons := self peekButtons.
- 	pos := self peekPosition.
- 	modifiers := buttons bitShift: -3.
- 	buttons := buttons bitAnd: 7.
- 	mapped := self mapButtons: buttons modifiers: modifiers.
- 	eventBuffer
- 		at: 1
- 		put: EventTypeMouse;
- 		 at: 2 put: self eventTimeNow;
- 		 at: 3 put: pos x;
- 		 at: 4 put: pos y;
- 		 at: 5 put: mapped;
- 		 at: 6 put: modifiers.
- 	^ eventBuffer!

Item was removed:
- ----- Method: EventSensor>>cursorPoint (in category 'mouse') -----
- cursorPoint
- 	"Answer a Point indicating the cursor location."
- 
- 	^ self peekPosition!

Item was removed:
- ----- Method: EventSensor>>cursorPoint: (in category 'mouse') -----
- cursorPoint: aPoint 
- 	"Set aPoint to be the current cursor location."
- 
- 	^self primCursorLocPut: aPoint!

Item was removed:
- ----- Method: EventSensor>>eventQueue (in category 'accessing') -----
- eventQueue
- 	^ eventQueue!

Item was removed:
- ----- Method: EventSensor>>eventQueue: (in category 'accessing') -----
- eventQueue: aSharedQueue
- 	eventQueue := aSharedQueue.!

Item was removed:
- ----- Method: EventSensor>>eventTickler (in category 'private') -----
- eventTickler
- 	"Poll infrequently to make sure that the UI process is not been stuck. 
- 	If it has been stuck, then spin the event loop so that I can detect the 
- 	interrupt key."
- 	| delay |
- 	delay := Delay forMilliseconds: self class eventPollPeriod.
- 	self lastEventPoll.	"ensure not nil."
- 	[| delta | 
- 	[ delay wait.
- 	delta := Time millisecondClockValue - lastEventPoll.
- 	(delta < 0
- 			or: [delta > self class eventPollPeriod])
- 		ifTrue:
- 			["force check on rollover"
- 			self fetchMoreEvents]]
- 		on: Error do: [:ex | ]] repeat.!

Item was removed:
- ----- Method: EventSensor>>eventTicklerProcess (in category 'accessing') -----
- eventTicklerProcess
- 	"Answer my event tickler process, if any"
- 	^EventTicklerProcess!

Item was removed:
- ----- Method: EventSensor>>eventTimeNow (in category 'private') -----
- eventTimeNow
- 	"Answer an event timeStamp that is slightly more recent than that of
- 	the most recently processed event. Intended for synthesized events to
- 	be processed in line with those from the real event queue."
- 
- 	^ lastEventTime + 1.
- !

Item was removed:
- ----- Method: EventSensor>>fetchMoreEvents (in category 'private-I/O') -----
- fetchMoreEvents
- 	"Fetch more events from the VM"
- 	| eventBuffer type |
- 
- 	"Reset input semaphore so clients can wait for the next events after this one."
- 	inputSemaphore isSignaled
- 		ifTrue: [ hasInputSemaphore := true.
- 			inputSemaphore initSignals ].
- 
- 	"Remember the last time that I checked for events."
- 	lastEventPoll := Time millisecondClockValue.
- 
- 	eventBuffer := Array new: 8.
- 	[self primGetNextEvent: eventBuffer.
- 	type := eventBuffer at: 1.
- 	type = EventTypeNone]
- 		whileFalse: [self processEvent: eventBuffer].
- !

Item was removed:
- ----- Method: EventSensor>>flushEvents (in category 'accessing') -----
- flushEvents
- 
- 	keyboardBuffer flush.
- 	mouseWheelDelta := 0 at 0.
- 
- 	self eventQueue ifNotNil: [:queue | queue flush].!

Item was removed:
- ----- Method: EventSensor>>hasTablet (in category 'tablet') -----
- hasTablet
- 	"Answer true if there is a pen tablet available on this computer."
- 
- 	^ (self primTabletGetParameters: 1) notNil
- !

Item was removed:
- ----- Method: EventSensor>>initialize (in category 'initialize') -----
- initialize
- 
- 	mouseButtons := 0.
- 	mousePosition := 0 at 0.
- 	mouseWheelDelta := 0 at 0.
- 	keyboardBuffer := SharedQueue new.
- 	
- 	interruptKey := $. asciiValue bitOr: 16r0800. 	"cmd-."
- 	interruptSemaphore := Semaphore new.
- 	
- 	eventQueue := SharedQueue new.
- 	
- 	inputSemaphore := Semaphore new.
- 	hasInputSemaphore := false.!

Item was removed:
- ----- Method: EventSensor>>installEventTickler (in category 'private') -----
- installEventTickler
- 	"Initialize the interrupt watcher process. Terminate the old process if any."
- 	"Sensor installEventTickler"
- 
- 	EventTicklerProcess ifNotNil: [EventTicklerProcess terminate].
- 	EventTicklerProcess := [self eventTickler] forkAt: Processor lowIOPriority.
- !

Item was removed:
- ----- Method: EventSensor>>installInterruptWatcher (in category 'user interrupts') -----
- installInterruptWatcher
- 	"Initialize the interrupt watcher process. Terminate the old process if any."
- 	"Sensor installInterruptWatcher"
- 
- 	InterruptWatcherProcess ifNotNil: [InterruptWatcherProcess terminate].
- 	InterruptWatcherProcess := [self userInterruptWatcher] forkAt: Processor lowIOPriority.!

Item was removed:
- ----- Method: EventSensor>>interruptWatcherProcess (in category 'user interrupts') -----
- interruptWatcherProcess
- 	"Answer my interrupt watcher process, if any"
- 	^InterruptWatcherProcess!

Item was removed:
- ----- Method: EventSensor>>isAnyKbdEvent: (in category 'private') -----
- isAnyKbdEvent: buf
- 	^(buf at: 1) = EventTypeKeyboard!

Item was removed:
- ----- Method: EventSensor>>isKbdEvent: (in category 'private') -----
- isKbdEvent: buf
- 	^ (buf at: 1) = EventTypeKeyboard and: [(buf at: 4) = EventKeyChar]!

Item was removed:
- ----- Method: EventSensor>>joystickButtons: (in category 'joystick') -----
- joystickButtons: index
- 
- 	^ ((self primReadJoystick: index) bitShift: -22) bitAnd: 16r71F
- 	!

Item was removed:
- ----- Method: EventSensor>>joystickOn: (in category 'joystick') -----
- joystickOn: index
- 
- 	^ (((self primReadJoystick: index) bitShift: -27) bitAnd: 1) ~= 0
- 	!

Item was removed:
- ----- Method: EventSensor>>joystickXY: (in category 'joystick') -----
- joystickXY: index
- 
- 	| inputWord x y |
- 	inputWord := self primReadJoystick: index.
- 	x := (inputWord bitAnd: 16r7FF) - 16r400.
- 	y := ((inputWord bitShift: -11) bitAnd: 16r7FF) - 16r400.
- 	^ x at y
- 	!

Item was removed:
- ----- Method: EventSensor>>lastEventPoll (in category 'private') -----
- lastEventPoll
- 	"Answer the last clock value at which fetchMoreEvents was called."
- 	^lastEventPoll ifNil: [ lastEventPoll := Time millisecondClockValue ]!

Item was removed:
- ----- Method: EventSensor>>leftShiftDown (in category 'modifier keys') -----
- leftShiftDown
- 	"Answer whether the shift key on the keyboard is being held down. The name of this message is a throwback to the Alto, which had independent left and right shift keys."
- 
- 	^ self peekButtons anyMask: 8!

Item was removed:
- ----- Method: EventSensor>>mapButtons:modifiers: (in category 'private-I/O') -----
- mapButtons: buttons modifiers: modifiers
- 	"Map the buttons to yellow or blue based on the given modifiers.
- 	If only the red button is pressed, then map
- 		Ctrl-RedButton -> BlueButton.
- 		Cmd-RedButton -> YellowButton.
- 	"
- 	(buttons = RedButtonBit)
- 		ifFalse:[^buttons].
- 	(modifiers allMask: CtrlKeyBit) 
- 		ifTrue:[^BlueButtonBit].
- 	(modifiers allMask: CommandKeyBit) 
- 		ifTrue:[^YellowButtonBit].
- 	^buttons!

Item was removed:
- ----- Method: EventSensor>>mouseButtons (in category 'mouse') -----
- mouseButtons
- 	"Answer a number from 0 to 7 that encodes the state of the three mouse buttons in its lowest 3 bits."
- 
- 	^ self peekButtons bitAnd: 7
- !

Item was removed:
- ----- Method: EventSensor>>nextEvent (in category 'accessing') -----
- nextEvent
- 	"Return the next event from the receiver. If the queue is empty, try to fetch more events once."
- 
- 	^ self eventQueue 
- 		ifNil: [
- 			self fetchMoreEvents.
- 			self nextEventSynthesized]
- 		ifNotNil: [:queue |
- 			keyboardBuffer flush.
- 			mouseWheelDelta := 0 at 0.
- 			queue isEmpty ifTrue: [self fetchMoreEvents].
- 			queue nextOrNil]!

Item was removed:
- ----- Method: EventSensor>>nextEventSynthesized (in category 'private') -----
- nextEventSynthesized
- 
- 	| synthesizedEvent |
- 	synthesizedEvent := self peekEventSynthesized.
- 	keyboardBuffer nextOrNil.
- 	^ synthesizedEvent!

Item was removed:
- ----- Method: EventSensor>>noButtonPressed (in category 'mouse') -----
- noButtonPressed
- 	"Answer whether any mouse button is not being pressed."
- 
- 	^self anyButtonPressed not
- !

Item was removed:
- ----- Method: EventSensor>>oldPrimInterruptSemaphore: (in category 'primitives-fallback') -----
- oldPrimInterruptSemaphore: aSemaphore 
- 	"Primitive. Install the argument as the semaphore to be signalled whenever the user presses the interrupt key. The semaphore will be signaled once each time the interrupt key is pressed."
- 
- 	<primitive: 134>
- 	^self primitiveFailed
- "Note: This primitive is obsolete with the new event driven architecture in which EventSensor can handle the interrupts itself. However, for supporting older images running on newer VMs the primitive must still be implemented."!

Item was removed:
- ----- Method: EventSensor>>oldPrimKbdNext (in category 'primitives-fallback') -----
- oldPrimKbdNext
- 	<primitive: 108>
- 	^ nil!

Item was removed:
- ----- Method: EventSensor>>oldPrimMouseButtons (in category 'primitives-fallback') -----
- oldPrimMouseButtons
- 	<primitive: 107>
- 	^ 0!

Item was removed:
- ----- Method: EventSensor>>oldPrimMousePt (in category 'primitives-fallback') -----
- oldPrimMousePt
- 	"Primitive. Poll the mouse to find out its position. Return a Point. Fail if
- 	event-driven tracking is used instead of polling. Optional. See Object
- 	documentation whatIsAPrimitive."
- 
- 	<primitive: 90>
- 	^ 0 at 0!

Item was removed:
- ----- Method: EventSensor>>oldPrimSetInterruptKey: (in category 'primitives-fallback') -----
- oldPrimSetInterruptKey: anInteger
- 	"Primitive. Register the given keycode as the user interrupt key. The low byte of the keycode is the ISO character and its next four bits are the Smalltalk modifer bits <cmd><opt><ctrl><shift>."
- 
- 	<primitive: 133>
- 	^self primitiveFailed
- "Note: This primitive is obsolete with the new event driven architecture in which EventSensor can handle the interrupts itself. However, for supporting older images running on newer VMs the primitive must still be implemented."!

Item was removed:
- ----- Method: EventSensor>>optionKeyPressed (in category 'modifier keys') -----
- optionKeyPressed
- 	"Answer whether the option key on the Macintosh keyboard is being held down. Macintosh specific.  Clients are discouraged from calling this directly, since it circumvents bert's attempt to eradicate option-key checks"
- 
- 	^ self peekButtons anyMask: (2r0100 "opt" bitShift: EventSensor numMouseButtons)!

Item was removed:
- ----- Method: EventSensor>>peekEvent (in category 'accessing') -----
- peekEvent
- 	"Look ahead at the next event. Try to fetch more events first."
- 
- 	^ self eventQueue
- 		ifNil: [
- 			self fetchMoreEvents.
- 			self peekEventSynthesized]
- 		ifNotNil: [:queue |
- 			queue isEmpty ifTrue: [self fetchMoreEvents].
- 			queue peek]!

Item was removed:
- ----- Method: EventSensor>>peekEventSynthesized (in category 'private') -----
- peekEventSynthesized
- 	"Return a synthesized event. This method is called if an event driven client wants to receive events but the primary user interface is not event-driven (e.g., the receiver does not have an event queue but only updates its state). This can, for instance, happen if a Morphic World is run in an MVC window. To simplify the clients work this method will always return all available keyboard events first, and then (repeatedly) the mouse events. Since mouse events come last, the client can assume that after one mouse event has been received there are no more to come. Note that it is impossible for EventSensor to determine if a mouse event has been issued before so the client must be aware of the possible problem of getting repeatedly the same mouse events. See HandMorph>>processEvents for an example on how to deal with this."
- 	| kbd array buttons pos modifiers mapped |
- 	"First check for keyboard"
- 	array := Array new: 8.
- 	keyboardBuffer isEmpty ifFalse:
- 		["simulate keyboard event"
- 		array at: 1 put: EventTypeKeyboard. "evt type"
- 		array at: 2 put: self eventTimeNow. "time stamp"
- 		array at: 3 put: ((kbd := keyboardBuffer peek) bitAnd: 255). "char code"
- 		array at: 4 put: EventKeyChar. "key press/release"
- 		array at: 5 put: (kbd bitShift: -8). "modifier keys"
- 		^ array].
- 
- 	"Then check for mouse"
- 	pos := mousePosition.
- 	buttons := mouseButtons.
- 	modifiers := buttons bitShift: -3.
- 	buttons := buttons bitAnd: 7.
- 	mapped := self mapButtons: buttons modifiers: modifiers.
- 	array 
- 		at: 1 put: EventTypeMouse;
- 		at: 2 put: self eventTimeNow;
- 		at: 3 put: pos x;
- 		at: 4 put: pos y;
- 		at: 5 put: mapped;
- 		at: 6 put: modifiers.
- 	^ array
- 
- !

Item was removed:
- ----- Method: EventSensor>>primCursorLocPut: (in category 'private-I/O') -----
- primCursorLocPut: aPoint
- 	"If the primitive fails, try again with a rounded point."
- 
- 	<primitive: 91>
- 	^ self primCursorLocPutAgain: aPoint rounded!

Item was removed:
- ----- Method: EventSensor>>primCursorLocPutAgain: (in category 'private-I/O') -----
- primCursorLocPutAgain: aPoint
- 	"Do nothing if primitive is not implemented."
- 
- 	<primitive: 91>
- 	^ self!

Item was removed:
- ----- Method: EventSensor>>primGetNextEvent: (in category 'private-I/O') -----
- primGetNextEvent: array
- 	"Store the next OS event available into the provided array.
- 	Essential. If the VM is not event driven the ST code will fall
- 	back to the old-style mechanism and use the state based
- 	primitives instead."
- 	| kbd buttons modifiers pos mapped |
- 	<primitive: 94>
- 	"Simulate the events"
- 	array at: 1 put: EventTypeNone. "assume no more events"
- 
- 	"First check for keyboard"
- 	kbd := self oldPrimKbdNext.
- 	kbd = nil ifFalse:[
- 		"simulate keyboard event"
- 		array at: 1 put: EventTypeKeyboard. "evt type"
- 		array at: 2 put: self eventTimeNow. "time stamp"
- 		array at: 3 put: (kbd bitAnd: 255). "char code"
- 		array at: 4 put: EventKeyChar. "key press/release"
- 		array at: 5 put: (kbd bitShift: -8). "modifier keys"
- 		^self].
- 
- 	"Then check for mouse"
- 	buttons := self oldPrimMouseButtons.
- 	pos := self oldPrimMousePt.
- 	modifiers := buttons bitShift: -3.
- 	buttons := buttons bitAnd: 7.
- 	mapped := self mapButtons: buttons modifiers: modifiers.
- 	(pos = mousePosition and:[(mapped bitOr: (modifiers bitShift: 3)) = mouseButtons])
- 		ifTrue:[^self].
- 	array 
- 		at: 1 put: EventTypeMouse;
- 		at: 2 put: self eventTimeNow;
- 		at: 3 put: pos x;
- 		at: 4 put: pos y;
- 		at: 5 put: mapped;
- 		at: 6 put: modifiers.
- !

Item was removed:
- ----- Method: EventSensor>>primReadJoystick: (in category 'primitives-tablet') -----
- primReadJoystick: index
- 	"Return the joystick input word for the joystick with the given index in the range [1..16]. Returns zero if the index does not correspond to a currently installed joystick."
- 
- 	<primitive: 'primitiveReadJoystick' module: 'JoystickTabletPlugin'>
- 	^ 0
- 
- 	!

Item was removed:
- ----- Method: EventSensor>>primSetInputSemaphore: (in category 'private-I/O') -----
- primSetInputSemaphore: semaIndex
- 	"Set the input semaphore the VM should use for asynchronously signaling the availability of events. Primitive. Optional."
- 	<primitive: 93>
- 	^nil!

Item was removed:
- ----- Method: EventSensor>>primTabletGetParameters: (in category 'primitives-tablet') -----
- primTabletGetParameters: cursorIndex
- 	"Answer the pen tablet parameters. For parameters that differ from cursor to cursor, answer those associated with the cursor having the given index. Answer nil if there is no pen tablet. The parameters are:
- 	1. tablet width, in tablet units
- 	2. tablet height, in tablet units
- 	3. number of tablet units per inch
- 	4. number of cursors (pens, pucks, etc; some tablets have more than one)
- 	5. this cursor index
- 	6. and 7. x scale and x offset for scaling tablet coordintes (e.g., to fit the screen)
- 	8. and 9. y scale and y offset for scaling tablet coordintes  (e.g., to fit the screen)
- 	10. number of pressure levels
- 	11. presure threshold needed close pen tip switch 
- 	12. number of pen tilt angles"
- 
- 	<primitive: 'primitiveGetTabletParameters' module: 'JoystickTabletPlugin'>
- 	^ nil
- !

Item was removed:
- ----- Method: EventSensor>>primTabletRead: (in category 'primitives-tablet') -----
- primTabletRead: cursorIndex
- 	"Answer the pen tablet data for the cursor having the given index. Answer nil if there is no pen tablet. The data is:
- 	1. index of the cursor to which this data applies
- 	2. timestamp of the last state chance for this cursor
- 	3., 4., and 5. x, y, and z coordinates of the cursor (z is typically 0)
- 	6. and 7. xTilt and yTilt of the cursor; (signed)
- 	8. type of cursor (0 = unknown, 1 = pen, 2 = puck, 3 = eraser)
- 	9. cursor buttons
- 	10. cursor pressure, downward
- 	11. cursor pressure, tangential
- 	12. flags"
- 
- 	<primitive: 'primitiveReadTablet' module: 'JoystickTabletPlugin'>
- 	self primitiveFailed
- !

Item was removed:
- ----- Method: EventSensor>>processEvent: (in category 'private-I/O') -----
- processEvent: evt 
- 	"Process a single event. This method is run at high priority."
- 	| type buttons window |
- 	type := evt at: 1.
- 	lastEventTime := evt at: 2.
- 
- 	"Only process main window events, forward others to host window proxies"
- 	window := evt at: 8.
- 	(window isNil or: [window isZero]) ifTrue: 
- 		[window := 1. 
- 		evt at: 8 put: window].
- 	window = 1 ifFalse: [
- 		^Smalltalk at: #HostWindowProxy ifPresent: [:w | w processEvent: evt]].
- 
- 	"Tackle mouse events and mouse wheel events first"
- 	(type = EventTypeMouse or: [type = EventTypeMouseWheel])
- 		ifTrue: [buttons := (ButtonDecodeTable at: (evt at: 5) + 1). 
- 				evt at: 5 put: (Smalltalk platformName = 'Mac OS'
- 							ifTrue: [ buttons ]
- 							ifFalse: [ self mapButtons: buttons modifiers: (evt at: 6) ]).
- 				self queueEvent: evt.
- 				type = EventTypeMouseWheel
- 					ifTrue: [^ self processMouseWheelEvent: evt].				
- 				type = EventTypeMouse
- 					ifTrue: [^ self processMouseEvent: evt]].
- 	
- 	"Store the event in the queue if there's any"
- 	type = EventTypeKeyboard
- 		ifTrue: [ "Check if the event is a user interrupt"
- 			((evt at: 4) = EventKeyChar
- 				and: [((evt at: 3)
- 						bitOr: (((evt at: 5)
- 							bitAnd: 8)
- 							bitShift: 8))
- 							= interruptKey])
- 					ifTrue: ["interrupt key is meta - not reported as event"
- 							^ interruptSemaphore signal].
- 			"Decode keys for characters (e.g., map ctrl -> cmd)."
- 			(evt at: 4) = EventKeyChar
- 				ifTrue: [ | unicode ascii |
- 					"Copy lookup key first in case of key swap."
- 					unicode := {evt at: 6. evt at: 5}.
- 					ascii := {evt at: 3. evt at: 5}.
- 					KeyDecodeTable "Unicode character first"
- 						at: unicode
- 						ifPresent: [:a | evt at: 6 put: a first;
- 								 at: 5 put: a second]. 
- 					KeyDecodeTable "ASCII character second"
- 						at: ascii
- 						ifPresent: [:a | evt at: 3 put: a first;
- 								 at: 5 put: a second]]
- 				ifFalse: ["Replace modifiers for virtual keys. (keyUp/keyDown)"
- 					(evt at: 5) > 0 "Any modifier pressed?" ifTrue: [
- 						VirtualKeyTable
- 							at: ((evt at: 5) bitShift: 8)
- 							ifPresent: [:a | evt at: 5 put: a]]].
- 			self queueEvent: evt. 
- 			self processKeyboardEvent: evt . 
- 			^self ].
- 				
- 	"Handle all events other than Keyboard or Mouse."
- 	self queueEvent: evt.
- 	!

Item was removed:
- ----- Method: EventSensor>>processKeyboardEvent: (in category 'private-I/O') -----
- processKeyboardEvent: evt
- 	"process a keyboard event, updating EventSensor state"
- 	"Never update keyboardBuffer if we have an eventQueue active"
- 	mouseButtons := (mouseButtons bitAnd: EventSensor anyMouseButtonMask) bitOr: ((evt at: 5) bitShift: EventSensor numMouseButtons).
- 	
- 	(evt at: 3) ifNotNil: "extra characters not handled in MVC"
- 		[:charCode| | pressCode |
- 		 (pressCode := evt at: 4) = EventKeyChar ifTrue: "key down/up not handled in MVC"
- 			["mix in modifiers"
- 			keyboardBuffer nextPut: (charCode bitOr: ((evt at: 5) bitShift: 8))]]!

Item was removed:
- ----- Method: EventSensor>>processMouseEvent: (in category 'private-I/O') -----
- processMouseEvent: evt
- 	"process a mouse event, updating EventSensor state"
- 	| modifiers buttons mapped |
- 	mousePosition := (evt at: 3) @ (evt at: 4).
- 	buttons := evt at: 5.
- 	modifiers := evt at: 6.
- 	mapped := self mapButtons: buttons modifiers: modifiers.
- 	mouseButtons := mapped bitOr: (modifiers bitShift: EventSensor numMouseButtons)!

Item was removed:
- ----- Method: EventSensor>>processMouseWheelEvent: (in category 'private-I/O') -----
- processMouseWheelEvent: evt
- 	"process a mouse wheel event, updating EventSensor state"
- 	
- 	| modifiers buttons mapped |
- 	mouseWheelDelta := mouseWheelDelta + ((evt at: 3) @ (evt at: 4)).
- 	buttons := evt at: 5.
- 	modifiers := evt at: 6.
- 	mapped := self mapButtons: buttons modifiers: modifiers.
- 	mouseButtons := mapped bitOr: (modifiers bitShift: EventSensor numMouseButtons)!

Item was removed:
- ----- Method: EventSensor>>queueEvent: (in category 'private-I/O') -----
- queueEvent: evt
- 	"Queue the given event in the event queue (if any).
- 	Note that the event buffer must be copied since it
- 	will be reused later on."
- 	
- 	self eventQueue ifNotNil: [:queue |
- 		queue nextPut: evt shallowCopy].!

Item was removed:
- ----- Method: EventSensor>>rawMacOptionKeyPressed (in category 'modifier keys') -----
- rawMacOptionKeyPressed
- 	"Answer whether the option key on the Macintosh keyboard is being held down. Macintosh specific.  Clients are discouraged from calling this directly, since it circumvents bert's attempt to eradicate option-key checks"
- 
- 	self deprecated: 'Use #optionKeyPressed instead.'.
- 	^ self optionKeyPressed!

Item was removed:
- ----- Method: EventSensor>>redButtonPressed (in category 'mouse') -----
- redButtonPressed
- 	"Answer true if only the red mouse button is being pressed.
- 	This is the first mouse button, usually the left one."
- 
- 	^ (self peekButtons bitAnd: 7) = 4
- !

Item was removed:
- ----- Method: EventSensor>>shiftPressed (in category 'modifier keys') -----
- shiftPressed
- 	"Answer whether the shift key on the keyboard is being held down."
- 
- 	^ self peekButtons anyMask: (2r0001 "shift" bitShift: EventSensor numMouseButtons)!

Item was removed:
- ----- Method: EventSensor>>shutDown (in category 'initialize') -----
- shutDown
- 
- 	InterruptWatcherProcess ifNotNil: [
- 		InterruptWatcherProcess terminate.
- 		InterruptWatcherProcess := nil ].
- 
- 	EventTicklerProcess ifNotNil: [
- 		EventTicklerProcess terminate.
- 		EventTicklerProcess := nil. ].
- 	
- 	inputSemaphore ifNotNil:[Smalltalk unregisterExternalObject: inputSemaphore].!

Item was removed:
- ----- Method: EventSensor>>startUp (in category 'initialize') -----
- startUp
- 
- 	self initialize.
- 	self primSetInputSemaphore: (Smalltalk registerExternalObject: inputSemaphore).
- 
- 	self installInterruptWatcher.
- 	self installEventTickler.
- 
- 	self eventQueue: SharedQueue new.
- 
- 	"Attempt to discover whether the input semaphore is actually being signaled."
- 	hasInputSemaphore := false.
- 	inputSemaphore initSignals.!

Item was removed:
- ----- Method: EventSensor>>tabletExtent (in category 'tablet') -----
- tabletExtent
- 	"Answer the full tablet extent in tablet coordinates."
- 
- 	| params |
- 	params := self primTabletGetParameters: 1.
- 	params ifNil: [^ self error: 'no tablet available'].
- 	^ (params at: 1)@(params at: 2)
- !

Item was removed:
- ----- Method: EventSensor>>tabletPoint (in category 'tablet') -----
- tabletPoint
- 	"Answer the current position of the first tablet pointing device (pen, puck, or eraser) in tablet coordinates."
- 
- 	| data |
- 	data := self primTabletRead: 1.  "state of first/primary pen"
- 	^ (data at: 3) @ (data at: 4)
- !

Item was removed:
- ----- Method: EventSensor>>tabletPressure (in category 'tablet') -----
- tabletPressure
- 	"Answer the current pressure of the first tablet pointing device (pen, puck, or eraser), a number between 0.0 (no pressure) and 1.0 (max pressure)"
- 
- 	| params data |
- 	params := self primTabletGetParameters: 1.
- 	params ifNil: [^ self].
- 	data := self primTabletRead: 1.  "state of first/primary pen"
- 	^ (data at: 10) asFloat / ((params at: 10) - 1)
- !

Item was removed:
- ----- Method: EventSensor>>tabletTimestamp (in category 'tablet') -----
- tabletTimestamp
- 	"Answer the time (in tablet clock ticks) at which the tablet's primary pen last changed state. This can be used in polling loops; if this timestamp hasn't changed, then the pen state hasn't changed either."
- 
- 	| data |
- 	data := self primTabletRead: 1.  "state of first/primary pen"
- 	^ data at: 2
- !

Item was removed:
- ----- Method: EventSensor>>userInterruptWatcher (in category 'user interrupts') -----
- userInterruptWatcher
- 	"Wait for user interrupts and open a notifier on the active process when one occurs."
- 	[ interruptSemaphore wait.
- 	Display deferUpdates: false.
- 	SoundService stop.
- 	Smalltalk handleUserInterrupt ] repeat!

Item was removed:
- ----- Method: EventSensor>>waitButton (in category 'mouse') -----
- waitButton
- 	"Wait for the user to press any mouse button and then answer with the 
- 	current location of the cursor."
- 
- 	| delay |
- 	delay := Delay forMilliseconds: 50.
- 	[self anyButtonPressed] whileFalse: [ delay wait ].
- 	^self cursorPoint
- !

Item was removed:
- ----- Method: EventSensor>>waitButtonOrKeyboard (in category 'mouse') -----
- waitButtonOrKeyboard
- 	"Wait for the user to press either any mouse button or any key. 
- 	Answer the current cursor location or nil if a keypress occured."
- 
- 	| delay |
- 	delay := Delay forMilliseconds: 50.
- 	[self anyButtonPressed]
- 		whileFalse: [delay wait.
- 			self keyboardPressed
- 				ifTrue: [^ nil]].
- 	^ self cursorPoint
- !

Item was removed:
- ----- Method: EventSensor>>waitClickButton (in category 'mouse') -----
- waitClickButton
- 	"Wait for the user to click (press and then release) any mouse button and 
- 	then answer with the current location of the cursor."
- 
- 	self waitButton.
- 	^self waitNoButton!

Item was removed:
- ----- Method: EventSensor>>waitNoButton (in category 'mouse') -----
- waitNoButton
- 	"Wait for the user to release any mouse button and then answer the current location of the cursor."
- 
- 	| delay |
- 	delay := Delay forMilliseconds: 50.
- 	[self anyButtonPressed] whileTrue: [ delay wait].
- 	^self cursorPoint
- !

Item was removed:
- ----- Method: EventSensor>>yellowButtonPressed (in category 'mouse') -----
- yellowButtonPressed
- 	"Answer whether only the yellow mouse button is being pressed. 
- 	This is the second mouse button or option+click on the Mac."
- 
- 	^ (self peekButtons bitAnd: 7) = 2
- !

Item was removed:
- SharedPool subclass: #EventSensorConstants
- 	instanceVariableNames: ''
- 	classVariableNames: 'BlueButtonBit CommandKeyBit CtrlKeyBit EventKeyChar EventKeyDown EventKeyUp EventTouchCancelled EventTouchDown EventTouchMoved EventTouchStationary EventTouchUp EventTypeComplex EventTypeDragDropFiles EventTypeKeyboard EventTypeMenu EventTypeMouse EventTypeMouseWheel EventTypeNone EventTypeWindow OptionKeyBit RedButtonBit ShiftKeyBit TouchPhaseBegan TouchPhaseCancelled TouchPhaseEnded TouchPhaseMoved TouchPhaseStationary WindowEventActivated WindowEventClose WindowEventIconise WindowEventMetricChange WindowEventPaint WindowEventScreenChange YellowButtonBit'
- 	poolDictionaries: ''
- 	category: 'Kernel-Processes'!

Item was removed:
- ----- Method: EventSensorConstants class>>initialize (in category 'pool initialization') -----
- initialize
- 	"EventSensorConstants initialize"
- 	RedButtonBit := 4.
- 	BlueButtonBit := 2.
- 	YellowButtonBit := 1.
- 
- 	ShiftKeyBit := 1.
- 	CtrlKeyBit := 2.
- 	OptionKeyBit := 4.
- 	CommandKeyBit := 8.
- 
- 	"Types of events"
- 	EventTypeNone := 0.
- 	EventTypeMouse := 1.
- 	EventTypeKeyboard := 2.
- 	EventTypeDragDropFiles := 3.
- 	EventTypeMenu := 4.
- 	EventTypeWindow := 5.
- 	EventTypeComplex := 6.
- 	EventTypeMouseWheel := 7.
- 
- 	"Press codes for keyboard events"
- 	EventKeyChar := 0.
- 	EventKeyDown := 1.
- 	EventKeyUp := 2.
- 
- 	"Host window events"
- 	WindowEventMetricChange := 1.
- 	WindowEventClose := 2.
- 	WindowEventIconise := 3. 
- 	WindowEventActivated	:= 4. 
- 	WindowEventPaint := 5.
- 	WindowEventScreenChange := 6.
- 
- 	"types for touch events"
- 	EventTouchDown := 1.
- 	EventTouchUp := 2.
- 	EventTouchMoved := 3.
- 	EventTouchStationary := 4.
- 	EventTouchCancelled := 5.
- 
- 	"iOS touch phase constants"
- 	TouchPhaseBegan := 0.
- 	TouchPhaseMoved := 1.
- 	TouchPhaseStationary := 2.
- 	TouchPhaseEnded := 3.
- 	TouchPhaseCancelled := 4.
- !

Item was removed:
- Object subclass: #Exception
- 	instanceVariableNames: 'messageText tag signalContext handlerContext outerContext'
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'Kernel-Exceptions-Kernel'!
- 
- !Exception commentStamp: 'eem 3/30/2017 17:49' prior: 0!
- This is the main class used to implement the exception handling system (EHS).  It plays two distinct roles:  that of the exception, and that of the exception handler.  More specifically, it implements the bulk of the protocols laid out in the ANSI specification - those protocol names are reflected in the message categories.
- 
- Exception is an abstract class.  Instances should neither be created nor trapped.  In most cases, subclasses should inherit from Error or Notification rather than directly from Exception.
- 
- In implementing this EHS, The Fourth Estate Inc. incorporated some ideas and code from Craig Latta's EHS.  His insights were crucial in allowing us to implement BlockClosure>>valueUninterruptably (and by extension, #ensure: and #ifCurtailed:), and we imported the following methods with little or no modification:
- 
- Context>>terminateTo:
- Context>>terminate
- Context>>receiver:
- Context>>answer:
- 
- Thanks, Craig!!!

Item was removed:
- ----- Method: Exception class>>, (in category 'exceptionSelector') -----
- , anotherException
- 	"Create an exception set."
- 
- 	^ExceptionSet new
- 		add: self;
- 		add: anotherException;
- 		yourself!

Item was removed:
- ----- Method: Exception class>>handles: (in category 'exceptionSelector') -----
- handles: exception
- 	"Determine whether an exception handler will accept a signaled exception."
- 
- 	^ exception isKindOf: self!

Item was removed:
- ----- Method: Exception class>>signal (in category 'exceptionInstantiator') -----
- signal
- 	"Signal the occurrence of an exceptional condition."
- 
- 	^ self new signal!

Item was removed:
- ----- Method: Exception class>>signal: (in category 'exceptionInstantiator') -----
- signal: signalerText
- 	"Signal the occurrence of an exceptional condition with a specified textual description."
- 
- 	^ self new signal: signalerText!

Item was removed:
- ----- Method: Exception>>canSearchForSignalerContext (in category 'debug support') -----
- canSearchForSignalerContext
- 	"This method is /only/ to support the debugger's catching of exceptions in stepIntoBlock."
- 	^signalContext isContext!

Item was removed:
- ----- Method: Exception>>defaultAction (in category 'priv handling') -----
- defaultAction
- 	"The default action taken if the exception is signaled."
- 
- 	self subclassResponsibility!

Item was removed:
- ----- Method: Exception>>defaultResumeValue (in category 'defaults') -----
- defaultResumeValue
- 	"Answer the value that by default should be returned if the exception is resumed"
- 	^nil!

Item was removed:
- ----- Method: Exception>>defaultReturnValue (in category 'defaults') -----
- defaultReturnValue
- 	"Answer the value that by default should be returned if the exception is returned"
- 	^nil!

Item was removed:
- ----- Method: Exception>>description (in category 'printing') -----
- description
- 	"Return a textual description of the exception."
- 
- 	| desc mt |
- 	desc := self class name asString.
- 	^(mt := self messageText) == nil
- 		ifTrue: [desc]
- 		ifFalse: [desc, ': ', mt]!

Item was removed:
- ----- Method: Exception>>freshCopy (in category 'copying') -----
- freshCopy
- 
- 	^ self copy refreshContexts!

Item was removed:
- ----- Method: Exception>>isNested (in category 'handling') -----
- isNested
- 	"Determine whether the current exception handler is within the scope of another handler for the same exception."
- 
- 	^ handlerContext nextHandlerContext canHandleSignal: self!

Item was removed:
- ----- Method: Exception>>isResumable (in category 'priv handling') -----
- isResumable
- 	"Determine whether an exception is resumable."
- 
- 	^ true!

Item was removed:
- ----- Method: Exception>>messageText (in category 'printing') -----
- messageText
- 	"Return an exception's message text."
- 	^ messageText ifNil: [ String empty ]!

Item was removed:
- ----- Method: Exception>>messageText: (in category 'signaling') -----
- messageText: signalerText
- 	"Set an exception's message text."
- 
- 	messageText := signalerText!

Item was removed:
- ----- Method: Exception>>outer (in category 'handling') -----
- outer
- 	"Evaluate the enclosing exception action and return to here instead of signal if it resumes (see #resumeUnchecked:)."
- 
- 	| prevOuterContext currHandlerContext |
- 	self isResumable ifTrue: [
- 		currHandlerContext := handlerContext.
- 		prevOuterContext := outerContext.
- 		outerContext := thisContext contextTag.
- 	].
- 	self pass.
- !

Item was removed:
- ----- Method: Exception>>pass (in category 'handling') -----
- pass
- 	"Yield control to the enclosing exception action for the receiver."
- 
- 	(handlerContext nextHandlerContextForSignal: self) handleSignal: self!

Item was removed:
- ----- Method: Exception>>printDetailsOn: (in category 'printing') -----
- printDetailsOn: aStream
- 	"Allow applications to optionally print extra details without overriding a base package."!

Item was removed:
- ----- Method: Exception>>printOn: (in category 'printing') -----
- printOn: stream
- 
- 	stream nextPutAll: self description!

Item was removed:
- ----- Method: Exception>>privHandlerContext (in category 'priv handling') -----
- privHandlerContext
- 	^handlerContext!

Item was removed:
- ----- Method: Exception>>privHandlerContext: (in category 'priv handling') -----
- privHandlerContext: aContextTag
- 
- 	handlerContext := aContextTag!

Item was removed:
- ----- Method: Exception>>rearmHandlerDuring: (in category 'handling') -----
- rearmHandlerDuring: aBlock
- "Make the current error handler re-entrant while it is running aBlock. Only works in a closure-enabled image"
- 
- 	^ handlerContext rearmHandlerDuring: aBlock!

Item was removed:
- ----- Method: Exception>>receiver (in category 'printing') -----
- receiver
- 
- 	^ self signalerContext receiver!

Item was removed:
- ----- Method: Exception>>refreshContexts (in category 'copying') -----
- refreshContexts
- 
- 	signalContext := handlerContext := outerContext := nil.
- !

Item was removed:
- ----- Method: Exception>>resignalAs: (in category 'handling') -----
- resignalAs: replacementException
- 	"Signal an alternative exception in place of the receiver.
- 	Unwind to signalContext before signalling the replacement exception"
- 
- 	signalContext resumeEvaluating: [replacementException signal]!

Item was removed:
- ----- Method: Exception>>resume (in category 'handling') -----
- resume
- 	"Return from the message that signaled the receiver."
- 
- 	self resume: self defaultResumeValue!

Item was removed:
- ----- Method: Exception>>resume: (in category 'handling') -----
- resume: resumptionValue
- 	"Return resumptionValue as the value of the signal message."
- 
- 	self isResumable ifFalse: [IllegalResumeAttempt signal].
- 	self resumeUnchecked: resumptionValue!

Item was removed:
- ----- Method: Exception>>resumeEvaluating: (in category 'handling') -----
- resumeEvaluating: aBlock
- 	"Return result of evaluating aBlock as the value of #signal, unless this was called after an #outer message, then return resumptionValue as the value of #outer.
- 	The block is only evaluated after unwinding the stack."
- 
- 	| ctxt |
- 	outerContext ifNil: [
- 		signalContext returnEvaluating: aBlock
- 	] ifNotNil: [
- 		ctxt := outerContext.
- 		outerContext := ctxt tempAt: 1. "prevOuterContext in #outer"
- 		handlerContext := ctxt tempAt: 2. "currHandlerContext in #outer"
- 		ctxt returnEvaluating: aBlock
- 	].
- !

Item was removed:
- ----- Method: Exception>>resumeUnchecked: (in category 'handling') -----
- resumeUnchecked: resumptionValue
- 	"Return resumptionValue as the value of #signal, unless this was called after an #outer message, then return resumptionValue as the value of #outer."
- 
- 	^self resumeEvaluating: [resumptionValue]!

Item was removed:
- ----- Method: Exception>>retry (in category 'handling') -----
- retry
- 	"Abort an exception handler and re-evaluate its protected block."
- 
- 	handlerContext restart!

Item was removed:
- ----- Method: Exception>>retryUsing: (in category 'handling') -----
- retryUsing: alternativeBlock
- 	"Abort an exception handler and evaluate a new block in place of the handler's protected block."
- 
- 	handlerContext restartWithNewReceiver: alternativeBlock
- !

Item was removed:
- ----- Method: Exception>>return (in category 'handling') -----
- return
- 	"Return nil as the value of the block protected by the active exception handler."
- 
- 	self return: self defaultReturnValue!

Item was removed:
- ----- Method: Exception>>return: (in category 'handling') -----
- return: returnValue
- 	"Return the argument as the value of the block protected by the active exception handler."
- 
- 	handlerContext return: returnValue!

Item was removed:
- ----- Method: Exception>>searchFrom: (in category 'handling') -----
- searchFrom: aContext
- 	" Set the context where the handler search will start. "
- 
- 	signalContext := aContext contextTag!

Item was removed:
- ----- Method: Exception>>signal (in category 'signaling') -----
- signal
- 	"Ask handler contexts in the sender chain to handle this signal.  The default is to evaluate my defaultAction and return the result.
- 	Sending #signal to an already signaled exception generates a fresh copy of the receiver."
- 	
- 	signalContext ifNotNil: [^self freshCopy signal].
- 	signalContext := thisContext contextTag.
- 	^(thisContext nextHandlerContextForSignal: self) handleSignal: self!

Item was removed:
- ----- Method: Exception>>signal: (in category 'signaling') -----
- signal: signalerText
- 	"Signal the occurrence of an exceptional condition with a specified textual description."
- 
- 	self messageText: signalerText.
- 	^ self signal!

Item was removed:
- ----- Method: Exception>>signalerContext (in category 'handling') -----
- signalerContext
- 	"Find the first sender of signal(:)"
- 
- 	^ signalContext findContextSuchThat: [:ctxt |
- 		(ctxt receiver == self or: [ctxt receiver == self class]) not]!

Item was removed:
- ----- Method: Exception>>tag (in category 'exceptionDescription') -----
- tag
- 	"Return an exception's tag value."
- 
- 	^tag == nil
- 		ifTrue: [self messageText]
- 		ifFalse: [tag]!

Item was removed:
- ----- Method: Exception>>tag: (in category 'exceptionBuilder') -----
- tag: t
- 	"This message is not specified in the ANSI protocol, but that looks like an oversight because #tag is specified, and the spec states that the signaler may store the tag value."
- 
- 	tag := t!

Item was removed:
- Object subclass: #ExceptionSet
- 	instanceVariableNames: 'exceptions'
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'Kernel-Exceptions'!
- 
- !ExceptionSet commentStamp: '<historical>' prior: 0!
- An ExceptionSet is a grouping of exception handlers which acts as a single handler.  Within the group, the most recently added handler will be the last handler found during a handler search (in the case where more than one handler in the group is capable of handling a given exception). !

Item was removed:
- ----- Method: ExceptionSet>>, (in category 'exceptionSelector') -----
- , anException
- 	"Return an exception set that contains the receiver and the argument exception. This is commonly used to specify a set of exception selectors for an exception handler."
- 
- 	self add: anException.
- 	^self!

Item was removed:
- ----- Method: ExceptionSet>>add: (in category 'private') -----
- add: anException
- 
- 	^exceptions add: anException!

Item was removed:
- ----- Method: ExceptionSet>>handles: (in category 'exceptionSelector') -----
- handles: anException
- 	"Determine whether an exception handler will accept a signaled exception."
- 
- 	^exceptions anySatisfy: [:ex | ex handles: anException]!

Item was removed:
- ----- Method: ExceptionSet>>initialize (in category 'private') -----
- initialize
- 
- 	exceptions := OrderedCollection new!

Item was removed:
- SqNumberParser subclass: #ExtendedNumberParser
- 	instanceVariableNames: ''
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'Kernel-Numbers'!
- 
- !ExtendedNumberParser commentStamp: 'eem 8/6/2014 10:34' prior: 0!
- An ExtendedNumberParser parses numbers, extending Squeak number syntax with these rules
- 
- - allow partial specification of integer and fraction parts:
- 1.e2 .1e3 are both 100.0
- - allow plus sign before number and in exponent
- - integers raised to exponents, the results of which are fractional, are answered as Fractions, not Floats
- !

Item was removed:
- ----- Method: ExtendedNumberParser>>allowPlusSign (in category 'accessing') -----
- allowPlusSign
- 	^true!

Item was removed:
- ----- Method: ExtendedNumberParser>>exponentLetters (in category 'accessing') -----
- exponentLetters
- 	"Allow uppercase exponent letter."
- 	
- 	^'edqEDQ'!

Item was removed:
- ----- Method: ExtendedNumberParser>>makeIntegerOrScaledInteger (in category 'parsing-private') -----
- makeIntegerOrScaledInteger
- 	"at this point, there is no digit, nor fractionPart.
- 	maybe it can be a scaled decimal with fraction omitted..."
- 	
- 	neg
- 		ifTrue: [integerPart := integerPart negated].
- 	self readExponent
- 		ifTrue: [^integerPart * (base raisedToInteger: exponent)].
- 	(self readScaleWithDefaultNumberOfDigits: 0)
- 		ifTrue: [^integerPart asScaledDecimal: scale].
- 	^ integerPart!

Item was removed:
- ----- Method: ExtendedNumberParser>>nextFraction (in category 'parsing-public') -----
- nextFraction
- 	| numerator denominator numberOfTrailingZeroInIntegerPart |
- 	base := self defaultBase.
- 	neg := self peekSignIsMinus.
- 	(integerPart := self nextUnsignedIntegerOrNilBase: base)
- 		ifNil: [numberOfTrailingZeroInIntegerPart := 0]
- 		ifNotNil: [
- 			numberOfTrailingZeroInIntegerPart := nDigits - lastNonZero.
- 			(sourceStream peekFor: $r)
- 				ifTrue: ["<base>r<integer>"
- 					(base := integerPart) < 2
- 						ifTrue: [
- 							sourceStream skip: -1.
- 							^ self expected: 'an integer greater than 1 as valid radix'].
- 					self peekSignIsMinus
- 						ifTrue: [neg := neg not].
- 					integerPart := self nextUnsignedIntegerBase: base.
- 					numberOfTrailingZeroInIntegerPart := nDigits - lastNonZero]].
- 	(sourceStream peekFor: $.)
- 		ifTrue:
- 			[^self readFractionPartNumberOfTrailingZeroInIntegerPart: numberOfTrailingZeroInIntegerPart].
- 	integerPart
- 		ifNil:
- 			["No integerPart, raise an error"
- 			^ self expected: 'a digit'].
- 	numerator := neg
- 		ifTrue: [integerPart negated]
- 		ifFalse: [integerPart].
- 	self readExponent ifTrue: [numerator := numerator * (base raisedToInteger: exponent)].
- 	(sourceStream peekFor: $/) ifFalse: [^numerator].
- 	base := 10.
- 	base := self defaultBase.
- 	(denominator := self nextUnsignedIntegerOrNilBase: base)
- 		ifNil:
- 			[sourceStream skip: -1. "Not a valid denominator, ungobble / and return numerator"
- 			^numerator].
- 	(sourceStream peekFor: $r)
- 		ifTrue: ["<base>r<integer>"
- 			(base := denominator) < 2
- 				ifTrue: [
- 					sourceStream skip: -1.
- 					^ self expected: 'an integer greater than 1 as valid radix'].
- 			denominator := self nextUnsignedIntegerBase: base].
- 	self readExponent ifTrue: [denominator := denominator * (base raisedToInteger: exponent)].
- 	^numerator / denominator!

Item was removed:
- ----- Method: ExtendedNumberParser>>nextNumber (in category 'parsing-public') -----
- nextNumber
- 	"main method for reading a number.
- 	This one can read Float Integer and ScaledDecimal"
- 	
- 	| numberOfTrailingZeroInIntegerPart |
- 	base := self defaultBase.
- 	neg := self peekSignIsMinus.
- 	integerPart := self nextUnsignedIntegerOrNilBase: base.
- 	integerPart ifNil: [(sourceStream peekFor: $.)
- 		ifTrue: [
- 			"Try .1 syntax"
- 			^self readNumberWithoutIntegerPart]
- 		ifFalse: [
- 			"This is not a regular number beginning with a digit
- 			It is time to check for exceptional condition NaN and Infinity"
- 			^self readNamedFloatOrFail]].
- 	numberOfTrailingZeroInIntegerPart := nDigits - lastNonZero.
- 	(sourceStream peekFor: $r)
- 		ifTrue: ["<base>r<integer>"
- 			| oldNeg pos |
- 			pos := sourceStream position - 1.
- 			(base := integerPart) < 2
- 				ifTrue: ["A radix currently need to be greater than 1, ungobble the r and return the integer part"
- 					sourceStream skip: -1.
- 					^neg
- 						ifTrue: [base negated]
- 						ifFalse: [base]].
- 			oldNeg := neg.
- 			self peekSignIsMinus ifTrue: [neg := neg not].
- 			integerPart := self nextUnsignedIntegerOrNilBase: base.
- 			integerPart ifNil: [
- 				(sourceStream peekFor: $.) ifTrue: [self readNumberWithoutIntegerPartOrNil ifNotNil: [:aNumber | ^aNumber]].
- 				sourceStream position: pos.
- 					^oldNeg
- 						ifTrue: [base negated]
- 						ifFalse: [base]].
- 			numberOfTrailingZeroInIntegerPart := nDigits - lastNonZero].
- 	^ (sourceStream peekFor: $.)
- 		ifTrue: [self readNumberWithFractionPartNumberOfTrailingZeroInIntegerPart: numberOfTrailingZeroInIntegerPart]
- 		ifFalse: [self makeIntegerOrScaledInteger]!

Item was removed:
- ----- Method: ExtendedNumberParser>>readFractionPartNumberOfTrailingZeroInIntegerPart: (in category 'parsing-private') -----
- readFractionPartNumberOfTrailingZeroInIntegerPart: numberOfTrailingZeroInIntegerPart
- 	"at this stage, sign integerPart and a fraction point have been read.
- 	try and form a number with a fractionPart"
- 	
- 	| numberOfNonZeroFractionDigits numberOfTrailingZeroInFractionPart mantissa value |
- 	fractionPart := self nextUnsignedIntegerOrNilBase: base.
- 	fractionPart
- 		ifNil: [
- 			"No fractionPart found, but can be an extended 1.e2 syntax"
- 			integerPart ifNil: ["No integerPart, nor fractionPart found, ungobble the fraction point and raise an error"
- 					sourceStream skip: -1.
- 					^self expected: 'a digit'].
- 			fractionPart := 0.
- 			numberOfNonZeroFractionDigits := 0.
- 			numberOfTrailingZeroInFractionPart := 0]
- 		ifNotNil: [.
- 			numberOfNonZeroFractionDigits := lastNonZero.
- 			numberOfTrailingZeroInFractionPart := nDigits - lastNonZero].
- 	self readExponent.
- 	integerPart ifNil: [integerPart := 0].
- 	
- 	fractionPart isZero
- 		ifTrue: [mantissa := integerPart
- 						// (base raisedToInteger: numberOfTrailingZeroInIntegerPart).
- 			exponent := exponent + numberOfTrailingZeroInIntegerPart]
- 		ifFalse: [mantissa := integerPart
- 						* (base raisedToInteger: numberOfNonZeroFractionDigits) + (fractionPart // (base raisedToInteger: numberOfTrailingZeroInFractionPart)).
- 			exponent := exponent - numberOfNonZeroFractionDigits].
- 
- 	value := exponent positive
- 		ifTrue: [mantissa * (base raisedToInteger: exponent)]
- 		ifFalse: [mantissa / (base raisedToInteger: exponent negated)].
- 	^ neg
- 		ifTrue: [value negated]
- 		ifFalse: [value]!

Item was removed:
- ----- Method: ExtendedNumberParser>>readNumberWithFractionPartNumberOfTrailingZeroInIntegerPart: (in category 'parsing-private') -----
- readNumberWithFractionPartNumberOfTrailingZeroInIntegerPart: numberOfTrailingZeroInIntegerPart
- 	"at this stage, sign integerPart and a decimal point have been read.
- 	try and form a number with a fractionPart"
- 	
- 	| numberOfNonZeroFractionDigits numberOfTrailingZeroInFractionPart mantissa value |
- 	fractionPart := self nextUnsignedIntegerOrNilBase: base.
- 	fractionPart
- 		ifNil:
- 			["No fractionPart found, but can be a 1.e2 syntax"
- 			fractionPart := 0.
- 			nDigits := 0.
- 			numberOfNonZeroFractionDigits := 0.
- 			numberOfTrailingZeroInFractionPart := 0]
- 		ifNotNil:
- 			[numberOfNonZeroFractionDigits := lastNonZero.
- 			numberOfTrailingZeroInFractionPart := nDigits - lastNonZero].
- 	self readExponent
- 		ifFalse: [(self readScaleWithDefaultNumberOfDigits: nDigits)
- 				ifTrue: [^self
- 					makeScaledDecimalWithNumberOfNonZeroFractionDigits: numberOfNonZeroFractionDigits
- 					andNumberOfTrailingZeroInFractionPart: numberOfTrailingZeroInFractionPart]].
- 
- 	fractionPart isZero
- 		ifTrue:
- 			[mantissa := integerPart
- 						// (base raisedToInteger: numberOfTrailingZeroInIntegerPart).
- 			exponent := exponent + numberOfTrailingZeroInIntegerPart]
- 		ifFalse:
- 			[mantissa := integerPart
- 						* (base raisedToInteger: numberOfNonZeroFractionDigits)
- 						+ (fractionPart // (base raisedToInteger: numberOfTrailingZeroInFractionPart)).
- 			exponent := exponent - numberOfNonZeroFractionDigits].
- 
- 	value := self makeFloatFromMantissa: mantissa exponent: exponent base: base.
- 	^ neg
- 		ifTrue: [value isZero
- 				ifTrue: [Float negativeZero]
- 				ifFalse: [value negated]]
- 		ifFalse: [value]!

Item was removed:
- ----- Method: ExtendedNumberParser>>readNumberWithoutIntegerPart (in category 'parsing-private') -----
- readNumberWithoutIntegerPart
- 	"at this stage, sign followed by a decimal point have been read, but no intergerPart
- 	try and form a number with a fractionPart"
- 	
- 	^self readNumberWithoutIntegerPartOrNil ifNil: [
- 		"No integer part, no fractionPart, this does not look like a number..."
- 		^self expected: 'a digit between 0 and 9'].!

Item was removed:
- ----- Method: ExtendedNumberParser>>readNumberWithoutIntegerPartOrNil (in category 'parsing-private') -----
- readNumberWithoutIntegerPartOrNil
- 	"at this stage, sign followed by a decimal point have been read, but no intergerPart
- 	try and form a number with a fractionPart"
- 	
- 	| numberOfNonZeroFractionDigits numberOfTrailingZeroInFractionPart mantissa value |
- 	integerPart := 0.
- 	fractionPart := self nextUnsignedIntegerOrNilBase: base.
- 	fractionPart ifNil: [
- 		"No integer part, no fractionPart, this does not look like a number..."
- 		^nil].
- 	numberOfNonZeroFractionDigits := lastNonZero.
- 	numberOfTrailingZeroInFractionPart := nDigits - lastNonZero.
- 	self readExponent
- 		ifFalse: [(self readScaleWithDefaultNumberOfDigits: nDigits)
- 				ifTrue: [^self makeScaledDecimalWithNumberOfNonZeroFractionDigits: numberOfNonZeroFractionDigits
- 					andNumberOfTrailingZeroInFractionPart: numberOfTrailingZeroInFractionPart]].
- 
- 	fractionPart isZero
- 		ifTrue: [mantissa := 0]
- 		ifFalse: [mantissa := (fractionPart // (base raisedToInteger: numberOfTrailingZeroInFractionPart)).
- 			exponent := exponent - numberOfNonZeroFractionDigits].
- 
- 	value := self makeFloatFromMantissa: mantissa exponent: exponent base: base.
- 	^ neg
- 		ifTrue: [value isZero
- 				ifTrue: [Float negativeZero]
- 				ifFalse: [value negated]]
- 		ifFalse: [value]!

Item was removed:
- NumberParser subclass: #FORTRANNumberParser
- 	instanceVariableNames: ''
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'Kernel-Numbers'!
- 
- !FORTRANNumberParser commentStamp: 'nice 2/13/2010 00:28' prior: 0!
- FORTRANNumberParser is able to parse ASCII representation of numbers generated by FORTRAN programs.
- 
- Possible syntax:
- 	digit = '0' | '1' | '2' | '3' | '4' | '5' | '6' | '7' | '8' | '9' ;
- 	sign =  '+' | '-';
- 	integer = [sign] digit{digit} ;
- 	float = [sign] [digit{digit}] ['.'] digit{digit} [('E' | 'D' ) [sign] digit{digit} ] ;
- 	number = integer | float ;
- 	
- Examples:
- 	124
- 	+124
- 	-124
- 	1.0
- 	1.
- 	.23
- 	1E+5
- 	1.0E-3
- 	.1E-22
- 	3.01D+55
- 
- Not accepted: exponent letter is sometimes omitted for double precision with 3 digits exponent...
- 	1.001-123
- 
- Not accepted: complex numbers into parentheses
- 	(1.0 , 3.11)
- !

Item was removed:
- ----- Method: FORTRANNumberParser>>allowPlusSign (in category 'accessing') -----
- allowPlusSign
- 	^true!

Item was removed:
- ----- Method: FORTRANNumberParser>>exponentLetters (in category 'accessing') -----
- exponentLetters
- 	"answer the list of possible exponents for Numbers.
- 	Note: this parser will not honour precision attached to the exponent.
- 	different exponent do not lead to different precisions.
- 	only IEEE 754 double precision floating point numbers will be created"
- 
- 	^'ED'!

Item was removed:
- ----- Method: FORTRANNumberParser>>nextFloat (in category 'parsing-public') -----
- nextFloat
- 	^self nextNumber asFloat!

Item was removed:
- ----- Method: FORTRANNumberParser>>nextNumber (in category 'parsing-public') -----
- nextNumber
- 	"main method for reading a number with FORTRAN syntax.
- 	This one can read Real and Integer (not complex)"
- 
- 	| numberOfTrailingZeroInIntegerPart numberOfNonZeroFractionDigits mantissa value numberOfTrailingZeroInFractionPart noInt |
- 	base := self defaultBase..
- 	(self nextMatchAll: 'NaN') ifTrue: [^Float nan].
- 	neg := self peekSignIsMinus.
- 	(self nextMatchAll: 'Infinity') 
- 		ifTrue: [^neg ifTrue: [Float negativeInfinity] ifFalse: [Float infinity]].
- 	(noInt := sourceStream peekFor: $.) 
- 		ifTrue: 
- 			[integerPart := 0.
- 			numberOfTrailingZeroInIntegerPart := 0]
- 		ifFalse: 
- 			[integerPart := self nextUnsignedIntegerBase: base.
- 			numberOfTrailingZeroInIntegerPart := nDigits - lastNonZero].
- 	(noInt or: [sourceStream peekFor: $.]) 
- 		ifTrue: 
- 			[fractionPart := self nextUnsignedIntegerBase: base ifFail: [nil].
- 			fractionPart isNil 
- 				ifTrue: 
- 					[noInt 
- 						ifTrue: 
- 							["no interger part, no fraction part..."
- 							self expected: 'a digit 0 to 9'.
- 							^nil].
- 					fractionPart := 0]
- 				ifFalse: 
- 					[numberOfNonZeroFractionDigits := lastNonZero.
- 					numberOfTrailingZeroInFractionPart := nDigits - lastNonZero].
- 			self readExponent]
- 		ifFalse: 
- 			[self readExponent ifFalse: [^neg ifTrue: [integerPart negated] ifFalse: [integerPart]].
- 			fractionPart := 0].
- 	fractionPart isZero 
- 		ifTrue: 
- 			[mantissa := integerPart // (base raisedTo: numberOfTrailingZeroInIntegerPart).
- 			exponent := exponent + numberOfTrailingZeroInIntegerPart]
- 		ifFalse: 
- 			[mantissa := integerPart * (base raisedTo: numberOfNonZeroFractionDigits) 
- 						+ (fractionPart // (base raisedTo: numberOfTrailingZeroInFractionPart)).
- 			exponent := exponent - numberOfNonZeroFractionDigits].
- 	value := self 
- 				makeFloatFromMantissa: mantissa
- 				exponent: exponent
- 				base: base.
- 	^neg ifTrue: [value isZero ifTrue: [Float negativeZero] ifFalse: [value negated]] ifFalse: [value]!

Item was removed:
- Boolean subclass: #False
- 	instanceVariableNames: ''
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'Kernel-Objects'!
- 
- !False commentStamp: '<historical>' prior: 0!
- False defines the behavior of its single instance, false -- logical negation. Notice how the truth-value checks become direct message sends, without the need for explicit testing.
- 
- Be aware however that most of these methods are not sent as real messages in normal use. Most are inline coded by the compiler as test and jump bytecodes - avoiding the overhead of the full message sends. So simply redefining these methods here will have no effect.!

Item was removed:
- ----- Method: False class>>initializedInstance (in category 'as yet unclassified') -----
- initializedInstance
- 	^ false!

Item was removed:
- ----- Method: False>>& (in category 'logical operations') -----
- & aBoolean 
- 	"Evaluating conjunction -- answer false since receiver is false, but let the VM quickly check the type of the argument first."
- 
- 	aBoolean ifFalse: [ ^false ].
- 	^false!

Item was removed:
- ----- Method: False>>==> (in category 'logical operations') -----
- ==> aBlock
- 	^true!

Item was removed:
- ----- Method: False>>and: (in category 'controlling') -----
- and: alternativeBlock 
- 	"Nonevaluating conjunction -- answer with false since the receiver is false."
- 
- 	^self!

Item was removed:
- ----- Method: False>>asBit (in category 'printing') -----
- asBit
- 
- 	^ 0!

Item was removed:
- ----- Method: False>>ifFalse: (in category 'controlling') -----
- ifFalse: alternativeBlock 
- 	"Answer the value of alternativeBlock. Execution does not actually
- 	reach here because the expression is compiled in-line."
- 
- 	^alternativeBlock value!

Item was removed:
- ----- Method: False>>ifFalse:ifTrue: (in category 'controlling') -----
- ifFalse: falseAlternativeBlock ifTrue: trueAlternativeBlock 
- 	"Answer the value of falseAlternativeBlock. Execution does not
- 	actually reach here because the expression is compiled in-line."
- 
- 	^falseAlternativeBlock value!

Item was removed:
- ----- Method: False>>ifTrue: (in category 'controlling') -----
- ifTrue: alternativeBlock 
- 	"Since the condition is false, answer the value of the false alternative, 
- 	which is nil. Execution does not actually reach here because the
- 	expression is compiled in-line."
- 
- 	^nil!

Item was removed:
- ----- Method: False>>ifTrue:ifFalse: (in category 'controlling') -----
- ifTrue: trueAlternativeBlock ifFalse: falseAlternativeBlock 
- 	"Answer the value of falseAlternativeBlock. Execution does not
- 	actually reach here because the expression is compiled in-line."
- 
- 	^falseAlternativeBlock value!

Item was removed:
- ----- Method: False>>not (in category 'logical operations') -----
- not
- 	"Negation -- answer true since the receiver is false."
- 
- 	^true!

Item was removed:
- ----- Method: False>>or: (in category 'controlling') -----
- or: alternativeBlock 
- 	"Nonevaluating disjunction -- answer value of alternativeBlock."
- 
- 	^alternativeBlock value!

Item was removed:
- ----- Method: False>>printOn: (in category 'printing') -----
- printOn: aStream 
- 
- 	aStream nextPutAll: 'false'!

Item was removed:
- ----- Method: False>>xor: (in category 'logical operations') -----
- xor: aBoolean
- 	"aBoolean is either a boolean, or an object who's #value returns a boolean (usually a block)."
- 	^aBoolean value ifTrue: [ true ] ifFalse: [ false ]!

Item was removed:
- ----- Method: False>>| (in category 'logical operations') -----
- | aBoolean 
- 	"Evaluating disjunction (OR) -- could  answer aBoolean since receiver is false, but let the VM quickly check the type of the argument instead."
- 
- 	aBoolean ifTrue: [ ^true ].
- 	^false!

Item was removed:
- Number subclass: #Float
- 	instanceVariableNames: ''
- 	classVariableNames: 'E Epsilon Halfpi Infinity Ln10 Ln2 MaxVal MaxValLn MinValLogBase2 NaN NegativeInfinity NegativeZero Pi RadiansPerDegree Sqrt2 ThreePi Twopi'
- 	poolDictionaries: ''
- 	category: 'Kernel-Numbers'!
- 
- !Float commentStamp: '<historical>' prior: 0!
- My instances represent IEEE-754 floating-point double-precision numbers.  They have about 16 digits of accuracy and their range is between plus and minus 10^307. Some valid examples are:
- 	
- 	8.0 13.3 0.3 2.5e6 1.27e-30 1.27e-31 -12.987654e12
- 
- Mainly: no embedded blanks, little e for tens power, and a digit on both sides of the decimal point.  It is actually possible to specify a radix for Squeak Float constants.  This is great for teaching about numbers, but may be confusing to the average reader:
- 
- 	3r20.2 --> 6.66666666666667
- 	8r20.2 --> 16.25
- 
- If you don't have access to the definition of IEEE-754, you can figure out what is going on by printing various simple values in Float hex.  It may help you to know that the basic format is...
- 	sign		1 bit
- 	exponent	11 bits with bias of 1023 (16r3FF) to produce an exponent
- 						in the range -1023 .. +1024
- 				- 16r000:
- 					significand = 0: Float zero
- 					significand ~= 0: Denormalized number (exp = -1024, no hidden '1' bit)
- 				- 16r7FF:
- 					significand = 0: Infinity
- 					significand ~= 0: Not A Number (NaN) representation
- 	mantissa	53 bits, but only 52 are stored (20 in the first word, 32 in the second).  This is because a normalized mantissa, by definition, has a 1 to the right of its floating point, and IEEE-754 omits this redundant bit to gain an extra bit of precision instead.  People talk about the mantissa without its leading one as the FRACTION, and with its leading 1 as the SIGNFICAND.
- 
- The single-precision format is...
- 	sign		1 bit
- 	exponent	8 bits, with bias of 127, to represent -126 to +127
-                     - 0x0 and 0xFF reserved for Float zero (mantissa is ignored)
-                     - 16r7F reserved for Float underflow/overflow (mantissa is ignored)
- 	mantissa	24 bits, but only 23 are stored
- This format is used in FloatArray (qv), and much can be learned from the conversion routines, Float asIEEE32BitWord, and Float class fromIEEE32Bit:.
- 
- Thanks to Rich Harmon for asking many questions and to Tim Olson, Bruce Cohen, Rick Zaccone and others for the answers that I have collected here.!

Item was removed:
- ----- Method: Float class>>basicNew (in category 'instance creation') -----
- basicNew
- 	^BoxedFloat64 basicNew: 2!

Item was removed:
- ----- Method: Float class>>basicNew: (in category 'instance creation') -----
- basicNew: anInteger
- 	^BoxedFloat64 basicNew: 2!

Item was removed:
- ----- Method: Float class>>denormalized (in category 'constants') -----
- denormalized
- 	"Answer whether implementation supports denormalized numbers (also known as gradual underflow)."
- 	
- 	^true!

Item was removed:
- ----- Method: Float class>>e (in category 'constants') -----
- e
- 	"Answer the constant, E."
- 
- 	^E!

Item was removed:
- ----- Method: Float class>>emax (in category 'constants') -----
- emax
- 	"Answer exponent of maximal representable value"
- 	
- 	^1023!

Item was removed:
- ----- Method: Float class>>emin (in category 'constants') -----
- emin
- 	"Answer exponent of minimal normalized representable value"
- 	
- 	^-1022!

Item was removed:
- ----- Method: Float class>>epsilon (in category 'constants') -----
- epsilon
- 	"Answer difference between 1.0 and previous representable value"
- 	
- 	^1.0 timesTwoPower: 1 - self precision!

Item was removed:
- ----- Method: Float class>>fmax (in category 'constants') -----
- fmax
- 	"Answer the maximum finite floating point value representable."
- 	
- 	^MaxVal!

Item was removed:
- ----- Method: Float class>>fmin (in category 'constants') -----
- fmin
- 	"Answer minimum positive representable value."
- 	
- 	^self denormalized
- 		ifTrue: [self fminDenormalized]
- 		ifFalse: [self fminNormalized]!

Item was removed:
- ----- Method: Float class>>fminDenormalized (in category 'constants') -----
- fminDenormalized
- 	"Answer the minimum denormalized value representable."
- 	
- 	^1.0 timesTwoPower: MinValLogBase2!

Item was removed:
- ----- Method: Float class>>fminNormalized (in category 'constants') -----
- fminNormalized
- 	"Answer the minimum normalized value representable."
- 	
- 	^1.0 timesTwoPower: -1022!

Item was removed:
- ----- Method: Float class>>fromIEEE32Bit: (in category 'instance creation') -----
- fromIEEE32Bit: word
- 	"Convert the given 32 bit word (which is supposed to be a positive 32-bit value) from
- 	 a 32 bit IEEE floating point representation into an actual Squeak float object (being
- 	 64 bits wide). Should only be used for conversion in FloatArrays or likewise objects."
- 	
- 	| sign mantissa exponent delta |
- 	word <= 0 ifTrue:
- 		[^word negative
- 			ifTrue: [self error: 'Cannot deal with negative numbers']
- 			ifFalse: [self zero]].
- 	sign := word bitAnd: 16r80000000.
- 	word = sign ifTrue:
- 		[^self negativeZero].
- 	
- 	exponent := ((word bitShift: -23) bitAnd: 16rFF) - 127.
- 	mantissa := word bitAnd:  16r7FFFFF.
- 
- 	exponent = 128 ifTrue: "Either NAN or INF"
- 		[^mantissa = 0
- 			ifTrue:
- 				[sign = 0 
- 					ifTrue: [self infinity]
- 					ifFalse: [self negativeInfinity]]
- 			ifFalse: [self nan]].
- 
- 	exponent = -127 ifTrue:
- 		"gradual underflow (denormalized number)
- 		 Remove first bit of mantissa and adjust exponent"
- 		[delta := mantissa highBit.
- 		 mantissa := (mantissa bitAnd: (1 bitShift: delta - 1) - 1) bitShift: 24 - delta.
- 		 exponent := exponent + delta - 23].
- 	
- 	"Create new float"
- 	^(self basicNew: 2)
- 		basicAt: 1 put: ((sign bitOr: (1023 + exponent bitShift: 20)) bitOr: (mantissa bitShift: -3));
- 		basicAt: 2 put: ((mantissa bitAnd: 7) bitShift: 29);
- 		* 1.0 "reduce to SmallFloat64 if possible"!

Item was removed:
- ----- Method: Float class>>fromIEEE64Bit: (in category 'instance creation') -----
- fromIEEE64Bit: anInteger
- 	"Convert the given 64 bit word (which is supposed to be a positive 64-bit value) from
- 	  a 64 bit IEEE floating point representation into an actual Squeak float object (being
- 	  64 bits wide). Should only be used for conversion in FloatArrays or likewise objects."
- 	| value |
- 	value := self basicNew: 2.
- 	value
- 		basicAt: 1 put: (anInteger bitShift: -32);
- 		basicAt: 2 put: (anInteger bitAnd: 16rFFFFFFFF).
- 	^value * 1.0 "reduce to SmallFloat64 if possible"!

Item was removed:
- ----- Method: Float class>>halfPi (in category 'constants') -----
- halfPi
- 	^ Halfpi!

Item was removed:
- ----- Method: Float class>>infinity (in category 'constants') -----
- infinity
- 	"Answer the value used to represent an infinite magnitude"
- 
- 	^ Infinity!

Item was removed:
- ----- Method: Float class>>initialize (in category 'class initialization') -----
- initialize
- 	"Float initialize"
- 	"Constants from Computer Approximations, pp. 182-183:
- 		Pi = 3.14159265358979323846264338327950288
- 		Pi/2 = 1.57079632679489661923132169163975144
- 		Pi*2 = 6.28318530717958647692528676655900576
- 		Pi/180 = 0.01745329251994329576923690768488612
- 		2.0 ln = 0.69314718055994530941723212145817657
- 		2.0 sqrt = 1.41421356237309504880168872420969808"
- 
- 	Pi := 3.14159265358979323846264338327950288.
- 	Halfpi := Pi / 2.0.
- 	Twopi := Pi * 2.0.
- 	ThreePi := Pi * 3.0.
- 	RadiansPerDegree := Pi / 180.0.
- 
- 	Ln2 := 0.69314718055994530941723212145817657.
- 	Ln10 := 10.0 ln.
- 	Sqrt2 := 1.41421356237309504880168872420969808.
- 	E := 2.718281828459045235360287471353.
- 
- 	Epsilon := 0.000000000001.  "Defines precision of mathematical functions"
- 
- 	MaxVal := 1.7976931348623157e308.
- 	MaxValLn := 709.782712893384.
- 	MinValLogBase2 := -1074.
- 
- 	Infinity := MaxVal * MaxVal.
- 	NegativeInfinity := 0.0 - Infinity.
- 	NaN := Infinity - Infinity.
- 	NegativeZero := 1.0 / Infinity negated.
- 
- 	{Infinity. NegativeInfinity. NaN} do: [:each| each beReadOnlyObject]
- !

Item was removed:
- ----- Method: Float class>>ln10 (in category 'constants') -----
- ln10
- 	^ Ln10!

Item was removed:
- ----- Method: Float class>>ln2 (in category 'constants') -----
- ln2
- 	^ Ln2!

Item was removed:
- ----- Method: Float class>>maxExactInteger (in category 'constants') -----
- maxExactInteger
- 	"Answer the biggest integer such that it is exactly represented in a float, and all smaller integers also are"
- 	^1 bitShift: self precision!

Item was removed:
- ----- Method: Float class>>nan (in category 'constants') -----
- nan
- 	"Answer the canonical value used to represent Not-A-Number"
- 
- 	^ NaN!

Item was removed:
- ----- Method: Float class>>negativeInfinity (in category 'constants') -----
- negativeInfinity
- 	"Answer the value used to represent a negative infinity."
- 	^ NegativeInfinity!

Item was removed:
- ----- Method: Float class>>negativeZero (in category 'constants') -----
- negativeZero
- 
- 	^ NegativeZero!

Item was removed:
- ----- Method: Float class>>one (in category 'constants') -----
- one
- 	
- 	^1.0!

Item was removed:
- ----- Method: Float class>>pi (in category 'constants') -----
- pi
- 	"Answer the constant, Pi."
- 
- 	^Pi!

Item was removed:
- ----- Method: Float class>>precision (in category 'constants') -----
- precision
- 	"Answer the apparent precision of the floating point representation.
- 	That is the maximum number of radix-based digits (bits if radix=2) representable in floating point without round off error.
- 	Technically, 52 bits are stored in the representation, and normalized numbers have an implied leading 1 that does not need to be stored.
- 	Note that denormalized floating point numbers don't have the implied leading 1, and thus gradually loose precision.
- 	This format conforms IEEE 754 double precision standard."
- 	
- 	^53!

Item was removed:
- ----- Method: Float class>>radix (in category 'constants') -----
- radix
- 	"Answer the radix used for internal floating point representation."
- 	
- 	^2!

Item was removed:
- ----- Method: Float class>>readFrom: (in category 'instance creation') -----
- readFrom: aStream 
- 	"Answer a new Float as described on the stream, aStream."
- 
- 	^(super readFrom: aStream) asFloat!

Item was removed:
- ----- Method: Float class>>readFrom:ifFail: (in category 'instance creation') -----
- readFrom: aStream ifFail: aBlock
- 	"Answer a new Float as described on the stream, aStream."
- 
- 	^(super readFrom: aStream ifFail: [^aBlock value]) asFloat!

Item was removed:
- ----- Method: Float class>>sqrt2 (in category 'constants') -----
- sqrt2
- 
- 	^ Sqrt2!

Item was removed:
- ----- Method: Float class>>threePi (in category 'constants') -----
- threePi
- 
- 	^ ThreePi
- !

Item was removed:
- ----- Method: Float class>>twoPi (in category 'constants') -----
- twoPi
- 
- 	^ Twopi
- !

Item was removed:
- ----- Method: Float class>>zero (in category 'constants') -----
- zero
- 	^ 0.0.!

Item was removed:
- ----- Method: Float>>abs (in category 'arithmetic') -----
- abs
- 	"This is faster than using Number abs and works for negativeZero."
- 	self <= 0.0
- 		ifTrue: [^ 0.0 - self]
- 		ifFalse: [^ self]!

Item was removed:
- ----- Method: Float>>absByteEncode:base: (in category 'printing') -----
- absByteEncode: aStream base: base
- 	"Print my value on a stream in the given base.  Assumes that my value is strictly
- 	positive; negative numbers, zero, and NaNs have already been handled elsewhere.
- 	Based upon the algorithm outlined in:
- 	Robert G. Burger and R. Kent Dybvig
- 	Printing Floating Point Numbers Quickly and Accurately
- 	ACM SIGPLAN 1996 Conference on Programming Language Design and Implementation
- 	June 1996.
- 	This version performs all calculations with Floats instead of LargeIntegers, and loses
- 	about 3 lsbs of accuracy compared to an exact conversion."
- 
- 	| significantBits fBase exp baseExpEstimate r s mPlus mMinus scale d tc1 tc2 fixedFormat decPointCount |
- 	self isInfinite ifTrue: [aStream print: 'Infinity'. ^ self].
- 	significantBits := 50.  "approximately 3 lsb's of accuracy loss during conversion"
- 	fBase := base asFloat.
- 	exp := self exponent.
- 	baseExpEstimate := (exp * fBase reciprocalLogBase2 - 1.0e-10) ceiling.
- 	exp >= 0
- 		ifTrue:
- 			[r := self.
- 			s := 1.0.
- 			mPlus := 1.0 timesTwoPower: exp - significantBits.
- 			mMinus := self significand ~= 1.0 ifTrue: [mPlus] ifFalse: [mPlus / 2.0]]
- 		ifFalse:
- 			[r := self timesTwoPower: significantBits.
- 			s := 1.0 timesTwoPower:  significantBits.
- 			mMinus := 1.0 timesTwoPower: (exp max: -1024).
- 			mPlus :=
- 				(exp = MinValLogBase2) | (self significand ~= 1.0)
- 					ifTrue: [mMinus]
- 					ifFalse: [mMinus * 2.0]].
- 	baseExpEstimate >= 0
- 		ifTrue:
- 			[s := s * (fBase raisedToInteger: baseExpEstimate).
- 			exp = 1023
- 				ifTrue:   "scale down to prevent overflow to Infinity during conversion"
- 					[r := r / fBase.
- 					s := s / fBase.
- 					mPlus := mPlus / fBase.
- 					mMinus := mMinus / fBase]]
- 		ifFalse:
- 			[exp < -1023
- 				ifTrue:   "scale up to prevent denorm reciprocals overflowing to Infinity"
- 					[d := (53 * fBase reciprocalLogBase2 - 1.0e-10) ceiling.
- 					scale := fBase raisedToInteger: d.
- 					r := r * scale.
- 					mPlus := mPlus * scale.
- 					mMinus := mMinus * scale.
- 					scale := fBase raisedToInteger: (baseExpEstimate + d) negated]
- 				ifFalse:
- 				[scale := fBase raisedToInteger: baseExpEstimate negated].
- 			s := s / scale].
- 	(r + mPlus >= s)
- 		ifTrue: [baseExpEstimate := baseExpEstimate + 1]
- 		ifFalse:
- 			[s := s / fBase].
- 	(fixedFormat := baseExpEstimate between: -3 and: 6)
- 		ifTrue:
- 			[decPointCount := baseExpEstimate.
- 			baseExpEstimate <= 0
- 				ifTrue: [aStream print: ('0.000000' truncateTo: 2 - baseExpEstimate)]]
- 		ifFalse:
- 			[decPointCount := 1].
- 	[d := (r / s) truncated.
- 	r := r - (d * s).
- 	(tc1 := r <= mMinus) | (tc2 := r + mPlus >= s)] whileFalse:
- 		[aStream print: (Character digitValue: d).
- 		r := r * fBase.
- 		mPlus := mPlus * fBase.
- 		mMinus := mMinus * fBase.
- 		decPointCount := decPointCount - 1.
- 		decPointCount = 0 ifTrue: [aStream print: $.]].
- 	tc2 ifTrue:
- 		[tc1 not | (tc1 & (r*2.0 >= s)) ifTrue: [d := d + 1]].
- 	aStream print: (Character digitValue: d).
- 	decPointCount > 0
- 		ifTrue:
- 		[decPointCount - 1 to: 1 by: -1 do: [:i | aStream print: $0].
- 		aStream print: '.0'].
- 	fixedFormat ifFalse:
- 		[aStream print: $e.
- 		aStream print: (baseExpEstimate - 1) printString]!

Item was removed:
- ----- Method: Float>>absPrintExactlyOn:base: (in category 'printing') -----
- absPrintExactlyOn: aStream base: base
- 	"Print my value on a stream in the given base.  Assumes that my value is strictly
- 	positive; negative numbers, zero, and NaNs have already been handled elsewhere.
- 	Based upon the algorithm outlined in:
- 	Robert G. Burger and R. Kent Dybvig
- 	Printing Floating Point Numbers Quickly and Accurately
- 	ACM SIGPLAN 1996 Conference on Programming Language Design and Implementation
- 	June 1996.
- 	This version guarantees that the printed representation exactly represents my value
- 	by using exact integer arithmetic."
- 
- 	| significand exp baseExpEstimate r s mPlus mMinus scale roundingIncludesLimits d tc1 tc2 fixedFormat decPointCount slowbit shead |
- 	self isInfinite ifTrue: [aStream nextPutAll: 'Infinity'. ^ self].
- 	significand := self significandAsInteger.
- 	roundingIncludesLimits := significand even.
- 	exp := (self exponent - 52) max: MinValLogBase2.
- 	baseExpEstimate := (self exponent * base asFloat reciprocalLogBase2 - 1.0e-10) ceiling.
- 	exp >= 0
- 		ifTrue:
- 			[significand ~= 16r10000000000000
- 				ifTrue:
- 					[r := significand bitShift: 1 + exp.
- 					s := 2.
- 					mPlus := mMinus := 1 bitShift: exp]
- 				ifFalse:
- 					[r := significand bitShift: 2 + exp.
- 					s := 4.
- 					mPlus := 2 * (mMinus := 1 bitShift: exp)]]
- 		ifFalse:
- 			[(exp = MinValLogBase2 or: [significand ~= 16r10000000000000])
- 				ifTrue:
- 					[r := significand bitShift: 1.
- 					s := 1 bitShift: 1 - exp.
- 					mPlus := mMinus := 1]
- 				ifFalse:
- 					[r := significand bitShift: 2.
- 					s := 1 bitShift: 2 - exp.
- 					mPlus := 2.
- 					mMinus := 1]].
- 	baseExpEstimate >= 0
- 		ifTrue: [s := s * (base raisedToInteger: baseExpEstimate)]
- 		ifFalse:
- 			[scale := base raisedToInteger: baseExpEstimate negated.
- 			r := r * scale.
- 			mPlus := mPlus * scale.
- 			mMinus := mMinus * scale].
- 	((r + mPlus >= s) and: [roundingIncludesLimits or: [r + mPlus > s]])
- 		ifTrue: [baseExpEstimate := baseExpEstimate + 1]
- 		ifFalse:
- 			[r := r * base.
- 			mPlus := mPlus * base.
- 			mMinus := mMinus * base].
- 	(fixedFormat := baseExpEstimate between: -3 and: 6)
- 		ifTrue:
- 			[decPointCount := baseExpEstimate.
- 			baseExpEstimate <= 0
- 				ifTrue: [aStream nextPutAll: ('0.000000' truncateTo: 2 - baseExpEstimate)]]
- 		ifFalse:
- 			[decPointCount := 1].
- 	slowbit := 1 - s lowBit .
- 	shead := s bitShift: slowbit.
- 	[d := (r bitShift: slowbit) // shead.
- 	r := r - (d * s).
- 	(tc1 := (r <= mMinus) and: [roundingIncludesLimits or: [r < mMinus]]) |
- 	(tc2 := (r + mPlus >= s) and: [roundingIncludesLimits or: [r + mPlus > s]])] whileFalse:
- 		[aStream nextPut: (Character digitValue: d).
- 		r := r * base.
- 		mPlus := mPlus * base.
- 		mMinus := mMinus * base.
- 		(decPointCount := decPointCount - 1) = 0 ifTrue: [aStream nextPut: $.]].
- 	tc2 ifTrue:
- 		[(tc1 not or: [r * 2 >= s]) ifTrue: [d := d + 1]].
- 	aStream nextPut: (Character digitValue: d).
- 	decPointCount > 0
- 		ifTrue:
- 			[decPointCount - 1 to: 1 by: -1 do: [:i | aStream nextPut: $0].
- 			aStream nextPutAll: '.0'].
- 	fixedFormat
- 		ifFalse:
- 			[aStream nextPut: $e.
- 			aStream nextPutAll: (baseExpEstimate - 1) printString]!

Item was removed:
- ----- Method: Float>>absPrintExactlyOn:base:decimalPlaces:showTrailingFractionalZeros: (in category 'printing') -----
- absPrintExactlyOn: aStream base: base decimalPlaces: placesDesired showTrailingFractionalZeros: showtrailingZeros
- 	"Print my value on a stream in the given base with fixed number of digits after floating point.
- 	When placesDesired are beyond Float precision, zeroes are appended.
- 	When showtrailingZeros is false, the trailing zeroes after decimal point will be omitted.
- 	If all fractional digits are zeros, the decimal point is omitted too.
- 	Assumes that my value is strictly positive; negative numbers, zero, and NaNs have already been handled elsewhere.
- 	Based upon the algorithm outlined in:
- 	Robert G. Burger and R. Kent Dybvig
- 	Printing Floating Point Numbers Quickly and Accurately
- 	ACM SIGPLAN 1996 Conference on Programming Language Design and Implementation
- 	June 1996.."
- 
- 	| significand exp baseExpEstimate r s mPlus mMinus scale roundingLowIncludesLimits roundingHighIncludesLimits d tc1 tc2 decPointCount slowbit shead delta |
- 	self isInfinite ifTrue: [aStream nextPutAll: 'Infinity'. ^ self].
- 	significand := self significandAsInteger.
- 	exp := (self exponent - 52) max: MinValLogBase2.
- 	exp >= 0
- 		ifTrue:
- 			[significand ~= 16r10000000000000
- 				ifTrue:
- 					[r := significand bitShift: 1 + exp.
- 					s := 2.
- 					mPlus := mMinus := 1 bitShift: exp]
- 				ifFalse:
- 					[r := significand bitShift: 2 + exp.
- 					s := 4.
- 					mPlus := 2 * (mMinus := 1 bitShift: exp)]]
- 		ifFalse:
- 			[(exp = MinValLogBase2 or: [significand ~= 16r10000000000000])
- 				ifTrue:
- 					[r := significand bitShift: 1.
- 					s := 1 bitShift: 1 - exp.
- 					mPlus := mMinus := 1]
- 				ifFalse:
- 					[r := significand bitShift: 2.
- 					s := 1 bitShift: 2 - exp.
- 					mPlus := 2.
- 					mMinus := 1]].
- 	delta := s / 2 / (base raisedTo: placesDesired).
- 	roundingLowIncludesLimits :=  (mMinus < delta and: [mMinus := delta. true]) or: [significand even].
- 	roundingHighIncludesLimits := (mPlus < delta and: [mPlus := delta. true]) or: [significand even].
- 	baseExpEstimate := (self exponent * base asFloat reciprocalLogBase2 - 1.0e-10) ceiling.
- 	baseExpEstimate >= 0
- 		ifTrue: [s := s * (base raisedToInteger: baseExpEstimate)]
- 		ifFalse:
- 			[scale := base raisedToInteger: baseExpEstimate negated.
- 			r := r * scale.
- 			mPlus := mPlus * scale.
- 			mMinus := mMinus * scale].
- 	((r + mPlus >= s) and: [roundingHighIncludesLimits or: [r + mPlus > s]])
- 		ifTrue: [baseExpEstimate := baseExpEstimate + 1]
- 		ifFalse:
- 			[r := r * base.
- 			mPlus := mPlus * base.
- 			mMinus := mMinus * base].
- 	decPointCount := baseExpEstimate.
- 	baseExpEstimate <= 0
- 		ifTrue:
- 			[placesDesired + baseExpEstimate <= 0
- 				ifTrue:
- 					[aStream nextPut: $0.
- 					(showtrailingZeros and: [placesDesired > 0]) ifTrue: [aStream nextPut: $.; nextPutAll: (String new: placesDesired withAll: $0)].
- 					^self].
- 			aStream nextPutAll: '0.'; nextPutAll: (String new: 0 - baseExpEstimate withAll: $0)].
- 	slowbit := 1 - s lowBit .
- 	shead := s bitShift: slowbit.
- 	[d := (r bitShift: slowbit) // shead.
- 	r := r - (d * s).
- 	(tc1 := (r <= mMinus) and: [roundingLowIncludesLimits or: [r < mMinus]]) |
- 	(tc2 := (r + mPlus >= s) and: [roundingHighIncludesLimits or: [r + mPlus > s]])] whileFalse:
- 		[aStream nextPut: (Character digitValue: d).
- 		r := r * base.
- 		mPlus := mPlus * base.
- 		mMinus := mMinus * base.
- 		(decPointCount := decPointCount - 1) = 0 ifTrue: [aStream nextPut: $.]].
- 	tc2 ifTrue:
- 		[(tc1 not or: [r * 2 >= s]) ifTrue: [d := d + 1]].
- 	aStream nextPut: (Character digitValue: d).
- 	decPointCount > 0
- 		ifTrue:
- 			[decPointCount - 1 to: 1 by: -1 do: [:i | aStream nextPut: $0].
- 			(showtrailingZeros and: [placesDesired > 0]) ifTrue: [aStream nextPut: $.; nextPutAll: (String new: placesDesired withAll: $0)]]
- 		ifFalse:
- 			[(showtrailingZeros and: [placesDesired + decPointCount > 1]) ifTrue: [aStream nextPutAll: (String new: placesDesired + decPointCount - 1 withAll: $0)]].!

Item was removed:
- ----- Method: Float>>absPrintOn:base: (in category 'printing') -----
- absPrintOn: aStream base: base
- 	"Print my value on a stream in the given base.  Assumes that my value is strictly
- 	positive; negative numbers, zero, and NaNs have already been handled elsewhere.
- 	Based upon the algorithm outlined in:
- 	Robert G. Burger and R. Kent Dybvig
- 	Printing Floating Point Numbers Quickly and Accurately
- 	ACM SIGPLAN 1996 Conference on Programming Language Design and Implementation
- 	June 1996.
- 	This version performs all calculations with Floats instead of LargeIntegers, and loses
- 	about 3 lsbs of accuracy compared to an exact conversion."
- 
- 	| significantBits fBase exp baseExpEstimate r s mPlus mMinus scale d tc1 tc2 fixedFormat decPointCount |
- 	self isInfinite ifTrue: [aStream nextPutAll: 'Infinity'. ^ self].
- 	significantBits := 50.  "approximately 3 lsb's of accuracy loss during conversion"
- 	fBase := base asFloat.
- 	exp := self exponent.
- 	baseExpEstimate := (exp * fBase reciprocalLogBase2 - 1.0e-10) ceiling.
- 	exp >= 0
- 		ifTrue:
- 			[r := self.
- 			s := 1.0.
- 			mPlus := 1.0 timesTwoPower: exp - significantBits.
- 			mMinus := self significand ~= 1.0 ifTrue: [mPlus] ifFalse: [mPlus / 2.0]]
- 		ifFalse:
- 			[r := self timesTwoPower: significantBits.
- 			s := 1.0 timesTwoPower:  significantBits.
- 			mMinus := 1.0 timesTwoPower: (exp max: -1024).
- 			mPlus :=
- 				(exp = MinValLogBase2) | (self significand ~= 1.0)
- 					ifTrue: [mMinus]
- 					ifFalse: [mMinus * 2.0]].
- 	baseExpEstimate >= 0
- 		ifTrue:
- 			[exp = 1023
- 				ifTrue:   "scale down to prevent overflow to Infinity during conversion"
- 					[r := r / fBase.
- 					s := s * (fBase raisedToInteger: baseExpEstimate - 1).
- 					mPlus := mPlus / fBase.
- 					mMinus := mMinus / fBase]
- 				ifFalse:
- 					[s := s * (fBase raisedToInteger: baseExpEstimate)]]
- 		ifFalse:
- 			[exp < -1023
- 				ifTrue:   "scale up to prevent denorm reciprocals overflowing to Infinity"
- 					[d := (53 * fBase reciprocalLogBase2 - 1.0e-10) ceiling.
- 					scale := fBase raisedToInteger: d.
- 					r := r * scale.
- 					mPlus := mPlus * scale.
- 					mMinus := mMinus * scale.
- 					scale := fBase raisedToInteger: (baseExpEstimate + d) negated]
- 				ifFalse:
- 				[scale := fBase raisedToInteger: baseExpEstimate negated].
- 			s := s / scale].
- 	(r + mPlus >= s)
- 		ifTrue: [baseExpEstimate := baseExpEstimate + 1]
- 		ifFalse:
- 			[s := s / fBase].
- 	(fixedFormat := baseExpEstimate between: -3 and: 6)
- 		ifTrue:
- 			[decPointCount := baseExpEstimate.
- 			baseExpEstimate <= 0
- 				ifTrue: [aStream nextPutAll: ('0.000000' truncateTo: 2 - baseExpEstimate)]]
- 		ifFalse:
- 			[decPointCount := 1].
- 	[d := (r / s) truncated.
- 	r := r - (d * s).
- 	(tc1 := r <= mMinus) | (tc2 := r + mPlus >= s)] whileFalse:
- 		[aStream nextPut: (Character digitValue: d).
- 		r := r * fBase.
- 		mPlus := mPlus * fBase.
- 		mMinus := mMinus * fBase.
- 		decPointCount := decPointCount - 1.
- 		decPointCount = 0 ifTrue: [aStream nextPut: $.]].
- 	tc2 ifTrue:
- 		[tc1 not | (tc1 & (r*2.0 >= s)) ifTrue: [d := d + 1]].
- 	aStream nextPut: (Character digitValue: d).
- 	decPointCount > 0
- 		ifTrue:
- 		[decPointCount - 1 to: 1 by: -1 do: [:i | aStream nextPut: $0].
- 		aStream nextPutAll: '.0'].
- 	fixedFormat ifFalse:
- 		[aStream nextPut: $e.
- 		aStream nextPutAll: (baseExpEstimate - 1) printString]!

Item was removed:
- ----- Method: Float>>absPrintOn:base:digitCount: (in category 'printing') -----
- absPrintOn: aStream base: base digitCount: digitCount 
- 	"Print me in the given base, using digitCount significant figures."
- 
- 	| fuzz x exp q fBase scale logScale xi |
- 	self isInfinite ifTrue: [^ aStream nextPutAll: 'Inf'].
- 	fBase := base asFloat.
- 	"x is myself normalized to [1.0, fBase), exp is my exponent"
- 	exp := self floorLog: fBase.
- 	scale := 1.0.
- 	logScale := 0.
- 	[(x := fBase raisedTo: (exp + logScale)) = 0]
- 		whileTrue:
- 			[scale := scale * fBase.
- 			logScale := logScale + 1].
- 	x := self * scale / x.
- 	fuzz := fBase raisedTo: 1 - digitCount.
- 	"round the last digit to be printed"
- 	x := 0.5 * fuzz + x.
- 	x >= fBase
- 		ifTrue: 
- 			["check if rounding has unnormalized x"
- 			x := x / fBase.
- 			exp := exp + 1].
- 	(exp < 6 and: [exp > -4])
- 		ifTrue: 
- 			["decimal notation"
- 			q := 0.
- 			exp < 0 ifTrue: [1 to: 1 - exp do: [:i | aStream nextPut: ('0.0000'
- at: i)]]]
- 		ifFalse: 
- 			["scientific notation"
- 			q := exp.
- 			exp := 0].
- 	[x >= fuzz]
- 		whileTrue: 
- 			["use fuzz to track significance"
- 			xi := x asInteger.
- 			aStream nextPut: (Character digitValue: xi).
- 			x := x - xi asFloat * fBase.
- 			fuzz := fuzz * fBase.
- 			exp := exp - 1.
- 			exp = -1 ifTrue: [aStream nextPut: $.]].
- 	[exp >= -1]
- 		whileTrue: 
- 			[aStream nextPut: $0.
- 			exp := exp - 1.
- 			exp = -1 ifTrue: [aStream nextPut: $.]].
- 	q ~= 0
- 		ifTrue: 
- 			[aStream nextPut: $e.
- 			q printOn: aStream]!

Item was removed:
- ----- Method: Float>>adaptToFraction:andCompare: (in category 'converting') -----
- adaptToFraction: rcvr andCompare: selector 
- 	"If I am involved in comparison with a Fraction, convert myself to a
- 	Fraction. This way, no bit is lost and comparison is exact."
- 	
- 	self isFinite ifFalse: [
- 		selector == #= ifTrue: [ ^false ].
- 		selector == #~= ifTrue: [ ^true ].
- 		(selector == #< or: [ selector == #'<=' ])
- 			ifTrue: [ ^self >= 0.0].
- 		(selector == #> or: [ selector == #'>=' ])
- 			ifTrue: [ ^0.0 >= self ].
- 		^self error: 'unknow comparison selector' ].
- 		
- 	"Try to avoid asTrueFraction because it can cost"
- 	rcvr isAnExactFloat ifTrue: [^rcvr asExactFloat perform: selector with: self].
- 	selector == #= ifTrue: [^false].
- 	selector == #~= ifTrue: [^true].
- 	^ rcvr perform: selector with: self asTrueFraction!

Item was removed:
- ----- Method: Float>>adaptToFraction:andSend: (in category 'converting') -----
- adaptToFraction: rcvr andSend: selector
- 	"If I am involved in arithmetic with a Fraction, convert it to a Float."
- 	^ rcvr asFloat perform: selector with: self!

Item was removed:
- ----- Method: Float>>adaptToInteger:andCompare: (in category 'converting') -----
- adaptToInteger: rcvr andCompare: selector 
- 	"If I am involved in comparison with an Integer, convert myself to a
- 	Fraction. This way, no bit is lost and comparison is exact."
- 	
- 	self isFinite ifFalse: [
- 		selector == #= ifTrue: [ ^false ].
- 		selector == #~= ifTrue: [ ^true ].
- 		(selector == #< or: [ selector == #'<=' ])
- 			ifTrue: [ ^self >= 0.0 ].
- 		(selector == #> or: [ selector == #'>=' ])
- 			ifTrue: [ ^0.0 >= self ].
- 		^self error: 'unknow comparison selector'].
- 		
- 	"Try to avoid asTrueFraction because it can cost"
- 	selector == #= ifTrue: [
- 		self fractionPart = 0.0 ifFalse: [^false]].
- 	selector == #~= ifTrue: [
- 		self fractionPart = 0.0 ifFalse: [^true]].
- 	
- 	rcvr isAnExactFloat ifTrue: [^rcvr asExactFloat perform: selector with: self].
- 	selector == #= ifTrue: [^false].
- 	selector == #~= ifTrue: [^true].
- 	^ rcvr perform: selector with: self asTrueFraction!

Item was removed:
- ----- Method: Float>>adaptToInteger:andSend: (in category 'converting') -----
- adaptToInteger: rcvr andSend: selector
- 	"If I am involved in arithmetic with an Integer, convert it to a Float."
- 	^ rcvr asFloat perform: selector with: self!

Item was removed:
- ----- Method: Float>>adaptToScaledDecimal:andCompare: (in category 'converting') -----
- adaptToScaledDecimal: rcvr andCompare: selector 
- 	"If I am involved in comparison with a scaled Decimal, convert myself to a
- 	Fraction. This way, no bit is lost and comparison is exact."
- 	
- 	self isFinite ifFalse: [
- 		selector == #= ifTrue: [^false].
- 		selector == #~= ifTrue: [^true].
- 		(selector == #< or: [ selector == #'<=' ])
- 			ifTrue: [ ^self >= 0.0 ].
- 		(selector == #> or: [ selector == #'>=' ])
- 			ifTrue: [ ^0.0 >= self ].
- 		^self error: 'unknow comparison selector' ].
- 
- 	"Try to avoid asTrueFraction because it can cost"
- 	rcvr isAnExactFloat ifTrue: [^rcvr asExactFloat perform: selector with: self].
- 	selector == #= ifTrue: [^false].
- 	selector == #~= ifTrue: [^true].
- 	^ rcvr perform: selector with: self asTrueFraction!

Item was removed:
- ----- Method: Float>>adaptToScaledDecimal:andSend: (in category 'converting') -----
- adaptToScaledDecimal: receiverScaledDecimal andSend: arithmeticOpSelector 
- 	"Convert receiverScaledDecimal to a Float and do the arithmetic. 
- 	receiverScaledDecimal arithmeticOpSelector self."
- 	#Numeric.
- 	"add 200/01/19 For ScaledDecimal support."
- 	^ receiverScaledDecimal asFloat perform: arithmeticOpSelector with: self!

Item was removed:
- ----- Method: Float>>arCosh (in category 'mathematical functions') -----
- arCosh
- 	"Answer receiver's area hyperbolic cosine.
- 	That is the inverse function of cosh."
- 
- 	self < 1 
- 		ifTrue: 
- 			[^DomainError signal: 'Receiver must be greater or equal to 1'].
- 	^self + 1 = self 
- 		ifTrue: [self abs ln + 2 ln]
- 		ifFalse: [((self squared - 1) sqrt + self) ln]!

Item was removed:
- ----- Method: Float>>arSinh (in category 'mathematical functions') -----
- arSinh
- 	"Answer receiver's area hyperbolic sine.
- 	That is the inverse function of sinh."
- 
- 	self = 0.0 ifTrue: [^self].	"Handle negativeZero"  
- 	^self + 1 = self 
- 		ifTrue: [(self abs ln + 2 ln) * self sign]
- 		ifFalse: [((self squared + 1) sqrt + self) ln]!

Item was removed:
- ----- Method: Float>>arTanh (in category 'mathematical functions') -----
- arTanh
- 	"Answer receiver's area hyperbolic tangent.
- 	That is the inverse function of tanh."
- 
- 	self = 0.0 ifTrue: [^self].	"Handle negativeZero"
- 	self abs = 1 ifTrue: [^self copySignTo: Float infinity].
- 	self abs > 1 
- 		ifTrue: 
- 			[^DomainError signal: 'Receiver must be between -1.0 and 1.0'].
- 	^((1 + self) / (1 - self)) ln / 2!

Item was removed:
- ----- Method: Float>>arcCos (in category 'mathematical functions') -----
- arcCos
- 	"Answer the angle in radians."
- 
- 	^ Halfpi - self arcSin!

Item was removed:
- ----- Method: Float>>arcSin (in category 'mathematical functions') -----
- arcSin
- 	"Answer the angle in radians."
- 
- 	((self < -1.0) or: [self > 1.0]) ifTrue: [DomainError signal: 'arcSin only takes values between -1 and 1'].
- 	((self = -1.0) or: [self = 1.0])
- 		ifTrue: [^ Halfpi * self]
- 		ifFalse: [^ (self / (1.0 - (self * self)) sqrt) arcTan]!

Item was removed:
- ----- Method: Float>>arcTan: (in category 'mathematical functions') -----
- arcTan: denominator
- 	"Answer the angle in radians, taking care of 4 quadrants.
- 	Implementation note: use signBit and sign: in order to catch cases of negativeZero"
- 
- 	self = 0.0
- 		ifTrue:
- 			[denominator signBit = 0 ifTrue: [ ^0.0 ].
- 			^Pi sign: self ].
- 	denominator = 0.0 ifTrue: [ ^Halfpi sign: self ].
- 	denominator > 0.0 	ifTrue: [ ^(self / denominator) arcTan ].
- 	^(self / denominator) arcTan + (Pi sign: self)!

Item was removed:
- ----- Method: Float>>asApproximateFraction (in category 'converting') -----
- asApproximateFraction
- 	"Answer a Fraction approximating the receiver. This conversion uses the 
- 	continued fraction method to approximate a floating point number."
- 
- 	^ self asApproximateFractionRelativeDecimalPlaces: 10!

Item was removed:
- ----- Method: Float>>asApproximateFractionAtOrder: (in category 'converting') -----
- asApproximateFractionAtOrder: maxOrder
- 	"Answer a Fraction approximating the receiver. This conversion uses the 
- 	continued fraction method to approximate a floating point number. If maxOrder
- 	is zero, use maximum order"
- 
- 	^self 
- 		asApproximateFractionAtOrder: maxOrder
- 		precision: self ulp / 2!

Item was removed:
- ----- Method: Float>>asApproximateFractionAtOrder:precision: (in category 'converting') -----
- asApproximateFractionAtOrder: maxOrder precision: limit 
- 	"Answer a Rational number--Integer or Fraction--representing the receiver.
- 	This conversion uses the continued fraction method to	approximate a floating point number.
- 	The iteration stops when precision has reached the prescribed limit,
- 	or when the maximum number of iterations has been reached.
- 	If maxOrder is zero, then the number of iterations is not limited."
- 	
- 	| num1 denom1 num2 denom2 int frac newD order |
- 	newD := self asFraction. "use exact arithmetic to avoid both overflow and accumulation of rounding errors"
- 	num1 := denom2 := 1. "Initialize alternating numerators"
- 	num2 := denom1 := 0. "and denominators"	
- 	order := maxOrder = 0 ifTrue: [-1] ifFalse: [maxOrder].
- 	[int := newD integerPart. "get the integer part of this"
- 	frac := newD fractionPart. "and save the fractional part for next time"
- 	num1 := num2 + ((num2 := num1) * int). "Update numerators"
- 	denom1 := denom2 + ((denom2 := denom1) * int). "and denominators"
- 	frac = 0
- 		or: [order = 0
- 		or: [((Fraction numerator: num1 denominator: denom1) - self) abs <= limit]]]
- 		whileFalse:
- 			[newD := frac reciprocal "Take reciprocal of the fractional part".
- 			order := order - 1].
- 	^denom1 = 1
- 		ifTrue: ["Am i really an Integer?"
- 			num1"Yes, return Integer result"]
- 		ifFalse: ["Otherwise return Fraction result"
- 			Fraction numerator: num1 denominator: denom1]!

Item was removed:
- ----- Method: Float>>asApproximateFractionRelativeDecimalPlaces: (in category 'converting') -----
- asApproximateFractionRelativeDecimalPlaces: decimalPlaces
- 	"Answer a Fraction approximating the receiver. This conversion uses the 
- 	continued fraction method to approximate a floating point number.
- 	Stop the recursion when precision has reached prescribed number of relative decimalPlaces."
- 
- 	^ self
- 		asApproximateFractionAtOrder: 0
- 		precision: (1.0 timesTwoPower: self exponent - (decimalPlaces * Ln10 / Ln2) rounded)!

Item was removed:
- ----- Method: Float>>asBytesDescription (in category 'printing') -----
- asBytesDescription
- 	^ self asInteger asBytesDescription!

Item was removed:
- ----- Method: Float>>asFloat (in category 'converting') -----
- asFloat
- 	"Answer the receiver itself."
- 
- 	^self!

Item was removed:
- ----- Method: Float>>asFraction (in category 'converting') -----
- asFraction
- 	^ self asTrueFraction !

Item was removed:
- ----- Method: Float>>asIEEE32BitWord (in category 'converting') -----
- asIEEE32BitWord
- 	"Convert the receiver into a 32 bit Integer value representing the same number in IEEE 32 bit format.
- 	 Used for conversion in FloatArrays."
- 	
- 	| word1 word2 sign mantissa exponent truncatedBits mask roundToUpper |
- 	
- 	"skip fast positive and nnegative zero"
- 	self = 0.0 ifTrue: [^self basicAt: 1].
- 	
- 	"retrieve 64 bits of IEEE 754 double"
- 	word1 := self basicAt: 1.
- 	word2 := self basicAt: 2.
- 	
- 	"prepare sign exponent and mantissa of 32 bits float"
- 	sign := word1 bitAnd: 16r80000000.
- 	exponent := ((word1 bitShift: -20) bitAnd: 16r7FF) - 1023 + 127.
- 	mantissa := (word2 bitShift: -29) + ((word1 bitAnd:  16rFFFFF) bitShift: 3).
- 	truncatedBits := (word2 bitAnd: 16r1FFFFFFF).
- 
- 	"We must now honour default IEEE rounding mode (round to nearest even)"
- 	
- 	"we are below gradual underflow, even if rounded to upper mantissa"
- 	exponent < -24 ifTrue: [^sign]. "this can be negative zero"
- 	
- 	"BEWARE: rounding occurs on less than 23bits when gradual underflow"
- 	exponent <= 0
- 		ifTrue:
- 			[mask := 1 bitShift: exponent negated.
- 			mantissa := mantissa bitOr: 16r800000.
- 			roundToUpper := (mantissa bitAnd: mask) isZero not
- 				and: [truncatedBits isZero not
- 					or: [(mantissa bitAnd: mask - 1) isZero not
- 						or: [(mantissa bitAnd: mask*2) isZero not]]].
- 			mantissa := mantissa bitShift: exponent - 1.
- 			"exponent := exponent + 1"]
- 		ifFalse:
- 			[roundToUpper := (truncatedBits bitAnd: 16r10000000) isZero not
- 				and: [(mantissa bitAnd: 16r1) isZero not
- 					or: [(truncatedBits bitAnd: 16r0FFFFFFF) isZero not]]].
- 		
- 	"adjust mantissa and exponent due to IEEE rounding mode"
- 	roundToUpper ifTrue:
- 		[mantissa := mantissa + 1.
- 		mantissa > 16r7FFFFF ifTrue:
- 			[mantissa := 0.
- 			exponent := exponent+1]].
- 
- 	exponent > 254 ifTrue: "Overflow"
- 		[exponent := 255.
- 		self isNaN
- 			ifTrue: [mantissa isZero
- 				ifTrue: ["BEWARE: do not convert a NaN to infinity due to truncatedBits"
- 					mantissa := 1]]
- 			ifFalse: [mantissa := 0]].
- 		
- 	"Encode the word"
- 	^(sign bitOr: ((exponent max: 0) bitShift: 23)) bitOr: mantissa!

Item was removed:
- ----- Method: Float>>asIEEE64BitWord (in category 'converting') -----
- asIEEE64BitWord
- 	"Convert the receiver into a 64 bit Integer value representing the same number in IEEE 64 bit format.
- 	 Used for conversion in FloatArrays."
- 	
- 	^((self basicAt: 1) bitShift: 32) + (self basicAt: 2)!

Item was removed:
- ----- Method: Float>>asTrueFraction (in category 'converting') -----
- asTrueFraction
- 	" Answer a fraction that EXACTLY represents self,
- 	  a double precision IEEE floating point number.
- 	  Floats are stored in the same form on all platforms.
- 	  (Does handle gradual underflow but not NANs.)
- 	  By David N. Smith with significant performance
- 	  improvements by Luciano Esteban Notarfrancesco.
- 	  (Version of 11April97)"
- 	| signexp positive expPart exp fraction fractionPart signedFraction result zeroBitsCount |
- 	self isInfinite ifTrue: [self error: 'Cannot represent infinity as a fraction'].
- 	self isNaN ifTrue: [self error: 'Cannot represent Not-a-Number as a fraction'].
- 
- 
- 	" Extract the sign and the biased exponent "
- 	signexp := (self basicAt: 1) bitShift: -20.
- 	positive := (signexp bitAnd: 16r800) = 0.
- 	expPart := signexp bitAnd: 16r7FF.
- 
- 	" Extract fractional part; answer 0 if this is a true 0.0 value "
- 	fractionPart := (((self basicAt: 1) bitAnd: 16rFFFFF) bitShift: 32)+ (self basicAt: 2).
- 	( expPart=0 and: [ fractionPart=0 ] ) ifTrue: [ ^ 0  ].
- 
- 	" Replace omitted leading 1 in fraction unless gradual underflow"
- 	fraction := expPart = 0
- 		ifTrue: [fractionPart bitShift: 1]
- 		ifFalse: [fractionPart bitOr: 16r0010000000000000].
- 	signedFraction := positive ifTrue: [fraction] ifFalse: [fraction negated].
- 	
- 	"Unbias exponent: 16r3FF is bias; 52 is fraction width"
- 	exp := 16r3FF + 52 - expPart.
- 
- 	" Form the result. When exp>52, the exponent is adjusted by
- 	  the number of trailing zero bits in the fraction to minimize
- 	  the (huge) time otherwise spent in #gcd:. "
- 	exp negative
- 		ifTrue: [
- 			result := signedFraction bitShift: exp negated ]
- 		ifFalse:	[
- 			zeroBitsCount := fraction lowBit - 1.
- 			exp := exp - zeroBitsCount.
- 			exp <= 0
- 				ifTrue: [
- 					zeroBitsCount := zeroBitsCount + exp.
- 					"exp := 0."   " Not needed; exp not
- refernced again "
- 					result := signedFraction bitShift:
- zeroBitsCount negated ]
- 				ifFalse: [
- 					result := Fraction
- 						numerator: (signedFraction
- bitShift: zeroBitsCount negated)
- 						denominator: (1 bitShift:
- exp) ] ].
- 
- 	"Low cost validation omitted after extensive testing"
- 	"(result asFloat = self) ifFalse: [self error: 'asTrueFraction validation failed']."
- 	^ result !

Item was removed:
- ----- Method: Float>>at: (in category 'accessing') -----
- at: index 
- 	"Avoid primitive in Object>>at:"
- 
- 	^self basicAt: index!

Item was removed:
- ----- Method: Float>>at:put: (in category 'accessing') -----
- at: index put: value 
- 	"Avoid primitive in Object>>at:put:"
- 
- 	^self basicAt: index put: value!

Item was removed:
- ----- Method: Float>>basicAt: (in category 'accessing') -----
- basicAt: index
- 	"Primitive. Assumes receiver is indexable. Answer the value of an 
- 	indexable element in the receiver. Fail if the argument index is not an 
- 	Integer or is out of bounds. Essential. Do not override in a subclass. See 
- 	Object documentation whatIsAPrimitive.
- 
- 	This version of basicAt: is specifically for floats, answering the most significant
- 	word for index 1 and the least significant word for index 2.  This allows the VM
- 	to store floats in whatever order it chooses while it appears to the image that
- 	they are always in big-endian/PowerPC order."
- 
- 	<primitive: 38 error: ec>
- 	ec ifNil: "primitive not implemented; floats are in big-endian/PowerPC order."
- 		[^super basicAt: index].
- 	index isInteger ifTrue: [self errorSubscriptBounds: index].
- 	index isNumber
- 		ifTrue: [^self basicAt: index asInteger]
- 		ifFalse: [self errorNonIntegerIndex]!

Item was removed:
- ----- Method: Float>>basicAt:put: (in category 'accessing') -----
- basicAt: index put: value
- 	"Primitive. Assumes receiver is indexable. Store the second argument 
- 	value in the indexable element of the receiver indicated by index. Fail 
- 	if the index is not an Integer or is out of bounds. Or fail if the value is 
- 	not of the right type for this kind of collection. Answer the value that 
- 	was stored. Essential. Do not override in a subclass. See Object 
- 	documentation whatIsAPrimitive.
- 
- 	This version of basicAt: is specifically for floats, answering the most significant
- 	word for index 1 and the least significant word for index 2.  This allows the VM
- 	to store floats in whatever order it chooses while it appears to the image that
- 	they are always in big-endian/PowerPC order."
- 
- 	<primitive: 39 error: ec>
- 	ec ifNil: "primitive not implemented; floats are in big-endian/PowerPC order."
- 		[^super basicAt: index put: value].
- 	index isInteger
- 		ifTrue: [(index >= 1 and: [index <= self size])
- 					ifTrue: [self errorImproperStore]
- 					ifFalse: [self errorSubscriptBounds: index]].
- 	index isNumber
- 		ifTrue: [^self basicAt: index asInteger put: value]
- 		ifFalse: [self errorNonIntegerIndex]!

Item was removed:
- ----- Method: Float>>byteEncode:base: (in category 'printing') -----
- byteEncode: aStream base: base
- 	"Handle sign, zero, and NaNs; all other values passed to absPrintOn:base:" 
- 
- 	self isNaN ifTrue: [aStream print: 'NaN'. ^ self]. "check for NaN before sign"
- 	self > 0.0
- 		ifTrue: [self absByteEncode: aStream base: base]
- 		ifFalse:
- 			[self signBit = 1
- 				ifTrue: [aStream print: '-'].
- 			self = 0.0
- 				ifTrue: [aStream print: '0.0'. ^ self]
- 				ifFalse: [aStream writeNumber:self negated base: base]]!

Item was removed:
- ----- Method: Float>>closeTo: (in category 'comparing') -----
- closeTo: num
-  	"are these two numbers close?"
- 	num isNumber ifFalse: [^[self = num] ifError: [false]].
- 	self = 0.0 ifTrue: [^num abs < 0.0001].
- 	num = 0 ifTrue: [^self abs < 0.0001].
- 	^self = num asFloat or: [
- 		| abs |
- 		(abs := self abs) < 0.0001 ifTrue: [^num abs < 0.0001].
- 		(self - num) abs / (abs max: num abs) < 0.0001]!

Item was removed:
- ----- Method: Float>>cos (in category 'mathematical functions') -----
- cos
- 	"Answer the cosine of the receiver taken as an angle in radians."
- 
- 	^ (self + Halfpi) sin!

Item was removed:
- ----- Method: Float>>cosh (in category 'mathematical functions') -----
- cosh
- 	"Answer receivers hyperbolic cosine."
- 	
- 	| ex |
- 	ex := self abs exp.
- 	^(ex + ex reciprocal) / 2!

Item was removed:
- ----- Method: Float>>deepCopy (in category 'copying') -----
- deepCopy
- 
- 	^self copy!

Item was removed:
- ----- Method: Float>>degreeCos (in category 'mathematical functions') -----
- degreeCos
- 	"Take care of exceptional values"
- 	
- 	self isFinite ifTrue: [^super degreeCos].
- 	^self degreesToRadians cos!

Item was removed:
- ----- Method: Float>>degreeSin (in category 'mathematical functions') -----
- degreeSin
- 	"Take care of exceptional values"
- 	
- 	self isFinite ifTrue: [^super degreeSin].
- 	^self degreesToRadians sin!

Item was removed:
- ----- Method: Float>>degreesToRadians (in category 'converting') -----
- degreesToRadians
- 	"Answer the receiver in radians. Assumes the receiver is in degrees."
- 
- 	^self * RadiansPerDegree!

Item was removed:
- ----- Method: Float>>exponentFromBitPattern (in category 'truncation and round off') -----
- exponentFromBitPattern
- 	"Extract the exponent from the bit pattern.
- 	This is used only when primitive fails"
- 	
- 	| exponent word1 |
- 	self isFinite ifFalse: [^self error: 'cannot take the exponent of non finite Float'].
- 	self = 0.0 ifTrue: [^-1].
- 	word1 := self basicAt: 1.
- 	exponent := (word1 bitShift: -20) bitAnd: 16r7FF.
- 	^exponent = 0
- 		ifTrue:
- 			[| high |
- 			high := (word1 bitAnd: 16rFFFFF) highBit.
- 			high := high = 0
- 				ifTrue: [(self basicAt: 2) highBit]
- 				ifFalse: [high + 32].
- 			self class emin - self class precision + high]
- 		ifFalse:
- 			[exponent + self class emin - 1]!

Item was removed:
- ----- Method: Float>>floorLog: (in category 'mathematical functions') -----
- floorLog: radix
- 	"Answer the floor of the log base radix of the receiver.
- 	The result may be off by one due to rounding errors, except in base 2."
- 
- 	(radix = 2 and: [self > 0.0 and: [self isFinite]]) ifTrue: [^self exponent].
- 	^ (self log: radix) floor
- !

Item was removed:
- ----- Method: Float>>hasLimitedPrecision (in category 'testing') -----
- hasLimitedPrecision
- 	^true!

Item was removed:
- ----- Method: Float>>hash (in category 'comparing') -----
- hash
- 	"Hash is reimplemented because = is implemented. Both words of the float are used. (The bitShift:'s ensure that the intermediate results do not become a large integer.) Care is taken to answer same hash as an equal Integer."
- 
- 	(self isFinite and: [self fractionPart = 0.0]) ifTrue: [^self truncated hash].
- 	^ ((self basicAt: 1) bitShift: -4) +
- 	   ((self basicAt: 2) bitShift: -4)
- !

Item was removed:
- ----- Method: Float>>hex (in category 'printing') -----
- 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]
- "!

Item was removed:
- ----- Method: Float>>integerPart (in category 'truncation and round off') -----
- integerPart
- 	"Answer a Float whose value is the receiver's truncated value."
- 
- 	^self - self fractionPart!

Item was removed:
- ----- Method: Float>>isAnExactFloat (in category 'testing') -----
- isAnExactFloat
- 	^true!

Item was removed:
- ----- Method: Float>>isDenormal (in category 'testing') -----
- isDenormal
- 	"Return true if the receiver is a denormal."
- 
- 	^ self exponent < self class emin and: [self isZero not]!

Item was removed:
- ----- Method: Float>>isFinite (in category 'testing') -----
- isFinite
- 	"simple, byte-order independent test for rejecting Not-a-Number and (Negative)Infinity"
- 
- 	^(self - self) = 0.0!

Item was removed:
- ----- Method: Float>>isFloat (in category 'testing') -----
- isFloat
- 	^ true!

Item was removed:
- ----- Method: Float>>isInfinite (in category 'testing') -----
- isInfinite
- 	"Return true if the receiver is positive or negative infinity."
- 
- 	^ self = Infinity or: [self = NegativeInfinity]
- !

Item was removed:
- ----- Method: Float>>isLiteral (in category 'testing') -----
- isLiteral
- 	"There is no literal representation of NaN.
- 	However, there are literal representations of Infinity, like 1.0e1000.
- 	But since they are not able to print properly, only case of finite Float is considered."
- 	
- 	^self isFinite!

Item was removed:
- ----- Method: Float>>isNaN (in category 'testing') -----
- isNaN
- 	"simple, byte-order independent test for Not-a-Number"
- 
- 	^ self ~= self!

Item was removed:
- ----- Method: Float>>isPowerOfTwo (in category 'testing') -----
- isPowerOfTwo
- 	"Return true if the receiver is an integral power of two."
- 	^self significand = 1.0!

Item was removed:
- ----- Method: Float>>isZero (in category 'testing') -----
- isZero
- 	^self = 0.0!

Item was removed:
- ----- Method: Float>>literalEqual: (in category 'comparing') -----
- literalEqual: aFloat
- 	"Two float literals can be replaced by a single one only if their representation have the same bits.
- 	For example, zero and negativeZero are equal, but not literally equal."
- 
- 	^self class == aFloat class and: [(self at: 1) = (aFloat at: 1) and: [(self at: 2) = (aFloat at: 2)]]!

Item was removed:
- ----- Method: Float>>log (in category 'mathematical functions') -----
- log
- 	"Answer the base 10 logarithm of the receiver."
- 
- 	^ self ln / Ln10!

Item was removed:
- ----- Method: Float>>log2 (in category 'mathematical functions') -----
- log2
- 	"Answer the base 2 logarithm of the receiver.
- 	Arrange to answer exact result in case of exact power of 2."
- 
- 	|  s  |
- 	 s := self significand.
- 	^s > 1.3333333333333333
- 		ifTrue: [(0.5 * s) ln / Ln2 + (1 + self exponent)]
- 		ifFalse: [s ln / Ln2 + self exponent]!

Item was removed:
- ----- Method: Float>>negated (in category 'arithmetic') -----
- negated
- 	"Answer a Number that is the negation of the receiver.
- 	Implementation note: this version cares of negativeZero."
- 
- 	^-1.0 * self!

Item was removed:
- ----- Method: Float>>nthRoot: (in category 'mathematical functions') -----
- nthRoot: aPositiveInteger
- 	"Answer the nth root of the receiver."
- 	aPositiveInteger = 2 ifTrue: [
- 		^self sqrt ].
- 
- 	(aPositiveInteger isInteger not or: [ aPositiveInteger negative ])
- 		ifTrue: [^ ArithmeticError signal: 'nth root only defined for positive Integer n.'].
- 	
- 	^self negative
- 		ifTrue: [
- 			aPositiveInteger odd
- 				ifTrue: [ (self negated raisedTo: 1.0 / aPositiveInteger) negated ]
- 				ifFalse: [ ArithmeticError signal: 'Negative numbers don''t have even roots.' ]]
- 		ifFalse: [ self raisedTo: 1.0 / aPositiveInteger ]!

Item was removed:
- ----- Method: Float>>predecessor (in category 'truncation and round off') -----
- predecessor
- 	| ulp |
- 	self isFinite ifFalse: [
- 		(self isNaN or: [self negative]) ifTrue: [^self].
- 		^Float fmax].
- 	ulp := self ulp.
- 	^self - (0.5 * ulp) = self
- 		ifTrue: [self - ulp]
- 		ifFalse: [self - (0.5 * ulp)]!

Item was removed:
- ----- Method: Float>>printAsLiteralOn: (in category 'printing') -----
- printAsLiteralOn: aStream
- 	^self storeOn: aStream base: 10!

Item was removed:
- ----- Method: Float>>printOn:base: (in category 'printing') -----
- printOn: aStream base: base
- 	"Print the receiver with the minimal number of digits that describes it unambiguously.
- 	This way, every two different Float will have a different printed representation.
- 	More over, every Float can be reconstructed from its printed representation with #readFrom:." 
- 
- 	self isNaN ifTrue: [aStream nextPutAll: 'NaN'. ^ self]. "check for NaN before sign"
- 	self > 0.0
- 		ifTrue: [self absPrintExactlyOn: aStream base: base]
- 		ifFalse:
- 			[self signBit = 1
- 				ifTrue: [aStream nextPutAll: '-'].
- 			self = 0.0
- 				ifTrue: [aStream nextPutAll: '0.0']
- 				ifFalse: [self negated absPrintExactlyOn: aStream base: base]]!

Item was removed:
- ----- Method: Float>>printOn:maxDecimalPlaces: (in category 'printing') -----
- printOn: aStream maxDecimalPlaces: placesDesired
- 	"Refine super implementation in order to avoid any rounding error caused by rounded or roundTo:"
- 	
- 	self isFinite ifFalse: [^self printOn: aStream].
- 	self > 0.0
- 		ifTrue: [self absPrintExactlyOn: aStream base: 10 decimalPlaces: placesDesired showTrailingFractionalZeros: false]
- 		ifFalse:
- 			[self signBit = 1
- 				ifTrue: [aStream nextPutAll: '-'].
- 			self = 0.0
- 				ifTrue: [aStream nextPutAll: '0.0']
- 				ifFalse: [self absPrintExactlyOn: aStream base: 10 decimalPlaces: placesDesired showTrailingFractionalZeros: false]]!

Item was removed:
- ----- Method: Float>>printOn:showingDecimalPlaces: (in category 'printing') -----
- printOn: aStream showingDecimalPlaces: placesDesired
- 	"Refine super implementation in order to avoid any rounding error caused by rounded or roundTo:"
- 	
- 	self isFinite ifFalse: [^self printOn: aStream].
- 	self > 0.0
- 		ifTrue: [self absPrintExactlyOn: aStream base: 10 decimalPlaces: placesDesired showTrailingFractionalZeros: true]
- 		ifFalse:
- 			[self signBit = 1
- 				ifTrue: [aStream nextPutAll: '-'].
- 			self = 0.0
- 				ifTrue:
- 					[aStream nextPut: $0.
- 					placesDesired > 0 ifTrue: [aStream nextPut: $.; next: placesDesired put: $0]]
- 				ifFalse: [self absPrintExactlyOn: aStream base: 10 decimalPlaces: placesDesired showTrailingFractionalZeros: true]]!

Item was removed:
- ----- Method: Float>>printPaddedWith:to: (in category 'printing') -----
- printPaddedWith: aCharacter to: aNumber 
- 	"Answer the string containing the ASCII representation of the receiver 
- 	padded on the left with aCharacter to be at least on aNumber 
- 	integerPart characters and padded the right with aCharacter to be at 
- 	least anInteger fractionPart characters."
- 	| aStream digits fPadding fLen iPadding iLen curLen periodIndex |
- 	#Numeric.
- 	"2000/03/04  Harmon R. Added Date and Time support"
- 	aStream := WriteStream on: (String new: 10).
- 	self printOn: aStream.
- 	digits := aStream contents.
- 	periodIndex := digits indexOf: $..
- 	curLen := periodIndex - 1.
- 	iLen := aNumber integerPart.
- 	curLen < iLen
- 		ifTrue: [iPadding := (String new: (iLen - curLen) asInteger) atAllPut: aCharacter;
- 					 yourself]
- 		ifFalse: [iPadding := ''].
- 	curLen := digits size - periodIndex.
- 	"n.b. Treat aNumber as a string format specifier rather than as a number, because
- 	floating point truncation can produce incorrect results for the fraction part."
- 	fLen := (aNumber asString copyAfterLast: $. )
- 		ifNotEmpty: [:s | s asInteger]
- 		ifEmpty: [ 0 ].
- 	curLen < fLen
- 		ifTrue: [fPadding := (String new: fLen - curLen) atAllPut: aCharacter;
- 					 yourself]
- 		ifFalse: [fPadding := ''].
- 	^ iPadding , digits , fPadding!

Item was removed:
- ----- Method: Float>>radiansToDegrees (in category 'converting') -----
- radiansToDegrees
- 	"Answer the receiver in degrees. Assumes the receiver is in radians."
- 
- 	^self / RadiansPerDegree!

Item was removed:
- ----- Method: Float>>reciprocal (in category 'arithmetic') -----
- reciprocal
- 
- 	"Returns the reciprocal.
- 	If self is 0.0 the / signals a ZeroDivide"
- 	
- 	^1.0 / self!

Item was removed:
- ----- Method: Float>>reciprocalFloorLog: (in category 'mathematical functions') -----
- reciprocalFloorLog: radix 
- 	"Quick computation of (self log: radix) floor, when self < 1.0.
- 	Avoids infinite recursion problems with denormalized numbers"
- 
- 	| adjust scale n |
- 	adjust := 0.
- 	scale := 1.0.
- 	[(n := radix / (self * scale)) isInfinite]
- 		whileTrue:
- 			[scale := scale * radix.
- 			adjust := adjust + 1].
- 	^ ((n floorLog: radix) + adjust) negated!

Item was removed:
- ----- Method: Float>>reciprocalLogBase2 (in category 'mathematical functions') -----
- reciprocalLogBase2
- 	"optimized for self = 10, for use in conversion for printing"
- 
- 	^ self = 10.0
- 		ifTrue: [Ln2 / Ln10]
- 		ifFalse: [Ln2 / self ln]!

Item was removed:
- ----- Method: Float>>reduce (in category 'truncation and round off') -----
- reduce
-     "If self is close to an integer, return that integer"
- 
-     (self closeTo: self rounded) ifTrue: [^ self rounded]!

Item was removed:
- ----- Method: Float>>rounded (in category 'truncation and round off') -----
- rounded
- 	"Answer the integer nearest the receiver.
- 	Implementation note: super would not handle tricky inexact arithmetic"
- 	
- 	"self assert: 5000000000000001.0 rounded = 5000000000000001"
- 
- 	self fractionPart abs < 0.5
- 		ifTrue: [^self truncated]
- 		ifFalse: [^self truncated + self sign]!

Item was removed:
- ----- Method: Float>>safeArcCos (in category 'mathematical functions') -----
- safeArcCos
- 	"Answer the angle in radians."
- 	(self between: -1.0 and: 1.0)
- 		ifTrue: [^ self arcCos]
- 		ifFalse: [^ self sign arcCos]!

Item was removed:
- ----- Method: Float>>signBit (in category 'mathematical functions') -----
- signBit
- 	"Answer 1 if the receiver has sign bit set (including case of IEEE-754 negative-zero).
- 	Answer 0 otherwise"
- 
- 	^((self at: 1) bitShift: -31)!

Item was removed:
- ----- Method: Float>>significand (in category 'truncation and round off') -----
- significand
- 
- 	^ self timesTwoPower: (self exponent negated)!

Item was removed:
- ----- Method: Float>>significandAsInteger (in category 'truncation and round off') -----
- significandAsInteger
- 	"Answer the mantissa of a Float shifted so as to have the ulp equal to 1.
- 	For exceptional values, infinity and nan, just answer the bit pattern."
- 
- 	self isFinite ifTrue:
- 		[^(self timesTwoPower: self class precision - 1 - (self exponent max: self class emin)) truncated abs].
- 	^(((self basicAt: 1) bitAnd: 16r000FFFFF) bitShift: 32) bitOr: (self basicAt: 2)!

Item was removed:
- ----- Method: Float>>sinh (in category 'mathematical functions') -----
- sinh
- 	"Answer receivers hyperbolic sine"
- 	
- 	| ex |
- 	ex := self abs exp.
- 	^self copySignTo: (ex - ex reciprocal) / 2!

Item was removed:
- ----- Method: Float>>sqrt (in category 'mathematical functions') -----
- sqrt
- 	"Fallback code for absent primitives.
- 	Care to answer a correctly rounded result as mandated by IEEE-754."
- 	
- 	| guess selfScaled nextGuess exp secator hi lo remainder maxError |
- 	self <= 0.0
- 		ifTrue: [self = 0.0
- 				ifTrue: [^ self]
- 				ifFalse: [^ DomainError signal: 'sqrt undefined for number less than zero.']].
- 	self isFinite ifFalse: [^self].
- 	
- 	"scale to avoid loss of precision in case of gradual underflow
- 	(selfScaled between: 1.0 and: 2.0), so it is a good guess by itself"
- 	exp := self exponent // 2.
- 	guess := selfScaled := self timesTwoPower: exp * -2.
- 	
- 	"Use Newton-Raphson iteration - it converges quadratically
- 	(twice many correct bits at each loop)"
- 	[nextGuess := selfScaled - (guess * guess) / (2.0 * guess) + guess.
- 	"test if both guess are within 1 ulp"
- 	(nextGuess + guess) / 2.0  = guess]
- 		whileFalse: 
- 			["always round odd upper - this avoids infinite loop with alternate flip of last bit"
- 			guess := nextGuess + (nextGuess ulp/2.0)].
- 	
- 	"adjust the rounding - the guess can be 2 ulp up or 1 ulp down
- 	Let u = guess ulp.
- 	if (guess+u/2)^2<self, then guess is under-estimated
- 	if (guess-u/2)^2>self, then guess is over-estimated
- 	Note that they can't be equal (because left term has 55 bits).
- 	(guess+u/2)^2=guess^2 + guess*u + u^2/4 < self
- 	==> self - guess^2 > guess*u
- 	(guess-u/2)^2=guess^2 - guess*u + u^2/4 > self
- 	==> guess^2 - self >= guess*u
- 	(guess^2 - self) is evaluated with an emulated fused-multiply-add"
- 	
- 	["Decompose guess in two 26 bits parts hi,lo
- 	the trick is that they do not necessarily have the same sign
- 	If 53 bits are hi,0,lo => (hi,lo) else hi,1,lo=> (hi+1,-lo)"
- 	secator := "1<<27+1" 134217729.0.
- 	hi := guess * secator.
- 	hi :=hi + (guess - hi).
- 	lo := guess - hi.
- 	
- 	"The operations below are all exact"
- 	remainder := selfScaled - hi squared - (hi * lo * 2.0) - lo squared.
- 	maxError := guess timesTwoPower: 1 - Float precision.
- 	remainder > maxError or: [remainder negated >= maxError]]
- 			whileTrue: [guess :=remainder > 0.0
- 				ifTrue: [guess successor]
- 				ifFalse: [guess predecessor]].
- 	
- 	"undo the scaling"
- 	^ guess timesTwoPower: exp!

Item was removed:
- ----- Method: Float>>storeOn: (in category 'printing') -----
- storeOn: aStream 
- 	"Print the Number exactly so it can be interpreted back unchanged"
- 	
- 	self storeOn: aStream base: 10!

Item was removed:
- ----- Method: Float>>storeOn:base: (in category 'printing') -----
- storeOn: aStream base: base 
- 	"Print the Number exactly so it can be interpreted back unchanged"
- 	self isFinite
- 		ifTrue: [self signBit = 1 ifTrue: [aStream nextPutAll: '-'].
- 			base = 10 ifFalse: [aStream print: base; nextPut: $r].
- 			self = 0.0
- 				ifTrue: [aStream nextPutAll: '0.0']
- 				ifFalse: [self abs absPrintExactlyOn: aStream base: base]]
- 		ifFalse: [self isNaN
- 				ifTrue: [aStream nextPutAll: 'Float nan']
- 				ifFalse: [self > 0.0
- 						ifTrue: [aStream nextPutAll: 'Float infinity']
- 						ifFalse: [aStream nextPutAll: 'Float infinity negated']]]!

Item was removed:
- ----- Method: Float>>successor (in category 'truncation and round off') -----
- successor
- 	| ulp |
- 	self isFinite ifFalse: [
- 		(self isNaN or: [self positive]) ifTrue: [^self].
- 		^Float fmax negated].
- 	ulp := self ulp.
- 	^self + (0.5 * ulp) = self
- 		ifTrue: [self * -1.0 - ulp * -1.0 "This trick is for obtaining a negativeZero"]
- 		ifFalse: [self + (0.5 * ulp)]!

Item was removed:
- ----- Method: Float>>tan (in category 'mathematical functions') -----
- tan
- 	"Answer the tangent of the receiver taken as an angle in radians."
- 
- 	^ self sin / self cos!

Item was removed:
- ----- Method: Float>>tanh (in category 'mathematical functions') -----
- tanh
- 	"Answer hyperbolic tangent of receiver.
- 	Trivial implementation is:
- 		^self sinh/self cosh
- 	This implementation takes care not to overflow."
- 
- 	| ex emx |
- 	self = 0.0 ifTrue: [^self].	"Handle negativeZero"
- 	self > 20.0 ifTrue: [^1.0].
- 	self < -20.0 ifTrue: [^-1.0].
- 	ex := self exp.
- 	emx := ex reciprocal.
- 	^(ex - emx) / (ex + emx)!

Item was removed:
- ----- Method: Float>>timesTwoPower: (in category 'mathematical functions') -----
- timesTwoPower: anInteger 
- 	"Answer with the receiver multiplied by 2.0 raised
- 	to the power of the argument"
- 
- 	self isFinite ifFalse: [^self].
- 	self isZero ifTrue: [^self].
- 	
- 	"Make sure that (2.0 raisedTo: Integer) can be safely used without overflow
- 	For example:
- 		Float fminNormalized * (2.0 raisedTo: 2000) = Float infinity.
- 	while:
- 		(Float fminNormalized timesTwoPower: 2000) = (2.0 raisedTo: 2000+Float emin)."	
- 	anInteger > Float emax ifTrue: [^(self timesTwoPower: Float emax) timesTwoPower: anInteger - Float emax].
- 	
- 	"In case of gradual underflow, timesTwoPower: is not exact, so greatest care must be taken
- 	because two consecutive timesTwoPower: might differ from a single one"
- 	anInteger < (Float emin - Float precision + 1)
- 		ifTrue:
- 			[| deltaToUnderflow |
- 			deltaToUnderflow := Float emin - self exponent max: Float emin - Float precision + 1.
- 			deltaToUnderflow >= 0 ifTrue:
- 				["self is already near or past underflow, so don't care, result will be zero"
- 				deltaToUnderflow := Float emin].
- 			^(self timesTwoPower: deltaToUnderflow) timesTwoPower: anInteger - deltaToUnderflow].
- 	
- 	"If (2.0 raisedToInteger: anInteger) fit in a positive SmallInteger, then use faster SmallInteger conversion.
- 	Note that SmallInteger maxVal highBit = 30 in a 32 bits image, so 1 can be shifted 29 times."
- 	anInteger > -30 ifTrue: [
- 		anInteger < 0 ifTrue: [^ self / (1 bitShift: 0 - anInteger) asFloat].
- 		anInteger < 30 ifTrue: [^ self * (1 bitShift: anInteger) asFloat]].
- 	
- 	^ self * (2.0 raisedToInteger: anInteger)!

Item was removed:
- ----- Method: Float>>ulp (in category 'truncation and round off') -----
- ulp
- 	"Answer the unit of least precision of self (the power of two corresponding to last bit of mantissa)"
- 	
- 	| exponent |
- 	self isFinite ifFalse: [^self abs].
- 	self = 0.0 ifTrue: [^Float fmin].
- 	exponent := self exponent.
- 	^exponent < self class emin
- 		ifTrue: [Float fminDenormalized]
-  		ifFalse: [Float epsilon timesTwoPower: exponent]!

Item was removed:
- ----- Method: Float>>veryDeepCopyWith: (in category 'copying') -----
- veryDeepCopyWith: deepCopier
- 	"Return self.  Do not record me."
- 
- 	^self shallowCopy!

Item was removed:
- ArithmeticError subclass: #FloatingPointException
- 	instanceVariableNames: ''
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'Kernel-Numbers-Exceptions'!

Item was removed:
- Number subclass: #Fraction
- 	instanceVariableNames: 'numerator denominator'
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'Kernel-Numbers'!
- 
- !Fraction commentStamp: 'nice 11/14/2017 20:39' prior: 0!
- Fraction provides methods for dealing with fractions like 1/3 as a ratio of two integers (as apposed to a decimal representation 0.33333...).
- 
- instance variables:
- 	numerator	<Integer> the number appearing before the fraction bar (above)
- 	denominator	<Integer> the number appearing after the fraction bar (below)
- 		
- A Fraction is generally created by sending the message / to an Integer, like in
- 
-     1 / 3
- 
- Alternatively, it is possible to create a new instance of Fraction by sending #numerator:denominator: to the class.
- In this later case, it is then user responsibility to ensure that it conforms to the following invariants:
- 
- - the denominator shall allways be positive.
-   A negative Fraction shall have a negative numerator, never a negative denominator.
-   Example: 1 / -3 will return -1/3
- - the denominator shall allways be greater than 1.
-   A Fraction with denominator 1 shall be reduced to its numerator (an Integer).
-   Example 3 / 1 will answer 3 (the Integer) not 3/1
- - the numerator and denominator shall never have common multiples.
-   Common multiples shall allways be simplified until (numerator gcd: denominator) = 1.
-   Example 8 / 6 will answer 4 / 3, because both 8=2*4 and 6=2*3 are both divisible by 2.
- 
- A Fraction non conforming to above invariants could be the cause of undefined behavior and unexpected results.
- If unsure, it is advised to send the message #reduced to the freshly created instance so as to obtain a conforming Fraction, or an Integer.
- 
- Note that Fraction and Integer represent together the set of Rational numbers:
- - Integer is a subset of rational (those which are whole numbers)
- - Fraction is used for representing the complementary subset of rational (those which are not whole numbers)
- 
- There could have been a Rational superclass to both Integer and Fraction, and a message #isRational for testing if a Number is a Rational, as well as a message #asRational for converting a Number to a Rational.
- But this level of indirection is not strictly necessary: instead, the notion of Rational and Fraction are collapsed in Squeak, and Integer are considered as a sort of special Fraction with unitary denominator.
- Thus #isFraction is the testing message, to which every Integer will also answer true, since considered as a sort of Fraction.
- And #asFraction is the conversion message, that may answer an instance of Fraction or Integer, depending if the corresponding rational number is whole or not.
- 
- All public arithmetic operations will answer reduced fractions.
- Examples:
- 
- (2/3) + (2/3)
- (2/3) + (1/2)		"case showing reduction to common denominator" 
- (2/3) + (4/3)		"case where result is reduced to an Integer"
- (2/3) raisedToInteger: 5		 "fractions also can be exponentiated"
- !

Item was removed:
- ----- Method: Fraction class>>numerator:denominator: (in category 'instance creation') -----
- numerator: numInteger denominator: denInteger 
- 	"Answer an instance of me (numInteger/denInteger).
- 	NOTE: This primitive initialization method will not reduce improper fractions,
- 	so normal usage should be coded as, eg,
- 		(Fraction numerator: a denominator: b) reduced
- 	or, more simply, as
- 		a / b."
- 
- 	^self new setNumerator: numInteger denominator: denInteger!

Item was removed:
- ----- Method: Fraction class>>readFrom: (in category 'instance creation') -----
- readFrom: stringOrStream 
- 	"Answer a fraction as described on aStream. 
- 	The fraction may be specified as numerator/denominator, or just a numerator, or as integerPart.fractionPart.
- 	In numerator/denominator form, both parts may have a radix specification and an exponent, but only numerator can have a sign.
- 	In fractional digits form, an alternate radix and an exponent can also be provided, the integer or fraction part being optional."
- 	
- 	^(ExtendedNumberParser on: stringOrStream) nextFraction!

Item was removed:
- ----- Method: Fraction class>>readFrom:base: (in category 'instance creation') -----
- readFrom: stringOrStream base: aRadix
- 	"Answer a Fraction as described on aStream. 
- 	The Fraction may be specified as numerator/denominator, or just with numerator.
- 	Both numerator and denominator can have an exponent, but only numerator can have a sign."
- 	
- 	^(ExtendedNumberParser on: stringOrStream) nextFractionBase: aRadix!

Item was removed:
- ----- Method: Fraction>>* (in category 'arithmetic') -----
- * aNumber 
- 	"Answer the result of multiplying the receiver by aNumber."
- 	| d1 d2 |
- 	aNumber isFraction ifTrue: 
- 		[d1 := numerator gcd: aNumber denominator.
- 		d2 := denominator gcd: aNumber numerator.
- 		(d2 = denominator and: [d1 = aNumber denominator])
- 			ifTrue: [^ numerator // d1 * (aNumber numerator // d2)].
- 		^ Fraction numerator: numerator // d1 * (aNumber numerator // d2)
- 				denominator: denominator // d2 * (aNumber denominator // d1)].
- 	^ aNumber adaptToFraction: self andSend: #*!

Item was removed:
- ----- Method: Fraction>>+ (in category 'arithmetic') -----
- + aNumber 
- 	"Answer the sum of the receiver and aNumber."
- 	| n d d1 d2 |
- 	aNumber isInteger ifTrue:
- 		[^Fraction numerator: numerator + (denominator * aNumber) denominator: denominator].
- 	aNumber isFraction ifTrue: 
- 		[d := denominator gcd: aNumber denominator.
- 		n := numerator * (d1 := aNumber denominator // d) + (aNumber numerator * (d2 := denominator // d)).
- 		d1 := d1 * d2.
- 		n := n // (d2 := n gcd: d).
- 		(d := d1 * (d // d2)) = 1 ifTrue: [^ n].
- 		^ Fraction numerator: n denominator: d].
- 	^ aNumber adaptToFraction: self andSend: #+!

Item was removed:
- ----- Method: Fraction>>- (in category 'arithmetic') -----
- - aNumber
- 	"Answer the difference between the receiver and aNumber."
- 	aNumber isInteger ifTrue:
- 		[^Fraction numerator: numerator - (denominator * aNumber) denominator: denominator].
- 	aNumber isFraction ifTrue:
- 		[^ self + aNumber negated].
- 	^ aNumber adaptToFraction: self andSend: #-!

Item was removed:
- ----- Method: Fraction>>/ (in category 'arithmetic') -----
- / aNumber
- 	"Answer the result of dividing the receiver by aNumber."
- 	aNumber isFraction
- 		ifTrue: [^self * aNumber reciprocal].
- 	^ aNumber adaptToFraction: self andSend: #/!

Item was removed:
- ----- Method: Fraction>>< (in category 'comparing') -----
- < aNumber
- 	aNumber isFraction ifTrue:
- 		[^ numerator * aNumber denominator < (aNumber numerator * denominator)].
- 	^ aNumber adaptToFraction: self andCompare: #<!

Item was removed:
- ----- Method: Fraction>><= (in category 'comparing') -----
- <= aNumber
- 	aNumber isFraction ifTrue:
- 		[^ numerator * aNumber denominator <= (aNumber numerator * denominator)].
- 	^ aNumber adaptToFraction: self andCompare: #<=!

Item was removed:
- ----- Method: Fraction>>= (in category 'comparing') -----
- = aNumber
- 	aNumber isNumber ifFalse: [^ false].
- 	aNumber isInteger ifTrue: ["If properly reduced, self cannot be an Integer" ^ false].
- 	aNumber isFraction
- 		ifTrue: ["Assume that both Fraction are reduced"
- 				^ numerator = aNumber numerator and:
- 					[denominator = aNumber denominator]].
- 	^ aNumber adaptToFraction: self andCompare: #=!

Item was removed:
- ----- Method: Fraction>>> (in category 'comparing') -----
- > aNumber
- 	aNumber isFraction ifTrue:
- 		[^ numerator * aNumber denominator > (aNumber numerator * denominator)].
- 	^ aNumber adaptToFraction: self andCompare: #>!

Item was removed:
- ----- Method: Fraction>>>= (in category 'comparing') -----
- >= aNumber
- 	aNumber isFraction ifTrue:
- 		[^ numerator * aNumber denominator >= (aNumber numerator * denominator)].
- 	^ aNumber adaptToFraction: self andCompare: #>=!

Item was removed:
- ----- Method: Fraction>>adaptToInteger:andCompare: (in category 'converting') -----
- adaptToInteger: rcvr andCompare: selector
- 	"Assuming that self is properly reduced, it cannot be an Integer"
- 	selector == #= ifTrue: [^false].
- 	selector == #~= ifTrue: [^true].
- 	"Inequality: avoid division with this transformation:
- 	rcvr op: (num/den)
- 	rcvr - (num/den) op: 0
- 	rcvr*den op: num"
- 	^rcvr * denominator perform: selector with: numerator!

Item was removed:
- ----- Method: Fraction>>adaptToInteger:andSend: (in category 'converting') -----
- adaptToInteger: rcvr andSend: selector
- 	"If I am involved in arithmetic with an Integer, convert it to a Fraction."
- 	^ (Fraction numerator: rcvr denominator: 1) perform: selector with: self!

Item was removed:
- ----- Method: Fraction>>adaptToScaledDecimal:andSend: (in category 'converting') -----
- adaptToScaledDecimal: receiverScaledDecimal andSend: arithmeticOpSelector 
- 	"Convert self to a ScaledDecimal and do the arithmetic. 
- 	receiverScaledDecimal arithmeticOpSelector self."
- 	
- 	^ receiverScaledDecimal perform: arithmeticOpSelector with: (self asScaledDecimal: receiverScaledDecimal scale)!

Item was removed:
- ----- Method: Fraction>>asExactFloat (in category 'converting') -----
- asExactFloat
- 	"When we know that this Fraction is an exact Float, this conversion is much faster than asFloat."
- 
- 	^numerator asFloat timesTwoPower: 1 - denominator highBit!

Item was removed:
- ----- Method: Fraction>>asFloat (in category 'converting') -----
- asFloat
- 	"Answer a Float that closely approximates the value of the receiver.
- 	This implementation will answer the closest floating point number to the receiver.
- 	In case of a tie, it will use the IEEE 754 round to nearest even mode.
- 	In case of overflow, it will answer +/- Float infinity."
- 
- 	| a b mantissa exponent hasTruncatedBits lostBit n ha hb hm |
- 	a := numerator abs.
- 	b := denominator.	"denominator is always positive"
- 	ha := a highBitOfMagnitude.
- 	hb := b highBitOfMagnitude.
- 	
- 	"Number of bits to keep in mantissa plus one to handle rounding."
- 	n := 1 + Float precision.
- 
- 	"If both numerator and denominator are represented exactly in floating point number,
- 	then fastest thing to do is to use hardwired float division."
- 	(ha < n and: [hb < n]) ifTrue: [^numerator asFloat / denominator asFloat].
- 
- 	"Shift the fraction by a power of two exponent so as to obtain a mantissa with n bits.
- 	First guess is rough, the mantissa might have n+1 bits."
- 	exponent := ha - hb - n.
- 	exponent >= 0
- 		ifTrue: [b := b bitShift: exponent]
- 		ifFalse: [a := a bitShift: exponent negated].
- 	mantissa := a quo: b.
- 	hasTruncatedBits := a > (mantissa * b).
- 	hm := mantissa highBit.
- 	
- 	"Check for gradual underflow, in which case the mantissa will loose bits.
- 	Keep at least one bit to let underflow preserve the sign of zero."
- 	lostBit := Float emin - (exponent + hm - 1).
- 	lostBit > 0 ifTrue: [n := n - lostBit max: 1].
- 
- 	"Remove excess bits in the mantissa."
- 	hm > n
- 		ifTrue:
- 			[exponent := exponent + hm - n.
- 			hasTruncatedBits := hasTruncatedBits or: [mantissa anyBitOfMagnitudeFrom: 1 to: hm - n].
- 			mantissa := mantissa bitShift: n - hm].
- 
- 	"Check if mantissa must be rounded upward.
- 	The case of tie (mantissa odd & hasTruncatedBits not)
- 	will be handled by Integer>>asFloat."
- 	(hasTruncatedBits and: [mantissa odd])
- 		ifTrue: [mantissa := mantissa + 1].
- 
- 	^ (self positive
- 			ifTrue: [mantissa asFloat]
- 			ifFalse: [mantissa asFloat negated])
- 		timesTwoPower: exponent!

Item was removed:
- ----- Method: Fraction>>asFraction (in category 'converting') -----
- asFraction	
- 	"Answer the receiver itself."
- 
- 	^self!

Item was removed:
- ----- Method: Fraction>>asNonFraction (in category 'converting') -----
- asNonFraction	
- 	"Answer a number equivalent to the receiver that is not a fraction."
- 
- 
- 	^self asFloat!

Item was removed:
- ----- Method: Fraction>>asScaledDecimal (in category 'converting') -----
- asScaledDecimal
- 	"Convert the receiver to a ScaledDecimal.
- 	If there is a finite decimal representation of the receiver, then use the exact number of decimal places required.
- 	Else, use a default number of decimals."
- 	
- 	| pow2 pow5 q q5 |
- 	pow2 := denominator lowBit - 1.
- 	q := denominator bitShift: pow2 negated.
- 	pow5 := 0.
- 	[q = 1]
- 		whileFalse: [
- 			q5 := q // 5.
- 			(q - (5 * q5)) = 0 ifFalse: [^super asScaledDecimal].
- 			q := q5.
- 			pow5 := pow5 + 1].
- 	^self asScaledDecimal: (pow2 max: pow5)!

Item was removed:
- ----- Method: Fraction>>denominator (in category 'private') -----
- denominator
- 
- 	^denominator!

Item was removed:
- ----- Method: Fraction>>floorLog: (in category 'mathematical functions') -----
- floorLog: radix
- 	"Unlike super, this version is exact when radix is integer"
- 	
- 	| d n |
- 	radix isInteger ifFalse: [^super floorLog: radix].
- 	n := numerator floorLog: radix.
- 	d := denominator floorLog: radix.
- 	^(numerator * (radix raisedTo: d))
- 		< (denominator * (radix raisedTo: n))
- 		ifTrue: [n - d - 1]
- 		ifFalse: [n - d]!

Item was removed:
- ----- Method: Fraction>>gcd: (in category 'arithmetic') -----
- gcd: aFraction
- 	| d |
- 	d := denominator gcd: aFraction denominator.
- 	^(numerator *(aFraction denominator//d) gcd: aFraction numerator*(denominator//d)) / (denominator//d*aFraction denominator)!

Item was removed:
- ----- Method: Fraction>>hash (in category 'comparing') -----
- hash
- 	"Hash is reimplemented because = is implemented."
- 	
- 	"Care is taken that a Fraction equal to a Float also has an equal hash"
- 	self isAnExactFloat ifTrue: [^self asExactFloat hash].
- 	
- 	"Else, I cannot be exactly equal to a Float, use own hash algorithm."
- 	^numerator hash hashMultiply bitXor: denominator hash!

Item was removed:
- ----- Method: Fraction>>isAnExactFloat (in category 'testing') -----
- isAnExactFloat
- 	"Answer true if this Fraction can be converted exactly to a Float"
- 	^ denominator isPowerOfTwo
- 		and: ["I have a reasonable significand: not too big"
- 			numerator highBitOfMagnitude <= Float precision
- 				and: ["I have a reasonable exponent: not too small"
- 					Float emin + denominator highBitOfMagnitude <= Float precision]]!

Item was removed:
- ----- Method: Fraction>>isFraction (in category 'converting') -----
- isFraction
- 	^ true!

Item was removed:
- ----- Method: Fraction>>isPowerOfTwo (in category 'testing') -----
- isPowerOfTwo
- 	"Return true if the receiver is an integral power of two."
- 
- 	^numerator = 1 and: [ denominator isPowerOfTwo ]!

Item was removed:
- ----- Method: Fraction>>lcm: (in category 'arithmetic') -----
- lcm: n 
- 	"Answer the least common multiple of the receiver and n."
- 
- 	^self // (self gcd: n) * n!

Item was removed:
- ----- Method: Fraction>>ln (in category 'mathematical functions') -----
- ln
- 	"This function is defined because super ln might overflow."
- 	| res |
- 	self <= 0 ifTrue: [DomainError signal: 'ln is only defined for x > 0'].
- 	"Test self < 1 before converting to float in order to avoid precision loss due to gradual underflow."
- 	numerator < denominator ifTrue: [^self reciprocal ln negated].
- 	res := super ln.
- 	res isFinite ifTrue: [^res].
- 	^numerator ln - denominator ln!

Item was removed:
- ----- Method: Fraction>>log (in category 'mathematical functions') -----
- log
- 	"This function is defined because super log might overflow."
- 	| res |
- 	self <= 0 ifTrue: [DomainError signal: 'log is only defined for x > 0'].
- 	"Test self < 1 before converting to float in order to avoid precision loss due to gradual underflow."
- 	numerator < denominator ifTrue: [^self reciprocal log negated].
- 	res := super log.
- 	res isFinite ifTrue: [^res].
- 	^numerator log - denominator log!

Item was removed:
- ----- Method: Fraction>>log2 (in category 'mathematical functions') -----
- log2
- 	"This function is defined because super log2 might overflow."
- 	| res |
- 	self <= 0 ifTrue: [DomainError signal: 'log2 is only defined for x > 0'].
- 	"Test self < 1 before converting to float in order to avoid precision loss due to gradual underflow."
- 	numerator < denominator ifTrue: [^self reciprocal log2 negated].
- 	res := super log2.
- 	res isFinite ifTrue: [^res].
- 	^numerator log2 - denominator log2!

Item was removed:
- ----- Method: Fraction>>negated (in category 'arithmetic') -----
- negated 
- 	"Refer to the comment in Number|negated."
- 
- 	^ Fraction
- 		numerator: numerator negated
- 		denominator: denominator!

Item was removed:
- ----- Method: Fraction>>negative (in category 'testing') -----
- negative
- 
- 	^numerator negative!

Item was removed:
- ----- Method: Fraction>>nthRoot: (in category 'mathematical functions') -----
- nthRoot: aPositiveInteger
- 	"Answer the nth root of the receiver."
- 
- 	| guess |
- 	guess := (numerator nthRootTruncated: aPositiveInteger) / (denominator nthRootTruncated: aPositiveInteger).
- 	(guess raisedTo: aPositiveInteger) = self ifTrue: [^guess].
- 	"There is no exact nth root, so answer a Float approximation"
- 	^(self abs ln / aPositiveInteger) exp * self sign!

Item was removed:
- ----- Method: Fraction>>numerator (in category 'private') -----
- numerator
- 
- 	^numerator!

Item was removed:
- ----- Method: Fraction>>printOn: (in category 'printing') -----
- printOn: aStream
- 
- 	aStream nextPut: $(.
- 	numerator printOn: aStream.
- 	aStream nextPut: $/.
- 	denominator printOn: aStream.
- 	aStream nextPut: $).
- !

Item was removed:
- ----- Method: Fraction>>printOn:base: (in category 'printing') -----
- printOn: aStream base: base
- 
- 	aStream nextPut: $(.
- 	numerator printOn: aStream base: base.
- 	aStream nextPut: $/.
- 	denominator printOn: aStream base: base.
- 	aStream nextPut: $).
- !

Item was removed:
- ----- Method: Fraction>>printOn:showingDecimalPlaces: (in category 'printing') -----
- printOn: aStream showingDecimalPlaces: placesDesired
- 	"Same as super, but provides a faster implementation by inlining some Fraction protocol thus avoiding intermediate Fraction creation."
- 	
- 	| roundedFractionPart integerPart scaling |
- 	placesDesired <= 0
- 		ifTrue: [self rounded printOn: aStream]
- 		ifFalse:
- 			[scaling := 10 raisedToInteger: placesDesired.
- 			integerPart := numerator abs quo: denominator.
- 			roundedFractionPart := (numerator abs - (integerPart * denominator)) * scaling * 2 + denominator quo: denominator * 2.
- 			roundedFractionPart = scaling
- 				ifTrue:
- 					[integerPart := integerPart + 1.
- 					roundedFractionPart := 0].
- 			"Don't print minus sign if result is rouded to zero"
- 			(numerator negative and: [integerPart > 0 or: [roundedFractionPart > 0]]) ifTrue: [aStream nextPut: $-].
- 			integerPart printOn: aStream.
- 			aStream nextPut: $..
- 			roundedFractionPart printOn: aStream base: 10 length: placesDesired padded: true].!

Item was removed:
- ----- Method: Fraction>>printTruncatedOn:showingDecimalPlaces: (in category 'printing') -----
- printTruncatedOn: aStream showingDecimalPlaces: placesDesired
- 	"Print a representation of the receiver on aStream in decimal notation with prescribed number of places after decimal separator.
- 	Print as if the receiver was truncated to requested precision."
- 	
- 	| truncatedFractionPart integerPart scaling |
- 	placesDesired <= 0
- 		ifTrue: [self truncated printOn: aStream]
- 		ifFalse:
- 			[scaling := 10 raisedToInteger: placesDesired.
- 			integerPart := numerator abs quo: denominator.
- 			truncatedFractionPart := (numerator abs - (integerPart * denominator)) * scaling quo: denominator.
- 			numerator negative ifTrue: [aStream nextPut: $-].
- 			integerPart printOn: aStream.
- 			aStream nextPut: $..
- 			truncatedFractionPart printOn: aStream base: 10 length: placesDesired padded: true].!

Item was removed:
- ----- Method: Fraction>>raisedToFraction: (in category 'mathematical functions') -----
- raisedToFraction: aFraction
- 	| root |
- 	root := (self numerator nthRootTruncated: aFraction denominator) / (self denominator nthRootTruncated: aFraction denominator).
- 	(root raisedToInteger: aFraction denominator) = self ifTrue: [^root raisedToInteger: aFraction numerator].
- 	^super raisedToFraction: aFraction!

Item was removed:
- ----- Method: Fraction>>raisedToInteger: (in category 'mathematical functions') -----
- raisedToInteger: anInteger 
- 	"See Number | raisedToInteger:"
- 	anInteger = 0 ifTrue: [^ 1].
- 	anInteger < 0 ifTrue: [^ self reciprocal raisedToInteger: anInteger negated].
- 	^ Fraction numerator: (numerator raisedToInteger: anInteger)
- 		denominator: (denominator raisedToInteger: anInteger)!

Item was removed:
- ----- Method: Fraction>>reciprocal (in category 'private') -----
- reciprocal
- 	
- 	numerator abs = 1 ifTrue: [^denominator * numerator].
- 	^self class numerator: denominator denominator: numerator!

Item was removed:
- ----- Method: Fraction>>reduced (in category 'private') -----
- reduced
- 
- 	| gcd numer denom |
- 	numerator = 0 ifTrue: [^0].
- 	gcd := numerator gcd: denominator.
- 	numer := numerator // gcd.
- 	denom := denominator // gcd.
- 	denom = 1 ifTrue: [^numer].
- 	^Fraction numerator: numer denominator: denom!

Item was removed:
- ----- Method: Fraction>>setNumerator:denominator: (in category 'private') -----
- setNumerator: n denominator: d
- 
- 	d isZero ifTrue: [ ^(ZeroDivide dividend: n) signal ].
- 	numerator := n asInteger.
- 	(denominator := d asInteger) negative ifTrue: [ "keep sign in numerator"
- 		numerator := numerator negated.
- 		denominator := denominator negated ]!

Item was removed:
- ----- Method: Fraction>>sqrt (in category 'mathematical functions') -----
- sqrt
- 	| d n |
- 	n := numerator sqrt.
- 	d := denominator sqrt.
- 	"The #sqrt method in integer will only answer a Float if there's no exact square root.
- 	So, we need a float anyway."
- 	(n isInfinite or: [ d isInfinite ]) ifTrue: [
- 		^self asFloat sqrt ].
- 	^n / d!

Item was removed:
- ----- Method: Fraction>>squared (in category 'mathematical functions') -----
- squared
- 	"See Fraction (Number) | squared"
- 	^ Fraction numerator: numerator squared denominator: denominator squared!

Item was removed:
- ----- Method: Fraction>>storeOn:base: (in category 'printing') -----
- storeOn: aStream base: base
- 
- 	aStream nextPut: $(.
- 	numerator storeOn: aStream base: base.
- 	aStream nextPut: $/.
- 	denominator storeOn: aStream base: base.
- 	aStream nextPut: $).
- !

Item was removed:
- ----- Method: Fraction>>truncated (in category 'truncation and round off') -----
- truncated 
- 	"Refer to the comment in Number|truncated."
- 
- 	^numerator quo: denominator!

Item was removed:
- BlockClosure variableSubclass: #FullBlockClosure
- 	instanceVariableNames: 'receiver'
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'Kernel-Methods'!
- 
- !FullBlockClosure commentStamp: 'eem 5/1/2020 10:24' prior: 0!
- Instances of FullBlockClosure represent blocks, a sequence of statements inside square brackets that can be evaluated at any time via one of the value messages (value, value:, value:value:, ..., valueWithArguments:), which answer their last statement.  Blocks therefore allow deferred evaluation and so are used to build control structures where a sequence of statements are evaluated or not depending on other values in the program.
- 
- FullBlockClosure is a refinement of BlockClosure that allows the block to use its own method to hold its code instead of embedding that code within its home method.
- 
- Instance Variables (inherited)
- 	numArgs			<SmallInteger> 
- 	outerContext:		<Context|nil> 
- 	startpcOrMethod	<CompiledBlock>
- 
- Instance Variables
- 	receiver:			<Object>
- 
- numArgs
- 	- the number of arguments the block expects. This is superfluous; the number of arguments can be obtained from the receiver's compiledBlock.
- 
- outerContext
- 	- the Context of the method or block activation in which the receiver is created.
- 
- compiledBlock(startpcOrMethod)
- 	- reused to refer to the CompiledBlock that implements the receiver's code.
- 
- receiver
- 	- the receiver of the message that created the block's home method activation.
- 
- 
- Implementation notes:
- 
- A FullBlockClosure is a closure that can be independent of any outerContext if desired.  It has its own method (reusing the startpcOrMethod inst var) and its own receiver.  outerContext can be either a Context or nil.
- 
- This closure design, implemented by Eliot Miranda and Clement Bera along with the Sista work, aims to simplify the block closure model while enhacing its capabilities. It allows lazy decompilation of closures and fast machine code dispatch in Cog's JIT, while allowing inlining of methods and blocks to be independent from their enclosing blocks.
- 
- At closure creation time, the Sista closure creation bytecode specifies:
- - the compiledBlock to execute when executing this block's code (in the literal frame)
- - if the receiver is the current receiver or a receiver passed on stack before the copied values.
- - if the closure needs an outerContext. outerContexts are used for non local returns and debugging. Blocks with non-local (up arrow) returns have to set their outerContext. For other blocks (97% of blocks), it's a trade-off between performance and debuggability.!

Item was removed:
- ----- Method: FullBlockClosure class>>initialize (in category 'class initialization') -----
- initialize
- 	"Also see SmalltalkImage >> #recreateSpecialObjectsArray."
- 	
- 	(Smalltalk specialObjectsArray at: 38)
- 		ifNil: [Smalltalk specialObjectsArray at: 38 put: self].!

Item was removed:
- ----- Method: FullBlockClosure class>>receiver:outerContext:method:copiedValues: (in category 'instance creation') -----
- receiver: aReceiver outerContext: aContextOrNil method: aCompiledBlock copiedValues: anArrayOrNil
- 	^(self new: anArrayOrNil basicSize)
- 		receiver: aReceiver
- 		outerContext: aContextOrNil
- 		method: aCompiledBlock
- 		copiedValues: anArrayOrNil!

Item was removed:
- ----- Method: FullBlockClosure>>= (in category 'comparing') -----
- = aClosure
- 	self == aClosure ifTrue: [^true].
- 	aClosure class == self class ifFalse: [^false].
- 	^startpcOrMethod = aClosure method
- 	 and: [outerContext = aClosure outerContext or: [self isClean]]!

Item was removed:
- ----- Method: FullBlockClosure>>abstractBytecodeMessagesDo: (in category 'scanning') -----
- abstractBytecodeMessagesDo: aBlock
- 	^startpcOrMethod abstractBytecodeMessagesDo: aBlock!

Item was removed:
- ----- Method: FullBlockClosure>>asContextWithSender: (in category 'private') -----
- asContextWithSender: aContext
- 	"Inner private support method for evaluation.  Do not use unless you know what you're doing."
- 
- 	^(Context newForMethod: startpcOrMethod)
- 		setSender: aContext
- 		receiver: self receiver
- 		method: startpcOrMethod
- 		closure: self
- 		startpc: startpcOrMethod initialPC;
- 		privRefresh!

Item was removed:
- ----- Method: FullBlockClosure>>blockCreationPC (in category 'scanning') -----
- blockCreationPC
- 	self shouldNotImplement!

Item was removed:
- ----- Method: FullBlockClosure>>cull: (in category 'evaluating') -----
- cull: firstArg
- 	"Activate the receiver, with one or zero arguments."
- 	<primitive: 207> "Handle the one argument case primitively"
- 	numArgs >= 1 ifTrue: [ ^self value: firstArg ].
- 	^self value!

Item was removed:
- ----- Method: FullBlockClosure>>cull:cull: (in category 'evaluating') -----
- cull: firstArg cull: secondArg
- 	"Activate the receiver, with two or less arguments."
- 	<primitive: 207> "Handle the two argument case primitively"
- 	numArgs >= 2 ifTrue: [ ^self value: firstArg value: secondArg ].	
- 	numArgs = 1 ifTrue: [ ^self value: firstArg ].
- 	^self value!

Item was removed:
- ----- Method: FullBlockClosure>>cull:cull:cull: (in category 'evaluating') -----
- cull: firstArg cull: secondArg cull: thirdArg
- 	"Activate the receiver, with three or less arguments."
- 	<primitive: 207> "Handle the three argument case primitively"
- 	numArgs >= 2 ifTrue:
- 		[numArgs >= 3 ifTrue:
- 			[^self value: firstArg value: secondArg value: thirdArg].
- 		^self value: firstArg value: secondArg].
- 	numArgs = 1 ifTrue:
- 		[^self value: firstArg].
- 	^self value!

Item was removed:
- ----- Method: FullBlockClosure>>cull:cull:cull:cull: (in category 'evaluating') -----
- cull: firstArg cull: secondArg cull: thirdArg cull: fourthArg
- 	"Activate the receiver, with four or less arguments."
- 	<primitive: 207> "Handle the four argument case primitively"
- 	numArgs >= 3 ifTrue:
- 		[numArgs >= 4 ifTrue:
- 			[^self value: firstArg value: secondArg value: thirdArg value: fourthArg].
- 		^self value: firstArg value: secondArg value: thirdArg].
- 	numArgs = 2 ifTrue:
- 		[^self value: firstArg value: secondArg].
- 	numArgs = 1 ifTrue:
- 		[^self value: firstArg].
- 	^self value!

Item was removed:
- ----- Method: FullBlockClosure>>cull:cull:cull:cull:cull: (in category 'evaluating') -----
- cull: firstArg cull: secondArg cull: thirdArg cull: fourthArg cull: fifthArg
- 	"Activate the receiver, with five or less arguments."
- 	<primitive: 207> "Handle the five argument case primitively"
- 
- 	^ numArgs
- 		caseOf: {
- 			[5] -> [self value: firstArg value: secondArg value: thirdArg value: fourthArg value: fifthArg].
- 			[4] -> [self value: firstArg value: secondArg value: thirdArg value: fourthArg].
- 			[3] -> [self value: firstArg value: secondArg value: thirdArg].
- 			[2] -> [self value: firstArg value: secondArg].
- 			[1] -> [self value: firstArg].
- 			[0] -> [self value] }
- 		otherwise: [self numArgsError: numArgs]!

Item was removed:
- ----- Method: FullBlockClosure>>endPC (in category 'accessing') -----
- endPC
- 	^startpcOrMethod endPC!

Item was removed:
- ----- Method: FullBlockClosure>>hasMethodReturn (in category 'scanning') -----
- hasMethodReturn
- 	"Answer whether the receiver has a method-return ('^') in its code."
- 	^startpcOrMethod hasMethodReturn!

Item was removed:
- ----- Method: FullBlockClosure>>home (in category 'accessing') -----
- home
- 	^ outerContext ifNotNil: [ outerContext home ]!

Item was removed:
- ----- Method: FullBlockClosure>>homeMethod (in category 'accessing') -----
- homeMethod
- 	^startpcOrMethod homeMethod!

Item was removed:
- ----- Method: FullBlockClosure>>isFullBlock (in category 'testing') -----
- isFullBlock
- 	^true!

Item was removed:
- ----- Method: FullBlockClosure>>method (in category 'accessing') -----
- method
- 	^startpcOrMethod!

Item was removed:
- ----- Method: FullBlockClosure>>numArgs: (in category 'accessing') -----
- numArgs: n
- 	numArgs := n!

Item was removed:
- ----- Method: FullBlockClosure>>numTemps (in category 'accessing') -----
- numTemps
- 	^startpcOrMethod numTemps!

Item was removed:
- ----- Method: FullBlockClosure>>outerContext: (in category 'accessing') -----
- outerContext: ctxt
- 	outerContext := ctxt!

Item was removed:
- ----- Method: FullBlockClosure>>outerContext:startpc:numArgs:copiedValues: (in category 'initialize-release') -----
- outerContext: aContext startpc: aStartpc numArgs: argCount copiedValues: anArrayOrNil
- 	self shouldNotImplement!

Item was removed:
- ----- Method: FullBlockClosure>>printOn: (in category 'private') -----
- printOn: s
- 	[ super printOn: s ] on: Error do: [ :ex | s << '!![' << ex messageText << ']!!' ]!

Item was removed:
- ----- Method: FullBlockClosure>>receiver (in category 'accessing') -----
- receiver
- 	^ receiver!

Item was removed:
- ----- Method: FullBlockClosure>>receiver: (in category 'accessing') -----
- receiver: anObject
- 	receiver := anObject!

Item was removed:
- ----- Method: FullBlockClosure>>receiver:outerContext:method:copiedValues: (in category 'initialize-release') -----
- receiver: aReceiver outerContext: aContextOrNil method: aCompiledBlock copiedValues: anArrayOrNil
- 	receiver := aReceiver.
- 	outerContext := aContextOrNil.
- 	startpcOrMethod := aCompiledBlock.
- 	numArgs := aCompiledBlock numArgs.
- 	1 to: self numCopiedValues do:
- 		[:i|
- 		self at: i put: (anArrayOrNil at: i)]!

Item was removed:
- ----- Method: FullBlockClosure>>simulateValueWithArguments:caller: (in category 'simulation') -----
- simulateValueWithArguments: anArray caller: aContext
- 	"Simulate the valueWithArguments: primitive. Fail if anArray is not an array of the right arity."
- 	| newContext |
- 	newContext := (Context newForMethod: startpcOrMethod)
- 						setSender: aContext
- 						receiver: receiver
- 						method: startpcOrMethod
- 						closure: self
- 						startpc: startpcOrMethod initialPC.
- 	((newContext objectClass: anArray) ~~ Array
- 	 or: [numArgs ~= anArray size]) ifTrue:
- 		[^Context primitiveFailTokenFor: nil].
- 	newContext stackp: startpcOrMethod numTemps.
- 	1 to: numArgs do:
- 		[:i| newContext at: i put: (anArray at: i)].
- 	1 to: self basicSize do:
- 		[:i| newContext at: i + numArgs put: (self at: i)].
- 	^newContext!

Item was removed:
- ----- Method: FullBlockClosure>>size (in category 'accessing') -----
- size
- 	"Answer closure's bytecode size (number of bytes) by accessing
- 	 the closure's method."
- 	^startpcOrMethod endPC - startpcOrMethod initialPC + 1!

Item was removed:
- ----- Method: FullBlockClosure>>startpc (in category 'accessing') -----
- startpc
- 	^startpcOrMethod initialPC!

Item was removed:
- ----- Method: FullBlockClosure>>value (in category 'evaluating') -----
- value
- 	"Activate the receiver, creating a closure activation (MethodContext)
- 	 whose closure is the receiver and whose caller is the sender of this
- 	 message. Supply the copied values to the activation as its copied
- 	 temps. Primitive. Essential."
- 	<primitive: 207>
- 	numArgs ~= 0 ifTrue:
- 		[self numArgsError: 0].
- 	^self primitiveFailed!

Item was removed:
- ----- Method: FullBlockClosure>>value: (in category 'evaluating') -----
- value: firstArg
- 	"Activate the receiver, creating a closure activation (MethodContext)
- 	 whose closure is the receiver and whose caller is the sender of this
- 	 message. Supply the argument and copied values to the activation
- 	 as its argument and copied temps. Primitive. Essential."
- 	<primitive: 207>
- 	numArgs ~= 1 ifTrue:
- 		[self numArgsError: 1].
- 	^self primitiveFailed!

Item was removed:
- ----- Method: FullBlockClosure>>value:value: (in category 'evaluating') -----
- value: firstArg value: secondArg
- 	"Activate the receiver, creating a closure activation (MethodContext)
- 	 whose closure is the receiver and whose caller is the sender of this
- 	 message. Supply the arguments and copied values to the activation
- 	 as its arguments and copied temps. Primitive. Essential."
- 	<primitive: 207>
- 	numArgs ~= 2 ifTrue:
- 		[self numArgsError: 2].
- 	^self primitiveFailed!

Item was removed:
- ----- Method: FullBlockClosure>>value:value:value: (in category 'evaluating') -----
- value: firstArg value: secondArg value: thirdArg
- 	"Activate the receiver, creating a closure activation (MethodContext)
- 	 whose closure is the receiver and whose caller is the sender of this
- 	 message. Supply the arguments and copied values to the activation
- 	 as its arguments and copied temps. Primitive. Essential."
- 	<primitive: 207>
- 	numArgs ~= 3 ifTrue:
- 		[self numArgsError: 3].
- 	^self primitiveFailed!

Item was removed:
- ----- Method: FullBlockClosure>>value:value:value:value: (in category 'evaluating') -----
- value: firstArg value: secondArg value: thirdArg value: fourthArg
- 	"Activate the receiver, creating a closure activation (MethodContext)
- 	 whose closure is the receiver and whose caller is the sender of this
- 	 message. Supply the arguments and copied values to the activation
- 	 as its arguments and copied temps. Primitive. Essential."
- 	<primitive: 207>
- 	numArgs ~= 4 ifTrue:
- 		[self numArgsError: 4].
- 	^self primitiveFailed!

Item was removed:
- ----- Method: FullBlockClosure>>value:value:value:value:value: (in category 'evaluating') -----
- value: firstArg value: secondArg value: thirdArg value: fourthArg value: fifthArg
- 	"Activate the receiver, creating a closure activation (MethodContext)
- 	 whose closure is the receiver and whose caller is the sender of this
- 	 message. Supply the arguments and copied values to the activation
- 	 as its arguments and copied temps. Primitive. Essential."
- 	<primitive: 207>
- 	numArgs ~= 5 ifTrue:
- 		[self numArgsError: 5].
- 	^self primitiveFailed!

Item was removed:
- ----- Method: FullBlockClosure>>valueNoContextSwitch (in category 'evaluating') -----
- valueNoContextSwitch
- 	"An exact copy of BlockClosure>>value except that this version will not preempt
- 	 the current process on block activation if a higher-priority process is runnable.
- 	 Primitive. Essential."
- 	<primitive: 209>
- 	numArgs ~= 0 ifTrue:
- 		[self numArgsError: 0].
- 	self primitiveFailed!

Item was removed:
- ----- Method: FullBlockClosure>>valueNoContextSwitch: (in category 'evaluating') -----
- valueNoContextSwitch: anArg
- 	"An exact copy of BlockClosure>>value: except that this version will not preempt
- 	 the current process on block activation if a higher-priority process is runnable.
- 	 Primitive. Essential."
- 	<primitive: 209>
- 	numArgs ~= 1 ifTrue:
- 		[self numArgsError: 1].
- 	self primitiveFailed!

Item was removed:
- ----- Method: FullBlockClosure>>valueWithArguments: (in category 'evaluating') -----
- valueWithArguments: anArray
- 	"Activate the receiver, creating a closure activation (MethodContext)
- 	 whose closure is the receiver and whose caller is the sender of this
- 	 message. Supply the arguments in an anArray and copied values to
- 	 the activation as its arguments and copied temps. Primitive. Essential."
- 	<primitive: 208>
- 	numArgs ~= anArray size ifTrue:
- 		[self numArgsError: anArray size].
- 	^self primitiveFailed!

Item was removed:
- ProtoObject subclass: #FutureMaker
- 	instanceVariableNames: 'myTarget deltaMSecs'
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'Kernel-Processes'!
- 
- !FutureMaker commentStamp: 'jcg 12/17/2009 23:24' prior: 0!
- Uses #doesNotUnderstand: to transform messages into future messages.  In practice, this class is never used; for efficiency, the Compiler has been modified to use FutureNode to transform code at compile-time to directly send #futureSend:at:args:.  However, this is simply an optimization... the semantics are unchanged.!

Item was removed:
- ----- Method: FutureMaker>>= (in category 'comparing') -----
- = anObject
- 	^self == anObject!

Item was removed:
- ----- Method: FutureMaker>>basicAt: (in category 'accessing') -----
- basicAt: index 
- 	"Primitive. Assumes receiver is indexable. Answer the value of an 
- 	indexable element in the receiver. Fail if the argument index is not an 
- 	Integer or is out of bounds. Essential. Do not override in a subclass. See 
- 	Object documentation whatIsAPrimitive."
- 
- 	<primitive: 60>
- 	index isInteger ifTrue: [self errorSubscriptBounds: index].
- 	index isNumber
- 		ifTrue: [^self basicAt: index asInteger]
- 		ifFalse: [self errorNonIntegerIndex]!

Item was removed:
- ----- Method: FutureMaker>>basicAt:put: (in category 'accessing') -----
- basicAt: index put: value 
- 	"Primitive. Assumes receiver is indexable. Store the second argument 
- 	value in the indexable element of the receiver indicated by index. Fail 
- 	if the index is not an Integer or is out of bounds. Or fail if the value is 
- 	not of the right type for this kind of collection. Answer the value that 
- 	was stored. Essential. Do not override in a subclass. See Object 
- 	documentation whatIsAPrimitive."
- 
- 	<primitive: 61 error: ec>
- 	index isInteger ifTrue:
- 		[(index >= 1 and: [index <= self basicSize])
- 			ifTrue:
- 				[ec == #'no modification' ifTrue:
- 					[^thisContext modificationForbiddenFor: self at: index put: value].
- 				 self errorImproperStore]
- 			ifFalse: [self errorSubscriptBounds: index]].
- 	index isNumber ifTrue:
- 		[^self basicAt: index asInteger put: value].
- 	self errorNonIntegerIndex!

Item was removed:
- ----- Method: FutureMaker>>basicSize (in category 'accessing') -----
- basicSize
- 	"Primitive. Answer the number of indexable variables in the receiver. 
- 	This value is the same as the largest legal subscript. Essential. Do not 
- 	override in any subclass. See Object documentation whatIsAPrimitive."
- 
- 	<primitive: 62>
- 	"The number of indexable fields of fixed-length objects is 0"
- 	^0!

Item was removed:
- ----- Method: FutureMaker>>doesNotUnderstand: (in category 'accessing') -----
- doesNotUnderstand: aMessage
- 	"Package up the message and send it"
- 	^myTarget futureSend: aMessage selector at: deltaMSecs args: aMessage arguments!

Item was removed:
- ----- Method: FutureMaker>>hash (in category 'comparing') -----
- hash
- 	^self scaledIdentityHash!

Item was removed:
- ----- Method: FutureMaker>>instVarAt: (in category 'accessing') -----
- instVarAt: index 
- 	"Primitive. Answer a fixed variable in an object. The numbering of the 
- 	variables corresponds to the named instance variables. Fail if the index 
- 	is not an Integer or is not the index of a fixed variable. Essential. See 
- 	Object documentation whatIsAPrimitive."
- 
- 	<primitive: 173 error: ec>
- 	self primitiveFailed!

Item was removed:
- ----- Method: FutureMaker>>instVarAt:put: (in category 'accessing') -----
- instVarAt: anInteger put: anObject
- 	"Primitive. Store a value into a fixed variable in the receiver. The 
- 	numbering of the variables corresponds to the named instance variables. 
- 	Fail if the index is not an Integer or is not the index of a fixed variable. 
- 	Answer the value stored as the result. Using this message violates the 
- 	principle that each object has sovereign control over the storing of 
- 	values into its instance variables. Essential. See Object documentation 
- 	whatIsAPrimitive."
- 
- 	<primitive: 174 error: ec>
- 	ec == #'no modification' ifTrue:
- 		[^thisContext modificationForbiddenFor: self instVarAt: anInteger value: anObject].
- 	self primitiveFailed!

Item was removed:
- ----- Method: FutureMaker>>isKindOf: (in category 'accessing') -----
- isKindOf: aClass 
- 	"--- needed for debugging ---"
- 	self class == aClass
- 		ifTrue: [^true]
- 		ifFalse: [^self class inheritsFrom: aClass]!

Item was removed:
- ----- Method: FutureMaker>>isMemberOf: (in category 'accessing') -----
- isMemberOf: aClass 
- 	"Answer whether the receiver is an instance of the class, aClass."
- 	^self class == aClass!

Item was removed:
- ----- Method: FutureMaker>>isText (in category 'testing') -----
- isText
- 	^false!

Item was removed:
- ----- Method: FutureMaker>>printOn: (in category 'printing') -----
- printOn: aStream
- 	"Append to the argument, aStream, a sequence of characters that  
- 	identifies the receiver."
- 	| title |
- 	title := self class name.
- 	aStream
- 		nextPutAll: (title first isVowel ifTrue: ['an '] ifFalse: ['a ']);
- 		nextPutAll: title!

Item was removed:
- ----- Method: FutureMaker>>printString (in category 'printing') -----
- printString
- 	"Answer a String whose characters are a description of the receiver. 
- 	If you want to print without a character limit, use fullPrintString."
- 	^ self printStringLimitedTo: 50000!

Item was removed:
- ----- Method: FutureMaker>>printStringLimitedTo: (in category 'printing') -----
- printStringLimitedTo: limit
- 	"Answer a String whose characters are a description of the receiver.
- 	If you want to print without a character limit, use fullPrintString."
- 	| limitedString |
- 	limitedString := String streamContents: [:s | self printOn: s] limitedTo: limit.
- 	limitedString size < limit ifTrue: [^ limitedString].
- 	^ limitedString , '...etc...'!

Item was removed:
- ----- Method: FutureMaker>>setDeltaMSecs:target: (in category 'private') -----
- setDeltaMSecs: delta target: futureTarget
- 	deltaMSecs := delta.
- 	myTarget := futureTarget.!

Item was removed:
- ----- Method: FutureMaker>>setTarget: (in category 'private') -----
- setTarget: aTarget
- 	myTarget := aTarget.!

Item was removed:
- Exception subclass: #Halt
- 	instanceVariableNames: ''
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'Kernel-Exceptions'!
- 
- !Halt commentStamp: '<historical>' prior: 0!
- Halt is provided to support Object>>halt.!

Item was removed:
- ----- Method: Halt>>defaultAction (in category 'priv handling') -----
- defaultAction
- 	"No one has handled this error, but now give them a chance to decide how to debug it.  If none handle this either then open debugger (see UnhandedError-defaultAction)"
- 
- 	UnhandledError signalForException: self!

Item was removed:
- ----- Method: Halt>>isResumable (in category 'description') -----
- isResumable
- 
- 	^true!

Item was removed:
- Exception subclass: #IllegalResumeAttempt
- 	instanceVariableNames: ''
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'Kernel-Exceptions'!
- 
- !IllegalResumeAttempt commentStamp: '<historical>' prior: 0!
- This class is private to the EHS implementation.  An instance of it is signaled whenever an attempt is made to resume from an exception which answers false to #isResumable.!

Item was removed:
- ----- Method: IllegalResumeAttempt>>defaultAction (in category 'handling') -----
- defaultAction
- 	"No one has handled this error, but now give them a chance to decide how to debug it.  If none handle this either then open debugger (see UnhandedError-defaultAction)"
- 
- 	UnhandledError signalForException: self!

Item was removed:
- ----- Method: IllegalResumeAttempt>>isResumable (in category 'handling') -----
- isResumable
- 	
- 	^ false!

Item was removed:
- ----- Method: IllegalResumeAttempt>>readMe (in category 'comment') -----
- readMe
- 
- 	"Never handle this exception!!"!

Item was removed:
- InstructionClient subclass: #ImplicitLiteralFinder
- 	instanceVariableNames: ''
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'Kernel-Methods'!
- 
- !ImplicitLiteralFinder commentStamp: 'eem 9/12/2021 14:44' prior: 0!
- ImplicitLiteralFinder is a means to extract special literals from an instruction stream.  Instances of InstructionClient answer self in response to all bytecode decode messages.  Instances of this class answer the literal itself for implicit literal bytecode messages.
- 
- Instance Variables
- !

Item was removed:
- ----- Method: ImplicitLiteralFinder>>pushSpecialConstant: (in category 'instruction decoding - implicit literals') -----
- pushSpecialConstant: value
- 	^value!

Item was removed:
- ----- Method: ImplicitLiteralFinder>>sendSpecial:numArgs: (in category 'instruction decoding - implicit literals') -----
- sendSpecial: selector numArgs: numArgs
- 	^selector!

Item was removed:
- Object subclass: #ImplicitLiteralInstructionClientHook
- 	instanceVariableNames: ''
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'Kernel-Methods'!
- 
- !ImplicitLiteralInstructionClientHook commentStamp: 'eem 9/16/2021 19:35' prior: 0!
- ImplicitLiteralInstructionClientHook is a hook to allow clients to intercept bytecodes referencing implicit literals, such as special selector sends which have an implicit selector in Smalltalk specialSelectors.  It implements the messages sent by InstructionStream's interpretNextXXXInstructionFor: methods for bytecodes that reference implicit literals as sends of the relevant explciit literal methods.  This allows clients that want to to intercept implicit literal messages while leaving existing clients unchanged.
- 
- The class also supports CompiledCode>>abstractBytecodeMessagesFrom:to:do: et al which depend on MessageNotUnderstood to collect bytecode messages.  Use of instances of this class hides the existence of pushSpecialConstant: and sendSpecial:numArgs: since these are understood, but their sends of pushConstant: and send:super:numArgs: are not.
- 
- Instance Variables!

Item was removed:
- ----- Method: ImplicitLiteralInstructionClientHook>>pushSpecialConstant: (in category 'instruction decoding - implicit literals') -----
- pushSpecialConstant: value
- 	"This is a hook to allow clients to intercept implicit literal bytecodes"
- 	^self pushConstant: value!

Item was removed:
- ----- Method: ImplicitLiteralInstructionClientHook>>sendSpecial:numArgs: (in category 'instruction decoding - implicit literals') -----
- sendSpecial: selector numArgs: numArgs
- 	"This is a hook to allow clients to intercept special selector sends (which have an implicit selector)"
- 	^self send: selector super: false numArgs: numArgs!

Item was removed:
- Notification subclass: #InMidstOfFileinNotification
- 	instanceVariableNames: ''
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'Kernel-Exceptions'!

Item was removed:
- ----- Method: InMidstOfFileinNotification>>defaultAction (in category 'handling') -----
- defaultAction
- 
- 	^false!

Item was removed:
- InstructionClient subclass: #InstVarRefLocator
- 	instanceVariableNames: 'bingo'
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'Kernel-Methods'!
- 
- !InstVarRefLocator commentStamp: 'eem 3/30/2017 17:43' prior: 0!
- My job is to scan bytecodes for instance variable references.
- 
- BlockClosure allInstances collect: [ :x |
- 	{x. x method hasInstVarRef}
- ]!

Item was removed:
- ----- Method: InstVarRefLocator>>interpretNextInstructionUsing: (in category 'initialize-release') -----
- interpretNextInstructionUsing: aScanner 
- 	
- 	bingo := false.
- 	aScanner interpretNextInstructionFor: self.
- 	^bingo!

Item was removed:
- ----- Method: InstVarRefLocator>>popIntoReceiverVariable: (in category 'instruction decoding') -----
- popIntoReceiverVariable: offset 
- 
- 	bingo := true!

Item was removed:
- ----- Method: InstVarRefLocator>>pushReceiverVariable: (in category 'instruction decoding') -----
- pushReceiverVariable: offset
- 
- 	bingo := true!

Item was removed:
- ----- Method: InstVarRefLocator>>storeIntoReceiverVariable: (in category 'instruction decoding') -----
- storeIntoReceiverVariable: offset 
- 
- 	bingo := true!

Item was removed:
- ImplicitLiteralInstructionClientHook subclass: #InstructionClient
- 	instanceVariableNames: ''
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'Kernel-Methods'!
- 
- !InstructionClient commentStamp: 'md 4/8/2003 12:50' prior: 0!
- My job is to make it easier to implement clients for InstructionStream. See InstVarRefLocator
- as an example. !

Item was removed:
- ----- Method: InstructionClient>>blockReturnConstant: (in category 'instruction decoding') -----
- blockReturnConstant: value
- 	"Return Constant From Block bytecode."
- 
- !

Item was removed:
- ----- Method: InstructionClient>>blockReturnTop (in category 'instruction decoding') -----
- blockReturnTop
- 	"Return Top Of Stack bytecode."
- 
- !

Item was removed:
- ----- Method: InstructionClient>>callPrimitive: (in category 'instruction decoding') -----
- callPrimitive: pimIndex
- 	"SqueakV3PlusClosures:	239 11101111	iiiiiiii   jjjjjjjj  Call Primitive #iiiiiiii + (jjjjjjjj * 256)
- 	 NewsqueakV4:				249 11111001	iiiiiiii   jjjjjjjj  Call Primitive #iiiiiiii + (jjjjjjjj * 256)
- 	 SistaV1:					248 11111000 iiiiiiii mjjjjjjj  Call Primitive #iiiiiiii + (jjjjjjj * 256)
- 									m=1 means inlined primitive, no hard return after execution."!

Item was removed:
- ----- Method: InstructionClient>>directedSuperSend:numArgs: (in category 'instruction decoding') -----
- directedSuperSend: selector numArgs: numArgs
- 	"Send Message Above Specific Class With Selector, selector, bytecode.
- 	 Start the lookup above the class that is the value of the association on
- 	 top of stack. The arguments  of the message are found in the top numArgs
- 	 stack locations beneath the association, and the receiver just below them."!

Item was removed:
- ----- Method: InstructionClient>>doDup (in category 'instruction decoding') -----
- doDup
- 	"Duplicate Top Of Stack bytecode."
- 
- !

Item was removed:
- ----- Method: InstructionClient>>doPop (in category 'instruction decoding') -----
- doPop
- 	"Remove Top Of Stack bytecode."
- !

Item was removed:
- ----- Method: InstructionClient>>jump: (in category 'instruction decoding') -----
- jump: offset
- 	"Unconditional Jump bytecode."
- 
- !

Item was removed:
- ----- Method: InstructionClient>>jump:if: (in category 'instruction decoding') -----
- jump: offset if: condition 
- 	"Conditional Jump bytecode."
- 
- !

Item was removed:
- ----- Method: InstructionClient>>methodReturnConstant: (in category 'instruction decoding') -----
- methodReturnConstant: value 
- 	"Return Constant bytecode."
- !

Item was removed:
- ----- Method: InstructionClient>>methodReturnReceiver (in category 'instruction decoding') -----
- methodReturnReceiver
- 	"Return Self bytecode."
- !

Item was removed:
- ----- Method: InstructionClient>>methodReturnTop (in category 'instruction decoding') -----
- methodReturnTop
- 	"Return Top Of Stack bytecode."
- !

Item was removed:
- ----- Method: InstructionClient>>popIntoLiteralVariable: (in category 'instruction decoding') -----
- popIntoLiteralVariable: anAssociation 
- 	"Remove Top Of Stack And Store Into Literal Variable bytecode."
- !

Item was removed:
- ----- Method: InstructionClient>>popIntoReceiverVariable: (in category 'instruction decoding') -----
- popIntoReceiverVariable: offset 
- 	"Remove Top Of Stack And Store Into Instance Variable bytecode."
- !

Item was removed:
- ----- Method: InstructionClient>>popIntoRemoteTemp:inVectorAt: (in category 'instruction decoding') -----
- popIntoRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
- 	"Remove Top Of Stack And Store Into Offset of Temp Vector bytecode."!

Item was removed:
- ----- Method: InstructionClient>>popIntoTemporaryVariable: (in category 'instruction decoding') -----
- popIntoTemporaryVariable: offset 
- 	"Remove Top Of Stack And Store Into Temporary Variable bytecode."
- !

Item was removed:
- ----- Method: InstructionClient>>pushActiveContext (in category 'instruction decoding') -----
- pushActiveContext
- 	"Push Active Context On Top Of Its Own Stack bytecode."
- !

Item was removed:
- ----- Method: InstructionClient>>pushClosureCopyNumCopiedValues:numArgs:blockSize: (in category 'instruction decoding') -----
- pushClosureCopyNumCopiedValues: numCopied numArgs: numArgs blockSize: blockSize
- 	"Push Closure bytecode."
- !

Item was removed:
- ----- Method: InstructionClient>>pushConsArrayWithElements: (in category 'instruction decoding') -----
- pushConsArrayWithElements: numElements
- 	"Push Cons Array of size numElements popping numElements items from the stack into the array bytecode."
- !

Item was removed:
- ----- Method: InstructionClient>>pushConstant: (in category 'instruction decoding') -----
- pushConstant: value
- 	"Push Constant, value, on Top Of Stack bytecode."
- !

Item was removed:
- ----- Method: InstructionClient>>pushFullClosure:numCopied: (in category 'instruction decoding') -----
- pushFullClosure: aCompiledBlock numCopied: numCopied
- 	"Push Full Closure bytecode."!

Item was removed:
- ----- Method: InstructionClient>>pushLiteralVariable: (in category 'instruction decoding') -----
- pushLiteralVariable: anAssociation
- 	"Push Contents Of anAssociation On Top Of Stack bytecode."
- !

Item was removed:
- ----- Method: InstructionClient>>pushNewArrayOfSize: (in category 'instruction decoding') -----
- pushNewArrayOfSize: numElements 
- 	"Push New Array of size numElements bytecode."
- !

Item was removed:
- ----- Method: InstructionClient>>pushReceiver (in category 'instruction decoding') -----
- pushReceiver
- 	"Push Active Context's Receiver on Top Of Stack bytecode."
- !

Item was removed:
- ----- Method: InstructionClient>>pushReceiverVariable: (in category 'instruction decoding') -----
- pushReceiverVariable: offset
- 	"Push Contents Of the Receiver's Instance Variable Whose Index 
- 	is the argument, offset, On Top Of Stack bytecode."
- !

Item was removed:
- ----- Method: InstructionClient>>pushRemoteTemp:inVectorAt: (in category 'instruction decoding') -----
- pushRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
- 	"Push Contents at Offset in Temp Vector bytecode."!

Item was removed:
- ----- Method: InstructionClient>>pushTemporaryVariable: (in category 'instruction decoding') -----
- pushTemporaryVariable: offset
- 	"Push Contents Of Temporary Variable Whose Index Is the 
- 	argument, offset, On Top Of Stack bytecode."
- !

Item was removed:
- ----- Method: InstructionClient>>send:super:numArgs: (in category 'instruction decoding') -----
- send: selector super: supered numArgs: numberArguments
- 	"Send Message With Selector, selector, bytecode. The argument, 
- 	supered, indicates whether the receiver of the message is specified with 
- 	'super' in the source method. The arguments of the message are found in 
- 	the top numArguments locations on the stack and the receiver just 
- 	below them."
- !

Item was removed:
- ----- Method: InstructionClient>>storeIntoLiteralVariable: (in category 'instruction decoding') -----
- storeIntoLiteralVariable: anAssociation 
- 	"Store Top Of Stack Into Literal Variable Of Method bytecode."
- !

Item was removed:
- ----- Method: InstructionClient>>storeIntoReceiverVariable: (in category 'instruction decoding') -----
- storeIntoReceiverVariable: offset 
- 	"Store Top Of Stack Into Instance Variable Of Method bytecode."
- !

Item was removed:
- ----- Method: InstructionClient>>storeIntoRemoteTemp:inVectorAt: (in category 'instruction decoding') -----
- storeIntoRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
- 	"Store Top Of Stack And Store Into Offset of Temp Vector bytecode."!

Item was removed:
- ----- Method: InstructionClient>>storeIntoTemporaryVariable: (in category 'instruction decoding') -----
- storeIntoTemporaryVariable: offset 
- 	"Store Top Of Stack Into Temporary Variable Of Method bytecode."
- !

Item was removed:
- ----- Method: InstructionClient>>trapIfNotInstanceOf: (in category 'instruction decoding') -----
- trapIfNotInstanceOf: behaviorOrArrayOfBehavior
- 	"If the top of stack is not an instance of either the argument, or, if the argument is an Array,
- 	  any of the elements of the argument, send the class trap message to the current context."!

Item was removed:
- InstructionClient subclass: #InstructionPrinter
- 	instanceVariableNames: 'method scanner stream oldPC innerIndents indent printPC indentSpanOfFollowingJump fullBlockRecursionSelector'
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'Kernel-Methods'!
- 
- !InstructionPrinter commentStamp: 'md 4/8/2003 12:47' prior: 0!
- My instances can print the object code of a CompiledMethod in symbolic format. They print into an instance variable, stream, and uses oldPC to determine how many bytes to print in the listing. The variable method  is used to hold the method being printed.!

Item was removed:
- ----- Method: InstructionPrinter class>>on: (in category 'printing') -----
- on: aMethod
- 	^self new method: aMethod.
- 	!

Item was removed:
- ----- Method: InstructionPrinter class>>printClass: (in category 'printing') -----
- printClass: class 
- 	"Create a file whose name is the argument followed by '.bytes'. Store on 
- 	the file the symbolic form of the compiled methods of the class."
- 	| file |
- 	file := FileStream newFileNamed: class name , '.bytes'.
- 	class selectorsAndMethodsDo: 
- 		[:sel :m | 
- 		file cr; nextPutAll: sel; cr.
- 		(self on: m) printInstructionsOn: file].
- 	file close
- 	"InstructionPrinter printClass: Parser."
- !

Item was removed:
- ----- Method: InstructionPrinter>>blockReturnConstant: (in category 'instruction decoding') -----
- blockReturnConstant: value 
- 	"Print the Return Constant From Block bytecode."
- 
- 	self print: 'blockReturn: ', value printString!

Item was removed:
- ----- Method: InstructionPrinter>>blockReturnTop (in category 'instruction decoding') -----
- blockReturnTop
- 	"Print the Return Top Of Stack bytecode."
- 
- 	self print: 'blockReturn'!

Item was removed:
- ----- Method: InstructionPrinter>>callPrimitive: (in category 'instruction decoding') -----
- callPrimitive: index
- 	"Print the callPrimitive bytecode.  This is the m = 0 case in SistaV1:	**	248, and  V3/Spur 139 below.
- 
- 	SistaV1:	**	248	(2)	11111000 	iiiiiiii		mssjjjjj		Call Primitive #iiiiiiii + (jjjjj * 256) 
- 								m=1 means inlined primitive, no hard return after execution. 
- 								ss defines the unsafe operation set used to encode the operations. 
- 								(ss = 0 means sista unsafe operations, ss = 01 means lowcode operations, other numbers are as yet used)
- 	 V3/Spur:		139		10001011	i i i i i i i i	jjjjjjjj		Call Primitive #iiiiiiii + (jjjjjjjj * 256)"
- 
- 	self print: 'callPrimitive: ' , index printString!

Item was removed:
- ----- Method: InstructionPrinter>>directedSuperSend:numArgs: (in category 'instruction decoding') -----
- directedSuperSend: selector "<Symbol>" numArgs: numArgs "<SmallInteger>"
- 	self print: 'directedSuperSend: ' , (self stringForSelector: selector numArgs: numArgs)!

Item was removed:
- ----- Method: InstructionPrinter>>doDup (in category 'instruction decoding') -----
- doDup
- 	"Print the Duplicate Top Of Stack bytecode."
- 
- 	self print: 'dup'!

Item was removed:
- ----- Method: InstructionPrinter>>doPop (in category 'instruction decoding') -----
- doPop
- 	"Print the Remove Top Of Stack bytecode."
- 
- 	self print: 'pop'!

Item was removed:
- ----- Method: InstructionPrinter>>indent (in category 'accessing') -----
- indent
- 
- 	^ indent ifNil: [0]!

Item was removed:
- ----- Method: InstructionPrinter>>indent: (in category 'initialize-release') -----
- indent: numTabs
- 
- 	indent := numTabs!

Item was removed:
- ----- Method: InstructionPrinter>>jump: (in category 'instruction decoding') -----
- jump: offset
- 	"Print the Unconditional Jump bytecode."
- 
- 	self print: 'jumpTo: ' , (scanner pc + offset) printString.
- 	indentSpanOfFollowingJump ifTrue:
- 		[indentSpanOfFollowingJump := false.
- 		 innerIndents atAll: (scanner pc to: scanner pc + offset - 1) put: (innerIndents at: scanner pc - 1) + 1]!

Item was removed:
- ----- Method: InstructionPrinter>>jump:if: (in category 'instruction decoding') -----
- jump: offset if: condition 
- 	"Print the Conditional Jump bytecode."
- 
- 	self print: 
- 		(condition
- 			ifTrue: ['jumpTrue: ']
- 			ifFalse: ['jumpFalse: '])
- 			, (scanner pc + offset) printString!

Item was removed:
- ----- Method: InstructionPrinter>>method (in category 'accessing') -----
- method
- 	^method.!

Item was removed:
- ----- Method: InstructionPrinter>>method: (in category 'accessing') -----
- method: aMethod
- 	method :=  aMethod.
- 	printPC := true.
- 	indentSpanOfFollowingJump := false!

Item was removed:
- ----- Method: InstructionPrinter>>methodReturnConstant: (in category 'instruction decoding') -----
- methodReturnConstant: value 
- 	"Print the Return Constant bytecode."
- 
- 	self print: 'return: ' , value printString!

Item was removed:
- ----- Method: InstructionPrinter>>methodReturnReceiver (in category 'instruction decoding') -----
- methodReturnReceiver
- 	"Print the Return Self bytecode."
- 
- 	self print: 'returnSelf'!

Item was removed:
- ----- Method: InstructionPrinter>>methodReturnTop (in category 'instruction decoding') -----
- methodReturnTop
- 	"Print the Return Top Of Stack bytecode."
- 
- 	self print: 'returnTop'!

Item was removed:
- ----- Method: InstructionPrinter>>popIntoLiteralVariable: (in category 'instruction decoding') -----
- popIntoLiteralVariable: anAssociation 
- 	"Print the Remove Top Of Stack And Store Into Literal Variable bytecode."
- 
- 	self print: 'popIntoLit: ' , anAssociation key!

Item was removed:
- ----- Method: InstructionPrinter>>popIntoReceiverVariable: (in category 'instruction decoding') -----
- popIntoReceiverVariable: offset 
- 	"Print the Remove Top Of Stack And Store Into Instance Variable 
- 	bytecode."
- 
- 	self print: 'popIntoRcvr: ' , offset printString!

Item was removed:
- ----- Method: InstructionPrinter>>popIntoRemoteTemp:inVectorAt: (in category 'instruction decoding') -----
- popIntoRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
- 	self print: 'popIntoTemp: ', remoteTempIndex printString, ' inVectorAt: ', tempVectorIndex printString!

Item was removed:
- ----- Method: InstructionPrinter>>popIntoTemporaryVariable: (in category 'instruction decoding') -----
- popIntoTemporaryVariable: offset 
- 	"Print the Remove Top Of Stack And Store Into Temporary Variable 
- 	bytecode."
- 
- 	self print: 'popIntoTemp: ' , offset printString!

Item was removed:
- ----- Method: InstructionPrinter>>print: (in category 'printing') -----
- print: instruction 
- 	"Append to the receiver a description of the bytecode, instruction." 
- 
- 	| code |
- 	stream tab: self indent.
- 	printPC ifTrue: [stream print: oldPC; space].
- 	stream tab: (innerIndents at: oldPC).
- 	stream nextPut: $<.
- 	oldPC to: scanner pc - 1 do: 
- 		[:i | 
- 		code := (method at: i) radix: 16.
- 		stream nextPut: 
- 			(code size < 2
- 				ifTrue: [$0]
- 				ifFalse: [code at: 1]).
- 		stream nextPut: code last; space].
- 	stream skip: -1.
- 	stream nextPut: $>.
- 	stream space.
- 	stream nextPutAll: instruction.
- 	stream cr.
- 	oldPC := scanner pc.
- 	"(InstructionPrinter compiledMethodAt: #print:) symbolic."
- !

Item was removed:
- ----- Method: InstructionPrinter>>printInstructionsOn: (in category 'initialize-release') -----
- printInstructionsOn: aStream 
- 	"Append to the stream, aStream, a description of each bytecode in the
- 	 instruction stream."
- 	
- 	| end |
- 	stream := aStream.
- 	scanner := InstructionStream on: method.
- 	end := method endPC.
- 	oldPC := scanner pc.
- 	innerIndents := Array new: end withAll: 0.
- 	fullBlockRecursionSelector := #printInstructionsOn:.
- 	[scanner pc <= end] whileTrue:
- 		[scanner interpretNextInstructionFor: self]!

Item was removed:
- ----- Method: InstructionPrinter>>printInstructionsOn:do: (in category 'initialize-release') -----
- printInstructionsOn: aStream do: aBlock
- 	"Append to the stream, aStream, a description of each bytecode in the
- 	 instruction stream. Evaluate aBlock with the receiver, the scanner and
- 	 the stream after each instruction."
- 
- 	| end |
- 	stream := aStream.
- 	scanner := InstructionStream on: method.
- 	end := method endPC.
- 	oldPC := scanner pc.
- 	innerIndents := Array new: end withAll: 0.
- 	[scanner pc <= end] whileTrue:
- 		[scanner interpretNextInstructionFor: self.
- 		 aBlock value: self value: scanner value: stream]!

Item was removed:
- ----- Method: InstructionPrinter>>printPC (in category 'accessing') -----
- printPC
- 	^printPC!

Item was removed:
- ----- Method: InstructionPrinter>>printPC: (in category 'accessing') -----
- printPC: aBoolean
- 	printPC := aBoolean!

Item was removed:
- ----- Method: InstructionPrinter>>pushActiveContext (in category 'instruction decoding') -----
- pushActiveContext
- 	"Print the Push Active Context On Top Of Its Own Stack bytecode."
- 
- 	self print: 'pushThisContext: '!

Item was removed:
- ----- Method: InstructionPrinter>>pushClosureCopyNumCopiedValues:numArgs:blockSize: (in category 'instruction decoding') -----
- pushClosureCopyNumCopiedValues: numCopied numArgs: numArgs blockSize: blockSize
- 	self print: 'closureNumCopied: ', numCopied printString
- 			, ' numArgs: ', numArgs printString
- 			, ' bytes ', scanner pc printString
- 			, ' to ', (scanner pc + blockSize - 1) printString.
- 	innerIndents
- 		atAll: (scanner pc to: scanner pc + blockSize - 1)
- 		put: (innerIndents at: scanner pc - 1) + 1!

Item was removed:
- ----- Method: InstructionPrinter>>pushConsArrayWithElements: (in category 'instruction decoding') -----
- pushConsArrayWithElements: numElements 
- 	self print: 'pop ', numElements printString, ' into (Array new: ', numElements printString, ')'!

Item was removed:
- ----- Method: InstructionPrinter>>pushConstant: (in category 'instruction decoding') -----
- pushConstant: obj
- 	"Print the Push Constant, obj, on Top Of Stack bytecode."
- 
- 	self print: (String streamContents:
- 				[:s |
- 				s nextPutAll: 'pushConstant: '.
- 				obj isVariableBinding
- 					ifTrue:
- 						[obj key
- 							ifNotNil: [s nextPutAll: '##'; nextPutAll: obj key]
- 							ifNil: [s nextPutAll: '###'; nextPutAll: obj value soleInstance name]]
- 					ifFalse:
- 						[obj isClosure
- 							ifTrue: [s nextPutAll: obj sourceString]
- 							ifFalse: [obj printOn: s]]]).
- 
- 	obj isCompiledMethod ifTrue:
- 		[obj longPrintOn: stream indent: self indent + 2.
- 		^self]!

Item was removed:
- ----- Method: InstructionPrinter>>pushFullClosure:numCopied: (in category 'printing') -----
- pushFullClosure: aCompiledBlock numCopied: numCopied
- 	| literalIndex |
- 	literalIndex := method literals identityIndexOf: aCompiledBlock.
- 	literalIndex = 0
- 		ifTrue:
- 			[self print: 'closureNumCopied: ', numCopied printString
- 				, ' numArgs: ', aCompiledBlock numArgs printString]
- 		ifFalse:
- 			[self print: 'pushFullClosure: (self literalAt: ', literalIndex printString,
- 						') numCopied: ', numCopied printString,
- 						' "numArgs: ', aCompiledBlock numArgs printString, '"'].
- 	
- 	fullBlockRecursionSelector ifNotNil:
- 		[(self class on: aCompiledBlock)
- 			indent: self indent + 1;
- 			perform: fullBlockRecursionSelector with: stream]!

Item was removed:
- ----- Method: InstructionPrinter>>pushLiteralVariable: (in category 'instruction decoding') -----
- pushLiteralVariable: anAssociation
- 	"Print the Push Value Of anAssociation On Top Of Stack bytecode."
- 
- 	self print: 'pushLitVar: ' , (anAssociation printStringLimitedTo: 64)!

Item was removed:
- ----- Method: InstructionPrinter>>pushNewArrayOfSize: (in category 'instruction decoding') -----
- pushNewArrayOfSize: numElements 
- 	self print: 'push: (Array new: ', numElements printString, ')'!

Item was removed:
- ----- Method: InstructionPrinter>>pushReceiver (in category 'instruction decoding') -----
- pushReceiver
- 	"Print the Push Active Context's Receiver on Top Of Stack bytecode."
- 
- 	self print: 'self'!

Item was removed:
- ----- Method: InstructionPrinter>>pushReceiverVariable: (in category 'instruction decoding') -----
- pushReceiverVariable: offset
- 	"Print the Push Contents Of the Receiver's Instance Variable Whose Index 
- 	is the argument, offset, On Top Of Stack bytecode."
- 
- 	self print: 'pushRcvr: ' , offset printString!

Item was removed:
- ----- Method: InstructionPrinter>>pushRemoteTemp:inVectorAt: (in category 'instruction decoding') -----
- pushRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex 
- 	self print: 'pushTemp: ', remoteTempIndex printString, ' inVectorAt: ', tempVectorIndex printString!

Item was removed:
- ----- Method: InstructionPrinter>>pushTemporaryVariable: (in category 'instruction decoding') -----
- pushTemporaryVariable: offset
- 	"Print the Push Contents Of Temporary Variable Whose Index Is the 
- 	argument, offset, On Top Of Stack bytecode."
- 
- 	self print: 'pushTemp: ' , offset printString!

Item was removed:
- ----- Method: InstructionPrinter>>send:super:numArgs: (in category 'instruction decoding') -----
- send: selector super: supered numArgs: numArgs
- 	"Print the Send Message With Selector, selector, bytecode. The argument, 
- 	supered, indicates whether the receiver of the message is specified with 
- 	'super' in the source method. The arguments of the message are found in 
- 	the top numArguments locations on the stack and the receiver just 
- 	below them."
- 
- 	self print: (supered
- 				ifTrue: ['superSend: ']
- 				ifFalse: ['send: '])
- 			, (self stringForSelector: selector numArgs: numArgs)!

Item was removed:
- ----- Method: InstructionPrinter>>storeIntoLiteralVariable: (in category 'instruction decoding') -----
- storeIntoLiteralVariable: anAssociation 
- 	"Print the Store Top Of Stack Into Literal Variable Of Method bytecode."
- 
- 	self print: 'storeIntoLit: ' , anAssociation key!

Item was removed:
- ----- Method: InstructionPrinter>>storeIntoReceiverVariable: (in category 'instruction decoding') -----
- storeIntoReceiverVariable: offset 
- 	"Print the Store Top Of Stack Into Instance Variable Of Method bytecode."
- 
- 	self print: 'storeIntoRcvr: ' , offset printString!

Item was removed:
- ----- Method: InstructionPrinter>>storeIntoRemoteTemp:inVectorAt: (in category 'instruction decoding') -----
- storeIntoRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex 
- 	self print: 'storeIntoTemp: ', remoteTempIndex printString, ' inVectorAt: ', tempVectorIndex printString!

Item was removed:
- ----- Method: InstructionPrinter>>storeIntoTemporaryVariable: (in category 'instruction decoding') -----
- storeIntoTemporaryVariable: offset 
- 	"Print the Store Top Of Stack Into Temporary Variable Of Method 
- 	bytecode."
- 
- 	self print: 'storeIntoTemp: ' , offset printString!

Item was removed:
- ----- Method: InstructionPrinter>>stringForSelector:numArgs: (in category 'printing') -----
- stringForSelector: selector numArgs: numArgs
- 	^(selector isSymbol and: [selector numArgs = numArgs])
- 		ifTrue: [selector]
- 		ifFalse: [selector printString
- 				, (numArgs = 1
- 					ifTrue: [' (1 arg)']
- 					ifFalse: [' (', numArgs printString, ' args)'])]!

Item was removed:
- ----- Method: InstructionPrinter>>trapIfNotInstanceOf: (in category 'instruction decoding') -----
- trapIfNotInstanceOf: behaviorOrArrayOfBehavior
- 	"If the top of stack is not an instance of either the argument, or, if the argument is an Array,
- 	  any of the elements of the argument, send the class trap message to the current context."
- 	self print: 'trapIfNotInstanceOf: ', behaviorOrArrayOfBehavior printString!

Item was removed:
- Object subclass: #InstructionStream
- 	instanceVariableNames: 'sender pc'
- 	classVariableNames: 'SpecialConstants'
- 	poolDictionaries: ''
- 	category: 'Kernel-Methods'!
- 
- !InstructionStream commentStamp: '<historical>' prior: 0!
- My instances can interpret the byte-encoded Smalltalk instruction set. They maintain a program counter (pc) for streaming through CompiledMethods. My subclasses are Contexts, which inherit this capability. They store the return pointer in the instance variable sender, and the current position in their method in the instance variable pc. For other users, sender can hold a method to be similarly interpreted. The unclean re-use of sender to hold the method was to avoid a trivial subclass for the stand-alone scanning function.!

Item was removed:
- ----- Method: InstructionStream class>>initialize (in category 'class initialization') -----
- initialize
- 	"Initialize an array of special constants returned by single-bytecode returns
- 	 in the SqueakV3 bytecode set."
- 
- 	SpecialConstants := {true. false. nil. -1. 0. 1. 2}
- 	"InstructionStream initialize."
- !

Item was removed:
- ----- Method: InstructionStream class>>instVarNamesAndOffsetsDo: (in category 'compiling') -----
- instVarNamesAndOffsetsDo: aBinaryBlock
- 	"This is part of the interface between the compiler and a class's instance or field names.
- 	 We override here to arrange that the compiler will use MaybeContextInstanceVariableNodes
- 	 for instances variables of Context or any of its superclasses and subclasses.  The
- 	 convention to make the compiler use the special nodes is to use negative indices"
- 
- 	| superInstSize |
- 	(self withAllSubclasses noneSatisfy: [:class|class isContextClass]) ifTrue:
- 		[^super instVarNamesAndOffsetsDo: aBinaryBlock].
- 	(superInstSize := superclass notNil ifTrue: [superclass instSize] ifFalse: [0]) > 0 ifTrue:
- 		[superclass instVarNamesAndOffsetsDo: aBinaryBlock].
- 	1 to: self instSize - superInstSize do:
- 		[:i| aBinaryBlock value: (instanceVariables at: i) value: (i + superInstSize) negated]!

Item was removed:
- ----- Method: InstructionStream class>>isContextClass (in category 'compiling') -----
- isContextClass
- 	^false!

Item was removed:
- ----- Method: InstructionStream class>>on: (in category 'instance creation') -----
- on: method 
- 	"Answer an instance of me on the argument, method."
- 
- 	^self new method: method pc: method initialPC!

Item was removed:
- ----- Method: InstructionStream>>addSelectorTo: (in category 'scanning') -----
- addSelectorTo: set 
- 	"If this instruction is a send, add its selector to set."
- 
- 	| selectorOrSelf |
- 	(selectorOrSelf := self selectorToSendOrSelf) == self ifFalse:
- 		[set add: selectorOrSelf]!

Item was removed:
- ----- Method: InstructionStream>>atEnd (in category 'decoding') -----
- atEnd
- 
- 	^ pc > self method endPC!

Item was removed:
- ----- Method: InstructionStream>>blockMethodOrNil (in category 'scanning') -----
- blockMethodOrNil
- 	"If this instruction is a full block creation, answer the block's method, otherwise nil."
- 
- 	| method |
- 	method := self method.
- 	^method encoderClass blockMethodOrNilFor: self in: method at: pc!

Item was removed:
- ----- Method: InstructionStream>>firstByte (in category 'scanning') -----
- firstByte
- 	"Answer the first byte of the current bytecode."
- 
- 	^self method at: pc!

Item was removed:
- ----- Method: InstructionStream>>followingByte (in category 'scanning') -----
- followingByte
- 	"Answer the next bytecode."
- 
- 	^self method at: pc + 1!

Item was removed:
- ----- Method: InstructionStream>>followingBytecode (in category 'scanning') -----
- followingBytecode
- 	"Answer the bytecode of the following bytecode (different to nextByte)."
- 
- 	^self method at: self followingPc!

Item was removed:
- ----- Method: InstructionStream>>followingPc (in category 'scanning') -----
- followingPc
- 	"Answer the pc of the following bytecode."
- 	| method |
- 	method := self method.
- 	^pc + (method encoderClass bytecodeSize: (method at: pc))!

Item was removed:
- ----- Method: InstructionStream>>fourthByte (in category 'scanning') -----
- fourthByte
- 	"Answer the fourth byte of the current bytecode."
- 
- 	^self method at: pc + 3!

Item was removed:
- ----- Method: InstructionStream>>interpretJump (in category 'decoding') -----
- interpretJump
- 	"If the instruction at pc is an unconditional jump, interpret it, advancing the pc,
- 	 and answering the jump distance. Otherwise answer nil."
- 	^self method encoderClass interpretJumpIn: self!

Item was removed:
- ----- Method: InstructionStream>>interpretJumpIfCond (in category 'decoding') -----
- interpretJumpIfCond
- 	"If the instruction at pc is a conditional jump, interpret it, advancing the pc,
- 	 and answering the jump distance. Otherwise answer nil."
- 	^self method encoderClass interpretJumpIfCondIn: self!

Item was removed:
- ----- Method: InstructionStream>>interpretNext2ByteSistaV1Instruction:for:extA:extB:startPC: (in category 'decoding - private - sista v1') -----
- interpretNext2ByteSistaV1Instruction: bytecode for: client extA: extA extB: extB startPC: startPC
- 	"Send to the argument, client, a message that specifies the next instruction.
- 	 This method handles the two-byte codes.
- 	 For a table of the bytecode set, see EncoderForV1's class comment."
- 
- 	| byte method |
- 	method := self method.
- 	byte := self method at: pc.
- 	pc := pc + 1.
- 	"We do an inline quasi-binary search on bytecode"
- 	bytecode < 234 ifTrue: "pushes"
- 		[bytecode < 231 ifTrue:
- 			[bytecode < 229 ifTrue:
- 				[| literal |
- 				 bytecode = 226 ifTrue:
- 					[^client pushReceiverVariable: (extA bitShift: 8) + byte].
- 				 literal := method literalAt: (extA bitShift: 8) + byte + 1.
- 				 bytecode = 227 ifTrue:
- 					[^client pushLiteralVariable: literal].
- 				 ^client pushConstant: literal].
- 			bytecode = 229 ifTrue:
- 				[^client pushTemporaryVariable: byte].
- 			^self unusedBytecode: client at: startPC].
- 		bytecode = 231 ifTrue:
- 			[^byte < 128
- 				ifTrue: [client pushNewArrayOfSize: byte]
- 				ifFalse: [client pushConsArrayWithElements: byte - 128]].
- 		bytecode = 232 ifTrue:
- 			[^client pushSpecialConstant: ((extB < 128 ifTrue: [extB] ifFalse: [extB - 256]) bitShift: 8) + byte].
- 		^client pushSpecialConstant: (Character value: ((extB bitAnd: 16rFF) bitShift: 8) + byte)].
- 	bytecode < 240 ifTrue: "sends, trap and jump"
- 		[bytecode < 236 ifTrue: "sends"
- 			[(bytecode = 235 and: [extB >= 64]) ifTrue:
- 				[^client
- 					directedSuperSend: (method literalAt: (extA bitShift: 5) + (byte // 8) + 1)
- 					numArgs: (extB - 64 bitShift: 3) + (byte \\ 8)].
- 			 ^client
- 				send: (method literalAt: (extA bitShift: 5) + (byte // 8) + 1)
- 				super: bytecode = 235
- 				numArgs: (extB bitShift: 3) + (byte \\ 8)].
- 		 bytecode = 236 ifTrue:
- 			[^client callMappedInlinedPrimitive: byte].
- 		bytecode = 237 ifTrue:
- 			[^client jump: (extB bitShift: 8) + byte].
- 		 ^client jump: (extB bitShift: 8) + byte if: bytecode = 238].
- 	bytecode < 243 ifTrue:
- 		[bytecode = 240 ifTrue:
- 			[^client popIntoReceiverVariable: (extA bitShift: 8) + byte].
- 		 bytecode = 241 ifTrue:
- 			[^client popIntoLiteralVariable: (method literalAt: (extA bitShift: 8) + byte + 1)].
- 		 ^client popIntoTemporaryVariable: byte].
- 	bytecode = 243 ifTrue:
- 		[^client storeIntoReceiverVariable: (extA bitShift: 8) + byte].
- 	bytecode = 244 ifTrue:
- 		[^client storeIntoLiteralVariable: (method literalAt: (extA bitShift: 8) + byte + 1)].
- 	bytecode = 245 ifTrue:
- 		[^client storeIntoTemporaryVariable: byte].
- 	"246-247	1111011 i	xxxxxxxx	UNASSIGNED"
- 	^self unusedBytecode: client at: startPC!

Item was removed:
- ----- Method: InstructionStream>>interpretNext3ByteSistaV1Instruction:for:extA:extB:startPC: (in category 'decoding - private - sista v1') -----
- interpretNext3ByteSistaV1Instruction: bytecode for: client extA: extA extB: extB startPC: startPC
- 	"Send to the argument, client, a message that specifies the next instruction.
- 	 This method handles the three-byte codes.
- 	 For a table of the bytecode set, see EncoderForSistaV1's class comment."
- 
- 	| method byte2 byte3 literal |
- 	method := self method.
- 	byte2 := method at: pc.
- 	byte3 := method at: pc + 1.
- 	pc := pc + 2.
- 
- 	"**	248	(2)	11111000 	iiiiiiii		mssjjjjj		Call Primitive #iiiiiiii + (jjjjj * 256) 
- 									m=1 means inlined primitive, no hard return after execution. 
- 									ss defines the unsafe operation set used to encode the operations. 
- 									(ss = 0 means sista unsafe operations, ss = 01 means lowcode operations, other numbers are not used)
- 									Lowcode inlined primitives may have extensions."
- 	bytecode = 248 ifTrue:
- 		[| primitiveSetSelector primitiveNumber |
- 		 byte3 < 128 ifTrue:
- 			[ "Maybe this should be restricted to the 13 bit primitiveNumber too..."
- 			 ^client callPrimitive: byte2 + (byte3 bitShift: 8)].
- 		 primitiveSetSelector := (byte3 bitShift: -5) bitAnd: 3.
- 		 primitiveNumber := byte2 + ((byte3 bitAnd: 31) bitShift: 8).
- 		 primitiveSetSelector = 0 ifTrue: "Sista inline primitives"
- 			[^client callInlinePrimitive: byte2 + (byte3 - 128 bitShift: 8)].
- 		 primitiveSetSelector = 1 ifTrue: "Lowcode inline primitives"
- 			[^client callLowcodeInlinePrimitive: byte2 + (byte3 - 128 bitShift: 8) extA: extA extB: extB].
- 		 "fall through to ^self unusedBytecode: client at: startPC below"].
- 
- 	"*	249		11111001	xxxxxxxx	siyyyyyy	push Closure Compiled block literal index xxxxxxxx (+ Extend A * 256) numCopied yyyyyy receiverOnStack: s = 1 ignoreOuterContext: i = 1"
- 	bytecode = 249 ifTrue:
- 		[literal := method literalAt: (extA bitShift: 8) + byte2 + 1.
- 		 (byte3 noMask: 16rC0) ifTrue:
- 			[^client pushFullClosure: literal numCopied: byte3].
- 		 ^client
- 			pushFullClosure: literal
- 			numCopied: (byte3 bitAnd: 16r3F)
- 			receiverOnStack: (byte3 anyMask: 16r80)
- 			ignoreOuterContext: (byte3 anyMask: 16r40)].
- 	bytecode = 250 ifTrue:
- 		["**	250  11111010  eeiiikkk  jjjjjjjj  Push Closure Num Copied iii (+ExtA//16*8) Num Args kkk (+ ExtA\\16*8) BlockSize jjjjjjjj (+ExtB*256). ee = num extensions"
- 		 ^client
- 			pushClosureCopyNumCopiedValues: ((byte2 bitShift: -3) bitAnd: 7) + (extA // 16 bitShift: 3)
- 			numArgs: (byte2 bitAnd: 7) + (extA \\ 16 bitShift: 3)
- 			blockSize: byte3 + (extB bitShift: 8)].
- 	bytecode = 251 ifTrue:
- 		[^client pushRemoteTemp: byte2 inVectorAt: byte3].
- 	bytecode = 252 ifTrue:
- 		[^client storeIntoRemoteTemp: byte2 inVectorAt: byte3].
- 	bytecode = 253 ifTrue:
- 		[^client popIntoRemoteTemp: byte2 inVectorAt: byte3].
- 	"**	254		11111110	kkkkkkkk	jjjjjjjj		branch If Not Instance Of Behavior/Array Of Behavior kkkkkkkk (+ Extend A * 256, where Extend A >= 0) distance jjjjjjjj (+ Extend B * 256, where Extend B >= 0)"
- 	bytecode = 254 ifTrue: "The sign bit of extB inverts the operation.  Would like to have extB < -128, but this is good enough for now."
- 		[literal := method literalAt: (extA bitShift: 8) + byte2 + 1.
- 		 extB < 0 ifTrue: [^client branchIfInstanceOf: literal distance: (extB + 128 bitShift: 8) + byte3].
- 		 ^client branchIfNotInstanceOf: literal distance: (extB bitShift: 8) + byte3].
- 	^self unusedBytecode: client at: startPC!

Item was removed:
- ----- Method: InstructionStream>>interpretNextInstructionFor: (in category 'decoding') -----
- interpretNextInstructionFor: client
- 	"Send to the argument, client, a message that specifies the type of the next instruction."
- 
- 	^self method encoderClass interpretNextInstructionFor: client in: self!

Item was removed:
- ----- Method: InstructionStream>>interpretNextSistaV1InstructionFor: (in category 'decoding - private - sista v1') -----
- interpretNextSistaV1InstructionFor: client
- 	"Send to the argument, client, a message that specifies the next instruction."
- 
- 	| byte div16 offset method extA extB savedPC |
- 	method := self method.
- 	"For a table of the bytecode set, see EncoderForSistaV1's class comment."
- 	"consume and compute any extensions first."
- 	extA := extB := 0.
- 	savedPC := pc.
- 	[byte := self method at: pc.
- 	 pc := pc + 1.
- 	 byte >= 16rE0 and: [byte <= 16rE1]] whileTrue:
- 		[| extByte |
- 		 extByte := self method at: pc.
- 		 pc := pc + 1.
- 		 byte = 16rE0
- 			ifTrue:
- 				[extA := (extA bitShift: 8) + extByte]
- 			ifFalse:
- 				[extB := (extB = 0 and: [extByte > 127])
- 							ifTrue: [extByte - 256]
- 							ifFalse: [(extB bitShift: 8) + extByte]]].
- 	div16 := byte // 16.
- 	offset := byte \\ 16.
- 	"We do an inline quasi-binary search on each of the possible 16 values of div16"
- 	div16 < 11 ifTrue:
- 		[div16 < 6 ifTrue:
- 			[div16 < 4 ifTrue:
- 				[div16 < 2 ifTrue:
- 					[div16 = 0 ifTrue:
- 						 [^client pushReceiverVariable: offset].
- 					^client pushLiteralVariable: (method literalAt: offset + 1)]. "div16 = 1"
- 				 ^client pushConstant: (method literalAt: byte \\ 32 + 1)].
- 			 div16 = 4 ifTrue:
- 				[offset < 12 ifTrue:
- 					[^client pushTemporaryVariable: offset].
- 				 offset = 12 ifTrue:
- 					[^client pushReceiver].
- 				 offset = 13 ifTrue:
- 					[^client pushSpecialConstant: true].
- 				 offset = 14 ifTrue:
- 					[^client pushSpecialConstant: false].
- 				 offset = 15 ifTrue:
- 					[^client pushSpecialConstant: nil]].
- 			"div16 = 5"
- 			 offset < 2 ifTrue:
- 				[^client pushSpecialConstant: offset].
- 			 offset = 2 ifTrue:
- 				[^self interpretSistaV1ExtendedPush: extB for: client].
- 			 offset = 3 ifTrue:
- 				[^client doDup].
- 			 offset = 8 ifTrue:
- 				[^client methodReturnReceiver].
- 			 offset = 9 ifTrue:
- 				[^client methodReturnConstant: true].
- 			 offset = 10 ifTrue:
- 				[^client methodReturnConstant: false].
- 			 offset = 11 ifTrue:
- 				[^client methodReturnConstant: nil].
- 			 offset = 12 ifTrue:
- 				[^client methodReturnTop].
- 			 offset = 13 ifTrue:
- 				[^client blockReturnConstant: nil].
- 			 offset = 14 ifTrue:
- 				[^client blockReturnTop].
- 			 offset = 15 ifTrue:
- 				[^client doNop].
- 			 ^self unusedBytecode: client at: savedPC].
- 		"short sends"
- 		div16 = 6 ifTrue:
- 			[^client
- 				sendSpecial: (Smalltalk specialSelectorAt: offset + 1)
- 				numArgs: (Smalltalk specialNargsAt: offset + 1)].
- 		 div16 = 7 ifTrue:
- 			[^client
- 				sendSpecial: (Smalltalk specialSelectorAt: offset + 17)
- 				numArgs: (Smalltalk specialNargsAt: offset + 17)].
- 		^client
- 			send: (method literalAt: offset + 1)
- 			super: false
- 			numArgs: div16 - 8].
- 	"div16 >= 11; bytecode >= 176"
- 	div16 < 14 ifTrue:
- 		[div16 = 11 ifTrue:
- 			[offset < 8 ifTrue:
- 				[^client jump: offset + 1].
- 			 ^client jump: offset - 7 if: true].
- 		 div16 = 12 ifTrue:
- 			[offset < 8 ifTrue:
- 				[^client jump: offset + 1 if: false].
- 			 ^client popIntoReceiverVariable: offset - 8].
- 		 "div16 = 13"
- 		 offset < 8 ifTrue:
- 		 	[^client popIntoTemporaryVariable: offset].
- 		 offset = 8 ifTrue:
- 			[^client doPop].
- 		 offset = 9 ifTrue:
- 			[^client trap].
- 		 ^self unusedBytecode: client at: savedPC].
- 	"2 byte and 3 byte codes"
- 	byte < 248 ifTrue:
- 		[^self interpretNext2ByteSistaV1Instruction: byte for: client extA: extA extB: extB startPC: savedPC].
- 	^self interpretNext3ByteSistaV1Instruction: byte for: client extA: extA extB: extB startPC: savedPC!

Item was removed:
- ----- Method: InstructionStream>>interpretNextV3ClosuresInstructionFor: (in category 'decoding - private - v3 plus closures') -----
- interpretNextV3ClosuresInstructionFor: client 
- 	"Send to the argument, client, a message that specifies the type of the 
- 	 next instruction."
- 
- 	| byte type offset method |
- 	method := self method.  
- 	byte := method at: pc.
- 	type := byte // 16.  
- 	offset := byte \\ 16.  
- 	pc := pc+1.
- 	"We do an inline binary search on each of the possible 16 values of type."
- 	type < 8 ifTrue:
- 		[type < 4 ifTrue:
- 			[type < 2 ifTrue:
- 				[type = 0 ifTrue:
- 					[^ client pushReceiverVariable: offset].
- 				^ client pushTemporaryVariable: offset].				"type = 1"
- 			type = 2 ifTrue: 
- 				[^ client pushConstant: (method literalAt: offset + 1)].
- 			^ client pushConstant: (method literalAt: offset + 17)].		"type = 3"
- 		type < 6 ifTrue:
- 			[type = 4 ifTrue:
- 				[^ client pushLiteralVariable: (method literalAt: offset + 1)].
- 			^ client pushLiteralVariable: (method literalAt: offset + 17)]."type = 5"
- 		type = 6 ifTrue:
- 			[offset < 8 ifTrue:
- 				[^ client popIntoReceiverVariable: offset].
- 			^ client popIntoTemporaryVariable: offset - 8].
- 		"type = 7"
- 		offset = 0 ifTrue: [^ client pushReceiver].
- 		offset < 8 ifTrue: [^ client pushSpecialConstant: (SpecialConstants at: offset)].
- 		offset = 8 ifTrue: [^ client methodReturnReceiver].
- 		offset < 12 ifTrue: [^ client methodReturnConstant: (SpecialConstants at: offset - 8)].
- 		offset = 12 ifTrue: [^ client methodReturnTop].
- 		offset = 13 ifTrue: [^ client blockReturnTop].
- 		^ self unusedBytecode: client at: pc - 1]. "offset = 14 & offset = 15, 126 & 127"
- 	type < 12 ifTrue:
- 		[type < 10 ifTrue:
- 			[type = 8 ifTrue:
- 				[^ self
- 					interpretV3ClosuresExtension: offset
- 					in: method
- 					for: client].
- 			"type = 9 (short jumps)"
- 			offset < 8 ifTrue: [^ client jump: offset + 1].
- 			^ client jump: offset - 8 + 1 if: false].
- 		type = 10 ifTrue: "(long jumps)"
- 			[byte := method at: pc.
- 			pc := pc + 1.
- 			offset < 8 ifTrue: [^ client jump: offset - 4 * 256 + byte].
- 			^ client jump: (offset bitAnd: 3) * 256 + byte if: offset < 12].
- 		"type = 11; arithmetic special selector sends"
- 		^ client
- 			sendSpecial: (Smalltalk specialSelectorAt: offset + 1)
- 			numArgs: (Smalltalk specialNargsAt: offset + 1)].
- 		type = 12 ifTrue: "non-arithmetic special selector sends"
- 			[^ client
- 				sendSpecial: (Smalltalk specialSelectorAt: offset + 17)
- 				numArgs: (Smalltalk specialNargsAt: offset + 17)].
- 	"type = 13, 14 or 15"
- 	^ client
- 		send: (method literalAt: offset + 1)
- 		super: false
- 		numArgs: type - 13 "0, 1 & 2"!

Item was removed:
- ----- Method: InstructionStream>>interpretNextV3InstructionFor: (in category 'decoding - private - v3 plus closures') -----
- interpretNextV3InstructionFor: client 
- 	"Send to the argument, client, a message that specifies the type of the 
- 	 next instruction."
- 
- 	| byte type offset method |
- 	method := self method.  
- 	byte := method at: pc.
- 	type := byte // 16.  
- 	offset := byte \\ 16.  
- 	pc := pc+1.
- 	"We do an inline binary search on each of the possible 16 values of type."
- 	type < 8 ifTrue:
- 		[type < 4 ifTrue:
- 			[type < 2 ifTrue:
- 				[type = 0 ifTrue:
- 					[^ client pushReceiverVariable: offset].
- 				^ client pushTemporaryVariable: offset].				"type = 1"
- 			type = 2 ifTrue: 
- 				[^ client pushConstant: (method literalAt: offset + 1)].
- 			^ client pushConstant: (method literalAt: offset + 17)].		"type = 3"
- 		type < 6 ifTrue:
- 			[type = 4 ifTrue:
- 				[^ client pushLiteralVariable: (method literalAt: offset + 1)].
- 			^ client pushLiteralVariable: (method literalAt: offset + 17)]."type = 5"
- 		type = 6 ifTrue:
- 			[offset < 8 ifTrue:
- 				[^ client popIntoReceiverVariable: offset].
- 			^ client popIntoTemporaryVariable: offset - 8].
- 		"type = 7"
- 		offset = 0 ifTrue: [^ client pushReceiver].
- 		offset < 8 ifTrue: [^ client pushSpecialConstant: (SpecialConstants at: offset)].
- 		offset = 8 ifTrue: [^ client methodReturnReceiver].
- 		offset < 12 ifTrue: [^ client methodReturnConstant: (SpecialConstants at: offset - 8)].
- 		offset = 12 ifTrue: [^ client methodReturnTop].
- 		offset = 13 ifTrue: [^ client blockReturnTop].
- 		^ self unusedBytecode: client at: pc - 1]. "offset = 14 & offset = 15, 126 & 127"
- 	type < 12 ifTrue:
- 		[type < 10 ifTrue:
- 			[type = 8 ifTrue:
- 				[^ self
- 					interpretV3Extension: offset
- 					in: method
- 					for: client].
- 			"type = 9 (short jumps)"
- 			offset < 8 ifTrue: [^ client jump: offset + 1].
- 			^ client jump: offset - 8 + 1 if: false].
- 		type = 10 ifTrue: "(long jumps)"
- 			[byte := method at: pc.
- 			pc := pc + 1.
- 			offset < 8 ifTrue: [^ client jump: offset - 4 * 256 + byte].
- 			^ client jump: (offset bitAnd: 3) * 256 + byte if: offset < 12].
- 		"type = 11; arithmetic special selector sends"
- 		^ client
- 			sendSpecial: (Smalltalk specialSelectorAt: offset + 1)
- 			numArgs: (Smalltalk specialNargsAt: offset + 1)].
- 		type = 12 ifTrue: "non-arithmetic special selector sends"
- 			[^ client
- 				sendSpecial: (Smalltalk specialSelectorAt: offset + 17)
- 				numArgs: (Smalltalk specialNargsAt: offset + 17)].
- 	"type = 13, 14 or 15"
- 	^ client
- 		send: (method literalAt: offset + 1)
- 		super: false
- 		numArgs: type - 13 "0, 1 & 2"!

Item was removed:
- ----- Method: InstructionStream>>interpretSistaV1ExtendedPush:for: (in category 'decoding - private - sista v1') -----
- interpretSistaV1ExtendedPush: extB for: client
- 	"Implement the extended push for non-zero extensions."
- 	"*	82			01010010			Push thisContext, (then Extend B = 1 => push thisProcess)"
- 	extB = 0 ifTrue:
- 		[^client pushActiveContext].
- 	extB = 1 ifTrue:
- 		[^client pushActiveProcess].
- 	self error: 'undefined extended push'!

Item was removed:
- ----- Method: InstructionStream>>interpretSistaV1Jump (in category 'decoding - private - sista v1') -----
- interpretSistaV1Jump
- 	"If the instruction at pc is an unconditional jump, interpret it, advancing the pc,
- 	 and answering the jump distance. Otherwise answer nil."
- 
- 	"	176-183	10110 iii				Jump iii + 1 (i.e., 1 through 8)
- 	 *	225/16rE1	11100001	sbbbbbbb	Extend B (Ext B = Ext B prev * 256 + Ext B)
- 	 *	237		11101101	iiiiiiii		Jump #iiiiiiii (+ Extend B * 256, where bbbbbbbb = sddddddd, e.g. -32768 = i=0, a=0, s=1)"
- 	| method byte nextpc extB |
- 	method := self method.
- 	"consume and compute any extension first."
- 	extB := 0.
- 	nextpc := pc. "must not advance pc unless this is a jump."
- 	[byte := self method at: nextpc.
- 	 nextpc := nextpc + 1.
- 	 byte = 16rE1] whileTrue:
- 		[| extByte |
- 		 extByte := self method at: nextpc.
- 		 nextpc := nextpc + 1.
- 		 extB := (extB = 0 and: [extByte > 127])
- 					ifTrue: [extByte - 256]
- 					ifFalse: [(extB bitShift: 8) + extByte]].
- 	(byte between: 176 and: 183) ifTrue:
- 		[pc := nextpc.
- 		 ^byte - 191].
- 	byte = 237 ifTrue:
- 		[byte := method at: nextpc.
- 		 pc := nextpc + 1.
- 		 ^(extB bitShift: 8) + byte].
- 	^nil!

Item was removed:
- ----- Method: InstructionStream>>interpretSistaV1JumpIfCond (in category 'decoding - private - sista v1') -----
- interpretSistaV1JumpIfCond
- 	"If the instruction at pc is a conditional jump, interpret it, advancing the pc,
- 	 and answering the jump distance. Otherwise answer nil."
- 
- 	"	184-191	10111 iii				Pop and Jump 0n True iii +1 (i.e., 1 through 8)
- 		192-199	11000 iii				Pop and Jump 0n False iii +1 (i.e., 1 through 8)
- 	 *	225/E1		11100001	sbbbbbbb	Extend B (Ext B = Ext B prev * 256 + Ext B)
- 	 *	238		11101110	iiiiiiii		Pop and Jump 0n True #iiiiiiii (+ Extend B * 256, where Extend B >= 0)
- 	 *	239		11101111	iiiiiiii		Pop and Jump 0n False #iiiiiiii (+ Extend B * 256, where Extend B >= 0)"
- 	| method byte nextpc extB |
- 	method := self method.
- 	"consume and compute any extension first."
- 	extB := 0.
- 	nextpc := pc. "must not advance pc unless this is a jump."
- 	[byte := self method at: nextpc.
- 	 nextpc := nextpc + 1.
- 	 byte = 16rE1] whileTrue:
- 		[| extByte |
- 		 extByte := self method at: nextpc.
- 		 nextpc := nextpc + 1.
- 		 extB := (extB = 0 and: [extByte > 127])
- 					ifTrue: [extByte - 256]
- 					ifFalse: [(extB bitShift: 8) + extByte]].
- 	(byte between: 184 and: 199) ifTrue:
- 		[pc := nextpc.
- 		 ^(byte bitAnd: 7) + 1].
- 	(byte between: 238 and: 239) ifTrue:
- 		[byte := method at: nextpc.
- 		 pc := nextpc + 1.
- 		 ^(extB bitShift: 8) + byte].
- 	^nil!

Item was removed:
- ----- Method: InstructionStream>>interpretV3ClosuresExtension:in:for: (in category 'decoding - private - v3 plus closures') -----
- interpretV3ClosuresExtension: offset in: method for: client
- 	| type offset2 byte2 byte3 byte4 |
- 	offset <= 6 ifTrue: 
- 		["Extended op codes 128-134"
- 		byte2 := method at: pc. pc := pc + 1.
- 		offset <= 2 ifTrue:
- 			["128-130:  extended pushes and pops"
- 			type := byte2 // 64.
- 			offset2 := byte2 \\ 64.
- 			offset = 0 ifTrue: 
- 				[type = 0 ifTrue: [^client pushReceiverVariable: offset2].
- 				type = 1 ifTrue: [^client pushTemporaryVariable: offset2].
- 				type = 2  ifTrue: [^client pushConstant: (method literalAt: offset2 + 1)].
- 				type = 3 ifTrue: [^client pushLiteralVariable: (method literalAt: offset2 + 1)]].
- 			offset = 1 ifTrue: 
- 				[type = 0 ifTrue: [^client storeIntoReceiverVariable: offset2].
- 				type = 1 ifTrue: [^client storeIntoTemporaryVariable: offset2].
- 				type = 2 ifTrue: [self error: 'illegalStore'].
- 				type = 3 ifTrue: [^client storeIntoLiteralVariable: (method literalAt: offset2 + 1)]].
- 			offset = 2 ifTrue: 
- 				[type = 0 ifTrue: [^client popIntoReceiverVariable: offset2].
- 				type = 1 ifTrue: [^client popIntoTemporaryVariable: offset2].
- 				type = 2 ifTrue: [self error: 'illegalStore'].
- 				type = 3  ifTrue: [^client popIntoLiteralVariable: (method literalAt: offset2 + 1)]]].
- 		"131-134: extended sends"
- 		offset = 3 ifTrue:  "Single extended send"
- 			[^client send: (method literalAt: byte2 \\ 32 + 1)
- 					super: false numArgs: byte2 // 32].
- 		offset = 4 ifTrue:    "Double extended do-anything"
- 			[byte3 := method at: pc. pc := pc + 1.
- 			type := byte2 // 32.
- 			type = 0 ifTrue: [^client send: (method literalAt: byte3 + 1)
- 									super: false numArgs: byte2 \\ 32].
- 			type = 1 ifTrue: [^client send: (method literalAt: byte3 + 1)
- 									super: true numArgs: byte2 \\ 32].
- 			type = 2 ifTrue: [^client pushReceiverVariable: byte3].
- 			type = 3 ifTrue: [^client pushConstant: (method literalAt: byte3 + 1)].
- 			type = 4 ifTrue: [^client pushLiteralVariable: (method literalAt: byte3 + 1)].
- 			ty