[Vm-dev] VM Maker: VMMaker.oscog-nice.1813.mcz
commits at source.squeak.org
commits at source.squeak.org
Tue Apr 19 23:05:06 UTC 2016
Nicolas Cellier uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-nice.1813.mcz
==================== Summary ====================
Name: VMMaker.oscog-nice.1813
Author: nice
Time: 20 April 2016, 1:02:48.617 am
UUID: 9ce7e2b2-2956-4228-9744-345c61a693ed
Ancestors: VMMaker.oscog-nice.1812
Revert elimination of type specifications for LargeIntegersPlugin.
Instead, provide a bunch of Integer type checking.
- isIntegerObject: <=> isMemberOf: SmallInteger (already existing)
- isKindOfInteger: <=> isKindOf: Integer
- isLargeIntegerObject= <=> isKindOf: LargePositiveInteger (Squeak) or LargeInteger (Pharo)
- isLargePositiveIntegerObject: <=> isMemberOf: LargePositiveInteger
- isLargeNegativeIntegerObject: <=> isMemberOf: LargeNegativeInteger
Note that this will require a change of svn source for platforms/Cross/vm/sqVirtalMachine.[ch]
=============== Diff against VMMaker.oscog-nice.1812 ===============
Item was changed:
----- Method: FFIPlugin>>ffiPushUnsignedLongLongOop: (in category 'callout support') -----
ffiPushUnsignedLongLongOop: oop
"Push a longlong type (e.g., a 64bit integer).
Note: Coercions from float are *not* supported."
| lowWord highWord length ptr |
<var: #ptr type:'unsigned char *'>
oop == interpreterProxy nilObject
ifTrue:[^self ffiPushUnsignedLong: 0 Long: 0.]. "@@: check this"
oop == interpreterProxy falseObject
ifTrue:[^self ffiPushUnsignedLong: 0 Long: 0].
oop == interpreterProxy trueObject
ifTrue:[^self ffiPushUnsignedLong: 0 Long: 1].
(interpreterProxy isIntegerObject: oop) ifTrue:[
lowWord := interpreterProxy integerValueOf: oop.
lowWord < 0 ifTrue:[^self ffiFail: FFIErrorCoercionFailed].
highWord := 0.
] ifFalse:[
+ (interpreterProxy isLargePositiveIntegerObject: oop)
- (interpreterProxy fetchClassOf: oop) = interpreterProxy classLargePositiveInteger
ifFalse:[^interpreterProxy primitiveFail].
(interpreterProxy isBytes: oop) ifFalse:[^self ffiFail: FFIErrorCoercionFailed].
length := interpreterProxy byteSizeOf: oop.
length > 8 ifTrue:[^self ffiFail: FFIErrorCoercionFailed].
lowWord := highWord := 0.
ptr := interpreterProxy firstIndexableField: oop.
0 to: (length min: 4)-1 do:[:i|
lowWord := lowWord + ((ptr at: i) << (i*8))].
0 to: (length-5) do:[:i|
highWord := highWord + ((ptr at: i+4) << (i*8))].
].
^self ffiPushUnsignedLong: lowWord Long: highWord.!
Item was changed:
----- Method: IA32ABIPlugin>>primAlienReplace (in category 'primitives-accessing') -----
primAlienReplace
"Copy some number of bytes from some source object starting at the index
into the receiver destination object from startIndex to stopIndex . The source
and destination may be Aliens or byte-indexable objects. The primitive wll have either
of the following signatures:
<Alien | indexableByteSubclass | indexableWordSubclass>
primReplaceFrom: start <Integer>
to: stop <Integer>
with: replacement <Alien | indexableByteSubclass | indexableWordSubclass | Integer>
startingAt: repStart <Integer> ^<self>
<primitive: 'primitiveAlienReplace' error: errorCode module: 'IA32ABI'>
<Anywhere>
primReplaceIn: dest <Alien | indexableByteSubclass | indexableWordSubclass>
from: start <Integer>
to: stop <Integer>
with: replacement <Alien | indexableByteSubclass | indexableWordSubclass | Integer>
startingAt: repStart <Integer> ^<self>
<primitive: 'primitiveAlienReplace' error: errorCode module: 'IA32ABI'>
"
| array start stop repl replStart dest src totalLength count |
<export: true>
array := interpreterProxy stackValue: 4.
start := interpreterProxy stackIntegerValue: 3.
stop := interpreterProxy stackIntegerValue: 2.
repl := interpreterProxy stackValue: 1.
replStart := interpreterProxy stackIntegerValue: 0.
(interpreterProxy failed
or: [(interpreterProxy isWordsOrBytes: array) not]) ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
(self isAlien: array)
ifTrue:
[totalLength := self sizeField: array.
dest := (self startOfData: array withSize: totalLength) + start - 1.
totalLength = 0 "no bounds checks for zero-sized (pointer) Aliens"
ifTrue: [totalLength := stop]
ifFalse: [totalLength := totalLength abs]]
ifFalse:
[totalLength := interpreterProxy byteSizeOf: array.
dest := (self startOfByteData: array) + start - 1].
(start >= 1 and: [start - 1 <= stop and: [stop <= totalLength]])
ifFalse: [^interpreterProxy primitiveFailFor: PrimErrBadIndex].
(interpreterProxy isIntegerObject: repl)
ifTrue:
[(interpreterProxy integerValueOf: repl) <= 0 ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
src := (interpreterProxy integerValueOf: repl) + replStart - 1]
ifFalse:
+ [(interpreterProxy isLargePositiveIntegerObject: repl)
- [(interpreterProxy fetchClassOf: repl) == interpreterProxy classLargePositiveInteger
ifTrue:
[src := (interpreterProxy positive32BitValueOf: repl) + replStart - 1.
interpreterProxy failed ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument]]
ifFalse:
[(self isAlien: repl)
ifTrue:
[totalLength := self sizeField: repl.
src := (self startOfData: repl withSize: totalLength) + replStart - 1.
totalLength = 0 "no bounds checks for zero-sized (pointer) Aliens"
ifTrue: [totalLength := stop - start + replStart]
ifFalse: [totalLength := totalLength abs]]
ifFalse:
[(interpreterProxy isWordsOrBytes: repl) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
totalLength := interpreterProxy byteSizeOf: repl.
src := (self startOfByteData: repl) + replStart - 1].
(replStart >= 1 and: [stop - start + replStart <= totalLength]) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadIndex]]].
(interpreterProxy isOopImmutable: array) ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrNoModification].
count := stop - start + 1.
self cCode: 'memmove((void *)dest,(void *)src,count)'
inSmalltalk:
[count := count + src + dest. "squash unused var compiler warnings"
self error: 'not implemented'].
interpreterProxy pop: interpreterProxy methodArgumentCount!
Item was added:
+ ----- Method: Integer class>>ccg:prolog:expr:index: (in category '*VMMaker-plugin generation') -----
+ ccg: cg prolog: aBlock expr: aString index: anInteger
+
+ ^cg ccgLoad: aBlock expr: aString asKindOfIntegerFrom: anInteger!
Item was added:
+ ----- Method: Interpreter>>isKindOfInteger: (in category 'plugin primitive support') -----
+ isKindOfInteger: oop
+ "Answer true if the oop is kind of Integer (Small or Large)."
+ <api>
+ <inline: true>
+ ^(self isIntegerObject: oop)
+ or: [self isLargeIntegerInstance: oop]!
Item was added:
+ ----- Method: Interpreter>>isLargeIntegerObject: (in category 'plugin primitive support') -----
+ isLargeIntegerObject: oop
+ ^(self isLargeIntegerInstance: oop)!
Item was added:
+ ----- Method: Interpreter>>isLargeNegativeIntegerObject: (in category 'plugin primitive support') -----
+ isLargeNegativeIntegerObject: oop
+ ^(self isInstanceOfClassLargeNegativeInteger: oop)!
Item was added:
+ ----- Method: Interpreter>>isLargePositiveIntegerObject: (in category 'plugin primitive support') -----
+ isLargePositiveIntegerObject: oop
+ ^(self isInstanceOfClassLargePositiveInteger: oop)!
Item was removed:
- ----- Method: InterpreterPrimitives>>isInstanceOfClassLargeNegativeInteger: (in category 'primitive support') -----
- isInstanceOfClassLargeNegativeInteger: oop
- <inline: true>
- "N.B. Because Slang always inlines is:instanceOf:compactClassIndex:
- (because is:instanceOf:compactClassIndex: has an inline: pragma) the
- phrase (objectMemory splObj: ClassLargeNegativeInteger) is expanded
- in-place and is _not_ evaluated if oop has a non-zero CompactClassIndex."
- ^objectMemory
- is: oop
- instanceOf: (objectMemory splObj: ClassLargeNegativeInteger)
- compactClassIndex: ClassLargeNegativeIntegerCompactIndex!
Item was removed:
- ----- Method: InterpreterPrimitives>>isInstanceOfClassLargePositiveInteger: (in category 'primitive support') -----
- isInstanceOfClassLargePositiveInteger: oop
- <inline: true>
- "N.B. Because Slang always inlines is:instanceOf:compactClassIndex:
- (because is:instanceOf:compactClassIndex: has an inline: pragma) the
- phrase (objectMemory splObj: ClassLargePositiveInteger) is expanded
- in-place and is _not_ evaluated if oop has a non-zero CompactClassIndex."
- ^objectMemory
- is: oop
- instanceOf: (objectMemory splObj: ClassLargePositiveInteger)
- compactClassIndex: ClassLargePositiveIntegerCompactIndex!
Item was added:
+ ----- Method: InterpreterProxy>>isKindOfInteger: (in category 'testing') -----
+ isKindOfInteger: objectOrientedPointer
+ ^objectOrientedPointer isInteger!
Item was added:
+ ----- Method: InterpreterProxy>>isLargeIntegerObject: (in category 'testing') -----
+ isLargeIntegerObject: objectOrientedPointer
+ ^objectOrientedPointer isKindOf: LargePositiveInteger!
Item was added:
+ ----- Method: InterpreterProxy>>isLargeNegativeIntegerObject: (in category 'testing') -----
+ isLargeNegativeIntegerObject: objectOrientedPointer
+ ^objectOrientedPointer isMemberOf: LargeNegativeInteger!
Item was added:
+ ----- Method: InterpreterProxy>>isLargePositiveIntegerObject: (in category 'testing') -----
+ isLargePositiveIntegerObject: objectOrientedPointer
+ ^objectOrientedPointer isMemberOf: LargePositiveInteger!
Item was changed:
----- Method: LargeIntegersPlugin>>digitAddLarge:with: (in category 'oop functions') -----
digitAddLarge: firstInteger with: secondInteger
"Does not need to normalize!!"
| over firstDigitLen secondDigitLen shortInt shortDigitLen longInt longDigitLen sum newSum neg |
<var: #over type: #'unsigned int'>
firstDigitLen := self digitSizeOfLargeInt: firstInteger.
secondDigitLen := self digitSizeOfLargeInt: secondInteger.
+ neg := interpreterProxy isLargeNegativeIntegerObject: firstInteger.
- neg := (interpreterProxy fetchClassOf: firstInteger)
- = interpreterProxy classLargeNegativeInteger.
firstDigitLen <= secondDigitLen
ifTrue:
[shortInt := firstInteger.
shortDigitLen := firstDigitLen.
longInt := secondInteger.
longDigitLen := secondDigitLen]
ifFalse:
[shortInt := secondInteger.
shortDigitLen := secondDigitLen.
longInt := firstInteger.
longDigitLen := firstDigitLen].
" sum := Integer new: len neg: firstInteger negative."
self remapOop: #(shortInt longInt ) in: [sum := self createLargeIntegerNeg: neg digitLength: longDigitLen].
over := self
cDigitAdd: (self pointerToFirstDigitOfLargeInt: shortInt)
len: shortDigitLen
with: (self pointerToFirstDigitOfLargeInt: longInt)
len: longDigitLen
into: (self pointerToFirstDigitOfLargeInt: sum).
over > 0
ifTrue:
["sum := sum growby: 1."
self remapOop: sum in: [newSum := self createLargeIntegerNeg: neg byteLength: longDigitLen * 4 + 1].
self
cDigitCopyFrom: (self pointerToFirstDigitOfLargeInt: sum)
to: (self pointerToFirstDigitOfLargeInt: newSum)
len: longDigitLen.
sum := newSum.
"C index!!"
self cDigitOf: (self pointerToFirstDigitOfLargeInt: sum)
at: longDigitLen put: over]
ifFalse:
[sum := neg
ifTrue: [self normalizeNegative: sum]
ifFalse: [self normalizePositive: sum]].
^ sum!
Item was changed:
----- Method: LargeIntegersPlugin>>digitBitLogic:with:opIndex: (in category 'oop functions') -----
digitBitLogic: firstInteger with: secondInteger opIndex: opIx
"Bit logic here is only implemented for positive integers or Zero;
if rec or arg is negative, it fails."
| firstLarge secondLarge firstLen secondLen shortLen shortLarge longLen longLarge result |
(interpreterProxy isIntegerObject: firstInteger)
ifTrue:
[(interpreterProxy integerValueOf: firstInteger)
< 0 ifTrue: [^ interpreterProxy primitiveFail].
"convert it to a not normalized LargeInteger"
self remapOop: secondInteger in: [firstLarge := self createLargeFromSmallInteger: firstInteger]]
ifFalse:
+ [(interpreterProxy isLargePositiveIntegerObject: firstInteger) ifFalse: [^ interpreterProxy primitiveFail].
- [(interpreterProxy fetchClassOf: firstInteger)
- = interpreterProxy classLargePositiveInteger ifFalse: [^ interpreterProxy primitiveFail].
firstLarge := firstInteger].
(interpreterProxy isIntegerObject: secondInteger)
ifTrue:
[(interpreterProxy integerValueOf: secondInteger)
< 0 ifTrue: [^ interpreterProxy primitiveFail].
"convert it to a not normalized LargeInteger"
self remapOop: firstLarge in: [secondLarge := self createLargeFromSmallInteger: secondInteger]]
ifFalse:
+ [(interpreterProxy isLargePositiveIntegerObject: secondInteger) ifFalse: [^ interpreterProxy primitiveFail].
- [(interpreterProxy fetchClassOf: secondInteger)
- = interpreterProxy classLargePositiveInteger ifFalse: [^ interpreterProxy primitiveFail].
secondLarge := secondInteger].
firstLen := self byteSizeOfLargeInt: firstLarge.
secondLen := self byteSizeOfLargeInt: secondLarge.
firstLen < secondLen
ifTrue:
[shortLen := firstLen.
shortLarge := firstLarge.
longLen := secondLen.
longLarge := secondLarge]
ifFalse:
[shortLen := secondLen.
shortLarge := secondLarge.
longLen := firstLen.
longLarge := firstLarge].
self remapOop: #(shortLarge longLarge ) in: [result := interpreterProxy instantiateClass: interpreterProxy classLargePositiveInteger indexableSize: longLen].
self
cDigitOp: opIx
short: (self pointerToFirstDigitOfLargeInt: shortLarge)
len: shortLen + 3 // 4
long: (self pointerToFirstDigitOfLargeInt: longLarge)
len: longLen + 3 // 4
into: (self pointerToFirstDigitOfLargeInt: result).
interpreterProxy failed ifTrue: [^ 0].
^ self normalizePositive: result!
Item was changed:
----- Method: LargeIntegersPlugin>>digitSubLarge:with: (in category 'oop functions') -----
digitSubLarge: firstInteger with: secondInteger
"Normalizes."
| firstDigitLen secondDigitLen larger largeDigitLen smaller smallerDigitLen neg resDigitLen res firstNeg |
+ firstNeg := interpreterProxy isLargeNegativeIntegerObject: firstInteger.
- firstNeg := (interpreterProxy fetchClassOf: firstInteger)
- = interpreterProxy classLargeNegativeInteger.
firstDigitLen := self digitSizeOfLargeInt: firstInteger.
secondDigitLen := self digitSizeOfLargeInt: secondInteger.
firstDigitLen = secondDigitLen ifTrue:
[[firstDigitLen > 1
and: [(self unsafeDigitOfLargeInt: firstInteger at: firstDigitLen) = (self unsafeDigitOfLargeInt: secondInteger at: firstDigitLen)]]
whileTrue: [firstDigitLen := firstDigitLen - 1].
secondDigitLen := firstDigitLen].
(firstDigitLen < secondDigitLen
or: [firstDigitLen = secondDigitLen
and: [(self unsafeDigitOfLargeInt: firstInteger at: firstDigitLen) < (self unsafeDigitOfLargeInt: secondInteger at: firstDigitLen)]])
ifTrue:
[larger := secondInteger.
largeDigitLen := secondDigitLen.
smaller := firstInteger.
smallerDigitLen := firstDigitLen.
neg := firstNeg == false]
ifFalse:
[larger := firstInteger.
largeDigitLen := firstDigitLen.
smaller := secondInteger.
smallerDigitLen := secondDigitLen.
neg := firstNeg].
resDigitLen := largeDigitLen.
self remapOop: #(smaller larger)
in: [res := self createLargeIntegerNeg: neg digitLength: resDigitLen].
self
cDigitSub: (self pointerToFirstDigitOfLargeInt: smaller)
len: smallerDigitLen
with: (self pointerToFirstDigitOfLargeInt: larger)
len: largeDigitLen
into: (self pointerToFirstDigitOfLargeInt: res).
^neg
ifTrue: [self normalizeNegative: res]
ifFalse: [self normalizePositive: res]!
Item was removed:
- ----- Method: LargeIntegersPlugin>>isLargeIntegerOop: (in category 'util') -----
- isLargeIntegerOop: oop
- | oopClass |
- oopClass := interpreterProxy fetchClassOf: oop.
- ^oopClass == interpreterProxy classLargeNegativeInteger or: [oopClass == interpreterProxy classLargePositiveInteger]!
Item was changed:
----- Method: LargeIntegersPlugin>>normalize: (in category 'oop functions') -----
normalize: aLargeInteger
"Check for leading zeroes and return shortened copy if so."
self debugCode: [self msg: 'normalize: aLargeInteger'].
+ (interpreterProxy isLargePositiveIntegerObject: aLargeInteger)
- (interpreterProxy fetchClassOf: aLargeInteger)
- = interpreterProxy classLargePositiveInteger
ifTrue: [^ self normalizePositive: aLargeInteger]
ifFalse: [^ self normalizeNegative: aLargeInteger]!
Item was changed:
----- Method: LargeIntegersPlugin>>primAnyBitFrom:to: (in category 'Integer primitives') -----
primAnyBitFrom: from to: to
| integer large |
self debugCode: [self msg: 'primAnyBitFrom: from to: to'].
integer := self
primitive: 'primAnyBitFromTo'
+ parameters: #(#SmallInteger #SmallInteger )
+ receiver: #Integer.
- parameters: #(#SmallInteger #SmallInteger ).
(interpreterProxy isIntegerObject: integer)
ifTrue: ["convert it to a not normalized LargeInteger"
large := self createLargeFromSmallInteger: integer]
+ ifFalse: [large := integer].
- ifFalse:
- [(self isLargeIntegerOop: integer) ifFalse: [^interpreterProxy primitiveFail].
- large := integer].
^ (self
anyBitOfLargeInt: large
from: from
to: to)
asOop: Boolean!
Item was changed:
----- Method: LargeIntegersPlugin>>primDigitAdd: (in category 'Integer primitives') -----
primDigitAdd: secondInteger
| firstLarge secondLarge firstInteger |
self debugCode: [self msg: 'primDigitAdd: secondInteger'].
+ firstInteger := self
+ primitive: 'primDigitAdd'
+ parameters: #(Integer )
+ receiver: #Integer.
- firstInteger := self primitive: 'primDigitAdd'.
(interpreterProxy isIntegerObject: firstInteger)
+ ifTrue: ["convert it to a not normalized LargeInteger"
- ifTrue:
- ["convert it to a not normalized LargeInteger"
self remapOop: secondInteger in: [firstLarge := self createLargeFromSmallInteger: firstInteger]]
+ ifFalse: [firstLarge := firstInteger].
- ifFalse:
- [(self isLargeIntegerOop: firstInteger) ifFalse: [^interpreterProxy primitiveFail].
- firstLarge := firstInteger].
(interpreterProxy isIntegerObject: secondInteger)
+ ifTrue: ["convert it to a not normalized LargeInteger"
- ifTrue:
- ["convert it to a not normalized LargeInteger"
self remapOop: firstLarge in: [secondLarge := self createLargeFromSmallInteger: secondInteger]]
+ ifFalse: [secondLarge := secondInteger].
- ifFalse:
- [(self isLargeIntegerOop: secondInteger) ifFalse: [^interpreterProxy primitiveFail].
- secondLarge := secondInteger].
^ self digitAddLarge: firstLarge with: secondLarge!
Item was changed:
----- Method: LargeIntegersPlugin>>primDigitBitAnd: (in category 'Integer primitives') -----
primDigitBitAnd: secondInteger
"Bit logic here is only implemented for positive integers or Zero; if rec
or arg is negative, it fails."
| firstInteger |
self debugCode: [self msg: 'primDigitBitAnd: secondInteger'].
+ firstInteger := self
+ primitive: 'primDigitBitAnd'
+ parameters: #(Integer )
+ receiver: #Integer.
- firstInteger := self primitive: 'primDigitBitAnd'.
^ self
digitBitLogic: firstInteger
with: secondInteger
opIndex: andOpIndex!
Item was changed:
----- Method: LargeIntegersPlugin>>primDigitBitOr: (in category 'Integer primitives') -----
primDigitBitOr: secondInteger
"Bit logic here is only implemented for positive integers or Zero; if rec
or arg is negative, it fails."
| firstInteger |
self debugCode: [self msg: 'primDigitBitOr: secondInteger'].
+ firstInteger := self
+ primitive: 'primDigitBitOr'
+ parameters: #(Integer )
+ receiver: #Integer.
- firstInteger := self primitive: 'primDigitBitOr'.
^ self
digitBitLogic: firstInteger
with: secondInteger
opIndex: orOpIndex!
Item was changed:
----- Method: LargeIntegersPlugin>>primDigitBitShiftMagnitude: (in category 'Integer primitives') -----
primDigitBitShiftMagnitude: shiftCount
| rShift aLarge anInteger |
self debugCode: [self msg: 'primDigitBitShiftMagnitude: shiftCount'].
anInteger := self
primitive: 'primDigitBitShiftMagnitude'
+ parameters: #(#SmallInteger )
+ receiver: #Integer.
- parameters: #(#SmallInteger ).
(interpreterProxy isIntegerObject: anInteger)
+ ifTrue: ["convert it to a not normalized LargeInteger"
- ifTrue:
- ["convert it to a not normalized LargeInteger"
aLarge := self createLargeFromSmallInteger: anInteger]
+ ifFalse: [aLarge := anInteger].
- ifFalse:
- [(self isLargeIntegerOop: anInteger) ifFalse: [^interpreterProxy primitiveFail].
- aLarge := anInteger].
shiftCount >= 0
ifTrue: [^ self digit: aLarge Lshift: shiftCount]
ifFalse:
[rShift := 0 - shiftCount.
^ self normalize: (self
digit: aLarge
Rshift: rShift
lookfirst: (self digitSizeOfLargeInt: aLarge))]!
Item was changed:
----- Method: LargeIntegersPlugin>>primDigitBitXor: (in category 'Integer primitives') -----
primDigitBitXor: secondInteger
"Bit logic here is only implemented for positive integers or Zero; if rec
or arg is negative, it fails."
| firstInteger |
self debugCode: [self msg: 'primDigitBitXor: secondInteger'].
+ firstInteger := self
+ primitive: 'primDigitBitXor'
+ parameters: #(Integer )
+ receiver: #Integer.
- firstInteger := self primitive: 'primDigitBitXor'.
^ self
digitBitLogic: firstInteger
with: secondInteger
opIndex: xorOpIndex!
Item was changed:
----- Method: LargeIntegersPlugin>>primDigitCompare: (in category 'Integer primitives') -----
primDigitCompare: secondInteger
+ | firstVal secondVal firstInteger |
- | firstVal secondVal firstInteger firstIsSmall secondIsSmall |
self debugCode: [self msg: 'primDigitCompare: secondInteger'].
+ firstInteger := self
+ primitive: 'primDigitCompare'
+ parameters: #(#Integer )
+ receiver: #Integer.
- firstInteger := self primitive: 'primDigitCompare'.
"shortcut: aSmallInteger has to be smaller in Magnitude as aLargeInteger"
+ (interpreterProxy isIntegerObject: firstInteger)
+ ifTrue: ["first"
+ (interpreterProxy isIntegerObject: secondInteger)
+ ifTrue: ["second"
+ (firstVal := interpreterProxy integerValueOf: firstInteger) > (secondVal := interpreterProxy integerValueOf: secondInteger)
- firstIsSmall := interpreterProxy isIntegerObject: firstInteger.
- secondIsSmall := interpreterProxy isIntegerObject: secondInteger.
- firstIsSmall ifFalse: [(self isLargeIntegerOop: firstInteger) ifFalse: [^interpreterProxy primitiveFail]].
- secondIsSmall ifFalse: [(self isLargeIntegerOop: secondInteger) ifFalse: [^interpreterProxy primitiveFail]].
- firstIsSmall
- ifTrue:
- [secondIsSmall
- ifTrue:
- [(firstVal := interpreterProxy integerValueOf: firstInteger) > (secondVal := interpreterProxy integerValueOf: secondInteger)
ifTrue: [^ 1 asOop: SmallInteger"first > second"]
ifFalse: [firstVal < secondVal
ifTrue: [^ -1 asOop: SmallInteger"first < second"]
ifFalse: [^ 0 asOop: SmallInteger"first = second"]]]
+ ifFalse: ["SECOND"
+ ^ -1 asOop: SmallInteger"first < SECOND"]]
+ ifFalse: ["FIRST"
+ (interpreterProxy isIntegerObject: secondInteger)
+ ifTrue: ["second"
+ ^ 1 asOop: SmallInteger"FIRST > second"]
+ ifFalse: ["SECOND"
+ ^ self digitCompareLarge: firstInteger with: secondInteger]]!
- ifFalse:
- [^ -1 asOop: SmallInteger"first < SECOND"]]
- ifFalse:
- [secondIsSmall
- ifTrue:
- [^ 1 asOop: SmallInteger"FIRST > second"]
- ifFalse:
- [^ self digitCompareLarge: firstInteger with: secondInteger]]!
Item was changed:
----- Method: LargeIntegersPlugin>>primDigitDiv:negative: (in category 'Integer primitives') -----
primDigitDiv: secondInteger negative: neg
"Answer the result of dividing firstInteger by secondInteger.
Fail if parameters are not integers, not normalized or secondInteger is
zero. "
| firstAsLargeInteger secondAsLargeInteger firstInteger |
self debugCode: [self msg: 'primDigitDiv: secondInteger negative: neg'].
firstInteger := self
primitive: 'primDigitDivNegative'
+ parameters: #(#Integer #Boolean )
+ receiver: #Integer.
- parameters: #(#Oop #Boolean ).
"Coerce SmallIntegers to corresponding (not normalized) large integers
and check for zerodivide."
(interpreterProxy isIntegerObject: firstInteger)
+ ifTrue: ["convert to LargeInteger"
- ifTrue:
- ["convert to LargeInteger"
self
remapOop: secondInteger
in: [firstAsLargeInteger := self createLargeFromSmallInteger: firstInteger]]
ifFalse:
+ ["Avoid crashes in case of getting unnormalized args."
+ (self isNormalized: firstInteger)
+ ifFalse:
+ [self debugCode:
+ [self msg: 'ERROR in primDigitDiv: secondInteger negative: neg'.
+ self msg: '------> receiver *not* normalized!!'].
+ ^ interpreterProxy primitiveFail].
+ firstAsLargeInteger := firstInteger].
- [(self isLargeIntegerOop: firstInteger) ifFalse: [^interpreterProxy primitiveFail].
- "Avoid crashes in case of getting unnormalized args."
- (self isNormalized: firstInteger) ifFalse: [self
- debugCode: [self msg: 'ERROR in primDigitDiv: secondInteger negative: neg'.
- self msg: '------> receiver *not* normalized!!'].
- ^ interpreterProxy primitiveFail].firstAsLargeInteger := firstInteger].
(interpreterProxy isIntegerObject: secondInteger)
+ ifTrue: ["check for zerodivide and convert to LargeInteger"
+ (interpreterProxy integerValueOf: secondInteger)
+ = 0
- ifTrue:
- ["check for zerodivide and convert to LargeInteger"
- (interpreterProxy integerValueOf: secondInteger) = 0
ifTrue: [^ interpreterProxy primitiveFail].
self
remapOop: firstAsLargeInteger
in: [secondAsLargeInteger := self createLargeFromSmallInteger: secondInteger]]
ifFalse:
+ ["Avoid crashes in case of getting unnormalized args."
+ (self isNormalized: secondInteger)
+ ifFalse:
+ [self debugCode:
+ [self msg: 'ERROR in primDigitDiv: secondInteger negative: neg'.
+ self msg: '------> argument *not* normalized!!'].
+ ^ interpreterProxy primitiveFail].
- [(self isLargeIntegerOop: secondInteger) ifFalse: [^interpreterProxy primitiveFail].
- (self isNormalized: secondInteger) ifFalse: [self
- debugCode: [self msg: 'ERROR in primDigitDiv: secondInteger negative: neg'.
- self msg: '------> argument *not* normalized!!'].
- ^ interpreterProxy primitiveFail].
secondAsLargeInteger := secondInteger].
^ self
digitDivLarge: firstAsLargeInteger
with: secondAsLargeInteger
negative: neg!
Item was changed:
----- Method: LargeIntegersPlugin>>primDigitMultiply:negative: (in category 'Integer primitives') -----
primDigitMultiply: secondInteger negative: neg
| firstLarge secondLarge firstInteger |
self debugCode: [self msg: 'primDigitMultiply: secondInteger negative: neg'].
firstInteger := self
primitive: 'primDigitMultiplyNegative'
+ parameters: #(#Integer #Boolean )
+ receiver: #Integer.
- parameters: #(#Oop #Boolean ).
(interpreterProxy isIntegerObject: firstInteger)
+ ifTrue: ["convert it to a not normalized LargeInteger"
- ifTrue:
- ["convert it to a not normalized LargeInteger"
self
remapOop: secondInteger
in: [firstLarge := self createLargeFromSmallInteger: firstInteger]]
+ ifFalse: [firstLarge := firstInteger].
- ifFalse:
- [(self isLargeIntegerOop: firstInteger) ifFalse: [^interpreterProxy primitiveFail].
- firstLarge := firstInteger].
(interpreterProxy isIntegerObject: secondInteger)
+ ifTrue: ["convert it to a not normalized LargeInteger"
- ifTrue:
- ["convert it to a not normalized LargeInteger"
self
remapOop: firstLarge
in: [secondLarge := self createLargeFromSmallInteger: secondInteger]]
+ ifFalse: [secondLarge := secondInteger].
- ifFalse:
- [(self isLargeIntegerOop: secondInteger) ifFalse: [^interpreterProxy primitiveFail].
- secondLarge := secondInteger].
^ self
digitMultiplyLarge: firstLarge
with: secondLarge
negative: neg!
Item was changed:
----- Method: LargeIntegersPlugin>>primDigitSubtract: (in category 'Integer primitives') -----
primDigitSubtract: secondInteger
| firstLarge secondLarge firstInteger |
self debugCode: [self msg: 'primDigitSubtract: secondInteger'].
+ firstInteger := self
+ primitive: 'primDigitSubtract'
+ parameters: #(#Integer )
+ receiver: #Integer.
- firstInteger := self primitive: 'primDigitSubtract'.
(interpreterProxy isIntegerObject: firstInteger)
+ ifTrue: ["convert it to a not normalized LargeInteger"
- ifTrue:
- ["convert it to a not normalized LargeInteger"
self
remapOop: secondInteger
in: [firstLarge := self createLargeFromSmallInteger: firstInteger]]
+ ifFalse: [firstLarge := firstInteger].
- ifFalse:
- [(self isLargeIntegerOop: firstInteger) ifFalse: [^interpreterProxy primitiveFail].
- firstLarge := firstInteger].
(interpreterProxy isIntegerObject: secondInteger)
+ ifTrue: ["convert it to a not normalized LargeInteger"
- ifTrue:
- ["convert it to a not normalized LargeInteger"
self
remapOop: firstLarge
in: [secondLarge := self createLargeFromSmallInteger: secondInteger]]
+ ifFalse: [secondLarge := secondInteger].
- ifFalse:
- [(self isLargeIntegerOop: firstInteger) ifFalse: [^interpreterProxy primitiveFail].
- secondLarge := secondInteger].
^ self digitSubLarge: firstLarge with: secondLarge!
Item was changed:
----- Method: LargeIntegersPlugin>>primMontgomeryDigitLength (in category 'Integer primitives') -----
primMontgomeryDigitLength
self debugCode: [self msg: 'primMontgomeryDigitLength'].
+ self
+ primitive: 'primMontgomeryDigitLength'
+ parameters: #()
+ receiver: #Integer.
- self primitive: 'primMontgomeryDigitLength'.
^interpreterProxy integerObjectOf: 32!
Item was changed:
----- Method: LargeIntegersPlugin>>primMontgomeryTimes:modulo:mInvModB: (in category 'Integer primitives') -----
primMontgomeryTimes: secondOperandInteger modulo: thirdModuloInteger mInvModB: mInverseInteger
| firstLarge secondLarge firstInteger thirdLarge mInv |
<var: #mInv type: #'unsigned int'>
self debugCode: [self msg: 'montgomeryTimes: secondOperandInteger modulo: thirdModuloInteger mInvModB: smallInverseInteger'].
+ firstInteger := self
+ primitive: 'primMontgomeryTimesModulo'
+ parameters: #(Integer Integer Integer )
+ receiver: #Integer.
+ mInv := interpreterProxy positive32BitValueOf: mInverseInteger.
- firstInteger := self primitive: 'primMontgomeryTimesModulo'.
- mInv := interpreterProxy positive32BitValueOf: mInverseInteger.
(interpreterProxy isIntegerObject: firstInteger)
+ ifTrue: ["convert it to a not normalized LargeInteger"
- ifTrue:
- ["convert it to a not normalized LargeInteger"
self remapOop: #(secondOperandInteger thirdModuloInteger) in: [firstLarge := self createLargeFromSmallInteger: firstInteger]]
+ ifFalse: [firstLarge := firstInteger].
- ifFalse:
- [(self isLargeIntegerOop: firstInteger) ifFalse: [^interpreterProxy primitiveFail].
- firstLarge := firstInteger].
(interpreterProxy isIntegerObject: secondOperandInteger)
+ ifTrue: ["convert it to a not normalized LargeInteger"
- ifTrue:
- ["convert it to a not normalized LargeInteger"
self remapOop: #(firstLarge thirdModuloInteger) in: [secondLarge := self createLargeFromSmallInteger: secondOperandInteger]]
+ ifFalse: [secondLarge := secondOperandInteger].
- ifFalse:
- [(self isLargeIntegerOop: secondOperandInteger) ifFalse: [^interpreterProxy primitiveFail].
- secondLarge := secondOperandInteger].
(interpreterProxy isIntegerObject: thirdModuloInteger)
+ ifTrue: ["convert it to a not normalized LargeInteger"
- ifTrue:
- ["convert it to a not normalized LargeInteger"
self remapOop: #(firstLarge secondLarge) in: [thirdLarge := self createLargeFromSmallInteger: thirdModuloInteger]]
+ ifFalse: [thirdLarge := thirdModuloInteger].
- ifFalse:
- [(self isLargeIntegerOop: thirdModuloInteger) ifFalse: [^interpreterProxy primitiveFail].
- thirdLarge := thirdModuloInteger].
^ self digitMontgomery: firstLarge times: secondLarge modulo: thirdLarge mInvModB: mInv!
Item was changed:
----- Method: LargeIntegersPlugin>>primNormalizeNegative (in category 'Integer primitives') -----
primNormalizeNegative
| rcvr |
self debugCode: [self msg: 'primNormalizeNegative'].
+ rcvr := self
+ primitive: 'primNormalizeNegative'
+ parameters: #()
+ receiver: #LargeNegativeInteger.
- rcvr := self primitive: 'primNormalizeNegative'.
- (interpreterProxy fetchClassOf: rcvr) == interpreterProxy classLargeNegativeInteger ifFalse: [^interpreterProxy primitiveFail].
^ self normalizeNegative: rcvr!
Item was changed:
----- Method: LargeIntegersPlugin>>primNormalizePositive (in category 'Integer primitives') -----
primNormalizePositive
| rcvr |
self debugCode: [self msg: 'primNormalizePositive'].
+ rcvr := self
+ primitive: 'primNormalizePositive'
+ parameters: #()
+ receiver: #LargePositiveInteger.
- rcvr := self primitive: 'primNormalizePositive'.
- (interpreterProxy fetchClassOf: rcvr) == interpreterProxy classLargePositiveInteger ifFalse: [^interpreterProxy primitiveFail].
^ self normalizePositive: rcvr!
Item was added:
+ ----- Method: LargeNegativeInteger class>>ccg:prolog:expr:index: (in category '*VMMaker-plugin generation') -----
+ ccg: cg prolog: aBlock expr: aString index: anInteger
+
+ ^cg ccgLoad: aBlock expr: aString asMemberOfLargeNegativeIntegerFrom: anInteger!
Item was added:
+ ----- Method: LargePositiveInteger class>>ccg:prolog:expr:index: (in category '*VMMaker-plugin generation') -----
+ ccg: cg prolog: aBlock expr: aString index: anInteger
+
+ ^cg ccgLoad: aBlock expr: aString asMemberOfLargePositiveIntegerFrom: anInteger!
Item was added:
+ ----- Method: NewCoObjectMemorySimulator>>isKindOfInteger: (in category 'simulation only') -----
+ isKindOfInteger: offset
+ ^coInterpreter isKindOfInteger: offset!
Item was added:
+ ----- Method: NewCoObjectMemorySimulator>>isLargeIntegerObject: (in category 'simulation only') -----
+ isLargeIntegerObject: offset
+ ^coInterpreter isLargeIntegerObject: offset!
Item was added:
+ ----- Method: NewCoObjectMemorySimulator>>isLargeNegativeIntegerObject: (in category 'simulation only') -----
+ isLargeNegativeIntegerObject: offset
+ ^coInterpreter isLargeNegativeIntegerObject: offset!
Item was added:
+ ----- Method: NewCoObjectMemorySimulator>>isLargePositiveIntegerObject: (in category 'simulation only') -----
+ isLargePositiveIntegerObject: offset
+ ^coInterpreter isLargePositiveIntegerObject: offset!
Item was added:
+ ----- Method: NewObjectMemorySimulator>>isKindOfInteger: (in category 'simulation only') -----
+ isKindOfInteger: offset
+ ^coInterpreter isKindOfInteger: offset!
Item was added:
+ ----- Method: NewObjectMemorySimulator>>isLargeIntegerObject: (in category 'simulation only') -----
+ isLargeIntegerObject: offset
+ ^coInterpreter isLargeIntegerObject: offset!
Item was added:
+ ----- Method: NewObjectMemorySimulator>>isLargeNegativeIntegerObject: (in category 'simulation only') -----
+ isLargeNegativeIntegerObject: offset
+ ^coInterpreter isLargeNegativeIntegerObject: offset!
Item was added:
+ ----- Method: NewObjectMemorySimulator>>isLargePositiveIntegerObject: (in category 'simulation only') -----
+ isLargePositiveIntegerObject: offset
+ ^coInterpreter isLargePositiveIntegerObject: offset!
Item was changed:
----- Method: ObjectMemory>>cCoerceSimple:to: (in category 'simulation support') -----
cCoerceSimple: value to: cTypeString
<doNotGenerate>
^cTypeString caseOf:
+ { [#'char *'] -> [value].
+ [#'unsigned int'] -> [value]. }!
- { [#'char *'] -> [value] }!
Item was added:
+ ----- Method: ObjectMemory>>isInstanceOfClassLargeNegativeInteger: (in category 'interpreter access') -----
+ isInstanceOfClassLargeNegativeInteger: oop
+ <inline: true>
+ "N.B. Because Slang always inlines is:instanceOf:compactClassIndex:
+ (because is:instanceOf:compactClassIndex: has an inline: pragma) the
+ phrase (objectMemory splObj: ClassLargeNegativeInteger) is expanded
+ in-place and is _not_ evaluated if oop has a non-zero CompactClassIndex."
+ ^self
+ is: oop
+ instanceOf: (self splObj: ClassLargeNegativeInteger)
+ compactClassIndex: ClassLargeNegativeIntegerCompactIndex!
Item was added:
+ ----- Method: ObjectMemory>>isInstanceOfClassLargePositiveInteger: (in category 'interpreter access') -----
+ isInstanceOfClassLargePositiveInteger: oop
+ <inline: true>
+ "N.B. Because Slang always inlines is:instanceOf:compactClassIndex:
+ (because is:instanceOf:compactClassIndex: has an inline: pragma) the
+ phrase (objectMemory splObj: ClassLargePositiveInteger) is expanded
+ in-place and is _not_ evaluated if oop has a non-zero CompactClassIndex."
+ ^self
+ is: oop
+ instanceOf: (self splObj: ClassLargePositiveInteger)
+ compactClassIndex: ClassLargePositiveIntegerCompactIndex!
Item was added:
+ ----- Method: ObjectMemory>>isLargeIntegerInstance: (in category 'interpreter access') -----
+ isLargeIntegerInstance: oop
+ <inline: true>
+ ^(self isInstanceOfClassLargePositiveInteger: oop)
+ or: [self isInstanceOfClassLargeNegativeInteger: oop]!
Item was added:
+ ----- Method: SmartSyntaxPluginCodeGenerator>>ccgLoad:expr:asKindOfIntegerFrom: (in category 'coercing') -----
+ ccgLoad: aBlock expr: aString asKindOfIntegerFrom: anInteger
+
+ ^String streamContents: [:aStream | aStream
+ nextPutAll: 'interpreterProxy success: (interpreterProxy isKindOfInteger: (interpreterProxy stackValue: ';
+ nextPutAll: anInteger asString;
+ nextPutAll: ')).';
+ crtab;
+ nextPutAll: (self
+ ccgLoad: aBlock
+ expr: aString
+ asRawOopFrom: anInteger)]!
Item was added:
+ ----- Method: SmartSyntaxPluginCodeGenerator>>ccgLoad:expr:asMemberOfLargeNegativeIntegerFrom: (in category 'coercing') -----
+ ccgLoad: aBlock expr: aString asMemberOfLargeNegativeIntegerFrom: anInteger
+
+ ^String streamContents: [:aStream | aStream
+ nextPutAll: 'interpreterProxy success: (interpreterProxy isLargeNegativeIntegerObject: (interpreterProxy stackValue: ';
+ nextPutAll: anInteger asString;
+ nextPutAll: ')).';
+ crtab;
+ nextPutAll: (self
+ ccgLoad: aBlock
+ expr: aString
+ asRawOopFrom: anInteger)]!
Item was added:
+ ----- Method: SmartSyntaxPluginCodeGenerator>>ccgLoad:expr:asMemberOfLargePositiveIntegerFrom: (in category 'coercing') -----
+ ccgLoad: aBlock expr: aString asMemberOfLargePositiveIntegerFrom: anInteger
+
+ ^String streamContents: [:aStream | aStream
+ nextPutAll: 'interpreterProxy success: (interpreterProxy isLargePositiveIntegerObject: (interpreterProxy stackValue: ';
+ nextPutAll: anInteger asString;
+ nextPutAll: ')).';
+ crtab;
+ nextPutAll: (self
+ ccgLoad: aBlock
+ expr: aString
+ asRawOopFrom: anInteger)]!
Item was added:
+ ----- Method: SmartSyntaxPluginSimulator>>ccgLoad:expr:asKindOfIntegerFrom: (in category 'simulation') -----
+ ccgLoad: forProlog expr: failBlock asKindOfIntegerFrom: argIndexOrNil
+ ^[:oop|
+ interpreterProxy success: (interpreterProxy isKindOfInteger: oop).
+ oop]!
Item was added:
+ ----- Method: SmartSyntaxPluginSimulator>>ccgLoad:expr:asMemberOfLargeNegativeIntegerFrom: (in category 'simulation') -----
+ ccgLoad: forProlog expr: failBlock asMemberOfLargeNegativeIntegerFrom: argIndexOrNil
+ ^[:oop|
+ interpreterProxy success: (interpreterProxy isLargeNegativeIntegerObject: oop).
+ oop]!
Item was added:
+ ----- Method: SmartSyntaxPluginSimulator>>ccgLoad:expr:asMemberOfLargePositiveIntegerFrom: (in category 'simulation') -----
+ ccgLoad: forProlog expr: failBlock asMemberOfLargePositiveIntegerFrom: argIndexOrNil
+ ^[:oop|
+ interpreterProxy success: (interpreterProxy isLargePositiveIntegerObject: oop).
+ oop]!
Item was added:
+ ----- Method: SpurMemoryManager>>isInstanceOfClassLargeNegativeInteger: (in category 'interpreter access') -----
+ isInstanceOfClassLargeNegativeInteger: oop
+ "Answer if the oop is a large negative integer instance."
+ ^(self isNonImmediate: oop) and: [(self classIndexOf: oop) = ClassLargeNegativeIntegerCompactIndex]!
Item was added:
+ ----- Method: SpurMemoryManager>>isInstanceOfClassLargePositiveInteger: (in category 'interpreter access') -----
+ isInstanceOfClassLargePositiveInteger: oop
+ "Answer if the oop is a large positive integer instance."
+ ^(self isNonImmediate: oop) and: [(self classIndexOf: oop) = ClassLargePositiveIntegerCompactIndex]!
Item was added:
+ ----- Method: SpurMemoryManager>>isLargeIntegerInstance: (in category 'interpreter access') -----
+ isLargeIntegerInstance: oop
+ "Answer if the oop is a large positive or negative integer instance."
+ ^(self isNonImmediate: oop) and: [((self classIndexOf: oop) - ClassLargeNegativeIntegerCompactIndex) asUnsignedInteger <= 1]!
Item was added:
+ ----- Method: StackInterpreter>>isKindOfInteger: (in category 'internal interpreter access') -----
+ isKindOfInteger: oop
+ "Answer true if the oop is kind of Integer (Small or Large)."
+ <api>
+ <inline: true>
+ ^(objectMemory isIntegerObject: oop)
+ or: [objectMemory isLargeIntegerInstance: oop]!
Item was added:
+ ----- Method: StackInterpreter>>isLargeIntegerObject: (in category 'internal interpreter access') -----
+ isLargeIntegerObject: oop
+ <api>
+ <inline: true>
+ ^objectMemory isLargeIntegerInstance: oop!
Item was added:
+ ----- Method: StackInterpreter>>isLargeNegativeIntegerObject: (in category 'internal interpreter access') -----
+ isLargeNegativeIntegerObject: oop
+ <api>
+ <inline: true>
+ ^objectMemory isInstanceOfClassLargeNegativeInteger: oop!
Item was added:
+ ----- Method: StackInterpreter>>isLargePositiveIntegerObject: (in category 'internal interpreter access') -----
+ isLargePositiveIntegerObject: oop
+ <api>
+ <inline: true>
+ ^objectMemory isInstanceOfClassLargePositiveInteger: oop!
Item was changed:
----- Method: StackInterpreter>>printStringOf: (in category 'debug printing') -----
printStringOf: oop
| fmt len cnt max i |
<inline: false>
(objectMemory isImmediate: oop) ifTrue:
[^self].
(objectMemory addressCouldBeObj: oop) ifFalse:
[^self].
fmt := objectMemory formatOf: oop.
fmt < objectMemory firstByteFormat ifTrue: [^self].
cnt := (max := 128) min: (len := objectMemory lengthOf: oop).
i := 0.
((objectMemory is: oop
instanceOf: (objectMemory splObj: ClassByteArray)
compactClassIndex: classByteArrayCompactIndex)
+ or: [(objectMemory isLargeIntegerInstance: oop)])
- or: [(self isInstanceOfClassLargePositiveInteger: oop)
- or: [(self isInstanceOfClassLargeNegativeInteger: oop)]])
ifTrue:
[[i < cnt] whileTrue:
[self printHex: (objectMemory fetchByte: i ofObject: oop).
i := i + 1]]
ifFalse:
[[i < cnt] whileTrue:
[self cCode:
[(objectMemory fetchByte: i ofObject: oop) = 13 "Character cr asInteger" ifTrue:
[self print: '<CR>'.
i + 1 < len ifTrue:
[self print: '...'].
^self]].
self printChar: (objectMemory fetchByte: i ofObject: oop).
i := i + 1]].
len > max ifTrue:
[self print: '...'].
self flush!
Item was changed:
----- Method: ThreadedFFIPlugin>>ffiIntegerValueOf: (in category 'callout support') -----
ffiIntegerValueOf: oop
"Support for generic callout. Answer an integer value that is coerced as C would do."
<inline: true>
"Cheat with a tag test"
(oop anyMask: BytesPerWord - 1)
ifTrue:
[(interpreterProxy isIntegerObject: oop) ifTrue:
[^interpreterProxy integerValueOf: oop].
self cppIf: SPURVM
ifTrue:
[(interpreterProxy isCharacterObject: oop) ifTrue: "Immediate in Spur"
[^interpreterProxy characterValueOf: oop].
(interpreterProxy isFloatObject: oop) ifTrue: "Immediate in 64-bit Spur"
[^interpreterProxy floatValueOf: oop]]]
ifFalse:
[self cppIf: SPURVM
ifTrue: "No non-immediate characters in Spur"
[]
ifFalse:
[(interpreterProxy isCharacterObject: oop) ifTrue:
[^interpreterProxy characterValueOf: oop]].
(interpreterProxy isFloatObject: oop) ifTrue:
[^interpreterProxy floatValueOf: oop].
oop = interpreterProxy nilObject ifTrue: [^0]. "@@: should we really allow this????"
oop = interpreterProxy falseObject ifTrue: [^0].
oop = interpreterProxy trueObject ifTrue: [^1].
+ (interpreterProxy isLargePositiveIntegerObject: oop) ifTrue:
- (interpreterProxy fetchClassOf: oop) = interpreterProxy classLargePositiveInteger ifTrue:
[self cppIf: BytesPerWord = 8 "Use cppIf: to get the return type of the function right. Should be sqInt on 32-bits."
ifTrue: [^interpreterProxy positive64BitValueOf: oop]
ifFalse: [^interpreterProxy positive32BitValueOf: oop]]].
^interpreterProxy signedMachineIntegerValueOf: oop "<- will fail if not integer"!
More information about the Vm-dev
mailing list