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] !
vm-dev@lists.squeakfoundation.org