[Vm-dev] VM Maker: VMMaker.oscog-nice.1823.mcz
commits at source.squeak.org
commits at source.squeak.org
Wed Apr 20 00:09:56 UTC 2016
Nicolas Cellier uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-nice.1823.mcz
==================== Summary ====================
Name: VMMaker.oscog-nice.1823
Author: nice
Time: 20 April 2016, 2:07:36.545 am
UUID: e93f8c0f-a7f9-409d-ac57-f8ae88bb4342
Ancestors: VMMaker.oscog-eem.1822, VMMaker.oscog-nice.1813
Merge the LargeIntegersPlugin acceleration for type checking (VMMaker.oscog-nice.1813).
Add the missing simulation hooks for Spur.
These changes require svn sources for platforms/Cross/vm/sqVirtualMemory.[ch] rev 3673
=============== Diff against VMMaker.oscog-eem.1822 ===============
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 classLargeNegativeInteger ifTrue: [^ 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 classLargeNegativeInteger ifTrue: [^ 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 changed:
----- Method: LargeIntegersPlugin>>isNormalized: (in category 'oop functions') -----
+ isNormalized: aLargeInteger
+ | len |
- isNormalized: anInteger
- | len maxVal minVal sLen val class positive |
- <var: #val type: #'unsigned long'>
- <var: #minVal type: #'unsigned long'>
- (interpreterProxy isIntegerObject: anInteger)
- ifTrue: [^ true].
- class := interpreterProxy fetchClassOf: anInteger.
- (positive := class = interpreterProxy classLargePositiveInteger) ifFalse:
- [class = interpreterProxy classLargeNegativeInteger ifFalse:
- [interpreterProxy primitiveFailFor: PrimErrBadArgument.
- ^false]].
"Check for leading zero of LargeInteger"
+ len := self byteSizeOfLargeInt: aLargeInteger.
- len := self byteSizeOfLargeInt: anInteger.
len = 0 ifTrue:
[^ false].
+ (self unsafeByteOfLargeInt: aLargeInteger at: len) = 0 ifTrue:
- (self unsafeByteOfLargeInt: anInteger at: len) = 0 ifTrue:
[^ false].
+ ^true!
- "no leading zero, now check if anInteger is in SmallInteger range or not"
- sLen := interpreterProxy maxSmallInteger > 16r3FFFFFFF
- ifTrue: [8]
- ifFalse: [4].
- "maximal digitLength of aSmallInteger"
- len > sLen ifTrue:
- [^ true].
- len < sLen ifTrue:
- [^ false].
- "len = sLen"
- ^positive
- ifTrue: [maxVal := interpreterProxy maxSmallInteger. "SmallInteger maxVal"
- "all bytes of maxVal but the highest one are just FF's"
- (self digitOfCSI: anInteger at: sLen // 4)
- > (self digitOfCSI: maxVal at: sLen // 4)]
- ifFalse: [val := self unsafeDigitOfLargeInt: anInteger at: len // 4.
- sLen > 4 ifTrue: [val := val << 32 + (self unsafeDigitOfLargeInt: anInteger at: 1)].
- minVal := 0 - interpreterProxy minSmallInteger.
- val > minVal]!
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>>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.
- "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].
- (self isNormalized: secondInteger)
- ifFalse: [self
- debugCode: [self msg: 'ERROR in primDigitDiv: secondInteger negative: neg'.
- self msg: '------> argument *not* normalized!!'].
- ^ interpreterProxy primitiveFail].
"Coerce SmallIntegers to corresponding (not normalized) large integers
and check for zerodivide."
(interpreterProxy isIntegerObject: firstInteger)
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].
- ifFalse: [firstAsLargeInteger := firstInteger].
(interpreterProxy isIntegerObject: secondInteger)
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].
+ secondAsLargeInteger := secondInteger].
- ifFalse: [secondAsLargeInteger := secondInteger].
^ self
digitDivLarge: firstAsLargeInteger
with: secondAsLargeInteger
negative: neg!
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>>isKindOfInteger: (in category 'simulation only') -----
+ isKindOfInteger: oop
+ <doNotGenerate>
+ ^coInterpreter isKindOfInteger: oop!
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: SpurMemoryManager>>isLargeNegativeIntegerObject: (in category 'simulation only') -----
+ isLargeNegativeIntegerObject: oop
+ <doNotGenerate>
+ ^coInterpreter isLargeNegativeIntegerObject: oop!
Item was added:
+ ----- Method: SpurMemoryManager>>isLargePositiveIntegerObject: (in category 'simulation only') -----
+ isLargePositiveIntegerObject: oop
+ <doNotGenerate>
+ ^coInterpreter isLargePositiveIntegerObject: oop!
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