'From Cuis 1.0 of 28 November 2009 [latest update: #337] on 9 December 2009 at 11:08:35 pm'!

!CompiledMethod methodsFor: 'accessing' stamp: 'md 2/18/2006 13:11'!
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! !

!CompiledMethod methodsFor: 'accessing' stamp: 'ar 8/8/2009 12:02'!
dragLabel
	"The label we use for dragging compiled methods"
	^self methodClass name, '>>', self selector! !

!CompiledMethod methodsFor: 'accessing' stamp: 'eem 6/30/2009 12:38'!
endPC
	"Answer the index of the last bytecode."
	| size flagByte |
	"Can't create a zero-sized CompiledMethod so no need to use last for the errorEmptyCollection check.
	 We can reuse size."
	size := self size.
	flagByte := self at: size.
	flagByte = 0 ifTrue:
		["If last byte = 0, may be either 0, 0, 0, 0 or just 0"
		1 to: 4 do: [:i | (self at: size - i) = 0 ifFalse: [^size - i]]].
	flagByte < 252 ifTrue:
		["Magic sources (temp names encoded in last few bytes)"
		^flagByte <= 127
			ifTrue: [size - flagByte - 1]
			ifFalse: [size - (flagByte - 128 * 128) - (self at: size - 1) - 2]].
	"Normal 4-byte source pointer"
	^size - 4! !

!CompiledMethod methodsFor: 'accessing' stamp: 'eem 8/20/2009 11:42'!
flag
	"Answer the user-level flag bit"

	^((self header bitShift: -29) bitAnd: 1) = 1! !

!CompiledMethod methodsFor: 'accessing' stamp: 'eem 11/29/2008 11:38'!
methodClass
	"answer the class that I am installed in"
	^(self literalAt: self numLiterals) value.! !

!CompiledMethod methodsFor: 'accessing' stamp: 'md 2/16/2006 11:30'!
methodClass: aClass
	"set the class binding in the last literal to aClass"
	self literalAt: self numLiterals put: aClass binding! !

!CompiledMethod methodsFor: 'accessing' stamp: 'md 2/16/2006 14:00'!
methodReference
	| class selector |
	class := self methodClass ifNil: [^nil].
	selector := self selector ifNil: [^nil].
	^MethodReference class: class selector: selector.
	! !

!CompiledMethod methodsFor: 'accessing' stamp: 'md 1/20/2006 16:09'!
scanner

	^ InstructionStream on: self! !

!CompiledMethod methodsFor: 'accessing' stamp: 'md 2/15/2006 20:51'!
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.! !

!CompiledMethod methodsFor: 'accessing' stamp: 'md 2/15/2006 20:51'!
searchForSelector
	"search me in all classes, if found, return my selector. Slow!!"
	| selector |
	self systemNavigation allBehaviorsDo: [:class | 
		(selector := class methodDict keyAtIdentityValue: self ifAbsent: [nil]) ifNotNil: [^selector]].
	^nil.! !

!CompiledMethod methodsFor: 'accessing' stamp: 'eem 11/28/2008 12:54'!
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 MethodProperties stored in the penultimate literal."
	| penultimateLiteral | 
	^(penultimateLiteral := self penultimateLiteral) isMethodProperties
		ifTrue: [penultimateLiteral selector]
		ifFalse: [penultimateLiteral]! !

!CompiledMethod methodsFor: 'comparing' stamp: 'nice 11/8/2009 15:27'!
= method
	| numLits |
	"Answer whether the receiver implements the same code as the 
	argument, method."
	(method isKindOf: CompiledMethod) ifFalse: [^false].
	self size = method size ifFalse: [^false].
	self header = method header ifFalse: [^false].
	self initialPC to: self endPC do:
		[:i | (self at: i) = (method at: i) ifFalse: [^false]].
	(numLits := self numLiterals) ~= method numLiterals ifTrue: [^false].
	"``Dont bother checking FFI and named primitives''
	 (#(117 120) includes: self primitive) ifTrue: [^ true]."
	1 to: numLits do:
		[:i| | lit1 lit2 |
		lit1 := self literalAt: i.
		lit2 := method literalAt: i.
		lit1 = lit2 ifFalse:
			[(i = 1 and: [#(117 120) includes: self primitive])
				ifTrue: [lit1 isArray
							ifTrue:
								[(lit2 isArray and: [lit1 allButLast = lit2 allButLast]) ifFalse:
									[^false]]
							ifFalse: "ExternalLibraryFunction"
								[(lit1 analogousCodeTo: lit2) ifFalse:
									[^false]]] ifFalse:
			[i = (numLits - 1) ifTrue: "properties"
				[(self properties analogousCodeTo: method properties) ifFalse:
					[^false]] ifFalse:
			 [lit1 isFloat
				ifTrue:
					["Floats match if values are close, due to roundoff error."
					(lit1 closeTo: lit2) ifFalse: [^false]. self flag: 'just checking'. self halt]
				ifFalse:
					["any other discrepancy is a failure"
					^ false]]]]].
	^true! !

!CompiledMethod methodsFor: 'comparing' stamp: 'md 2/16/2006 17:07'!
equivalentTo: aCompiledMethod 
	"does not work yet with non-RB parseTrees"
	^ self = aCompiledMethod
		or: [self class == aCompiledMethod class
				and: [self numArgs == aCompiledMethod numArgs
						and: [self decompile = aCompiledMethod decompile]]].! !

!CompiledMethod methodsFor: 'testing' stamp: 'md 1/21/2006 10:54'!
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."
	| assoc |
	#(#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 := Smalltalk
						associationAt: aSymbol
						ifAbsent: [])
				ifNotNil: [(self hasLiteral: assoc)
						ifTrue: [^ true]]].
	^ false! !

!CompiledMethod methodsFor: 'testing' stamp: 'NS 12/12/2003 15:18'!
isAbstract
	| marker |
	marker := self markerOrNil.
	^ marker notNil and: [self class abstractMarkers includes: marker].! !

!CompiledMethod methodsFor: 'testing' stamp: 'al 1/23/2004 13:12'!
isConflict
	^ self markerOrNil == self class conflictMarker! !

!CompiledMethod methodsFor: 'testing' stamp: 'NS 3/22/2005 16:32'!
isDisabled
	^ self isDisabled: self markerOrNil! !

!CompiledMethod methodsFor: 'testing' stamp: 'NS 3/22/2005 16:32'!
isDisabled: marker
	^ marker == self class disabledMarker! !

!CompiledMethod methodsFor: 'testing' stamp: 'NS 3/22/2005 16:32'!
isExplicitlyRequired
	^ self isExplicitlyRequired: self markerOrNil! !

!CompiledMethod methodsFor: 'testing' stamp: 'NS 3/22/2005 16:32'!
isExplicitlyRequired: marker
	^ marker == self class explicitRequirementMarker! !

!CompiledMethod methodsFor: 'testing' stamp: 'NS 3/22/2005 16:32'!
isImplicitlyRequired
	^ self isImplicitlyRequired: self markerOrNil! !

!CompiledMethod methodsFor: 'testing' stamp: 'NS 3/22/2005 16:32'!
isImplicitlyRequired: marker
	^ marker == self class implicitRequirementMarker! !

!CompiledMethod methodsFor: 'testing' stamp: 'NS 3/22/2005 16:40'!
isProvided
	^ self isProvided: self markerOrNil! !

!CompiledMethod methodsFor: 'testing' stamp: 'NS 3/22/2005 16:40'!
isProvided: marker
	marker ifNil: [^ true].
	^ (self isRequired: marker) not and: [(self isDisabled: marker) not]! !

!CompiledMethod methodsFor: 'testing' stamp: 'NS 3/22/2005 16:38'!
isRequired
	^ self isRequired: self markerOrNil! !

!CompiledMethod methodsFor: 'testing' stamp: 'NS 3/22/2005 16:38'!
isRequired: marker
	marker ifNil: [^ false].
	(self isImplicitlyRequired: marker) ifTrue: [^ true].
	(self isExplicitlyRequired: marker) ifTrue: [^ true]. 
	(self isSubclassResponsibility: marker) ifTrue: [^ true]. 
	^ false! !

!CompiledMethod methodsFor: 'testing' stamp: 'NS 3/22/2005 16:38'!
isSubclassResponsibility
	^ self isSubclassResponsibility: self markerOrNil! !

!CompiledMethod methodsFor: 'testing' stamp: 'NS 3/22/2005 16:38'!
isSubclassResponsibility: marker
	^ marker == self class subclassResponsibilityMarker! !

!CompiledMethod methodsFor: 'printing' stamp: 'md 2/16/2006 13:26'!
decompileString
	^self decompile decompileString! !

!CompiledMethod methodsFor: 'printing' stamp: 'nice 10/7/2009 20:53'!
printOn: aStream 
	"Overrides method inherited from the byte arrayed collection."

	aStream nextPut: $(; print: self methodClass; nextPutAll: '>>'; nextPutAll: self selector storeString; space; nextPut: $".
	self printNameOn: aStream. 
	aStream nextPut: $(; print: self identityHash; nextPut: $); nextPut: $"; nextPut: $)! !

!CompiledMethod methodsFor: 'printing' stamp: 'MPW 1/1/1901 22:09'!
printOnStream: aStream 
	"Overrides method inherited from the byte arrayed collection."

	aStream print: 'a CompiledMethod'! !

!CompiledMethod methodsFor: 'printing' stamp: 'eem 12/5/2008 09:48'!
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! !

!CompiledMethod methodsFor: 'printing' stamp: 'jmv 12/9/2009 22:56'!
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"

	| file preamble stamp tokens tokenCount |
	self fileIndex = 0 ifTrue: [^ String new].  "no source pointer for this method"
	file := SourceFiles at: self fileIndex.
	file ifNil: [^ String new].  "sources file not available"
	"file does not exist happens in secure mode"
	file := [file readOnlyCopy] on: FileDoesNotExistException do:[:ex| nil].
	file ifNil: [^ String new].
	preamble := self getPreambleFrom: file at: (0 max: self filePosition - 3).
		stamp := String new.
		tokens := (preamble findString: 'methodsFor:' startingAt: 1) > 0
			ifTrue: [Scanner new scanTokens: preamble]
			ifFalse: [Array new  "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]].
	file close.
	^ stamp! !

!CompiledMethod methodsFor: 'literals' stamp: 'eem 11/29/2008 11:37'!
hasLiteral: literal
	"Answer whether the receiver references the argument, literal."
	2 to: self numLiterals - 1 "exclude superclass + selector/properties"
	  do:[:index |
		literal == (self objectAt: index) ifTrue: [^true]].
	^false! !

!CompiledMethod methodsFor: 'literals' stamp: 'eem 11/29/2008 17:01'!
hasLiteralSuchThat: litBlock
	"Answer true if litBlock returns true for any literal in this method, even if embedded in array structure."
	(self penultimateLiteral isMethodProperties
	 and: [self penultimateLiteral hasLiteralSuchThat: litBlock]) ifTrue:
		[^true].
	2 to: self numLiterals + 1 do:
		[:index | | lit |
		lit := self objectAt: index.
		((litBlock value: lit)
		or: [lit isArray and: [lit hasLiteralSuchThat: litBlock]]) ifTrue:
			[^true]].
	^false! !

!CompiledMethod methodsFor: 'literals' stamp: 'eem 8/7/2009 11:43'!
hasLiteralThorough: literal
	"Answer true if any literal in this method is literal,
	even if embedded in array structure."

	(self penultimateLiteral isMethodProperties
	 and: [self penultimateLiteral hasLiteralThorough: literal]) ifTrue:[^true].
	2 to: self numLiterals - 1 "exclude superclass + selector/properties"
	   do:[:index | | lit |
		((lit := self objectAt: index) == literal
		 or: [(lit isVariableBinding and: [lit key == literal])
		 or: [lit isArray and: [lit hasLiteral: literal]]]) ifTrue:
			[^ true]].
	^ false ! !

!CompiledMethod methodsFor: 'literals' stamp: 'ms 5/10/2007 11:21'!
hasLiteralThorough: aLiteral from: aBlock
	"Answer true if any literal in this method is literal, even if embedded in array structure or within its pragmas."

	| literal |
	self pragmas do: [ :pragma |
		(pragma hasLiteral: aLiteral) ifTrue: [ ^ true ] ].
	2 to: self numLiterals + 1 do: [ :index | 
		literal := self objectAt: index.
		literal == aLiteral  ifTrue: [ ^ true ].
		literal == aBlock ifFalse:[ (literal hasLiteralThorough: aLiteral) ifTrue: [ ^ true ]] ].
	^ false.! !

!CompiledMethod methodsFor: 'literals' stamp: 'jmv 12/9/2009 22:53'!
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! !

!CompiledMethod methodsFor: 'literals' stamp: 'eem 4/30/2009 18:03'!
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! !

!CompiledMethod methodsFor: 'literals' stamp: 'dvf 11/12/2002 00:44'!
refersToLiteral:aLiteral

	^self hasLiteral: aLiteral.! !

!CompiledMethod methodsFor: 'literals' stamp: 'dvf 11/12/2002 00:44'!
sendsSelector: aSymbol 

	^ self messages includes: aSymbol! !

!CompiledMethod methodsFor: 'scanning' stamp: 'md 4/27/2006 15:12'!
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! !

!CompiledMethod methodsFor: 'scanning' stamp: 'dvf 11/12/2002 00:44'!
messagesDo: aBlock 

	^ self messages do:aBlock.! !

!CompiledMethod methodsFor: 'source code management' stamp: 'eem 9/5/2009 14:59'!
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: (self qCompress: tempString)! !

!CompiledMethod methodsFor: 'source code management' stamp: 'yo 3/16/2004 12:23'!
getPreambleFrom: aFileStream at: position
	|  writeStream |
	writeStream := String new writeStream.
	position
		to: 0
		by: -1
		do: [:p | 
			| c | 
			aFileStream position: p.
			c := aFileStream basicNext.
			c == $!!
				ifTrue: [^ writeStream contents reverse]
				ifFalse: [writeStream nextPut: c]]! !

!CompiledMethod methodsFor: 'source code management'!
getSource
	^ self getSourceFor: self selector in:self methodClass.! !

!CompiledMethod methodsFor: 'source code management' stamp: 'eem 9/5/2009 15:04'!
getSourceFor: selector in: class
	"Retrieve or reconstruct the source code for this method."
	| flagByte source |
	flagByte := self last.
	(flagByte = 0
		or: [flagByte = 251 "some source-less methods have flag = 251, rest = 0"
			and: [((1 to: 3) allSatisfy: [:i | (self at: self size - i) = 0])]])
		ifTrue:
		["No source pointer -- decompile without temp names"
		^ (class decompilerClass new decompile: selector in: class method: self)
			decompileString].
	flagByte < 252 ifTrue:
		["Magic sources -- decompile with temp names"
		^ ((class decompilerClass new withTempNames: self tempNamesString)
				decompile: selector in: class method: self)
			decompileString].

	"Situation normal;  read the sourceCode from the file"
	
	source := [self getSourceFromFile]
				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
		ifNotNil:
			[| sourceSelector |
			"I think this is something to do with the traits system.  It would be ncie if someone
			 documented this.  It looks like an egregious hack to me. eem 9/5/2009 09:04"
			 sourceSelector := Parser parserClass new parseSelector: source.
			 sourceSelector = selector
				ifTrue: [source]
				ifFalse: [self replace: sourceSelector with: selector in: source]]
		ifNil:
			["Something really wrong -- decompile blind (no temps)"
			 (class decompilerClass new decompile: selector in: class method: self)
				decompileString]! !

!CompiledMethod methodsFor: 'source code management' stamp: 'eem 5/29/2009 12:16'!
holdsTempNames
	"Are tempNames stored in trailer bytes"

	| flagByte |
	flagByte := self last.
	(flagByte = 0 or: [flagByte = 251 "some source-less methods have flag = 251, rest = 0"
			and: [(1 to: 3) allSatisfy: [:i | (self at: self size - i) = 0]]])
		ifTrue: [^ false].  "No source pointer & no temp names"
	flagByte < 252 ifTrue: [^ true].  "temp names compressed"
	^ false	"Source pointer"
! !

!CompiledMethod methodsFor: 'source code management' stamp: 'md 6/2/2006 10:34'!
linesOfCode
	"An approximate measure of lines of code.
	Includes comments, but excludes blank lines."
	| strm line lines |
	lines := 0.
	strm := ReadStream on: self getSource.
		[strm atEnd] whileFalse:
			[line := strm upTo: Character cr.
			line isEmpty ifFalse: [lines := lines+1]].
	^lines ! !

!CompiledMethod methodsFor: 'source code management' stamp: 'jmv 12/9/2009 22:56'!
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 become: (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! !

!CompiledMethod methodsFor: 'source code management' stamp: 'md 1/20/2006 16:36'!
setMySourcePointer: srcPointer

	srcPointer = 0 ifTrue: [
		self at: self size put: 0.
		^self].
	(srcPointer between: 16r1000000 and: 16r4FFFFFF) ifFalse: [self error: 'Source pointer out of range'].
	self at: self size put: (srcPointer bitShift: -24) + 251.
	1 to: 3 do: [:i |
		self at: self size-i put: ((srcPointer bitShift: (i-3)*8) bitAnd: 16rFF)]! !

!CompiledMethod methodsFor: 'source code management' stamp: 'ajh 8/13/2002 18:19'!
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]! !

!CompiledMethod methodsFor: 'source code management' stamp: 'md 8/2/2006 20:25'!
sourceSelector
	"Answer my selector extracted from my source.  If no source answer nil"

	| sourceString |
	sourceString := self getSourceFromFile ifNil: [^ nil].
	^self methodClass parserClass new parseSelector: sourceString! !

!CompiledMethod methodsFor: 'file in/out' stamp: 'yo 10/28/2004 22:38'!
objectForDataStream: refStrm
	
	self primitive = 117 ifTrue: [self literals first at: 4 put: 0].
! !

!CompiledMethod methodsFor: 'decompiling' stamp: 'eem 4/30/2009 18:13'!
compilerClass
	^self methodClass 
		ifNil: [Compiler] 
		ifNotNil: [:class | class compilerClass].! !

!CompiledMethod methodsFor: 'decompiling' stamp: 'md 2/16/2006 17:08'!
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.! !

!CompiledMethod methodsFor: 'decompiling' stamp: 'md 2/22/2006 15:59'!
decompileWithTemps
	"Return the decompiled parse tree that represents self, but get the temp names
	 by compiling the sourcecode..."

	|  class selector |
	class := self methodClass ifNil: [Object].
	selector := self selector ifNil: [self defaultSelector].

	(self fileIndex > 0 and: [(SourceFiles at: self fileIndex) isNil]) ifTrue: [
			"Emergency or no source file -- decompile without temp names "
			^self decompile.
	].
	^((self decompilerClass new withTempNames: self methodNode tempNames)
						decompile: selector
						in: class
						method: self)! !

!CompiledMethod methodsFor: 'decompiling' stamp: 'eem 9/5/2009 14:17'!
decompilerClass
	^self compilerClass decompilerClass! !

!CompiledMethod methodsFor: 'decompiling' stamp: 'eem 7/6/2009 15:57'!
methodNode
	"Return the parse tree that represents self"
	| aClass source |
	aClass := self methodClass.
	source := self
				getSourceFor: (self selector ifNil: [self defaultSelector])
				in: aClass.
	^(aClass parserClass new
		encoderClass: (self isBlueBookCompiled
						ifTrue: [EncoderForV3]
						ifFalse: [EncoderForV3PlusClosures]);
		parse: source class: aClass)
			sourceText: source;
			yourself! !

!CompiledMethod methodsFor: 'decompiling' stamp: 'md 2/19/2006 23:30'!
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 parserClass new parse: source class: class.
	node sourceText: source.
	^node! !

!CompiledMethod methodsFor: 'decompiling' stamp: 'eem 4/30/2009 18:14'!
parserClass
	^self methodClass 
		ifNil: [Compiler parserClass] 
		ifNotNil: [:class | class parserClass].! !

!CompiledMethod methodsFor: 'private' stamp: 'al 2/13/2006 17:44'!
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.

	Marker methods compile to bytecode like:

		9 <70> self
		10 <D0> send: <literal 1>
		11 <87> pop
		12 <78> returnSelf

	for the first form, or 

		9 <70> self
		10 <D0> send: <literal 1>
		11 <7C> returnTop

	for the second form."

	| e |
	((e := self endPC) = 19 or: [e = 20]) ifFalse: [^ nil].
	(self numLiterals = 3) ifFalse:[^ nil].
	(self at: 17) =  16r70 ifFalse:[^ nil].		"push self"
	(self at: 18) = 16rD0 ifFalse:[^ nil].		"send <literal 1>"
	"If we reach this point, we have a marker method that sends self <literal 1>"
	^ self literalAt: 1
! !

!CompiledMethod methodsFor: 'private' stamp: 'md 8/2/2006 20:25'!
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 parserClass new
		parseArgsAndTemps: aText string notifying: nil) copyFrom: 1 to: self numArgs.
	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)! !

!CompiledMethod methodsFor: '*Morphic-Explorer' stamp: 'eem 5/15/2008 13:14'!
explorerContents
	"(CompiledMethod compiledMethodAt: #explorerContents) explore"
	
	^Array streamContents:
		[:s| | tokens |
		tokens := Scanner new scanTokens: (self headerDescription readStream skipTo: $"; upTo: $").
		s nextPut: (ObjectExplorerWrapper
						with: ((0 to: tokens size by: 2) collect:
								[:i| i = 0 ifTrue: [self header] ifFalse: [{tokens at: i - 1. tokens at: i}]])
						name: 'header'
						model: self).
		(1 to: self numLiterals) do:
			[:key|
			s nextPut: (ObjectExplorerWrapper
							with: (self literalAt: key)
							name: ('literal', key printString contractTo: 32)
							model: self)].
		self isQuick
			ifTrue: [s nextPut: (ObjectExplorerWrapper
									with: self symbolic
									name: #symbolic
									model: self)]
			ifFalse:
				[self symbolicLinesDo:
					[:pc :line|
					pc <= 1
						ifTrue:
							[s nextPut: (ObjectExplorerWrapper
											with: line
											name: 'pragma'
											model: self)]
						ifFalse:
							[s nextPut: (ObjectExplorerWrapper
											with: line
											name: pc printString
											model: self)]]].
				"should be self numLiterals + 1 * Smalltalk wordSize + 1"
		self endPC + 1
			to: self basicSize
			do: [:key|
				s nextPut: (ObjectExplorerWrapper
								with: (self basicAt: key)
								name: key printString
								model: self)]]! !

!CompiledMethod methodsFor: 'closures' stamp: 'md 1/20/2006 16:10'!
allEmbeddedBlockMethods

	| set |
	set := OrderedCollection new.
	1 to: self numLiterals do: [:i |  | lit |
		lit := self literalAt: i.
		(lit isKindOf: CompiledMethod) ifTrue: [
			set add: lit.
			set addAll: lit allEmbeddedBlockMethods.
		] ifFalse: [(lit isKindOf: BlockClosure) ifTrue: [
			set add: lit method.
			set addAll: lit method allEmbeddedBlockMethods
		]].
	].
	^ set! !

!CompiledMethod methodsFor: 'closures' stamp: 'md 1/20/2006 16:01'!
containsBlockClosures

	^ self embeddedBlockMethods size > 0! !

!CompiledMethod methodsFor: 'closures' stamp: 'md 1/20/2006 16:00'!
embeddedBlockMethods

	| set |
	set := OrderedCollection new.
	1 to: self numLiterals do: [:i |  | lit |
		lit := self literalAt: i.
		(lit isKindOf: CompiledMethod) ifTrue: [
			set add: lit.
		] ifFalse: [(lit isKindOf: BlockClosure) ifTrue: [
			set add: lit method.
		]].
	].
	^ set! !

!CompiledMethod methodsFor: 'closures' stamp: 'md 1/20/2006 16:08'!
isBlockMethod
	"Is this a sub-method (embedded block's method) of another method. If so the last literal points to its outer method"

	^ (self header bitAnd: 1 << 29) ~= 0! !

!CompiledMethod methodsFor: 'closures' stamp: 'md 1/20/2006 16:08'!
isBlockMethod: bool
	"Use the sign bit in the header to mark methods that are sub-methods of an outer method. The outer method will be held in my last literal."

	self objectAt: 1 put: (bool
		ifTrue: [self header bitOr: 1 << 29]
		ifFalse: [self header bitAnd: (1 << 29) bitInvert])! !

!CompiledMethod methodsFor: 'closures' stamp: 'md 1/20/2006 16:09'!
isClosureCompiled: bool
	"Use the sign bit in the header to mark methods that have been compiled using the new closure compiler (Parser2)."

	self objectAt: 1 put: (bool
		ifTrue: [(self header bitOr: 1 << 30) as31BitSmallInt]
		ifFalse: [(self header bitAnd: (1 << 30) bitInvert) as31BitSmallInt])! !

!CompiledMethod methodsFor: 'closures' stamp: 'md 1/20/2006 16:09'!
method
	"polymorphic with closure"

	^ self! !

!CompiledMethod methodsFor: 'closures' stamp: 'md 1/20/2006 16:09'!
remoteReturns
	"For closure methods only"

	^ self messages includes: #privRemoteReturnTo:! !

!CompiledMethod methodsFor: 'closures' stamp: 'md 1/20/2006 16:56'!
searchImageForHomeMethod

	Smalltalk allObjectsDo: [:obj |
		obj class == CompiledMethod ifTrue: [
			(obj pointsTo: self) ifTrue: [^ obj searchImageForHomeMethod]
		] ifFalse: [obj class == BlockClosure ifTrue: [
			(obj method == self and: [obj size = 0])
				ifTrue: [^ obj searchImageForHomeMethod]
		]]
	].
	^ self  "must be a loner block method"! !

!CompiledMethod methodsFor: '*Tools-Inspector' stamp: 'ar 9/27/2005 18:32'!
inspectorClass
	"Answer the class of the inspector to be used on the receiver.  Called by inspect; 
	use basicInspect to get a normal (less useful) type of inspector."

	^ CompiledMethodInspector! !


!CompiledMethod class methodsFor: 'instance creation' stamp: 'NS 12/12/2003 15:03'!
newFrom: aCompiledMethod
	| inst |
	inst := super basicNew: aCompiledMethod size.
	1 to: aCompiledMethod size do: [:index |
		inst at: index put: (aCompiledMethod at: index)].
	^ inst.! !

!CompiledMethod class methodsFor: 'instance creation' stamp: 'NS 12/12/2003 15:08'!
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! !

!CompiledMethod class methodsFor: 'constants' stamp: 'NS 12/12/2003 15:17'!
abstractMarkers
	^ #(subclassResponsibility shouldNotImplement)! !

!CompiledMethod class methodsFor: 'constants' stamp: 'al 1/23/2004 13:11'!
conflictMarker
	^ #traitConflict! !

!CompiledMethod class methodsFor: 'constants' stamp: 'al 1/23/2004 13:11'!
disabledMarker
	^ #shouldNotImplement! !

!CompiledMethod class methodsFor: 'constants' stamp: 'al 1/23/2004 13:11'!
explicitRequirementMarker
	^ #explicitRequirement! !

!CompiledMethod class methodsFor: 'constants' stamp: 'al 1/23/2004 13:11'!
implicitRequirementMarker
	^ #requirement! !

!CompiledMethod class methodsFor: 'constants' stamp: 'al 1/23/2004 13:11'!
subclassResponsibilityMarker
	^ #subclassResponsibility! !


!SmalltalkEditor methodsFor: 'compatibility' stamp: 'jmv 12/9/2009 22:51'!
select
	"do nothing"! !


!SyntaxErrorNotification methodsFor: 'accessing' stamp: 'ar 9/27/2005 19:17'!
category
	^category! !

!SyntaxErrorNotification methodsFor: 'accessing' stamp: 'ar 9/27/2005 19:11'!
doitFlag
	^doitFlag! !

!SyntaxErrorNotification methodsFor: 'accessing' stamp: 'ar 9/27/2005 19:10'!
errorClass
	^inClass! !

!SyntaxErrorNotification methodsFor: 'accessing' stamp: 'ar 9/27/2005 19:10'!
errorCode
	^code! !

!SyntaxErrorNotification methodsFor: 'accessing' stamp: 'ar 9/27/2005 19:14'!
messageText
	^ super messageText
		ifNil: [messageText := code]! !

!SyntaxErrorNotification methodsFor: 'accessing' stamp: 'ar 9/27/2005 19:15'!
setClass: aClass category: aCategory code: codeString doitFlag: aBoolean
	inClass := aClass.
	category := aCategory.
	code := codeString.
	doitFlag := aBoolean ! !

!SyntaxErrorNotification methodsFor: 'exceptionDescription' stamp: 'jmv 12/9/2009 23:02'!
defaultAction

	"Handle a syntax error"
	| notifier |
	notifier :=  SyntaxError new
		setClass: self errorClass
		code: self errorCode
		debugger: (Debugger context: self signalerContext)
		doitFlag: self doitFlag.
	notifier category: self category.
	SyntaxError open: notifier.! !


!SyntaxErrorNotification class methodsFor: 'exceptionInstantiator' stamp: 'ar 9/27/2005 19:15'!
inClass: aClass category: aCategory withCode: codeString doitFlag: doitFlag 
	^ (self new
		setClass: aClass
		category: aCategory 
		code: codeString
		doitFlag: doitFlag) signal! !

SyntaxErrorNotification class removeSelector: #inClass:withCode:doitFlag:!
SyntaxErrorNotification removeSelector: #setClass:code:debugger:doitFlag:!
SyntaxErrorNotification removeSelector: #syntaxError!

!SmalltalkEditor reorganize!
('editing keys' browseIt: browseItHere: doIt: exploreIt: fileItIn: implementorsOfIt: inspectIt: methodNamesContainingIt: methodStringsContainingIt: pasteInitials: printIt: referencesToIt: save: sendersOfIt: spawnIt:)
('do-its' compileSelectionFor:in: debug:receiver:in: debugIt doIt evaluateSelection exploreIt inspectIt printIt)
('menu messages' browseChangeSetsWithSelector browseClassFromIt browseIt browseItHere classCommentsContainingIt classNamesContainingIt explain fileItIn implementorsOfIt methodNamesContainingIt methodSourceContainingIt methodStringsContainingit prettyPrint referencesToIt selectedSelector selectedSymbol sendersOfIt spawn)
('typing/selecting keys' argAdvance: displayIfFalse: displayIfTrue: doAgainOnce: querySymbol:)
('explain' explainAnySel: explainChar: explainClass: explainCtxt: explainGlobal: explainInst: explainMySel: explainNumber: explainPartSel: explainScan: explainTemp:)
('new selection' nextTokenFrom:direction: notify:at:in: selectPrecedingIdentifier)
('private' completeSymbol:lastOffering:)
('undoers' undoQuery:lastOffering:)
('compatibility' select)
!

