[Vm-dev] VM Maker: VMMakerCompatibilityForPharo6-EliotMiranda.3.mcz

commits at source.squeak.org commits at source.squeak.org
Thu Aug 16 01:25:09 UTC 2018


Eliot Miranda uploaded a new version of VMMakerCompatibilityForPharo6 to project VM Maker:
http://source.squeak.org/VMMaker/VMMakerCompatibilityForPharo6-EliotMiranda.3.mcz

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

Name: VMMakerCompatibilityForPharo6-EliotMiranda.3
Author: EliotMiranda
Time: 15 August 2018, 6:25:07.316818 pm
UUID: 4dd7e00c-e52f-0d00-a920-37300bb88c17
Ancestors: VMMakerCompatibilityForPharo6-eem.2

Support for embeddedBlockClosures and schematicTempNamesString because these are used currently to interface to the JIT's code decoration facilities.

=============== Diff against VMMakerCompatibilityForPharo6-eem.2 ===============

Item was changed:
  SystemOrganization addCategory: #VMMakerCompatibilityForPharo6!
+ SystemOrganization addCategory: 'VMMakerCompatibilityForPharo6-Kernel-Methods'!
  SystemOrganization addCategory: 'VMMakerCompatibilityForPharo6-System'!

Item was added:
+ ----- Method: BytecodeEncoder class>>extensionsAt:in:into: (in category '*VMMakerCompatibilityForPharo6-instruction stream support') -----
+ extensionsAt: pc in: aCompiledMethod into: trinaryBlock
+ 	"If the bytecode at pc is an extension then evaluate aTrinaryBlock
+ 	 with the values of extA and extB and number of extension *bytes*.
+ 	 If the bytecode at pc is not an extension then evaluate with 0, 0, 0."
+ 
+ 	self subclassResponsibility!

Item was added:
+ InstructionClient subclass: #ClosureExtractor
+ 	instanceVariableNames: 'action scanner currentContext'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'VMMakerCompatibilityForPharo6-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 class>>withAction:andScanner: (in category 'instance creation') -----
+ withAction: aBlock andScanner: anInstructionStream
+ 	"The passed block must accept one value, which will be a BlockClosure."
+ 	^ self new action: aBlock; scanner: anInstructionStream!

Item was 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>>blockReturnConstant: (in category 'instruction decoding') -----
+ blockReturnConstant: value
+ 	currentContext := currentContext sender!

Item was added:
+ ----- Method: ClosureExtractor>>blockReturnTop (in category 'instruction decoding') -----
+ blockReturnTop
+ 	currentContext := currentContext sender!

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."
+ 	| block |
+ 	block := BlockClosure
+ 				outerContext: currentContext
+ 				startpc: scanner pc
+ 				numArgs: numArgs
+ 				copiedValues: (Array new: numCopied)..
+ 	currentContext := block asContextWithSender: currentContext.
+ 	action value: block!

Item was added:
+ ----- Method: ClosureExtractor>>pushFullClosure:numCopied: (in category 'instruction decoding') -----
+ pushFullClosure: aCompiledBlock numCopied: numCopied
+ 	"Create a BlockClosure corresponding to the closure bytecode
+ 	 and execute the action block with it. The created BlockClosure is only a pseudo value,
+ 	 it is not populated with meaningful context and argument information."
+ 	| block |
+ 	block := FullBlockClosure
+ 				receiver: nil
+ 				outerContext: currentContext
+ 				method: aCompiledBlock
+ 				copiedValues: (Array new: numCopied).
+ 	currentContext := block asContextWithSender: currentContext.
+ 	action value: block!

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

Item was added:
+ ----- Method: ClosureExtractor>>scanner: (in category 'accessing') -----
+ scanner: anInstructionStream
+ 	scanner := anInstructionStream.
+ 	currentContext := Context
+ 							sender: nil
+ 							receiver: nil
+ 							method: scanner method
+ 							arguments: (Array new: scanner method numArgs)!

Item was added:
+ ----- Method: CompiledCode>>isCompiledCode (in category '*VMMakerCompatibilityForPharo6-testing') -----
+ isCompiledCode
+ 	^true!

Item was added:
+ ----- Method: CompiledMethod>>embeddedBlockClosures (in category '*VMMakerCompatibilityForPharo6-closures') -----
+ embeddedBlockClosures
+ 	| bms extractor scanner endPC encoderClass |
+ 	bms := OrderedCollection new.
+ 	scanner := self scanner.
+ 	extractor := ClosureExtractor withAction: [:c| bms add: c] andScanner: scanner.
+ 	endPC := self endPC.
+ 	encoderClass := self encoderClass.
+ 	[scanner pc <= endPC] whileTrue:
+ 		[encoderClass interpretNextInstructionFor: extractor in: scanner].
+ 	^bms!

Item was added:
+ ----- Method: EncoderForSistaV1 class>>extensionsAt:in:into: (in category '*VMMakerCompatibilityForPharo6-compiled method support') -----
+ extensionsAt: bcpc in: method into: aTrinaryBlock
+ 	"If the bytecode at pc is an extension then evaluate aBinaryBlock with the values of extA and extB and number of extension *bytes*.
+ 	 If the bytecode at pc is not extended then evaluate aBinaryBlock with 0 and 0.
+ 	224		11100000	aaaaaaaa	Extend A (Ext A = Ext A prev * 256 + Ext A)
+ 	225		11100001	bbbbbbbb	Extend B (Ext B = Ext B prev * 256 + Ext B)"
+  
+ 	| scanpc byte extByte extA extB |
+ 	scanpc := bcpc.
+ 	"There may be an extension (it could be a false positive).  We must scan as fast as possible..."
+ 	extA := extB := 0.
+ 	[byte := method at: scanpc.
+ 	 byte >= 224 and: [byte <= 225]] whileTrue: 
+ 		[extByte := method at: scanpc + 1.
+ 		 scanpc := scanpc + 2.
+ 		 byte = 224
+ 			ifTrue:
+ 				[extA := (extA bitShift: 8) + extByte]
+ 			ifFalse:
+ 				[extB := (extB = 0 and: [extByte > 127])
+ 					ifTrue: [extByte - 256]
+ 					ifFalse: [(extB bitShift: 8) + extByte]]].
+ 	^aTrinaryBlock value: extA value: extB value: scanpc - bcpc
+ 
+ 
+ "Why use
+ 	byte >= 224 and: [byte <= 225]
+  and not
+ 	(byte bitAnd: 16rFE) = 16rE0
+  ?
+  | n |
+  n := 100000000.
+  #(0 224) collect:
+ 	[:byte|
+ 	{ Time millisecondsToRun: [1 to: n do: [:i| (byte >= 224 and: [byte <= 225]) ifTrue: []]].
+ 	   Time millisecondsToRun: [1 to: n do: [:i| (byte bitAnd: 16rFE) = 16rE0 ifTrue: []]] }] #(#(297 599) #(702 671))"!

Item was added:
+ ----- Method: EncoderForV3 class>>extensionsAt:in:into: (in category '*VMMakerCompatibilityForPharo6-instruction stream support') -----
+ extensionsAt: pc in: aCompiledMethod into: trinaryBlock
+ 	"If the bytecode at pc is an extension then evaluate aTrinaryBlock
+ 	 with the values of extA and extB and number of extension *bytes*.
+ 	 If the bytecode at pc is not an extension then evaluate with 0, 0, 0.
+ 	 There are no extensions in the SqueakV3/Smalltalk-80 bytecode set, so..." 
+ 	^trinaryBlock value: 0 value: 0 value: 0!

Item was added:
+ ----- Method: OCAbstractScope>>childrenDo:after:suchThat: (in category '*VMMakerCompatibilityForPharo6-results') -----
+ childrenDo: aBlock after: pBlock suchThat: selectBlock
+ 	children ifNotNil:
+ 		[children do:
+ 			[:child|
+ 			 (selectBlock value: child) ifTrue:
+ 				[aBlock value: child.
+ 				 child childrenDo: aBlock after: pBlock suchThat: selectBlock.
+ 				 pBlock value: child]]]!

Item was added:
+ ----- Method: OCAbstractScope>>childrenDo:suchThat: (in category '*VMMakerCompatibilityForPharo6-results') -----
+ childrenDo: aBlock suchThat: selectBlock
+ 	children ifNotNil:
+ 		[children do:
+ 			[:child|
+ 			 (selectBlock value: child) ifTrue:
+ 				[aBlock value: child.
+ 				 child childrenDo: aBlock suchThat: selectBlock]]]!

Item was added:
+ ----- Method: Object>>isCompiledCode (in category '*VMMakerCompatibilityForPharo6-testing') -----
+ isCompiledCode
+ 	^false!

Item was added:
+ ----- Method: RBMethodNode>>printSchematicTempsFor:in:on: (in category '*VMMakerCompatibilityForPharo6-results') -----
+ printSchematicTempsFor: blockNode in: blockScope on: stream
+ 	| startPos vectorStartPos |
+ 	startPos := stream position.
+ 	blockNode arguments do:
+ 		[:n|
+ 		 stream position > startPos ifTrue: [stream space].
+ 		 stream nextPutAll: n name].
+ 	blockScope isBlockScope ifTrue:
+ 		[(blockScope copiedVars "filter out remotes, e.g. 0vector0"
+ 				reject: [:var| var name first isDigit]) do:
+ 			[:var|
+ 			 stream position > startPos ifTrue: [stream space].
+ 			 stream nextPutAll: var name]].
+ 	(blockNode temporaries reject: [:var| (blockScope lookupVar: var name) isRemote]) do:
+ 		[:var|
+ 		 stream position > startPos ifTrue: [stream space].
+ 		 stream nextPutAll: var name].
+ 	vectorStartPos := stream position.
+ 	(blockNode temporaries select: [:var| (blockScope lookupVar: var name) isRemote]) do:
+ 		[:var|
+ 		 stream position = vectorStartPos ifTrue:
+ 			[vectorStartPos > startPos ifTrue: [stream space].
+ 			 stream nextPut: $(].
+ 		 stream nextPutAll: var name].
+ 	stream position > vectorStartPos ifTrue: [stream nextPut: $)]!

Item was added:
+ ----- Method: RBMethodNode>>schematicTempNamesString (in category '*VMMakerCompatibilityForPharo6-results') -----
+ schematicTempNamesString
+ 	scope ifNil: [self generateIR].
+ 	^String streamContents:
+ 		[:s|
+ 		 self printSchematicTempsFor: self in: scope on: s.
+ 		 scope
+ 			childrenDo:
+ 				[:childBlockScope|
+ 				 childBlockScope isOptimizedBlockScope ifFalse:
+ 					[s nextPut: $[.
+ 					 self printSchematicTempsFor: childBlockScope node in: childBlockScope on: s]]
+ 			after:
+ 				[:childBlockScope|
+ 				 childBlockScope isOptimizedBlockScope ifFalse:
+ 					[s nextPut: $]]]
+ 			suchThat: [:childScope| childScope isBlockScope]]
+ 		  !



More information about the Vm-dev mailing list