Squeak-dev April 2019

squeak-dev@lists.squeakfoundation.org

36 participants
122 discussions

The Trunk: KernelTests-nice.358.mcz
by commits＠source.squeak.org 28 Apr '19

28 Apr '19

Nicolas Cellier uploaded a new version of KernelTests to project The Trunk: http://source.squeak.org/trunk/KernelTests-nice.358.mcz ==================== Summary ==================== Name: KernelTests-nice.358 Author: nice Time: 28 April 2019, 1:51:22.467166 am UUID: 607e8c38-5586-4894-8e92-013e69fe774b Ancestors: KernelTests-nice.357 Slightly change the set of LargePositiveInteger probe and exhibit a problem in sqrtRem. This is because I did not respect the pre-condition that most significant digit a3 be at least 1/4th of the digit base b. a3 >= b/4 I made a confusion of log scale... I thought that a3 having at least 3/4 of the byte length of b was enough... Err! b/4 means that we can only offer 2 bit less than b! if self digitLength is a multiple of 4 bytes, and self most significand byte has two leading zero bits or more, the pre-condition is not OK... =============== Diff against KernelTests-nice.357 =============== Item was changed: ----- Method: LargePositiveIntegerTest>>x13kbits (in category 'accessing') ----- x13kbits "Return a 13 kilo bits integer" ^(15 to: 44 by: 4) + inject: 9753102468 - inject: 9876543210 into: [:big :bits | big * big << bits + bits]! Item was changed: ----- Method: LargePositiveIntegerTest>>x92kbits (in category 'accessing') ----- x92kbits "Return a 92 kilo bits integer" ^(11 to: 51 by: 4) + inject: 1357924680 - inject: 1234567890 into: [:big :bits | big * big << bits + bits]!

1 0

The Trunk: Collections-nice.827.mcz
by commits＠source.squeak.org 27 Apr '19

27 Apr '19

Nicolas Cellier uploaded a new version of Collections to project The Trunk: http://source.squeak.org/trunk/Collections-nice.827.mcz ==================== Summary ==================== Name: Collections-nice.827 Author: nice Time: 27 April 2019, 10:34:08.261332 pm UUID: 6dd69760-fdb4-4e8c-8809-38a4fb90b11e Ancestors: Collections-nice.826 Provide fastMultiply: helper #digitShiftSum: =============== Diff against Collections-nice.826 =============== Item was added: + ----- Method: Interval>>digitShiftSum: (in category 'enumerating') ----- + digitShiftSum: aBlock + "Reconstruct an Integer that has been split in chunks by using shift and add. + Each of my element represent a digitShift, an my step size repreent the digit length of chunks. + The block is evaluated with each digitShift to produce the chunks. + + Algorithm insights: + Let d0,d1,d2,... be the chunks, and s be the bit shift (8*step because digitLength is 8bits) + The naive loop does shift each chunk and accumulate into a sum: + ((d0 + (d1<<s)) + (d2<<s)) + (d3<<s) + ... + The length of accumulator increase at each iteration (1+2+3...) resulting in a cost (size+1)*size/2, or O(size^2) + Note that Horner scheme would be of about same cost + (((... + d3) << s + d2) << s + d1) << s + d0 + (a bit like so called Shlemiel the painter) + If we instead divide and conquer, we add smaller parts (1+1+2+...) resulting into a cost of O(size*log2(size)) + (d0 + (d1<<s)) + ((d2 + (d3<<s)) << s) + ... + However, the divide and conquer split comes with an additionnal cost, so do it only if worth it." + + | sz half offset | + "Naive loop in O(size^2)/2 is best for small size" + (sz := self size) <= 8 ifTrue: [^self inject: 0 into: [:sum :shift | ((aBlock value: shift) bitShift: 8 * shift) + sum]]. + half := sz // 2. + offset := half * step + start. + ^((start to: half - 1 * step + start by: step) digitShiftSum: aBlock) + + (((0 to: self last - offset by: step) digitShiftSum: [:k | aBlock value: offset + k]) bitShift: 8 * offset)!

1 0

The Trunk: Kernel-nice.1220.mcz
by commits＠source.squeak.org 27 Apr '19

27 Apr '19

Nicolas Cellier uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-nice.1220.mcz ==================== Summary ==================== Name: Kernel-nice.1220 Author: nice Time: 27 April 2019, 2:36:07.52994 pm UUID: b2eb6e2e-1dfa-4d23-9421-ec0e5e8d4f86 Ancestors: Kernel-fn.1216 Accelerate some huge Integer arithmetic (This is a squash of inbox commits) These algorithms use divide and conquer strategy that recursively split a problem into simpler problems. 1) Multiplication and Squaring - Implement Karatsuba and 3-way Toom-Cook algorithms for fast large integer multiplication (a Bodrato Zanoni variant) - Implement the 2-way asymetrical Karatsuba, 3-way symetrical, and 4-way asymetrical Toom-Cook squaring variant of Chung-Hasan. Note that asymetrical squareToom4 over-performs the symetrical squaredToom3 even for medium size (800 bytes). - provide a fastMultiply: that dispatch on appropriate variant based on heuristics. Currently this fast multiplication is used only in LargePositiveInteger>>squared, and other algorithme below. - slightly modify raisedToInteger: to use that squared. This result in a small penalty for small number exponentation, but large speed up for big integers. 2) Square-root - implement the Karatsuba-like square root algorithm from Paul Zimmerman. 3) Division - Implement the recursive fast division of Burnikel-Ziegler for large integers and connect it to digitDiv:neg: when operands are large enough. - Use this recursive algorithm to accelerate digitDiv:neg: This is not the fastest known division which is a composition of Barrett and Newton-Raphson inversion - but is easy to implement and should have similar performances for at least a few thousand bytes long integers - see for example http://bioinfo.ict.ac.cn/~dbu/AlgorithmCourses/Lectures/Lec5-Fast-Division-… 4) Printing - Use digitDiv:neg: in large integer printString so as to obtain the quotient (head) and remainder (tail) in a single operation. Together with divide and conquer division, this results in a factor of about 4x for 50000 factorial printString. Examples on a 64 bits image/VM (MBP 2015 i5 2.7GHz) [10 raisedToInteger: 30] bench. '3,770,000 per second. 265 nanoseconds per run.' - before '3,500,000 per second. 286 nanoseconds per run.' - after [10.0 raisedToInteger: 30] bench. '10,900,000 per second. 91.6 nanoseconds per run.' - before '9,540,000 per second. 105 nanoseconds per run.' - after | x | x := 100 factorial. [x raisedToInteger: 30] bench. '15,900 per second. 63 microseconds per run.' - before '19,500 per second. 51.3 microseconds per run.' - after | x | x := 1000 factorial. [x raisedToInteger: 30] bench. '58.8 per second. 17 milliseconds per run.' - before '179 per second. 5.6 milliseconds per run.' - after | x | x := 500 factorial - 100 factorial. { [x sqrtFloor] bench. [x sqrtFloorNewtonRaphson] bench. } #( '42,300 per second. 23.6 microseconds per run.' '8,240 per second. 121 microseconds per run.') | x | x := 50000 factorial - 10000 factorial + 5000 factorial - 1000 factorial + 500 factorial - 100 factorial + 50 factorial - 10 factorial + 5 factorial - 1. { [x printString] bench. } #('1.29 per second. 778 milliseconds per run.') - before #('5.12 per second. 195 milliseconds per run.') - after =============== Diff against Kernel-fn.1216 =============== Item was added: + ----- Method: Integer>>digitDiv21: (in category 'private') ----- + digitDiv21: anInteger + + ^(self digitDiv: anInteger neg: false) collect: #normalize! Item was added: + ----- Method: Integer>>digitDiv32: (in category 'private') ----- + digitDiv32: anInteger + + ^(self digitDiv: anInteger neg: false) collect: #normalize! Item was changed: ----- Method: Integer>>digitDiv:neg: (in category 'private') ----- + digitDiv: anInteger neg: aBoolean + ^self primDigitDiv: anInteger neg: aBoolean! - digitDiv: arg neg: ng - "Answer with an array of (quotient, remainder)." - | quo rem ql d div dh dnh dl qhi qlo j l hi lo r3 a t divDigitLength remDigitLength | - <primitive: 'primDigitDivNegative' module:'LargeIntegers'> - arg = 0 ifTrue: [^ (ZeroDivide dividend: self) signal]. - "TFEI added this line" - l := self digitLength - arg digitLength + 1. - l <= 0 ifTrue: [^ Array with: 0 with: self]. - "shortcut against #highBit" - d := 8 - arg lastDigit highBitOfByte. - div := arg digitLshift: d. - divDigitLength := div digitLength + 1. - div := div growto: divDigitLength. - "shifts so high order word is >=128" - rem := self digitLshift: d. - rem digitLength = self digitLength ifTrue: [rem := rem growto: self digitLength + 1]. - remDigitLength := rem digitLength. - "makes a copy and shifts" - quo := Integer new: l neg: ng. - dl := divDigitLength - 1. - "Last actual byte of data" - ql := l. - dh := div digitAt: dl. - dnh := dl = 1 - ifTrue: [0] - ifFalse: [div digitAt: dl - 1]. - 1 to: ql do: - [:k | - "maintain quo*arg+rem=self" - "Estimate rem/div by dividing the leading to bytes of rem by dh." - "The estimate is q = qhi*16+qlo, where qhi and qlo are nibbles." - j := remDigitLength + 1 - k. - "r1 := rem digitAt: j." - (rem digitAt: j) - = dh - ifTrue: [qhi := qlo := 15 - "i.e. q=255"] - ifFalse: - ["Compute q = (r1,r2)//dh, t = (r1,r2)\\dh. - Note that r1,r2 are bytes, not nibbles. - Be careful not to generate intermediate results exceeding 13 - bits." - "r2 := (rem digitAt: j - 1)." - t := ((rem digitAt: j) - bitShift: 4) - + ((rem digitAt: j - 1) - bitShift: -4). - qhi := t // dh. - t := (t \\ dh bitShift: 4) - + ((rem digitAt: j - 1) - bitAnd: 15). - qlo := t // dh. - t := t \\ dh. - "Next compute (hi,lo) := q*dnh" - hi := qhi * dnh. - lo := qlo * dnh + ((hi bitAnd: 15) - bitShift: 4). - hi := (hi bitShift: -4) - + (lo bitShift: -8). - lo := lo bitAnd: 255. - "Correct overestimate of q. - Max of 2 iterations through loop -- see Knuth vol. 2" - r3 := j < 3 - ifTrue: [0] - ifFalse: [rem digitAt: j - 2]. - [(t < hi - or: [t = hi and: [r3 < lo]]) - and: - ["i.e. (t,r3) < (hi,lo)" - qlo := qlo - 1. - lo := lo - dnh. - lo < 0 - ifTrue: - [hi := hi - 1. - lo := lo + 256]. - hi >= dh]] - whileTrue: [hi := hi - dh]. - qlo < 0 - ifTrue: - [qhi := qhi - 1. - qlo := qlo + 16]]. - "Subtract q*div from rem" - l := j - dl. - a := 0. - 1 to: divDigitLength do: - [:i | - hi := (div digitAt: i) - * qhi. - lo := a + (rem digitAt: l) - ((hi bitAnd: 15) - bitShift: 4) - ((div digitAt: i) - * qlo). - rem digitAt: l put: lo - (lo // 256 * 256). - "sign-tolerant form of (lo bitAnd: 255)" - a := lo // 256 - (hi bitShift: -4). - l := l + 1]. - a < 0 - ifTrue: - ["Add div back into rem, decrease q by 1" - qlo := qlo - 1. - l := j - dl. - a := 0. - 1 to: divDigitLength do: - [:i | - a := (a bitShift: -8) - + (rem digitAt: l) + (div digitAt: i). - rem digitAt: l put: (a bitAnd: 255). - l := l + 1]]. - quo digitAt: ql + 1 - k put: (qhi bitShift: 4) - + qlo]. - rem := rem - digitRshift: d - bytes: 0 - lookfirst: dl. - ^ Array with: quo with: rem! Item was added: + ----- Method: Integer>>fastMultiply: (in category 'arithmetic') ----- + fastMultiply: anInteger + ^self * anInteger! Item was added: + ----- Method: Integer>>karatsubaTimes: (in category 'arithmetic') ----- + karatsubaTimes: anInteger + "Eventually use Karatsuba algorithm to perform the multiplication. + This is efficient only for large integers (see subclass). + By default, use regular multiplication." + + ^self * anInteger! Item was added: + ----- Method: Integer>>primDigitDiv:neg: (in category 'private') ----- + primDigitDiv: arg neg: ng + "Answer with an array of (quotient, remainder)." + | quo rem ql d div dh dnh dl qhi qlo j l hi lo r3 a t divDigitLength remDigitLength | + <primitive: 'primDigitDivNegative' module:'LargeIntegers'> + arg = 0 ifTrue: [^ (ZeroDivide dividend: self) signal]. + "TFEI added this line" + l := self digitLength - arg digitLength + 1. + l <= 0 ifTrue: [^ Array with: 0 with: self]. + "shortcut against #highBit" + d := 8 - arg lastDigit highBitOfByte. + div := arg digitLshift: d. + divDigitLength := div digitLength + 1. + div := div growto: divDigitLength. + "shifts so high order word is >=128" + rem := self digitLshift: d. + rem digitLength = self digitLength ifTrue: [rem := rem growto: self digitLength + 1]. + remDigitLength := rem digitLength. + "makes a copy and shifts" + quo := Integer new: l neg: ng. + dl := divDigitLength - 1. + "Last actual byte of data" + ql := l. + dh := div digitAt: dl. + dnh := dl = 1 + ifTrue: [0] + ifFalse: [div digitAt: dl - 1]. + 1 to: ql do: + [:k | + "maintain quo*arg+rem=self" + "Estimate rem/div by dividing the leading to bytes of rem by dh." + "The estimate is q = qhi*16+qlo, where qhi and qlo are nibbles." + j := remDigitLength + 1 - k. + "r1 := rem digitAt: j." + (rem digitAt: j) + = dh + ifTrue: [qhi := qlo := 15 + "i.e. q=255"] + ifFalse: + ["Compute q = (r1,r2)//dh, t = (r1,r2)\\dh. + Note that r1,r2 are bytes, not nibbles. + Be careful not to generate intermediate results exceeding 13 + bits." + "r2 := (rem digitAt: j - 1)." + t := ((rem digitAt: j) + bitShift: 4) + + ((rem digitAt: j - 1) + bitShift: -4). + qhi := t // dh. + t := (t \\ dh bitShift: 4) + + ((rem digitAt: j - 1) + bitAnd: 15). + qlo := t // dh. + t := t \\ dh. + "Next compute (hi,lo) := q*dnh" + hi := qhi * dnh. + lo := qlo * dnh + ((hi bitAnd: 15) + bitShift: 4). + hi := (hi bitShift: -4) + + (lo bitShift: -8). + lo := lo bitAnd: 255. + "Correct overestimate of q. + Max of 2 iterations through loop -- see Knuth vol. 2" + r3 := j < 3 + ifTrue: [0] + ifFalse: [rem digitAt: j - 2]. + [(t < hi + or: [t = hi and: [r3 < lo]]) + and: + ["i.e. (t,r3) < (hi,lo)" + qlo := qlo - 1. + lo := lo - dnh. + lo < 0 + ifTrue: + [hi := hi - 1. + lo := lo + 256]. + hi >= dh]] + whileTrue: [hi := hi - dh]. + qlo < 0 + ifTrue: + [qhi := qhi - 1. + qlo := qlo + 16]]. + "Subtract q*div from rem" + l := j - dl. + a := 0. + 1 to: divDigitLength do: + [:i | + hi := (div digitAt: i) + * qhi. + lo := a + (rem digitAt: l) - ((hi bitAnd: 15) + bitShift: 4) - ((div digitAt: i) + * qlo). + rem digitAt: l put: lo - (lo // 256 * 256). + "sign-tolerant form of (lo bitAnd: 255)" + a := lo // 256 - (hi bitShift: -4). + l := l + 1]. + a < 0 + ifTrue: + ["Add div back into rem, decrease q by 1" + qlo := qlo - 1. + l := j - dl. + a := 0. + 1 to: divDigitLength do: + [:i | + a := (a bitShift: -8) + + (rem digitAt: l) + (div digitAt: i). + rem digitAt: l put: (a bitAnd: 255). + l := l + 1]]. + quo digitAt: ql + 1 - k put: (qhi bitShift: 4) + + qlo]. + rem := rem + digitRshift: d + bytes: 0 + lookfirst: dl. + ^ Array with: quo with: rem! Item was changed: ----- Method: Integer>>sqrtFloor (in category 'mathematical functions') ----- sqrtFloor + "Return the integer part of the square root of self + Assume self >= 0 + The following invariants apply: + 1) self sqrtFloor squared <= self + 2) (self sqrtFloor + 1) squared > self" - "Return the integer part of the square root of self" + ^self sqrtFloorNewtonRaphson! - | guess delta | - guess := 1 bitShift: self highBit + 1 // 2. - [ - delta := guess squared - self // (guess bitShift: 1). - delta = 0 ] whileFalse: [ - guess := guess - delta ]. - ^guess - 1! Item was added: + ----- Method: Integer>>sqrtFloorNewtonRaphson (in category 'mathematical functions') ----- + sqrtFloorNewtonRaphson + "Return the integer part of the square root of self. + Use a Newton-Raphson iteration since it converges quadratically + (twice more bits of precision at each iteration)" + + | guess delta | + guess := 1 bitShift: self highBit + 1 // 2. + [ + delta := guess squared - self // (guess bitShift: 1). + delta = 0 ] whileFalse: [ + guess := guess - delta ]. + ^guess - 1! Item was added: + ----- Method: Integer>>sqrtRem (in category 'mathematical functions') ----- + sqrtRem + "Return an array with floor sqrt and sqrt remainder. + Assume self >= 0. + The following invariants apply: + 1) self sqrtRem first squared <= self + 2) (self sqrtRem first + 1) squared > self + 3) self sqrtRem first squared + self sqrtRem last = self" + + | s | + s := self sqrtFloorNewtonRaphson. + ^{ s. self - s squared } ! Item was added: + ----- Method: Integer>>toom3Times: (in category 'arithmetic') ----- + toom3Times: anInteger + ^self * anInteger! Item was added: + ----- Method: LargePositiveInteger>>butLowestNDigits: (in category 'private') ----- + butLowestNDigits: N + "make a new integer removing N least significant digits of self." + + ^self bitShiftMagnitude: -8 * N! Item was added: + ----- Method: LargePositiveInteger>>copyDigitsFrom:to: (in category 'private') ----- + copyDigitsFrom: start to: stop + "Make a new integer keeping only some digits of self." + + | len slice | + start > 0 ifFalse: [^self error: 'start index should be at least 1']. + len := self digitLength. + (start > len or: [start > stop]) ifTrue: [^0]. + stop >= len + ifTrue: [start = 1 ifTrue: [^self]. + len := len - start + 1] + ifFalse: [len := stop - start + 1]. + slice := self class new: len. + slice replaceFrom: 1 to: len with: self startingAt: start. + ^slice normalize! Item was added: + ----- Method: LargePositiveInteger>>digitDiv21: (in category 'private') ----- + digitDiv21: anInteger + "This is part of the recursive division algorithm from Burnikel - Ziegler + Divide a two limbs receiver by 1 limb dividend + Each limb is decomposed in two halves of p bytes (8*p bits) + so as to continue the recursion" + + | p qr1 qr2 | + p := anInteger digitLength + 1 bitShift: -1. + p <= 256 ifTrue: [^(self primDigitDiv: anInteger neg: false) collect: #normalize]. + qr1 := (self butLowestNDigits: p) digitDiv32: anInteger. + qr2 := (self lowestNDigits: p) + (qr1 last bitShift: 8*p) digitDiv32: anInteger. + qr2 at: 1 put: (qr2 at: 1) + ((qr1 at: 1) bitShift: 8*p). + ^qr2! Item was added: + ----- Method: LargePositiveInteger>>digitDiv32: (in category 'private') ----- + digitDiv32: anInteger + "This is part of the recursive division algorithm from Burnikel - Ziegler + Divide 3 limb (a2,a1,a0) by 2 limb (b1,b0). + Each limb is made of p bytes (8*p bits). + This step transforms the division problem into multiplication + It must use the fastMultiply: to be worth the overhead costs." + + | a2 b1 d p q qr r | + p := anInteger digitLength + 1 bitShift: -1. + (a2 := self butLowestNDigits: 2*p) + < (b1 := anInteger butLowestNDigits: p) + ifTrue: + [qr := (self butLowestNDigits: p) digitDiv21: b1. + q := qr first. + r := qr last] + ifFalse: + [q := (1 bitShift: 8*p) - 1. + r := (self butLowestNDigits: p) - (b1 bitShift: 8*p) + b1]. + d := q fastMultiply: (anInteger lowestNDigits: p). + r := (self lowestNDigits: p) + (r bitShift: 8*p) - d. + [r < 0] + whileTrue: + [q := q - 1. + r := r + anInteger]. + ^Array with: q with: r + ! Item was added: + ----- Method: LargePositiveInteger>>digitDiv:neg: (in category 'private') ----- + digitDiv: anInteger neg: aBoolean + "If length is worth, engage a recursive divide and conquer strategy" + | qr | + (anInteger digitLength <= 256 + or: [self digitLength <= anInteger digitLength]) + ifTrue: [^ self primDigitDiv: anInteger neg: aBoolean]. + qr := self abs recursiveDigitDiv: anInteger abs. + self negative ifTrue: [qr at: 2 put: qr second negated]. + aBoolean ifTrue: [qr at: 1 put: qr first negated]. + ^qr! Item was added: + ----- Method: LargePositiveInteger>>fastMultiply: (in category 'arithmetic') ----- + fastMultiply: anInteger + "Eventually use Karatsuba or 3-way Toom-Cook algorithm to perform the multiplication" + + | xLen | + "arrange to have the receiver be the shorter" + (xLen := self digitLength) > anInteger digitLength + ifTrue: [^ anInteger fastMultiply: self ]. + + "If too short to be worth, fallback to naive algorithm" + (xLen >= 600) ifFalse: [^self * anInteger]. + (xLen >= 6000) ifFalse: [^self karatsubaTimes: anInteger]. + ^self toom3Times: anInteger! Item was added: + ----- Method: LargePositiveInteger>>karatsubaTimes: (in category 'arithmetic') ----- + karatsubaTimes: anInteger + "Eventually use Karatsuba algorithm to perform the multiplication + The Karatsuba algorithm divide number in two smaller parts. + Then it uses tricks to perform only 3 multiplications. + See https://en.wikipedia.org/wiki/Karatsuba_algorithm" + + | half xHigh xLow yHigh yLow low high mid xLen yLen | + "arrange to have the receiver be the shorter" + (xLen := self digitLength) > (yLen := anInteger digitLength) + ifTrue: [^ anInteger karatsubaTimes: self ]. + + "If too short to be worth, fallback to naive algorithm" + (xLen >= 600) ifFalse: [^self * anInteger]. + + "Seek for integers of about the same length, else split the long one" + yLen >= (7 * xLen bitShift: -2) + ifTrue: + [^(0 to: yLen - 1 by: xLen + 1) digitShiftSum: [:yShift | + self karatsubaTimes: + (anInteger copyDigitsFrom: yShift + 1 to: yShift + 1 + xLen)]]. + + "At this point, lengths are similar, divide each integer in two halves" + half := (yLen + 1 bitShift: -1) bitClear: 2r11. + xLow := self lowestNDigits: half. + xHigh := self butLowestNDigits: half. + yLow := anInteger lowestNDigits: half. + yHigh := anInteger butLowestNDigits: half. + + "Karatsuba trick: perform with 3 multiplications instead of 4" + low := xLow karatsubaTimes: yLow. + high := xHigh karatsubaTimes: yHigh. + mid := high + low + (xHigh - xLow karatsubaTimes: yLow - yHigh). + + "Sum the parts of decomposition" + ^low + (mid bitShiftMagnitude: 8*half) + (high bitShiftMagnitude: 16*half) + + " + | a b | + a := 650 factorial-1. + b := 700 factorial-1. + {a digitLength. b digitLength}. + self assert: (a karatsubaTimes: b) - (a * b) = 0. + [Smalltalk garbageCollect. + [1000 timesRepeat: [a karatsubaTimes: b]] timeToRun] value / + [Smalltalk garbageCollect. + [1000 timesRepeat: [a * b]] timeToRun] value asFloat + "! Item was added: + ----- Method: LargePositiveInteger>>lowestNDigits: (in category 'private') ----- + lowestNDigits: N + "Make a new integer keeping only N least significant digits of self" + + | low | + N >= self digitLength ifTrue: [^self]. + low := self class new: N. + low replaceFrom: 1 to: N with: self startingAt: 1. + ^low normalize! Item was changed: ----- Method: LargePositiveInteger>>printOn:base: (in category 'printing') ----- printOn: aStream base: b "Append a representation of this number in base b on aStream. In order to reduce cost of LargePositiveInteger ops, split the number in approximately two equal parts in number of digits." + | halfDigits halfPower head tail nDigitsUnderestimate qr | - | halfDigits halfPower head tail nDigitsUnderestimate | "Don't engage any arithmetic if not normalized" (self digitLength = 0 or: [(self digitAt: self digitLength) = 0]) ifTrue: [^self normalize printOn: aStream base: b]. nDigitsUnderestimate := b = 10 ifTrue: [((self highBit - 1) * 1233 >> 12) + 1. "This is because (2 log)/(10 log)*4096 is slightly greater than 1233"] ifFalse: [self highBit quo: b highBit]. "splitting digits with a whole power of two is more efficient" halfDigits := 1 bitShift: nDigitsUnderestimate highBit - 2. halfDigits <= 1 ifTrue: ["Hmmm, this could happen only in case of a huge base b... Let lower level fail" ^self printOn: aStream base: b nDigits: (self numberOfDigitsInBase: b)]. "Separate in two halves, head and tail" halfPower := b raisedToInteger: halfDigits. + qr := self digitDiv: halfPower neg: self negative. + head := qr first normalize. + tail := qr last normalize. - head := self quo: halfPower. - tail := self - (head * halfPower). "print head" head printOn: aStream base: b. "print tail without the overhead to count the digits" tail printOn: aStream base: b nDigits: halfDigits! Item was changed: ----- Method: LargePositiveInteger>>printOn:base:nDigits: (in category 'printing') ----- printOn: aStream base: b nDigits: n "Append a representation of this number in base b on aStream using n digits. In order to reduce cost of LargePositiveInteger ops, split the number of digts approximatily in two Should be invoked with: 0 <= self < (b raisedToInteger: n)" + | halfPower half head tail qr | - | halfPower half head tail | n <= 1 ifTrue: [ n <= 0 ifTrue: [self error: 'Number of digits n should be > 0']. "Note: this is to stop an infinite loop if one ever attempts to print with a huge base This can happen because choice was to not hardcode any limit for base b We let Character>>#digitValue: fail" ^aStream nextPut: (Character digitValue: self) ]. halfPower := n bitShift: -1. half := b raisedToInteger: halfPower. + qr := self digitDiv: half neg: self negative. + head := qr first normalize. + tail := qr last normalize. - head := self quo: half. - tail := self - (head * half). head printOn: aStream base: b nDigits: n - halfPower. tail printOn: aStream base: b nDigits: halfPower! Item was added: + ----- Method: LargePositiveInteger>>recursiveDigitDiv: (in category 'private') ----- + recursiveDigitDiv: anInteger + "This is the recursive division algorithm from Burnikel - Ziegler + See Fast Recursive Division - Christoph Burnikel, Joachim Ziegler + Research Report MPI-I-98-1-022, MPI Saarbrucken, Oct 1998 + https://pure.mpg.de/rest/items/item_1819444_4/component/file_2599480/content" + + | s m t a b z qr q i | + "round digits up to next power of 2" + s := anInteger digitLength. + m := 1 bitShift: (s - 1) highBit. + "shift so that leading bit of leading byte be 1, and digitLength power of two" + s := m * 8 - anInteger highBit. + a := self bitShift: s. + b := anInteger bitShift: s. + + "Decompose a into t limbs - each limb have m bytes + choose t such that leading bit of leading limb of a be 0" + t := (a highBit + 1 / (m * 8)) ceiling. + z := a butLowestNDigits: t - 2 * m. + i := t - 2. + q := 0. + "and do a division of two limb by 1 limb b for each pair of limb of a" + [qr := z digitDiv21: b. + q := (q bitShift: 8*m) + qr first. "Note: this naive recomposition of q cost O(t^2) - it is possible in O(t log(t))" + (i := i - 1) >= 0] whileTrue: + [z := (qr last bitShift: 8*m) + (a copyDigitsFrom: i * m + 1 to: i + 1 * m)]. + ^Array with: q with: (qr last bitShift: s negated)! Item was added: + ----- Method: LargePositiveInteger>>sqrtFloor (in category 'mathematical functions') ----- + sqrtFloor + "Like super, but use a faster divide and conquer strategy if it's worth" + + self digitLength >= 64 ifFalse: [^self sqrtFloorNewtonRaphson]. + ^self sqrtRem first! Item was added: + ----- Method: LargePositiveInteger>>sqrtRem (in category 'mathematical functions') ----- + sqrtRem + "Like super, but use a divide and conquer method to perform this operation. + See Paul Zimmermann. Karatsuba Square Root. [Research Report] RR-3805, INRIA. 1999, pp.8. <inria-00072854> + https://hal.inria.fr/inria-00072854/PDF/RR-3805.pdf" + + | n qr q s r sr high mid low | + n := self digitLength bitShift: -2. + n >= 16 ifFalse: [^super sqrtRem]. + high := self butLowestNDigits: n * 2. + mid := self copyDigitsFrom: n + 1 to: n * 2. + low := self lowestNDigits: n. + + sr := high sqrtRem. + qr := (sr last bitShift: 8 * n) + mid digitDiv: (sr first bitShift: 1) neg: false. + q := qr first normalize. + s := (sr first bitShift: 8 * n) + q. + r := (qr last normalize bitShift: 8 * n) + low - q squared. + r negative + ifTrue: + [r := (s bitShift: 1) + r - 1. + s := s - 1]. + sr at: 1 put: s; at: 2 put: r. + ^sr + ! Item was added: + ----- Method: LargePositiveInteger>>squared (in category 'mathematical functions') ----- + squared + "Eventually use a divide and conquer algorithm to perform the multiplication" + + (self digitLength >= 400) ifFalse: [^self * self]. + (self digitLength >= 800) ifFalse: [^self squaredKaratsuba]. + ^self squaredToom4! Item was added: + ----- Method: LargePositiveInteger>>squaredKaratsuba (in category 'mathematical functions') ----- + squaredKaratsuba + "Use a divide and conquer algorithm to perform the multiplication. + Split in two parts like Karatsuba, but economize 2 additions by using asymetrical product." + + | half xHigh xLow low high mid | + + "Divide digits in two halves" + half := self digitLength + 1 // 2 bitClear: 2r11. + xLow := self lowestNDigits: half. + xHigh := self butLowestNDigits: half. + + "eventually use karatsuba" + low := xLow squared. + high := xHigh squared. + mid := xLow karatsubaTimes: xHigh. + + "Sum the parts of decomposition" + ^low + (mid bitShift: 8*half+1) + (high bitShift: 16*half) + + " + | a | + a := 440 factorial-1. + a digitLength. + self assert: a * a - a squaredKaratsuba = 0. + [Smalltalk garbageCollect. + [2000 timesRepeat: [a squaredKaratsuba]] timeToRun] value / + [Smalltalk garbageCollect. + [2000 timesRepeat: [a * a]] timeToRun] value asFloat + "! Item was added: + ----- Method: LargePositiveInteger>>squaredToom3 (in category 'mathematical functions') ----- + squaredToom3 + "Use a 3-way Toom-Cook divide and conquer algorithm to perform the multiplication" + + | third x0 x1 x2 x20 z0 z1 z2 z3 z4 | + "divide in 3 parts" + third := self digitLength + 2 // 3 bitClear: 2r11. + x2 := self butLowestNDigits: third * 2. + x1 := self copyDigitsFrom: third + 1 to: third * 2. + x0 := self lowestNDigits: third. + + "Toom-3 trick: 5 multiplications instead of 9" + z0 := x0 squared. + z4 := x2 squared. + x20 := x2 + x0. + z1 := (x20 + x1) squared. + x20 := x20 - x1. + z2 := x20 squared. + z3 := ((x20 + x2 bitShift: 1) - x0) squared. + + "Sum the parts of decomposition" + z3 := z3 - z1 quo: 3. + z1 := z1 - z2 bitShift: -1. + z2 := z2 - z0. + + z3 := (z2 - z3 bitShift: -1) + (z4 bitShift: 1). + z2 := z2 + z1 - z4. + z1 := z1 - z3. + ^z0 + (z1 bitShift: 8*third) + (z2 bitShift: 16*third) + (z3 + (z4 bitShift: 8*third) bitShift: 24*third) + + " + | a | + a := 1400 factorial-1. + a digitLength. + self assert: a * a - a squaredToom3 = 0. + [Smalltalk garbageCollect. + [1000 timesRepeat: [a squaredToom3]] timeToRun] value / + [Smalltalk garbageCollect. + [1000 timesRepeat: [a squaredKaratsuba]] timeToRun] value asFloat + "! Item was added: + ----- Method: LargePositiveInteger>>squaredToom4 (in category 'mathematical functions') ----- + squaredToom4 + "Use a 4-way Toom-Cook divide and conquer algorithm to perform the multiplication. + See Asymmetric Squaring Formulae Jaewook Chung and M. Anwar Hasan + https://www.lirmm.fr/arith18/papers/Chung-Squaring.pdf" + + | p a0 a1 a2 a3 a02 a13 s0 s1 s2 s3 s4 s5 s6 t2 t3 | + "divide in 4 parts" + p := (self digitLength + 3 bitShift: -2) bitClear: 2r11. + a3 := self butLowestNDigits: p * 3. + a2 := self copyDigitsFrom: p * 2 + 1 to: p * 3. + a1 := self copyDigitsFrom: p + 1 to: p * 2. + a0 := self lowestNDigits: p. + + "Toom-4 trick: 7 multiplications instead of 16" + a02 := a0 - a2. + a13 := a1 - a3. + s0 := a0 squared. + s1 := (a0 fastMultiply: a1) bitShift: 1. + s2 := (a02 + a13) fastMultiply: (a02 - a13). + s3 := ((a0 + a1) + (a2 + a3)) squared. + s4 := (a02 fastMultiply: a13) bitShift: 1. + s5 := (a3 fastMultiply: a2) bitShift: 1. + s6 := a3 squared. + + "Interpolation" + t2 := s1 + s5. + t3 := (s2 + s3 + s4 bitShift: -1) - t2. + s3 := t2 - s4. + s4 := t3 - s0. + s2 := t3 - s2 - s6. + + "Sum the parts of decomposition" + ^s0 + (s1 bitShift: 8*p) + (s2 + (s3 bitShift: 8*p) bitShift: 16*p) + +(s4 + (s5 bitShift: 8*p) + (s6 bitShift: 16*p) bitShift: 32*p) + + " + | a | + a := 770 factorial-1. + a digitLength. + [a * a - a squaredToom4 = 0] assert. + [Smalltalk garbageCollect. + [1000 timesRepeat: [a squaredToom4]] timeToRun] value / + [Smalltalk garbageCollect. + [1000 timesRepeat: [a squaredKaratsuba]] timeToRun] value asFloat + "! Item was added: + ----- Method: LargePositiveInteger>>toom3Times: (in category 'arithmetic') ----- + toom3Times: anInteger + "Eventually use a variant of Toom-Cooke for performing multiplication. + Toom-Cooke is a generalization of Karatsuba divide and conquer algorithm. + It divides operands in n parts instead of 2. + See https://en.wikipedia.org/wiki/Toom%E2%80%93Cook_multiplication + Here we divide each operand in 3 parts, thus the name Toom-3. + And use a Bodrato-Zanoni variant for the choice of interpolation points and matrix inversion + See What about Toom-Cook matrices optimality? - Marco Bodrato, Alberto Zanoni - Oct. 2006 + http://www.bodrato.it/papers/WhatAboutToomCookMatricesOptimality.pdf" + + | third x2 x1 x0 y2 y1 y0 xLen yLen y20 z4 z3 z2 z1 z0 x20 | + "arrange to have the receiver be the shorter" + (xLen := self digitLength) > (yLen := anInteger digitLength) + ifTrue: [^anInteger toom3Times: self ]. + + "If too short to be worth, fallback to Karatsuba algorithm" + (xLen > 6000) ifFalse: [^self karatsubaTimes: anInteger]. + + "Seek for well balanced integers" + yLen > (5 * xLen bitShift: -2) + ifTrue: [^(0 to: yLen - 1 by: xLen + 1) digitShiftSum: [:yShift | + self toom3Times: (anInteger copyDigitsFrom: yShift + 1 to: yShift +1 + xLen)]]. + + "At this point, lengths are well balanced, divide in 3 parts" + third := yLen + 2 // 3 bitClear: 2r11. + x2 := self butLowestNDigits: third * 2. + x1 := self copyDigitsFrom: third + 1 to: third * 2. + x0 := self lowestNDigits: third. + y2 := anInteger butLowestNDigits: third * 2. + y1 := anInteger copyDigitsFrom: third + 1 to: third * 2. + y0 := anInteger lowestNDigits: third. + + "Toom-3 trick: 5 multiplications instead of 9" + z0 := x0 toom3Times: y0. + z4 := x2 toom3Times: y2. + x20 := x2 + x0. + y20 := y2 + y0. + z1 := x20 + x1 toom3Times: y20 + y1. + x20 := x20 - x1. + y20 := y20 - y1. + z2 := x20 toom3Times: y20. + z3 := (x20 + x2 bitShift: 1) - x0 toom3Times: (y20 + y2 bitShift: 1) - y0. + + "Sum the parts of decomposition" + z3 := z3 - z1 quo: 3. + z1 := z1 - z2 bitShift: -1. + z2 := z2 - z0. + + z3 := (z2 - z3 bitShift: -1) + (z4 bitShift: 1). + z2 := z2 + z1 - z4. + z1 := z1 - z3. + ^z0 + (z1 bitShift: 8*third) + (z2 bitShift: 16*third) + (z3 + (z4 bitShift: 8*third) bitShift: 24*third) + + " + | a b | + a :=5000 factorial - 1. + b := 6000 factorial - 1. + a digitLength min: b digitLength. + a digitLength max: b digitLength. + (a toom3Times: b) = (a * b) ifFalse: [self error]. + [Smalltalk garbageCollect. + [300 timesRepeat: [a toom3Times: b]] timeToRun] value / + [Smalltalk garbageCollect. + [300 timesRepeat: [a karatsubaTimes: b]] timeToRun] value asFloat + "! Item was changed: ----- Method: Number>>raisedToInteger: (in category 'mathematical functions') ----- raisedToInteger: anInteger "The 0 raisedToInteger: 0 is an special case. In some contexts must be 1 and in others must be handled as an indeterminate form. I take the first context because that's the way that was previously handled. Maybe further discussion is required on this topic." | bitProbe result | anInteger negative ifTrue: [^(self raisedToInteger: anInteger negated) reciprocal]. bitProbe := 1 bitShift: anInteger highBit - 1. result := self class one. [ (anInteger bitAnd: bitProbe) > 0 ifTrue: [ result := result * self ]. (bitProbe := bitProbe bitShift: -1) > 0 ] + whileTrue: [ result := result squared ]. - whileTrue: [ result := result * result ]. ^result!

3 2

The Trunk: KernelTests-nice.357.mcz
by commits＠source.squeak.org 27 Apr '19

27 Apr '19

Nicolas Cellier uploaded a new version of KernelTests to project The Trunk: http://source.squeak.org/trunk/KernelTests-nice.357.mcz ==================== Summary ==================== Name: KernelTests-nice.357 Author: nice Time: 27 April 2019, 2:45:13.141833 pm UUID: b42dbfd6-b189-4082-bd9b-7c9f5b0fd586 Ancestors: KernelTests-fn.356 Add some tests for new huge Integer arithmetic algorithms Note: I'd like to test things like: x := self x106kbits self assert: [x squaredToom4] runsFasterThan: [x squaredKaratsuba]. But I'm afraid that it might sometimes fail, depending on particular slave machnie load... Benchmarking is an art... =============== Diff against KernelTests-fn.356 =============== Item was added: + ----- Method: IntegerTest>>testSqrtRem (in category 'tests - mathematical functions') ----- + testSqrtRem + + #( + 0 1 2 3 4 5 10 16 30 160479924 386234481 501619156 524723498 580855366 766098594 834165249 1020363860 1042083924 1049218924 + 1459774772895569 3050005981408238 4856589481837079 5650488387708463 7831037396100244) do: [ :each | + | sr | + sr := each sqrtRem. + self assert: sr first squared <= each. + self assert: (sr first+1) squared > each. + self assert: sr first squared + sr last = each] + ! Item was added: + ----- Method: LargePositiveIntegerTest>>testDigitDiv (in category 'tests') ----- + testDigitDiv + | a b q r qr ap bp | + ap := self x23kbits. + bp := self x13kbits. + self assert: (ap recursiveDigitDiv: bp) = ((ap primDigitDiv: bp neg: false) collect: #normalize). + #(#yourself #negated) do: [:opa | + #(#yourself #negated) do: [:opb | + a := ap perform: opa. + b := bp perform: opb. + qr := a digitDiv: b neg: opa ~~ opb. + q := qr first normalize. + r := qr last normalize. + self assert: q * b + r = a. + self assert: r abs < b abs. + self assert: a positive ==> r positive. + self assert: a negative ==> (r negative | r isZero)]] + ! Item was added: + ----- Method: LargePositiveIntegerTest>>testFastMultiply (in category 'tests') ----- + testFastMultiply + | a b ab ap bp | + ap := self x92kbits. + bp := self x106kbits. + #(#yourself #negated) do: [:opa | + #(#yourself #negated) do: [:opb | + a := ap perform: opa. + b := bp perform: opb. + ab := a * b. + self assert: (a fastMultiply: b) = ab. + self assert: (a karatsubaTimes: b) = ab. + self assert: (a toom3Times: b) = ab]]! Item was added: + ----- Method: LargePositiveIntegerTest>>testSqrtRem (in category 'tests') ----- + testSqrtRem + | x sr | + x := self x92kbits. + sr := x sqrtRem. + self assert: sr first squared <= x. + self assert: (sr first+1) squared > x. + self assert: sr first squared + sr last = x.! Item was added: + ----- Method: LargePositiveIntegerTest>>testSquared (in category 'tests') ----- + testSquared + + | large ref | + large := self x23kbits. + ref := large * large. + self assert: ref = large squared. + self assert: ref = large squaredKaratsuba. + self assert: ref = large squaredToom3. + self assert: ref = large squaredToom4.! Item was added: + ----- Method: LargePositiveIntegerTest>>x106kbits (in category 'accessing') ----- + x106kbits + "Return a 106 kilo bits integer" + ^(15 to: 55 by: 4) + inject: 9876543210 + into: [:big :bits | big * big << bits + bits]! Item was added: + ----- Method: LargePositiveIntegerTest>>x13kbits (in category 'accessing') ----- + x13kbits + "Return a 13 kilo bits integer" + ^(15 to: 44 by: 4) + inject: 9876543210 + into: [:big :bits | big * big << bits + bits]! Item was added: + ----- Method: LargePositiveIntegerTest>>x23kbits (in category 'accessing') ----- + x23kbits + "Return a 23 kilo bits integer" + ^(11 to: 44 by: 4) + inject: 1234567890 + into: [:big :bits | big * big << bits + bits]! Item was added: + ----- Method: LargePositiveIntegerTest>>x92kbits (in category 'accessing') ----- + x92kbits + "Return a 92 kilo bits integer" + ^(11 to: 51 by: 4) + inject: 1234567890 + into: [:big :bits | big * big << bits + bits]!

1 0

The Inbox: Kernel-nice.1219.mcz
by commits＠source.squeak.org 27 Apr '19

27 Apr '19

Nicolas Cellier uploaded a new version of Kernel to project The Inbox: http://source.squeak.org/inbox/Kernel-nice.1219.mcz ==================== Summary ==================== Name: Kernel-nice.1219 Author: nice Time: 27 April 2019, 12:17:47.293648 pm UUID: dc581577-0fd6-470c-82ed-58eaafcb7dbf Ancestors: Kernel-nice.1218 Fix large digitDiv:neg: sign mess. Remove a useless temp in fastMultiply Comment toom3 reference better (The work of Bodrato Zanoni deserve it) =============== Diff against Kernel-nice.1218 =============== Item was changed: ----- Method: LargePositiveInteger>>digitDiv:neg: (in category 'private') ----- digitDiv: anInteger neg: aBoolean "If length is worth, engage a recursive divide and conquer strategy" | qr | (anInteger digitLength <= 256 or: [self digitLength <= anInteger digitLength]) ifTrue: [^ self primDigitDiv: anInteger neg: aBoolean]. qr := self abs recursiveDigitDiv: anInteger abs. + self negative ifTrue: [qr at: 2 put: qr second negated]. + aBoolean ifTrue: [qr at: 1 put: qr first negated]. + ^qr! - ^ aBoolean - ifTrue: [qr collect: #negated] - ifFalse: [qr]! Item was changed: ----- Method: LargePositiveInteger>>fastMultiply: (in category 'arithmetic') ----- fastMultiply: anInteger "Eventually use Karatsuba or 3-way Toom-Cook algorithm to perform the multiplication" + | xLen | - | xLen yLen | "arrange to have the receiver be the shorter" + (xLen := self digitLength) > anInteger digitLength - (xLen := self digitLength) > (yLen := anInteger digitLength) ifTrue: [^ anInteger fastMultiply: self ]. "If too short to be worth, fallback to naive algorithm" (xLen >= 600) ifFalse: [^self * anInteger]. (xLen >= 6000) ifFalse: [^self karatsubaTimes: anInteger]. ^self toom3Times: anInteger! Item was changed: ----- Method: LargePositiveInteger>>toom3Times: (in category 'arithmetic') ----- toom3Times: anInteger "Eventually use a variant of Toom-Cooke for performing multiplication. Toom-Cooke is a generalization of Karatsuba divide and conquer algorithm. It divides operands in n parts instead of 2. See https://en.wikipedia.org/wiki/Toom%E2%80%93Cook_multiplication + Here we divide each operand in 3 parts, thus the name Toom-3. + And use a Bodrato-Zanoni variant for the choice of interpolation points and matrix inversion + See What about Toom-Cook matrices optimality? - Marco Bodrato, Alberto Zanoni - Oct. 2006 + http://www.bodrato.it/papers/WhatAboutToomCookMatricesOptimality.pdf" - Here we divide each operand in 3 parts, thus the name Toom-3." | third x2 x1 x0 y2 y1 y0 xLen yLen y20 z4 z3 z2 z1 z0 x20 | "arrange to have the receiver be the shorter" (xLen := self digitLength) > (yLen := anInteger digitLength) ifTrue: [^anInteger toom3Times: self ]. "If too short to be worth, fallback to Karatsuba algorithm" (xLen > 6000) ifFalse: [^self karatsubaTimes: anInteger]. "Seek for well balanced integers" yLen > (5 * xLen bitShift: -2) ifTrue: [^(0 to: yLen - 1 by: xLen + 1) digitShiftSum: [:yShift | self toom3Times: (anInteger copyDigitsFrom: yShift + 1 to: yShift +1 + xLen)]]. "At this point, lengths are well balanced, divide in 3 parts" third := yLen + 2 // 3 bitClear: 2r11. x2 := self butLowestNDigits: third * 2. x1 := self copyDigitsFrom: third + 1 to: third * 2. x0 := self lowestNDigits: third. y2 := anInteger butLowestNDigits: third * 2. y1 := anInteger copyDigitsFrom: third + 1 to: third * 2. y0 := anInteger lowestNDigits: third. "Toom-3 trick: 5 multiplications instead of 9" z0 := x0 toom3Times: y0. z4 := x2 toom3Times: y2. x20 := x2 + x0. y20 := y2 + y0. z1 := x20 + x1 toom3Times: y20 + y1. x20 := x20 - x1. y20 := y20 - y1. z2 := x20 toom3Times: y20. z3 := (x20 + x2 bitShift: 1) - x0 toom3Times: (y20 + y2 bitShift: 1) - y0. "Sum the parts of decomposition" z3 := z3 - z1 quo: 3. z1 := z1 - z2 bitShift: -1. z2 := z2 - z0. z3 := (z2 - z3 bitShift: -1) + (z4 bitShift: 1). z2 := z2 + z1 - z4. z1 := z1 - z3. ^z0 + (z1 bitShift: 8*third) + (z2 bitShift: 16*third) + (z3 + (z4 bitShift: 8*third) bitShift: 24*third) " | a b | a :=5000 factorial - 1. b := 6000 factorial - 1. a digitLength min: b digitLength. a digitLength max: b digitLength. (a toom3Times: b) = (a * b) ifFalse: [self error]. [Smalltalk garbageCollect. [300 timesRepeat: [a toom3Times: b]] timeToRun] value / [Smalltalk garbageCollect. [300 timesRepeat: [a karatsubaTimes: b]] timeToRun] value asFloat "!

1 0

The Trunk: Kernel-fn.1216.mcz
by commits＠source.squeak.org 27 Apr '19

27 Apr '19

Fabio Niephaus uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-fn.1216.mcz ==================== Summary ==================== Name: Kernel-fn.1216 Author: fn Time: 27 April 2019, 11:08:43.467561 am UUID: 4af5e126-9387-41b6-bd41-a6c526f0bd8a Ancestors: Kernel-eem.1215 Make SmallInteger's method overrides for copying consistent with those of SmallFloat64. =============== Diff against Kernel-eem.1215 =============== Item was added: + ----- Method: SmallInteger>>copy (in category 'copying') ----- + copy + "Answer the receiver, because SmallIntegers are unique." + ^self! Item was changed: ----- Method: SmallInteger>>deepCopy (in category 'copying') ----- + deepCopy + "Answer the receiver, because SmallIntegers are unique." + ^self! - deepCopy! Item was changed: ----- Method: SmallInteger>>shallowCopy (in category 'copying') ----- + shallowCopy + "Answer the receiver, because SmallIntegers are unique." + ^self! - shallowCopy! Item was changed: ----- Method: SmallInteger>>veryDeepCopyWith: (in category 'copying') ----- veryDeepCopyWith: deepCopier + "Answer the receiver, because SmallIntegers are unique." + ^self! - "Return self. I can't be copied. Do not record me."!

1 0

The Trunk: Morphic-cmm.1486.mcz
by commits＠source.squeak.org 27 Apr '19

27 Apr '19

Chris Muller uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-cmm.1486.mcz ==================== Summary ==================== Name: Morphic-cmm.1486 Author: cmm Time: 26 April 2019, 8:35:52.194323 pm UUID: 94a2f848-a9cf-43a7-a2bb-597457bf319f Ancestors: Morphic-mt.1485 - Fix a glitch in #tryInvokeHalo: which could lead to mis-identification of the correct halo target. - Update the new Tools menu entry to read "Git Browser". =============== Diff against Morphic-mt.1485 =============== Item was changed: ----- Method: PasteUpMorph>>tryInvokeHalo: (in category 'events-processing') ----- tryInvokeHalo: aUserInputEvent "Invoke halos around the top-most world container at aUserInputEvent's #position. If it was already halo'd, zero-in on its next inward component morph at that position. Holding Shift during the click reverses this traversal order." | stack innermost haloTarget | Preferences noviceMode ifTrue: [ ^ self ]. Morph haloForAll ifFalse: [ ^ self ]. "the stack is the top-most morph to bottom-most." stack := (self morphsAt: aUserInputEvent position unlocked: true) select: [ : each | each wantsHaloFromClick or: [ each handlesMouseDown: aUserInputEvent ] ]. innermost := aUserInputEvent hand halo ifNil: [ stack first ] ifNotNil: + [ : existingHalo | (stack copyWithout: existingHalo) "No halos on halos" - [ : existingHalo | stack allButFirst "existingHalo is first on the stack, not a target" detect: [ : each | each owner == self ] ifFound: [ : worldContainer | "Is existingHalo's target part of the same worldContainer as the morph clicked?" (existingHalo target withAllOwners includes: worldContainer) ifTrue: [ "same hierarchy, let #transferHalo: continue to handle it for now." ^self ] ifFalse: [ "different hierarchy, remove + add." aUserInputEvent hand removeHalo. aUserInputEvent shiftPressed ifTrue: [ stack second "first is still the just removed halo" ] ifFalse: [ worldContainer ] ] ] ifNone: [ "existingHalo is on the World, defer to #transferHalo: for now." ^self ] ]. "If modifier key is pressed, start at innermost (the target), otherwise the outermost (direct child of the world (self))." + haloTarget := (innermost == self or: [aUserInputEvent shiftPressed]) - haloTarget := (innermost == self or: [aUserInputEvent shiftPressed]) ifTrue: [ innermost ] ifFalse: [ "Find the outermost owner that wants it." innermost withAllOwners reversed allButFirst detect: [ : each | each wantsHaloFromClick ] ifNone: [ "haloTarget has its own mouseDown handler, don't halo." ^ self ] ]. "Now that we have the haloTarget, show the halo." aUserInputEvent hand newMouseFocus: haloTarget event: aUserInputEvent. haloTarget invokeHaloOrMove: aUserInputEvent. "aUserInputEvent has been consumed, don't let it cause any further side-effects." aUserInputEvent ignore! Item was changed: ----- Method: TheWorldMainDockingBar>>gitInfrastructureMenuItemOn: (in category 'submenu - tools') ----- gitInfrastructureMenuItemOn: menu menu addItem: [ : item | item + contents: 'Git Browser' translated ; + help: 'Browse repositories on github.com' translated ; - contents: 'Git Infrastructure' translated ; - help: 'Load tools for accessing github repositories.' translated ; icon: (self colorIcon: Color lightGray) ; target: Installer ; selector: #installGitInfrastructure ]! Item was changed: + (PackageInfo named: 'Morphic') postscript: '"Added Git Browser to Tools menu" - (PackageInfo named: 'Morphic') postscript: '"updated Tools menu" TheWorldMainDockingBar updateInstances'!

2 1

The Trunk: Morphic-cmm.1487.mcz
by commits＠source.squeak.org 27 Apr '19

27 Apr '19

Chris Muller uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-cmm.1487.mcz ==================== Summary ==================== Name: Morphic-cmm.1487 Author: cmm Time: 26 April 2019, 8:41:58.231963 pm UUID: 8cb25e4c-50bf-40a5-b912-905db496b69f Ancestors: Morphic-mt.1485 - Fix revisions of class definitions when there's another PackageInfo defined whose full name is only a prefix of the working copy the selected class belongs to. - Check the local package-cache before hitting the server for operations where the ancestral UUID is known, such as diffing from the History list. Keep its allFileNamesCache up to date. =============== Diff against Morphic-mt.1485 =============== Item was changed: ----- Method: PasteUpMorph>>tryInvokeHalo: (in category 'events-processing') ----- tryInvokeHalo: aUserInputEvent "Invoke halos around the top-most world container at aUserInputEvent's #position. If it was already halo'd, zero-in on its next inward component morph at that position. Holding Shift during the click reverses this traversal order." | stack innermost haloTarget | Preferences noviceMode ifTrue: [ ^ self ]. Morph haloForAll ifFalse: [ ^ self ]. "the stack is the top-most morph to bottom-most." stack := (self morphsAt: aUserInputEvent position unlocked: true) select: [ : each | each wantsHaloFromClick or: [ each handlesMouseDown: aUserInputEvent ] ]. innermost := aUserInputEvent hand halo ifNil: [ stack first ] ifNotNil: + [ : existingHalo | (stack copyWithout: existingHalo) "No halos on halos" - [ : existingHalo | stack allButFirst "existingHalo is first on the stack, not a target" detect: [ : each | each owner == self ] ifFound: [ : worldContainer | "Is existingHalo's target part of the same worldContainer as the morph clicked?" (existingHalo target withAllOwners includes: worldContainer) ifTrue: [ "same hierarchy, let #transferHalo: continue to handle it for now." ^self ] ifFalse: [ "different hierarchy, remove + add." aUserInputEvent hand removeHalo. aUserInputEvent shiftPressed ifTrue: [ stack second "first is still the just removed halo" ] ifFalse: [ worldContainer ] ] ] ifNone: [ "existingHalo is on the World, defer to #transferHalo: for now." ^self ] ]. "If modifier key is pressed, start at innermost (the target), otherwise the outermost (direct child of the world (self))." + haloTarget := (innermost == self or: [aUserInputEvent shiftPressed]) - haloTarget := (innermost == self or: [aUserInputEvent shiftPressed]) ifTrue: [ innermost ] ifFalse: [ "Find the outermost owner that wants it." innermost withAllOwners reversed allButFirst detect: [ : each | each wantsHaloFromClick ] ifNone: [ "haloTarget has its own mouseDown handler, don't halo." ^ self ] ]. "Now that we have the haloTarget, show the halo." aUserInputEvent hand newMouseFocus: haloTarget event: aUserInputEvent. haloTarget invokeHaloOrMove: aUserInputEvent. "aUserInputEvent has been consumed, don't let it cause any further side-effects." aUserInputEvent ignore! Item was changed: ----- Method: TheWorldMainDockingBar>>gitInfrastructureMenuItemOn: (in category 'submenu - tools') ----- gitInfrastructureMenuItemOn: menu menu addItem: [ : item | item + contents: 'Git Browser' translated ; + help: 'Browse repositories on github.com' translated ; - contents: 'Git Infrastructure' translated ; - help: 'Load tools for accessing github repositories.' translated ; icon: (self colorIcon: Color lightGray) ; target: Installer ; + selector: #installAndOpenGitBrowser ]! - selector: #installGitInfrastructure ]! Item was changed: + (PackageInfo named: 'Morphic') postscript: '"Added Git Browser to Tools menu" - (PackageInfo named: 'Morphic') postscript: '"updated Tools menu" TheWorldMainDockingBar updateInstances'!

1 0

The Trunk: Installer-Core-cmm.431.mcz
by commits＠source.squeak.org 27 Apr '19

27 Apr '19

Chris Muller uploaded a new version of Installer-Core to project The Trunk: http://source.squeak.org/trunk/Installer-Core-cmm.431.mcz ==================== Summary ==================== Name: Installer-Core-cmm.431 Author: cmm Time: 21 April 2019, 7:54:57.789733 pm UUID: c241b3df-f0a8-4ed3-b11b-f8975ab292cf Ancestors: Installer-Core-tcj.426 Auto-install Metacello if necessary when a Metacello load script is executed. =============== Diff against Installer-Core-tcj.426 =============== Item was changed: ----- Method: Installer class>>ensureRecentMetacello (in category 'scripts') ----- ensureRecentMetacello "Copied and adapted from https://github.com/Metacello/metacello/blob/master/README.md" | metacello | ((Smalltalk classNamed: #WebClient) ifNil: [ false ] ifNotNil: [ :webClient | [ (webClient httpHead: 'https://github.com') isSuccess ] on: Error do: [ false ] ]) ifFalse: [ ^self inform: 'Could not connect to "https://github.com".\\You need an internet connection and SSL support\to install (or update) Metacello.\\Please fix those issues and try again.' translated withCRs ]. + self isMetacelloInstalled ifFalse: [ + "Prepare a clean environment for it." + Smalltalk globals removeKey: #Metacello. - metacello := (Smalltalk classNamed: #Metacello) ifNil: [ "Get the Metacello configuration (for Squeak users)" Installer gemsource project: 'metacello'; addPackage: 'ConfigurationOfMetacello'; install. "Bootstrap Metacello Preview, using mcz files (#'previewBootstrap' symbolic version" ((Smalltalk classNamed: #ConfigurationOfMetacello) project version: #'previewBootstrap') load. + metacello := Smalltalk classNamed: #Metacello ]. - Smalltalk classNamed: #Metacello ]. "Now load latest version of Metacello" metacello new baseline: 'Metacello'; repository: 'github://Metacello/metacello:master/repository'; get. metacello new baseline: 'Metacello'; repository: 'github://Metacello/metacello:master/repository'; load: #('default' 'Metacello-Help'). ! Item was added: + ----- Method: Installer class>>installAndOpenGitBrowser (in category 'scripts') ----- + installAndOpenGitBrowser + self installGitInfrastructure. + (Smalltalk at: #SquitBrowser) open.! Item was changed: ----- Method: Installer class>>installGitInfrastructure (in category 'scripts') ----- installGitInfrastructure + | priorSetting | + "for INIFileTest>>#testComplexRead" + priorSetting := Scanner allowUnderscoreAsAssignment. + Scanner allowUnderscoreAsAssignment: true. - self ensureRecentMetacello. - (Smalltalk at: #Metacello) new baseline: 'Squot'; repository: 'github://hpi-swa/Squot:master/src'; + load. + + Scanner allowUnderscoreAsAssignment: priorSetting + ! - load.! Item was added: + ----- Method: Installer class>>isMetacelloInstalled (in category 'scripts') ----- + isMetacelloInstalled + "Squeak is shipped with the global #Metacello referring to lightweight MetacelloStub. After the first message is sent, the latest Metacello is installed, replacing the stub." + ^ (Smalltalk at: #Metacello) ~= MetacelloStub! Item was added: + Object subclass: #MetacelloStub + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Installer-Core'! + + !MetacelloStub commentStamp: 'cmm 4/8/2019 14:00' prior: 0! + MetacelloStub is a loose reference to the class Metacello in its host repository. It's kept at both its real name, #MetacelloStub, as well as the name #Metacello. This is done to allow Squeak to respond to messages sent to Metacello (e.g., as referenced in external installation scripts), without the need to ship with Metacello pre-installed.! Item was added: + ----- Method: MetacelloStub class>>confirmMetacello (in category 'overriding') ----- + confirmMetacello + Installer isMetacelloInstalled ifFalse: + [ (UIManager confirm: 'This action requires Metacello, but it''s not installed. Download and install it now?') ifTrue: [ Installer ensureRecentMetacello ] ]! Item was added: + ----- Method: MetacelloStub class>>doesNotUnderstand: (in category 'overriding') ----- + doesNotUnderstand: aMessage + "Handle any messages sent to Metacello class, too." + self confirmMetacello. + ^ aMessage sendTo: (Smalltalk classNamed: #Metacello)! Item was added: + ----- Method: MetacelloStub class>>initialize (in category 'initialize-release') ----- + initialize + Smalltalk + at: #Metacello + ifAbsentPut: [ self ]! Item was added: + ----- Method: MetacelloStub class>>isMetacelloConfig (in category 'overriding') ----- + isMetacelloConfig + "Sent during Metacello's bootstrap initialization to all classes in the system. Respond false." + ^ false! Item was added: + ----- Method: MetacelloStub class>>new (in category 'overriding') ----- + new + self confirmMetacello. + ^ (Smalltalk at: #Metacello) new!

1 0

The Trunk: Monticello-cmm.699.mcz
by commits＠source.squeak.org 27 Apr '19

27 Apr '19

Chris Muller uploaded a new version of Monticello to project The Trunk: http://source.squeak.org/trunk/Monticello-cmm.699.mcz ==================== Summary ==================== Name: Monticello-cmm.699 Author: cmm Time: 22 April 2019, 2:33:18.479505 pm UUID: de205c9e-af00-4954-9f2a-243d83ac9f1e Ancestors: Monticello-nice.695 - Fix revisions of class definitions when there's another PackageInfo defined whose full name is only a prefix of the working copy the selected class belongs to. - Check the local package-cache before hitting the server for operations where the ancestral UUID is known, such as diffing from the History list. Keep its allFileNamesCache up to date. =============== Diff against Monticello-nice.695 =============== Item was removed: - (PackageInfo named: 'Monticello') preamble: '"Woops, somehow missed the #browseMcMethodRevisions Service." - | methodMenuServiceCategory classMenuServiceCategory | - methodMenuServiceCategory := ServiceRegistry current serviceWithId: #browserMethodMenu. - methodMenuServiceCategory services copy do: - [ : each | (#(#browseMcMethodHistory #browseMcMethodOrigin ) includes: each id) ifTrue: [ methodMenuServiceCategory services remove: each ] ]. - classMenuServiceCategory := ServiceRegistry current serviceWithId: #browserClassMenu. - classMenuServiceCategory services copy do: - [ : each | (#(#browseMcClassHistory #browseMcClassOrigin ) includes: each id) ifTrue: [ classMenuServiceCategory services remove: each ] ]'! Item was changed: ----- Method: Class>>packageInfo (in category '*monticello') ----- packageInfo + ^ (PackageInfo allPackages select: [ : each | each includesClass: self ]) + ifEmpty: [ nil ] + ifNotEmpty: + [ : myPackages | "Select the most-qualified match." + myPackages detectMax: [ : each | each packageName size ] ]! - ^ PackageInfo allPackages - detect: [ : each | each includesClass: self ] - ifNone: [ nil ]! Item was removed: - ----- Method: MCRepository>>isTrunkBackup (in category 'testing') ----- - isTrunkBackup - ^ false! Item was changed: ----- Method: MCRepository>>prepareVersionForStorage: (in category 'accessing') ----- prepareVersionForStorage: aVersion ^ self alwaysStoreDiffs ifTrue: [aVersion asDiffAgainst: + (self withCache closestAncestorVersionFor: aVersion info ifNone: [^ aVersion])] - (self closestAncestorVersionFor: aVersion info ifNone: [^ aVersion])] ifFalse: [aVersion]! Item was added: + ----- Method: MCRepository>>withCache (in category 'accessing') ----- + withCache + "Answer the receiver with package-cache in front of it." + ^ MCRepositoryGroup with: self! Item was added: + ----- Method: MCRepositoryGroup class>>with: (in category 'instance creation') ----- + with: aMCRepository + ^ self new + addRepository: aMCRepository ; + yourself! Item was added: + ----- Method: MCRepositoryGroup>>closestAncestorVersionFor:ifNone: (in category 'accessing') ----- + closestAncestorVersionFor: anAncestry ifNone: errorBlock + anAncestry breadthFirstAncestorsDo: + [:ancestorInfo | + (self versionWithInfo: ancestorInfo) ifNotNil: [:v | ^ v]]. + ^ errorBlock value! Item was changed: ----- Method: MCRepositoryGroup>>flushAllFilenames (in category 'private') ----- flushAllFilenames + self repositories do: [ : each | each flushAllFilenames ]! - repositories do: [ : each | each flushAllFilenames ]! Item was changed: ----- Method: MCRepositoryGroup>>versionWithInfo:ifAbsent: (in category 'repository-api') ----- versionWithInfo: aVersionInfo ifAbsent: aBlock + self repositories do: - repositories do: [ : each | ([each versionWithInfo: aVersionInfo ifAbsent: [ nil ]] on: NetworkError do: [ : err | nil ]) ifNotNil: [ : ver | ^ ver ] ]. ^ aBlock value! Item was added: + ----- Method: MCRepositoryGroup>>withCache (in category 'accessing') ----- + withCache + ^ self! Item was changed: ----- Method: MCVersionNotification>>initializeWithVersion:repository: (in category 'private') ----- initializeWithVersion: aVersion repository: aRepository version := aVersion. repository := aRepository. + ancestor := repository withCache closestAncestorVersionFor: version info ifNone: []. - ancestor := repository closestAncestorVersionFor: version info ifNone: []. changes := ancestor ifNil: [#()] ifNotNil: [(version snapshot patchRelativeToBase: ancestor snapshot) operations sorted]! Item was changed: ----- Method: MCWorkingCopy>>changesRelativeToRepository: (in category 'operations') ----- + changesRelativeToRepository: aRepository - changesRelativeToRepository: aRepository | ancestorVersion ancestorSnapshot | + ancestorVersion := aRepository withCache + closestAncestorVersionFor: ancestry + ifNone: [ nil ]. + ancestorSnapshot := ancestorVersion + ifNil: [ MCSnapshot empty ] + ifNotNil: [ ancestorVersion snapshot ]. - ancestorVersion := aRepository closestAncestorVersionFor: ancestry ifNone: []. - ancestorSnapshot := ancestorVersion ifNil: [MCSnapshot empty] ifNotNil: [ancestorVersion snapshot]. ^ package snapshot patchRelativeToBase: ancestorSnapshot! Item was changed: ----- Method: MCWorkingCopyBrowser>>viewChanges (in category 'actions') ----- viewChanges | patch | self canSave ifTrue: + [patch := workingCopy changesRelativeToRepository: self repository withCache. + patch isNil ifTrue: [ ^self ]. - [patch := workingCopy changesRelativeToRepository: self repository. - patch isNil ifTrue: [^ self]. patch isEmpty ifTrue: [ workingCopy modified: false. self inform: 'No changes' ] ifFalse: [ workingCopy modified: true. (MCPatchBrowser forPatch: patch) label: 'Patch Browser: ', workingCopy description; environmentInDisplayingImage: workingCopy environment; + show ] ]! - show]]! Item was removed: - (PackageInfo named: 'Monticello') postscript: 'MCDefinitionIndex migrateAllInstances'!

1 0

← Newer
1
2
3
4
5
6
7
8
9
...
13
Older →