[Vm-dev] VM Maker: VMMaker.oscog-nice.1771.mcz
commits at source.squeak.org
commits at source.squeak.org
Wed Apr 6 03:09:16 UTC 2016
Nicolas Cellier uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-nice.1771.mcz
==================== Summary ====================
Name: VMMaker.oscog-nice.1771
Author: nice
Time: 6 April 2016, 5:06:23.182 am
UUID: 36fe278a-84bd-4899-a882-833a4edf8696
Ancestors: VMMaker.oscog-cb.1770
Upgrade LargeIntegersPlugin to v2.0
LargeInteger primitives now deal with 32-bits digits.
At image side, LargeInteger digits are still 8-bit wide.
This enables fallback code to work in absence of the plugin.
Subtle code:
1) Large integers still have byteLength calculated as short as possible
this is to avoid having null highest 8-bit digit at image side
2) For this reason largeInt:growTo: takes a byte-length parameter
and we need to restore byteSizeOfCSI: and byteSizeOfLargeInt:
3) For multiply, the result is allocated with just enough bytes
for example 13 bytes*11 bytes->24 bytes->6 digits
If we would round to digits, that would be: 4 digits*3 digits->7 digits
for this reason, an additional parameter (resLen) has been added to cDigitMultiply
and care is taken to not write a (null) carry past this result length
4) For hypothetical big-endian machines, bytes are swapped on the fly at each fetch/store from/to memory (see cDigitOf:at: / cDigitOf:at:put:)
This is achieved thru byteSwapped32IfBigEndian: which translates to a C macro SQ_SWAP_4_BYTES_IF_BIGENDIAN (defined in SVN platforms/Cross/vm/sqMemoryAccess.h)
But this is necessary only for arithmetic ops (+ - * / < > ...)
For bit ops or copy, there is no need to swap bytes, so direct access to pointer is used.
5) Due to SmartSyntaxInterpreterPlugin, byteSwapped32IfBigEndian: has to be send to self, not to interpreterProxy, otherwise the C function is generated even if we specified <doNotGenerate> in InterpreterProxy...
For simulation purposes, this message delegates to InterpreterProxy>>byteSwapped32IfBigEndian: (this time <doNotGenerate> is taken into account in LargeIntegersPlugin)
InterpreterProxy should have a knowledge of simulator objectMemory endianness, and we should be able to simulate big endian VM. But it currently does not, so we can only simulate little endian until we fix it.
Other than that I renamed a few messages
cDigitOfCSI:at: -> digitOfCSI:at:
cDigitLengthOfCSI: -> digitSizeOfCSI:
This was to have a better symetry with digitOfLargeInt:at: digitSizeOfLargeInt:
For the future, some operations could be further optimized:
- on Spur VM, objects are 8 byte aligned. If we can make sure that every byte up to byteLenght + 7 // 8 is correctly filled with zero, then we can implement some of the primitives with 64-bits digit (for example comparison and bit-ops)
- the copy of digits could be perform with mem:cp:y:
- in normalizePositive: / normalizeNegative: it should be possible to shorten a LargeInteger from longByteLen to shortByteLen without reallocating and copying, if ever (shortByteLen + 3 // 4) = (longByteLen + 3 // 4) in V3, and (shortByteLen + 7 // 8) = (longByteLen + 7 // 8) in Spur. I demonstrated this sometimes ago (see http://smallissimo.blogspot.fr/2013/04/still-hacking-largeintegerplugins-in.html)
OK, this commit message is a bit longer than usual, and maybe this prose should be saved elsewhere, but at least it now exists.
=============== Diff against VMMaker.oscog-cb.1770 ===============
Item was added:
+ ----- Method: InterpreterProxy>>byteSwapped32IfBigEndian: (in category 'other') -----
+ byteSwapped32IfBigEndian: anInteger
+ "Note: for simulation only.
+ This message is not generated in C but replaced with a macro"
+ <doNotGenerate>
+ self vmEndianness = 1 ifTrue: [^anInteger byteSwap32].
+ ^anInteger!
Item was added:
+ ----- Method: InterpreterProxy>>byteSwapped64IfBigEndian: (in category 'other') -----
+ byteSwapped64IfBigEndian: anInteger
+ "Note: for simulation only.
+ This message is not generated in C but replaced with a macro"
+ <doNotGenerate>
+ self vmEndianness = 1 ifTrue: [^anInteger byteSwap64].
+ ^anInteger!
Item was changed:
SmartSyntaxInterpreterPlugin subclass: #LargeIntegersPlugin
instanceVariableNames: 'andOpIndex orOpIndex xorOpIndex'
classVariableNames: ''
poolDictionaries: ''
category: 'VMMaker-Plugins'!
+ !LargeIntegersPlugin commentStamp: 'nice 4/5/2016 22:27' prior: 0!
- !LargeIntegersPlugin commentStamp: 'sr 6/14/2004 14:04' prior: 0!
LargeIntegersPlugin provides functions for speeding up LargeInteger arithmetics. Usually it is part of your installation as 'LargeIntegers' plugin (a C-compiled binary).
Correctly installed?
----------------------
Probably you are just working with it.
To be really sure try
100 factorial. "to force plugin loading"
SmalltalkImage current listLoadedModules.
Then you should see 'LargeIntegers' somewhere in the output strings. If this should not be the case, you probably have a problem.
Variables
-----------
Inst vars:
andOpIndex C constant
orOpIndex C constant
xorOpIndex C constant
Used like an enum, in ST one would use symbols instead.
Class vars:
none
History
--------
+ v2.0
+
+ Rewrite primitives to use 32-bits digits instead of 8-bits digits. This can fasten many operation up to 2x and multiplication up to 7x.
+ Since Large Integers are still variable byte object, care is taken to allocate just enough bytes to contain integer value (not necessarily a multiple of 4 bytes).
+ Primitives will use the extra bytes beyond necessary bytes up to next multiple of 4, so it's mandatory that those extra bytes be correctly set to zero
+ At image side, digits are still 8-bits so that fallback code involve only SmallInteger.
+
+ Primitives assume that byte ordering (endianness) is allways little endian, because LargeIntegers remain regular byte Objects.
+ On (hypothetic) big endian machines, conversion is performed at fetch/store time thru usage of dedicated macro.
+
v1.5
- no code change at all compared to v1.4
- made to outsource testing code (LargeIntegersPluginTest) introduced in earlier versions
- updated class comment: reference to LargeIntegersPluginTest removed
v1.4
- no semantic change compared to v1.3
- >>cHighBit: improved (could be faster now)
- fix: class comment
- improved class comment
- >>flag: introduced to allow #flag: messages (does nothing)
- new: class>>buildCodeGeneratorUpTo: as hook for switching debugMode (default is not to change anything)
- removed: class>>new (obsolete)
- minor cleanup of source code layout
v1.3
- fix: >>primDigitDiv:negative: now checks if its Integer args are normalized; without this change the plugin crashes, if a division by zero through a non normalized - filled with zero bytes - arg occurs. This can happen through printing by the inspector windows after changing the bytes of a LargeInteger manually.
v1.2
- fix: >>anyBitOfBytes: aBytesOop from: start to: stopArg
v1.1
- >>primGetModuleName for checking the version of the plugin;
- >>primDigitBitShiftMagnitude and >>primAnyBitFrom:to: for supporting - not installing!! - unification of shift semantics of negative Integers;
v1.0
- speeds up digitDiv:neg: at about 20%.
In >>cCoreDigitDivDiv:len:rem:len:quo:len: the 'nibble' arithmetic is removed.
!
Item was changed:
----- Method: LargeIntegersPlugin class>>version (in category 'translation') -----
version
"Answer the receiver's version info as String."
+ ^ 'v2.0'!
- ^ 'v1.5'!
Item was changed:
----- Method: LargeIntegersPlugin>>anyBitOfLargeInt:from:to: (in category 'util') -----
+ anyBitOfLargeInt: anOop from: start to: stopArg
+ "Argument has to be a Large Integer!!"
- anyBitOfLargeInt: aBytesOop from: start to: stopArg
- "Argument has to be aBytesOop!!"
"Tests for any magnitude bits in the interval from start to stopArg."
+ | magnitude stop firstDigitIx lastDigitIx firstMask lastMask |
+ <var: #digit type: #'unsigned int'>
+ <var: #firstMask type: #'unsigned int'>
+ <var: #lastMask type: #'unsigned int'>
+ <var: #firstDigitIx type: #usqInt>
+ <var: #lastDigitIx type: #usqInt>
+ <var: #ix type: #usqInt>
- | magnitude rightShift leftShift stop firstByteIx lastByteIx |
self
+ debugCode: [self msg: 'anyBitOfLargeInt: anOop from: start to: stopArg'].
- debugCode: [self msg: 'anyBitOfLargeInt: aBytesOop from: start to: stopArg'].
start < 1 | (stopArg < 1)
ifTrue: [^ interpreterProxy primitiveFail].
+ magnitude := anOop.
+ stop := stopArg min: (self highBitOfLargeInt: magnitude).
- magnitude := aBytesOop.
- stop := stopArg
- min: (self highBitOfLargeInt: magnitude).
start > stop
ifTrue: [^ false].
+ firstDigitIx := start - 1 // 32 + 1.
+ lastDigitIx := stop - 1 // 32 + 1.
+ firstMask := 16rFFFFFFFF asUnsignedLong << (start - 1 bitAnd: 31). "Note asUnsignedLong required to avoid ULLL suffix bug"
+ lastMask := 16rFFFFFFFF >> (31 - (stop - 1 bitAnd: 31)).
+ firstDigitIx = lastDigitIx
+ ifTrue: [| digit |
+ digit := self unsafeDigitOfLargeInt: magnitude at: firstDigitIx.
+ ^ (digit bitAnd: (firstMask bitAnd: lastMask))
- firstByteIx := start - 1 // 8 + 1.
- lastByteIx := stop - 1 // 8 + 1.
- rightShift := (start - 1 \\ 8).
- leftShift := 7 - (stop - 1 \\ 8).
- firstByteIx = lastByteIx
- ifTrue: [| digit mask |
- mask := (255 << rightShift) bitAnd: (255 >> leftShift).
- digit := self digitOfLargeInt: magnitude at: firstByteIx.
- ^ (digit bitAnd: mask)
~= 0].
+ ((self unsafeDigitOfLargeInt: magnitude at: firstDigitIx) bitAnd: firstMask)
- ((self digitOfLargeInt: magnitude at: firstByteIx)
- >> rightShift)
~= 0
ifTrue: [^ true].
+ firstDigitIx + 1
+ to: lastDigitIx - 1
+ do: [:ix | (self unsafeDigitOfLargeInt: magnitude at: ix)
- firstByteIx + 1
- to: lastByteIx - 1
- do: [:ix | (self digitOfLargeInt: magnitude at: ix)
~= 0
ifTrue: [^ true]].
+ ((self unsafeDigitOfLargeInt: magnitude at: lastDigitIx) bitAnd: lastMask)
- (((self digitOfLargeInt: magnitude at: lastByteIx)
- << leftShift)
- bitAnd: 255)
~= 0
ifTrue: [^ true].
^ false!
Item was added:
+ ----- Method: LargeIntegersPlugin>>byteSizeOfCSI: (in category 'util') -----
+ byteSizeOfCSI: csi
+ "Answer the number of bytes required to represent the value of a C-SmallInteger."
+ csi >= 0 ifTrue:
+ [csi < 256 ifTrue:
+ [^1].
+ csi < 65536 ifTrue:
+ [^2].
+ csi < 16777216 ifTrue:
+ [^3].
+ self cppIf: interpreterProxy bytesPerOop = 4
+ ifTrue:
+ [^4]
+ ifFalse:
+ [csi < 4294967296 ifTrue:
+ [^4].
+ csi < 1099511627776 ifTrue:
+ [^5].
+ csi < 281474976710656 ifTrue:
+ [^6].
+ csi < 72057594037927936 ifTrue:
+ [^7].
+ ^8]].
+ csi > -256 ifTrue:
+ [^1].
+ csi > -65536 ifTrue:
+ [^2].
+ csi > -16777216 ifTrue:
+ [^3].
+ self cppIf: interpreterProxy bytesPerOop = 4
+ ifTrue:
+ [^4]
+ ifFalse:
+ [csi > -4294967296 ifTrue:
+ [^4].
+ csi > -1099511627776 ifTrue:
+ [^5].
+ csi > -281474976710656 ifTrue:
+ [^6].
+ csi > -72057594037927936 ifTrue:
+ [^7].
+ ^8]!
Item was added:
+ ----- Method: LargeIntegersPlugin>>byteSizeOfLargeInt: (in category 'util') -----
+ byteSizeOfLargeInt: bytesOop
+ "Answer the number of bytes required to represent a LargeInteger.
+ Precondition: bytesOop is not a small integer."
+ ^ interpreterProxy slotSizeOf: bytesOop!
Item was added:
+ ----- Method: LargeIntegersPlugin>>byteSwapped32IfBigEndian: (in category 'C core util') -----
+ byteSwapped32IfBigEndian: anInteger
+ "This is only for simulation purposes"
+ <doNotGenerate>
+ ^interpreterProxy byteSwapped32IfBigEndian: anInteger!
Item was added:
+ ----- Method: LargeIntegersPlugin>>byteSwapped64IfBigEndian: (in category 'C core util') -----
+ byteSwapped64IfBigEndian: anInteger
+ "This is only for simulation purposes"
+ <doNotGenerate>
+ ^interpreterProxy byteSwapped64IfBigEndian: anInteger!
Item was removed:
- ----- Method: LargeIntegersPlugin>>cCopyIntVal:toBytes: (in category 'C core util') -----
- cCopyIntVal: val toBytes: bytes
- | pByte |
- <var: #pByte type: #'unsigned char *'>
- pByte := interpreterProxy firstIndexableField: bytes.
- 1 to: (self cDigitLengthOfCSI: val)
- do: [:ix | pByte at: ix - 1 put: (self cDigitOfCSI: val at: ix)]!
Item was changed:
----- Method: LargeIntegersPlugin>>cDigitAdd:len:with:len:into: (in category 'C core') -----
+ cDigitAdd: pWordShort len: shortLen with: pWordLong len: longLen into: pWordRes
+ "pWordRes len = longLen; returns over.."
+ | accum |
+ <returnTypeC: #'unsigned int'>
+ <var: #pWordShort type: #'unsigned int *'>
+ <var: #pWordLong type: #'unsigned int *'>
+ <var: #pWordRes type: #'unsigned int *'>
+ <var: #accum type: #'unsigned long long'>
- cDigitAdd: pByteShort len: shortLen with: pByteLong len: longLen into: pByteRes
- "pByteRes len = longLen; returns over.."
- | accum limit |
- <returnTypeC: #'unsigned char'>
- <var: #pByteShort type: #'unsigned char *'>
- <var: #pByteLong type: #'unsigned char *'>
- <var: #pByteRes type: #'unsigned char *'>
- <var: #accum type: #'unsigned int'>
accum := 0.
+ 0 to: shortLen - 1 do:
- limit := shortLen - 1.
- 0 to: limit do:
[:i |
+ accum := (accum >> 32)
+ + (self cDigitOf: pWordShort at: i)
+ + (self cDigitOf: pWordLong at: i).
+ self cDigitOf: pWordRes at: i put: (accum bitAnd: 16rFFFFFFFF)].
+ shortLen to: longLen - 1 do:
- accum := (accum >> 8)
- + (pByteShort at: i) + (pByteLong at: i).
- pByteRes at: i put: (accum bitAnd: 255)].
- limit := longLen - 1.
- shortLen to: limit do:
[:i |
+ accum := (accum >> 32)
+ + (self cDigitOf: pWordLong at: i).
+ self cDigitOf: pWordRes at: i put: (accum bitAnd: 16rFFFFFFFF)].
+ ^ accum >> 32!
- accum := (accum >> 8)
- + (pByteLong at: i).
- pByteRes at: i put: (accum bitAnd: 255)].
- ^ accum >> 8!
Item was changed:
----- Method: LargeIntegersPlugin>>cDigitCompare:with:len: (in category 'C core') -----
cDigitCompare: pFirst with: pSecond len: len
"Precondition: pFirst len = pSecond len."
| secondDigit ix firstDigit |
+ <var: #pFirst type: #'unsigned int *'>
+ <var: #pSecond type: #'unsigned int *'>
- <var: #pFirst type: #'unsigned char *'>
- <var: #pSecond type: #'unsigned char *'>
<var: #firstDigit type: #'unsigned int'>
<var: #secondDigit type: #'unsigned int'>
ix := len - 1.
[ix >= 0]
whileTrue:
[(secondDigit := pSecond at: ix) ~= (firstDigit := pFirst at: ix)
+ ifTrue: [(self byteSwapped32IfBigEndian: secondDigit) < (self byteSwapped32IfBigEndian: firstDigit)
- ifTrue: [secondDigit < firstDigit
ifTrue: [^ 1]
ifFalse: [^ -1]].
ix := ix - 1].
^ 0!
Item was changed:
----- Method: LargeIntegersPlugin>>cDigitCopyFrom:to:len: (in category 'C core util') -----
cDigitCopyFrom: pFrom to: pTo len: len
+ <var: #pFrom type: #'unsigned int *'>
+ <var: #pTo type: #'unsigned int *'>
- | limit |
- <returnTypeC: #'int'>
- <var: #pFrom type: #'unsigned char *'>
- <var: #pTo type: #'unsigned char *'>
self cCode: '' inSmalltalk: [
(interpreterProxy isKindOf: InterpreterSimulator) ifTrue: [
"called from InterpreterSimulator"
+ 0 to: (len - 1) * 4 do: [:i |
- limit := len - 1.
- 0 to: limit do: [:i |
interpreterProxy byteAt: pTo + i
put: (interpreterProxy byteAt: pFrom + i)
].
^ 0
].
].
+ "Note: don't care about endianness here, copy operation is endian neutral"
+ 0 to: len - 1 do: [:i | pTo at: i put: (pFrom at: i)].
+ ^ 0!
- limit := len - 1.
- 0 to: limit do: [:i | pTo at: i put: (pFrom at: i)].
- ^ 0
- !
Item was changed:
----- Method: LargeIntegersPlugin>>cDigitDiv:len:rem:len:quo:len: (in category 'C core') -----
cDigitDiv: pDiv len: divLen rem: pRem len: remLen quo: pQuo len: quoLen
+ | dl ql dh dnh j t hi lo r3 l a b cond q r1r2 mul |
+ <var: #pDiv type: #'unsigned int *'>
+ <var: #pRem type: #'unsigned int *'>
+ <var: #pQuo type: #'unsigned int *'>
- | dl ql dh dnh j t hi lo r3 l a cond q r1r2 mul b |
- <var: #pDiv type: #'unsigned char *'>
- <var: #pRem type: #'unsigned char *'>
- <var: #pQuo type: #'unsigned char *'>
<var: #dh type: #'unsigned int'>
<var: #dnh type: #'unsigned int'>
<var: #r3 type: #'unsigned int'>
+ <var: #q type: #'unsigned long long'>
+ <var: #a type: #'unsigned long long'>
+ <var: #b type: #'unsigned long long'>
+ <var: #t type: #'unsigned long long'>
+ <var: #mul type: #'unsigned long long'>
+ <var: #hi type: #'unsigned long long'>
+ <var: #lo type: #'unsigned long long'>
+ <var: #r1r2 type: #'unsigned long long'>
- <var: #q type: #'unsigned int'>
- <var: #a type: #'unsigned int'>
- <var: #b type: #'unsigned int'>
- <var: #t type: #'unsigned int'>
- <var: #mul type: #'unsigned int'>
- <var: #hi type: #'unsigned int'>
- <var: #lo type: #'unsigned int'>
- <var: #r1r2 type: #'unsigned int'>
dl := divLen - 1.
"Last actual byte of data (ST ix)"
ql := quoLen.
+ dh := self cDigitOf: pDiv at: dl - 1.
- dh := pDiv at: dl - 1.
dl = 1
ifTrue: [dnh := 0]
+ ifFalse: [dnh := self cDigitOf: pDiv at: dl - 2].
- ifFalse: [dnh := pDiv at: dl - 2].
1 to: ql do:
[:k |
"maintain quo*arg+rem=self"
+ "Estimate rem/div by dividing the leading two unint32 of rem by dh."
+ "The estimate is q = qhi*16r100000000+qlo, where qhi and qlo are uint32."
- "Estimate rem/div by dividing the leading two digits of rem by dh."
- "The estimate is q = qhi*16r100+qlo, where qhi and qlo are unsigned char."
j := remLen + 1 - k.
"r1 := rem digitAt: j."
+ (self cDigitOf: pRem at: j - 1)
- (pRem at: j - 1)
= dh
+ ifTrue: [q := 16rFFFFFFFF]
- ifTrue: [q := 16rFF]
ifFalse:
+ ["Compute q = (r1,r2)//dh, t = (r1,r2)\\dh.
+ Note that r1,r2 are uint64, not uint32."
- ["Compute q = (r1,r2)//dh, t = (r1,r2)\\dh."
"r2 := (rem digitAt: j - 2)."
+ r1r2 := self cDigitOf: pRem at: j - 1.
+ r1r2 := (r1r2 << 32) + (self cDigitOf: pRem at: j - 2).
- r1r2 := pRem at: j - 1.
- r1r2 := (r1r2 << 8) + (pRem at: j - 2).
t := r1r2 \\ dh.
q := r1r2 // dh.
"Next compute (hi,lo) := q*dnh"
mul := q * dnh.
+ hi := mul >> 32.
+ lo := mul bitAnd: 16rFFFFFFFF.
- hi := mul >> 8.
- lo := mul bitAnd: 16rFF.
"Correct overestimate of q.
Max of 2 iterations through loop -- see Knuth vol. 2"
j < 3
ifTrue: [r3 := 0]
+ ifFalse: [r3 := self cDigitOf: pRem at: j - 3].
- ifFalse: [r3 := pRem at: j - 3].
[(t < hi
or: [t = hi and: [r3 < lo]])
ifTrue:
["i.e. (t,r3) < (hi,lo)"
q := q - 1.
hi = 0 "since hi is unsigned we must have this guard"
ifTrue: [cond := false]
ifFalse:
[lo < dnh
ifTrue:
[hi := hi - 1.
+ lo := lo + 16r100000000 - dnh]
- lo := lo + 16r100 - dnh]
ifFalse:
[lo := lo - dnh].
cond := hi >= dh]]
ifFalse: [cond := false].
cond]
whileTrue: [hi := hi - dh]].
"Subtract q*div from rem"
l := j - dl.
a := 0.
1 to: divLen do:
[:i |
+ hi := (self cDigitOf: pDiv at: i - 1) * (q >> 32).
+ lo := (self cDigitOf: pDiv at: i - 1) * (q bitAnd: 16rFFFFFFFF).
+ b := (self cDigitOf: pRem at: l - 1) - a - (lo bitAnd: 16rFFFFFFFF).
+ self cDigitOf: pRem at: l - 1 put: (b bitAnd: 16rFFFFFFFF).
+ "simulate arithmetic shift (preserving sign of b)"
+ b := b >> 32 bitOr: (0 - (b >> 63) bitAnd: 16rFFFFFFFF00000000).
+ a := hi + (lo >> 32) - b.
- hi := (pDiv at: i - 1) * (q >> 8).
- lo := (pDiv at: i - 1) * (q bitAnd: 16rFF).
- b := (pRem at: l - 1) - a - (lo bitAnd: 16rFF).
- pRem at: l - 1 put: (b bitAnd: 16rFF).
- "BEWARE: signed shift is implementation defined in C..."
- b := b signedBitShift: -8.
- "This is a possible replacement to simulate arithmetic shift (preserving sign of b)"
- "b := b >> 8 bitOr: (0 - (b >> ((interpreterProxy sizeof: b)*8""CHAR_BIT""-1)) << 8)."
- a := hi + (lo >> 8) - b.
l := l + 1].
a > 0
ifTrue:
["Add div back into rem, decrease q by 1"
q := q - 1.
l := j - dl.
a := 0.
1 to: divLen do:
[:i |
+ a := (a >> 32)
+ + (self cDigitOf: pRem at: l - 1) + (self cDigitOf: pDiv at: i - 1).
+ self cDigitOf: pRem at: l - 1 put: (a bitAnd: 16rFFFFFFFF).
- a := (a >> 8)
- + (pRem at: l - 1) + (pDiv at: i - 1).
- pRem at: l - 1 put: (a bitAnd: 16rFF).
l := l + 1]].
+ self cDigitOf: pQuo at: quoLen - k put: q].
- pQuo at: quoLen - k put: q].
^0!
Item was changed:
----- Method: LargeIntegersPlugin>>cDigitHighBit:len: (in category 'C core util') -----
+ cDigitHighBit: pUint32 len: len
- cDigitHighBit: pByte len: len
"Answer the index (in bits) of the high order bit of the receiver, or zero if the
receiver is zero. This method is allowed (and needed) for
+ LargeNegativeIntegers as well, since Squeak's LargeIntegers are sign/magnitude.
+ Work with 32 bits digits."
- LargeNegativeIntegers as well, since Squeak's LargeIntegers are
- sign/magnitude."
| realLength lastDigit |
+ <var: #pUint32 type: #'unsigned int *'>
- <var: #pByte type: #'unsigned char *'>
<var: #lastDigit type: #'unsigned int'>
realLength := len.
+ [realLength = 0 ifTrue: [^0].
+ (lastDigit := self cDigitOf: pUint32 at: (realLength := realLength - 1)) = 0]
+ whileTrue.
+ ^ (self cHighBit32: lastDigit) + (32 * realLength)!
- [(lastDigit := pByte at: realLength - 1) = 0]
- whileTrue: [(realLength := realLength - 1) = 0 ifTrue: [^ 0]].
- ^ (self cHighBit: lastDigit) + (8 * (realLength - 1))!
Item was removed:
- ----- Method: LargeIntegersPlugin>>cDigitLengthOfCSI: (in category 'C core util') -----
- cDigitLengthOfCSI: csi
- "Answer the number of bytes required to represent the value of a CSmallInteger."
- csi >= 0 ifTrue:
- [csi < 256 ifTrue:
- [^1].
- csi < 65536 ifTrue:
- [^2].
- csi < 16777216 ifTrue:
- [^3].
- self cppIf: interpreterProxy bytesPerOop = 4
- ifTrue:
- [^4]
- ifFalse:
- [csi < 4294967296 ifTrue:
- [^4].
- csi < 1099511627776 ifTrue:
- [^5].
- csi < 281474976710656 ifTrue:
- [^6].
- csi < 72057594037927936 ifTrue:
- [^7].
- ^8]].
- csi > -256 ifTrue:
- [^1].
- csi > -65536 ifTrue:
- [^2].
- csi > -16777216 ifTrue:
- [^3].
- self cppIf: interpreterProxy bytesPerOop = 4
- ifTrue:
- [^4]
- ifFalse:
- [csi > -4294967296 ifTrue:
- [^4].
- csi > -1099511627776 ifTrue:
- [^5].
- csi > -281474976710656 ifTrue:
- [^6].
- csi > -72057594037927936 ifTrue:
- [^7].
- ^8]!
Item was changed:
----- Method: LargeIntegersPlugin>>cDigitLshift:from:len:to:len: (in category 'C core') -----
cDigitLshift: shiftCount from: pFrom len: lenFrom to: pTo len: lenTo
"C indexed!!"
| digitShift bitShift carry limit digit rshift |
+ <var: #pTo type: #'unsigned int *'>
+ <var: #pFrom type: #'unsigned int *'>
- <var: #pTo type: #'unsigned char *'>
- <var: #pFrom type: #'unsigned char *'>
<var: #carry type: #'unsigned int'>
<var: #digit type: #'unsigned int'>
+ digitShift := shiftCount // 32.
+ bitShift := shiftCount \\ 32.
- digitShift := shiftCount // 8.
- bitShift := shiftCount \\ 8.
limit := digitShift - 1.
+ "Note: 0 is endian neutral, use direct access"
0 to: limit do: [:i | pTo at: i put: 0].
bitShift = 0 ifTrue: ["Fast version for digit-aligned shifts"
"C indexed!!"
^ self
cDigitReplace: pTo
from: digitShift
to: lenTo - 1
with: pFrom
startingAt: 0].
+ "This implementation use at most 31 bits of carry.
+ bitAnd: 16rFFFFFFFF is only for simulator, useless in C"
+ rshift := 32 - bitShift.
- "This implementation use at most 15 bits of carry.
- bitAnd: 16rFF is only for simulator, useless in C"
- rshift := 8 - bitShift.
carry := 0.
limit := lenFrom - 1.
0 to: limit do:
[:i |
+ digit := self cDigitOf: pFrom at: i.
+ self cDigitOf: pTo at: i + digitShift put: ((carry bitOr: digit << bitShift) bitAnd: 16rFFFFFFFF).
- digit := pFrom at: i.
- pTo at: i + digitShift put: ((carry bitOr: digit << bitShift) bitAnd: 16rFF).
carry := digit >> rshift].
+ carry = 0 ifFalse: [self cDigitOf: pTo at: lenTo - 1 put: carry].
+ ^0!
- carry = 0 ifFalse: [pTo at: lenTo - 1 put: carry].
- ^0
- !
Item was changed:
----- Method: LargeIntegersPlugin>>cDigitMontgomery:len:times:len:modulo:len:mInvModB:into: (in category 'C core') -----
+ cDigitMontgomery: pFirst
- cDigitMontgomery: pBytesFirst
len: firstLen
+ times: pSecond
- times: pBytesSecond
len: secondLen
+ modulo: pThird
- modulo: pBytesThird
len: thirdLen
mInvModB: mInv
+ into: pRes
- into: pBytesRes
+ | u limit1 limit2 limit3 accum accum2 accum3 lastDigit |
+ <var: #pFirst type: #'unsigned int *'>
+ <var: #pSecond type: #'unsigned int *'>
+ <var: #pThird type: #'unsigned int *'>
+ <var: #mInv type: #'unsigned int'>
+ <var: #pRes type: #'unsigned int *'>
+ <var: #accum type: #'unsigned long long'>
+ <var: #accum2 type: #'unsigned long long'>
+ <var: #accum3 type: #'unsigned long long'>
+ <var: #u type: #'unsigned long long '>
+ <var: #lastDigit type: #'unsigned int '>
- | u limit1 limit2 limit3 accum lastByte |
- <var: #pBytesFirst type: #'unsigned char *'>
- <var: #pBytesSecond type: #'unsigned char *'>
- <var: #pBytesThird type: #'unsigned char *'>
- <var: #pBytesRes type: #'unsigned char *'>
- <var: #accum type: #'unsigned int'>
- <var: #u type: #'unsigned char'>
- <var: #lastByte type: #'unsigned char'>
limit1 := firstLen - 1.
limit2 := secondLen - 1.
limit3 := thirdLen - 1.
+ lastDigit := 0.
- lastByte := 0.
0 to: limit1 do:
[:i |
+ accum3 := self cDigitOf: pFirst at: i.
+ accum3 := accum3*(self cDigitOf: pSecond at: 0) + (self cDigitOf: pRes at: 0).
+ u := accum3 * mInv bitAnd: 16rFFFFFFFF.
+ accum2 := u * (self cDigitOf: pThird at: 0).
+ accum := (accum2 bitAnd: 16rFFFFFFFF) + (accum3 bitAnd: 16rFFFFFFFF).
+ accum := (accum >> 32) + (accum2 >> 32) + (accum3 >> 32).
- accum := (pBytesRes at: 0) + ((pBytesFirst at: i)*(pBytesSecond at: 0)).
- u := accum * mInv bitAnd: 255.
- accum := accum + (u * (pBytesThird at: 0)).
1 to: limit2 do: [:k |
+ accum3 := self cDigitOf: pFirst at: i.
+ accum3 := accum3*(self cDigitOf: pSecond at: k) + (self cDigitOf: pRes at: k).
+ accum2 := u * (self cDigitOf: pThird at: k).
+ accum := accum + (accum2 bitAnd: 16rFFFFFFFF) + (accum3 bitAnd: 16rFFFFFFFF).
+ self cDigitOf: pRes at: k-1 put: (accum bitAnd: 16rFFFFFFFF).
+ accum := (accum >> 32) + (accum2 >> 32) + (accum3 >> 32)].
- accum := (accum >> 8) + (pBytesRes at: k) + ((pBytesFirst at: i)*(pBytesSecond at: k)) + (u * (pBytesThird at: k)).
- pBytesRes at: k-1 put: (accum bitAnd: 255)].
secondLen to: limit3 do: [:k |
+ accum2 := u * (self cDigitOf: pThird at: k).
+ accum := accum + (self cDigitOf: pRes at: k) + (accum2 bitAnd: 16rFFFFFFFF).
+ self cDigitOf: pRes at: k-1 put: (accum bitAnd: 16rFFFFFFFF).
+ accum := (accum >> 32) + (accum2 >> 32)].
+ accum := accum + lastDigit.
+ self cDigitOf: pRes at: limit3 put: (accum bitAnd: 16rFFFFFFFF).
+ lastDigit := accum >> 32].
- accum := (accum >> 8) + (pBytesRes at: k) + (u * (pBytesThird at: k)).
- pBytesRes at: k-1 put: (accum bitAnd: 255)].
- accum := (accum >> 8) + lastByte.
- pBytesRes at: limit3 put: (accum bitAnd: 255).
- lastByte := accum >> 8].
firstLen to: limit3 do:
[:i |
+ accum := (self cDigitOf: pRes at: 0).
+ u := accum * mInv bitAnd: 16rFFFFFFFF.
+ accum := accum + (u * (self cDigitOf: pThird at: 0)).
+ accum := accum >> 32.
- accum := (pBytesRes at: 0).
- u := accum * mInv bitAnd: 255.
- accum := accum + (u * (pBytesThird at: 0)).
1 to: limit3 do: [:k |
+ accum2 := u * (self cDigitOf: pThird at: k).
+ accum := accum + (self cDigitOf: pRes at: k) + (accum2 bitAnd: 16rFFFFFFFF).
+ self cDigitOf: pRes at: k-1 put: (accum bitAnd: 16rFFFFFFFF).
+ accum := (accum >> 32) + (accum2 >> 32)].
+ accum := accum + lastDigit.
+ self cDigitOf: pRes at: limit3 put: (accum bitAnd: 16rFFFFFFFF).
+ lastDigit := accum >> 32].
+ (lastDigit = 0 and: [(self cDigitCompare: pThird with: pRes len: thirdLen) = 1]) ifFalse: [
+ "self cDigitSub: pThird len: thirdLen with: pRes len: thirdLen into: pRes"
- accum := (accum >> 8) + (pBytesRes at: k) + (u * (pBytesThird at: k)).
- pBytesRes at: k-1 put: (accum bitAnd: 255)].
- accum := (accum >> 8) + lastByte.
- pBytesRes at: limit3 put: (accum bitAnd: 255).
- lastByte := accum >> 8].
- (lastByte = 0 and: [(self cDigitCompare: pBytesThird with: pBytesRes len: thirdLen) = 1]) ifFalse: [
- "self cDigitSub: pBytesThird len: thirdLen with: pBytesRes len: thirdLen into: pBytesRes"
accum := 0.
0 to: limit3 do:
[:i |
+ accum := accum + (self cDigitOf: pRes at: i) - (self cDigitOf: pThird at: i).
+ self cDigitOf: pRes at: i put: (accum bitAnd: 16rFFFFFFFF).
+ accum := 0 - (accum >> 63)]].
+ ^0!
- accum := accum + (pBytesRes at: i) - (pBytesThird at: i).
- pBytesRes at: i put: (self cCode: [accum] inSmalltalk: [accum bitAnd: 255]).
- accum := accum signedBitShift: -8]].!
Item was removed:
- ----- Method: LargeIntegersPlugin>>cDigitMultiply:len:with:len:into: (in category 'C core') -----
- cDigitMultiply: pByteShort len: shortLen with: pByteLong len: longLen into: pByteRes
- | limitLong digit k carry limitShort ab |
- <returnTypeC: #'unsigned char'>
- <var: #pByteShort type: #'unsigned char *'>
- <var: #pByteLong type: #'unsigned char *'>
- <var: #pByteRes type: #'unsigned char *'>
- <var: #digit type: #'unsigned int'>
- <var: #carry type: #'unsigned int'>
- <var: #ab type: #'unsigned int'>
- (shortLen = 1 and: [(pByteShort at: 0)
- = 0])
- ifTrue: [^ 0].
- (longLen = 1 and: [(pByteLong at: 0)
- = 0])
- ifTrue: [^ 0].
- "prod starts out all zero"
- limitShort := shortLen - 1.
- limitLong := longLen - 1.
- 0 to: limitShort do: [:i | (digit := pByteShort at: i) ~= 0
- ifTrue:
- [k := i.
- carry := 0.
- "Loop invariant: 0<=carry<=0377, k=i+j-1 (ST)"
- "-> Loop invariant: 0<=carry<=0377, k=i+j (C) (?)"
- 0 to: limitLong do:
- [:j |
- ab := (pByteLong at: j).
- ab := ab * digit + carry + (pByteRes at: k).
- carry := ab >> 8.
- pByteRes at: k put: (ab bitAnd: 16rFF).
- k := k + 1].
- pByteRes at: k put: carry]].
- ^ 0!
Item was added:
+ ----- Method: LargeIntegersPlugin>>cDigitMultiply:len:with:len:into:len: (in category 'C core') -----
+ cDigitMultiply: pWordShort len: shortLen with: pWordLong len: longLen into: pWordRes len: resLen
+ | limitLong digit k carry limitShort ab |
+ <returnTypeC: #'unsigned int'>
+ <var: #pWordShort type: #'unsigned int *'>
+ <var: #pWordLong type: #'unsigned int *'>
+ <var: #pWordRes type: #'unsigned int *'>
+ <var: #digit type: #'unsigned int'>
+ <var: #carry type: #'unsigned int'>
+ <var: #ab type: #'unsigned long long'>
+ (shortLen = 1 and: [(pWordShort at: 0) = 0])
+ ifTrue: [^ 0].
+ (longLen = 1 and: [(pWordLong at: 0) = 0])
+ ifTrue: [^ 0].
+ "prod starts out all zero"
+ limitShort := shortLen - 1.
+ limitLong := longLen - 1.
+ 0 to: limitShort do: [:i | (digit := self cDigitOf: pWordShort at: i) ~= 0
+ ifTrue:
+ [k := i.
+ carry := 0.
+ "Loop invariant: 0<=carry<=16rFFFFFFFF, k=i+j-1 (ST)"
+ "-> Loop invariant: 0<=carry<=16rFFFFFFFF, k=i+j (C) (?)"
+ 0 to: limitLong do:
+ [:j |
+ ab := (self cDigitOf: pWordLong at: j).
+ ab := ab * digit + carry + (self cDigitOf: pWordRes at: k).
+ carry := ab >> 32.
+ self cDigitOf: pWordRes at: k put: (ab bitAnd: 16rFFFFFFFF).
+ k := k + 1].
+ k < resLen ifTrue: [self cDigitOf: pWordRes at: k put: carry]]].
+ ^ 0!
Item was added:
+ ----- Method: LargeIntegersPlugin>>cDigitOf:at: (in category 'C core util') -----
+ cDigitOf: cPointer at: zeroBasedDigitIndex
+ <inline: true>
+ <returnTypeC: #'unsigned int'>
+ <var: 'cPointer' type: #'unsigned int *'>
+ ^self byteSwapped32IfBigEndian: (cPointer at: zeroBasedDigitIndex)!
Item was added:
+ ----- Method: LargeIntegersPlugin>>cDigitOf:at:put: (in category 'C core util') -----
+ cDigitOf: cPointer at: zeroBasedDigitIndex put: aValue
+ <inline: true>
+ <returnTypeC: #'unsigned int'>
+ <var: 'cPointer' type: #'unsigned int *'>
+ <var: 'aValue' type: #'unsigned int'>
+ ^cPointer at: zeroBasedDigitIndex put: (self byteSwapped32IfBigEndian: aValue)!
Item was removed:
- ----- Method: LargeIntegersPlugin>>cDigitOfCSI:at: (in category 'C core util') -----
- cDigitOfCSI: csi at: ix
- "Answer the value of an indexable field in the receiver.
- LargePositiveInteger uses bytes of base two number, and each is a
- 'digit' base 256."
- "ST indexed!!"
- ^self
- cCode: [(csi < 0
- ifTrue: [0 - csi]
- ifFalse: [csi]) >> (ix - 1 * 8) bitAnd: 255]
- inSmalltalk: [csi digitAt: ix]!
Item was changed:
----- Method: LargeIntegersPlugin>>cDigitOp:short:len:long:len:into: (in category 'C core') -----
+ cDigitOp: opIndex short: pWordShort len: shortLen long: pWordLong len: longLen into: pWordRes
+ "pWordRes len = longLen.
+ NOTE: we don't bother with endianness here, those bit opes are endian-neutral"
- cDigitOp: opIndex short: pByteShort len: shortLen long: pByteLong len: longLen into: pByteRes
- "pByteRes len = longLen."
| limit |
+ <var: #pWordShort type: #'unsigned int *'>
+ <var: #pWordLong type: #'unsigned int *'>
+ <var: #pWordRes type: #'unsigned int *'>
- <var: #pByteShort type: #'unsigned char *'>
- <var: #pByteLong type: #'unsigned char *'>
- <var: #pByteRes type: #'unsigned char *'>
limit := shortLen - 1.
opIndex = andOpIndex
ifTrue:
+ [0 to: limit do: [:i | pWordRes at: i put: ((pWordShort at: i)
+ bitAnd: (pWordLong at: i))].
- [0 to: limit do: [:i | pByteRes at: i put: ((pByteShort at: i)
- bitAnd: (pByteLong at: i))].
limit := longLen - 1.
+ shortLen to: limit do: [:i | pWordRes at: i put: 0].
- shortLen to: limit do: [:i | pByteRes at: i put: 0].
^ 0].
opIndex = orOpIndex
ifTrue:
+ [0 to: limit do: [:i | pWordRes at: i put: ((pWordShort at: i)
+ bitOr: (pWordLong at: i))].
- [0 to: limit do: [:i | pByteRes at: i put: ((pByteShort at: i)
- bitOr: (pByteLong at: i))].
limit := longLen - 1.
+ shortLen to: limit do: [:i | pWordRes at: i put: (pWordLong at: i)].
- shortLen to: limit do: [:i | pByteRes at: i put: (pByteLong at: i)].
^ 0].
opIndex = xorOpIndex
ifTrue:
+ [0 to: limit do: [:i | pWordRes at: i put: ((pWordShort at: i)
+ bitXor: (pWordLong at: i))].
- [0 to: limit do: [:i | pByteRes at: i put: ((pByteShort at: i)
- bitXor: (pByteLong at: i))].
limit := longLen - 1.
+ shortLen to: limit do: [:i | pWordRes at: i put: (pWordLong at: i)].
- shortLen to: limit do: [:i | pByteRes at: i put: (pByteLong at: i)].
^ 0].
^ interpreterProxy primitiveFail!
Item was changed:
----- Method: LargeIntegersPlugin>>cDigitReplace:from:to:with:startingAt: (in category 'C core util') -----
cDigitReplace: pTo from: start to: stop with: pFrom startingAt: repStart
"C indexed!!"
+ <var: #pTo type: #'unsigned int *'>
+ <var: #pFrom type: #'unsigned int *'>
- <returnTypeC: #'int'>
- <var: #pTo type: #'unsigned char *'>
- <var: #pFrom type: #'unsigned char *'>
^ self
cDigitCopyFrom: pFrom + repStart
to: pTo + start
len: stop - start + 1!
Item was changed:
----- Method: LargeIntegersPlugin>>cDigitRshift:from:len:to:len: (in category 'C core') -----
+ cDigitRshift: shiftCount from: pFrom len: lenFrom to: pTo len: lenTo
+ | carry digit digitShift bitShift leftShift limit start |
+ <var: #pTo type: #'unsigned int *'>
+ <var: #pFrom type: #'unsigned int *'>
- cDigitRshift: shiftCount from: pFrom len: fromLen to: pTo len: toLen
- | digit bitShift carry digitShift leftShift limit start |
- <var: #pTo type: #'unsigned char *'>
- <var: #pFrom type: #'unsigned char *'>
<var: #carry type: #'unsigned int'>
<var: #digit type: #'unsigned int'>
+ digitShift := shiftCount // 32.
+ bitShift := shiftCount \\ 32.
+ bitShift = 0 ifTrue: ["Fast version for digit-aligned shifts"
- digitShift := shiftCount // 8.
- bitShift := shiftCount \\ 8.
- bitShift = 0 ifTrue: ["Fast version for byte-aligned shifts"
"C indexed!!"
^self
cDigitReplace: pTo
from: 0
+ to: lenTo - 1
- to: toLen - 1
with: pFrom
startingAt: digitShift].
+ "This implementation use at most 31 bits of carry.
+ bitAnd: 16rFFFFFFFF is only for simulator, useless in C"
+ leftShift := 32 - bitShift.
+ carry := (self cDigitOf: pFrom at: digitShift) >> bitShift.
- "This implementation use at most 16 bits of x"
- leftShift := 8 - bitShift.
- carry := (pFrom at: digitShift) >> bitShift.
start := digitShift + 1.
+ limit := lenFrom - 1.
- limit := fromLen - 1.
start to: limit do:
[:j |
+ digit := self cDigitOf: pFrom at: j.
+ self cDigitOf: pTo at: j - start put: ((carry bitOr: digit << leftShift) bitAnd: 16rFFFFFFFF).
- digit := pFrom at: j.
- pTo at: j - start put: ((carry bitOr: digit << leftShift) bitAnd: 16rFF).
carry := digit >> bitShift].
+ carry = 0 ifFalse: [self cDigitOf: pTo at: lenTo - 1 put: carry].
- carry = 0 ifFalse: [pTo at: toLen - 1 put: carry].
^0!
Item was changed:
----- Method: LargeIntegersPlugin>>cDigitSub:len:with:len:into: (in category 'C core') -----
+ cDigitSub: pWordSmall
+ len: smallLen
+ with: pWordLarge
+ len: largeLen
+ into: pWordRes
- cDigitSub: pByteSmall len: smallLen with: pByteLarge len: largeLen into: pByteRes
| z |
+ <var: #pWordSmall type: #'unsigned int *'>
+ <var: #pWordLarge type: #'unsigned int *'>
+ <var: #pWordRes type: #'unsigned int *'>
+ <var: #z type: #'unsigned long long'>
- <var: #pByteSmall type: #'unsigned char *'>
- <var: #pByteLarge type: #'unsigned char *'>
- <var: #pByteRes type: #'unsigned char *'>
- <var: #z type: #'unsigned int'>
+ z := 0.
- z := 0. "Loop invariant is -1<=z<=1"
0 to: smallLen - 1 do:
[:i |
+ z := z + (self cDigitOf: pWordLarge at: i) - (self cDigitOf: pWordSmall at: i).
+ self cDigitOf: pWordRes at: i put: (z bitAnd: 16rFFFFFFFF).
+ z := 0 - (z >> 63)].
- z := z + (pByteLarge at: i) - (pByteSmall at: i).
- pByteRes at: i put: (self cCode: [z] inSmalltalk: [z bitAnd: 255]).
- z := z signedBitShift: -8].
smallLen to: largeLen - 1 do:
[:i |
+ z := z + (self cDigitOf: pWordLarge at: i) .
+ self cDigitOf: pWordRes at: i put: (z bitAnd: 16rFFFFFFFF).
+ z := 0 - (z >> 63)].
+ ^0!
- z := z + (pByteLarge at: i) .
- pByteRes at: i put: (self cCode: [z] inSmalltalk: [z bitAnd: 255]).
- z := z signedBitShift: -8].
- !
Item was added:
+ ----- Method: LargeIntegersPlugin>>cHighBit32: (in category 'C core util') -----
+ cHighBit32: anUnsignedInt32
+ "Answer the index of the high order bit of the argument, or zero if the
+ argument is zero."
+ | shifted bitNo |
+
+ <var: #anUnsignedInt32 type: #'unsigned int'>
+ <var: #shifted type: #'unsigned int'>
+ shifted := anUnsignedInt32.
+ bitNo := 0.
+ shifted < (1 << 16)
+ ifFalse: [shifted := shifted >> 16.
+ bitNo := bitNo + 16].
+ shifted < (1 << 8)
+ ifFalse: [shifted := shifted >> 8.
+ bitNo := bitNo + 8].
+ shifted < (1 << 4)
+ ifFalse: [shifted := shifted >> 4.
+ bitNo := bitNo + 4].
+ shifted < (1 << 2)
+ ifFalse: [shifted := shifted >> 2.
+ bitNo := bitNo + 2].
+ shifted < (1 << 1)
+ ifFalse: [shifted := shifted >> 1.
+ bitNo := bitNo + 1].
+ "shifted 0 or 1 now"
+ ^ bitNo + shifted!
Item was removed:
- ----- Method: LargeIntegersPlugin>>cHighBit: (in category 'C core util') -----
- cHighBit: uint
- "Answer the index of the high order bit of the argument, or zero if the
- argument is zero."
- "For 64 bit uints there could be added a 32-shift."
- | shifted bitNo |
- <var: #uint type: #'unsigned int'>
- <var: #shifted type: #'unsigned int'>
- shifted := uint.
- bitNo := 0.
- shifted < (1 << 16)
- ifFalse: [shifted := shifted bitShift: -16.
- bitNo := bitNo + 16].
- shifted < (1 << 8)
- ifFalse: [shifted := shifted bitShift: -8.
- bitNo := bitNo + 8].
- shifted < (1 << 4)
- ifFalse: [shifted := shifted bitShift: -4.
- bitNo := bitNo + 4].
- shifted < (1 << 2)
- ifFalse: [shifted := shifted bitShift: -2.
- bitNo := bitNo + 2].
- shifted < (1 << 1)
- ifFalse: [shifted := shifted bitShift: -1.
- bitNo := bitNo + 1].
- "shifted 0 or 1 now"
- ^ bitNo + shifted!
Item was changed:
----- Method: LargeIntegersPlugin>>createLargeFromSmallInteger: (in category 'oop util') -----
createLargeFromSmallInteger: anOop
"anOop has to be a SmallInteger!!"
+ | val res pDigit byteSize digitSize |
+ <var: #pDigit type: #'unsigned int *'>
- | val class size res pByte byte |
- <var: #pByte type: #'unsigned char *'>
val := interpreterProxy integerValueOf: anOop.
+ byteSize := self byteSizeOfCSI: val.
+ res := self createLargeIntegerNeg: val < 0 byteLength: byteSize.
+ pDigit := interpreterProxy firstIndexableField: res.
+ digitSize := byteSize + 3 // 4.
+ 1 to: digitSize do: [:ix | self cDigitOf: pDigit at: ix - 1 put: (self digitOfCSI: val at: ix)].
+ ^ res!
- val < 0
- ifTrue: [class := interpreterProxy classLargeNegativeInteger]
- ifFalse: [class := interpreterProxy classLargePositiveInteger].
- size := self cDigitLengthOfCSI: val.
- res := interpreterProxy instantiateClass: class indexableSize: size.
- pByte := interpreterProxy firstIndexableField: res.
- 1 to: size do: [:ix |
- byte := self cDigitOfCSI: val at: ix.
- pByte at: ix - 1 put: byte].
- ^res!
Item was added:
+ ----- Method: LargeIntegersPlugin>>createLargeIntegerNeg:byteLength: (in category 'util') -----
+ createLargeIntegerNeg: neg byteLength: byteLength
+ <inline: true>
+ ^interpreterProxy
+ instantiateClass: (neg
+ ifTrue: [interpreterProxy classLargeNegativeInteger]
+ ifFalse: [interpreterProxy classLargePositiveInteger])
+ indexableSize: byteLength!
Item was added:
+ ----- Method: LargeIntegersPlugin>>createLargeIntegerNeg:digitLength: (in category 'util') -----
+ createLargeIntegerNeg: neg digitLength: digitLength
+ <inline: true>
+ ^self
+ createLargeIntegerNeg: neg byteLength: digitLength * 4!
Item was changed:
----- Method: LargeIntegersPlugin>>digit:Lshift: (in category 'oop functions') -----
+ digit: anOop Lshift: shiftCount
+ "Attention: this method invalidates all oop's!! Only newOop is valid at return."
- digit: aBytesOop Lshift: shiftCount
- "Attention: this method invalidates all oop's!! Only newBytes is valid at return."
"Does not normalize."
+ | newOop highBit newDigitLen newByteLen oldDigitLen |
+ oldDigitLen := self digitSizeOfLargeInt: anOop.
+ (highBit := self cDigitHighBit: (interpreterProxy firstIndexableField: anOop)
+ len: oldDigitLen) = 0 ifTrue: [^ interpreterProxy instantiateClass: (interpreterProxy fetchClassOf: anOop) indexableSize: 1].
+ newByteLen := highBit + shiftCount + 7 // 8.
+ self remapOop: anOop in: [newOop := interpreterProxy instantiateClass: (interpreterProxy fetchClassOf: anOop)
+ indexableSize: newByteLen].
+ newDigitLen := newByteLen + 3 // 4.
- | newBytes highBit newLen oldLen |
- oldLen := self digitSizeOfLargeInt: aBytesOop.
- (highBit := self cDigitHighBit: (interpreterProxy firstIndexableField: aBytesOop)
- len: oldLen) = 0 ifTrue: [^ 0 asOop: SmallInteger].
- newLen := highBit + shiftCount + 7 // 8.
- self remapOop: aBytesOop in: [newBytes := interpreterProxy instantiateClass: (interpreterProxy fetchClassOf: aBytesOop)
- indexableSize: newLen].
self
cDigitLshift: shiftCount
+ from: (interpreterProxy firstIndexableField: anOop)
+ len: oldDigitLen
+ to: (interpreterProxy firstIndexableField: newOop)
+ len: newDigitLen.
+ ^ newOop!
- from: (interpreterProxy firstIndexableField: aBytesOop)
- len: oldLen
- to: (interpreterProxy firstIndexableField: newBytes)
- len: newLen.
- ^ newBytes!
Item was changed:
----- Method: LargeIntegersPlugin>>digit:Rshift:lookfirst: (in category 'oop functions') -----
+ digit: anOop Rshift: shiftCount lookfirst: a
- digit: aBytesOop Rshift: shiftCount lookfirst: a
"Attention: this method invalidates all oop's!! Only newBytes is valid at return."
+ "Shift right 32*digitShift+bitShift bits, 0<=bitShift<32.
- "Shift right shiftCount bits, 0<=shiftCount.
Discard all digits beyond a, and all zeroes at or below a."
"Does not normalize."
+ | newByteLen newOop oldBitLen newBitLen oldDigitLen newDigitLen |
+ oldBitLen := self cDigitHighBit: (interpreterProxy firstIndexableField: anOop) len: a.
+ oldDigitLen := oldBitLen + 31 // 32.
- | newByteLen newOop oldBitLen newBitLen oldDigitLen |
- oldBitLen := self cDigitHighBit: (interpreterProxy firstIndexableField: aBytesOop) len: a.
- oldDigitLen := oldBitLen + 7 // 8.
newBitLen := oldBitLen - shiftCount.
newBitLen <= 0 ifTrue: ["All bits lost"
^ interpreterProxy
+ instantiateClass: (interpreterProxy fetchClassOf: anOop)
- instantiateClass: (interpreterProxy fetchClassOf: aBytesOop)
indexableSize: 0].
newByteLen := newBitLen + 7 // 8.
+ newDigitLen := newByteLen + 3 // 4.
+ self remapOop: anOop in: [newOop := interpreterProxy instantiateClass: (interpreterProxy fetchClassOf: anOop)
- self remapOop: aBytesOop in: [newOop := interpreterProxy instantiateClass: (interpreterProxy fetchClassOf: aBytesOop)
indexableSize: newByteLen].
self
cDigitRshift: shiftCount
+ from: (interpreterProxy firstIndexableField: anOop)
- from: (interpreterProxy firstIndexableField: aBytesOop)
len: oldDigitLen
to: (interpreterProxy firstIndexableField: newOop)
+ len: newDigitLen.
- len: newByteLen.
^ newOop!
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 fetchClassOf: firstInteger)
+ = interpreterProxy classLargeNegativeInteger.
+ firstDigitLen <= secondDigitLen
- | over firstLen secondLen shortInt shortLen longInt longLen sum newSum resClass |
- <var: #over type: #'unsigned char'>
- firstLen := self digitSizeOfLargeInt: firstInteger.
- secondLen := self digitSizeOfLargeInt: secondInteger.
- resClass := interpreterProxy fetchClassOf: firstInteger.
- firstLen <= secondLen
ifTrue:
[shortInt := firstInteger.
+ shortDigitLen := firstDigitLen.
- shortLen := firstLen.
longInt := secondInteger.
+ longDigitLen := secondDigitLen]
- longLen := secondLen]
ifFalse:
[shortInt := secondInteger.
+ shortDigitLen := secondDigitLen.
- shortLen := secondLen.
longInt := firstInteger.
+ longDigitLen := firstDigitLen].
- longLen := firstLen].
" sum := Integer new: len neg: firstInteger negative."
+ self remapOop: #(shortInt longInt ) in: [sum := self createLargeIntegerNeg: neg digitLength: longDigitLen].
- self remapOop: #(shortInt longInt ) in: [sum := interpreterProxy instantiateClass: resClass indexableSize: longLen].
over := self
cDigitAdd: (interpreterProxy firstIndexableField: shortInt)
+ len: shortDigitLen
- len: shortLen
with: (interpreterProxy firstIndexableField: longInt)
+ len: longDigitLen
- len: longLen
into: (interpreterProxy firstIndexableField: sum).
over > 0
ifTrue:
["sum := sum growby: 1."
+ self remapOop: sum in: [newSum := self createLargeIntegerNeg: neg byteLength: longDigitLen * 4 + 1].
- self remapOop: sum in: [newSum := interpreterProxy instantiateClass: resClass indexableSize: longLen + 1].
self
cDigitCopyFrom: (interpreterProxy firstIndexableField: sum)
to: (interpreterProxy firstIndexableField: newSum)
+ len: longDigitLen.
- len: longLen.
sum := newSum.
"C index!!"
+ self cDigitOf: (self cCoerce: (interpreterProxy firstIndexableField: sum) to: 'unsigned int *')
+ at: longDigitLen put: over]
+ ifFalse:
+ [sum := neg
+ ifTrue: [self normalizeNegative: sum]
+ ifFalse: [self normalizePositive: sum]].
- (self cCoerce: (interpreterProxy firstIndexableField: sum)
- to: 'unsigned char *')
- at: longLen put: over].
^ 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 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 fetchClassOf: secondInteger)
= interpreterProxy classLargeNegativeInteger ifTrue: [^ interpreterProxy primitiveFail].
secondLarge := secondInteger].
+ firstLen := self byteSizeOfLargeInt: firstLarge.
+ secondLen := self byteSizeOfLargeInt: secondLarge.
- firstLen := self digitSizeOfLargeInt: firstLarge.
- secondLen := self digitSizeOfLargeInt: 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: (interpreterProxy firstIndexableField: shortLarge)
+ len: shortLen + 3 // 4
- len: shortLen
long: (interpreterProxy firstIndexableField: longLarge)
+ len: longLen + 3 // 4
- len: longLen
into: (interpreterProxy firstIndexableField: result).
interpreterProxy failed ifTrue: [^ 0].
^ self normalizePositive: result!
Item was changed:
----- Method: LargeIntegersPlugin>>digitCompareLarge:with: (in category 'oop functions') -----
digitCompareLarge: firstInteger with: secondInteger
"Compare the magnitude of firstInteger with that of secondInteger.
Return a code of 1, 0, -1 for firstInteger >, = , < secondInteger"
+ | firstDigitLen secondDigitLen |
+ firstDigitLen := self digitSizeOfLargeInt: firstInteger.
+ secondDigitLen := self digitSizeOfLargeInt: secondInteger.
+ secondDigitLen ~= firstDigitLen
+ ifTrue: [secondDigitLen > firstDigitLen
- | firstLen secondLen |
- firstLen := self digitSizeOfLargeInt: firstInteger.
- secondLen := self digitSizeOfLargeInt: secondInteger.
- secondLen ~= firstLen
- ifTrue: [secondLen > firstLen
ifTrue: [^ -1 asOop: SmallInteger]
ifFalse: [^ 1 asOop: SmallInteger]].
^ (self
cDigitCompare: (interpreterProxy firstIndexableField: firstInteger)
with: (interpreterProxy firstIndexableField: secondInteger)
+ len: firstDigitLen)
- len: firstLen)
asOop: SmallInteger!
Item was changed:
----- Method: LargeIntegersPlugin>>digitDivLarge:with:negative: (in category 'oop functions') -----
digitDivLarge: firstInteger with: secondInteger negative: neg
"Does not normalize."
"Division by zero has to be checked in caller."
+ | firstDigitLen secondDigitLen quoDigitLen d div rem quo result |
+ firstDigitLen := self digitSizeOfLargeInt: firstInteger.
+ secondDigitLen := self digitSizeOfLargeInt: secondInteger.
+ quoDigitLen := firstDigitLen - secondDigitLen + 1.
+ quoDigitLen <= 0
- | firstLen secondLen resultClass l d div rem quo result |
- firstLen := self digitSizeOfLargeInt: firstInteger.
- secondLen := self digitSizeOfLargeInt: secondInteger.
- neg
- ifTrue: [resultClass := interpreterProxy classLargeNegativeInteger]
- ifFalse: [resultClass := interpreterProxy classLargePositiveInteger].
- l := firstLen - secondLen + 1.
- l <= 0
ifTrue:
[self remapOop: firstInteger in: [result := interpreterProxy instantiateClass: interpreterProxy classArray indexableSize: 2].
result stAt: 1 put: (0 asOop: SmallInteger).
result stAt: 2 put: firstInteger.
^ result].
"set rem and div to copies of firstInteger and secondInteger, respectively.
However,
to facilitate use of Knuth's algorithm, multiply rem and div by 2 (that
is, shift)
+ until the high word of div is >=16r80000000"
+ d := 32 - (self cHighBit32: (self unsafeDigitOfLargeInt: secondInteger at: secondDigitLen)).
- until the high byte of div is >=128"
- d := 8 - (self cHighBit: (self unsafeDigitOf: secondInteger at: secondLen)).
self remapOop: firstInteger
in:
[div := self digit: secondInteger Lshift: d.
+ div := self largeInt: div growTo: (self digitSizeOfLargeInt: div) + 1 * 4].
- div := self largeIntOrInt: div growTo: (self digitLength: div)
- + 1].
self remapOop: div
in:
[rem := self digit: firstInteger Lshift: d.
+ (self digitSizeOfLargeInt: rem) = firstDigitLen
+ ifTrue: [rem := self largeInt: rem growTo: firstDigitLen + 1 * 4]].
+ self remapOop: #(div rem ) in: [quo := self createLargeIntegerNeg: neg digitLength: quoDigitLen].
- (self digitLength: rem)
- = firstLen ifTrue: [rem := self largeIntOrInt: rem growTo: firstLen + 1]].
- self remapOop: #(div rem ) in: [quo := interpreterProxy instantiateClass: resultClass indexableSize: l].
self
cDigitDiv: (interpreterProxy firstIndexableField: div)
+ len: (self digitSizeOfLargeInt: div)
- len: (self digitLength: div)
rem: (interpreterProxy firstIndexableField: rem)
+ len: (self digitSizeOfLargeInt: rem)
- len: (self digitLength: rem)
quo: (interpreterProxy firstIndexableField: quo)
+ len: (self digitSizeOfLargeInt: quo).
- len: (self digitLength: quo).
self remapOop: #(quo ) in: [rem := self
digit: rem
Rshift: d
+ lookfirst: (self digitSizeOfLargeInt: div)
- lookfirst: (self digitLength: div)
- 1].
"^ Array with: quo with: rem"
self remapOop: #(quo rem ) in: [result := interpreterProxy instantiateClass: interpreterProxy classArray indexableSize: 2].
result stAt: 1 put: quo.
result stAt: 2 put: rem.
^ result!
Item was removed:
- ----- Method: LargeIntegersPlugin>>digitLength: (in category 'util') -----
- digitLength: oop
- (interpreterProxy isIntegerObject: oop)
- ifTrue: [^ self cDigitLengthOfCSI: (interpreterProxy integerValueOf: oop)]
- ifFalse: [^ self digitSizeOfLargeInt: oop]!
Item was removed:
- ----- Method: LargeIntegersPlugin>>digitLengthOfNonImmediate: (in category 'util') -----
- digitLengthOfNonImmediate: oop
- <inline: true>
- ^self digitSizeOfLargeInt: oop!
Item was changed:
----- Method: LargeIntegersPlugin>>digitMontgomery:times:modulo:mInvModB: (in category 'oop functions') -----
digitMontgomery: firstLarge times: secondLarge modulo: thirdLarge mInvModB: mInv
+ <var: #mInv type: #'unsigned int'>
-
| firstLen secondLen thirdLen prod |
firstLen := self digitSizeOfLargeInt: firstLarge.
secondLen := self digitSizeOfLargeInt: secondLarge.
thirdLen := self digitSizeOfLargeInt: thirdLarge.
firstLen <= thirdLen ifFalse: [^interpreterProxy primitiveFail].
secondLen <= thirdLen ifFalse: [^interpreterProxy primitiveFail].
+ self remapOop: #(firstLarge secondLarge thirdLarge) in: [prod := interpreterProxy instantiateClass: interpreterProxy classLargePositiveInteger indexableSize: thirdLen * 4].
- (mInv >= 0 and: [mInv <= 255]) ifFalse: [^interpreterProxy primitiveFail].
- self remapOop: #(firstLarge secondLarge thirdLarge) in: [prod := interpreterProxy instantiateClass: interpreterProxy classLargePositiveInteger indexableSize: thirdLen].
self
cDigitMontgomery: (interpreterProxy firstIndexableField: firstLarge)
len: firstLen
times: (interpreterProxy firstIndexableField: secondLarge)
len: secondLen
modulo: (interpreterProxy firstIndexableField: thirdLarge)
len: thirdLen
mInvModB: mInv
into: (interpreterProxy firstIndexableField: prod).
^self normalizePositive: prod!
Item was changed:
----- Method: LargeIntegersPlugin>>digitMultiplyLarge:with:negative: (in category 'oop functions') -----
digitMultiplyLarge: firstInteger with: secondInteger negative: neg
"Normalizes."
+ | firstLen secondLen shortInt shortLen longInt longLen prod |
+ firstLen := self byteSizeOfLargeInt: firstInteger.
+ secondLen := self byteSizeOfLargeInt: secondInteger.
- | firstLen secondLen shortInt shortLen longInt longLen prod resultClass |
- firstLen := self digitSizeOfLargeInt: firstInteger.
- secondLen := self digitSizeOfLargeInt: secondInteger.
firstLen <= secondLen
ifTrue:
[shortInt := firstInteger.
shortLen := firstLen.
longInt := secondInteger.
longLen := secondLen]
ifFalse:
[shortInt := secondInteger.
shortLen := secondLen.
longInt := firstInteger.
longLen := firstLen].
+ self remapOop: #(shortInt longInt ) in: [prod := self createLargeIntegerNeg: neg byteLength: longLen + shortLen].
- neg
- ifTrue: [resultClass := interpreterProxy classLargeNegativeInteger]
- ifFalse: [resultClass := interpreterProxy classLargePositiveInteger].
- self remapOop: #(shortInt longInt ) in: [prod := interpreterProxy instantiateClass: resultClass indexableSize: longLen + shortLen].
self
cDigitMultiply: (interpreterProxy firstIndexableField: shortInt)
+ len: shortLen + 3 // 4
- len: shortLen
with: (interpreterProxy firstIndexableField: longInt)
+ len: longLen + 3 // 4
+ into: (interpreterProxy firstIndexableField: prod)
+ len: longLen + shortLen + 3 // 4.
+ ^neg
+ ifTrue: [self normalizeNegative: prod]
+ ifFalse: [self normalizePositive: prod]!
- len: longLen
- into: (interpreterProxy firstIndexableField: prod).
- ^ self normalize: prod!
Item was added:
+ ----- Method: LargeIntegersPlugin>>digitOfCSI:at: (in category 'util') -----
+ digitOfCSI: csi at: ix
+ "Answer the value of a 32 bits digit in a C-SmallInteger."
+ "ST indexed!!"
+ ^(csi < 0
+ ifTrue: [0 - csi]
+ ifFalse: [csi]) >> (ix - 1 * 32)!
Item was changed:
----- Method: LargeIntegersPlugin>>digitOfLargeInt:at: (in category 'util') -----
digitOfLargeInt: aBytesOop at: ix
"Argument has to be aLargeInteger!!"
ix > (self digitSizeOfLargeInt: aBytesOop)
ifTrue: [^ 0]
+ ifFalse: [^ self unsafeDigitOfLargeInt: aBytesOop at: ix]!
- ifFalse: [^ self unsafeDigitOf: aBytesOop at: ix]!
Item was added:
+ ----- Method: LargeIntegersPlugin>>digitSizeOfCSI: (in category 'util') -----
+ digitSizeOfCSI: csi
+ "Answer the number of 32-bits fields of a C-SmallInteger. This value is
+ the same as the largest legal subscript."
+ ^(interpreterProxy maxSmallInteger <= 16r3FFFFFFF)
+ ifTrue: [1]
+ ifFalse: [csi > 16rFFFFFFFF asLong "asLong is not really needed here, but avoid generating a warning in 32bits, and harmless in 64bits"
+ ifTrue: [2]
+ ifFalse: [csi < -16rFFFFFFFF
+ ifTrue: [2]
+ ifFalse: [1]]]!
Item was changed:
----- Method: LargeIntegersPlugin>>digitSizeOfLargeInt: (in category 'util') -----
+ digitSizeOfLargeInt: anOop
+ "answer number of 32 bits digits of a Large Integer"
+ <inline: true>
+ ^(self byteSizeOfLargeInt: anOop) + 3 // 4!
- digitSizeOfLargeInt: bytesOop
- "Precondition: bytesOop is not anInteger and a bytes object."
- ^ interpreterProxy slotSizeOf: bytesOop!
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 |
- | firstLen secondLen larger largerLen smaller smallerLen neg resLen res firstNeg |
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)]])
- firstLen := self digitSizeOfLargeInt: firstInteger.
- secondLen := self digitSizeOfLargeInt: secondInteger.
- firstLen = secondLen ifTrue:
- [[firstLen > 1
- and: [(self digitOfLargeInt: firstInteger at: firstLen) = (self digitOfLargeInt: secondInteger at: firstLen)]]
- whileTrue: [firstLen := firstLen - 1].
- secondLen := firstLen].
- (firstLen < secondLen
- or: [firstLen = secondLen
- and: [(self digitOfLargeInt: firstInteger at: firstLen) < (self digitOfLargeInt: secondInteger at: firstLen)]])
ifTrue:
[larger := secondInteger.
+ largeDigitLen := secondDigitLen.
- largerLen := secondLen.
smaller := firstInteger.
+ smallerDigitLen := firstDigitLen.
- smallerLen := firstLen.
neg := firstNeg == false]
ifFalse:
[larger := firstInteger.
+ largeDigitLen := firstDigitLen.
- largerLen := firstLen.
smaller := secondInteger.
+ smallerDigitLen := secondDigitLen.
- smallerLen := secondLen.
neg := firstNeg].
+ resDigitLen := largeDigitLen.
- resLen := largerLen.
self remapOop: #(smaller larger)
+ in: [res := self createLargeIntegerNeg: neg digitLength: resDigitLen].
- in: [res := interpreterProxy
- instantiateClass: (neg
- ifTrue: [interpreterProxy classLargeNegativeInteger]
- ifFalse: [interpreterProxy classLargePositiveInteger])
- indexableSize: resLen].
self
cDigitSub: (interpreterProxy firstIndexableField: smaller)
+ len: smallerDigitLen
- len: smallerLen
with: (interpreterProxy firstIndexableField: larger)
+ len: largeDigitLen
- len: largerLen
into: (interpreterProxy firstIndexableField: res).
^neg
ifTrue: [self normalizeNegative: res]
ifFalse: [self normalizePositive: res]!
Item was changed:
----- Method: LargeIntegersPlugin>>highBitOfLargeInt: (in category 'util') -----
+ highBitOfLargeInt: anOop
+ <inline: true>
+ ^ self
+ cDigitHighBit: (interpreterProxy firstIndexableField: anOop)
+ len: (self digitSizeOfLargeInt: anOop)!
- highBitOfLargeInt: aBytesOop
- ^ self cDigitHighBit: (interpreterProxy firstIndexableField: aBytesOop)
- len: (self digitSizeOfLargeInt: aBytesOop)!
Item was changed:
----- Method: LargeIntegersPlugin>>isNormalized: (in category 'oop functions') -----
isNormalized: anInteger
+ | len maxVal minVal sLen val class positive |
+ <var: #val type: #'unsigned long'>
+ <var: #minVal type: #'unsigned long'>
+ (interpreterProxy isIntegerObject: anInteger)
+ ifTrue: [^ true].
- | len class positive pointer |
- <var: #pointer type: #'unsigned char *'>
- (interpreterProxy isIntegerObject: anInteger) ifTrue:
- [^true].
class := interpreterProxy fetchClassOf: anInteger.
(positive := class = interpreterProxy classLargePositiveInteger) ifFalse:
[class = interpreterProxy classLargeNegativeInteger ifFalse:
[interpreterProxy primitiveFailFor: PrimErrBadArgument.
^false]].
- pointer := interpreterProxy cCoerce: (interpreterProxy firstIndexableField: anInteger) to: #'unsigned char *'.
"Check for leading zero of LargeInteger"
+ len := self byteSizeOfLargeInt: anInteger.
+ len = 0 ifTrue:
+ [^ false].
+ (self unsafeByteOfLargeInt: anInteger at: len) = 0 ifTrue:
+ [^ false].
- len := self digitLengthOfNonImmediate: anInteger.
- (len = 0 or: [(pointer at: len - 1) = 0]) ifTrue:
- [^false].
"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]!
- len ~= interpreterProxy bytesPerOop ifTrue:
- [^len > interpreterProxy bytesPerOop].
- positive ifTrue: "all bytes of but the highest one are just FF's"
- [^(pointer at: interpreterProxy bytesPerOop - 1)
- > (self cDigitOfCSI: interpreterProxy maxSmallInteger at: interpreterProxy bytesPerOop)].
- "all bytes of but the highest one are just 00's"
- (pointer at: interpreterProxy bytesPerOop - 1)
- < (self cDigitOfCSI: interpreterProxy minSmallInteger at: interpreterProxy bytesPerOop) ifTrue:
- [^false].
- "if just one digit differs, then anInteger < minval (the corresponding digit byte is greater!!)
- and therefore a LargeNegativeInteger"
- 0 to: interpreterProxy bytesPerOop - 1 do:
- [:ix |
- (pointer at: ix) = (self cDigitOfCSI: interpreterProxy minSmallInteger at: ix + 1) ifFalse:
- [^true]].
- ^false!
Item was changed:
----- Method: LargeIntegersPlugin>>largeInt:growTo: (in category 'oop util') -----
+ largeInt: aBytesObject growTo: newByteLen
- largeInt: aBytesObject growTo: newLen
"Attention: this method invalidates all oop's!! Only newBytes is valid at return."
"Does not normalize."
+ | newBytes oldDigitLen newDigitLen copyLen |
- | newBytes oldLen copyLen |
self remapOop: aBytesObject in: [newBytes := interpreterProxy instantiateClass: (interpreterProxy fetchClassOf: aBytesObject)
+ indexableSize: newByteLen].
+ newDigitLen := newByteLen + 3 // 4.
+ oldDigitLen := self digitSizeOfLargeInt: aBytesObject.
+ oldDigitLen < newDigitLen
+ ifTrue: [copyLen := oldDigitLen]
+ ifFalse: [copyLen := newDigitLen].
- indexableSize: newLen].
- oldLen := self digitSizeOfLargeInt: aBytesObject.
- oldLen < newLen
- ifTrue: [copyLen := oldLen]
- ifFalse: [copyLen := newLen].
self
cDigitCopyFrom: (interpreterProxy firstIndexableField: aBytesObject)
to: (interpreterProxy firstIndexableField: newBytes)
len: copyLen.
^ newBytes!
Item was removed:
- ----- Method: LargeIntegersPlugin>>largeIntOrInt:growTo: (in category 'oop util') -----
- largeIntOrInt: oop growTo: len
- "Attention: this method invalidates all oop's!! Only newBytes is valid at return."
- | newBytes val class |
- (interpreterProxy isIntegerObject: oop)
- ifTrue:
- [val := interpreterProxy integerValueOf: oop.
- val < 0
- ifTrue: [class := interpreterProxy classLargeNegativeInteger]
- ifFalse: [class := interpreterProxy classLargePositiveInteger].
- newBytes := interpreterProxy instantiateClass: class indexableSize: len.
- self cCopyIntVal: val toBytes: newBytes]
- ifFalse: [newBytes := self largeInt: oop growTo: len].
- ^ newBytes!
Item was changed:
----- Method: LargeIntegersPlugin>>normalizeNegative: (in category 'oop functions') -----
normalizeNegative: aLargeNegativeInteger
"Check for leading zeroes and return shortened copy if so."
"First establish len = significant length."
+ | val val2 sLen digitLen byteLen oldByteLen minVal |
+ <var: #val type: #'unsigned long'>
+ <var: #val2 type: #'unsigned long'>
+ <var: #minVal type: #'unsigned long'>
+ digitLen := self digitSizeOfLargeInt: aLargeNegativeInteger.
+ [digitLen ~= 0 and: [(self unsafeDigitOfLargeInt: aLargeNegativeInteger at: digitLen) = 0]]
+ whileTrue: [digitLen := digitLen - 1].
+ digitLen = 0 ifTrue: [^ 0 asOop: SmallInteger].
- | sLen val len oldLen pointer |
- len := oldLen := self digitLengthOfNonImmediate: aLargeNegativeInteger.
- pointer := interpreterProxy
- cCoerce: (interpreterProxy firstIndexableField: aLargeNegativeInteger)
- to: #'unsigned char *'.
- [len > 0 and: [(pointer at: len - 1) = 0]] whileTrue:
- [len := len - 1].
- len = 0 ifTrue: [^ 0 asOop: SmallInteger].
-
"Now check if in SmallInteger range"
+ val := self unsafeDigitOfLargeInt: aLargeNegativeInteger at: digitLen.
sLen := interpreterProxy minSmallInteger < -16r40000000
+ ifTrue: [2]
+ ifFalse: [1]. "SmallInteger minVal digitLength"
+ digitLen <= sLen
+ ifTrue:
+ [minVal := 0 - interpreterProxy minSmallInteger.
+ val2 := val.
+ digitLen > 1 ifTrue: [val2 := val2 << 32 + (self unsafeDigitOfLargeInt: aLargeNegativeInteger at: 1)].
+ val2 <= minVal
+ ifTrue: [^0 - val2 asOop: SmallInteger]].
- ifTrue: [8]
- ifFalse: [4]. "SmallInteger digitLength"
- len <= sLen ifTrue:
- [(len < sLen
- or: [(pointer at: sLen - 1)
- < (self cDigitOfCSI: interpreterProxy minSmallInteger at: sLen)]) ifTrue: "interpreterProxy minSmallInteger lastDigit"
- ["If high digit less, then can be small"
- val := 0 - (pointer at: (len := len - 1)).
- len - 1 to: 0 by: -1 do:
- [:i | val := val * 256 - (pointer at: i)].
- ^val asOop: SmallInteger].
- 1 to: sLen do:
- [:i | | byte | "If all digits same, then = minSmallInteger (sr: minSmallInteger digits 1 to sLen - 1 are 0)"
- byte := i > len ifTrue: [0] ifFalse: [pointer at: i - 1].
- byte ~= (self cDigitOfCSI: interpreterProxy minSmallInteger at: i) ifTrue: "Not so; return self shortened"
- [len < oldLen ifTrue: "^ self growto: len"
- [^self largeInt: aLargeNegativeInteger growTo: len].
- ^aLargeNegativeInteger]].
- ^interpreterProxy minSmallInteger asOop: SmallInteger].
"Return self, or a shortened copy"
+ byteLen := digitLen * 4.
+ val <= 16rFFFF
+ ifTrue: [byteLen := byteLen - 2]
+ ifFalse: [val := val >> 16].
+ val <= 16rFF
+ ifTrue: [byteLen := byteLen - 1].
+ oldByteLen := self byteSizeOfLargeInt: aLargeNegativeInteger.
+ byteLen < oldByteLen
+ ifTrue: [^ self largeInt: aLargeNegativeInteger growTo: byteLen]
+ ifFalse: [^ aLargeNegativeInteger]!
- len < oldLen ifTrue: "^ self growto: len"
- [^self largeInt: aLargeNegativeInteger growTo: len].
- ^aLargeNegativeInteger!
Item was changed:
----- Method: LargeIntegersPlugin>>normalizePositive: (in category 'oop functions') -----
normalizePositive: aLargePositiveInteger
"Check for leading zeroes and return shortened copy if so."
"First establish len = significant length."
+ | val val2 sLen digitLen byteLen oldByteLen maxVal |
+ <var: #val type: #'unsigned long'>
+ <var: #val2 type: #'unsigned long'>
+ <var: #maxVal type: #'unsigned long'>
+ digitLen := self digitSizeOfLargeInt: aLargePositiveInteger.
+ [digitLen ~= 0 and: [(self unsafeDigitOfLargeInt: aLargePositiveInteger at: digitLen) = 0]]
+ whileTrue: [digitLen := digitLen - 1].
+ digitLen = 0 ifTrue: [^ 0 asOop: SmallInteger].
- | sLen val len oldLen pointer |
- <var: #pointer type: #'unsigned char *'>
- len := oldLen := self digitLengthOfNonImmediate: aLargePositiveInteger.
- pointer := interpreterProxy
- cCoerce: (interpreterProxy firstIndexableField: aLargePositiveInteger)
- to: #'unsigned char *'.
- [len > 0 and: [(pointer at: len - 1) = 0]] whileTrue:
- [len := len - 1].
- len = 0 ifTrue: [^ 0 asOop: SmallInteger].
-
"Now check if in SmallInteger range"
+ val := self unsafeDigitOfLargeInt: aLargePositiveInteger at: digitLen.
+ sLen := interpreterProxy maxSmallInteger > 16r3FFFFFFF
+ ifTrue: [2]
+ ifFalse: [1]. "SmallInteger maxVal digitLength"
+ digitLen <= sLen
+ ifTrue:
+ [maxVal := interpreterProxy maxSmallInteger.
+ val2 := val.
+ digitLen > 1 ifTrue: [val2 := val2 << 32 + (self unsafeDigitOfLargeInt: aLargePositiveInteger at: 1)].
+ val2 <= maxVal
+ ifTrue: [^val2 asOop: SmallInteger]].
- sLen := interpreterProxy maxSmallInteger > 16r3FFFFFFF "SmallInteger maxVal digitLength."
- ifTrue: [8]
- ifFalse: [4].
- len <= sLen ifTrue:
- [(len < sLen
- or: [(pointer at: sLen - 1) <= (self cDigitOfCSI: interpreterProxy maxSmallInteger at: sLen)]) ifTrue:
- ["If so, return its SmallInt value"
- val := pointer at: (len := len - 1).
- len - 1 to: 0 by: -1 do:
- [:i | val := val * 256 + (pointer at: i)].
- ^val asOop: SmallInteger]].
"Return self, or a shortened copy"
+ byteLen := digitLen * 4.
+ val <= 16rFFFF
+ ifTrue: [byteLen := byteLen - 2]
+ ifFalse: [val := val >> 16].
+ val <= 16rFF
+ ifTrue: [byteLen := byteLen - 1].
+ oldByteLen := self byteSizeOfLargeInt: aLargePositiveInteger.
+ byteLen < oldByteLen
+ ifTrue: [^ self largeInt: aLargePositiveInteger growTo: byteLen]
+ ifFalse: [^ aLargePositiveInteger]!
- len < oldLen ifTrue: "^ self growto: len"
- [^self largeInt: aLargePositiveInteger growTo: len].
- ^aLargePositiveInteger!
Item was changed:
----- Method: LargeIntegersPlugin>>primMontgomeryDigitLength (in category 'Integer primitives') -----
primMontgomeryDigitLength
self debugCode: [self msg: 'primMontgomeryDigitLength'].
self
primitive: 'primMontgomeryDigitLength'
parameters: #()
receiver: #Integer.
+ ^interpreterProxy integerObjectOf: 32!
- ^interpreterProxy integerObjectOf: 8!
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'>
- primMontgomeryTimes: secondOperandInteger modulo: thirdModuloInteger mInvModB: smallInverseInteger
- | firstLarge secondLarge firstInteger thirdLarge |
self debugCode: [self msg: 'montgomeryTimes: secondOperandInteger modulo: thirdModuloInteger mInvModB: smallInverseInteger'].
firstInteger := self
primitive: 'primMontgomeryTimesModulo'
+ parameters: #(Integer Integer Integer )
- parameters: #(Integer Integer SmallInteger )
receiver: #Integer.
+ mInv := interpreterProxy positive32BitValueOf: mInverseInteger.
(interpreterProxy isIntegerObject: firstInteger)
ifTrue: ["convert it to a not normalized LargeInteger"
self remapOop: #(secondOperandInteger thirdModuloInteger) in: [firstLarge := self createLargeFromSmallInteger: firstInteger]]
ifFalse: [firstLarge := firstInteger].
(interpreterProxy isIntegerObject: secondOperandInteger)
ifTrue: ["convert it to a not normalized LargeInteger"
self remapOop: #(firstLarge thirdModuloInteger) in: [secondLarge := self createLargeFromSmallInteger: secondOperandInteger]]
ifFalse: [secondLarge := secondOperandInteger].
(interpreterProxy isIntegerObject: thirdModuloInteger)
ifTrue: ["convert it to a not normalized LargeInteger"
self remapOop: #(firstLarge secondLarge) in: [thirdLarge := self createLargeFromSmallInteger: thirdModuloInteger]]
ifFalse: [thirdLarge := thirdModuloInteger].
+ ^ self digitMontgomery: firstLarge times: secondLarge modulo: thirdLarge mInvModB: mInv!
- ^ self digitMontgomery: firstLarge times: secondLarge modulo: thirdLarge mInvModB: smallInverseInteger!
Item was added:
+ ----- Method: LargeIntegersPlugin>>unsafeByteOfLargeInt:at: (in category 'util') -----
+ unsafeByteOfLargeInt: bytesObj at: ix
+ "Argument bytesObj must not be aSmallInteger!!"
+ <inline: true>
+ <returnTypeC: #'unsigned char'>
+ ^(interpreterProxy cCoerce: (interpreterProxy firstIndexableField: bytesObj) to: #'unsigned char *') at: ix - 1!
Item was removed:
- ----- Method: LargeIntegersPlugin>>unsafeDigitOf:at: (in category 'util') -----
- unsafeDigitOf: bytesObj at: ix
- "Argument bytesObj must not be aSmallInteger!!"
- <inline: true>
- ^(interpreterProxy cCoerce: (interpreterProxy firstIndexableField: bytesObj) to: #'unsigned char *') at: ix - 1!
Item was added:
+ ----- Method: LargeIntegersPlugin>>unsafeDigitOfLargeInt:at: (in category 'util') -----
+ unsafeDigitOfLargeInt: anOop at: ix
+ "Argument must not be aSmallInteger!!"
+ <inline: true>
+ <returnTypeC: #'unsigned int'>
+ ^self cDigitOf: (interpreterProxy cCoerce: (interpreterProxy firstIndexableField: anOop) to: #'unsigned int *') at: ix - 1!
More information about the Vm-dev
mailing list