[Vm-dev] VM Maker: VMMaker.oscog-eem.3222.mcz

commits at source.squeak.org commits at source.squeak.org
Tue Jul 26 19:11:15 UTC 2022


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

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

Name: VMMaker.oscog-eem.3222
Author: eem
Time: 26 July 2022, 12:11:03.160721 pm
UUID: f96f49a4-54f0-42a0-bcbb-bd5b6cc3e68a
Ancestors: VMMaker.oscog-dtl.3221

Simulation: fix a memcpy:_:_: case which was using a deprecated path to byteAt:put:.

Slang:
Fix accessorDepth calculations for clichés such as
primitiveSocketListenWithOrWithoutBacklog
	"Backward compatibility"
	<export: true>
	interpreterProxy methodArgumentCount = 2
		ifTrue:[^self primitiveSocketListenOnPort]
		ifFalse:[^self primitiveSocketListenOnPortBacklog]

=============== Diff against VMMaker.oscog-dtl.3221 ===============

Item was changed:
  ----- Method: CCodeGenerator>>accessorDepthForMethod: (in category 'spur primitive compilation') -----
  accessorDepthForMethod: method "TMethod"
  	"Compute the depth the method traverses object structure, assuming it is a primitive.
  	 This is in support of Spur's lazy become.  A primitive may fail in argument validation
  	 because it encounters a forwarder.  The primitive failure code needs to know to what
  	 depth it must follow arguments to find forwarders, so that if any are found, they can
  	 be followed and the primitive retried.
  
  	 This method determines that depth. It starts by collecting references to the stack and
  	 then follows these through assignments to variables and use of accessor methods
  	 such as fetchPointer:ofObject:. For example
  		| obj field  |
  		obj := self stackTop.
  		field := objectMemory fetchPointer: 1 ofObject: obj.
  		self storePointer: 1 ofObject: field withValue: (self stackValue: 1)
  	has depth 2, since field is accessed, and field is an element of obj.
  
  	The information is cached since it needs to be computed *before* inlining."
  	^accessorDepthCache
  		at: method smalltalkSelector
  		ifAbsentPut:
  			[beganInlining
  				ifTrue:
  					[(method export
  					 or: [vmClass notNil or: [vmClass primitiveTable includes: method smalltalkSelector]])
  						ifTrue: [-1]
  						ifFalse: [self error: 'it is too late to compute accessor depths!!']]
  				ifFalse:
  					 [((method definingClass includesSelector: method smalltalkSelector) ifTrue:
  							[(method definingClass >> method smalltalkSelector) pragmaAt: #accessorDepth:])
  						ifNotNil: [:pragma| pragma arguments first]
  						ifNil:
+ 							["Deal with clichés of the form
- 							["Deal with the
  									primitiveFoo
  										objectMemory hasSpurMemoryManagerAPI
  											ifTrue: [self primitiveFooSpur]
  											ifFalse: [self primitiveFooV3]
+ 							  and
+ 									primitiveFoo
+ 										interpreterProxy methodArgumentCount = M
+ 											ifTrue: [self primitiveFooM]
+ 											ifFalse: [self primitiveFooN]
+ 							 etc..."
+ 							method
+ 								isIfThenElseClicheGiven: self
+ 								IfTrue:
+ 									[:ifTrueCliche :ifFalseCliche|
+ 									method extractSpurPrimitiveSelector
+ 										ifNotNil:
+ 											[:actualSelector| | subMethod |
+ 											(subMethod := self methodNamed: actualSelector) ifNil:
+ 												[subMethod := self compileToTMethodSelector: actualSelector in: method definingClass].
+ 											self accessorDepthForMethod: subMethod]
+ 										ifNil:
+ 											[(self accessorDepthForMethod: (self methodNamed: ifTrueCliche))
+ 												max: (self accessorDepthForMethod: (self methodNamed: ifFalseCliche))]]
+ 								ifFalse:
+ 									[self accessorDepthForMethod: method interpreterClass: (vmClass ifNil: [StackInterpreter])]]]]!
- 							  cliché"
- 							method extractSpurPrimitiveSelector
- 								ifNotNil:
- 									[:actualSelector| | subMethod |
- 									(subMethod := self methodNamed: actualSelector) ifNil:
- 										[subMethod := self compileToTMethodSelector: actualSelector in: method definingClass].
- 									self accessorDepthForMethod: subMethod]
- 								ifNil: [self accessorDepthForMethod: method interpreterClass: (vmClass ifNil: [StackInterpreter])]]]]!

Item was added:
+ ----- Method: TMethod>>isIfThenElseClicheGiven:IfTrue:ifFalse: (in category 'primitive compilation') -----
+ isIfThenElseClicheGiven: aCodeGenerator IfTrue: binaryBlock ifFalse: unaryBlock
+ 	"If the receiver is a cliché of the form
+ 			primitiveFoo
+ 				objectMemory hasSpurMemoryManagerAPI
+ 					ifTrue: [self primitiveFooSpur]
+ 					ifFalse: [self primitiveFooV3]
+ 	  or
+ 			primitiveFoo
+ 				interpreterProxy methodArgumentCount = M
+ 					ifTrue: [self primitiveFooM]
+ 					ifFalse: [self primitiveFooN]
+ 	then answer the result of invoking binaryBlock with the two selectors in each arm of the ifTrue:ifFalse:.
+ 	Otherwise answer the result of evaluating the unary block."
+ 	| firstStmt getSelector |
+ 	((firstStmt := parseTree statements first) isSend
+ 	 and: [firstStmt isSend
+ 	 and: [(#(ifTrue:ifFalse: ifFalse:ifTrue:) includes: firstStmt selector)
+ 	 and: [(firstStmt args allSatisfy:
+ 			[:node| | subnode |
+ 			node isStmtList
+ 			and: [node statements size = 1
+ 			and: [((subnode := node statements first) isSend and: [subnode args isEmpty])
+ 				or: [subnode isReturn and: [subnode expression isSend and: [subnode expression args isEmpty]]]]]])
+ 	 and: [parseTree noneSatisfy:
+ 				[:node| node isSend and: [aCodeGenerator isStackAccessor: node selector given: aCodeGenerator vmClass]]]]]]) ifTrue:
+ 		[getSelector := [:subnode| subnode isReturn ifTrue: [subnode expression selector] ifFalse: [subnode selector]].
+ 		 ^binaryBlock
+ 			value: (getSelector value: firstStmt args first statements first)
+ 			value: (getSelector value: firstStmt args second statements first)].
+ 	^unaryBlock value!

Item was changed:
  ----- Method: VMClass>>memcpy:_:_: (in category 'C library simulation') -----
  memcpy: dest _: src _: bytes
  	<doNotGenerate>
  	"implementation of memcpy(3). N.B. If ranges overlap, must use memmove."
  	| getBlock setBlock source destination |
  
  	source := src isVMSimulationAddress
  		ifTrue: [src asInteger]
  		ifFalse: [src].
  	destination := dest isVMSimulationAddress
  		ifTrue: [dest asInteger]
  		ifFalse: [dest].
  	(source isInteger and: [destination isInteger]) ifTrue:
  		[ self deny: ((destination <= source and: [destination + bytes > source])
  					or: [source <= destination and: [source + bytes > destination]])].
  
  	"Determine the source and destination access blocks based on the parameter type"
  	getBlock := source isCollection ifTrue: 
  		[source isString ifTrue: 
  			"basicAt: answers integers"
  			[[ :idx | source basicAt: idx]]
  		ifFalse: 
  			[source class == ByteArray ifTrue: 
  				[[ :idx | source at: idx]]]]
  	ifFalse: 
  		[source isInteger ifTrue: 
  			[[ :idx | self byteAt: source + idx - 1]]
  		ifFalse: 
  			[source isCArray ifTrue:
  				[[ :idx | source at: idx - 1]]]].
  	getBlock ifNil: [self error: 'unhandled type of source string'].
  	setBlock := destination isCollection ifTrue: 
  		[destination isString ifTrue:
  			"basicAt:put: stores integers"
  			[[ :idx | destination basicAt: idx put: (getBlock value: idx)]] 
  		ifFalse: 
  			[destination class == ByteArray ifTrue: 
  				[[ :idx | destination at: idx put: (getBlock value: idx)]]]]
  	ifFalse: 
  		[destination isInteger ifTrue:
+ 			[| objectMemory |
+ 			objectMemory := self objectMemory.
+ 			[ :idx | objectMemory byteAt: destination + idx - 1 put: (getBlock value: idx)]]
- 			[[ :idx | self byteAt: destination + idx - 1 put: (getBlock value: idx)]]
  		ifFalse:
  			[destination isCArray ifTrue:
  				[[ :idx | destination at: idx - 1 put: (getBlock value: idx)]]]].
  	setBlock ifNil: [self error: 'unhandled type of destination string'].
  	1 to: bytes do: setBlock.
  
  	^destination!

Item was changed:
  ----- Method: VMPluginCodeGenerator>>accessorsAndAssignmentsForSubMethodNamed:actuals:depth:interpreterClass:into: (in category 'spur primitive compilation') -----
  accessorsAndAssignmentsForSubMethodNamed: selector actuals: actualParameters depth: depth interpreterClass: interpreterClass into: aTrinaryBlock
  	"Evaluate aTrinaryBlock with the root accessor sends, accessor sends and assignments in the sub-method named selector."
  
  	| method map |
  	(inProgressSelectors includes: selector) ifTrue:
  		[^nil].
  	inProgressSelectors add: selector.
  	method := self methodNamed: selector.
  	"this is unsatisfactory.  a pluggable scheme that asks the relevant plugin the right question would
  	 be better but for now the only cross-plugin load is for loadBitBltFrom:warping: and variants."
  	(#(loadBitBltFrom: loadWarpBltFrom: loadBitBltFrom:warping:) includes: selector) ifTrue:
  		[(method isNil
  		  or: [method definingClass ~~ BitBltSimulation]) ifTrue:
  			[method := (BitBltSimulation >> selector) asTranslationMethodOfClass: TMethod]].
  	method ifNil:
  		[^nil].
  	map := Dictionary new.
+ 	method argsForAccessorChainComputation do: [:var| map at: var put: depth asString, var].
- 	method args do: [:var| map at: var put: depth asString, var].
  	method locals do: [:var| map at: var put: depth asString, var].
  	^self accessorsAndAssignmentsForMethod: (method copy renameVariablesUsing: map)
+ 		actuals: (actualParameters ifEmpty: [method argsForAccessorChainComputation])
- 		actuals: actualParameters
  		depth: depth + 1
  		interpreterClass: interpreterClass
  		into: aTrinaryBlock!

Item was changed:
  ----- Method: VMPluginCodeGenerator>>isStackAccessor:given: (in category 'spur primitive compilation') -----
  isStackAccessor: selector given: interpreterClass
+ 	^(interpreterClass notNil and: [interpreterClass isStackAccessor: selector])
- 	^(interpreterClass isStackAccessor: selector)
  	 or: [pluginClass isStackAccessor: selector]
  	!



More information about the Vm-dev mailing list