[Vm-dev] VM Maker: VMMaker.oscog-eem.1891.mcz
commits at source.squeak.org
commits at source.squeak.org
Wed Jun 29 19:35:19 UTC 2016
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.1891.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.1891
Author: eem
Time: 29 June 2016, 12:33:32.521203 pm
UUID: 496e6e75-7d9c-4299-8e65-e951b54de254
Ancestors: VMMaker.oscog-eem.1890
Simplify parameter validation in several plugins, especially the FloatArrayPlugin. stackObjectValue: checks for an object, failing if it accesses an immediate. But so do isWords:, isBytes: et al. There is no need to check twice. Further, the "interpreterProxy success: expr. ... interpreterProxy failed ifTrue: [^nil]" form contauns more calls then the "expr ifFalse: [^interpreterProxy primtiveFail]" form and so is slower.
Trying the Travis infrastructure to test this for the first time. Gulp. But I'd love others to eyeball this change (and use the style in future).
=============== Diff against VMMaker.oscog-eem.1890 ===============
Item was changed:
----- Method: FloatArrayPlugin>>primitiveAddFloatArray (in category 'arithmetic primitives') -----
primitiveAddFloatArray
"Primitive. Add the receiver and the argument, both FloatArrays and store the result into the receiver."
| rcvr arg rcvrPtr argPtr length |
<export: true>
+ <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 *'.
- <var: #rcvrPtr type:'float *'>
- <var: #argPtr type:'float *'>
- arg := interpreterProxy stackObjectValue: 0.
- rcvr := interpreterProxy stackObjectValue: 1.
- interpreterProxy failed ifTrue:[^nil].
- interpreterProxy success: (interpreterProxy isWords: arg).
- interpreterProxy success: (interpreterProxy isWords: rcvr).
- interpreterProxy failed ifTrue:[^nil].
- length := interpreterProxy stSizeOf: arg.
- interpreterProxy success: (length = (interpreterProxy stSizeOf: rcvr)).
- interpreterProxy failed ifTrue:[^nil].
- 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)].
- 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>>primitiveAddScalar (in category 'arithmetic primitives') -----
primitiveAddScalar
"Primitive. Add the argument, a scalar value to the receiver, a FloatArray"
| rcvr rcvrPtr value length |
<export: true>
+ <var: #value type: #double>
+ <var: #rcvrPtr type:#'float *'>
- <var: #value type:'double '>
- <var: #rcvrPtr type:'float *'>
value := interpreterProxy stackFloatValue: 0.
- rcvr := interpreterProxy stackObjectValue: 1.
interpreterProxy failed ifTrue:[^nil].
+ rcvr := interpreterProxy stackValue: 1.
+ (interpreterProxy isWords: rcvr) ifFalse:
+ [^interpreterProxy primitiveFail].
- interpreterProxy success: (interpreterProxy isWords: rcvr).
- interpreterProxy failed ifTrue:[^nil].
length := interpreterProxy stSizeOf: rcvr.
+ rcvrPtr := self cCoerce: (interpreterProxy firstIndexableField: rcvr) to: #'float *'.
- 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].
- rcvrPtr at: i put: (self cCoerce: (rcvrPtr at: i) to: 'double') + value].
interpreterProxy pop: 1. "Leave rcvr on stack"!
Item was changed:
----- Method: FloatArrayPlugin>>primitiveAt (in category 'access primitives') -----
primitiveAt
| index rcvr floatValue floatPtr |
<export: true>
+ <var: #floatValue type: #double>
+ <var: #floatPtr type: #'float *'>
- <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].
- rcvr := interpreterProxy stackObjectValue: 1.
- interpreterProxy failed ifTrue:[^nil].
- interpreterProxy success: (interpreterProxy isWords: rcvr).
- interpreterProxy success: (index > 0 and:[index <= (interpreterProxy slotSizeOf: rcvr)]).
- interpreterProxy failed ifTrue:[^nil].
floatPtr := interpreterProxy firstIndexableField: rcvr.
floatValue := (floatPtr at: index-1) asFloat.
interpreterProxy pop: 2.
+ interpreterProxy pushFloat: floatValue!
- 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 *'>
- <var: #floatValue type: 'double '>
- <var: #floatPtr type:'float *'>
value := interpreterProxy stackValue: 0.
(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].
- rcvr := interpreterProxy stackObjectValue: 2.
- interpreterProxy failed ifTrue:[^nil].
- interpreterProxy success: (interpreterProxy isWords: rcvr).
- interpreterProxy success: (index > 0 and:[index <= (interpreterProxy slotSizeOf: rcvr)]).
- interpreterProxy failed ifTrue:[^nil].
floatPtr := interpreterProxy firstIndexableField: rcvr.
+ floatPtr at: index-1 put: (self cCoerce: floatValue to:#float).
+ interpreterProxy pop: 3 thenPush: value!
- floatPtr at: index-1 put: (self cCoerce: floatValue to:'float').
- interpreterProxy failed ifFalse: [interpreterProxy pop: 3 thenPush: value].!
Item was changed:
----- Method: FloatArrayPlugin>>primitiveDivFloatArray (in category 'arithmetic primitives') -----
primitiveDivFloatArray
"Primitive. Add the receiver and the argument, both FloatArrays and store the result into the receiver."
| rcvr arg rcvrPtr argPtr length |
<export: true>
+ <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 *'.
- <var: #rcvrPtr type:'float *'>
- <var: #argPtr type:'float *'>
- arg := interpreterProxy stackObjectValue: 0.
- rcvr := interpreterProxy stackObjectValue: 1.
- interpreterProxy failed ifTrue:[^nil].
- interpreterProxy success: (interpreterProxy isWords: arg).
- interpreterProxy success: (interpreterProxy isWords: rcvr).
- interpreterProxy failed ifTrue:[^nil].
- length := interpreterProxy stSizeOf: arg.
- interpreterProxy success: (length = (interpreterProxy stSizeOf: rcvr)).
- interpreterProxy failed ifTrue:[^nil].
- 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|
+ (interpreterProxy intAtPointer:(self cCoerce: (argPtr + i) to: #'char*')) = 0 ifTrue:[^interpreterProxy primitiveFail]].
- ( 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).
- 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. Add the argument, a scalar value to the receiver, a FloatArray"
| rcvr rcvrPtr value inverse length |
<export: true>
- <var: #value type:'double '>
<var: #inverse type:'double '>
+ <var: #value type: #double>
+ <var: #rcvrPtr type:#'float *'>
- <var: #rcvrPtr type:'float *'>
value := interpreterProxy stackFloatValue: 0.
- rcvr := interpreterProxy stackObjectValue: 1.
interpreterProxy failed ifTrue:[^nil].
+ rcvr := interpreterProxy stackValue: 1.
+ (interpreterProxy isWords: rcvr) ifFalse:
+ [^interpreterProxy primitiveFail].
- value = 0.0 ifTrue:[^interpreterProxy primitiveFail].
- interpreterProxy success: (interpreterProxy isWords: rcvr).
- interpreterProxy failed ifTrue:[^nil].
length := interpreterProxy stSizeOf: rcvr.
+ rcvrPtr := self cCoerce: (interpreterProxy firstIndexableField: rcvr) to: #'float *'.
- 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.
- rcvrPtr at: i put: (self cCoerce: (rcvrPtr at: i) to: 'double') * inverse.
].
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>
+ <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 *'.
- <var: #rcvrPtr type:'float *'>
- <var: #argPtr type:'float *'>
- <var: #result type:'double '>
- arg := interpreterProxy stackObjectValue: 0.
- rcvr := interpreterProxy stackObjectValue: 1.
- interpreterProxy failed ifTrue:[^nil].
- interpreterProxy success: (interpreterProxy isWords: arg).
- interpreterProxy success: (interpreterProxy isWords: rcvr).
- interpreterProxy failed ifTrue:[^nil].
- length := interpreterProxy stSizeOf: arg.
- interpreterProxy success: (length = (interpreterProxy stSizeOf: rcvr)).
- interpreterProxy failed ifTrue:[^nil].
- 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')).
].
interpreterProxy pop: 2. "Pop args + rcvr"
interpreterProxy pushFloat: result. "Return result"!
Item was changed:
----- Method: FloatArrayPlugin>>primitiveEqual (in category 'access primitives') -----
primitiveEqual
| rcvr arg rcvrPtr argPtr length |
<export: true>
+ <var: #rcvrPtr type: #'float *'>
+ <var: #argPtr type: #'float *'>
+ arg := interpreterProxy stackValue: 0.
+ rcvr := interpreterProxy stackValue: 1.
+ ((interpreterProxy isWords: arg)
+ and: [(interpreterProxy isWords: rcvr)]) ifFalse:
+ [^interpreterProxy primitiveFail].
- <var: #rcvrPtr type:'float *'>
- <var: #argPtr type:'float *'>
- arg := interpreterProxy stackObjectValue: 0.
- rcvr := interpreterProxy stackObjectValue: 1.
- interpreterProxy failed ifTrue:[^nil].
- interpreterProxy success: (interpreterProxy isWords: arg).
- interpreterProxy success: (interpreterProxy isWords: rcvr).
- interpreterProxy failed ifTrue:[^nil].
interpreterProxy pop: 2.
+ (length := interpreterProxy stSizeOf: arg) = (interpreterProxy stSizeOf: rcvr) ifFalse:
+ [^interpreterProxy pushBool: false].
+ rcvrPtr := self cCoerce: (interpreterProxy firstIndexableField: rcvr) to: #'float *'.
+ argPtr := self cCoerce: (interpreterProxy firstIndexableField: arg) to: #'float *'.
- length := interpreterProxy stSizeOf: arg.
- length = (interpreterProxy stSizeOf: rcvr) ifFalse:[^interpreterProxy pushBool: false].
-
- 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) = (argPtr at: i) ifFalse:[^interpreterProxy pushBool: false].
].
^interpreterProxy pushBool: true!
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].
- <var: #rcvrPtr type:'int *'>
- rcvr := interpreterProxy stackObjectValue: 0.
- interpreterProxy failed ifTrue:[^nil].
- interpreterProxy success: (interpreterProxy isWords: rcvr).
- interpreterProxy failed ifTrue:[^nil].
length := interpreterProxy stSizeOf: rcvr.
+ rcvrPtr := self cCoerce: (interpreterProxy firstIndexableField: rcvr) to: #'int *'.
- rcvrPtr := self cCoerce: (interpreterProxy firstIndexableField: rcvr) to: 'int *'.
result := 0.
0 to: length-1 do:[:i|
result := result + (rcvrPtr at: i).
].
interpreterProxy pop: 1.
^interpreterProxy pushInteger: (result bitAnd: 16r1FFFFFFF)!
Item was changed:
----- Method: FloatArrayPlugin>>primitiveMulFloatArray (in category 'arithmetic primitives') -----
primitiveMulFloatArray
"Primitive. Add the receiver and the argument, both FloatArrays and store the result into the receiver."
| rcvr arg rcvrPtr argPtr length |
<export: true>
+ <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 *'.
- <var: #rcvrPtr type:'float *'>
- <var: #argPtr type:'float *'>
- arg := interpreterProxy stackObjectValue: 0.
- rcvr := interpreterProxy stackObjectValue: 1.
- interpreterProxy failed ifTrue:[^nil].
- interpreterProxy success: (interpreterProxy isWords: arg).
- interpreterProxy success: (interpreterProxy isWords: rcvr).
- interpreterProxy failed ifTrue:[^nil].
- length := interpreterProxy stSizeOf: arg.
- interpreterProxy success: (length = (interpreterProxy stSizeOf: rcvr)).
- interpreterProxy failed ifTrue:[^nil].
- 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).
- 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>>primitiveMulScalar (in category 'arithmetic primitives') -----
primitiveMulScalar
"Primitive. Add the argument, a scalar value to the receiver, a FloatArray"
| rcvr rcvrPtr value length |
<export: true>
+ <var: #value type: #double>
+ <var: #rcvrPtr type:#'float *'>
- <var: #value type:'double '>
- <var: #rcvrPtr type:'float *'>
value := interpreterProxy stackFloatValue: 0.
- rcvr := interpreterProxy stackObjectValue: 1.
interpreterProxy failed ifTrue:[^nil].
+ rcvr := interpreterProxy stackValue: 1.
+ (interpreterProxy isWords: rcvr) ifFalse:
+ [^interpreterProxy primitiveFail].
- interpreterProxy success: (interpreterProxy isWords: rcvr).
- interpreterProxy failed ifTrue:[^nil].
length := interpreterProxy stSizeOf: rcvr.
+ rcvrPtr := self cCoerce: (interpreterProxy firstIndexableField: rcvr) to: #'float *'.
- 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.
- rcvrPtr at: i put: (self cCoerce: (rcvrPtr at: i) to: 'double') * value.
].
interpreterProxy pop: 1. "Leave rcvr on stack"!
Item was changed:
----- Method: FloatArrayPlugin>>primitiveSubFloatArray (in category 'arithmetic primitives') -----
primitiveSubFloatArray
"Primitive. Add the receiver and the argument, both FloatArrays and store the result into the receiver."
| rcvr arg rcvrPtr argPtr length |
<export: true>
+ <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 *'.
- <var: #rcvrPtr type:'float *'>
- <var: #argPtr type:'float *'>
- arg := interpreterProxy stackObjectValue: 0.
- rcvr := interpreterProxy stackObjectValue: 1.
- interpreterProxy failed ifTrue:[^nil].
- interpreterProxy success: (interpreterProxy isWords: arg).
- interpreterProxy success: (interpreterProxy isWords: rcvr).
- interpreterProxy failed ifTrue:[^nil].
- length := interpreterProxy stSizeOf: arg.
- interpreterProxy success: (length = (interpreterProxy stSizeOf: rcvr)).
- interpreterProxy failed ifTrue:[^nil].
- 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).
- 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>>primitiveSubScalar (in category 'arithmetic primitives') -----
primitiveSubScalar
"Primitive. Add the argument, a scalar value to the receiver, a FloatArray"
| rcvr rcvrPtr value length |
<export: true>
+ <var: #value type: #double>
+ <var: #rcvrPtr type:#'float *'>
- <var: #value type:'double '>
- <var: #rcvrPtr type:'float *'>
value := interpreterProxy stackFloatValue: 0.
- rcvr := interpreterProxy stackObjectValue: 1.
interpreterProxy failed ifTrue:[^nil].
+ rcvr := interpreterProxy stackValue: 1.
+ (interpreterProxy isWords: rcvr) ifFalse:
+ [^interpreterProxy primitiveFail].
- interpreterProxy success: (interpreterProxy isWords: rcvr).
- interpreterProxy failed ifTrue:[^nil].
length := interpreterProxy stSizeOf: rcvr.
+ rcvrPtr := self cCoerce: (interpreterProxy firstIndexableField: rcvr) to: #'float *'.
- 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.
- rcvrPtr at: i put: (self cCoerce: (rcvrPtr at: i) to: 'double') - value.
].
interpreterProxy pop: 1. "Leave rcvr on stack"!
Item was changed:
----- Method: FloatArrayPlugin>>primitiveSum (in category 'arithmetic primitives') -----
primitiveSum
"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>
+ <var: #sum type: #double>
+ <var: #rcvrPtr type: #'float *'>
+ rcvr := interpreterProxy stackValue: 0.
+ (interpreterProxy isWords: rcvr) ifFalse:
+ [^interpreterProxy primitiveFail].
- <var: #sum type:'double '>
- <var: #rcvrPtr type:'float *'>
- rcvr := interpreterProxy stackObjectValue: 0.
- interpreterProxy failed ifTrue:[^nil].
- interpreterProxy success: (interpreterProxy isWords: rcvr).
- interpreterProxy failed ifTrue:[^nil].
length := interpreterProxy stSizeOf: rcvr.
+ rcvrPtr := self cCoerce: (interpreterProxy firstIndexableField: rcvr) to: #'float *'.
- 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).
- sum := sum + (self cCoerce: (rcvrPtr at: i) to: 'double').
].
interpreterProxy pop: 1 thenPush: (interpreterProxy floatObjectOf: sum)!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveScanCharacters (in category 'I/O primitives') -----
primitiveScanCharacters
"The character scanner primitive."
+ | kernDelta stops sourceString scanStopIndex scanStartIndex rcvr scanDestX scanLastIndex scanXTable
+ scanMap maxGlyph ascii stopReason glyphIndex sourceX sourceX2 nextDestX scanRightX nilOop |
- | kernDelta stops sourceString scanStopIndex scanStartIndex rcvr scanDestX scanLastIndex scanXTable scanMap maxGlyph ascii stopReason glyphIndex sourceX sourceX2 nextDestX scanRightX nilOop |
self methodArgumentCount = 6
ifFalse: [^ self primitiveFail].
"Load the receiver and arguments"
kernDelta := self stackIntegerValue: 0.
+ stops := self stackValue: 1.
- stops := self stackObjectValue: 1.
scanRightX := self stackIntegerValue: 2.
+ sourceString := self stackValue: 3.
- sourceString := self stackObjectValue: 3.
scanStopIndex := self stackIntegerValue: 4.
scanStartIndex := self stackIntegerValue: 5.
+ rcvr := self stackValue: 6.
- rcvr := self stackObjectValue: 6.
self successful ifFalse: [^ nil].
+ "check argument type and range and rcvr"
+ ((objectMemory isArray: stops)
+ and: [(objectMemory slotSizeOf: stops) >= 258
+ and: [(objectMemory isBytes: sourceString)
+ and: [scanStartIndex > 0
+ and: [scanStopIndex > 0
+ and: [scanStopIndex <= (objectMemory byteSizeOf: sourceString)
+ and: [(objectMemory isPointers: rcvr)
+ and: [(objectMemory slotSizeOf: rcvr) >= 4]]]]]]])
- "check argument type and range"
- (objectMemory isArray: stops) ifFalse: [^ self primitiveFail].
- (objectMemory slotSizeOf: stops) >= 258 ifFalse: [^ self primitiveFail].
- (objectMemory isBytes: sourceString) ifFalse: [^ self primitiveFail].
- (scanStartIndex > 0 and: [scanStopIndex > 0 and: [scanStopIndex <= (objectMemory byteSizeOf: sourceString)]])
ifFalse: [^ self primitiveFail].
+ "Check required rcvr instVars"
- "Check receiver and required instVars"
- ((objectMemory isPointers: rcvr) and: [(objectMemory slotSizeOf: rcvr) >= 4]) ifFalse: [^ self primitiveFail].
scanDestX := self fetchInteger: 0 ofObject: rcvr.
scanLastIndex := self fetchInteger: 1 ofObject: rcvr.
scanXTable := objectMemory fetchPointer: 2 ofObject: rcvr.
scanMap := objectMemory fetchPointer: 3 ofObject: rcvr.
+ ((objectMemory isArray: scanXTable)
+ and: [(objectMemory isArray: scanMap)
+ and: [(objectMemory slotSizeOf: scanMap) = 256
+ and: [self successful "for the fetchInteger:ofObject:'s abobve"]]]) ifFalse:
+ [^ self primitiveFail].
- ((objectMemory isArray: scanXTable) and: [objectMemory isArray: scanMap]) ifFalse: [^ self primitiveFail].
- (objectMemory slotSizeOf: scanMap) = 256 ifFalse: [^ self primitiveFail].
- self successful ifFalse: [^ nil].
maxGlyph := (objectMemory slotSizeOf: scanXTable) - 2.
"Okay, here we go. We have eliminated nearly all failure
conditions, to optimize the inner fetches."
scanLastIndex := scanStartIndex.
nilOop := objectMemory nilObject.
[scanLastIndex <= scanStopIndex]
whileTrue: [
"Known to be okay since scanStartIndex > 0 and scanStopIndex <= sourceString size"
ascii := objectMemory fetchByte: scanLastIndex - 1 ofObject: sourceString.
"Known to be okay since stops size >= 258"
(stopReason := objectMemory fetchPointer: ascii ofObject: stops) = nilOop
ifFalse: ["Store everything back and get out of here since some stop conditionn needs to be checked"
(objectMemory isIntegerValue: scanDestX) ifFalse: [^ self primitiveFail].
self storeInteger: 0 ofObject: rcvr withValue: scanDestX.
self storeInteger: 1 ofObject: rcvr withValue: scanLastIndex.
self pop: 7. "args+rcvr"
^ self push: stopReason].
"Known to be okay since scanMap size = 256"
glyphIndex := self fetchInteger: ascii ofObject: scanMap.
"fail if the glyphIndex is out of range"
(self failed or: [glyphIndex < 0 or: [glyphIndex > maxGlyph]]) ifTrue: [^ self primitiveFail].
sourceX := self fetchInteger: glyphIndex ofObject: scanXTable.
sourceX2 := self fetchInteger: glyphIndex + 1 ofObject: scanXTable.
"Above may fail if non-integer entries in scanXTable"
self failed ifTrue: [^ nil].
nextDestX := scanDestX + sourceX2 - sourceX.
nextDestX > scanRightX ifTrue:
["Store everything back and get out of here since we got to the right edge"
(objectMemory isIntegerValue: scanDestX) ifFalse: [^ self primitiveFail].
self storeInteger: 0 ofObject: rcvr withValue: scanDestX.
self storeInteger: 1 ofObject: rcvr withValue: scanLastIndex.
self pop: 7 "args+rcvr" thenPush: (objectMemory fetchPointer: CrossedX - 1 ofObject: stops).
^nil].
scanDestX := nextDestX + kernDelta.
scanLastIndex := scanLastIndex + 1].
(objectMemory isIntegerValue: scanDestX) ifFalse: [^ self primitiveFail].
self storeInteger: 0 ofObject: rcvr withValue: scanDestX.
self storeInteger: 1 ofObject: rcvr withValue: scanStopIndex.
self pop: 7 "args+rcvr" thenPush: (objectMemory fetchPointer: EndOfRun - 1 ofObject: stops)!
Item was changed:
----- Method: JPEGReaderPlugin>>primitiveColorConvertGrayscaleMCU (in category 'primitives') -----
primitiveColorConvertGrayscaleMCU
"Requires:
JPEGColorComponent
bits
WordArray with: 3*Integer (residuals)
ditherMask
"
| arrayOop |
<export: true>
self stInit.
interpreterProxy methodArgumentCount = 4
ifFalse:[^interpreterProxy primitiveFail].
ditherMask := interpreterProxy stackIntegerValue: 0.
- arrayOop := interpreterProxy stackObjectValue: 1.
interpreterProxy failed ifTrue:[^nil].
+ arrayOop := interpreterProxy stackValue: 1.
((interpreterProxy isWords: arrayOop) and:[(interpreterProxy slotSizeOf: arrayOop) = 3])
ifFalse:[^interpreterProxy primitiveFail].
residuals := interpreterProxy firstIndexableField: arrayOop.
+ arrayOop := interpreterProxy stackValue: 2.
- arrayOop := interpreterProxy stackObjectValue: 2.
- interpreterProxy failed ifTrue:[^nil].
(interpreterProxy isWords: arrayOop)
ifFalse:[^interpreterProxy primitiveFail].
jpegBitsSize := interpreterProxy slotSizeOf: arrayOop.
jpegBits := interpreterProxy firstIndexableField: arrayOop.
+ arrayOop := interpreterProxy stackValue: 3.
- arrayOop := interpreterProxy stackObjectValue: 3.
- interpreterProxy failed ifTrue:[^nil].
(self yColorComponentFrom: arrayOop)
ifFalse:[^interpreterProxy primitiveFail].
self colorConvertGrayscaleMCU.
+ interpreterProxy pop: 4!
- interpreterProxy pop: 4.!
Item was changed:
----- Method: JPEGReaderPlugin>>primitiveColorConvertMCU (in category 'primitives') -----
primitiveColorConvertMCU
"Requires:
Array with: 3*JPEGColorComponent
bits
WordArray with: 3*Integer (residuals)
ditherMask
"
| arrayOop |
<export: true>
self stInit.
interpreterProxy methodArgumentCount = 4
ifFalse:[^interpreterProxy primitiveFail].
ditherMask := interpreterProxy stackIntegerValue: 0.
- arrayOop := interpreterProxy stackObjectValue: 1.
interpreterProxy failed ifTrue:[^nil].
+ arrayOop := interpreterProxy stackValue: 1.
((interpreterProxy isWords: arrayOop) and:[(interpreterProxy slotSizeOf: arrayOop) = 3])
ifFalse:[^interpreterProxy primitiveFail].
residuals := interpreterProxy firstIndexableField: arrayOop.
+ arrayOop := interpreterProxy stackValue: 2.
- arrayOop := interpreterProxy stackObjectValue: 2.
- interpreterProxy failed ifTrue:[^nil].
(interpreterProxy isWords: arrayOop)
ifFalse:[^interpreterProxy primitiveFail].
jpegBitsSize := interpreterProxy slotSizeOf: arrayOop.
jpegBits := interpreterProxy firstIndexableField: arrayOop.
+ arrayOop := interpreterProxy stackValue: 3.
- arrayOop := interpreterProxy stackObjectValue: 3.
- interpreterProxy failed ifTrue:[^nil].
((interpreterProxy isPointers: arrayOop) and:[(interpreterProxy slotSizeOf: arrayOop) = 3])
ifFalse:[^interpreterProxy primitiveFail].
(self yColorComponentFrom: (interpreterProxy fetchPointer: 0 ofObject: arrayOop))
ifFalse:[^interpreterProxy primitiveFail].
(self cbColorComponentFrom: (interpreterProxy fetchPointer: 1 ofObject: arrayOop))
ifFalse:[^interpreterProxy primitiveFail].
(self crColorComponentFrom: (interpreterProxy fetchPointer: 2 ofObject: arrayOop))
ifFalse:[^interpreterProxy primitiveFail].
self colorConvertMCU.
+ interpreterProxy pop: 4!
- interpreterProxy pop: 4.!
Item was changed:
----- Method: JPEGReaderPlugin>>primitiveDecodeMCU (in category 'primitives') -----
primitiveDecodeMCU
"In:
anArray WordArray of: DCTSize2
aColorComponent JPEGColorComponent
dcTable WordArray
acTable WordArray
stream JPEGStream
"
| arrayOop oop anArray |
<export: true>
+ <var: #anArray type: #'int *'>
- <var: #anArray type: 'int *'>
self cCode:'' inSmalltalk:[self stInit].
interpreterProxy methodArgumentCount = 5
ifFalse:[^interpreterProxy primitiveFail].
+ oop := interpreterProxy stackValue: 0.
- oop := interpreterProxy stackObjectValue: 0.
- interpreterProxy failed ifTrue:[^nil].
(self loadJPEGStreamFrom: oop)
ifFalse:[^interpreterProxy primitiveFail].
+ arrayOop := interpreterProxy stackValue: 1.
- arrayOop := interpreterProxy stackObjectValue: 1.
- interpreterProxy failed ifTrue:[^nil].
(interpreterProxy isWords: arrayOop)
ifFalse:[^interpreterProxy primitiveFail].
acTableSize := interpreterProxy slotSizeOf: arrayOop.
acTable := interpreterProxy firstIndexableField: arrayOop.
+ arrayOop := interpreterProxy stackValue: 2.
- arrayOop := interpreterProxy stackObjectValue: 2.
- interpreterProxy failed ifTrue:[^nil].
(interpreterProxy isWords: arrayOop)
ifFalse:[^interpreterProxy primitiveFail].
dcTableSize := interpreterProxy slotSizeOf: arrayOop.
dcTable := interpreterProxy firstIndexableField: arrayOop.
+ oop := interpreterProxy stackValue: 3.
- oop := interpreterProxy stackObjectValue: 3.
- interpreterProxy failed ifTrue:[^nil].
(self colorComponent: yComponent from: oop)
ifFalse:[^interpreterProxy primitiveFail].
+ arrayOop := interpreterProxy stackValue: 4.
+ ((interpreterProxy isWords: arrayOop)
+ and: [(interpreterProxy slotSizeOf: arrayOop) = DCTSize2])
- arrayOop := interpreterProxy stackObjectValue: 4.
- interpreterProxy failed ifTrue:[^nil].
- (interpreterProxy isWords: arrayOop)
ifFalse:[^interpreterProxy primitiveFail].
- (interpreterProxy slotSizeOf: arrayOop) = DCTSize2
- ifFalse:[^interpreterProxy primitiveFail].
anArray := interpreterProxy firstIndexableField: arrayOop.
interpreterProxy failed ifTrue:[^nil].
self decodeBlockInto: anArray component: yComponent.
interpreterProxy failed ifTrue:[^nil].
self storeJPEGStreamOn: (interpreterProxy stackValue: 0).
interpreterProxy
storeInteger: PriorDCValueIndex
ofObject: (interpreterProxy stackValue: 3)
withValue: (yComponent at: PriorDCValueIndex).
+ interpreterProxy pop: 5!
- interpreterProxy pop: 5.!
Item was changed:
----- Method: JPEGReaderPlugin>>primitiveIdctInt (in category 'primitives') -----
primitiveIdctInt
"In:
anArray: IntegerArray new: DCTSize2
qt: IntegerArray new: DCTSize2.
"
| arrayOop anArray qt |
<export: true>
+ <var: #anArray type: #'int *'>
+ <var: #qt type: #'int *'>
- <var: #anArray type: 'int *'>
- <var: #qt type: 'int *'>
self cCode:'' inSmalltalk:[self stInit].
interpreterProxy methodArgumentCount = 2
ifFalse:[^interpreterProxy primitiveFail].
+ arrayOop := interpreterProxy stackValue: 0.
- arrayOop := interpreterProxy stackObjectValue: 0.
- interpreterProxy failed ifTrue:[^nil].
((interpreterProxy isWords: arrayOop) and:[(interpreterProxy slotSizeOf: arrayOop) = DCTSize2])
ifFalse:[^interpreterProxy primitiveFail].
qt := interpreterProxy firstIndexableField: arrayOop.
+ arrayOop := interpreterProxy stackValue: 1.
- arrayOop := interpreterProxy stackObjectValue: 1.
- interpreterProxy failed ifTrue:[^nil].
((interpreterProxy isWords: arrayOop) and:[(interpreterProxy slotSizeOf: arrayOop) = DCTSize2])
ifFalse:[^interpreterProxy primitiveFail].
anArray := interpreterProxy firstIndexableField: arrayOop.
self idctBlockInt: anArray qt: qt.
+ interpreterProxy pop: 2!
- interpreterProxy pop: 2.!
Item was changed:
----- Method: Spur32BitMMLECoSimulator>>firstIndexableField: (in category 'object format') -----
firstIndexableField: objOop
"NOTE: overridden from SpurMemoryManager to add coercion to CArray, so please duplicate any changes.
There are only two important cases, both for objects with named inst vars, i.e. formats 2,3 & 5.
The first indexable field for formats 2 & 5 is the slot count (by convention, even though that's off the end
of the object). For 3 we must go to the class."
| fmt classFormat |
<returnTypeC: #'void *'>
fmt := self formatOf: objOop.
fmt <= self lastPointerFormat ifTrue: "pointer; may need to delve into the class format word"
[(fmt between: self indexablePointersFormat and: self weakArrayFormat) ifTrue:
[classFormat := self formatOfClass: (self fetchClassOfNonImm: objOop).
^self cCoerce: (self pointerForOop: objOop
+ self baseHeaderSize
+ ((self fixedFieldsOfClassFormat: classFormat) << self shiftForWord))
to: #'oop *'].
^self cCoerce: (self pointerForOop: objOop
+ self baseHeaderSize
+ ((self numSlotsOf: objOop) << self shiftForWord))
to: #'oop *'].
+ "All bit objects, and indeed CompiledMethod, though this is a no-no, start at 0"
- "All bit objects, and indeed CompiledMethod, though this is a non-no, start at 0"
self assert: (fmt >= self sixtyFourBitIndexableFormat and: [fmt < self firstCompiledMethodFormat]).
^self
cCoerce: (self pointerForOop: objOop + self baseHeaderSize)
to: (fmt < self firstByteFormat
ifTrue:
[fmt = self sixtyFourBitIndexableFormat
ifTrue: ["64 bit field objects" #'long long *']
ifFalse:
[fmt < self firstShortFormat
ifTrue: ["32 bit field objects" #'int *']
ifFalse: ["16-bit field objects" #'short *']]]
ifFalse: ["byte objects (including CompiledMethod" #'char *'])!
Item was changed:
----- Method: Spur32BitMMLESimulator>>firstIndexableField: (in category 'object format') -----
firstIndexableField: objOop
"NOTE: overridden from SpurMemoryManager to add coercion to CArray, so please duplicate any changes.
There are only two important cases, both for objects with named inst vars, i.e. formats 2,3 & 5.
The first indexable field for formats 2 & 5 is the slot count (by convention, even though that's off the end
of the object). For 3 we must go to the class."
| fmt classFormat |
<returnTypeC: #'void *'>
fmt := self formatOf: objOop.
fmt <= self lastPointerFormat ifTrue: "pointer; may need to delve into the class format word"
[(fmt between: self indexablePointersFormat and: self weakArrayFormat) ifTrue:
[classFormat := self formatOfClass: (self fetchClassOfNonImm: objOop).
^self cCoerce: (self pointerForOop: objOop
+ self baseHeaderSize
+ ((self fixedFieldsOfClassFormat: classFormat) << self shiftForWord))
to: #'oop *'].
^self cCoerce: (self pointerForOop: objOop
+ self baseHeaderSize
+ ((self numSlotsOf: objOop) << self shiftForWord))
to: #'oop *'].
+ "All bit objects, and indeed CompiledMethod, though this is a no-no, start at 0"
- "All bit objects, and indeed CompiledMethod, though this is a non-no, start at 0"
self assert: (fmt >= self sixtyFourBitIndexableFormat and: [fmt < self firstCompiledMethodFormat]).
^self
cCoerce: (self pointerForOop: objOop + self baseHeaderSize)
to: (fmt < self firstByteFormat
ifTrue:
[fmt = self sixtyFourBitIndexableFormat
ifTrue: ["64 bit field objects" #'long long *']
ifFalse:
[fmt < self firstShortFormat
ifTrue: ["32 bit field objects" #'int *']
ifFalse: ["16-bit field objects" #'short *']]]
ifFalse: ["byte objects (including CompiledMethod" #'char *'])!
Item was changed:
----- Method: Spur64BitMMLECoSimulator>>firstIndexableField: (in category 'object format') -----
firstIndexableField: objOop
"NOTE: overridden from SpurMemoryManager to add coercion to CArray, so please duplicate any changes.
There are only two important cases, both for objects with named inst vars, i.e. formats 2,3 & 5.
The first indexable field for formats 2 & 5 is the slot count (by convention, even though that's off the end
of the object). For 3 we must go to the class."
| fmt classFormat |
<returnTypeC: #'void *'>
fmt := self formatOf: objOop.
fmt <= self lastPointerFormat ifTrue: "pointer; may need to delve into the class format word"
[(fmt between: self indexablePointersFormat and: self weakArrayFormat) ifTrue:
[classFormat := self formatOfClass: (self fetchClassOfNonImm: objOop).
^self cCoerce: (self pointerForOop: objOop
+ self baseHeaderSize
+ ((self fixedFieldsOfClassFormat: classFormat) << self shiftForWord))
to: #'oop *'].
^self cCoerce: (self pointerForOop: objOop
+ self baseHeaderSize
+ ((self numSlotsOf: objOop) << self shiftForWord))
to: #'oop *'].
+ "All bit objects, and indeed CompiledMethod, though this is a no-no, start at 0"
- "All bit objects, and indeed CompiledMethod, though this is a non-no, start at 0"
self assert: (fmt >= self sixtyFourBitIndexableFormat and: [fmt < self firstCompiledMethodFormat]).
^self
cCoerce: (self pointerForOop: objOop + self baseHeaderSize)
to: (fmt < self firstByteFormat
ifTrue:
[fmt = self sixtyFourBitIndexableFormat
ifTrue: ["64 bit field objects" #'long long *']
ifFalse:
[fmt < self firstShortFormat
ifTrue: ["32 bit field objects" #'int *']
ifFalse: ["16-bit field objects" #'short *']]]
ifFalse: ["byte objects (including CompiledMethod" #'char *'])!
Item was changed:
----- Method: Spur64BitMMLESimulator>>firstIndexableField: (in category 'object format') -----
firstIndexableField: objOop
"NOTE: overridden from SpurMemoryManager to add coercion to CArray, so please duplicate any changes.
There are only two important cases, both for objects with named inst vars, i.e. formats 2,3 & 5.
The first indexable field for formats 2 & 5 is the slot count (by convention, even though that's off the end
of the object). For 3 we must go to the class."
| fmt classFormat |
<returnTypeC: #'void *'>
fmt := self formatOf: objOop.
fmt <= self lastPointerFormat ifTrue: "pointer; may need to delve into the class format word"
[(fmt between: self indexablePointersFormat and: self weakArrayFormat) ifTrue:
[classFormat := self formatOfClass: (self fetchClassOfNonImm: objOop).
^self cCoerce: (self pointerForOop: objOop
+ self baseHeaderSize
+ ((self fixedFieldsOfClassFormat: classFormat) << self shiftForWord))
to: #'oop *'].
^self cCoerce: (self pointerForOop: objOop
+ self baseHeaderSize
+ ((self numSlotsOf: objOop) << self shiftForWord))
to: #'oop *'].
+ "All bit objects, and indeed CompiledMethod, though this is a no-no, start at 0"
- "All bit objects, and indeed CompiledMethod, though this is a non-no, start at 0"
self assert: (fmt >= self sixtyFourBitIndexableFormat and: [fmt < self firstCompiledMethodFormat]).
^self
cCoerce: (self pointerForOop: objOop + self baseHeaderSize)
to: (fmt < self firstByteFormat
ifTrue:
[fmt = self sixtyFourBitIndexableFormat
ifTrue: ["64 bit field objects" #'long long *']
ifFalse:
[fmt < self firstShortFormat
ifTrue: ["32 bit field objects" #'int *']
ifFalse: ["16-bit field objects" #'short *']]]
ifFalse: ["byte objects (including CompiledMethod" #'char *'])!
Item was changed:
----- Method: SpurMemoryManager>>firstIndexableField: (in category 'object format') -----
firstIndexableField: objOop
"NOTE: overridden in various simulator subclasses to add coercion to CArray, so please duplicate any changes.
There are only two important cases, both for objects with named inst vars, i.e. formats 2,3 & 5.
The first indexable field for formats 2 & 5 is the slot count (by convention, even though that's off the end
of the object). For 3 we must go to the class."
| fmt classFormat |
<returnTypeC: #'void *'>
fmt := self formatOf: objOop.
fmt <= self weakArrayFormat ifTrue:
[fmt = self arrayFormat ifTrue: "array starts at 0."
[^self pointerForOop: objOop + self baseHeaderSize].
fmt >= self indexablePointersFormat ifTrue: "indexable with inst vars; need to delve into the class format word"
[classFormat := self formatOfClass: (self fetchClassOfNonImm: objOop).
^self pointerForOop: objOop
+ self baseHeaderSize
+ ((self fixedFieldsOfClassFormat: classFormat) << self shiftForWord)].
"otherwise not indexable"
^0].
+ "All bit objects, and indeed CompiledMethod, though this is a no-no, start at 0"
- "All bit objects, and indeed CompiledMethod, though this is a non-no, start at 0"
(fmt >= self sixtyFourBitIndexableFormat
and: [fmt < self firstCompiledMethodFormat]) ifTrue:
[^self pointerForOop: objOop + self baseHeaderSize].
"otherwise not indexable"
^0!
Item was changed:
----- Method: SqueakSSLPlugin>>primitiveAccept (in category 'primitives') -----
primitiveAccept
"Primitive. Starts or continues a server handshake using the current session.
Will eventually produce output to be sent to the client. Requires the host
and cert name to be set for the session. Returns a code indicating the sate
of the connection:
> 0 - Number of bytes to be sent to the client.
0 - Success. The connection is established.
-1 - More input is required.
< -1 - Other errors.
"
| start srcLen dstLen srcOop dstOop handle srcPtr dstPtr result |
+ <var: #srcPtr type: #'char *'>
+ <var: #dstPtr type: #'char *'>
- <var: #srcPtr type: 'char *'>
- <var: #dstPtr type: 'char *'>
<export: true>
interpreterProxy methodArgumentCount = 5
ifFalse:[^interpreterProxy primitiveFail].
+ dstOop := interpreterProxy stackValue: 0.
- dstOop := interpreterProxy stackObjectValue: 0.
srcLen := interpreterProxy stackIntegerValue: 1.
start := interpreterProxy stackIntegerValue: 2.
+ srcOop := interpreterProxy stackValue: 3.
- srcOop := interpreterProxy stackObjectValue: 3.
handle := interpreterProxy stackIntegerValue: 4.
interpreterProxy failed ifTrue:[^nil].
((start > 0 and:[srcLen >= 0])
and:[(interpreterProxy isBytes: srcOop)
and:[(interpreterProxy isBytes: dstOop)
and:[(interpreterProxy byteSizeOf: srcOop) >= (start + srcLen - 1)]]])
ifFalse:[^interpreterProxy primitiveFail].
srcPtr := interpreterProxy firstIndexableField: srcOop.
dstPtr := interpreterProxy firstIndexableField: dstOop.
srcPtr := srcPtr + start - 1.
dstLen := interpreterProxy byteSizeOf: dstOop.
result := self cCode: 'sqAcceptSSL(handle, srcPtr, srcLen, dstPtr, dstLen)'
inSmalltalk:[handle. srcPtr. srcLen. dstPtr. dstLen. -2].
interpreterProxy failed ifTrue:[^nil].
interpreterProxy pop: interpreterProxy methodArgumentCount+1.
interpreterProxy pushInteger: result.!
Item was changed:
----- Method: SqueakSSLPlugin>>primitiveConnect (in category 'primitives') -----
primitiveConnect
"Primitive. Starts or continues a client handshake using the provided data.
Will eventually produce output to be sent to the server. Requires the host
name to be set for the session.
Returns:
> 0 - Number of bytes to be sent to the server
0 - Success. The connection is established.
-1 - More input is required.
< -1 - Other errors.
"
| start srcLen dstLen srcOop dstOop handle srcPtr dstPtr result |
+ <var: #srcPtr type: #'char *'>
+ <var: #dstPtr type: #'char *'>
- <var: #srcPtr type: 'char *'>
- <var: #dstPtr type: 'char *'>
<export: true>
interpreterProxy methodArgumentCount = 5
ifFalse:[^interpreterProxy primitiveFail].
+ dstOop := interpreterProxy stackValue: 0.
- dstOop := interpreterProxy stackObjectValue: 0.
srcLen := interpreterProxy stackIntegerValue: 1.
start := interpreterProxy stackIntegerValue: 2.
+ srcOop := interpreterProxy stackValue: 3.
- srcOop := interpreterProxy stackObjectValue: 3.
handle := interpreterProxy stackIntegerValue: 4.
interpreterProxy failed ifTrue:[^nil].
((start > 0 and:[srcLen >= 0])
and:[(interpreterProxy isBytes: srcOop)
and:[(interpreterProxy isBytes: dstOop)
and:[(interpreterProxy byteSizeOf: srcOop) >= (start + srcLen - 1)]]])
ifFalse:[^interpreterProxy primitiveFail].
srcPtr := interpreterProxy firstIndexableField: srcOop.
dstPtr := interpreterProxy firstIndexableField: dstOop.
srcPtr := srcPtr + start - 1.
dstLen := interpreterProxy byteSizeOf: dstOop.
result := self cCode: 'sqConnectSSL(handle, srcPtr, srcLen, dstPtr, dstLen)'
inSmalltalk:[handle. srcPtr. srcLen. dstPtr. dstLen. -2].
interpreterProxy failed ifTrue:[^nil].
interpreterProxy pop: interpreterProxy methodArgumentCount+1.
interpreterProxy pushInteger: result.!
Item was changed:
----- Method: SqueakSSLPlugin>>primitiveDecrypt (in category 'primitives') -----
primitiveDecrypt
"Primitive. Decrypts a buffer sent via the connection.
Requires the session to be established.
Returns:
>=0 - Number of bytes decrypted in the result buffer
< -1 - Other errors.
"
| start srcLen dstLen srcOop dstOop handle srcPtr dstPtr result |
<var: #srcPtr type: 'char *'>
<var: #dstPtr type: 'char *'>
<export: true>
interpreterProxy methodArgumentCount = 5
ifFalse:[^interpreterProxy primitiveFail].
+ dstOop := interpreterProxy stackValue: 0.
- dstOop := interpreterProxy stackObjectValue: 0.
srcLen := interpreterProxy stackIntegerValue: 1.
start := interpreterProxy stackIntegerValue: 2.
+ srcOop := interpreterProxy stackValue: 3.
- srcOop := interpreterProxy stackObjectValue: 3.
handle := interpreterProxy stackIntegerValue: 4.
interpreterProxy failed ifTrue:[^nil].
((start > 0 and:[srcLen >= 0])
and:[(interpreterProxy isBytes: srcOop)
and:[(interpreterProxy isBytes: dstOop)
and:[(interpreterProxy byteSizeOf: srcOop) >= (start + srcLen - 1)]]])
ifFalse:[^interpreterProxy primitiveFail].
srcPtr := interpreterProxy firstIndexableField: srcOop.
dstPtr := interpreterProxy firstIndexableField: dstOop.
srcPtr := srcPtr + start - 1.
dstLen := interpreterProxy byteSizeOf: dstOop.
result := self cCode: 'sqDecryptSSL(handle, srcPtr, srcLen, dstPtr, dstLen)'
inSmalltalk:[handle. srcPtr. srcLen. dstPtr. dstLen. -2].
interpreterProxy failed ifTrue:[^nil].
interpreterProxy pop: interpreterProxy methodArgumentCount+1.
interpreterProxy pushInteger: result.!
Item was changed:
----- Method: SqueakSSLPlugin>>primitiveEncrypt (in category 'primitives') -----
primitiveEncrypt
"Primitive. Encrypts a buffer to be sent to the via the connection.
Requires the session to be established.
Returns:
>=0 - Number of bytes encrypted in the result buffer
< -1 - Other errors.
"
| start srcLen dstLen srcOop dstOop handle srcPtr dstPtr result |
<var: #srcPtr type: 'char *'>
<var: #dstPtr type: 'char *'>
<export: true>
interpreterProxy methodArgumentCount = 5
ifFalse:[^interpreterProxy primitiveFail].
+ dstOop := interpreterProxy stackValue: 0.
- dstOop := interpreterProxy stackObjectValue: 0.
srcLen := interpreterProxy stackIntegerValue: 1.
start := interpreterProxy stackIntegerValue: 2.
+ srcOop := interpreterProxy stackValue: 3.
- srcOop := interpreterProxy stackObjectValue: 3.
handle := interpreterProxy stackIntegerValue: 4.
interpreterProxy failed ifTrue:[^nil].
((start > 0 and:[srcLen >= 0])
and:[(interpreterProxy isBytes: srcOop)
and:[(interpreterProxy isBytes: dstOop)
and:[(interpreterProxy byteSizeOf: srcOop) >= (start + srcLen - 1)]]])
ifFalse:[^interpreterProxy primitiveFail].
srcPtr := interpreterProxy firstIndexableField: srcOop.
dstPtr := interpreterProxy firstIndexableField: dstOop.
srcPtr := srcPtr + start - 1.
dstLen := interpreterProxy byteSizeOf: dstOop.
result := self cCode: 'sqEncryptSSL(handle, srcPtr, srcLen, dstPtr, dstLen)'
inSmalltalk:[handle. srcPtr. srcLen. dstPtr. dstLen. -2].
interpreterProxy failed ifTrue:[^nil].
interpreterProxy pop: interpreterProxy methodArgumentCount+1.
interpreterProxy pushInteger: result.!
Item was changed:
----- Method: SqueakSSLPlugin>>primitiveSetStringProperty (in category 'primitives') -----
primitiveSetStringProperty
"Primitive. Sets a string property for the session"
| srcLen srcOop propID handle srcPtr result |
<var: #srcPtr type: 'char *'>
<export: true>
interpreterProxy methodArgumentCount = 3
ifFalse:[^interpreterProxy primitiveFail].
+ srcOop := interpreterProxy stackValue: 0.
- srcOop := interpreterProxy stackObjectValue: 0.
propID := interpreterProxy stackIntegerValue: 1.
handle := interpreterProxy stackIntegerValue: 2.
interpreterProxy failed ifTrue:[^nil].
(interpreterProxy isBytes: srcOop)
ifFalse:[^interpreterProxy primitiveFail].
srcPtr := interpreterProxy firstIndexableField: srcOop.
srcLen := interpreterProxy byteSizeOf: srcOop.
result := self cCode: 'sqSetStringPropertySSL(handle, propID, srcPtr, srcLen)'
inSmalltalk:[handle. srcPtr. propID. srcLen. false].
result ifFalse:[^interpreterProxy primitiveFail].
interpreterProxy failed ifTrue:[^nil].
interpreterProxy pop: interpreterProxy methodArgumentCount.
!
Item was changed:
----- Method: ThreadedFFIPlugin>>ffiArgument:Spec:Class:in: (in category 'callout support') -----
ffiArgument: oop Spec: argSpec Class: argClass in: calloutState
"Callout support. Prepare the given oop as argument.
argSpec defines the compiled spec for the argument.
argClass (if non-nil) defines the required (super)class for the argument."
<var: #calloutState type: #'CalloutState *'>
| valueOop oopClass isStruct nilOop |
<inline: false>
oopClass := interpreterProxy fetchClassOf: oop. "Prefetch class (we'll need it)"
nilOop := interpreterProxy nilObject.
"Do the necessary type checks"
argClass = nilOop ifFalse:[
"Type check 1:
Is the required class of the argument a subclass of ExternalStructure?"
(interpreterProxy includesBehavior: argClass
ThatOf: interpreterProxy classExternalStructure)
ifFalse:[^FFIErrorWrongType]. "Nope. Fail."
"Type check 2:
Is the class of the argument a subclass of required class?"
((nilOop = oop) or:[interpreterProxy includesBehavior: oopClass ThatOf: argClass])
ifFalse:[^FFIErrorCoercionFailed]. "Nope. Fail."
"Okay, we've passed the type check (so far)"
].
"Check if oopClass is a subclass of ExternalStructure.
If this is the case we'll work on it's handle and not the actual oop."
isStruct := false.
+ (oop ~= nilOop
+ and: [interpreterProxy isPointers: oop]) ifTrue: "#isPointers: will fail if oop is immediate so don't even attempt to use it"
+ [isStruct := interpreterProxy
+ includesBehavior: oopClass
+ ThatOf: interpreterProxy classExternalStructure.
+ (argClass = nilOop or: [isStruct]) ifFalse:
+ [^FFIErrorCoercionFailed]].
+ "note: the test for #isPointers: above should speed up execution since no pointer type
+ ST objects are allowed in external calls and thus if #isPointers: is true then the arg must
+ be ExternalStructure to work. If it isn't then the code fails anyways so speed isn't an issue."
- ((interpreterProxy isImmediate: oop) or:[oop = nilOop]) ifFalse:[
- "#isPointers: will fail if oop is immediate so don't even attempt to use it"
- (interpreterProxy isPointers: oop)
- ifTrue:[isStruct := interpreterProxy includesBehavior: oopClass
- ThatOf: interpreterProxy classExternalStructure.
- (argClass = nilOop or:[isStruct])
- ifFalse:[^FFIErrorCoercionFailed]].
- "note: the test for #isPointers: above should speed up execution since no pointer type ST objects are allowed in external calls and thus if #isPointers: is true then the arg must be ExternalStructure to work. If it isn't then the code fails anyways so speed isn't an issue"
- ].
"Determine valueOop (e.g., the actual oop to pass as argument)"
isStruct
ifTrue:[valueOop := interpreterProxy fetchPointer: 0 ofObject: oop]
ifFalse:[valueOop := oop].
"Fetch and check the contents of the compiled spec"
(interpreterProxy isWords: argSpec)
ifFalse:[^FFIErrorWrongType].
calloutState ffiArgSpecSize: (interpreterProxy slotSizeOf: argSpec).
calloutState ffiArgSpecSize = 0 ifTrue:[^FFIErrorWrongType].
calloutState ffiArgSpec: (interpreterProxy firstIndexableField: argSpec).
calloutState ffiArgHeader: (interpreterProxy longAt: calloutState ffiArgSpec).
"Do the actual preparation of the argument"
"Note: Order is important since FFIFlagStructure + FFIFlagPointer is used to represent 'typedef void* VoidPointer' and VoidPointer really is *struct* not pointer."
(calloutState ffiArgHeader anyMask: FFIFlagStructure) ifTrue:[
"argument must be ExternalStructure"
isStruct ifFalse:[^FFIErrorCoercionFailed].
(calloutState ffiArgHeader anyMask: FFIFlagAtomic)
ifTrue:[^FFIErrorWrongType]. "bad combination"
^self ffiPushStructureContentsOf: valueOop in: calloutState].
(calloutState ffiArgHeader anyMask: FFIFlagPointer) ifTrue:[
"no integers (or characters) for pointers please"
(interpreterProxy isImmediate: oop)
ifTrue:[^FFIErrorIntAsPointer].
"but allow passing nil pointer for any pointer type"
oop = nilOop ifTrue:[^self ffiPushPointer: nil in: calloutState].
"argument is reference to either atomic or structure type"
(calloutState ffiArgHeader anyMask: FFIFlagAtomic) ifTrue:[
isStruct "e.g., ExternalData"
ifTrue:[^self ffiAtomicStructByReference: oop Class: oopClass in: calloutState]
ifFalse:[^self ffiAtomicArgByReference: oop Class: oopClass in: calloutState].
"********* NOTE: The above uses 'oop' not 'valueOop' (for ExternalData) ******"
].
"Needs to be external structure here"
isStruct ifFalse:[^FFIErrorCoercionFailed].
^self ffiPushPointerContentsOf: valueOop in: calloutState].
(calloutState ffiArgHeader anyMask: FFIFlagAtomic) ifTrue:[
"argument is atomic value"
^self ffiArgByValue: valueOop in: calloutState].
"None of the above - bad spec"
^FFIErrorWrongType!
Item was changed:
----- Method: ThreadedFFIPlugin>>primitiveLogCallsTo (in category 'primitives') -----
primitiveLogCallsTo
"Enable logging of FFI calls by providing it with a log file name."
| logFile ok |
<export: true>
interpreterProxy methodArgumentCount = 1
ifFalse:[^interpreterProxy primitiveFail].
+ logFile := interpreterProxy stackValue: 0.
- logFile := interpreterProxy stackObjectValue: 0.
logFile = interpreterProxy nilObject ifTrue:[ "disable logging"
ok := self ffiLogFileName: nil OfLength: 0.
ok ifFalse:[^interpreterProxy primitiveFail].
ffiLogEnabled := false.
] ifFalse:[ "enable logging"
(interpreterProxy isBytes: logFile) ifFalse:[^interpreterProxy primitiveFail].
ok := self ffiLogFileName: (interpreterProxy firstIndexableField: logFile)
OfLength: (interpreterProxy byteSizeOf: logFile).
ok ifFalse:[^interpreterProxy primitiveFail].
ffiLogEnabled := true.
].
^interpreterProxy pop: 1. "pop arg; return rcvr"
!
Item was changed:
----- Method: UUIDPlugin>>primitiveMakeUUID (in category 'system primitives') -----
primitiveMakeUUID
| oop location |
<export: true>
+ <var: #location type: #'char*'>
+ oop := interpreterProxy stackValue: 0.
+ (interpreterProxy methodArgumentCount = 0
+ and: [(interpreterProxy isBytes: oop)
+ and: [(interpreterProxy byteSizeOf: oop) = 16]]) ifFalse:
- <var: #location type: 'char*'>
- oop := interpreterProxy stackObjectValue: 0.
- (interpreterProxy failed
- or: [interpreterProxy methodArgumentCount ~= 0
- or: [(interpreterProxy isBytes: oop) not
- or: [(interpreterProxy byteSizeOf: oop) ~= 16]]]) ifTrue:
[^interpreterProxy primitiveFail].
location := interpreterProxy firstIndexableField: oop.
self cCode: [self MakeUUID: location]
inSmalltalk:
[| uuid |
uuid := UUID new.
1 to: 16 do:
[:i| location at: i - 1 put: (uuid at: i)]].
^oop!
More information about the Vm-dev
mailing list