'From Cuis 1.0 of 28 November 2009 [latest update: #337] on 8 December 2009 at 10:21:29 am'!

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

	self objectAt: 1 put: (self header bitAnd: (1 << 29) bitInvert)! !

!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: 'eem 11/29/2008 11:38'!
methodClassAssociation
	"answer the association to the class that I am installed in, or nil if none."
	^self literalAt: self numLiterals! !

!CompiledMethod methodsFor: 'accessing' stamp: 'eem 11/28/2008 12:58'!
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]! !

!CompiledMethod methodsFor: 'testing' stamp: 'eem 11/29/2008 11:28'!
hasNewPropertyFormat
	"As of the closure compiler all methods have (or better have) the new
	 format where the penultimate literal is either the method's selector
	 or its properties and the ultimate literal is the class association."
	^true! !

!CompiledMethod methodsFor: 'testing' stamp: 'eem 7/29/2008 16:51'!
isBlueBookCompiled
	"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 create old BlockClosures or use the new BlockClosure bytecodes.
	 It cannot tell if a method which uses neither the old nor the new block
	 bytecodes is compiled with the blue-book compiler or the new compiler.
	 But since methods that don't create blocks have essentially the same
	 code when compiled with either compiler this makes little difference."

	^((InstructionStream on: self) scanFor:
		[:instr |
		(instr >= 138 and: [instr <= 143]) ifTrue: [^false].
		instr = 200])
	   or: [(self hasLiteral: #blockCopy:)
		   and: [self messages includes: #blockCopy:]]! !

!CompiledMethod methodsFor: 'testing' stamp: 'eem 12/1/2008 11:14'!
isInstalled
	self methodClass ifNotNil:
		[:class|
		self selector ifNotNil:
			[:selector|
			^self == (class methodDict at: selector ifAbsent: [])]].
	^false! !

!CompiledMethod methodsFor: 'testing' stamp: 'eem 6/4/2008 16:19'!
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."

	^(InstructionStream on: self) scanFor: [:instr | instr >= 138 and: [instr <= 143]]! !

!CompiledMethod methodsFor: 'printing' stamp: 'eem 5/15/2008 11:04'!
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! !

!CompiledMethod methodsFor: 'printing' stamp: 'eem 5/15/2008 10:57'!
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.
! !

!CompiledMethod methodsFor: 'printing' stamp: 'eem 1/19/2009 10:28'!
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! !

!CompiledMethod methodsFor: 'printing' stamp: 'eem 5/29/2008 13:59'!
symbolicLinesDo: aBlock
	"Evaluate aBlock with each of the lines in the symbolic output."

	| aStream pc |
	aStream := ReadWriteStream on: (String new: 64).
	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]! !

!CompiledMethod methodsFor: 'literals' stamp: 'eem 5/6/2008 11:28'!
allLiterals
	^self literals! !

!CompiledMethod methodsFor: 'literals' stamp: 'eem 11/29/2008 11:38'!
indexOfLiteral: literal
	"Answer the literal index of the argument, literal, or zero if none."
	2 to: self numLiterals - 1 "exclude superclass + selector/properties"
	   do:
		[:index |
		literal == (self objectAt: index) ifTrue: [^index - 1]].
	^0! !

!CompiledMethod methodsFor: 'literals' stamp: 'eem 10/28/2008 10:47'!
literalsDo: aBlock
	"Evaluate aBlock for each of the literals referenced by the receiver."
	1 to: self numLiterals do:
		[:index |
		aBlock value: (self objectAt: index + 1)]! !

!CompiledMethod methodsFor: 'scanning' stamp: 'eem 12/13/2008 15:48'!
messagesSequence
	"Answer a Set of all the message selectors sent by this method."

	^Array streamContents:
		[:str| | scanner |
		scanner := InstructionStream on: self.
		scanner	scanFor: 
			[:x | | selectorOrSelf |
			(selectorOrSelf := scanner selectorToSendOrSelf) == scanner ifFalse:
				[str nextPut: selectorOrSelf].
			false	"keep scanning"]]! !

!CompiledMethod methodsFor: 'source code management' stamp: 'eem 6/8/2009 14:32'!
copyWithTempsFromMethodNode: aMethodNode
	^self copyWithTrailerBytes: (self qCompress: aMethodNode schematicTempNamesString)! !

!CompiledMethod methodsFor: 'source code management' stamp: 'eem 7/21/2009 13:26'!
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.
	 CompiledMethod>>endPC determines the maximum length of encoded
	 output, which means 1 to (251 - 128) * 128 + 127, or 15871 bytes"
	string isEmpty ifTrue:
		[^self qCompress: ' '].
	^ ByteArray streamContents:
		[:strm | | ix oddNibble sz |
		oddNibble := nil.
		string do:
			[:char |
			ix := 'ear tonsilcmbdfghjkpquvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ012345[]()'
					indexOf: char ifAbsent: 0.
			(ix = 0
				ifTrue:
					[char asInteger > 255 ifTrue: [^nil]. "Could use UTF8 here; too lazy right now"
					{ 0. char asInteger // 16. char asInteger \\ 16 }]
				ifFalse:
					[ix <= 11
						ifTrue: [{ ix }]
						ifFalse: [{ ix//16+12. ix\\16 }]])
					do: [:nibble |
						oddNibble
							ifNotNil: [strm nextPut: oddNibble*16 + nibble. oddNibble := nil]
							ifNil: [oddNibble := nibble]]].
		oddNibble ifNotNil: "4 = 'ear tonsil' indexOf: Character space"
			[strm nextPut: oddNibble * 16 + 4].
		(sz := strm position) > ((251 - 128) * 128 + 127) ifTrue:
			[^nil].
		sz <= 127
			ifTrue: [strm nextPut: sz]
			ifFalse:
				[strm nextPut: sz \\ 128; nextPut: sz // 128 + 128]]! !

!CompiledMethod methodsFor: 'source code management' stamp: 'eem 6/5/2009 18:07'!
qDecompressFrom: input "<ReadStream on: ByteArray> ^<String>"
	"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"
	^ String streamContents:
		[:strm | | nextNibble nibble peek charTable char |
		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)]]]]! !

!CompiledMethod methodsFor: 'source code management' stamp: 'eem 6/8/2009 10:29'!
tempNamesString
	"Decompress the encoded temp names into a schematicTempNames string."
	| sz flagByte |
	flagByte := self at: (sz := self size).
	(flagByte = 0 or: [flagByte > 251]) ifTrue: [^self error: 'not yet implemented'].
	(flagByte = 251
	 and: [(1 to: 3) allSatisfy: [:i | (self at: self size - i) = 0]]) ifTrue:
		[^self error: 'not yet implemented'].
	^self qDecompressFrom: (flagByte <= 127
								ifTrue:
									[ReadStream on: self from: sz - flagByte to: sz - 1]
								ifFalse:
									[ReadStream on: self from: sz - (flagByte - 128 * 128 + (self at: sz - 1)) - 1 to: sz - 2])! !

!CompiledMethod methodsFor: 'private' stamp: 'eem 11/29/2008 11:10'!
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]! !

!CompiledMethod methodsFor: 'private' stamp: 'eem 11/29/2008 11:52'!
penultimateLiteral: anObject
	"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 put: anObject]
		ifFalse: [self error: 'insufficient literals']! !

!CompiledMethod methodsFor: 'accessing-pragmas & properties' stamp: 'eem 12/1/2008 16:58'!
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]! !

!CompiledMethod methodsFor: 'accessing-pragmas & properties' stamp: 'eem 11/29/2008 16:36'!
pragmas
	| selectorOrProperties |
	^(selectorOrProperties := self penultimateLiteral) isMethodProperties
		ifTrue: [selectorOrProperties pragmas]
		ifFalse: [#()]! !

!CompiledMethod methodsFor: 'accessing-pragmas & properties' stamp: 'eem 11/29/2008 17:33'!
propertyKeysAndValuesDo: aBlock
	"Enumerate the receiver with all the keys and values."

	| propertiesOrSelector |
	(propertiesOrSelector := self penultimateLiteral) isMethodProperties ifTrue:
		[propertiesOrSelector propertyKeysAndValuesDo: aBlock]! !

!CompiledMethod methodsFor: 'accessing-pragmas & properties' stamp: 'eem 11/29/2008 11:45'!
propertyValueAt: propName
	| propertiesOrSelector |
	^(propertiesOrSelector := self penultimateLiteral) isMethodProperties
		ifTrue: [propertiesOrSelector propertyValueAt: propName ifAbsent: [nil]]
		ifFalse: [nil]! !

!CompiledMethod methodsFor: 'accessing-pragmas & properties' stamp: 'eem 11/29/2008 11:50'!
propertyValueAt: propName ifAbsent: aBlock
	| propertiesOrSelector |
	^(propertiesOrSelector := self penultimateLiteral) isMethodProperties
		ifTrue: [propertiesOrSelector propertyValueAt: propName ifAbsent: aBlock]
		ifFalse: [aBlock value]! !

!CompiledMethod methodsFor: 'accessing-pragmas & properties' stamp: 'eem 11/30/2008 08:55'!
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: ((AdditionalMethodState
									selector: propertiesOrSelector
									with: (Association
											key: propName asSymbol
											value: propValue))
									setMethod: self;
									yourself).
		^propValue].
	(propertiesOrSelector includesProperty: propName) ifTrue:
		[^propertiesOrSelector at: propName put: propValue].
	self penultimateLiteral: (propertiesOrSelector
								copyWith: (Association
												key: propName asSymbol
												value: propValue)).
	^propValue! !

!CompiledMethod methodsFor: 'accessing-pragmas & properties' stamp: 'eem 12/1/2008 11:02'!
removeProperty: propName
	"Remove the property propName if it exists.
	 Do _not_ raise an error if the property is missing."
	| value |
	value := self propertyValueAt: propName ifAbsent: [^nil].
	self penultimateLiteral: (self penultimateLiteral copyWithout:
									(Association
										key: propName
										value: value)).
	^value! !

!CompiledMethod methodsFor: 'accessing-pragmas & properties' stamp: 'eem 12/1/2008 11:02'!
removeProperty: propName ifAbsent: aBlock
	"Remove the property propName if it exists.
	 Answer the evaluation of aBlock if the property is missing."
	| value |
	value := self propertyValueAt: propName ifAbsent: [^aBlock value].
	self penultimateLiteral: (self penultimateLiteral copyWithout:
									(Association
										key: propName
										value: value)).
	^value! !

!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)]]! !


!InstructionClient methodsFor: 'instruction decoding' stamp: 'eem 5/31/2008 13:51'!
popIntoRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
	"Remove Top Of Stack And Store Into Offset of Temp Vector bytecode."! !

!InstructionClient methodsFor: 'instruction decoding' stamp: 'eem 5/31/2008 13:49'!
pushClosureCopyNumCopiedValues: numCopied numArgs: numArgs blockSize: blockSize
	"Push Closure bytecode."
! !

!InstructionClient methodsFor: 'instruction decoding' stamp: 'eem 6/16/2008 14:26'!
pushConsArrayWithElements: numElements
	"Push Cons Array of size numElements popping numElements items from the stack into the array bytecode."
! !

!InstructionClient methodsFor: 'instruction decoding' stamp: 'eem 5/31/2008 13:50'!
pushNewArrayOfSize: numElements 
	"Push New Array of size numElements bytecode."
! !

!InstructionClient methodsFor: 'instruction decoding' stamp: 'eem 5/31/2008 13:54'!
pushRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
	"Push Contents at Offset in Temp Vector bytecode."! !

!InstructionClient methodsFor: 'instruction decoding' stamp: 'eem 5/31/2008 13:52'!
storeIntoRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
	"Store Top Of Stack And Store Into Offset of Temp Vector bytecode."! !


!InstructionPrinter methodsFor: 'accessing' stamp: 'eem 5/29/2008 13:50'!
printPC
	^printPC! !

!InstructionPrinter methodsFor: 'accessing' stamp: 'eem 5/29/2008 13:50'!
printPC: aBoolean
	printPC := aBoolean! !

!InstructionPrinter methodsFor: 'initialize-release' stamp: 'eem 8/4/2008 16:26'!
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]! !

!InstructionPrinter methodsFor: 'instruction decoding' stamp: 'eem 5/25/2008 14:06'!
popIntoRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
	self print: 'popIntoTemp: ', remoteTempIndex printString, ' inVectorAt: ', tempVectorIndex printString! !

!InstructionPrinter methodsFor: 'instruction decoding' stamp: 'eem 6/16/2008 14:04'!
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! !

!InstructionPrinter methodsFor: 'instruction decoding' stamp: 'eem 5/30/2008 17:42'!
pushConsArrayWithElements: numElements 
	self print: 'pop ', numElements printString, ' into (Array new: ', numElements printString, ')'! !

!InstructionPrinter methodsFor: 'instruction decoding' stamp: 'eem 5/25/2008 15:02'!
pushNewArrayOfSize: numElements 
	self print: 'push: (Array new: ', numElements printString, ')'! !

!InstructionPrinter methodsFor: 'instruction decoding' stamp: 'eem 5/25/2008 00:00'!
pushRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex 
	self print: 'pushTemp: ', remoteTempIndex printString, ' inVectorAt: ', tempVectorIndex printString! !

!InstructionPrinter methodsFor: 'instruction decoding' stamp: 'eem 5/25/2008 14:06'!
storeIntoRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex 
	self print: 'storeIntoTemp: ', remoteTempIndex printString, ' inVectorAt: ', tempVectorIndex printString! !


!InstructionStream methodsFor: 'decoding' stamp: 'eem 9/29/2008 11:59'!
interpretJumpIfCond

	| byte |
	byte := self method at: pc.
	(byte between: 152 and: 159) ifTrue:
		[pc := pc + 1. ^byte - 151].
	(byte between: 168 and: 175) ifTrue:
		[pc := pc + 2. ^(byte bitAnd: 3) * 256 + (self method at: pc - 1)].
	^nil! !

!InstructionStream methodsFor: 'decoding' stamp: 'md 1/20/2006 17:19'!
interpretNextInstructionFor: 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:
	The old, cleaner but slowe code is retained as a comment below"
	type < 8
	ifTrue: [type < 4
				ifTrue: [type < 2
						ifTrue: [type < 1
								ifTrue: ["type = 0"
									^ client pushReceiverVariable: offset]
								ifFalse: ["type = 1"
									^ client pushTemporaryVariable: offset]]
						ifFalse: [type < 3
								ifTrue: ["type = 2"
									^ client
										pushConstant: (method literalAt: offset + 1)]
								ifFalse: ["type = 3"
									^ client
										pushConstant: (method literalAt: offset + 17)]]]
				ifFalse: [type < 6
						ifTrue: [type < 5
								ifTrue: ["type = 4"
									^ client
										pushLiteralVariable: (method literalAt: offset + 1)]
								ifFalse: ["type = 5"
									^ client
										pushLiteralVariable: (method literalAt: offset + 17)]]
						ifFalse: [type < 7
								ifTrue: ["type = 6"
									offset < 8
										ifTrue: [^ client popIntoReceiverVariable: offset]
										ifFalse: [^ client popIntoTemporaryVariable: offset - 8]]
								ifFalse: ["type = 7"
									offset = 0
										ifTrue: [^ client pushReceiver].
									offset < 8
										ifTrue: [^ client
												pushConstant: (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].
									offset > 13
										ifTrue: [^ self error: 'unusedBytecode']]]]]
		ifFalse: [type < 12
				ifTrue: [type < 10
						ifTrue: [type < 9
								ifTrue: ["type = 8"
									^ self
										interpretExtension: offset
										in: method
										for: client]
								ifFalse: ["type = 9 (short jumps)"
									offset < 8
										ifTrue: [^ client jump: offset + 1].
									^ client jump: offset - 8 + 1 if: false]]
						ifFalse: [type < 11
								ifTrue: ["type = 10 (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]
								ifFalse: ["type = 11"
									^ client
										send: (Smalltalk specialSelectorAt: offset + 1)
										super: false
										numArgs: (Smalltalk specialNargsAt: offset + 1)]]]
				ifFalse: [type = 12
						ifTrue: [^ client
								send: (Smalltalk specialSelectorAt: offset + 17)
								super: false
								numArgs: (Smalltalk specialNargsAt: offset + 17)]
						ifFalse: ["type = 13, 14 or 15"
							^ client
								send: (method literalAt: offset + 1)
								super: false
								numArgs: type - 13]]].


"    old code 
	type=0 ifTrue: [^client pushReceiverVariable: offset].
	type=1 ifTrue: [^client pushTemporaryVariable: offset].
	type=2 ifTrue: [^client pushConstant: (method literalAt: offset+1)].
	type=3 ifTrue: [^client pushConstant: (method literalAt: offset+17)].
	type=4 ifTrue: [^client pushLiteralVariable: (method literalAt: offset+1)].
	type=5 ifTrue: [^client pushLiteralVariable: (method literalAt: offset+17)].
	type=6 
		ifTrue: [offset<8
					ifTrue: [^client popIntoReceiverVariable: offset]
					ifFalse: [^client popIntoTemporaryVariable: offset-8]].
	type=7
		ifTrue: [offset=0 ifTrue: [^client pushReceiver].
				offset<8 ifTrue: [^client pushConstant: (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].
				offset>13 ifTrue: [^self error: 'unusedBytecode']].
	type=8 ifTrue: [^self interpretExtension: offset in: method for: client].
	type=9
		ifTrue:  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 
		ifTrue: 
			[^client 
				send: (Smalltalk specialSelectorAt: offset+1) 
				super: false
				numArgs: (Smalltalk specialNargsAt: offset+1)].
	type=12 
		ifTrue: 
			[^client 
				send: (Smalltalk specialSelectorAt: offset+17) 
				super: false
				numArgs: (Smalltalk specialNargsAt: offset+17)].
	type>12
		ifTrue: 
			[^client send: (method literalAt: offset+1) 
					super: false
					numArgs: type-13]"! !

!InstructionStream methodsFor: 'scanning' stamp: 'eem 6/16/2008 09:52'!
firstByte
	"Answer the first byte of the current bytecode."

	^self method at: pc! !

!InstructionStream methodsFor: 'scanning' stamp: 'eem 6/16/2008 09:53'!
fourthByte
	"Answer the fourth byte of the current bytecode."

	^self method at: pc + 3! !

!InstructionStream methodsFor: 'scanning' stamp: 'eem 6/16/2008 09:52'!
secondByte
	"Answer the second byte of the current bytecode."

	^self method at: pc + 1! !

!InstructionStream methodsFor: 'scanning' stamp: 'eem 6/4/2008 10:57'!
selectorToSendOrSelf
	"If this instruction is a send, answer the selector, otherwise answer self."

	| byte byte2 |
	byte := self method at: pc.
	byte < 131 ifTrue: [^self].
	byte >= 176
		ifTrue: 
			["special byte or short send"
			byte >= 208
				ifTrue: [^self method literalAt: (byte bitAnd: 15) + 1]
				ifFalse: [^Smalltalk specialSelectorAt: byte - 176 + 1]]
		ifFalse: 
			[byte <= 134 ifTrue: 
				[byte2 := self method at: pc + 1.
				 byte = 131 ifTrue: [^self method literalAt: byte2 \\ 32 + 1].
				 byte = 132 ifTrue: [byte2 < 64 ifTrue: [^self method literalAt: (self method at: pc + 2) + 1]].
				 byte = 133 ifTrue: [^self method literalAt: byte2 \\ 32 + 1].
				 byte = 134 ifTrue: [^self method literalAt: byte2 \\ 64 + 1]]]! !

!InstructionStream methodsFor: 'private' stamp: 'eem 6/16/2008 09:49'!
interpretExtension: 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)].
			type = 5 ifTrue: [^client storeIntoReceiverVariable: byte3].
			type = 6 ifTrue: [^client popIntoReceiverVariable: byte3].
			type = 7 ifTrue: [^client storeIntoLiteralVariable: (method literalAt: byte3 + 1)]].
		offset = 5 ifTrue:  "Single extended send to super"
			[^client send: (method literalAt: byte2 \\ 32 + 1)
					super: true numArgs: byte2 // 32].
		offset = 6 ifTrue:   "Second extended send"
			[^client send: (method literalAt: byte2 \\ 64 + 1)
					super: false numArgs: byte2 // 64]].
	offset = 7 ifTrue: [^client doPop].
	offset = 8 ifTrue: [^client doDup].
	offset = 9 ifTrue: [^client pushActiveContext].
	byte2 := method at: pc. pc := pc + 1.
	offset = 10 ifTrue:
		[^byte2 < 128
			ifTrue: [client pushNewArrayOfSize: byte2]
			ifFalse: [client pushConsArrayWithElements: byte2 - 128]].
	offset = 11 ifTrue: [^self error: 'unusedBytecode'].
	byte3 := method at: pc.  pc := pc + 1.
	offset = 12 ifTrue: [^client pushRemoteTemp: byte2 inVectorAt: byte3].
	offset = 13 ifTrue: [^client storeIntoRemoteTemp: byte2 inVectorAt: byte3].
	offset = 14 ifTrue: [^client popIntoRemoteTemp: byte2 inVectorAt: byte3].
	"offset = 15"
	byte4 := method at: pc.  pc := pc + 1.
	^client
		pushClosureCopyNumCopiedValues: (byte2 bitShift: -4)
		numArgs: (byte2 bitAnd: 16rF)
		blockSize: (byte3 * 256) + byte4! !

!InstructionStream methodsFor: 'debugger access' stamp: 'eem 6/5/2008 10:28'!
abstractPC
	^self method abstractPCForConcretePC: pc! !

!InstructionStream methodsFor: 'debugger access' stamp: 'eem 6/5/2008 10:45'!
debuggerMap
	^self method debuggerMap! !


!ContextPart methodsFor: 'accessing' stamp: 'eem 6/27/2008 15:55'!
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]! !

!ContextPart methodsFor: 'accessing' stamp: 'eem 6/27/2008 15:57'!
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]! !

!ContextPart methodsFor: 'accessing' stamp: 'eem 6/27/2008 15:56'!
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]! !

!ContextPart methodsFor: 'accessing' stamp: 'eem 6/27/2008 15:57'!
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]! !

!ContextPart methodsFor: 'accessing' stamp: 'eem 6/27/2008 10:45'!
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 primitiveFail! !

!ContextPart methodsFor: 'accessing' stamp: 'eem 6/15/2008 11:31'!
contextForLocalVariables
	"Answer the context in which local variables (temporaries) are stored."

	self subclassResponsibility! !

!ContextPart methodsFor: 'accessing' stamp: 'eem 6/15/2008 11:27'!
methodReturnContext
	"Answer the context from which an ^-return should return from."

	self subclassResponsibility! !

!ContextPart methodsFor: 'accessing' stamp: 'eem 6/27/2008 10:46'!
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 primitiveFail! !

!ContextPart methodsFor: 'instruction decoding' stamp: 'eem 5/27/2008 11:38'!
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 at: tempVectorIndex + 1) at: remoteTempIndex + 1 put: self pop! !

!ContextPart methodsFor: 'instruction decoding' stamp: 'eem 8/29/2008 06:28'!
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
				outerContext: self
				startpc: pc
				numArgs: numArgs
				copiedValues: copiedValues).
	self jump: blockSize! !

!ContextPart methodsFor: 'instruction decoding' stamp: 'eem 5/27/2008 11:32'!
pushNewArrayOfSize: arraySize 
	self push: (Array new: arraySize)! !

!ContextPart methodsFor: 'instruction decoding' stamp: 'eem 5/27/2008 11:44'!
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 at: tempVectorIndex + 1) at: remoteTempIndex + 1)! !

!ContextPart methodsFor: 'instruction decoding' stamp: 'eem 5/27/2008 11:53'!
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 at: tempVectorIndex + 1) at: remoteTempIndex + 1 put: self top! !

!ContextPart methodsFor: 'debugger access' stamp: 'eem 7/17/2008 14:49'!
namedTempAt: index
	"Answer the value of the temp at index in the receiver's sequence of tempNames."
	^self debuggerMap namedTempAt: index in: self! !

!ContextPart methodsFor: 'debugger access' stamp: 'eem 6/24/2008 12:24'!
namedTempAt: index put: aValue
	"Set the value of the temp at index in the receiver's sequence of tempNames.
	 (Note that if the value is a copied value it is also set out along the lexical chain,
	  but alas not in along the lexical chain.)."
	^self debuggerMap namedTempAt: index put: aValue in: self! !

!ContextPart methodsFor: 'debugger access' stamp: 'ar 7/13/2007 16:52'!
print: anObject on: aStream
	"Safely print anObject in the face of direct ProtoObject subclasses"
	| title |
	(anObject class canUnderstand: #printOn:)
		ifTrue:[^anObject printOn: aStream].
	title := anObject class name.
	aStream
		nextPutAll: (title first isVowel ifTrue: ['an '] ifFalse: ['a ']);
		nextPutAll: title! !

!ContextPart methodsFor: 'controlling' stamp: 'eem 8/29/2008 06:27'!
closureCopy: numArgs copiedValues: anArray
	"Distinguish a block of code from its enclosing method by 
	creating a BlockClosure for that block. The compiler inserts into all 
	methods that contain blocks the bytecodes to send the message 
	closureCopy:copiedValues:. Do not use closureCopy:copiedValues: in code that you write!! Only the 
	compiler can decide to send the message closureCopy:copiedValues:. Fail if numArgs is 
	not a SmallInteger. Optional. No Lookup. See Object documentation 
	whatIsAPrimitive."

	<primitive: 200>
	^BlockClosure outerContext: self startpc: pc + 2 numArgs: numArgs copiedValues: anArray! !

!ContextPart methodsFor: 'query' stamp: 'eem 11/26/2008 20:21'!
isContext
	^true! !


!BlockContext methodsFor: 'accessing' stamp: 'eem 5/28/2008 10:43'!
activeHome
	"Search senders for the home context.  If the home
	 context is not found on the sender chain answer nil."
	^self caller findContextSuchThat: [:ctxt | ctxt = home]! !

!BlockContext methodsFor: 'accessing' stamp: 'eem 5/29/2008 13:14'!
caller
	^sender! !

!BlockContext methodsFor: 'accessing' stamp: 'eem 5/24/2008 11:20'!
closureHome
	"Answer the context from which an ^-return should return from."

	^self home! !

!BlockContext methodsFor: 'accessing' stamp: 'eem 6/15/2008 11:32'!
contextForLocalVariables
	"Answer the context in which local variables (temporaries) are stored."

	^home! !

!BlockContext methodsFor: 'accessing' stamp: 'eem 6/15/2008 11:33'!
methodReturnContext
	"Answer the context from which an ^-return should return from."

	^home! !

!BlockContext methodsFor: 'printing' stamp: 'eem 7/28/2008 14:10'!
fullPrintOn: aStream
	aStream print: self; cr.
	(self decompile ifNil: ['--source missing--']) printOn: aStream indent: 0! !


!Message methodsFor: 'accessing' stamp: 'eem 1/3/2009 10:42'!
numArgs
	"Answer the number of arguments in this message"

	^args size! !

!Message methodsFor: 'comparing' stamp: 'eem 11/27/2008 13:17'!
analogousCodeTo: anObject
	"For MethodPropertires comparison."
	^self class == anObject class
	  and: [selector == anObject selector
	  and: [args = anObject arguments
	  and: [lookupClass == anObject lookupClass]]]! !


!MethodContext methodsFor: 'accessing' stamp: 'eem 6/15/2008 11:28'!
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]! !

!MethodContext methodsFor: 'accessing' stamp: 'eem 5/28/2008 10:45'!
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]! !

!MethodContext methodsFor: 'accessing' stamp: 'eem 7/22/2008 11:57'!
closure
	^closureOrNil! !

!MethodContext methodsFor: 'accessing' stamp: 'eem 6/15/2008 11:31'!
contextForLocalVariables
	"Answer the context in which local variables (temporaries) are stored."

	^self! !

!MethodContext methodsFor: 'accessing' stamp: 'eem 4/25/2009 09:50'!
hasMethodReturn
	^closureOrNil hasMethodReturn! !

!MethodContext methodsFor: 'accessing' stamp: 'eem 7/22/2008 11:58'!
methodReturnContext
	"Answer the context from which an ^-return should return from."

	closureOrNil == nil ifTrue:
		[^self].
	^closureOrNil outerContext methodReturnContext! !

!MethodContext methodsFor: 'accessing' stamp: 'eem 7/22/2008 11:58'!
outerContext
	"Answer the context within which the receiver is nested."

	^closureOrNil == nil ifFalse:
		[closureOrNil outerContext]! !

!MethodContext methodsFor: 'private' stamp: 'eem 6/15/2008 11:27'!
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! !

!MethodContext methodsFor: 'private' stamp: 'eem 7/22/2008 12:00'!
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! !

!MethodContext methodsFor: 'instruction decoding (closures)' stamp: 'eem 7/22/2008 11:56'!
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! !

!MethodContext methodsFor: 'instruction decoding (closures)' stamp: 'eem 5/30/2008 18:40'!
pushConsArrayWithElements: numElements 
	| array |
	array := Array new: numElements.
	numElements to: 1 by: -1 do:
		[:i|
		array at: i put: self pop].
	self push: array! !

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

	stackp ~= 0 ifTrue:
		[self error: 'stack pointer should be zero!!'].
	closureOrNil ifNil:
		[self error: 'context needs a closure!!'].
	args do: [:arg| self push: arg].
	1 to: closureOrNil numCopiedValues do:
		[:i|
		self push: (closureOrNil copiedValueAt: i)].
	sender := sendr! !

