[Vm-dev] VM Maker: VMMaker.oscog-eem.2467.mcz
commits at source.squeak.org
commits at source.squeak.org
Mon Oct 22 16:37:40 UTC 2018
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.2467.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.2467
Author: eem
Time: 22 October 2018, 9:36:46.326124 am
UUID: d2018bf4-ea5f-4e5b-8c6f-af26f338a240
Ancestors: VMMaker.oscog-akg.2466
Plugins:
Fix a bug in FloatArrayPlugin>>primitiveDivFloatArray; the old code a) didn't check for -0.0 and b) didn't simulate. Eliminate several unnecessary stackObjectValue:'s in Matrix2x3Plugin; isWords: checkxs for immediates anyway. Fix several comments in FloatArrayPlugin primitives.
Simulator:
Fix simulation of the FloatArrayPlugin & Matrix2x3Plugin. Key is to implement cCoerce:to: in InterpreterPlugin to correctly coerce CArrays (as in self cCoerce: (interpreterProxy firstIndexableField: matrix) to: #'float *'), and to have CFloatArray>>at:put: convert floats via asIEEE[32|64]BitWord. Also fix coercion of CFloatArray back to CArray. Add Matrix2x3PluginSimulator to check primitiveComposeMatrix simulates correctly (there appear to be no tests; FloatArrayPluygin has a test suite).
Improve the performance of some of the C library simulations slightly and simplify where possible (basicAt:[put:] on strings fetch/store integers).
=============== Diff against VMMaker.oscog-akg.2466 ===============
Item was added:
+ ----- Method: CArray>>isCArray (in category 'testing') -----
+ isCArray
+ ^true!
Item was added:
+ ----- Method: CFloatArray>>asNonFloatAccessor (in category 'converting') -----
+ asNonFloatAccessor
+ | accessor |
+ CArray adoptInstance: (accessor := self shallowCopy unitSize: 8).
+ ^accessor!
Item was changed:
----- Method: CFloatArray>>at:put: (in category 'accessing') -----
at: offset put: val
| address |
address := unitSize * offset + self ptrAddress.
^unitSize >= 4
ifTrue:
[unitSize = 4
+ ifTrue: [interpreter long32At: address put: (val isFloat ifTrue: [val asIEEE32BitWord] ifFalse: [val])]
+ ifFalse: [interpreter long64At: address put: (val isFloat ifTrue: [val asIEEE64BitWord] ifFalse: [val])]]
- ifTrue: [interpreter long32At: address put: val]
- ifFalse: [interpreter long64At: address put: val]]
ifFalse:
[self error: 'unitSize must be 4 or 8']!
Item was added:
+ ----- Method: CFloatArray>>coerceTo:sim: (in category 'converting') -----
+ coerceTo: cTypeString sim: interpreterSimulator
+
+ ^cTypeString caseOf: {
+ ['float *'] -> [self shallowCopy unitSize: 4; yourself].
+ ['double *'] -> [self shallowCopy unitSize: 8; yourself] }
+ otherwise: [self asNonFloatAccessor coerceTo: cTypeString sim: interpreterSimulator]!
Item was changed:
----- Method: FloatArrayPlugin>>primitiveAt (in category 'access primitives') -----
primitiveAt
-
- | index rcvr floatValue floatPtr |
<export: true>
+ | index rcvr floatPtr |
- <var: #floatValue type: #double>
<var: #floatPtr type: #'float *'>
index := interpreterProxy stackIntegerValue: 0.
rcvr := interpreterProxy stackValue: 1.
(interpreterProxy failed not
and: [(interpreterProxy isWords: rcvr)
and: [index > 0 and: [index <= (interpreterProxy slotSizeOf: rcvr)]]]) ifFalse:
[^interpreterProxy primitiveFail].
+ floatPtr := self cCoerce: (interpreterProxy firstIndexableField: rcvr) to: #'float *'.
+ interpreterProxy methodReturnFloat: (floatPtr at: index - 1)!
- floatPtr := interpreterProxy firstIndexableField: rcvr.
- floatValue := (floatPtr at: index-1) asFloat.
- interpreterProxy pop: 2.
- interpreterProxy pushFloat: floatValue!
Item was changed:
----- Method: FloatArrayPlugin>>primitiveAtPut (in category 'access primitives') -----
primitiveAtPut
| value floatValue index rcvr floatPtr |
<export: true>
<var: #floatValue type: #double>
<var: #floatPtr type: #'float *'>
value := interpreterProxy stackValue: 0.
+ floatValue := (interpreterProxy isIntegerObject: value)
+ ifTrue: [(interpreterProxy integerValueOf: value) asFloat]
+ ifFalse: [interpreterProxy floatValueOf: value].
- (interpreterProxy isIntegerObject: value)
- ifTrue:[floatValue := (interpreterProxy integerValueOf: value) asFloat]
- ifFalse:[floatValue := interpreterProxy floatValueOf: value].
index := interpreterProxy stackIntegerValue: 1.
rcvr := interpreterProxy stackValue: 2.
(interpreterProxy failed not
and: [(interpreterProxy isWords: rcvr)
and: [index > 0 and: [index <= (interpreterProxy slotSizeOf: rcvr)]]]) ifFalse:
[^interpreterProxy primitiveFail].
+ floatPtr := self cCoerce: (interpreterProxy firstIndexableField: rcvr) to: #'float *'.
+ floatPtr at: index-1 put: (self cCoerce: floatValue to: #float).
- floatPtr := interpreterProxy firstIndexableField: rcvr.
- floatPtr at: index-1 put: (self cCoerce: floatValue to:#float).
interpreterProxy pop: 3 thenPush: value!
Item was changed:
----- Method: FloatArrayPlugin>>primitiveDivFloatArray (in category 'arithmetic primitives') -----
primitiveDivFloatArray
+ "Primitive. Divide each element in the receiver by the corresponding element in the argument, both FloatArrays, and store the result into the receiver."
- "Primitive. Add the receiver and the argument, both FloatArrays and store the result into the receiver."
- | rcvr arg rcvrPtr argPtr length |
<export: true>
+ | rcvr arg rcvrPtr argPtr length |
<var: #rcvrPtr type: #'float *'>
<var: #argPtr type: #'float *'>
arg := interpreterProxy stackValue: 0.
rcvr := interpreterProxy stackValue: 1.
((interpreterProxy isWords: arg)
and: [(interpreterProxy isWords: rcvr)
and: [(length := interpreterProxy stSizeOf: arg) = (interpreterProxy stSizeOf: rcvr)]]) ifFalse:
[^interpreterProxy primitiveFail].
rcvrPtr := self cCoerce: (interpreterProxy firstIndexableField: rcvr) to: #'float *'.
argPtr := self cCoerce: (interpreterProxy firstIndexableField: arg) to: #'float *'.
"Check if any of the argument's values is zero"
+ 0 to: length - 1 do:
+ [:i| (argPtr + i) = 0.0 ifTrue: "i.e. check for both 0.0 and -0.0"
+ [^interpreterProxy primitiveFail]].
+ 0 to: length - 1 do:
+ [:i| rcvrPtr at: i put: (self cCoerce: (rcvrPtr at: i) to: #double) / (self cCoerce: (argPtr at: i) to: #double)].
+ interpreterProxy pop: 1 "Leave rcvr on stack"!
- 0 to: length-1 do:[:i|
- (interpreterProxy intAtPointer:(self cCoerce: (argPtr + i) to: #'char*')) = 0 ifTrue:[^interpreterProxy primitiveFail]].
- 0 to: length-1 do:[:i|
- rcvrPtr at: i put: (self cCoerce: (rcvrPtr at: i) to: #double) / (self cCoerce: (argPtr at: i) to: #double).
- ].
- interpreterProxy pop: 1. "Leave rcvr on stack"!
Item was changed:
----- Method: FloatArrayPlugin>>primitiveDivScalar (in category 'arithmetic primitives') -----
primitiveDivScalar
+ "Primitive. Divide each element in the receiver by the argument, a scalar, and store the result into the receiver, a FloatArray"
- "Primitive. Add the argument, a scalar value to the receiver, a FloatArray"
| rcvr rcvrPtr value inverse length |
<export: true>
<var: #inverse type:'double '>
<var: #value type: #double>
<var: #rcvrPtr type:#'float *'>
value := interpreterProxy stackFloatValue: 0.
interpreterProxy failed ifTrue:[^nil].
rcvr := interpreterProxy stackValue: 1.
(interpreterProxy isWords: rcvr) ifFalse:
[^interpreterProxy primitiveFail].
length := interpreterProxy stSizeOf: rcvr.
rcvrPtr := self cCoerce: (interpreterProxy firstIndexableField: rcvr) to: #'float *'.
inverse := 1.0 / value.
0 to: length-1 do:[:i|
rcvrPtr at: i put: (self cCoerce: (rcvrPtr at: i) to: #double) * inverse.
].
+ interpreterProxy pop: 1 "Leave rcvr on stack"!
- interpreterProxy pop: 1. "Leave rcvr on stack"!
Item was changed:
----- Method: FloatArrayPlugin>>primitiveDotProduct (in category 'arithmetic primitives') -----
primitiveDotProduct
"Primitive. Compute the dot product of the receiver and the argument.
The dot product is defined as the sum of the products of the individual elements."
- | rcvr arg rcvrPtr argPtr length result |
<export: true>
+ | rcvr arg rcvrPtr argPtr length result |
<var: #result type: #double>
<var: #rcvrPtr type: #'float *'>
<var: #argPtr type: #'float *'>
arg := interpreterProxy stackValue: 0.
rcvr := interpreterProxy stackValue: 1.
((interpreterProxy isWords: arg)
and: [(interpreterProxy isWords: rcvr)
and: [(length := interpreterProxy stSizeOf: arg) = (interpreterProxy stSizeOf: rcvr)]]) ifFalse:
[^interpreterProxy primitiveFail].
rcvrPtr := self cCoerce: (interpreterProxy firstIndexableField: rcvr) to: #'float *'.
argPtr := self cCoerce: (interpreterProxy firstIndexableField: arg) to: #'float *'.
result := 0.0.
0 to: length-1 do:[:i|
+ result := result + ((self cCoerce: (rcvrPtr at: i) to: #double) * (self cCoerce: (argPtr at: i) to: #double)).
- result := result + ((self cCoerce: (rcvrPtr at: i) to: 'double') * (self cCoerce: (argPtr at: i) to: 'double')).
].
+ interpreterProxy methodReturnFloat: result. "Return result"!
- interpreterProxy pop: 2. "Pop args + rcvr"
- interpreterProxy pushFloat: result. "Return result"!
Item was changed:
----- Method: FloatArrayPlugin>>primitiveHashArray (in category 'access primitives') -----
primitiveHashArray
| rcvr rcvrPtr length result |
<export: true>
<var: #rcvrPtr type: #'int *'>
rcvr := interpreterProxy stackValue: 0.
(interpreterProxy isWords: rcvr) ifFalse:
[^interpreterProxy primitiveFail].
length := interpreterProxy stSizeOf: rcvr.
rcvrPtr := self cCoerce: (interpreterProxy firstIndexableField: rcvr) to: #'int *'.
result := 0.
0 to: length-1 do:[:i|
result := result + (rcvrPtr at: i).
].
+ interpreterProxy methodReturnInteger: (result bitAnd: 16r1FFFFFFF)!
- interpreterProxy pop: 1.
- ^interpreterProxy pushInteger: (result bitAnd: 16r1FFFFFFF)!
Item was changed:
----- Method: FloatArrayPlugin>>primitiveMulFloatArray (in category 'arithmetic primitives') -----
primitiveMulFloatArray
+ "Primitive. Multiply the receiver and the argument, both FloatArrays and store the result into the receiver."
- "Primitive. Add the receiver and the argument, both FloatArrays and store the result into the receiver."
- | rcvr arg rcvrPtr argPtr length |
<export: true>
+ | rcvr arg rcvrPtr argPtr length |
<var: #rcvrPtr type: #'float *'>
<var: #argPtr type: #'float *'>
arg := interpreterProxy stackValue: 0.
rcvr := interpreterProxy stackValue: 1.
((interpreterProxy isWords: arg)
and: [(interpreterProxy isWords: rcvr)
and: [(length := interpreterProxy stSizeOf: arg) = (interpreterProxy stSizeOf: rcvr)]]) ifFalse:
[^interpreterProxy primitiveFail].
rcvrPtr := self cCoerce: (interpreterProxy firstIndexableField: rcvr) to: #'float *'.
argPtr := self cCoerce: (interpreterProxy firstIndexableField: arg) to: #'float *'.
0 to: length-1 do:[:i|
rcvrPtr at: i put: (self cCoerce: (rcvrPtr at: i) to: #double) * (self cCoerce: (argPtr at: i) to: #double).
].
+ interpreterProxy pop: 1 "Leave rcvr on stack"!
- interpreterProxy pop: 1. "Leave rcvr on stack"!
Item was changed:
----- Method: FloatArrayPlugin>>primitiveMulScalar (in category 'arithmetic primitives') -----
primitiveMulScalar
- "Primitive. Add the argument, a scalar value to the receiver, a FloatArray"
- | rcvr rcvrPtr value length |
<export: true>
+ "Primitive. Multiply elements in the receiver, a FloatArray, by argument, a scalar value, and store the result into the receiver."
+ | rcvr rcvrPtr value length |
<var: #value type: #double>
<var: #rcvrPtr type:#'float *'>
value := interpreterProxy stackFloatValue: 0.
interpreterProxy failed ifTrue:[^nil].
rcvr := interpreterProxy stackValue: 1.
(interpreterProxy isWords: rcvr) ifFalse:
[^interpreterProxy primitiveFail].
length := interpreterProxy stSizeOf: rcvr.
rcvrPtr := self cCoerce: (interpreterProxy firstIndexableField: rcvr) to: #'float *'.
0 to: length-1 do:[:i|
rcvrPtr at: i put: (self cCoerce: (rcvrPtr at: i) to: #double) * value.
].
+ interpreterProxy pop: 1 "Leave rcvr on stack"!
- interpreterProxy pop: 1. "Leave rcvr on stack"!
Item was changed:
----- Method: FloatArrayPlugin>>primitiveSubFloatArray (in category 'arithmetic primitives') -----
primitiveSubFloatArray
+ "Primitive. Subtract each element in the argument from each element in the receiver, both FloatArrays and store the result into the receiver."
- "Primitive. Add the receiver and the argument, both FloatArrays and store the result into the receiver."
- | rcvr arg rcvrPtr argPtr length |
<export: true>
+ | rcvr arg rcvrPtr argPtr length |
<var: #rcvrPtr type: #'float *'>
<var: #argPtr type: #'float *'>
arg := interpreterProxy stackValue: 0.
rcvr := interpreterProxy stackValue: 1.
((interpreterProxy isWords: arg)
and: [(interpreterProxy isWords: rcvr)
and: [(length := interpreterProxy stSizeOf: arg) = (interpreterProxy stSizeOf: rcvr)]]) ifFalse:
[^interpreterProxy primitiveFail].
rcvrPtr := self cCoerce: (interpreterProxy firstIndexableField: rcvr) to: #'float *'.
argPtr := self cCoerce: (interpreterProxy firstIndexableField: arg) to: #'float *'.
0 to: length-1 do:[:i|
rcvrPtr at: i put: (self cCoerce: (rcvrPtr at: i) to: #double) - (self cCoerce: (argPtr at: i) to: #double).
].
+ interpreterProxy pop: 1 "Leave rcvr on stack"!
- interpreterProxy pop: 1. "Leave rcvr on stack"!
Item was changed:
----- Method: FloatArrayPlugin>>primitiveSubScalar (in category 'arithmetic primitives') -----
primitiveSubScalar
+ "Primitive. Subtract the argument, a scalar value from each element in the receiver, a FloatArray"
- "Primitive. Add the argument, a scalar value to the receiver, a FloatArray"
- | rcvr rcvrPtr value length |
<export: true>
+ | rcvr rcvrPtr value length |
<var: #value type: #double>
<var: #rcvrPtr type:#'float *'>
value := interpreterProxy stackFloatValue: 0.
interpreterProxy failed ifTrue:[^nil].
rcvr := interpreterProxy stackValue: 1.
(interpreterProxy isWords: rcvr) ifFalse:
[^interpreterProxy primitiveFail].
length := interpreterProxy stSizeOf: rcvr.
rcvrPtr := self cCoerce: (interpreterProxy firstIndexableField: rcvr) to: #'float *'.
0 to: length-1 do:[:i|
rcvrPtr at: i put: (self cCoerce: (rcvrPtr at: i) to: #double) - value.
].
+ interpreterProxy pop: 1 "Leave rcvr on stack"!
- interpreterProxy pop: 1. "Leave rcvr on stack"!
Item was changed:
----- Method: FloatArrayPlugin>>primitiveSum (in category 'arithmetic primitives') -----
primitiveSum
+ "Primitive. Answer the sum of each float in the receiver, a FloatArray."
- "Primitive. Find the sum of each float in the receiver, a FloatArray, and stash the result into the argument Float."
- | rcvr rcvrPtr length sum |
<export: true>
+ | rcvr rcvrPtr length sum |
<var: #sum type: #double>
<var: #rcvrPtr type: #'float *'>
rcvr := interpreterProxy stackValue: 0.
(interpreterProxy isWords: rcvr) ifFalse:
[^interpreterProxy primitiveFail].
length := interpreterProxy stSizeOf: rcvr.
rcvrPtr := self cCoerce: (interpreterProxy firstIndexableField: rcvr) to: #'float *'.
sum := 0.0.
0 to: length-1 do:[:i|
sum := sum + (self cCoerce: (rcvrPtr at: i) to: #double).
].
interpreterProxy methodReturnFloat: sum!
Item was changed:
----- Method: InterpreterPlugin>>cCoerce:to: (in category 'simulation') -----
+ cCoerce: value to: cTypeString
- cCoerce: value to: cType
<doNotGenerate>
"Type coercion for translation only; just return the value when running in Smalltalk.
This overrides the generic coercion method in VMClass. For some reason we are the exception.
If we want that style of coercion we can send cCoerce:to: to interpreterProxy, not self."
+ ^value isCArray
+ ifTrue: [value coerceTo: cTypeString sim: interpreterProxy]
+ ifFalse: [value]!
- ^value!
Item was added:
+ ----- Method: Matrix2x3Plugin class>>simulatorClass (in category 'simulation') -----
+ simulatorClass
+ ^Matrix2x3PluginSimulator!
Item was changed:
----- Method: Matrix2x3Plugin>>loadArgumentMatrix: (in category 'private') -----
loadArgumentMatrix: matrix
"Load the argument matrix"
+ <returnTypeC: #'float *'>
+ <inline: #always>
+ ((interpreterProxy isWords: matrix) and: [(interpreterProxy slotSizeOf: matrix) = 6]) ifFalse:
+ [interpreterProxy primitiveFail.
+ ^nil].
+ ^self cCoerce: (interpreterProxy firstIndexableField: matrix) to: #'float *'!
- <returnTypeC: 'float *'>
- interpreterProxy failed ifTrue:[^nil].
- ((interpreterProxy isWords: matrix) and:[(interpreterProxy slotSizeOf: matrix) = 6])
- ifFalse:[interpreterProxy primitiveFail.
- ^nil].
- ^self cCoerce: (interpreterProxy firstIndexableField: matrix) to:'float *'.!
Item was changed:
----- Method: Matrix2x3Plugin>>loadArgumentPoint: (in category 'private') -----
loadArgumentPoint: point
"Load the argument point into m23ArgX and m23ArgY"
+ | oop |
- | oop isInt |
- interpreterProxy failed ifTrue:[^nil].
"Check class of point"
+ (interpreterProxy fetchClassOf: point) = interpreterProxy classPoint ifFalse:
+ [^interpreterProxy primitiveFail].
- (interpreterProxy fetchClassOf: point) = (interpreterProxy classPoint)
- ifFalse:[^interpreterProxy primitiveFail].
"Load X value"
oop := interpreterProxy fetchPointer: 0 ofObject: point.
+ (interpreterProxy isIntegerObject: oop)
+ ifTrue: [m23ArgX := interpreterProxy integerValueOf: oop]
+ ifFalse:
+ [(interpreterProxy isFloatObject: oop)
+ ifTrue: [m23ArgX := interpreterProxy floatValueOf: oop]
+ ifFalse: [interpreterProxy primitiveFail]].
- isInt := interpreterProxy isIntegerObject: oop.
- (isInt or:[interpreterProxy isFloatObject: oop])
- ifFalse:[^interpreterProxy primitiveFail].
- isInt
- ifTrue:[m23ArgX := interpreterProxy integerValueOf: oop]
- ifFalse:[m23ArgX := interpreterProxy floatValueOf: oop].
-
"Load Y value"
oop := interpreterProxy fetchPointer: 1 ofObject: point.
+ (interpreterProxy isIntegerObject: oop)
+ ifTrue: [m23ArgY := interpreterProxy integerValueOf: oop]
+ ifFalse:
+ [(interpreterProxy isFloatObject: oop)
+ ifTrue: [m23ArgY := interpreterProxy floatValueOf: oop]
+ ifFalse: [interpreterProxy primitiveFail]]!
- isInt := interpreterProxy isIntegerObject: oop.
- (isInt or:[interpreterProxy isFloatObject: oop])
- ifFalse:[^interpreterProxy primitiveFail].
- isInt
- ifTrue:[m23ArgY := interpreterProxy integerValueOf: oop]
- ifFalse:[m23ArgY := interpreterProxy floatValueOf: oop].
-
- !
Item was changed:
----- Method: Matrix2x3Plugin>>matrix2x3ComposeMatrix:with:into: (in category 'transforming') -----
matrix2x3ComposeMatrix: m1 with: m2 into: m3
"Multiply matrix m1 with m2 and store the result into m3."
| a11 a12 a13 a21 a22 a23 |
+ <var: #m1 type: #'const float *'>
+ <var: #m2 type: #'const float *'>
+ <var: #m3 type: #'float *'>
+ <var: #a11 type: #double>
+ <var: #a12 type: #double>
+ <var: #a13 type: #double>
+ <var: #a21 type: #double>
+ <var: #a22 type: #double>
+ <var: #a23 type: #double>
- <var: #m1 type: 'const float *'>
- <var: #m2 type: 'const float *'>
- <var: #m3 type: 'float *'>
- <var: #a11 type: 'double '>
- <var: #a12 type: 'double '>
- <var: #a13 type: 'double '>
- <var: #a21 type: 'double '>
- <var: #a22 type: 'double '>
- <var: #a23 type: 'double '>
a11 := ((m1 at: 0) * (m2 at: 0)) + ((m1 at: 1) * (m2 at: 3)).
a12 := ((m1 at: 0) * (m2 at: 1)) + ((m1 at: 1) * (m2 at: 4)).
a13 := ((m1 at: 0) * (m2 at: 2)) + ((m1 at: 1) * (m2 at: 5)) + (m1 at: 2).
a21 := ((m1 at: 3) * (m2 at: 0)) + ((m1 at: 4) * (m2 at: 3)).
a22 := ((m1 at: 3) * (m2 at: 1)) + ((m1 at: 4) * (m2 at: 4)).
a23 := ((m1 at: 3) * (m2 at: 2)) + ((m1 at: 4) * (m2 at: 5)) + (m1 at: 5).
+ m3 at: 0 put: (self cCoerce: a11 to: #float).
+ m3 at: 1 put: (self cCoerce: a12 to: #float).
+ m3 at: 2 put: (self cCoerce: a13 to: #float).
+ m3 at: 3 put: (self cCoerce: a21 to: #float).
+ m3 at: 4 put: (self cCoerce: a22 to: #float).
+ m3 at: 5 put: (self cCoerce: a23 to: #float)!
- m3 at: 0 put: (self cCoerce: a11 to: 'float').
- m3 at: 1 put: (self cCoerce: a12 to: 'float').
- m3 at: 2 put: (self cCoerce: a13 to: 'float').
- m3 at: 3 put: (self cCoerce: a21 to: 'float').
- m3 at: 4 put: (self cCoerce: a22 to: 'float').
- m3 at: 5 put: (self cCoerce: a23 to: 'float').
- !
Item was changed:
----- Method: Matrix2x3Plugin>>primitiveComposeMatrix (in category 'primitives') -----
primitiveComposeMatrix
- | m1 m2 m3 result |
<export: true>
+ | m1 m2 m3 result |
- <inline: false>
<var: #m1 type: #'float *'>
<var: #m2 type: #'float *'>
<var: #m3 type: #'float *'>
+ m3 := self loadArgumentMatrix: (result := interpreterProxy stackValue: 0).
+ m2 := self loadArgumentMatrix: (interpreterProxy stackValue: 1).
+ m1 := self loadArgumentMatrix: (interpreterProxy stackValue: 2).
+ interpreterProxy failed ifFalse:
+ [self matrix2x3ComposeMatrix: m1 with: m2 into: m3.
+ interpreterProxy pop: 3 thenPush: result]!
- self cCode: '' "Make this fail in simulation"
- inSmalltalk: [interpreterProxy success: false. ^ nil].
- m3 := self loadArgumentMatrix: (result := interpreterProxy stackObjectValue: 0).
- m2 := self loadArgumentMatrix: (interpreterProxy stackObjectValue: 1).
- m1 := self loadArgumentMatrix: (interpreterProxy stackObjectValue: 2).
- interpreterProxy failed ifTrue:[^nil].
- self matrix2x3ComposeMatrix: m1 with: m2 into: m3.
- interpreterProxy pop: 3 thenPush: result!
Item was changed:
----- Method: Matrix2x3Plugin>>primitiveInvertPoint (in category 'primitives') -----
primitiveInvertPoint
- | matrix |
<export: true>
+ | matrix |
+ <var: #matrix type: #'float *'>
+ self loadArgumentPoint: (interpreterProxy stackValue: 0).
+ matrix := self loadArgumentMatrix: (interpreterProxy stackValue: 1).
- <inline: false>
- <var: #matrix type: 'float *'>
- self loadArgumentPoint: (interpreterProxy stackObjectValue: 0).
- matrix := self loadArgumentMatrix: (interpreterProxy stackObjectValue: 1).
interpreterProxy failed ifTrue:[^nil].
self matrix2x3InvertPoint: matrix.
+ interpreterProxy failed ifFalse:[self roundAndStoreResultPoint: 2]!
- interpreterProxy failed ifFalse:[self roundAndStoreResultPoint: 2].!
Item was changed:
----- Method: Matrix2x3Plugin>>primitiveInvertRectInto (in category 'primitives') -----
primitiveInvertRectInto
- | matrix srcOop dstOop originX originY cornerX cornerY minX maxX minY maxY |
<export: true>
+ | matrix srcOop dstOop originX originY cornerX cornerY minX maxX minY maxY |
+ <var: #matrix type: #'float *'>
+ <var: #originX type: #double>
+ <var: #originY type: #double>
+ <var: #cornerX type: #double>
+ <var: #cornerY type: #double>
+ <var: #minX type: #double>
+ <var: #maxX type: #double>
+ <var: #minY type: #double>
+ <var: #maxY type: #double>
- <inline: false>
- <var: #matrix type: 'float *'>
- <var: #originX type: 'double '>
- <var: #originY type: 'double '>
- <var: #cornerX type: 'double '>
- <var: #cornerY type: 'double '>
- <var: #minX type: 'double '>
- <var: #maxX type: 'double '>
- <var: #minY type: 'double '>
- <var: #maxY type: 'double '>
+ dstOop := interpreterProxy stackValue: 0.
+ srcOop := interpreterProxy stackValue: 1.
+ matrix := self loadArgumentMatrix: (interpreterProxy stackValue: 2).
- dstOop := interpreterProxy stackObjectValue: 0.
- srcOop := interpreterProxy stackObjectValue: 1.
- matrix := self loadArgumentMatrix: (interpreterProxy stackObjectValue: 2).
- interpreterProxy failed ifTrue:[^nil].
+ (matrix notNil
+ and: [(interpreterProxy fetchClassOf: srcOop) = (interpreterProxy fetchClassOf: dstOop)
+ and: [(interpreterProxy isPointers: srcOop)
+ and: [(interpreterProxy slotSizeOf: srcOop) = 2]]]) ifFalse:
+ [^interpreterProxy primitiveFail].
- (interpreterProxy fetchClassOf: srcOop) = (interpreterProxy fetchClassOf: dstOop)
- ifFalse:[^interpreterProxy primitiveFail].
- (interpreterProxy isPointers: srcOop)
- ifFalse:[^interpreterProxy primitiveFail].
- (interpreterProxy slotSizeOf: srcOop) = 2
- ifFalse:[^interpreterProxy primitiveFail].
"Load top-left point"
self loadArgumentPoint: (interpreterProxy fetchPointer: 0 ofObject: srcOop).
+ interpreterProxy failed ifTrue: [^nil].
- interpreterProxy failed ifTrue:[^nil].
originX := m23ArgX.
originY := m23ArgY.
self matrix2x3InvertPoint: matrix.
minX := maxX := m23ResultX.
minY := maxY := m23ResultY.
"Load bottom-right point"
+ self loadArgumentPoint: (interpreterProxy fetchPointer: 1 ofObject: srcOop).
+ interpreterProxy failed ifTrue: [^nil].
- self loadArgumentPoint:(interpreterProxy fetchPointer: 1 ofObject: srcOop).
- interpreterProxy failed ifTrue:[^nil].
cornerX := m23ArgX.
cornerY := m23ArgY.
self matrix2x3InvertPoint: matrix.
minX := minX min: m23ResultX.
maxX := maxX max: m23ResultX.
minY := minY min: m23ResultY.
maxY := maxY max: m23ResultY.
"Load top-right point"
m23ArgX := cornerX.
m23ArgY := originY.
self matrix2x3InvertPoint: matrix.
minX := minX min: m23ResultX.
maxX := maxX max: m23ResultX.
minY := minY min: m23ResultY.
maxY := maxY max: m23ResultY.
"Load bottom-left point"
m23ArgX := originX.
m23ArgY := cornerY.
self matrix2x3InvertPoint: matrix.
minX := minX min: m23ResultX.
maxX := maxX max: m23ResultX.
minY := minY min: m23ResultY.
maxY := maxY max: m23ResultY.
+ dstOop := self roundAndStoreResultRect: dstOop x0: minX y0: minY x1: maxX y1: maxY.
+ interpreterProxy failed ifFalse:
+ [interpreterProxy pop: 3 thenPush: dstOop]!
- interpreterProxy failed ifFalse:[
- dstOop := self roundAndStoreResultRect: dstOop x0: minX y0: minY x1: maxX y1: maxY].
- interpreterProxy failed ifFalse:[
- interpreterProxy pop: 3 thenPush: dstOop
- ]
- !
Item was changed:
----- Method: Matrix2x3Plugin>>primitiveIsIdentity (in category 'primitives') -----
primitiveIsIdentity
- | matrix |
<export: true>
+ | matrix |
+ <var: #matrix type: #'float *'>
+ matrix := self loadArgumentMatrix: (interpreterProxy stackValue: 0).
+ interpreterProxy failed ifFalse:
+ [interpreterProxy methodReturnBool:(
+ ((matrix at: 0) = (self cCoerce: 1.0 to: #float)) &
+ ((matrix at: 1) = (self cCoerce: 0.0 to: #float)) &
+ ((matrix at: 2) = (self cCoerce: 0.0 to: #float)) &
+ ((matrix at: 3) = (self cCoerce: 0.0 to: #float)) &
+ ((matrix at: 4) = (self cCoerce: 1.0 to: #float)) &
+ ((matrix at: 5) = (self cCoerce: 0.0 to: #float)))]!
- <inline: false>
- <var: #matrix type: 'float *'>
- matrix := self loadArgumentMatrix: (interpreterProxy stackObjectValue: 0).
- interpreterProxy failed ifTrue:[^nil].
- interpreterProxy pop: 1.
- interpreterProxy pushBool:(
- ((matrix at: 0) = (self cCoerce: 1.0 to: 'float')) &
- ((matrix at: 1) = (self cCoerce: 0.0 to: 'float')) &
- ((matrix at: 2) = (self cCoerce: 0.0 to: 'float')) &
- ((matrix at: 3) = (self cCoerce: 0.0 to: 'float')) &
- ((matrix at: 4) = (self cCoerce: 1.0 to: 'float')) &
- ((matrix at: 5) = (self cCoerce: 0.0 to: 'float'))).!
Item was changed:
----- Method: Matrix2x3Plugin>>primitiveIsPureTranslation (in category 'primitives') -----
primitiveIsPureTranslation
- | matrix |
<export: true>
+ | matrix |
+ <var: #matrix type: #'float *'>
+ matrix := self loadArgumentMatrix: (interpreterProxy stackValue: 0).
+ interpreterProxy failed ifFalse:
+ [interpreterProxy methodReturnBool:(
+ ((matrix at: 0) = (self cCoerce: 1.0 to: #float)) &
+ ((matrix at: 1) = (self cCoerce: 0.0 to: #float)) &
+ ((matrix at: 3) = (self cCoerce: 0.0 to: #float)) &
+ ((matrix at: 4) = (self cCoerce: 1.0 to: #float)))]!
- <inline: false>
- <var: #matrix type: 'float *'>
- matrix := self loadArgumentMatrix: (interpreterProxy stackObjectValue: 0).
- interpreterProxy failed ifTrue:[^nil].
- interpreterProxy pop: 1.
- interpreterProxy pushBool:(
- ((matrix at: 0) = (self cCoerce: 1.0 to: 'float')) &
- ((matrix at: 1) = (self cCoerce: 0.0 to: 'float')) &
- ((matrix at: 3) = (self cCoerce: 0.0 to: 'float')) &
- ((matrix at: 4) = (self cCoerce: 1.0 to: 'float'))).!
Item was changed:
----- Method: Matrix2x3Plugin>>primitiveTransformPoint (in category 'primitives') -----
primitiveTransformPoint
- | matrix |
<export: true>
+ | matrix |
+ <var: #matrix type: #'float *'>
+ self loadArgumentPoint: (interpreterProxy stackValue: 0).
+ matrix := self loadArgumentMatrix: (interpreterProxy stackValue: 1).
+ interpreterProxy failed ifFalse:
+ [self matrix2x3TransformPoint: matrix.
+ self roundAndStoreResultPoint: 2]!
- <inline: false>
- <var: #matrix type: 'float *'>
- self loadArgumentPoint: (interpreterProxy stackObjectValue: 0).
- matrix := self loadArgumentMatrix: (interpreterProxy stackObjectValue: 1).
- interpreterProxy failed ifTrue:[^nil].
- self matrix2x3TransformPoint: matrix.
- self roundAndStoreResultPoint: 2.!
Item was changed:
----- Method: Matrix2x3Plugin>>primitiveTransformRectInto (in category 'primitives') -----
primitiveTransformRectInto
- | matrix srcOop dstOop originX originY cornerX cornerY minX maxX minY maxY |
<export: true>
+ | matrix srcOop dstOop originX originY cornerX cornerY minX maxX minY maxY |
+ <var: #matrix type: #'float *'>
+ <var: #originX type: #double>
+ <var: #originY type: #double>
+ <var: #cornerX type: #double>
+ <var: #cornerY type: #double>
+ <var: #minX type: #double>
+ <var: #maxX type: #double>
+ <var: #minY type: #double>
+ <var: #maxY type: #double>
- <inline: false>
- <var: #matrix type: 'float *'>
- <var: #originX type: 'double '>
- <var: #originY type: 'double '>
- <var: #cornerX type: 'double '>
- <var: #cornerY type: 'double '>
- <var: #minX type: 'double '>
- <var: #maxX type: 'double '>
- <var: #minY type: 'double '>
- <var: #maxY type: 'double '>
+ dstOop := interpreterProxy stackValue: 0.
+ srcOop := interpreterProxy stackValue: 1.
+ matrix := self loadArgumentMatrix: (interpreterProxy stackValue: 2).
- dstOop := interpreterProxy stackObjectValue: 0.
- srcOop := interpreterProxy stackObjectValue: 1.
- matrix := self loadArgumentMatrix: (interpreterProxy stackObjectValue: 2).
- interpreterProxy failed ifTrue:[^nil].
+ (matrix notNil
+ and: [(interpreterProxy fetchClassOf: srcOop) = (interpreterProxy fetchClassOf: dstOop)
+ and: [(interpreterProxy isPointers: srcOop)
+ and: [(interpreterProxy slotSizeOf: srcOop) = 2]]]) ifFalse:
+ [^interpreterProxy primitiveFail].
- (interpreterProxy fetchClassOf: srcOop) = (interpreterProxy fetchClassOf: dstOop)
- ifFalse:[^interpreterProxy primitiveFail].
- (interpreterProxy isPointers: srcOop)
- ifFalse:[^interpreterProxy primitiveFail].
- (interpreterProxy slotSizeOf: srcOop) = 2
- ifFalse:[^interpreterProxy primitiveFail].
"Load top-left point"
self loadArgumentPoint: (interpreterProxy fetchPointer: 0 ofObject: srcOop).
interpreterProxy failed ifTrue:[^nil].
originX := m23ArgX.
originY := m23ArgY.
self matrix2x3TransformPoint: matrix.
minX := maxX := m23ResultX.
minY := maxY := m23ResultY.
"Load bottom-right point"
self loadArgumentPoint:(interpreterProxy fetchPointer: 1 ofObject: srcOop).
interpreterProxy failed ifTrue:[^nil].
cornerX := m23ArgX.
cornerY := m23ArgY.
self matrix2x3TransformPoint: matrix.
minX := minX min: m23ResultX.
maxX := maxX max: m23ResultX.
minY := minY min: m23ResultY.
maxY := maxY max: m23ResultY.
"Load top-right point"
m23ArgX := cornerX.
m23ArgY := originY.
self matrix2x3TransformPoint: matrix.
minX := minX min: m23ResultX.
maxX := maxX max: m23ResultX.
minY := minY min: m23ResultY.
maxY := maxY max: m23ResultY.
"Load bottom-left point"
m23ArgX := originX.
m23ArgY := cornerY.
self matrix2x3TransformPoint: matrix.
minX := minX min: m23ResultX.
maxX := maxX max: m23ResultX.
minY := minY min: m23ResultY.
maxY := maxY max: m23ResultY.
dstOop := self roundAndStoreResultRect: dstOop x0: minX y0: minY x1: maxX y1: maxY.
+ interpreterProxy failed ifFalse:
+ [interpreterProxy pop: 3 thenPush: dstOop]
- interpreterProxy failed ifFalse:[
- interpreterProxy pop: 3 thenPush: dstOop
- ]
!
Item was changed:
----- Method: Matrix2x3Plugin>>roundAndStoreResultRect:x0:y0:x1:y1: (in category 'private') -----
roundAndStoreResultRect: dstOop x0: x0 y0: y0 x1: x1 y1: y1
"Check, round and store the result of a rectangle operation"
+ <var: #x0 type: #double>
+ <var: #y0 type: #double>
+ <var: #x1 type: #double>
+ <var: #y1 type: #double>
+ | minX maxX minY maxY originOop cornerOop |
+ <var: #minX type: #double>
+ <var: #maxX type: #double>
+ <var: #minY type: #double>
+ <var: #maxY type: #double>
- | minX maxX minY maxY originOop cornerOop rectOop |
- <var: #x0 type: 'double '>
- <var: #y0 type: 'double '>
- <var: #x1 type: 'double '>
- <var: #y1 type: 'double '>
- <var: #minX type: 'double '>
- <var: #maxX type: 'double '>
- <var: #minY type: 'double '>
- <var: #maxY type: 'double '>
+ ((self okayIntValue: (minX := x0 + 0.5))
+ and: [(self okayIntValue: (maxX := x1 + 0.5))
+ and: [(self okayIntValue: (minY := y0 + 0.5))
+ and: [self okayIntValue: (maxY := y1 + 0.5)]]]) ifFalse:
+ [^interpreterProxy primitiveFail].
- minX := x0 + 0.5.
- (self okayIntValue: minX) ifFalse:[^interpreterProxy primitiveFail].
- maxX := x1 + 0.5.
- (self okayIntValue: maxX) ifFalse:[^interpreterProxy primitiveFail].
- minY := y0 + 0.5.
- (self okayIntValue: minY) ifFalse:[^interpreterProxy primitiveFail].
- maxY := y1 + 0.5.
- (self okayIntValue: maxY) ifFalse:[^interpreterProxy primitiveFail].
+ self remapOop: dstOop in:
+ [originOop := interpreterProxy makePointwithxValue: minX asInteger yValue: minY asInteger.
+ self remapOop: originOop in:
+ [cornerOop := interpreterProxy makePointwithxValue: maxX asInteger yValue: maxY asInteger]].
+ interpreterProxy
+ storePointer: 0 ofObject: dstOop withValue: originOop;
+ storePointer: 1 ofObject: dstOop withValue: cornerOop.
+ ^dstOop!
- interpreterProxy pushRemappableOop: dstOop.
- originOop := interpreterProxy makePointwithxValue: minX asInteger yValue: minY asInteger.
- interpreterProxy pushRemappableOop: originOop.
- cornerOop := interpreterProxy makePointwithxValue: maxX asInteger yValue: maxY asInteger.
- originOop := interpreterProxy popRemappableOop.
- rectOop := interpreterProxy popRemappableOop.
- interpreterProxy storePointer: 0 ofObject: rectOop withValue: originOop.
- interpreterProxy storePointer: 1 ofObject: rectOop withValue: cornerOop.
- ^rectOop!
Item was added:
+ Matrix2x3Plugin subclass: #Matrix2x3PluginSimulator
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'VMMaker-Plugins'!
Item was added:
+ ----- Method: Matrix2x3PluginSimulator>>primitiveComposeMatrix (in category 'primitives') -----
+ primitiveComposeMatrix
+ | m1 m2 m3 |
+ m2 := self stackMatrixValue: 1.
+ m1 := self stackMatrixValue: 2.
+ super primitiveComposeMatrix.
+ interpreterProxy failed ifFalse:
+ [m3 := self stackMatrixValue: 0.
+ self assert: m3 = (m1 composedWithLocal: m2)]!
Item was added:
+ ----- Method: Matrix2x3PluginSimulator>>stackMatrixValue: (in category 'simulation support') -----
+ stackMatrixValue: n
+ | maybeMatrixOop |
+ maybeMatrixOop := interpreterProxy stackValue: n.
+ ^((interpreterProxy isWords: maybeMatrixOop)
+ and: [(interpreterProxy slotSizeOf: maybeMatrixOop) = 6]) ifTrue:
+ [MatrixTransform2x3 new
+ basicAt: 1 put: (interpreterProxy fetchLong32: 0 ofObject: maybeMatrixOop);
+ basicAt: 2 put: (interpreterProxy fetchLong32: 1 ofObject: maybeMatrixOop);
+ basicAt: 3 put: (interpreterProxy fetchLong32: 2 ofObject: maybeMatrixOop);
+ basicAt: 4 put: (interpreterProxy fetchLong32: 3 ofObject: maybeMatrixOop);
+ basicAt: 5 put: (interpreterProxy fetchLong32: 4 ofObject: maybeMatrixOop);
+ basicAt: 6 put: (interpreterProxy fetchLong32: 5 ofObject: maybeMatrixOop);
+ yourself]!
Item was added:
+ ----- Method: Object>>isCArray (in category '*VMMaker-testing') -----
+ isCArray
+ ^false!
Item was changed:
----- Method: StackInterpreter>>tryLoadNewPlugin:pluginEntries: (in category 'primitive support') -----
tryLoadNewPlugin: pluginString pluginEntries: pluginEntries
"Load the plugin and if on Spur, populate pluginEntries with the prmitives in the plugin."
<doNotGenerate>
| plugin realPluginClass plugins simulatorClasses |
self transcript cr; show: 'Looking for module ', pluginString.
- "Defeat loading of the FloatArrayPlugin & Matrix2x3Plugin since complications with 32-bit
- float support prevent simulation. If you feel up to tackling this start by implementing
- cCoerce: value to: cType
- ^cType = 'float'
- ifTrue: [value asIEEE32BitWord]
- ifFalse: [value]
- in FloatArrayPlugin & Matrix2x3Plugin and then address the issues in the BalloonEnginePlugin.
- See http://forum.world.st/Simulating-the-BalloonEnginePlugin-FloatArrayPlugin-amp-Matrix2x3Plugin-primitives-td4734673.html"
- (#('FloatArrayPlugin' 'Matrix2x3Plugin') includes: pluginString) ifTrue:
- [self transcript show: ' ... defeated'. ^nil].
pluginString isEmpty
ifTrue:
[plugin := self]
ifFalse:
[plugins := InterpreterPlugin allSubclasses select: [:psc| psc moduleName asString = pluginString asString].
simulatorClasses := (plugins
select: [:psc| psc simulatorClass notNil]
thenCollect: [:psc| psc simulatorClass]) asSet.
simulatorClasses isEmpty ifTrue: [self transcript show: ' ... not found'. ^nil].
simulatorClasses size > 1 ifTrue: [^self error: 'This won''t work...'].
(plugins copyWithoutAll: simulatorClasses) notEmpty ifTrue:
[plugins := plugins copyWithoutAll: simulatorClasses].
plugins size > 1 ifTrue:
[self transcript show: '...multiple plugin classes; choosing ', plugins last name].
realPluginClass := plugins last. "hopefully lowest in the hierarchy..."
plugin := simulatorClasses anyOne newFor: realPluginClass.
plugin setInterpreter: objectMemory. "Ignore return value from setInterpreter"
(plugin respondsTo: #initialiseModule) ifTrue:
[plugin initialiseModule ifFalse:
[self transcript show: ' ... initialiser failed'. ^nil]]]. "module initialiser failed"
self transcript show: ' ... loaded'.
objectMemory hasSpurMemoryManagerAPI ifTrue:
[| realPlugin cg |
self transcript show: '...computing accessor depths'.
plugin class isPluginClass
ifTrue:
[realPlugin := (plugin isSmartSyntaxPluginSimulator
ifTrue: [realPluginClass]
ifFalse: [plugin class])
withAllSuperclasses detect: [:class| class shouldBeTranslated].
cg := realPlugin buildCodeGenerator]
ifFalse:
[cg := self codeGeneratorToComputeAccessorDepth.
primitiveTable withIndexDo:
[:prim :index| | depth |
prim isSymbol ifTrue:
[depth := cg accessorDepthForSelector: prim.
self assert: (depth isInteger or: [depth isNil and: [(plugin class whichClassIncludesSelector: prim) isNil]]).
primitiveAccessorDepthTable at: index - 1 put: depth]]].
cg exportedPrimitiveNames do:
[:primName| | fnSymbol |
fnSymbol := primName asSymbol.
pluginEntries addLast: {plugin.
fnSymbol.
[plugin perform: fnSymbol. self].
cg accessorDepthForSelector: fnSymbol}].
self transcript show: '...done'].
^pluginString asString -> plugin!
Item was changed:
----- Method: StackInterpreterPrimitives>>primitiveDoNamedPrimitiveWithArgs (in category 'plugin primitives') -----
primitiveDoNamedPrimitiveWithArgs
"Simulate an primitiveExternalCall invocation (e.g. for the Debugger). Do not cache anything.
e.g. ContextPart>>tryNamedPrimitiveIn: aCompiledMethod for: aReceiver withArgs: arguments"
| argumentArray arraySize methodArg methodHeader
moduleName functionName moduleLength functionLength
spec addr primRcvr isArray |
<var: #addr declareC: 'void (*addr)()'>
objectMemory hasSpurMemoryManagerAPI ifTrue: "See checkForAndFollowForwardedPrimitiveState"
[metaAccessorDepth := -2].
argumentArray := self stackTop.
methodArg := self stackValue: 2.
((objectMemory isArray: argumentArray)
and: [objectMemory isOopCompiledMethod: methodArg]) ifFalse:
[^self primitiveFailFor: -2]. "invalid args"
arraySize := objectMemory numSlotsOf: argumentArray.
(self roomToPushNArgs: arraySize) ifFalse:
[^self primitiveFailFor: -2]. "invalid args"
methodHeader := objectMemory methodHeaderOf: methodArg.
(objectMemory literalCountOfMethodHeader: methodHeader) > 2 ifFalse:
[^self primitiveFailFor: -3]. "invalid methodArg state"
spec := objectMemory fetchPointer: 1 "first literal" ofObject: methodArg.
isArray := self isInstanceOfClassArray: spec.
(isArray
and: [(objectMemory numSlotsOf: spec) = 4
and: [(self primitiveIndexOfMethod: methodArg header: methodHeader) = PrimNumberExternalCall]]) ifFalse:
[^self primitiveFailFor: -3]. "invalid methodArg state"
(self argumentCountOfMethodHeader: methodHeader) = arraySize ifFalse:
[^self primitiveFailFor: -2]. "invalid args (Array args wrong size)"
"The function has not been loaded yet. Fetch module and function name."
moduleName := objectMemory fetchPointer: 0 ofObject: spec.
moduleName = objectMemory nilObject
ifTrue: [moduleLength := 0]
ifFalse: [self success: (objectMemory isBytes: moduleName).
+ moduleLength := objectMemory lengthOf: moduleName].
- moduleLength := objectMemory lengthOf: moduleName.
- self cCode: '' inSmalltalk:
- [ (#('FloatArrayPlugin' 'Matrix2x3Plugin') includes: (self stringOf: moduleName)) "??"
- ifTrue: [moduleLength := 0 "Cause all of these to fail. Why?? eem 12/7/2017 09:37"]]].
functionName := objectMemory fetchPointer: 1 ofObject: spec.
self success: (objectMemory isBytes: functionName).
functionLength := objectMemory lengthOf: functionName.
self successful ifFalse: [^self primitiveFailFor: -3]. "invalid methodArg state"
"Spur needs to know the primitive's accessorDepth."
objectMemory hasSpurMemoryManagerAPI
ifTrue:
[addr := self ioLoadExternalFunction: functionName + objectMemory baseHeaderSize
OfLength: functionLength
FromModule: moduleName + objectMemory baseHeaderSize
OfLength: moduleLength
AccessorDepthInto: (self addressOf: metaAccessorDepth
put: [:val| metaAccessorDepth := val]).
addr = 0 ifTrue:
[metaAccessorDepth := -2]]
ifFalse:
[addr := self ioLoadExternalFunction: functionName + objectMemory baseHeaderSize
OfLength: functionLength
FromModule: moduleName + objectMemory baseHeaderSize
OfLength: moduleLength].
addr = 0 ifTrue:
[^self primitiveFailFor: -1]. "could not find function; answer generic failure (see below)"
"Cannot fail this primitive from now on. Can only fail the external primitive."
tempOop := objectMemory
eeInstantiateClassIndex: ClassArrayCompactIndex
format: objectMemory arrayFormat
numSlots: 4.
objectMemory
storePointerUnchecked: 0 ofObject: tempOop withValue: (argumentArray := self popStack);
storePointerUnchecked: 1 ofObject: tempOop withValue: (primRcvr := self popStack);
storePointerUnchecked: 2 ofObject: tempOop withValue: self popStack; "the method"
storePointerUnchecked: 3 ofObject: tempOop withValue: self popStack. "the context receiver"
self push: primRcvr. "replace context receiver with actual receiver"
argumentCount := arraySize.
1 to: arraySize do:
[:index| self push: (objectMemory fetchPointer: index - 1 ofObject: argumentArray)].
self callExternalPrimitive: addr.
self successful ifFalse: "If primitive failed, then restore state for failure code"
[self pop: arraySize + 1.
self push: (objectMemory fetchPointer: 3 ofObject: tempOop).
self push: (objectMemory fetchPointer: 2 ofObject: tempOop).
self push: (objectMemory fetchPointer: 1 ofObject: tempOop).
self push: (objectMemory fetchPointer: 0 ofObject: tempOop).
argumentCount := 3.
"Must reset primitiveFunctionPointer for checkForAndFollowForwardedPrimitiveState"
objectMemory hasSpurMemoryManagerAPI ifTrue:
[primitiveFunctionPointer := #primitiveDoNamedPrimitiveWithArgs].
"Hack. A nil prim error code (primErrorCode = 1) is interpreted by the image
as meaning this primitive is not implemented. So to pass back nil as an error
code we use -1 to indicate generic failure."
primFailCode = 1 ifTrue:
[primFailCode := -1]]!
Item was changed:
----- Method: VMClass>>memcpy:_:_: (in category 'C library simulation') -----
memcpy: dString _: sString _: bytes
<doNotGenerate>
"implementation of memcpy(3). N.B. If ranges overlap, must use memmove."
(dString isString or: [sString isString]) ifFalse:
[| destAddress sourceAddress |
dString class == ByteArray ifTrue:
+ [self memcpy: dString _: sString _: bytes].
- [ByteString adoptInstance: dString.
- ^[self memcpy: dString _: sString _: bytes] ensure:
- [ByteArray adoptInstance: dString]].
destAddress := dString asInteger.
sourceAddress := sString asInteger.
self deny: ((destAddress <= sourceAddress and: [destAddress + bytes > sourceAddress])
or: [sourceAddress <= destAddress and: [sourceAddress + bytes > destAddress]])].
+ dString isInteger
- dString isString
ifTrue:
[1 to: bytes do:
[:i| | v |
v := sString isString
+ ifTrue: [sString basicAt: i]
+ ifFalse: [self byteAt: sString + i - 1].
+ self byteAt: dString + i - 1 put: v]]
- ifTrue: [sString at: i]
- ifFalse: [Character value: (self byteAt: sString + i - 1)].
- dString at: i put: v]]
ifFalse:
[1 to: bytes do:
[:i| | v |
v := sString isString
+ ifTrue: [sString basicAt: i]
- ifTrue: [(sString at: i) asInteger]
ifFalse: [self byteAt: sString + i - 1].
+ dString basicAt: i put: v]].
- self byteAt: dString + i - 1 put: v]].
^dString!
Item was changed:
----- Method: VMClass>>strncmp:_:_: (in category 'C library simulation') -----
strncmp: aString _: bString _: n
<doNotGenerate>
"implementation of strncmp(3)"
+ bString isString
+ ifTrue:
+ [1 to: n do:
+ [:i| | v |
+ v := (aString basicAt: i) - (bString basicAt: i).
+ v ~= 0 ifTrue: [^v]]]
+ ifFalse:
+ [1 to: n do:
+ [:i| | v |
+ v := (aString basicAt: i) - (self byteAt: bString + i - 1).
+ v ~= 0 ifTrue: [^v]]].
- bString isString ifTrue:
- [1 to: n do:
- [:i|
- (aString at: i) asCharacter ~= (bString at: i) ifTrue:
- [^i]].
- ^0].
- 1 to: n do:
- [:i| | v |
- v := (aString at: i) asInteger - (self byteAt: bString + i - 1).
- v ~= 0 ifTrue: [^v]].
^0!
Item was changed:
----- Method: VMClass>>strncpy:_:_: (in category 'C library simulation') -----
+ strncpy: dest _: src _: n
- strncpy: aString _: bString _: n
<doNotGenerate>
+ "implementation of strncpy(3).
+ See e.g. https://manpages.debian.org/stretch/manpages-dev/strncpy.3.en.html
+ The C version always takes an address; the simulation allows a String, ByteArray,
+ CArray or address within the simulation object memory (Positive Integer)"
- "implementation of strncpy(3)"
-
| getBlock setBlock count |
-
count := n.
+ "Determine the source and destination access blocks based on the parameter type"
+ getBlock := src isCollection
+ ifTrue:
+ [count := count min: src size.
+ src isString
+ ifTrue: [[ :idx | src basicAt: idx]] "basicAt: answers integers"
+ ifFalse:
+ [src class == ByteArray ifTrue:
+ [[ :idx | src at: idx]]]]
+ ifFalse:
+ [src isInteger
+ ifTrue: [[ :idx | self byteAt: src + idx - 1]]
+ ifFalse:
+ [src class == CArray ifTrue:
+ [[ :idx | src at: idx - 1]]]].
+ getBlock ifNil: [self error: 'unhandled type of source string'].
+ setBlock := dest isCollection
+ ifTrue:
+ [dest isString
+ ifTrue: [[ :idx | dest basicAt: idx put: (getBlock value: idx)]] "basicAt:put: stores integers"
+ ifFalse:
+ [dest class == ByteArray ifTrue:
+ [[ :idx | dest at: idx put: (getBlock value: idx)]]]]
+ ifFalse:
+ [dest isInteger ifTrue:
+ [[ :idx | self byteAt: dest + idx - 1 put: (getBlock value: idx)]]].
+ setBlock ifNil: [self error: 'unhandled type of destination string'].
+ 1 to: count do: setBlock.
- aString isString ifTrue:
- [setBlock := [ :idx :ch | aString at: idx put: ch asCharacter]]
- ifFalse: [aString class == ByteArray ifTrue:
- [setBlock := [ :idx :ch | aString at: idx put: ch]]
- ifFalse: [aString isInteger ifTrue:
- [setBlock := [ :idx :ch | self byteAt: aString + idx - 1 put: ch]]]].
- bString isString ifTrue: [
- getBlock := [ :idx | (bString at: idx) asInteger ].
- count := count min: bString size]
- ifFalse: [bString class == ByteArray ifTrue: [
- getBlock := [ :idx | bString at: idx].
- count := count min: bString size]
- ifFalse: [bString isInteger ifTrue:
- [getBlock := [ :idx | self byteAt: bString + idx - 1]]
- ifFalse: [bString class == CArray ifTrue:
- [getBlock := [ :idx | bString at: idx - 1]]]]].
- 1 to: count do: [ :i | | v |
- v := getBlock value: i.
- setBlock value: i value: v].
"SVr4, 4.3BSD, C89, C99 require the remainder of the buffer be filled with nulls"
+ getBlock := [:idx| 0].
+ count + 1 to: n do: setBlock.
+ ^dest!
- count+1 to: n do: [ :i |
- setBlock value: i value: 0].
- ^aString!
More information about the Vm-dev
mailing list