[Vm-dev] VM Maker: VMMaker.oscog-nice.1813.mcz
Nicolas Cellier
nicolas.cellier.aka.nice at gmail.com
Tue Apr 19 23:37:49 UTC 2016
As suggested by Eliot, the class checks could be defined as macros in the
plugin preamble (if internal plugin and if SPURVM...), but this should also
be the case of many other vm api selectors (like isIntegerObject: etc...).
As suggested by Levente, this could as well be generalized by link time
optimization options of clang/gcc (-flto)...
Or by aggregating vm and internal plugins into a single source file.
We'll see later.
2016-04-20 1:04 GMT+02:00 <commits at source.squeak.org>:
>
> 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"!
>
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://lists.squeakfoundation.org/pipermail/vm-dev/attachments/20160420/95c81cf9/attachment-0001.htm
More information about the Vm-dev
mailing list