[Pkg] The Trunk: Kernel-mha.556.mcz

[commits at source.squeak.org]

Michael Haupt uploaded a new version of Kernel to project The Trunk:
http://source.squeak.org/trunk/Kernel-mha.556.mcz

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

Name: Kernel-mha.556
Author: mha
Time: 24 March 2011, 8:23:23.16 pm
UUID: 335384b3-adba-4f4f-b8aa-4cef81efebcc
Ancestors: Kernel-ul.555

revamped closures protocol in CompiledMethod and supplemental code/classes

=============== Diff against Kernel-ul.555 ===============

Item was added:
+ ----- Method: BlockClosure>>size (in category 'accessing') -----
+ size
+ 	"Extract this closure's bytecode size (number of bytes) by accessing the closure
+ 	creation bytecode in the enclosing method."
+ 	
+ 	^ ((self method at: self startpc - 2) bitShift: 8) + (self method at: self startpc - 1)!

Item was added:
+ InstructionClient subclass: #ClosureExtractor
+ 	instanceVariableNames: 'action scanner'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Kernel-Methods'!
+ 
+ !ClosureExtractor commentStamp: 'mha 9/21/2010 11:16' prior: 0!
+ A ClosureExtractor is a utility class that is used to extract all BlockClosures from a CompiledMethod. It inherits from InstructionClient and understands only one single message, namely that corresponding to the push closure bytecode instruction. Being sent this message, a ClosureExtractor will create a BlockClosure instance and evaluate the block it holds as an instance variable with that closure as parameter.!

Item was added:
+ ----- Method: ClosureExtractor classSide>>withAction:andScanner: (in category 'instance creation') -----
+ withAction: aBlock andScanner: anInstructionStream
+ 	"The passed block must accept one value, which will be a BlockClosure."
+ 	^ self new action: aBlock; scanner: anInstructionStream!

Item was added:
+ ----- Method: ClosureExtractor>>action (in category 'accessing') -----
+ action
+ 	^ action!

Item was added:
+ ----- Method: ClosureExtractor>>action: (in category 'accessing') -----
+ action: aBlock
+ 	action := aBlock!

Item was added:
+ ----- Method: ClosureExtractor>>pushClosureCopyNumCopiedValues:numArgs:blockSize: (in category 'instruction decoding') -----
+ pushClosureCopyNumCopiedValues: numCopied numArgs: numArgs blockSize: blockSize
+ 	
+ 	"Create a BlockClosure corresponding to the closure bytecode
+ 	and execute the action block with it. The created BlockClosure is only a pseudo value,
+ 	it is not populated with meaningful context and argument information."
+ 	
+ 	action value:
+ 		(BlockClosure
+ 			outerContext: (MethodContext
+ 				sender: thisContext
+ 				receiver: self
+ 				method: scanner method
+ 				arguments: (Array new: scanner method numArgs))
+ 			startpc: scanner pc
+ 			numArgs: numArgs
+ 			copiedValues: (Array new: numCopied))!

Item was added:
+ ----- Method: ClosureExtractor>>scanner (in category 'accessing') -----
+ scanner
+ 	^ scanner!

Item was added:
+ ----- Method: ClosureExtractor>>scanner: (in category 'accessing') -----
+ scanner: anInstructionStream
+ 	scanner := anInstructionStream!

Item was changed:
  ----- Method: CompiledMethod>>containsBlockClosures (in category 'closures') -----
  containsBlockClosures
+ 	^ self scanner scanFor: [ :bc | bc = 143 "push closure bytecode" ]!
- 
- 	^ self embeddedBlockMethods size > 0!

Item was changed:
  ----- Method: CompiledMethod>>embeddedBlockMethods (in category 'closures') -----
  embeddedBlockMethods
  
+ 	| bms extractor scanner |
+ 	bms := OrderedCollection new.
+ 	scanner := self scanner.
+ 	extractor := ClosureExtractor withAction: [ :c | bms add: c ] andScanner: scanner.
+ 	[ scanner pc <= self endPC ] whileTrue: [ scanner interpretNextInstructionFor: extractor ].
+ 	^ bms!
- 	| 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!

Item was changed:
  ----- Method: InstructionStream>>scanFor: (in category 'scanning') -----
  scanFor: scanBlock
+ 	"Check all bytecode instructions with scanBlock, answer true if scanBlock answers true.
+ 	This can be used to, e.g., check whether a method contains 'push closure' bytecodes like this:
+ 	aMethod scanFor: [ :b | b = 143 ]"
- 	"Answer the index of the first bytecode for which scanBlock
- 	 answers true when supplied with that bytecode."
  
  	| method end byte |
  	method := self method.
  	end := method endPC.
  	[pc <= end] whileTrue: 
  		[(scanBlock value: (byte := method at: pc)) ifTrue:
  			[^true].
  		 pc := self nextPc: byte].
  	^false!

Item was added:
+ ----- Method: MethodContext>>atEnd (in category 'testing') -----
+ atEnd
+ 	^ self isExecutingBlock
+ 		ifTrue: [ self closure startpc + self closure size - 1 = self pc ]
+ 		ifFalse: [ self pc >= self method endPC ]!