[Vm-dev] VM Maker: BytecodeSets-eem.7.mcz

commits at source.squeak.org commits at source.squeak.org
Thu Jul 31 16:39:21 UTC 2014


Eliot Miranda uploaded a new version of BytecodeSets to project VM Maker:
http://source.squeak.org/VMMaker/BytecodeSets-eem.7.mcz

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

Name: BytecodeSets-eem.7
Author: eem
Time: 31 July 2014, 6:39:13.243 am
UUID: 52f21932-18a2-4973-a78c-03f2fb26f1ec
Ancestors: BytecodeSets-eem.6

Add missing generateMethodOfClass:trailer:from: implemen-
tations, and SpecialLiteralNode.  Move EncoderForV3>>
computeMethodHeaderForNumArgs:numTemps:numLits:primitive:
and EncoderForV3 class>>unknownBytecode
from MethodMassageCompatibility.
Flip the switch to use generateMethodOfClass:trailer:from:
for method creation.

=============== Diff against BytecodeSets-eem.6 ===============

Item was changed:
  SystemOrganization addCategory: #'BytecodeSets-NewsqueakV3'!
  SystemOrganization addCategory: #'BytecodeSets-SistaV1'!
  SystemOrganization addCategory: #'BytecodeSets-NewsqueakV4'!
+ SystemOrganization addCategory: #'BytecodeSets-ParseNodes'!

Item was added:
+ ----- Method: EncoderForSistaV1>>computeMethodHeaderForNumArgs:numTemps:numLits:primitive: (in category 'method encoding') -----
+ computeMethodHeaderForNumArgs: numArgs numTemps: numTemps numLits: numLits primitive: primitiveIndex
+ 	numTemps > 63 ifTrue:
+ 		[^self error: 'Cannot compile -- too many temporary variables'].	
+ 	numLits > 65535 ifTrue:
+ 		[^self error: 'Cannot compile -- too many literals'].
+ 	^SmallInteger minVal "sign bit is the flag for the alternative bytecode set"
+ 	+ (numArgs bitShift: 24)
+ 	+ (numTemps bitShift: 18)
+ 	"+ (largeBit bitShift: 17)" "largeBit gets filled in later"
+ 	+ ((Smalltalk vmParameterAt: 65) == true
+ 		ifTrue: [numLits + (primitiveIndex > 0 ifTrue: [1 bitShift: 16] ifFalse: [0])]
+ 		ifFalse: [numLits > 255 ifTrue: [self error: 'vm does not support large methods'].
+ 				primitiveIndex > 511 ifTrue: [self error: 'hack does not support primitive > 511'].
+ 				(numLits bitShift: 9)
+ 				+ (primitiveIndex bitAnd: 511)])!

Item was added:
+ ----- Method: EncoderForSistaV1>>generateMethodOfClass:trailer:from: (in category 'method encoding') -----
+ generateMethodOfClass: aCompiledMethodClass trailer: trailer from: methodNode
+ 	"The receiver is the root of a parse tree. Answer an instance of aCompiledMethodClass.
+ 	 The argument, trailer, is arbitrary but is typically either the reference to the source code
+ 	 that is stored with every CompiledMethod, or an encoding of the method's temporary names."
+ 
+ 	| primErrNode blkSize nLits locals literals header method stack |
+ 	primErrNode := methodNode primitiveErrorVariableName ifNotNil:
+ 						[self fixTemp: methodNode primitiveErrorVariableName].
+ 	methodNode ensureClosureAnalysisDone.
+ 	self rootNode: methodNode. "this is for BlockNode>>sizeCodeForClosureValue:"
+ 	blkSize := (methodNode block sizeCodeForEvaluatedValue: self)
+ 				+ (methodNode primitive > 0
+ 					ifTrue: [self sizeCallPrimitive: methodNode primitive]
+ 					ifFalse: [0])
+ 				+ (primErrNode
+ 					ifNil: [0]
+ 					ifNotNil:
+ 						[primErrNode
+ 							index: methodNode arguments size + methodNode temporaries size;
+ 							sizeCodeForStore: self "The VM relies on storeIntoTemp: (129)"]).
+ 	locals := methodNode arguments, methodNode temporaries, (primErrNode ifNil: [#()] ifNotNil: [{primErrNode}]).
+ 	self noteBlockExtent: methodNode block blockExtent hasLocals: locals.
+ 	header := self computeMethodHeaderForNumArgs: methodNode arguments size
+ 					numTemps: locals size
+ 					numLits: (nLits := (literals := self allLiterals) size)
+ 					primitive: methodNode primitive.
+ 	method := trailer
+ 					createMethod: blkSize
+ 					class: aCompiledMethodClass
+ 					header: header.
+ 	1 to: nLits do: [:lit | method literalAt: lit put: (literals at: lit)].
+ 	self streamToMethod: method.
+ 	stack := ParseStack new init.
+ 	methodNode primitive > 0 ifTrue:
+ 		[self genCallPrimitive: methodNode primitive].
+ 	primErrNode ifNotNil:
+ 		[primErrNode emitCodeForStore: stack encoder: self].
+ 	stack position: method numTemps.
+ 	[methodNode block emitCodeForEvaluatedValue: stack encoder: self]
+ 		on: Error "If an attempt is made to write too much code the method will be asked"
+ 		do: [:ex|  "to grow, and the grow attempt will fail in CompiledMethod class>>#new:"
+ 			ex signalerContext sender method = (CompiledMethod class>>#new:)
+ 				ifTrue: [^self error: 'Compiler code size discrepancy']
+ 				ifFalse: [ex pass]].
+ 	stack position ~= (method numTemps + 1) ifTrue:
+ 		[^self error: 'Compiler stack discrepancy'].
+ 	self methodStreamPosition ~= (method size - trailer size) ifTrue:
+ 		[^self error: 'Compiler code size discrepancy'].
+ 	method needsFrameSize: stack size - method numTemps.
+ 	^method!

Item was added:
+ ----- Method: EncoderForV3 class>>unusedBytecode (in category '*BytecodeSets-bytecode decoding') -----
+ unusedBytecode
+ 	"Answer the opcode of a single-byte unused bytecode, if it exists in the encoder's bytecode set, or nil if not."
+ 	^126!

Item was added:
+ ----- Method: EncoderForV3>>computeMethodHeaderForNumArgs:numTemps:numLits:primitive: (in category '*BytecodeSets-method encoding') -----
+ computeMethodHeaderForNumArgs: numArgs numTemps: numTemps numLits: numLits primitive: primitiveIndex
+ 	| primBits |
+ 	numTemps > 63 ifTrue:
+ 		[^self error: 'Cannot compile -- too many temporary variables'].	
+ 	numLits > 255 ifTrue:
+ 		[^self error: 'Cannot compile -- too many literals'].
+ 	primBits := primitiveIndex <= 16r1FF
+ 					ifTrue: [primitiveIndex]
+ 					ifFalse: "For now the high bit of primitive no. is in the 29th bit of header"
+ 						[primitiveIndex > 16r3FF ifTrue: [self error: 'prim num too large'].
+ 						 (primitiveIndex bitAnd: 16r1FF) + ((primitiveIndex bitAnd: 16r200) bitShift: 19)].
+ 	^(numArgs bitShift: 24)
+ 	+ (numTemps bitShift: 18)
+ 	"+ (largeBit bitShift: 17)" "largeBit gets filled in later"
+ 	+ (numLits bitShift: 9)
+ 	+ primBits!

Item was added:
+ ----- Method: EncoderForV3>>generateMethodOfClass:trailer:from: (in category '*BytecodeSets-method encoding') -----
+ generateMethodOfClass: aCompiledMethodClass trailer: trailer from: methodNode
+ 	"The receiver is the root of a parse tree. Answer an instance of aCompiledMethodClass.
+ 	 The argument, trailer, is arbitrary but is typically either the reference to the source code
+ 	 that is stored with every CompiledMethod, or an encoding of the method's temporary names."
+ 
+ 	| primErrNode blkSize nLits literals header method stack |
+ 	primErrNode := methodNode primitiveErrorVariableName ifNotNil:
+ 						[self fixTemp: methodNode primitiveErrorVariableName].
+ 	blkSize := (methodNode block sizeCodeForEvaluatedValue: self)
+ 				+ (primErrNode
+ 					ifNil: [0]
+ 					ifNotNil: [primErrNode sizeCodeForStore: self "The VM relies on storeIntoTemp: (129)"]).
+ 	header := self computeMethodHeaderForNumArgs: methodNode arguments size
+ 					numTemps: self maxTemp
+ 					numLits: (nLits := (literals := self allLiterals) size)
+ 					primitive: methodNode primitive.
+ 	method := trailer
+ 					createMethod: blkSize
+ 					class: aCompiledMethodClass
+ 					header: header.
+ 	1 to: nLits do: [:lit | method literalAt: lit put: (literals at: lit)].
+ 	self streamToMethod: method.
+ 	stack := ParseStack new init.
+ 	primErrNode ifNotNil: [primErrNode emitCodeForStore: stack encoder: self].
+ 	stack position: method numTemps.
+ 	[methodNode block emitCodeForEvaluatedValue: stack encoder: self]
+ 		on: Error "If an attempt is made to write too much code the method will be asked"
+ 		do: [:ex|  "to grow, and the grow attempt will fail in CompiledMethod class>>#new:"
+ 			ex signalerContext sender method = (CompiledMethod class>>#new:)
+ 				ifTrue: [^self error: 'Compiler code size discrepancy']
+ 				ifFalse: [ex pass]].
+ 	stack position ~= (method numTemps + 1) ifTrue:
+ 		[^self error: 'Compiler stack discrepancy'].
+ 	self methodStreamPosition ~= (method size - trailer size) ifTrue:
+ 		[^self error: 'Compiler code size discrepancy'].
+ 	method needsFrameSize: stack size - method numTemps.
+ 	^method!

Item was added:
+ ----- Method: EncoderForV3PlusClosures>>generateMethodOfClass:trailer:from: (in category '*BytecodeSets-method encoding') -----
+ generateMethodOfClass: aCompiledMethodClass trailer: trailer from: methodNode
+ 	"The receiver is the root of a parse tree. Answer an instance of aCompiledMethodClass.
+ 	 The argument, trailer, is arbitrary but is typically either the reference to the source code
+ 	 that is stored with every CompiledMethod, or an encoding of the method's temporary names."
+ 
+ 	| primErrNode blkSize nLits locals literals header method stack |
+ 	primErrNode := methodNode primitiveErrorVariableName ifNotNil:
+ 						[self fixTemp: methodNode primitiveErrorVariableName].
+ 	methodNode ensureClosureAnalysisDone.
+ 	self rootNode: methodNode. "this is for BlockNode>>sizeCodeForClosureValue:"
+ 	blkSize := (methodNode block sizeCodeForEvaluatedValue: self)
+ 				+ (primErrNode
+ 					ifNil: [0]
+ 					ifNotNil:
+ 						[primErrNode
+ 							index: methodNode arguments size + methodNode temporaries size;
+ 							sizeCodeForStore: self "The VM relies on storeIntoTemp: (129)"]).
+ 	locals := methodNode arguments, methodNode temporaries, (primErrNode ifNil: [#()] ifNotNil: [{primErrNode}]).
+ 	self noteBlockExtent: methodNode block blockExtent hasLocals: locals.
+ 	header := self computeMethodHeaderForNumArgs: methodNode arguments size
+ 					numTemps: locals size
+ 					numLits: (nLits := (literals := self allLiterals) size)
+ 					primitive: methodNode primitive.
+ 	method := trailer
+ 					createMethod: blkSize
+ 					class: aCompiledMethodClass
+ 					header: header.
+ 	1 to: nLits do: [:lit | method literalAt: lit put: (literals at: lit)].
+ 	self streamToMethod: method.
+ 	stack := ParseStack new init.
+ 	primErrNode ifNotNil: [primErrNode emitCodeForStore: stack encoder: self].
+ 	stack position: method numTemps.
+ 	[methodNode block emitCodeForEvaluatedValue: stack encoder: self]
+ 		on: Error "If an attempt is made to write too much code the method will be asked"
+ 		do: [:ex|  "to grow, and the grow attempt will fail in CompiledMethod class>>#new:"
+ 			ex signalerContext sender method = (CompiledMethod class>>#new:)
+ 				ifTrue: [^self error: 'Compiler code size discrepancy']
+ 				ifFalse: [ex pass]].
+ 	stack position ~= (method numTemps + 1) ifTrue:
+ 		[^self error: 'Compiler stack discrepancy'].
+ 	self methodStreamPosition ~= (method size - trailer size) ifTrue:
+ 		[^self error: 'Compiler code size discrepancy'].
+ 	method needsFrameSize: stack size - method numTemps.
+ 	^method!

Item was added:
+ ----- Method: MethodNode>>generate:using: (in category '*BytecodeSets-code generation') -----
+ generate: trailer using: aCompiledMethodClass
+ 	"The receiver is the root of a parse tree. Answer an instance of aCompiledMethodClass.
+ 	 The argument, trailer, is arbitrary but is typically either the reference to the source code
+ 	 that is stored with every CompiledMethod, or an encoding of the method's temporary names."
+ 
+ 	| method |
+ 	self generate: trailer
+ 		using: aCompiledMethodClass
+ 		ifQuick:
+ 			[:m |
+ 			  m	literalAt: 2 put: encoder associationForClass;
+ 				properties: properties.
+ 			^m].
+ 	method := encoder generateMethodOfClass: aCompiledMethodClass trailer: trailer from: self.
+ 	method properties: properties.
+ 	^method!

Item was added:
+ ----- Method: MethodNode>>primitive (in category '*BytecodeSets-accessing') -----
+ primitive
+ 	^primitive!

Item was added:
+ LiteralNode subclass: #SpecialLiteralNode
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'BytecodeSets-ParseNodes'!

Item was added:
+ ----- Method: SpecialLiteralNode>>emitCodeForValue:encoder: (in category 'code generation (closures)') -----
+ emitCodeForValue: stack encoder: encoder
+ 	stack push: 1.
+ 	encoder genPushSpecialLiteral: key!

Item was added:
+ ----- Method: SpecialLiteralNode>>sizeCodeForValue: (in category 'code generation (closures)') -----
+ sizeCodeForValue: encoder
+ 	^encoder sizePushSpecialLiteral: key!



More information about the Vm-dev mailing list