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

!MethodDictionary commentStamp: 'jmv 12/9/2009 23:42' prior: 0!
I am just like a normal Dictionary, except that I am implemented differently.  Each Class has an instances of MethodDictionary to hold the correspondence between selectors (names of methods) and methods themselves.

In a normal Dictionary, the instance variable 'array' holds an array of Associations.  Since there are thousands of methods in the system, these Associations waste space.  

Each MethodDictionary is a variable object, with the list of keys (selector Symbols) in the variable part of the instance.  The variable 'array' holds the values, which are CompiledMethods.!


!BlockClosure methodsFor: 'evaluating' stamp: 'ar 7/20/2009 00:14'!
valueSupplyingAnswer: anObject

	^ (anObject isCollection and: [anObject isString not])
		ifTrue: [self valueSupplyingAnswers: {anObject}]
		ifFalse: [self valueSupplyingAnswers: {{'*'. anObject}}]! !

!BlockClosure methodsFor: 'evaluating' stamp: 'ar 7/20/2009 00:14'!
valueSupplyingAnswers: aListOfPairs
	"evaluate the block using a list of questions / answers that might be called upon to
	automatically respond to Object>>confirm: or FillInTheBlank requests"

	^ [self value] 
		on: ProvideAnswerNotification
		do: 
			[:notify | | answer caption |
			
			caption := notify messageText withSeparatorsCompacted. "to remove new lines"
			answer := aListOfPairs
				detect: 
					[:each | caption = each first or:
						[caption includesSubstring: each first caseSensitive: false] or:
						[each first match: caption]]
					ifNone: [nil].
			answer
				ifNotNil: [notify resume: answer second]
				ifNil: 
					[ | outerAnswer |
					outerAnswer := ProvideAnswerNotification signal: notify messageText.
					outerAnswer 
						ifNil: [notify resume] 
						ifNotNil: [notify resume: outerAnswer]]]! !

!BlockClosure methodsFor: 'evaluating' stamp: 'ar 7/20/2009 00:13'!
valueSuppressingAllMessages

	^ self valueSuppressingMessages: #('*')! !

!BlockClosure methodsFor: 'evaluating' stamp: 'ar 7/20/2009 00:14'!
valueSuppressingMessages: aListOfStrings

	^ self
		valueSuppressingMessages: aListOfStrings
		supplyingAnswers: #()! !

!BlockClosure methodsFor: 'evaluating' stamp: 'ar 7/20/2009 00:14'!
valueSuppressingMessages: aListOfStrings supplyingAnswers: aListOfPairs

	^ self valueSupplyingAnswers: aListOfPairs, (aListOfStrings collect: [:each | {each. true}])! !


!InstructionPrinter class methodsFor: 'printing' stamp: 'nice 10/20/2009 21:16'!
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 selectorsDo: 
		[:sel | 
		file cr; nextPutAll: sel; cr.
		(self on: (class compiledMethodAt: sel)) printInstructionsOn: file].
	file close
	"InstructionPrinter printClass: Parser."
! !


!InstructionStream methodsFor: 'decoding' stamp: 'ajh 3/2/2003 14:06'!
interpret

	[self atEnd] whileFalse: [self interpretNextInstructionFor: self]! !


!ContextPart methodsFor: 'accessing' stamp: 'ar 4/11/2006 01:49'!
methodNode
	^ self method methodNode.! !

!ContextPart methodsFor: 'accessing' stamp: 'md 2/17/2006 09:50'!
methodNodeFormattedAndDecorated: decorate
	"Answer a method node made from pretty-printed (and colorized, if decorate is true) 
	 source text."

	^ self method methodNodeFormattedAndDecorated: decorate.! !

!ContextPart methodsFor: 'debugger access' stamp: 'md 2/17/2006 18:41'!
methodClass 
	"Answer the class in which the receiver's method was found."
	
	^self method methodClass ifNil:[self receiver class].! !

!ContextPart methodsFor: '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! !

!ContextPart methodsFor: 'debugger access' stamp: 'md 2/17/2006 18:47'!
selector
	"Answer the selector of the method that created the receiver."

	^self method selector ifNil: [self method defaultSelector].! !

!ContextPart methodsFor: 'debugger access' stamp: 'md 2/22/2006 16:58'!
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."! !

!ContextPart methodsFor: 'controlling' stamp: 'ar 3/4/2009 14:57'!
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.
! !

!ContextPart methodsFor: 'controlling' stamp: 'ar 3/4/2009 14:58'!
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"

	| ctxt unwindBlock |
	self isDead ifTrue: [self cannotReturn: value to: self].
	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.
	^ value
! !

!ContextPart methodsFor: 'printing' stamp: 'md 2/17/2006 15:41'!
printOn: aStream 
	| selector class mclass |
	self method == nil ifTrue: [^ super printOn: aStream].
	class := self receiver class.
	mclass := self methodClass.
	selector := self selector ifNil:[self method defaultSelector].
	aStream nextPutAll: class name.
	mclass == class 
		ifFalse: 
			[aStream nextPut: $(.
			aStream nextPutAll: mclass name.
			aStream nextPut: $)].
	aStream nextPutAll: '>>'.
	aStream nextPutAll: selector.
	selector = #doesNotUnderstand: ifTrue: [
		aStream space.
		(self tempAt: 1) selector printOn: aStream.
	].
! !

!ContextPart methodsFor: 'private-exceptions' stamp: 'ar 3/4/2009 14:59'!
unwindTo: aContext

	| ctx unwindBlock |
	ctx := self.
	[(ctx := ctx findNextUnwindContextUpTo: aContext) isNil] whileFalse: [
		(ctx tempAt: 2) ifNil:[
			ctx tempAt: 2 put: true.
			unwindBlock := ctx tempAt: 1.
			unwindBlock value]
	].
! !

!ContextPart methodsFor: 'private-debugger' stamp: 'tfei 3/19/2000 23:24'!
cachesStack

	^false! !

!ContextPart methodsFor: 'query' stamp: 'md 1/20/2006 16:15'!
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
! !

!ContextPart methodsFor: 'query' stamp: 'md 1/20/2006 16:14'!
findSimilarSender
	"Return the closest sender with the same method, return nil if none found"

	| meth |
	meth := self method.
	^ self sender findContextSuchThat: [:c | c method == meth]! !

!ContextPart methodsFor: 'query' stamp: 'md 1/20/2006 16:14'!
isClosureContext

	^ false! !

!ContextPart methodsFor: '*39Deprecated' stamp: 'ar 7/18/2009 21:09'!
methodSelector
	"Answer the selector of the method that created the receiver."
	self deprecated: 'use #selector'.

	^self selector.
! !


!BlockContext methodsFor: 'accessing' stamp: 'RAH 4/25/2000 19:49'!
argumentCount
	"Answers the number of arguments needed to evaluate the receiver."
	#Valuable.
	^ self numArgs! !

!BlockContext methodsFor: 'accessing' stamp: 'md 4/27/2006 15:14'!
hasInstVarRef
	"Answer whether the receiver references an instance variable."

	| method scanner end printer |

	home ifNil: [^false].
	method := self method.
	end := self endPC.
	scanner := InstructionStream new method: method pc: startpc.
	printer := InstVarRefLocator new.

	[scanner pc <= end] whileTrue: [
		(printer interpretNextInstructionUsing: scanner) ifTrue: [^true].
	].
	^false! !

!BlockContext methodsFor: 'evaluating' stamp: 'cmm 2/16/2003 16:08'!
bench
	"See how many times I can value in 5 seconds.  I'll answer a meaningful description."

	| startTime endTime count |
	count := 0.
	endTime := Time millisecondClockValue + 5000.
	startTime := Time millisecondClockValue.
	[ Time millisecondClockValue > endTime ] whileFalse: [ self value.  count := count + 1 ].
	endTime := Time millisecondClockValue.
	^count = 1
		ifTrue: [ ((endTime - startTime) // 1000) printString, ' seconds.' ]
		ifFalse:
			[ ((count * 1000) / (endTime - startTime)) asFloat printString, ' per second.' ]! !

!BlockContext methodsFor: 'evaluating' stamp: 'jrp 10/10/2004 22:28'!
valueSupplyingAnswer: anObject

	^ (anObject isCollection and: [anObject isString not])
		ifTrue: [self valueSupplyingAnswers: {anObject}]
		ifFalse: [self valueSupplyingAnswers: {{'*'. anObject}}]! !

!BlockContext methodsFor: 'evaluating' stamp: 'md 11/10/2004 18:43'!
valueSupplyingAnswers: aListOfPairs
	"evaluate the block using a list of questions / answers that might be called upon to
	automatically respond to Object>>confirm: or FillInTheBlank requests"

	^ [self value] 
		on: ProvideAnswerNotification
		do: 
			[:notify | | answer caption |
			
			caption := notify messageText withSeparatorsCompacted. "to remove new lines"
			answer := aListOfPairs
				detect: 
					[:each | caption = each first or:
						[caption includesSubstring: each first caseSensitive: false] or:
						[each first match: caption]]
					ifNone: [nil].
			answer
				ifNotNil: [notify resume: answer second]
				ifNil: 
					[ | outerAnswer |
					outerAnswer := ProvideAnswerNotification signal: notify messageText.
					outerAnswer 
						ifNil: [notify resume] 
						ifNotNil: [notify resume: outerAnswer]]]! !

!BlockContext methodsFor: 'evaluating' stamp: 'jrp 10/10/2004 22:28'!
valueSuppressingAllMessages

	^ self valueSuppressingMessages: #('*')! !

!BlockContext methodsFor: 'evaluating' stamp: 'jrp 10/4/2004 18:59'!
valueSuppressingMessages: aListOfStrings

	^ self
		valueSuppressingMessages: aListOfStrings
		supplyingAnswers: #()! !

!BlockContext methodsFor: 'evaluating' stamp: 'jrp 10/4/2004 18:58'!
valueSuppressingMessages: aListOfStrings supplyingAnswers: aListOfPairs

	^ self valueSupplyingAnswers: aListOfPairs, (aListOfStrings collect: [:each | {each. true}])! !

!BlockContext methodsFor: 'evaluating' stamp: 'md 7/30/2005 21:22'!
valueWithArguments: anArray 
	"Primitive. Evaluate the block represented by the receiver. The argument 
	is an Array whose elements are the arguments for the block. Fail if the 
	length of the Array is not the same as the the number of arguments that 
	the block was expecting. Fail if the block is already being executed. 
	Essential. See Object documentation whatIsAPrimitive."

	<primitive: 82>

	anArray isArray ifFalse: [^self error: 'valueWithArguments: expects an array'].
	self numArgs = anArray size
		ifTrue: [self error: 'Attempt to evaluate a block that is already being evaluated.']
		ifFalse: [self error: 
			'This block accepts ' ,self numArgs printString, ' argument', (self numArgs = 1 ifTrue:[''] ifFalse:['s']) , 
			', but was called with ', anArray size printString, '.']

! !

!BlockContext methodsFor: 'evaluating' stamp: 'nk 3/11/2001 11:49'!
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! !

!BlockContext methodsFor: 'evaluating' stamp: 'md 3/28/2006 20:17'!
valueWithExit 
	  self value: [ ^nil ]! !

!BlockContext methodsFor: 'evaluating' stamp: 'md 10/7/2004 15:26'!
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."

	self numArgs = 0 ifTrue: [^self value].
	self numArgs = 1 ifTrue: [^self value: anArg].
	self numArgs  > 1 ifTrue: [^self valueWithArguments: {anArg}, (Array new: self numArgs  - 1)]! !

!BlockContext methodsFor: 'scheduling' stamp: 'ajh 2/10/2003 14:25'!
newProcess
	"Answer a Process running the code in the receiver. The process is not 
	scheduled."
	<primitive: 19> "Simulation guard"
	^Process
		forContext: 
			[self value.
			Processor terminateActive] asContext
		priority: Processor activePriority! !

!BlockContext methodsFor: 'scheduling' stamp: 'ajh 2/10/2003 14:25'!
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."
	<primitive: 19> "Simulation guard"
	^Process
		forContext: 
			[self valueWithArguments: anArray.
			Processor terminateActive] asContext
		priority: Processor activePriority! !

!BlockContext methodsFor: 'scheduling' stamp: 'sr 6/14/2004 15:19'!
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! !

!BlockContext methodsFor: 'printing' stamp: 'md 2/22/2006 15:53'!
decompile
	^ home method decompilerClass new decompileBlock: self! !

!BlockContext methodsFor: 'printing' stamp: 'md 2/20/2006 13:46'!
decompileString
	^self decompile decompileString.! !

!BlockContext methodsFor: 'printing' stamp: 'MPW 1/1/1901 22:01'!
printOnStream: aStream

	home == nil ifTrue: [^aStream print: 'a BlockContext with home=nil'].
	aStream print: '[] in '.
	super printOnStream: aStream! !

!BlockContext methodsFor: 'private' stamp: 'md 4/27/2006 15:14'!
endPC
	"Determine end of block from long jump preceding it"
	^(self method at: startpc - 2)
				\\ 16 - 4 * 256
				+ (self method at: startpc - 1) + startpc - 1.! !

!BlockContext methodsFor: 'private' stamp: 'tfei 3/20/2000 00:24'!
hideFromDebugger

	^home ~~ nil and: [home hideFromDebugger]! !

!BlockContext methodsFor: 'private' stamp: 'ajh 7/7/2004 13:43'!
myEnv
	"polymorphic with MethodContext"

	^ nil! !

!BlockContext methodsFor: 'exceptions' stamp: 'ar 12/4/2009 18:31'!
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 value.
	complete ifNil:[
		complete := true.
		aBlock value.
	].
	^ returnValue! !

!BlockContext methodsFor: 'exceptions' stamp: 'ar 12/4/2009 18:41'!
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 value.
	complete := true.
	^result! !

!BlockContext methodsFor: '*services-base' stamp: 'rr 3/21/2006 11:53'!
valueWithRequestor: aRequestor 
	"To do later: make the fillInTheBlank display more informative captions.
	Include the description of the service, and maybe record steps"

	^ self numArgs isZero 
		ifTrue: [self value]
		ifFalse: [self value: aRequestor]! !


!MethodContext methodsFor: 'accessing' stamp: 'md 4/27/2006 15:12'!
hasInstVarRef
	"Answer whether the receiver references an instance variable."

	^self method hasInstVarRef.! !

!MethodContext methodsFor: 'private-debugger' stamp: 'ajh 1/24/2003 23:38'!
cachesStack

	^ false
	"^self selector == #valueUninterruptably
		and: [self receiver class == BlockContext]"! !

!MethodContext methodsFor: 'private-debugger' stamp: 'tfei 3/20/2000 00:24'!
hideFromDebugger

	| sndr sndrHome |
	^self cachesStack
		or: [(sndr := self sender) ~~ nil
			and: [(sndrHome := sndr home) ~~ nil
				and: [sndrHome cachesStack]]]! !

!MethodContext methodsFor: 'printing' stamp: 'mvl 3/13/2007 11:40'!
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]! !

!MethodContext methodsFor: 'closure support' stamp: 'md 1/20/2006 17:17'!
asContext

	^ self! !

!MethodContext methodsFor: 'closure support' stamp: 'md 2/20/2006 20:38'!
capturedTempNames

	^ self methodNode scope capturedVars collect: [:var | var name]! !

!MethodContext methodsFor: 'closure support' stamp: 'md 2/20/2006 20:38'!
doItScope
	"scope (environment) for expressions executed within a method context. self will be the receiver of the do-it method. We want temp vars directly accessible"

	^ self methodNode scope asDoItScope! !

!MethodContext methodsFor: 'closure support' stamp: 'md 2/20/2006 20:38'!
freeNames

	^ self methodNode freeNames! !

!MethodContext methodsFor: 'closure support' stamp: 'md 2/20/2006 20:39'!
freeNamesAndValues

	| aStream eval |
	eval := [:string |
		self class evaluatorClass new
			evaluate2: (ReadStream on: string)
			in: self
			to: nil
			notifying: nil	"fix this"
			ifFail: [self error: 'bug']
			logged: false].

	aStream := '' writeStream.
	self freeNames doWithIndex: [:name :index |
		aStream nextPutAll: name; nextPut: $:; space; tab.
		(eval value: name) printOn: aStream.
		aStream cr].
	^ aStream contents! !

!MethodContext methodsFor: 'closure support' stamp: 'md 1/20/2006 17:16'!
isClosureContext

	^ self isExecutingBlock! !

!MethodContext methodsFor: 'testing' stamp: 'mha 8/10/2009 08:53'!
isMethodContext
	^ true! !


!MethodContext class methodsFor: 'closure support' stamp: 'md 2/20/2006 20:41'!
myEnvFieldIndex

	^ self allInstVarNames indexOf: 'receiverMap'! !

!MethodContext class methodsFor: 'private' stamp: 'ar 8/6/2009 23:13'!
allInstancesDo: aBlock
	"Only count until thisContext since evaluation of aBlock will create new contexts."
	| inst next |
	inst := self someInstance.
	[inst == thisContext] whileFalse:[
		next := inst nextInstance.
		aBlock value: inst.
		inst := next]
! !


!MethodDictionary methodsFor: 'removing' stamp: 'nice 1/10/2009 00:34'!
removeAll
	"This provides a faster way than repeated become.
	a single become is still in use to prevent system crash."
	
	| newSelf |
	tally = 0 ifTrue: [^self].
	newSelf := self species new: self size.  "This will preserve the capacity"
	self become: newSelf! !

!MethodDictionary methodsFor: 'private' stamp: 'ul 11/13/2009 12:07'!
fixCollisionsFrom: start
	"The element at start has been removed and replaced by nil.
	This method moves forward from there, relocating any entries
	that had been placed below due to collisions with this one."

	| key index |
	index := start.
	[ (key := self basicAt: (index := index \\ array size + 1)) == nil ] whileFalse: [
		| newIndex |
		(newIndex := self scanFor: key) = index ifFalse: [
			self swap: index with: newIndex ] ]! !

!MethodDictionary methodsFor: 'copying' stamp: 'ul 9/22/2009 04:52'!
postCopy

	array := array shallowCopy! !


!MethodDictionary class methodsFor: 'initialization' stamp: 'ul 10/30/2009 04:02'!
rehashAllInstances

	| instances newInstances |
	instances := self allInstances asArray.
	newInstances := self allInstances collect: [ :each | each rehashWithoutBecome ].
	instances elementsExchangeIdentityWith: newInstances! !


!MethodFinder class methodsFor: 'as yet unclassified' stamp: 'ar 9/27/2005 22:45'!
methodFor: dataAndAnswers
	"Return a Squeak expression that computes these answers.  (This method is called by the comment in the bottom pane of a MethodFinder.  Do not delete this method.)"

	| resultOC resultString |
	resultOC := (self new) load: dataAndAnswers; findMessage.
	resultString := String streamContents: [:strm |
		resultOC do: [:exp | strm nextPut: $(; nextPutAll: exp; nextPut: $); space]].
	^ resultString! !

