[Vm-dev] VM Maker: VMMaker.oscog-eem.3080.mcz
commits at source.squeak.org
commits at source.squeak.org
Thu Sep 30 20:54:10 UTC 2021
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.3080.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.3080
Author: eem
Time: 30 September 2021, 1:53:54.974044 pm
UUID: ce2200b5-6a9f-4819-a0b7-a1ea8e2458a4
Ancestors: VMMaker.oscog-eem.3079
Spur:
Fix bad bug in comptation of accessor depths for primitives. The algorithm was fooled by code which assigned through an oject accessor, e.g.
bm := interpreterProxy arrayValueOf: (interpreterProxy stackValue: 1).
as opposed to
bmOop := interpreterProxy stackValue: 1.
bm := interpreterProxy arrayValueOf: bmOop.
In any case rewrite primitiveCompressToByteArray & primitiveDecompressFromByteArray to avoid the repeated slow stack accesses.
=============== Diff against VMMaker.oscog-eem.3079 ===============
Item was changed:
----- Method: CCodeGenerator>>accessorChainsForMethod:interpreterClass: (in category 'spur primitive compilation') -----
accessorChainsForMethod: method interpreterClass: interpreterClass
"Answer a set of access paths from arguments through objects, in the method, assuming
it is a primitive. This is in support of Spur's lazy become. A primitive may fail because it
may encounter a forwarder. The primitive failure code needs to know to what depth it
must follow arguments to follow forwarders and, if any are found and followed, retry the
primitive. 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."
| accessors assignments roots chains extendedChains extended lastPass |
self accessorsAndAssignmentsForMethod: method
actuals: (self actualsForMethod: method)
depth: 0
interpreterClass: interpreterClass
into: [:theRoots :theAccessors :theAssignments|
roots := theRoots.
accessors := theAccessors.
assignments := theAssignments].
"Compute the transitive closure of assignments of accessor sends or variables to variables from the roots.
Start from the stack accesses (the roots).
On the last pass look only for accessors of the targets of the tip assignments."
chains := OrderedCollection new.
+ roots do:
+ [:root|
+ chains
+ addAll: (assignments
+ select: [:assignment| assignment expression = root]
+ thenCollect: [:assignment| OrderedCollection with: assignment]);
+ addAll: (accessors
+ select: [:accessor| accessor anySatisfy: [:subnode| subnode = root]]
+ thenCollect: [:accessor| OrderedCollection with: accessor])].
- roots do: [:root| chains addAll: (assignments
- select: [:assignment| assignment expression = root]
- thenCollect: [:assignment| OrderedCollection with: assignment])].
lastPass := false.
[extended := false.
extendedChains := OrderedCollection new: chains size * 2.
chains do:
[:chain| | tip refs accessorRefs variableRefs |
+ chain last isAssignment
+ ifTrue:
+ [tip := chain last variable.
+ refs := accessors select: [:send| send args anySatisfy: [:arg| tip isSameAs: arg]]]
+ ifFalse:
+ [tip := chain last.
+ refs := #()].
- tip := chain last variable.
- refs := accessors select: [:send| send args anySatisfy: [:arg| tip isSameAs: arg]].
lastPass ifFalse:
[accessorRefs := refs collect: [:send|
assignments
detect: [:assignment|
assignment expression = send
and: [(chain includes: assignment) not]]
ifNone: []]
thenSelect: [:assignmentOrNil| assignmentOrNil notNil].
variableRefs := assignments select:
[:assignment|
(tip isSameAs: assignment expression)
and: [(tip isSameAs: assignment variable) not
and: [(chain includes: assignment) not]]].
refs := (Set withAll: accessorRefs) addAll: variableRefs; yourself].
refs isEmpty
ifTrue:
[extendedChains add: chain]
ifFalse:
[lastPass ifFalse: [extended := true].
self assert: (refs noneSatisfy: [:assignment| chain includes: assignment]).
extendedChains addAll: (refs collect: [:assignment| chain, {assignment}])]].
extended or: [lastPass not]] whileTrue:
[chains := extendedChains.
extended ifFalse: [lastPass := true]].
^chains!
Item was changed:
----- Method: MiscPrimitivePlugin>>primitiveCompressToByteArray (in category 'primitives') -----
primitiveCompressToByteArray
"Bitmap compress: bm toByteArray: ba"
<export: true flags: #FastCPrimitiveFlag>
+ | bmOop baOop bm ba eqBytes i j k lowByte size destSize word |
- | bm ba eqBytes i j k lowByte size destSize word |
<var: 'ba' type: #'unsigned char *'>
<var: 'bm' type: #'int *'>
+ bmOop := interpreterProxy stackValue: 1.
+ baOop := interpreterProxy stackValue: 0.
+ bm := self cCode: [interpreterProxy arrayValueOf: bmOop]
- bm := self cCode: [interpreterProxy arrayValueOf: (interpreterProxy stackValue: 1)]
inSmalltalk: [interpreterProxy
+ cCoerce: (interpreterProxy arrayValueOf: bmOop)
- cCoerce: (interpreterProxy arrayValueOf: (interpreterProxy stackValue: 1))
to: #'int *'].
interpreterProxy failed ifTrue: [^nil].
+ (interpreterProxy isBytes: baOop) ifFalse:
- (interpreterProxy isBytes: (interpreterProxy stackValue: 0)) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
+ (interpreterProxy isOopImmutable: baOop) ifTrue:
- (interpreterProxy isOopImmutable: (interpreterProxy stackValue: 0)) ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrNoModification].
+ ba := interpreterProxy firstIndexableField: baOop.
- ba := interpreterProxy firstIndexableField: (interpreterProxy stackValue: 0).
size := interpreterProxy sizeOfSTArrayFromCPrimitive: bm.
destSize := interpreterProxy sizeOfSTArrayFromCPrimitive: ba.
interpreterProxy failed ifTrue: "the sizeOfSTArrayFromCPrimitive:'s fail for e.g. CompiledMethod"
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
destSize < ((size * 4) + 7 + (size // 1984 * 3)) ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrUnsupported]. "Size may be OK but we don't know, hence fail with unsupported"
i := self encodeInt: size in: ba at: 0.
k := 0.
[k < size] whileTrue:
[word := bm at: k.
lowByte := word bitAnd: 255.
eqBytes := (word >> 8 bitAnd: 255) = lowByte and: [(word >> 16 bitAnd: 255) = lowByte and: [(word >> 24 bitAnd: 255) = lowByte]].
j := k.
[j + 1 < size and: [word = (bm at: j + 1)]] whileTrue: [j := j + 1].
j > k
ifTrue:
[eqBytes
ifTrue:
[i := self encodeInt: j - k + 1 * 4 + 1 in: ba at: i.
ba at: i put: lowByte.
i := i + 1]
ifFalse:
[i := self encodeInt: j - k + 1 * 4 + 2 in: ba at: i.
i := self encodeBytesOf: word in: ba at: i].
k := j + 1]
ifFalse:
[eqBytes
ifTrue:
[i := self encodeInt: 1 * 4 + 1 in: ba at: i.
ba at: i put: lowByte.
i := i + 1.
k := k + 1]
ifFalse:
[[j + 1 < size and: [(bm at: j) ~= (bm at: j + 1)]] whileTrue: [j := j + 1].
j + 1 = size ifTrue: [j := j + 1].
i := self encodeInt: j - k * 4 + 3 in: ba at: i.
k to: j - 1 by: 1 do: [ :m | i := self encodeBytesOf: (bm at: m) in: ba at: i].
k := j]]].
interpreterProxy methodReturnInteger: i!
Item was changed:
----- Method: MiscPrimitivePlugin>>primitiveDecompressFromByteArray (in category 'primitives') -----
primitiveDecompressFromByteArray
"Bitmap decompress: bm fromByteArray: ba at: index"
<export: true flags: #FastCPrimitiveFlag>
+ | bmOop baOop bm ba index i anInt code data end k n pastEnd |
- | bm ba index i anInt code data end k n pastEnd |
<var: 'ba' type: #'unsigned char *'>
<var: 'bm' type: #'int *'>
<var: 'anInt' type: #'unsigned int'>
<var: 'code' type: #'unsigned int'>
<var: 'data' type: #'unsigned int'>
<var: 'n' type: #'unsigned int'>
+ bmOop := interpreterProxy stackValue: 2.
+ baOop := interpreterProxy stackValue: 1.
+ bm := self cCode: [interpreterProxy arrayValueOf: bmOop]
- bm := self cCode: [interpreterProxy arrayValueOf: (interpreterProxy stackValue: 2)]
inSmalltalk: [interpreterProxy
+ cCoerce: (interpreterProxy arrayValueOf: bmOop)
- cCoerce: (interpreterProxy arrayValueOf: (interpreterProxy stackValue: 2))
to: #'int *'].
+ (interpreterProxy isOopImmutable: bmOop) ifTrue:
- (interpreterProxy isOopImmutable: (interpreterProxy stackValue: 2)) ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrNoModification].
+ (interpreterProxy isBytes: baOop) ifFalse:
- (interpreterProxy isBytes: (interpreterProxy stackValue: 1)) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
+ ba := interpreterProxy firstIndexableField: baOop.
- ba := interpreterProxy firstIndexableField: (interpreterProxy stackValue: 1).
index := interpreterProxy stackIntegerValue: 0.
end := interpreterProxy sizeOfSTArrayFromCPrimitive: ba.
pastEnd := interpreterProxy sizeOfSTArrayFromCPrimitive: bm.
interpreterProxy failed ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
i := index - 1.
k := 0.
[i < end] whileTrue:
[anInt := ba at: i.
i := i + 1.
anInt <= 223 ifFalse:
[anInt <= 254
ifTrue:
[anInt := anInt - 224 * 256 + (ba at: i).
i := i + 1]
ifFalse:
[anInt := 0.
1 to: 4 by: 1 do:
[ :j | anInt := (anInt bitShift: 8) + (ba at: i).
i := i + 1]]].
n := anInt >> 2.
k + n > pastEnd ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrBadIndex].
code := anInt bitAnd: 3.
"code = 0 ifTrue: [nil]."
code = 1 ifTrue:
[data := ba at: i.
i := i + 1.
data := data bitOr: (data bitShift: 8).
data := data bitOr: (data bitShift: 16).
1 to: n do:
[ :j |
bm at: k put: data.
k := k + 1]].
code = 2 ifTrue:
[data := 0.
1 to: 4 do:
[ :j |
data := (data bitShift: 8) bitOr: (ba at: i).
i := i + 1].
1 to: n do:
[ :j |
bm at: k put: data.
k := k + 1]].
code = 3 ifTrue:
[1 to: n do:
[ :m |
data := 0.
1 to: 4 do:
[ :j |
data := (data bitShift: 8) bitOr: (ba at: i).
i := i + 1].
bm at: k put: data.
k := k + 1]]].
interpreterProxy pop: interpreterProxy methodArgumentCount!
More information about the Vm-dev
mailing list