[Vm-dev] VM Maker: VMMaker.oscog-eem.952.mcz
commits at source.squeak.org
commits at source.squeak.org
Sat Nov 22 02:42:48 UTC 2014
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.952.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.952
Author: eem
Time: 21 November 2014, 6:40:00.246 pm
UUID: c6647828-7baa-4c80-8f8f-1cfb627e2b84
Ancestors: VMMaker.oscog-eem.951
Implement SmallFloat/SmallDouble encode/decode.
Rename isInstanceOfClassFloat: to isFloatInstance:
Refactor floatObjectOf:, floatValueOf: and
isFloatInstance: into the ObjectMemory hierarchies.
=============== Diff against VMMaker.oscog-eem.951 ===============
Item was removed:
- ----- Method: Interpreter>>floatObjectOf: (in category 'object format') -----
- floatObjectOf: aFloat
- | newFloatObj |
- <inline: false>
- <var: #aFloat type: 'double '>
- self flag: #Dan.
- newFloatObj := self instantiateSmallClass: (self splObj: ClassFloat) sizeInBytes: 8+self baseHeaderSize.
- self storeFloatAt: newFloatObj + self baseHeaderSize from: aFloat.
- ^ newFloatObj.
- !
Item was removed:
- ----- Method: Interpreter>>floatValueOf: (in category 'utilities') -----
- floatValueOf: oop
- "Answer the C double precision floating point value of the argument,
- or fail if it is not a Float, and answer 0.
- Note: May be called by translated primitive code."
-
- | isFloat result |
- <returnTypeC: #double>
- <var: #result type: #double>
- isFloat := self isInstanceOfClassFloat: oop.
- isFloat ifTrue:
- [self cCode: '' inSmalltalk: [result := Float new: 2].
- self fetchFloatAt: oop + self baseHeaderSize into: result.
- ^result].
- self primitiveFail.
- ^0.0!
Item was changed:
----- Method: Interpreter>>primitiveAsFloat (in category 'arithmetic float primitives') -----
primitiveAsFloat
| arg |
arg := self popInteger.
+ self successful
+ ifTrue: [self pushFloat: arg asFloat]
+ ifFalse: [self unPop: 1]!
- successFlag
- ifTrue: [ self pushFloat: (self cCode: '((double) arg)' inSmalltalk: [arg asFloat]) ]
- ifFalse: [ self unPop: 1 ].!
Item was removed:
- ----- Method: InterpreterPrimitives>>isInstanceOfClassFloat: (in category 'primitive support') -----
- isInstanceOfClassFloat: oop
- <inline: true>
- "N.B. Because Slang always inlines is:instanceOf:compactClassIndex:
- (because is:instanceOf:compactClassIndex: has an inline: pragma) the
- phrase (objectMemory splObj: ClassFloat) is expanded in-place and is
- _not_ evaluated if oop has a non-zero CompactClassIndex."
- ^objectMemory
- is: oop
- instanceOf: (objectMemory splObj: ClassFloat)
- compactClassIndex: ClassFloatCompactIndex!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveAsFloat (in category 'arithmetic float primitives') -----
primitiveAsFloat
| arg |
arg := self popInteger.
self successful
+ ifTrue: [self pushFloat: arg asFloat]
+ ifFalse: [self unPop: 1]!
- ifTrue: [ self pushFloat: (self cCode: '((double) arg)' inSmalltalk: [arg asFloat]) ]
- ifFalse: [ self unPop: 1 ]!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveFormPrint (in category 'I/O primitives') -----
primitiveFormPrint
"On platforms that support it, this primitive prints the receiver, assumed to be a Form, to the default printer."
| landscapeFlag vScale hScale rcvr bitsArray w h
depth pixelsPerWord wordsPerLine bitsArraySize ok |
+ <var: #vScale type: #double>
+ <var: #hScale type: #double>
- <var: #vScale type: 'double '>
- <var: #hScale type: 'double '>
landscapeFlag := self booleanValueOf: self stackTop.
+ vScale := objectMemory floatValueOf: (self stackValue: 1).
+ hScale := objectMemory floatValueOf: (self stackValue: 2).
- vScale := self floatValueOf: (self stackValue: 1).
- hScale := self floatValueOf: (self stackValue: 2).
rcvr := self stackValue: 3.
+ ((objectMemory isPointers: rcvr)
- ((objectMemory isPointers: rcvr)
and: [(objectMemory lengthOf: rcvr) >= 4]) ifFalse:
[self success: false].
self successful ifTrue:
[bitsArray := objectMemory fetchPointer: 0 ofObject: rcvr.
w := self fetchInteger: 1 ofObject: rcvr.
h := self fetchInteger: 2 ofObject: rcvr.
depth := self fetchInteger: 3 ofObject: rcvr.
(w > 0 and: [h > 0]) ifFalse: [self success: false].
pixelsPerWord := 32 // depth.
wordsPerLine := (w + (pixelsPerWord - 1)) // pixelsPerWord.
(objectMemory isWordsOrBytes: bitsArray)
ifTrue:
[bitsArraySize := objectMemory numBytesOf: bitsArray.
self success: (bitsArraySize = (wordsPerLine * h * 4))]
ifFalse: [self success: false]].
self successful ifTrue:
[ok := self cCode: 'ioFormPrint(bitsArray + BaseHeaderSize, w, h, depth, hScale, vScale, landscapeFlag)'.
self success: ok].
self successful ifTrue:
[self pop: 3] "pop hScale, vScale, and landscapeFlag; leave rcvr on stack"!
Item was removed:
- ----- Method: NewCoObjectMemorySimulator>>floatValueOf: (in category 'simulation only') -----
- floatValueOf: obj
- "hack around the CoInterpreter/ObjectMemory split refactoring"
- ^coInterpreter floatValueOf: obj!
Item was added:
+ ----- Method: NewObjectMemory>>floatObjectOf: (in category 'interpreter access') -----
+ floatObjectOf: aFloat
+ | newFloatObj |
+ <inline: false>
+ <var: #aFloat type: #double>
+ newFloatObj := self
+ eeInstantiateSmallClassIndex: ClassFloatCompactIndex
+ format: self firstLongFormat
+ numSlots: (self sizeof: #double) / self bytesPerOop.
+ self storeFloatAt: newFloatObj + self baseHeaderSize from: aFloat.
+ ^newFloatObj!
Item was added:
+ ----- Method: NewObjectMemory>>floatValueOf: (in category 'interpreter access') -----
+ floatValueOf: oop
+ "Answer the C double precision floating point value of the argument,
+ or fail if it is not a Float, and answer 0.
+ Note: May be called by translated primitive code."
+
+ | isFloat result |
+ <returnTypeC: #double>
+ <var: #result type: #double>
+ isFloat := self isFloatInstance: oop.
+ isFloat ifTrue:
+ [self cCode: '' inSmalltalk: [result := Float new: 2].
+ self fetchFloatAt: oop + self baseHeaderSize into: result.
+ ^result].
+ coInterpreter primitiveFail.
+ ^0.0!
Item was removed:
- ----- Method: NewObjectMemorySimulator>>floatValueOf: (in category 'simulation only') -----
- floatValueOf: obj
- "hack around the CoInterpreter/ObjectMemory split refactoring"
- ^coInterpreter floatValueOf: obj!
Item was removed:
- ----- Method: NewspeakInterpreter>>floatObjectOf: (in category 'object format') -----
- floatObjectOf: aFloat
- | newFloatObj |
- <var: #aFloat type: #double>
- <inline: false> "because storeFloatAt:from: insists that its last arg is a variable"
- self flag: #Dan. "None of the float stuff has been converted for 64 bits"
- newFloatObj := self instantiateSmallClass: (self splObj: ClassFloat) sizeInBytes: 8+self baseHeaderSize.
- self storeFloatAt: newFloatObj + self baseHeaderSize from: aFloat.
- ^newFloatObj!
Item was removed:
- ----- Method: NewspeakInterpreter>>floatValueOf: (in category 'utilities') -----
- floatValueOf: oop
- "Answer the C double precision floating point value of the argument,
- or fail if it is not a Float, and answer 0.
- Note: May be called by translated primitive code."
-
- | isFloat result |
- <returnTypeC: #double>
- <var: #result type: #double>
- isFloat := self isInstanceOfClassFloat: oop.
- isFloat ifTrue:
- [self cCode: '' inSmalltalk: [result := Float new: 2].
- self fetchFloatAt: oop + self baseHeaderSize into: result.
- ^result].
- self primitiveFail.
- ^0.0!
Item was changed:
----- Method: NewspeakInterpreter>>primitiveAsFloat (in category 'float primitives') -----
primitiveAsFloat
| arg |
arg := self popInteger.
self successful
+ ifTrue: [self pushFloat: arg asFloat]
+ ifFalse: [self unPop: 1]!
- ifTrue: [ self pushFloat: (self cCode: '((double) arg)' inSmalltalk: [arg asFloat]) ]
- ifFalse: [ self unPop: 1 ].!
Item was added:
+ ----- Method: ObjectMemory>>floatObjectOf: (in category 'interpreter access') -----
+ floatObjectOf: aFloat
+ | newFloatObj |
+ <inline: false>
+ <var: #aFloat type: #double>
+ newFloatObj := self instantiateSmallClass: (self splObj: ClassFloat) sizeInBytes: (self sizeof: #double)+self baseHeaderSize.
+ self storeFloatAt: newFloatObj + self baseHeaderSize from: aFloat.
+ ^newFloatObj!
Item was added:
+ ----- Method: ObjectMemory>>floatValueOf: (in category 'interpreter access') -----
+ floatValueOf: oop
+ "Answer the C double precision floating point value of the argument,
+ or fail if it is not a Float, and answer 0.
+ Note: May be called by translated primitive code."
+
+ | isFloat result |
+ <returnTypeC: #double>
+ <var: #result type: #double>
+ isFloat := self isFloatInstance: oop.
+ isFloat ifTrue:
+ [self cCode: '' inSmalltalk: [result := Float new: 2].
+ self fetchFloatAt: oop + self baseHeaderSize into: result.
+ ^result].
+ self primitiveFail.
+ ^0.0!
Item was added:
+ ----- Method: ObjectMemory>>isFloatInstance: (in category 'interpreter access') -----
+ isFloatInstance: oop
+ <inline: true>
+ "N.B. Because Slang always inlines is:instanceOf:compactClassIndex:
+ (because is:instanceOf:compactClassIndex: has an inline: pragma) the
+ phrase (objectMemory splObj: ClassFloat) is expanded in-place and is
+ _not_ evaluated if oop has a non-zero CompactClassIndex."
+ ^self
+ is: oop
+ instanceOf: (self splObj: ClassFloat)
+ compactClassIndex: ClassFloatCompactIndex!
Item was added:
+ ----- Method: Spur32BitMemoryManager>>floatObjectOf: (in category 'interpreter access') -----
+ floatObjectOf: aFloat
+ | newFloatObj |
+ <inline: false>
+ <var: #aFloat type: #double>
+ newFloatObj := self
+ eeInstantiateSmallClassIndex: ClassFloatCompactIndex
+ format: self firstLongFormat
+ numSlots: (self sizeof: #double) / self bytesPerOop.
+ self storeFloatAt: newFloatObj + self baseHeaderSize from: aFloat.
+ ^newFloatObj!
Item was added:
+ ----- Method: Spur32BitMemoryManager>>floatValueOf: (in category 'interpreter access') -----
+ floatValueOf: oop
+ "Answer the C double precision floating point value of the argument,
+ or fail if it is not a Float, and answer 0.
+ Note: May be called by translated primitive code."
+
+ | isFloat result |
+ <returnTypeC: #double>
+ <var: #result type: #double>
+ isFloat := self isFloatInstance: oop.
+ isFloat ifTrue:
+ [self cCode: '' inSmalltalk: [result := Float new: 2].
+ self fetchFloatAt: oop + self baseHeaderSize into: result.
+ ^result].
+ coInterpreter primitiveFail.
+ ^0.0!
Item was added:
+ ----- Method: Spur32BitMemoryManager>>isFloatInstance: (in category 'interpreter access') -----
+ isFloatInstance: oop
+ <inline: true>
+ ^(self isNonImmediate: oop)
+ and: [(self classIndexOf: oop) = ClassFloatCompactIndex]!
Item was added:
+ ----- Method: Spur64BitMemoryManager>>floatObjectOf: (in category 'interpreter access') -----
+ floatObjectOf: aFloat
+ | newFloatObj |
+ <inline: false>
+ <var: #aFloat type: #double>
+ (self isSmallFloatValue: aFloat) ifTrue:
+ [^self smallFloatObjectOf: aFloat].
+ newFloatObj := self
+ eeInstantiateSmallClassIndex: ClassFloatCompactIndex
+ format: self firstLongFormat
+ numSlots: (self sizeof: #double) / self bytesPerOop.
+ self storeFloatAt: newFloatObj + self baseHeaderSize from: aFloat.
+ ^newFloatObj!
Item was added:
+ ----- Method: Spur64BitMemoryManager>>floatValueOf: (in category 'interpreter access') -----
+ floatValueOf: oop
+ "Answer the C double precision floating point value of the argument,
+ or fail if it is not a Float, and answer 0.
+ Note: May be called by translated primitive code."
+
+ | result tagBits |
+ <returnTypeC: #double>
+ <var: #result type: #double>
+ (tagBits := oop bitAnd: self tagMask) ~= 0
+ ifTrue:
+ [tagBits = self smallFloatTag ifTrue:
+ [^self smallFloatValueOf: oop]]
+ ifFalse:
+ [(self classIndexOf: oop) = ClassFloatCompactIndex ifTrue:
+ [self cCode: '' inSmalltalk: [result := Float new: 2].
+ self fetchFloatAt: oop + self baseHeaderSize into: result.
+ ^result]].
+ coInterpreter primitiveFail.
+ ^0.0!
Item was added:
+ ----- Method: Spur64BitMemoryManager>>isFloatInstance: (in category 'interpreter access') -----
+ isFloatInstance: oop
+ <inline: true>
+ | tagBits |
+ ^(tagBits := oop bitAnd: self tagMask) ~= 0
+ ifTrue: [tagBits = self smallFloatTag]
+ ifFalse: [(self classIndexOf: oop) = ClassFloatCompactIndex]!
Item was added:
+ ----- Method: Spur64BitMemoryManager>>isSmallFloatValue: (in category 'interpreter access') -----
+ isSmallFloatValue: aFloat
+ <inline: true>
+ <var: #aFloat type: #double>
+ | exponent |
+ exponent := self
+ cCode:
+ [| rawFloat |
+ rawFloat := (self cCoerce: (self addressOf: aFloat) to: 'sqLong *') at: 0.
+ rawFloat >> 52 bitAnd: 16r7FF]
+ inSmalltalk: [aFloat exponent].
+ ^exponent between: -127 and: 127!
Item was added:
+ ----- Method: Spur64BitMemoryManager>>rotateLeft: (in category 'interpreter access') -----
+ rotateLeft: anInteger
+ ^(anInteger >> 63 bitAnd: 1) + ((self cCode: [anInteger] inSmalltalk: [anInteger bitAnd: 16r7FFFFFFFFFFFFFFF]) << 1)!
Item was added:
+ ----- Method: Spur64BitMemoryManager>>rotateRight: (in category 'interpreter access') -----
+ rotateRight: anInteger
+ ^(self cCode: [anInteger] inSmalltalk: [anInteger bitAnd: 1]) << 63 + (anInteger asUnsignedLong >> 1)!
Item was added:
+ ----- Method: Spur64BitMemoryManager>>smallFloatExponentOffset (in category 'interpreter access') -----
+ smallFloatExponentOffset
+ ^128!
Item was added:
+ ----- Method: Spur64BitMemoryManager>>smallFloatMantissaBits (in category 'interpreter access') -----
+ smallFloatMantissaBits
+ ^52!
Item was added:
+ ----- Method: Spur64BitMemoryManager>>smallFloatObjectOf: (in category 'interpreter access') -----
+ smallFloatObjectOf: aFloat
+ "Encode the argument, aFloat in the SmallFloat range, as a tagged small float.
+ See section 61-bit Immediate Floats in the SpurMemoryManager class comment.
+
+ Encode: [1s][ 11 exponent ][52mantissa]
+ rot sign: [ 11 exponent ][52mantissa][1s]
+ sub exponent offset: [ 000 ][8expsubset][52 mantissa][1s]
+ shift: [8expsubset][52 mantissa][1s][ 000 ]
+ or/add tags: [8expsubset][52mantissa][1s][3tags]"
+ <inline: true>
+ <var: #aFloat type: #double>
+ | rawFloat rot |
+ rawFloat := self
+ cCode:
+ [(self cCoerce: (self addressOf: aFloat) to: 'sqLong *') at: 0]
+ inSmalltalk: [(aFloat at: 1) << 32 + (aFloat at: 2)].
+ rot := self rotateLeft: rawFloat.
+ rot > 1 ifTrue:
+ [rot := rot - (self smallFloatExponentOffset << (self smallFloatMantissaBits + 1)).
+ self assert: rot > 0].
+ ^rot << self numTagBits + self smallFloatTag!
Item was added:
+ ----- Method: Spur64BitMemoryManager>>smallFloatTag (in category 'cog jit support') -----
+ smallFloatTag
+ ^3!
Item was added:
+ ----- Method: Spur64BitMemoryManager>>smallFloatValueOf: (in category 'interpreter access') -----
+ smallFloatValueOf: oop
+ "Answer the C double precision floating point value of the argument, a SmallFloat.
+ See section 61-bit Immediate Floats in the SpurMemoryManager class comment.
+ msb lsb
+ Decode: [8expsubset][52mantissa][1s][3tags]
+ shift away tags: [ 000 ][8expsubset][52mantissa][1s]
+ add exponent offset: [ 11 exponent ][52mantissa][1s]
+ rot sign: [1s][ 11 exponent ][52mantissa]"
+ | rot |
+ <returnTypeC: #double>
+ <var: #result type: #double>
+ self assert: (oop bitAnd: self tagMask) = self smallFloatTag.
+ rot := oop >> self numTagBits.
+ rot > 1 ifTrue:
+ [rot := rot + (self smallFloatExponentOffset << (self smallFloatMantissaBits + 1))].
+ rot := self rotateRight: rot.
+ ^self cCode: [(self cCoerce: (self addressOf: rot) to: #'double *') at: 0]
+ inSmalltalk:
+ [(Float new: 2)
+ at: 1 put: rot >> 32;
+ at: 2 put: (rot bitAnd: 16rFFFFFFFF);
+ yourself]!
Item was added:
+ ----- Method: SpurMemoryManager>>floatObjectOf: (in category 'interpreter access') -----
+ floatObjectOf: aFloat
+ self subclassResponsibility!
Item was changed:
+ ----- Method: SpurMemoryManager>>floatValueOf: (in category 'interpreter access') -----
+ floatValueOf: oop
+ "Answer the C double precision floating point value of the argument,
+ or fail if it is not a Float, and answer 0.
+ Note: May be called by translated primitive code."
+
+ self subclassResponsibility!
- ----- Method: SpurMemoryManager>>floatValueOf: (in category 'simulation only') -----
- floatValueOf: obj
- "hack around the CoInterpreter/ObjectMemory split refactoring"
- <doNotGenerate>
- ^coInterpreter floatValueOf: obj!
Item was added:
+ ----- Method: SpurMemoryManager>>isFloatInstance: (in category 'interpreter access') -----
+ isFloatInstance: oop
+ self subclassResponsibility!
Item was changed:
----- Method: StackInterpreter>>fetchFloat:ofObject: (in category 'utilities') -----
fetchFloat: fieldIndex ofObject: objectPointer
"Fetch the instance variable at the given index of the given object. Return the C double precision floating point value of that instance variable, or fail if it is not a Float."
"Note: May be called by translated primitive code."
| floatOop |
+ <returnTypeC: #double>
- <returnTypeC: 'double'>
floatOop := objectMemory fetchPointer: fieldIndex ofObject: objectPointer.
+ ^objectMemory floatValueOf: floatOop!
- ^ self floatValueOf: floatOop!
Item was changed:
----- Method: StackInterpreter>>floatArg: (in category 'plugin primitive support') -----
floatArg: index
"Like #stackFloatValue: but access method arguments left-to-right"
| oop |
<returnTypeC: #double>
oop := self methodArg: index.
oop = 0 ifTrue:[^0.0]. "methodArg: failed"
+ ^objectMemory floatValueOf: oop!
- ^self floatValueOf: oop!
Item was removed:
- ----- Method: StackInterpreter>>floatObjectOf: (in category 'object format') -----
- floatObjectOf: aFloat
- | newFloatObj |
- <inline: false>
- <var: #aFloat type: #double>
- newFloatObj := objectMemory
- eeInstantiateSmallClassIndex: ClassFloatCompactIndex
- format: objectMemory firstLongFormat
- numSlots: (self sizeof: #double) / objectMemory bytesPerOop.
- objectMemory storeFloatAt: newFloatObj + objectMemory baseHeaderSize from: aFloat.
- ^newFloatObj!
Item was removed:
- ----- Method: StackInterpreter>>floatValueOf: (in category 'utilities') -----
- floatValueOf: oop
- "Answer the C double precision floating point value of the argument,
- or fail if it is not a Float, and answer 0.
- Note: May be called by translated primitive code."
-
- | isFloat result |
- <returnTypeC: #double>
- <var: #result type: #double>
- isFloat := self isInstanceOfClassFloat: oop.
- isFloat ifTrue:
- [self cCode: '' inSmalltalk: [result := Float new: 2].
- objectMemory fetchFloatAt: oop + objectMemory baseHeaderSize into: result.
- ^result].
- self primitiveFail.
- ^0.0!
Item was changed:
----- Method: StackInterpreter>>loadFloatOrIntFrom: (in category 'utilities') -----
loadFloatOrIntFrom: floatOrInt
"If floatOrInt is an integer, then convert it to a C double float and return it.
If it is a Float, then load its value and return it.
Otherwise fail -- ie return with primErrorCode non-zero."
<inline: true>
<returnTypeC: #double>
(objectMemory isIntegerObject: floatOrInt) ifTrue:
[^(objectMemory integerValueOf: floatOrInt) asFloat].
+ ^objectMemory floatValueOf: floatOrInt!
- ^self floatValueOf: floatOrInt!
Item was changed:
----- Method: StackInterpreter>>pop:thenPushFloat: (in category 'internal interpreter access') -----
pop: nItems thenPushFloat: f
"In the StackInterpreter stacks grow down."
| sp |
<inline: true>
<var: #f type: #double>
<var: #sp type: #'char *'>
stackPages
longAt: (sp := stackPointer + ((nItems - 1) * objectMemory wordSize))
+ put: (objectMemory floatObjectOf: f).
- put: (self floatObjectOf: f).
stackPointer := sp!
Item was changed:
----- Method: StackInterpreter>>popFloat (in category 'primitive support') -----
popFloat
<returnTypeC: #double>
+ ^objectMemory floatValueOf: self popStack!
- ^self floatValueOf: self popStack!
Item was changed:
----- Method: StackInterpreter>>pushFloat: (in category 'primitive support') -----
pushFloat: f
<var: #f type: #double>
+ self push: (objectMemory floatObjectOf: f).!
- self push: (self floatObjectOf: f).!
Item was changed:
----- Method: StackInterpreter>>stackFloatValue: (in category 'stack access') -----
stackFloatValue: offset
"In the StackInterpreter stacks grow down."
<returnTypeC: #double>
+ ^objectMemory floatValueOf: (stackPages longAt: stackPointer + (offset*objectMemory wordSize))!
- ^self floatValueOf: (stackPages longAt: stackPointer + (offset*objectMemory wordSize))!
Item was changed:
----- Method: StackInterpreterPrimitives>>primitiveVMParameter (in category 'system control primitives') -----
(excessive size, no diff calculated)
More information about the Vm-dev
mailing list