--- a/Class.st Tue May 17 10:05:14 2016 +0100
+++ b/Class.st Thu May 19 07:07:52 2016 +0200
@@ -1,3 +1,5 @@
+"{ Encoding: utf8 }"
+
"
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
@@ -1986,7 +1988,7 @@
are used so this code should work
"
-
+ AbstractSourceCodeManager isNil ifTrue:[^ nil]. "/ SCM package not yet loaded.
revision isNil ifTrue:[^self sourceCodeManager].
--- a/ExternalStream.st Tue May 17 10:05:14 2016 +0100
+++ b/ExternalStream.st Thu May 19 07:07:52 2016 +0200
@@ -2472,17 +2472,17 @@
errorHolder := OperatingSystem errorHolderForNumber:errorNumber.
exClass := (errorHolder errorCategory == #nonexistentSignal)
- ifTrue:[ FileDoesNotExistException ]
- ifFalse:[ OpenError ].
+ ifTrue:[ FileDoesNotExistException ]
+ ifFalse:[ OpenError ].
^ exClass newException
- errorCode:errorNumber;
- osErrorHolder:errorHolder;
- "/ cg: initialized lazyly - see OpenError>>#description
- "/ errorString:(' : ' , errorHolder errorString);
- parameter:self;
- raiseRequest
- "/ in:thisContext sender
+ errorCode:errorNumber;
+ osErrorHolder:errorHolder;
+ "/ cg: initialized lazily - see OpenError>>#description
+ "/ errorString:(' : ' , errorHolder errorString);
+ parameter:self;
+ raiseRequest
+ "/ in:thisContext sender
"Modified: / 09-09-2011 / 07:22:49 / cg"
!
--- a/Integer.st Tue May 17 10:05:14 2016 +0100
+++ b/Integer.st Thu May 19 07:07:52 2016 +0200
@@ -1443,6 +1443,7 @@
! !
+
!Integer methodsFor:'bcd conversion'!
decodeFromBCD
@@ -1714,7 +1715,6 @@
bitShift "{ Class: SmallInteger }"
revShift "{ Class: SmallInteger }"
digitShift "{ Class: SmallInteger }"
- n "{ Class: SmallInteger }"
nn "{ Class: SmallInteger }"
nDigits "{ Class: SmallInteger }" |
@@ -1725,17 +1725,17 @@
shiftCount > 0 ifTrue:[
"left shift"
+ nDigits := self digitLength.
digitShift := shiftCount // 8.
bitShift := shiftCount \\ 8.
- n := self digitLength.
"
modulo 8 shifts can be done faster ...
"
bitShift == 0 ifTrue:[
- n := n + digitShift.
- result := self class basicNew numberOfDigits:n sign:self sign.
- result digitBytes replaceFrom:(digitShift + 1) to:n with:self digitBytes.
+ nn := nDigits + digitShift.
+ result := self class basicNew numberOfDigits:nn sign:self sign.
+ result digitBytes replaceFrom:(digitShift + 1) to:nn with:self digitBytes.
"
no normalize needed, since receiver was already normalized
"
@@ -1746,10 +1746,10 @@
less-than-8 shifts can be done faster ...
"
digitShift == 0 ifTrue:[
- nn := n+1.
+ nn := nDigits+1.
result := self class basicNew numberOfDigits:nn sign:self sign.
prev := 0.
- 1 to:n do:[:index |
+ 1 to:nDigits do:[:index |
byte := self digitAt:index.
byte := (byte bitShift:bitShift) bitOr:prev.
result digitAt:index put:(byte bitAnd:16rFF).
@@ -1768,13 +1768,12 @@
"
slow case ...
"
- n := n + digitShift + 1.
- result := self class basicNew numberOfDigits:n sign:self sign.
+ nn := nDigits + digitShift + 1.
+ result := self class basicNew numberOfDigits:nn sign:self sign.
byte := self digitAt:1.
byte := (byte bitShift:bitShift) bitAnd:16rFF.
result digitAt:(digitShift + 1) put:byte.
revShift := -8 + bitShift.
- nDigits := self digitLength.
2 to:nDigits do:[:index |
byte := self digitAt:index.
byte2 := self digitAt:index-1.
@@ -1798,11 +1797,11 @@
shiftCount < 0 ifTrue:[
"right shift"
+ nDigits := self digitLength.
digitShift := shiftCount negated // 8.
bitShift := shiftCount negated \\ 8.
- n := self digitLength.
-
- digitShift >= n ifTrue:[
+
+ digitShift >= nDigits ifTrue:[
^ 0
].
@@ -1810,10 +1809,10 @@
modulo 8 shifts can be done faster ...
"
bitShift == 0 ifTrue:[
- n := n-digitShift.
- result := self class basicNew numberOfDigits:n sign:self sign.
- result digitBytes replaceFrom:1 to:n with:self digitBytes startingAt:(digitShift + 1) .
- n <= SmallInteger maxBytes ifTrue:[
+ nn := nDigits-digitShift.
+ result := self class basicNew numberOfDigits:nn sign:self sign.
+ result digitBytes replaceFrom:1 to:nn with:self digitBytes startingAt:(digitShift + 1) .
+ nn <= SmallInteger maxBytes ifTrue:[
^ result compressed
].
^ result
@@ -1823,11 +1822,11 @@
less-than-8 shifts can be done faster ...
"
digitShift == 0 ifTrue:[
- result := self class basicNew numberOfDigits:n sign:self sign.
+ result := self class basicNew numberOfDigits:nDigits sign:self sign.
prev := 0.
bitShift := bitShift negated.
revShift := 8 + bitShift.
- n to:1 by:-1 do:[:index |
+ nDigits to:1 by:-1 do:[:index |
byte := self digitAt:index.
next := (byte bitShift:revShift) bitAnd:16rFF.
byte := (byte bitShift:bitShift) bitOr:prev.
@@ -1840,14 +1839,14 @@
"
slow case ...
"
- nn := n-digitShift.
+ nn := nDigits-digitShift.
result := self class basicNew numberOfDigits:nn sign:self sign.
prev := 0.
bitShift := bitShift negated.
revShift := 8 + bitShift.
nn := digitShift + 1.
- n to:nn by:-1 do:[:index |
+ nDigits to:nn by:-1 do:[:index |
byte := self digitAt:index.
next := (byte bitShift:revShift) bitAnd:16rFF.
byte := (byte bitShift:bitShift) bitOr:prev.
@@ -3873,7 +3872,7 @@
the receiver raised to exp (an Integer) and mod (another Integer)"
|result m t
-"/ eI "{Class: SmallInteger}"
+ eI "{Class: SmallInteger}"
bits "{Class: SmallInteger}"|
"use the addition chaining algorithm"
@@ -3900,18 +3899,19 @@
result := 1.
t := m modulusOf:self.
- "/ to be validated ...
-"/ (exp class == SmallInteger) ifTrue:[
-"/ eI := exp.
-"/ [eI ~~ 0] whileTrue:[
-"/ (eI bitAnd:1) == 1 ifTrue:[
-"/ result := m modulusOf:(result * t).
-"/ ].
-"/ t := m modulusOf:(t * t).
-"/ eI := eI bitShift:-1.
-"/ ].
-"/ ^ result.
-"/ ].
+ (exp class == SmallInteger) ifTrue:[
+ eI := exp.
+ [eI ~~ 0] whileTrue:[
+ (eI bitAnd:1) == 1 ifTrue:[
+ result := m modulusOf:(result * t).
+ ].
+ eI := eI bitShift:-1.
+ eI ~~ 0 ifTrue:[
+ t := m modulusOf:(t * t).
+ ].
+ ].
+ ^ result.
+ ].
bits := exp highBit.
@@ -3931,12 +3931,12 @@
(20000000000000 raisedTo:200) \\ 190
Time millisecondsToRun:[10000 timesRepeat:[
- 20000000000000 raisedTo:200 mod:190
+ 200000000000000000000000 raisedTo:65537 mod:1900000000000000000000000
]
]
Time millisecondsToRun:[1000 timesRepeat:[
- (20000000000000 raisedTo:200) \\ 190
+ (200000000000000000000000 raisedTo:65537) \\ 1900000000000000000000000
]
]
"
@@ -3994,12 +3994,10 @@
|result t mp mq|
mp := p asModuloNumber.
- t := mp modulusOf:self.
- result := t raisedTo:ep mod:mp.
+ result := self raisedTo:ep mod:mp.
mq := q asModuloNumber.
- t := mq modulusOf:self.
- t := t raisedTo:eq mod:mq.
+ t := self raisedTo:eq mod:mq.
"now p2 is in result, q2 in t"
@@ -5523,6 +5521,9 @@
] ifFalse:[
abs := dividend.
].
+ abs < modulus ifTrue:[
+ ^ abs.
+ ].
"/ self assert:dividend < (modulus * modulus)
--- a/LargeInteger.st Tue May 17 10:05:14 2016 +0100
+++ b/LargeInteger.st Thu May 19 07:07:52 2016 +0200
@@ -1,5 +1,3 @@
-"{ Encoding: utf8 }"
-
"
COPYRIGHT (c) 1994 by Claus Gittinger
All Rights Reserved
@@ -317,6 +315,8 @@
"Modified: / 8.5.1998 / 21:40:41 / cg"
! !
+
+
!LargeInteger class methodsFor:'queries'!
isBuiltInClass
@@ -2441,8 +2441,8 @@
: "=a" (__pLow),
"=d" (__pHi)
: "0" (__digit),
- "1" ((unsigned long)(_v)),
- "rm" ((unsigned long)(_carry)) );
+ "1" (ASM_ULONGCAST(_v)),
+ "rm" (ASM_ULONGCAST(_carry)) );
((unsigned long *)resultP)[0] = __pLow;
_carry = __pHi;
@@ -3625,10 +3625,10 @@
adcl $0, %%eax \n\
movl $0, %%edx \n\
adcl $0, %%edx"
- : "=d" ((unsigned long)(__carry)),
- "=c" ((unsigned long)(__sum)),
- "=a" ((unsigned long)(__sum2))
- : "0" ((unsigned long)(__carry)),
+ : "=d" (ASM_ULONGCAST(__carry)),
+ "=c" (ASM_ULONGCAST(__sum)),
+ "=a" (ASM_ULONGCAST(__sum2))
+ : "0" (ASM_ULONGCAST(__carry)),
"1" (__digit1),
"2" (__digit2));
@@ -3662,9 +3662,9 @@
asm ("addl %%eax,%%edx \n\
movl $0,%%eax \n\
adcl $0,%%eax"
- : "=a" ((unsigned long)(__carry)),
- "=d" ((unsigned long)(__sum))
- : "0" ((unsigned long)(__carry)),
+ : "=a" (ASM_ULONGCAST(__carry)),
+ "=d" (ASM_ULONGCAST(__sum))
+ : "0" (ASM_ULONGCAST(__carry)),
"1" (__digit) );
((unsigned int *)(__src + __ptrDelta))[0] = __sum;
@@ -4418,7 +4418,7 @@
len2 := otherDigitByteArray size.
lenRslt := len1 + len2.
UseKarazuba ~~ false ifTrue:[
- lenRslt > 400 ifTrue:[ ^ self absMulKarazuba:aLargeInteger ].
+ lenRslt > 400 ifTrue:[ ^ self absMulKarazuba:aLargeInteger ].
].
result := self class basicNew numberOfDigits:lenRslt.
@@ -4427,297 +4427,199 @@
%{
if (__isByteArray(__INST(digitByteArray))
&& __isByteArray(otherDigitByteArray)
- && __isByteArray(resultDigitByteArray)
- && __bothSmallInteger(len1, len2)) {
- unsigned char *myBytes = __ByteArrayInstPtr(__INST(digitByteArray))->ba_element;
- unsigned char *otherBytes = __ByteArrayInstPtr(otherDigitByteArray)->ba_element;
- unsigned char *resultBytes = __ByteArrayInstPtr(resultDigitByteArray)->ba_element;
- unsigned char *_p1, *_pResult0, *_p1Last, *_p2Last, *_pResultLast;
- unsigned char *_pResultLastShort, *_pResultLastInt;
- unsigned INT _v;
- int _len1 = __intVal(len1);
- int _len2 = __intVal(len2);
-
- _p1Last = myBytes + _len1 - 1; /* the last byte */
- _p2Last = otherBytes + _len2 - 1; /* the last byte */
- _pResult0 = resultBytes;
- _pResultLast = resultBytes + _len1 + _len2 - 1; /* the last byte */
-
- /*
- * aaa...aaa f1[0] * f2
- * bbb...bbb f1[1] * f2
- * ccc...ccc f1[2] * f2
- * ...
- * xxx...xxx f1[high] * f2
- *
- * start short-wise
- * bounds: (16rFFFF * 16rFFFF) + 16rFFFF -> FFFF0000
- */
- _p1 = myBytes;
+ && __isByteArray(resultDigitByteArray)) {
+ unsigned char *myBytes = __ByteArrayInstPtr(__INST(digitByteArray))->ba_element;
+ unsigned char *otherBytes = __ByteArrayInstPtr(otherDigitByteArray)->ba_element;
+ unsigned char *resultBytes = __ByteArrayInstPtr(resultDigitByteArray)->ba_element;
+ unsigned char *_p1, *_pResult0, *_p1Last, *_p2Last;
+ unsigned INT _v;
+ int _len1 = __intVal(len1);
+ int _len2 = __intVal(len2);
+
+ _p1Last = myBytes + _len1 - 1; /* the last byte */
+ _p2Last = otherBytes + _len2 - 1; /* the last byte */
+ _pResult0 = resultBytes;
+
+ /*
+ * aaa...aaa f1[0] * f2
+ * + bbb...bbb f1[1] * f2
+ * + ccc...ccc f1[2] * f2
+ * + ...
+ * + xxx...xxx f1[high] * f2
+ *
+ * start short-wise
+ * bounds: (16rFFFF * 16rFFFF) + 16rFFFF -> FFFF0000
+ */
+ _p1 = myBytes;
#if defined(__LSBFIRST__) && (__POINTER_SIZE__ == 8)
- _pResultLastInt = _pResultLast - 3; /* the last int */
-
- /* loop over ints of f1 */
- for (; _p1 <= (_p1Last-3); _p1 += 4, _pResult0 += 4) {
- unsigned char *_pResult, *_p2;
- unsigned INT word1 = ((unsigned int *)_p1)[0];
-
- _pResult = _pResult0;
- _p2 = otherBytes;
-
- /* loop over ints of f2 */
- while (_p2 <= (_p2Last-3)) {
- _v = (word1 * (unsigned INT)(((unsigned int *)_p2)[0])) + ((unsigned INT)((unsigned int *)_pResult)[0]);
- ((unsigned int *)_pResult)[0] = _v /* & 0xFFFFFFFF */;
- _v >>= 32; /* now _v contains the carry*/
- _pResult += 4;
- if (_v) {
- unsigned char *_pResult1;
-
- /* distribute carry - int-wise, then byte-wise */
- for (_pResult1 = _pResult; _v; _pResult1 += 4) {
- if (_pResult1 > _pResultLastInt) break;
- _v += (unsigned INT)(((unsigned int *)_pResult1)[0]);
- ((unsigned int *)_pResult1)[0] = _v /* & 0xFFFFFFFF */;
- _v >>= 32;
- }
- for (; _v; _pResult1++) {
- _v += _pResult1[0];
- _pResult1[0] = _v /* & 0xFF */;
- _v >>= 8;
- }
- }
- _p2 += 4;
- }
-
- /* possible odd highByte of f2 */
- while (_p2 <= _p2Last) {
- _v = (word1 * (unsigned INT)(((unsigned char *)_p2)[0]))
- + (unsigned INT)(((unsigned char *)_pResult)[0]);
-
- ((unsigned char *)_pResult)[0] = _v /* & 0xFFFFFFFF */;
- _v >>= 8; /* now _v contains the carry*/
- _pResult++;
- if (_v) {
- unsigned char *_pResult1 = _pResult;
-
- /* distribute carry byte-wise */
- for (; _v; _pResult1++) {
- _v += _pResult1[0];
- _pResult1[0] = _v /* & 0xFF */;
- _v >>= 8;
- }
- }
- _p2++;
- }
- }
+ /* loop over ints of f1 */
+ for (; _p1 <= (_p1Last-3); _p1 += 4, _pResult0 += 4) {
+ unsigned char *_pResult = _pResult0;
+ unsigned char *_p2;
+ unsigned INT word1 = ((unsigned int *)_p1)[0];
+
+ _v = 0;
+
+ /* loop over ints of f2 */
+ for (_p2 = otherBytes; _p2 <= (_p2Last-3); _p2 += 4) {
+ _v = word1 * (unsigned INT)(((unsigned int *)_p2)[0])
+ + _v + (unsigned INT)((unsigned int *)_pResult)[0];
+ ((unsigned int *)_pResult)[0] = _v /* & 0xFFFFFFFF */;
+ _v >>= 32; /* now _v contains the carry*/
+ _pResult += 4;
+ }
+
+ /* possible odd up to 3 highBytes of f2 */
+ for ( ; _p2 <= _p2Last; _p2++) {
+ _v = word1 * (unsigned INT)(_p2[0])
+ + _v + (unsigned INT)(_pResult[0]);
+
+ ((unsigned char *)_pResult)[0] = _v /* & 0xFFFFFFFF */;
+ _v >>= 8; /* now _v contains the carry*/
+ _pResult++;
+ }
+ /* distribute leftover carry byte-wise */
+ for ( ; _v; _v >>= 8, _pResult++) {
+ _v += _pResult[0];
+ _pResult[0] = _v /* & 0xFF */;
+ }
+ }
#endif /* 64bit */
- /* possible odd high short of f1 (or shortLoop, if not 64bit) */
- _pResultLastShort = _pResultLast - 1; /* the last short */
-
- for (; _p1 < _p1Last; _p1 += 2, _pResult0 += 2) {
- unsigned char *_pResult, *_p2;
- unsigned int short1 = ((unsigned short *)_p1)[0];
+ /* possible odd high short of f1 (or shortLoop, if not 64bit) */
+
+ for (; _p1 < _p1Last; _p1 += 2, _pResult0 += 2) {
+ unsigned char *_pResult = _pResult0;
+ unsigned char *_p2 = otherBytes;
+ unsigned int short1 = ((unsigned short *)_p1)[0];
#if !defined(__LSBFIRST__)
- short1 = ((short1 >> 8) & 0xFF) | ((short1 & 0xFF) << 8);
-#endif
- _pResult = _pResult0;
- _p2 = otherBytes;
-
- /* loop over shorts of f2 */
- while (_p2 < _p2Last) {
-#if !defined(__LSBFIRST__)
- unsigned int _short2;
- unsigned int _short3;
-
- _short2 = ((unsigned short *)_p2)[0];
- _short2 = ((_short2 >> 8) /* & 0xFF */) | ((_short2 & 0xFF) << 8);
- _short3 = ((unsigned short *)_pResult)[0];
- _short3 = ((_short3 >> 8) /* & 0xFF */) | ((_short3 & 0xFF) << 8);
- _v = (short1 * _short2) + _short3;
- _pResult[0] = _v;
- _pResult[1] = _v >> 8;
-#else /* __LSBFIRST__ */
- _v = (short1 * ((unsigned short *)_p2)[0]) + ((unsigned short *)_pResult)[0];
- ((unsigned short *)_pResult)[0] = _v /* & 0xFFFF */;
-#endif
- _v >>= 16; /* now _v contains the carry*/
- _pResult += 2;
- if (_v) {
- unsigned char *_pResult1;
-
- /* distribute carry - short-wise, then byte-wise */
- _pResult1 = _pResult;
-#if defined(__LSBFIRST__)
- for (; _v; _pResult1 += 2) {
- if (_pResult1 > _pResultLastShort) break;
- _v += ((unsigned short *)_pResult1)[0];
- ((unsigned short *)_pResult1)[0] = _v /* & 0xFFFF */;
- _v >>= 16;
- }
-#endif
- for (; _v; _pResult1++) {
- _v += _pResult1[0];
- _pResult1[0] = _v /* & 0xFF */;
- _v >>= 8;
- }
- }
- _p2 += 2;
- }
-
- /* possible odd highByte of f2 */
- if (_p2 <= _p2Last) {
-#if !defined(__LSBFIRST__)
- unsigned int _short3;
-
- _short3 = ((unsigned short *)_pResult)[0];
- _short3 = ((_short3 >> 8) /* & 0xFF */) | ((_short3 & 0xFF) << 8);
- _v = (short1 * _p2[0]) + _short3;
- _pResult[0] = _v;
- _pResult[1] = _v >> 8;
-#else /* __LSBFIRST__ */
- _v = (short1 * _p2[0]) + ((unsigned short *)_pResult)[0];
- ((unsigned short *)_pResult)[0] = _v /* & 0xFFFF */;
-#endif
- _v >>= 16; /* now _v contains the carry*/
- _pResult += 2;
- if (_v) {
- unsigned char *_pResult1;
-
- /* distribute carry - short-wise, then byte-wise */
- _pResult1 = _pResult;
-#if defined(__LSBFIRST__)
- for (; _v; _pResult1 += 2) {
- if (_pResult1 > _pResultLastShort) break;
- _v += ((unsigned short *)_pResult1)[0];
- ((unsigned short *)_pResult1)[0] = _v /* & 0xFFFF */;
- _v >>= 16;
- }
+ short1 = ((short1 >> 8) & 0xFF) | ((short1 & 0xFF) << 8);
#endif
- for (; _v; _pResult1++) {
- _v += _pResult1[0];
- _pResult1[0] = _v /* & 0xFF */;
- _v >>= 8;
- }
- }
- _p2++;
- }
- }
-
- /* possible odd highByte of f1 (or byteLoop, if above is ever disabled) */
- for (; _p1 <= _p1Last; _p1++, _pResult0++) {
- unsigned char *_pResult, *_p2;
- unsigned int byte1 = _p1[0];
-
- _pResult = _pResult0;
- _p2 = otherBytes;
-
- /* loop over shorts of f2 */
- while (_p2 < _p2Last) {
+ _v = 0;
+
+ /* loop over shorts of f2 */
+ for ( ; _p2 < _p2Last; _p2 += 2, _pResult += 2) {
#if !defined(__LSBFIRST__)
- unsigned int _short2;
- unsigned int _short3;
-
- _short2 = ((unsigned short *)_p2)[0];
- _short2 = ((_short2 >> 8) /* & 0xFF */) | ((_short2 & 0xFF) << 8);
- _short3 = ((unsigned short *)_pResult)[0];
- _short3 = ((_short3 >> 8) /* & 0xFF */) | ((_short3 & 0xFF) << 8);
- _v = (byte1 * _short2) + _short3;
- _pResult[0] = _v;
- _pResult[1] = _v >> 8;
+ unsigned int _short2 = ((unsigned short *)_p2)[0];
+ unsigned int _short3 = ((unsigned short *)_pResult)[0];
+
+ _short2 = ((_short2 >> 8) /* & 0xFF */) | ((_short2 & 0xFF) << 8);
+ _short3 = ((_short3 >> 8) /* & 0xFF */) | ((_short3 & 0xFF) << 8);
+ _v = (short1 * _short2) + _short3 + _v;
+ _pResult[0] = _v;
+ _pResult[1] = _v >> 8;
+#else /* __LSBFIRST__ */
+ _v = (short1 * ((unsigned short *)_p2)[0]) + _v + ((unsigned short *)_pResult)[0];
+ ((unsigned short *)_pResult)[0] = _v /* & 0xFFFF */;
+#endif /* __LSBFIRST__ */
+ _v >>= 16; /* now _v contains the carry*/
+ }
+
+ /* possible odd highByte of f2 */
+ for ( ; _p2 <= _p2Last; _p2++, _pResult += 2) {
+#if !defined(__LSBFIRST__)
+ unsigned int _short3 = ((unsigned short *)_pResult)[0];
+
+ _short3 = ((_short3 >> 8) /* & 0xFF */) | ((_short3 & 0xFF) << 8);
+ _v = (short1 * _p2[0]) + _v + _short3;
+ _pResult[0] = _v;
+ _pResult[1] = _v >> 8;
#else /* __LSBFIRST__ */
- _v = (byte1 * ((unsigned short *)_p2)[0]) + ((unsigned short *)_pResult)[0];
- ((unsigned short *)_pResult)[0] = _v /* & 0xFFFF */;
-#endif
- _v >>= 16; /* now _v contains the carry*/
- _pResult += 2;
- if (_v) {
- unsigned char *_pResult1;
-
- /* distribute carry - short-wise, then byte-wise */
- _pResult1 = _pResult;
-#if defined(__LSBFIRST__)
- for (_pResult1 = _pResult; _v; _pResult1 += 2) {
- if (_pResult1 > _pResultLastShort) break;
- _v += ((unsigned short *)_pResult1)[0];
- ((unsigned short *)_pResult1)[0] = _v /* & 0xFFFF */;
- _v >>= 16;
- }
+ _v = (short1 * _p2[0]) + _v + ((unsigned short *)_pResult)[0];
+ ((unsigned short *)_pResult)[0] = _v /* & 0xFFFF */;
#endif /* __LSBFIRST__ */
- for (; _v; _pResult1++) {
- _v += _pResult1[0];
- _pResult1[0] = _v /* & 0xFF */;
- _v >>= 8;
- }
- }
- _p2 += 2;
- }
-
- /* possible odd highByte of f2 (or byteLoop, if not __LSBFIRST__) */
- while (_p2 <= _p2Last) {
- _v = (byte1 * _p2[0]) + _pResult[0];
- _pResult[0] = _v /* & 0xFF */;
- _v >>= 8; /* now _v contains the carry*/
- _pResult++;
- if (_v) {
- unsigned char *_pResult1;
-
- /* distribute carry */
- for (_pResult1 = _pResult; _v; _pResult1++) {
- _v += _pResult1[0];
- _pResult1[0] = _v /* & 0xFF */;
- _v >>= 8;
- }
- }
- _p2++;
- }
- }
- ok = true;
+ _v >>= 16; /* now _v contains the carry*/
+ }
+ /* distribute leftover carry byte-wise */
+ for ( ; _v; _v >>= 8, _pResult++) {
+ _v += _pResult[0];
+ _pResult[0] = _v /* & 0xFF */;
+ }
+ }
+
+ /* possible odd highByte of f1 (or byteLoop, if above is ever disabled) */
+ for (; _p1 <= _p1Last; _p1++, _pResult0++) {
+ unsigned char *_pResult = _pResult0;
+ unsigned char *_p2 = otherBytes;
+ unsigned int byte1 = _p1[0];
+
+ _v = 0;
+
+ /* loop over shorts of f2 */
+ for ( ; _p2 < _p2Last; _p2 += 2, _pResult += 2) {
+#if !defined(__LSBFIRST__)
+ unsigned int _short2 = ((unsigned short *)_p2)[0];
+ unsigned int _short3 = ((unsigned short *)_pResult)[0];
+
+ _short2 = ((_short2 >> 8) /* & 0xFF */) | ((_short2 & 0xFF) << 8);
+ _short3 = ((_short3 >> 8) /* & 0xFF */) | ((_short3 & 0xFF) << 8);
+ _v = (byte1 * _short2) + _v +_short3;
+ _pResult[0] = _v;
+ _pResult[1] = _v >> 8;
+#else /* __LSBFIRST__ */
+ _v = (byte1 * ((unsigned short *)_p2)[0]) + _v + ((unsigned short *)_pResult)[0];
+ ((unsigned short *)_pResult)[0] = _v /* & 0xFFFF */;
+#endif /* __LSBFIRST__ */
+ _v >>= 16; /* now _v contains the carry*/
+ }
+
+ /* possible odd highByte of f2 (or byteLoop, if not __LSBFIRST__) */
+ for ( ; _p2 <= _p2Last; _p2++, _pResult++) {
+ _v = (byte1 * _p2[0]) + _v + _pResult[0];
+ _pResult[0] = _v /* & 0xFF */;
+ _v >>= 8; /* now _v contains the carry*/
+ }
+ /* distribute leftover carry byte-wise */
+ for ( ; _v; _v >>= 8, _pResult++) {
+ _v += _pResult[0];
+ _pResult[0] = _v /* & 0xFF */;
+ }
+ }
+ ok = true;
}
%}.
ok ifFalse:[
- 1 to:len1 do:[:index1 |
- 1 to:len2 do:[:index2 |
- dstIndex := index1 + index2 - 1.
- prod := (digitByteArray basicAt:index1) * (otherDigitByteArray basicAt:index2).
- prod := prod + (resultDigitByteArray basicAt:dstIndex).
- resultDigitByteArray basicAt:dstIndex put:(prod bitAnd:16rFF).
- carry := prod bitShift:-8.
- carry ~~ 0 ifTrue:[
- idx := dstIndex + 1.
- [carry ~~ 0] whileTrue:[
- v := (resultDigitByteArray basicAt:idx) + carry.
- resultDigitByteArray basicAt:idx put:(v bitAnd:255).
- carry := v bitShift:-8.
- idx := idx + 1
- ]
- ]
- ]
- ].
+ 1 to:len1 do:[:index1 |
+ 1 to:len2 do:[:index2 |
+ dstIndex := index1 + index2 - 1.
+ prod := (digitByteArray basicAt:index1) * (otherDigitByteArray basicAt:index2).
+ prod := prod + (resultDigitByteArray basicAt:dstIndex).
+ resultDigitByteArray basicAt:dstIndex put:(prod bitAnd:16rFF).
+ carry := prod bitShift:-8.
+ carry ~~ 0 ifTrue:[
+ idx := dstIndex + 1.
+ [carry ~~ 0] whileTrue:[
+ v := (resultDigitByteArray basicAt:idx) + carry.
+ resultDigitByteArray basicAt:idx put:(v bitAnd:255).
+ carry := v bitShift:-8.
+ idx := idx + 1
+ ]
+ ]
+ ]
+ ].
].
^ result compressed
!
absMulKarazuba:aLargeInteger
"return a LargeInteger representing abs(self) * abs(theArgument) using the karazuba algorithm.
- a = (2^n * p) + q
- b = (2^n * r) + s
- a * b = ((2^n * p) + q) * ((2^n * r) + s)
- = 2^(n+n)*p*r + 2^n*p*s + 2^n*q*r + q*s
- = 2^(n+n)*p*r + (p*r + q*s - (q-p)*(s-r))*2^n + q*s
-
- this is faster for sufficient large n1,n2
- because regular multiplication is O(n1*n2) and karazuma multiplies much smaller numbers
- (half number of bits) but does more multiplations (on smaller numbers) and req's more
- additions and subtractions (on smaller numbers).
- The break-even for when to use regular multiplication has been determined heuristically
- and is somewhere around 1600 bits (digitLength of 200).
- (see test in absMul:)
-
- To disable karazuba, set UseKarazuba to false.
+ a = (2^n * p) + q
+ b = (2^n * r) + s
+ a * b = ((2^n * p) + q) * ((2^n * r) + s)
+ = 2^(n+n)*p*r + 2^n*p*s + 2^n*q*r + q*s
+ = 2^(n+n)*p*r + (p*r + q*s - (q-p)*(s-r))*2^n + q*s
+
+ this is faster for sufficient large n1,n2
+ because regular multiplication is O(n1*n2) and karazuma multiplies much smaller numbers
+ (half number of bits) but does more multiplications (on smaller numbers) and req's more
+ additions and subtractions (on smaller numbers).
+ The break-even for when to use regular multiplication has been determined heuristically
+ and is somewhere around 1600 bits (digitLength of 200).
+ (see test in absMul:)
+
+ To disable karazuba, set UseKarazuba to false.
"
"/ compute half-sized pi and qi...
@@ -4751,12 +4653,12 @@
"
#(100 500 1000 2500 5000 10000 25000 50000 100000 250000 500000 1000000) do:[:exp |
- |nr r1 r2|
- nr := (3 raisedTo:exp) asInteger.
- Transcript show:exp; show:' nbytes: '; showCR:nr digitLength;
- show:' normal: '; show:(Time microsecondsToRun:[ UseKarazuba := false. r1 := nr * nr ]); showCR:'us';
- show:' karazuba: '; show:(Time microsecondsToRun:[ UseKarazuba := true. r2 := nr absMulKarazuba: nr]); showCR:'us'.
- self assert:(r1 = r2).
+ |nr r1 r2|
+ nr := (3 raisedTo:exp) asInteger.
+ Transcript show:exp; show:' nbytes: '; showCR:nr digitLength;
+ show:' normal: '; show:(Time microsecondsToRun:[ UseKarazuba := false. r1 := nr * nr ]); showCR:'us';
+ show:' karazuba: '; show:(Time microsecondsToRun:[ UseKarazuba := true. r2 := nr absMulKarazuba: nr]); showCR:'us'.
+ self assert:(r1 = r2).
]
"
!
@@ -5710,4 +5612,3 @@
version_CVS
^ '$Header$'
! !
-
--- a/Method.st Tue May 17 10:05:14 2016 +0100
+++ b/Method.st Thu May 19 07:07:52 2016 +0200
@@ -995,8 +995,8 @@
self setAnnotations: anObject.
"/ "iterate over annotations just to invoke
-"/ annotationAtIndex: which lazyliyinitialize annotations
-"/ and send #annotatesMethod:"
+"/ annotationAtIndex: which lazily initializes annotations
+"/ and sends #annotatesMethod:"
"/ self annotationsDo:[:annotation|]
"Created: / 02-07-2010 / 22:38:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
@@ -1057,6 +1057,7 @@
"Modified (format): / 18-11-2011 / 14:47:06 / cg"
! !
+
!Method methodsFor:'accessing-visibility'!
isIgnored
@@ -3724,6 +3725,7 @@
"Created: / 23-07-2012 / 11:16:36 / cg"
! !
+
!Method methodsFor:'source management'!
revisionInfo
--- a/OrderedCollection.st Tue May 17 10:05:14 2016 +0100
+++ b/OrderedCollection.st Thu May 19 07:07:52 2016 +0200
@@ -324,6 +324,7 @@
! !
+
!OrderedCollection methodsFor:'accessing'!
at:anInteger
@@ -751,18 +752,21 @@
|removed element
srcIndex "{ Class: SmallInteger }"
- dstIndex "{ Class: SmallInteger }"|
+ dstIndex "{ Class: SmallInteger }"
+ lastIdx "{ Class: SmallInteger }"|
"/ first search forward to the first element which has
"/ to be removed (meets the criteria)
srcIndex := firstIndex.
+ lastIdx := lastIndex.
+
[
- srcIndex > lastIndex
+ srcIndex > lastIdx
or:[ aBlock value:(contentsArray at:srcIndex) ]
] whileFalse:[
srcIndex := srcIndex + 1.
].
- srcIndex > lastIndex ifTrue:[
+ srcIndex > lastIdx ifTrue:[
"/ nothing removed
^ #()
].
@@ -774,9 +778,8 @@
dstIndex := srcIndex.
srcIndex := srcIndex + 1.
- [ srcIndex <= lastIndex ] whileTrue:[
- element := contentsArray at:srcIndex.
- srcIndex := srcIndex + 1.
+ srcIndex to:lastIdx do:[:idx|
+ element := contentsArray at:idx.
(aBlock value:element) ifTrue:[
removed add:element
] ifFalse:[
@@ -784,7 +787,7 @@
dstIndex := dstIndex + 1.
].
].
- contentsArray from:dstIndex to:lastIndex put:nil.
+ contentsArray from:dstIndex to:lastIdx put:nil.
lastIndex := dstIndex - 1.
^ removed
--- a/Set.st Tue May 17 10:05:14 2016 +0100
+++ b/Set.st Thu May 19 07:07:52 2016 +0200
@@ -813,7 +813,6 @@
! !
-
!Set methodsFor:'obsolete set operations'!
+ aCollection
@@ -1239,7 +1238,6 @@
^ tally
! !
-
!Set methodsFor:'searching'!
findFirst:aBlock ifNone:exceptionValue
@@ -1266,6 +1264,7 @@
includes:anObject
"return true if the argument anObject is in the receiver"
+ tally == 0 ifTrue:[^ false]. "/ quick reject if empty
^ (self find:(anObject ? NilEntry) ifAbsent:0) ~~ 0
!
@@ -1302,6 +1301,7 @@
"return the number of occurrences of anObject in the receiver.
As I am a Set, this can only return 0 or 1."
+ tally == 0 ifTrue:[^ 0].
(self find:(anObject ? NilEntry) ifAbsent:0) == 0 ifTrue:[^ 0].
^ 1
--- a/Smalltalk.st Tue May 17 10:05:14 2016 +0100
+++ b/Smalltalk.st Thu May 19 07:07:52 2016 +0200
@@ -6094,16 +6094,16 @@
finally source file (.st), in that order.
The file is first searched for using the class name, then the abbreviated name.
The argument doInit controlls if the class should be sent a #initialize after the
- load; loadLazy tells if it should be loaded lazyly. beSilent tells if the compiler
+ load; loadLazy tells if it should be loaded lazily. beSilent tells if the compiler
should not send notes to the transcript; it can be true, false or nil, where
nil uses the value from SilentLoading."
^ self
- fileInClass:aClassName
- package:nil
- initialize:doInit
- lazy:loadLazy
- silent:beSilent
+ fileInClass:aClassName
+ package:nil
+ initialize:doInit
+ lazy:loadLazy
+ silent:beSilent
"Modified: / 9.1.1998 / 14:42:28 / cg"
!
@@ -6131,7 +6131,7 @@
finally source file (.st), in that order.
The file is first searched for using the class name, then the abbreviated name.
The argument doInit controlls if the class should be sent a #initialize after the
- load; loadLazy tells if it should be loaded lazyly. beSilent tells if the compiler
+ load; loadLazy tells if it should be loaded lazily. beSilent tells if the compiler
should not send notes to the transcript; it can be true, false or nil, where
nil uses the value from SilentLoading."
@@ -6140,315 +6140,315 @@
ClassLoadInProgressQuery answerNotifyLoading:aClassName do:[
- wasLazy := Compiler compileLazy:loadLazy.
- beSilent notNil ifTrue:[
- wasSilent := self silentLoading:beSilent.
- ].
-
- classFileName := Smalltalk fileNameForClass:aClassName.
- (classFileName = aClassName) ifTrue:[
- "/ no abbrev.stc translation for className
- (aClassName includes:$:) ifTrue:[
- "/ a nameSpace name
- alternativeClassFileName := classFileName copyFrom:(classFileName lastIndexOf:$:)+1
- ].
- ].
-
- classFileName asFilename isAbsolute ifTrue:[
- classFileName asFilename suffix notEmptyOrNil ifTrue:[
- ok := self fileIn:classFileName lazy:loadLazy silent:beSilent.
- ] ifFalse:[
- ok := self fileInSourceFile:classFileName lazy:loadLazy silent:beSilent.
- ]
- ] ifFalse:[
- classFileName := classFileName copyReplaceAll:$: with:$_ ifNone:classFileName.
- [
- Class withoutUpdatingChangesDo:[
- |zarFn zar entry|
-
- ok := false.
-
- package notNil ifTrue:[
- packageDir := package asPackageId packageDirectory.
- "/ packageDir := package asString.
- "/ packageDir := packageDir copyReplaceAll:$: with:$/.
- packageDir isNil ifTrue:[
- packageDir := self packageDirectoryForPackageId:package
- ].
- packageDir notNil ifTrue:[
- packageDir := packageDir asFilename.
- ].
- ].
-
- Class packageQuerySignal answer:package do:[
- "
- then, if dynamic linking is available,
- "
- (LoadBinaries and:[ObjectFileLoader notNil]) ifTrue:[
- sharedLibExtension := ObjectFileLoader sharedLibraryExtension.
- "
- first look for a class packages shared binary in binary/xxx.o
- "
- libName := self libraryFileNameOfClass:aClassName.
- libName notNil ifTrue:[
- (ok := self fileInClass:aClassName fromObject:(libName, sharedLibExtension))
- ifFalse:[
- sharedLibExtension ~= '.o' ifTrue:[
- ok := self fileInClass:aClassName fromObject:(libName, '.o')
- ]
- ].
- ].
- "
- then, look for a shared binary in binary/xxx.o
- "
- ok ifFalse:[
- (ok := self fileInClass:aClassName fromObject:(classFileName, sharedLibExtension))
- ifFalse:[
- sharedLibExtension ~= '.o' ifTrue:[
- ok := self fileInClass:aClassName fromObject:(classFileName, '.o')
- ].
- ok ifFalse:[
- alternativeClassFileName notNil ifTrue:[
- (ok := self fileInClass:aClassName fromObject:(alternativeClassFileName, sharedLibExtension))
- ifFalse:[
- sharedLibExtension ~= '.o' ifTrue:[
- ok := self fileInClass:aClassName fromObject:(alternativeClassFileName, '.o')
- ]
- ]
- ].
- ].
- ].
- ].
- ].
-
- "
- if that did not work, look for a compiled-bytecode file ...
- "
- ok ifFalse:[
- (ok := self fileIn:(classFileName , '.cls') lazy:loadLazy silent:beSilent)
- ifFalse:[
- alternativeClassFileName notNil ifTrue:[
- ok := self fileIn:(alternativeClassFileName , '.cls') lazy:loadLazy silent:beSilent
- ]
- ]
- ].
- "
- if that did not work, and the classes package is known,
- look for an st-cls file
- in a package subdir of the source-directory ...
- "
- ok ifFalse:[
- (packageDir notNil and:[BinaryObjectStorage notNil]) ifTrue:[
- packageFile := self getPackageFileName:((packageDir / 'classes' / classFileName) addSuffix:'cls').
- packageFile isNil ifTrue:[
- packageFile := (packageDir / 'classes' / classFileName) addSuffix:'cls'.
- ].
- (ok := self fileIn:packageFile lazy:loadLazy silent:beSilent)
- ifFalse:[
- alternativeClassFileName notNil ifTrue:[
- packageFile := self getPackageFileName:((packageDir / 'classes' / alternativeClassFileName) addSuffix:'cls').
- packageFile isNil ifTrue:[
- packageFile := ((packageDir / 'classes' / alternativeClassFileName) addSuffix:'cls').
- ].
- ok := self fileIn:packageFile lazy:loadLazy silent:beSilent
- ]
- ].
-
- zarFn := self getPackageFileName:(packageDir / 'classes.zip').
- zarFn notNil ifTrue:[
- zar := ZipArchive oldFileNamed:zarFn.
- zar notNil ifTrue:[
- entry := zar extract:(classFileName , '.cls').
- (entry isNil and:[alternativeClassFileName notNil]) ifTrue:[
- entry := zar extract:(alternativeClassFileName , '.cls').
- ].
- entry notNil ifTrue:[
- bos := BinaryObjectStorage onOld:(entry asByteArray readStream).
- bos next.
- bos close.
- ok := true
- ].
- ]
- ]
- ]
- ].
-
- "
- if that did not work, look for an st-source file ...
- "
- ok ifFalse:[
- filenameToSet := classFileName.
- (ok := self fileInSourceFile:filenameToSet lazy:loadLazy silent:beSilent)
- ifFalse:[
- alternativeClassFileName notNil ifTrue:[
- filenameToSet := alternativeClassFileName.
- ok := self fileInSourceFile:filenameToSet lazy:loadLazy silent:beSilent
- ].
- ok ifFalse:[
- "
- ... and in the standard source-directory
- "
- filenameToSet := 'source' asFilename / classFileName.
- (ok := self fileInSourceFile:filenameToSet lazy:loadLazy silent:beSilent)
- ifFalse:[
- alternativeClassFileName notNil ifTrue:[
- filenameToSet := 'source' asFilename / alternativeClassFileName.
- ok := self fileInSourceFile:filenameToSet lazy:loadLazy silent:beSilent
- ]
- ]
- ]
- ].
- "
- if that did not work, and the classes package is known,
- look for an st-source file
- in a package subdir of the source-directory ...
- "
- ok ifFalse:[
- packageDir notNil ifTrue:[
- packageFile := self getPackageSourceFileName:(packageDir / 'source' / classFileName).
- packageFile isNil ifTrue:[
- packageFile := (packageDir / 'source' / classFileName).
- ].
- filenameToSet := packageFile.
- (ok := self fileInSourceFile:packageFile lazy:loadLazy silent:beSilent)
- ifFalse:[
- alternativeClassFileName notNil ifTrue:[
- packageFile := self getPackageSourceFileName:(packageDir / 'source' / alternativeClassFileName).
- packageFile isNil ifTrue:[
- packageFile := (packageDir / 'source' / alternativeClassFileName).
- ].
- filenameToSet := packageFile.
- ok := self fileInSourceFile:packageFile lazy:loadLazy silent:beSilent
- ].
- ok ifFalse:[
- packageFile := self getPackageSourceFileName:(packageDir / classFileName).
- packageFile isNil ifTrue:[
- packageFile := (packageDir / classFileName).
- ].
- filenameToSet := packageFile.
- (ok := self fileInSourceFile:packageFile lazy:loadLazy silent:beSilent)
- ifFalse:[
- alternativeClassFileName notNil ifTrue:[
- packageFile := self getPackageFileName:(packageDir / alternativeClassFileName).
- packageFile isNil ifTrue:[
- packageFile := packageDir / alternativeClassFileName.
- ].
- filenameToSet := packageFile.
- ok := self fileInSourceFile:packageFile lazy:loadLazy silent:beSilent
- ].
- ok ifFalse:[
- "
- ... and in the standard source-directory
- "
- filenameToSet := 'source' asFilename / packageDir / classFileName.
- (ok := self fileInSourceFile:filenameToSet lazy:loadLazy silent:beSilent)
- ifFalse:[
- alternativeClassFileName notNil ifTrue:[
- filenameToSet := 'source' asFilename / packageDir / alternativeClassFileName.
- ok := self fileInSourceFile:filenameToSet lazy:loadLazy silent:beSilent
- ]
- ]
- ]
- ].
- ].
- ].
- ]
- ].
- "
- if that did not work, and the classes package is known,
- look for a zipArchive containing a class entry.
- "
- ok ifFalse:[
- packageDir notNil ifTrue:[
- zarFn := self getPackageFileName:(packageDir / 'source.zip').
- zarFn isNil ifTrue:[
- zarFn := packageDir withSuffix:'zip'.
- zarFn := self getSourceFileName:zarFn.
- ].
- (zarFn notNil and:[zarFn asFilename exists]) ifTrue:[
- zar := ZipArchive oldFileNamed:zarFn.
- zar notNil ifTrue:[
- entry := zar extract:(classFileName , '.st').
- (entry isNil and:[alternativeClassFileName notNil]) ifTrue:[
- entry := zar extract:(alternativeClassFileName , '.st').
- ].
- entry notNil ifTrue:[
- filenameToSet := zarFn.
- ok := self
- fileInStream:(entry asString readStream)
- lazy:loadLazy
- silent:beSilent
- logged:false
- addPath:nil
- ].
- ]
- ]
- ]
- ].
-
- "
- if that did not work,
- look for a zipArchive containing a class entry.
- "
- ok ifFalse:[
- zarFn := self getSourceFileName:'source.zip'.
- zarFn notNil ifTrue:[
- zar := ZipArchive oldFileNamed:zarFn.
- zar notNil ifTrue:[
- entry := zar extract:(zarFn := classFileName , '.st').
- (entry isNil and:[alternativeClassFileName notNil]) ifTrue:[
- entry := zar extract:(zarFn := alternativeClassFileName , '.st').
- ].
- entry notNil ifTrue:[
- filenameToSet := zarFn.
- ok := self
- fileInStream:(entry asString readStream)
- lazy:loadLazy
- silent:beSilent
- logged:false
- addPath:nil
- ].
- ]
- ]
- ].
- ok ifFalse:[
- "
- if there is a sourceCodeManager, ask it for the classes sourceCode
- "
- (mgr := Smalltalk at:#SourceCodeManager) notNil ifTrue:[
- inStream := mgr getMostRecentSourceStreamForClassNamed:aClassName inPackage:package.
- inStream notNil ifTrue:[
- filenameToSet := nil.
- ok := self fileInStream:inStream lazy:loadLazy silent:beSilent logged:false addPath:nil.
- ]
- ].
- ].
- ].
- ]
- ].
- ] ensure:[
- Compiler compileLazy:wasLazy.
- wasSilent notNil ifTrue:[
- self silentLoading:wasSilent
- ]
- ].
- ].
-
- ok ifTrue:[
- newClass := self at:(aClassName asSymbol).
- newClass notNil ifTrue:[
- "set the classes name - but do not change if already set"
- filenameToSet notNil ifTrue:[
- newClass getClassFilename isNil ifTrue:[
- newClass setClassFilename:(filenameToSet asFilename baseName)
- ].
- ].
-
- doInit ifTrue:[
- newClass initialize
- ]
- ]
- ].
+ wasLazy := Compiler compileLazy:loadLazy.
+ beSilent notNil ifTrue:[
+ wasSilent := self silentLoading:beSilent.
+ ].
+
+ classFileName := Smalltalk fileNameForClass:aClassName.
+ (classFileName = aClassName) ifTrue:[
+ "/ no abbrev.stc translation for className
+ (aClassName includes:$:) ifTrue:[
+ "/ a nameSpace name
+ alternativeClassFileName := classFileName copyFrom:(classFileName lastIndexOf:$:)+1
+ ].
+ ].
+
+ classFileName asFilename isAbsolute ifTrue:[
+ classFileName asFilename suffix notEmptyOrNil ifTrue:[
+ ok := self fileIn:classFileName lazy:loadLazy silent:beSilent.
+ ] ifFalse:[
+ ok := self fileInSourceFile:classFileName lazy:loadLazy silent:beSilent.
+ ]
+ ] ifFalse:[
+ classFileName := classFileName copyReplaceAll:$: with:$_ ifNone:classFileName.
+ [
+ Class withoutUpdatingChangesDo:[
+ |zarFn zar entry|
+
+ ok := false.
+
+ package notNil ifTrue:[
+ packageDir := package asPackageId packageDirectory.
+ "/ packageDir := package asString.
+ "/ packageDir := packageDir copyReplaceAll:$: with:$/.
+ packageDir isNil ifTrue:[
+ packageDir := self packageDirectoryForPackageId:package
+ ].
+ packageDir notNil ifTrue:[
+ packageDir := packageDir asFilename.
+ ].
+ ].
+
+ Class packageQuerySignal answer:package do:[
+ "
+ then, if dynamic linking is available,
+ "
+ (LoadBinaries and:[ObjectFileLoader notNil]) ifTrue:[
+ sharedLibExtension := ObjectFileLoader sharedLibraryExtension.
+ "
+ first look for a class packages shared binary in binary/xxx.o
+ "
+ libName := self libraryFileNameOfClass:aClassName.
+ libName notNil ifTrue:[
+ (ok := self fileInClass:aClassName fromObject:(libName, sharedLibExtension))
+ ifFalse:[
+ sharedLibExtension ~= '.o' ifTrue:[
+ ok := self fileInClass:aClassName fromObject:(libName, '.o')
+ ]
+ ].
+ ].
+ "
+ then, look for a shared binary in binary/xxx.o
+ "
+ ok ifFalse:[
+ (ok := self fileInClass:aClassName fromObject:(classFileName, sharedLibExtension))
+ ifFalse:[
+ sharedLibExtension ~= '.o' ifTrue:[
+ ok := self fileInClass:aClassName fromObject:(classFileName, '.o')
+ ].
+ ok ifFalse:[
+ alternativeClassFileName notNil ifTrue:[
+ (ok := self fileInClass:aClassName fromObject:(alternativeClassFileName, sharedLibExtension))
+ ifFalse:[
+ sharedLibExtension ~= '.o' ifTrue:[
+ ok := self fileInClass:aClassName fromObject:(alternativeClassFileName, '.o')
+ ]
+ ]
+ ].
+ ].
+ ].
+ ].
+ ].
+
+ "
+ if that did not work, look for a compiled-bytecode file ...
+ "
+ ok ifFalse:[
+ (ok := self fileIn:(classFileName , '.cls') lazy:loadLazy silent:beSilent)
+ ifFalse:[
+ alternativeClassFileName notNil ifTrue:[
+ ok := self fileIn:(alternativeClassFileName , '.cls') lazy:loadLazy silent:beSilent
+ ]
+ ]
+ ].
+ "
+ if that did not work, and the classes package is known,
+ look for an st-cls file
+ in a package subdir of the source-directory ...
+ "
+ ok ifFalse:[
+ (packageDir notNil and:[BinaryObjectStorage notNil]) ifTrue:[
+ packageFile := self getPackageFileName:((packageDir / 'classes' / classFileName) addSuffix:'cls').
+ packageFile isNil ifTrue:[
+ packageFile := (packageDir / 'classes' / classFileName) addSuffix:'cls'.
+ ].
+ (ok := self fileIn:packageFile lazy:loadLazy silent:beSilent)
+ ifFalse:[
+ alternativeClassFileName notNil ifTrue:[
+ packageFile := self getPackageFileName:((packageDir / 'classes' / alternativeClassFileName) addSuffix:'cls').
+ packageFile isNil ifTrue:[
+ packageFile := ((packageDir / 'classes' / alternativeClassFileName) addSuffix:'cls').
+ ].
+ ok := self fileIn:packageFile lazy:loadLazy silent:beSilent
+ ]
+ ].
+
+ zarFn := self getPackageFileName:(packageDir / 'classes.zip').
+ zarFn notNil ifTrue:[
+ zar := ZipArchive oldFileNamed:zarFn.
+ zar notNil ifTrue:[
+ entry := zar extract:(classFileName , '.cls').
+ (entry isNil and:[alternativeClassFileName notNil]) ifTrue:[
+ entry := zar extract:(alternativeClassFileName , '.cls').
+ ].
+ entry notNil ifTrue:[
+ bos := BinaryObjectStorage onOld:(entry asByteArray readStream).
+ bos next.
+ bos close.
+ ok := true
+ ].
+ ]
+ ]
+ ]
+ ].
+
+ "
+ if that did not work, look for an st-source file ...
+ "
+ ok ifFalse:[
+ filenameToSet := classFileName.
+ (ok := self fileInSourceFile:filenameToSet lazy:loadLazy silent:beSilent)
+ ifFalse:[
+ alternativeClassFileName notNil ifTrue:[
+ filenameToSet := alternativeClassFileName.
+ ok := self fileInSourceFile:filenameToSet lazy:loadLazy silent:beSilent
+ ].
+ ok ifFalse:[
+ "
+ ... and in the standard source-directory
+ "
+ filenameToSet := 'source' asFilename / classFileName.
+ (ok := self fileInSourceFile:filenameToSet lazy:loadLazy silent:beSilent)
+ ifFalse:[
+ alternativeClassFileName notNil ifTrue:[
+ filenameToSet := 'source' asFilename / alternativeClassFileName.
+ ok := self fileInSourceFile:filenameToSet lazy:loadLazy silent:beSilent
+ ]
+ ]
+ ]
+ ].
+ "
+ if that did not work, and the classes package is known,
+ look for an st-source file
+ in a package subdir of the source-directory ...
+ "
+ ok ifFalse:[
+ packageDir notNil ifTrue:[
+ packageFile := self getPackageSourceFileName:(packageDir / 'source' / classFileName).
+ packageFile isNil ifTrue:[
+ packageFile := (packageDir / 'source' / classFileName).
+ ].
+ filenameToSet := packageFile.
+ (ok := self fileInSourceFile:packageFile lazy:loadLazy silent:beSilent)
+ ifFalse:[
+ alternativeClassFileName notNil ifTrue:[
+ packageFile := self getPackageSourceFileName:(packageDir / 'source' / alternativeClassFileName).
+ packageFile isNil ifTrue:[
+ packageFile := (packageDir / 'source' / alternativeClassFileName).
+ ].
+ filenameToSet := packageFile.
+ ok := self fileInSourceFile:packageFile lazy:loadLazy silent:beSilent
+ ].
+ ok ifFalse:[
+ packageFile := self getPackageSourceFileName:(packageDir / classFileName).
+ packageFile isNil ifTrue:[
+ packageFile := (packageDir / classFileName).
+ ].
+ filenameToSet := packageFile.
+ (ok := self fileInSourceFile:packageFile lazy:loadLazy silent:beSilent)
+ ifFalse:[
+ alternativeClassFileName notNil ifTrue:[
+ packageFile := self getPackageFileName:(packageDir / alternativeClassFileName).
+ packageFile isNil ifTrue:[
+ packageFile := packageDir / alternativeClassFileName.
+ ].
+ filenameToSet := packageFile.
+ ok := self fileInSourceFile:packageFile lazy:loadLazy silent:beSilent
+ ].
+ ok ifFalse:[
+ "
+ ... and in the standard source-directory
+ "
+ filenameToSet := 'source' asFilename / packageDir / classFileName.
+ (ok := self fileInSourceFile:filenameToSet lazy:loadLazy silent:beSilent)
+ ifFalse:[
+ alternativeClassFileName notNil ifTrue:[
+ filenameToSet := 'source' asFilename / packageDir / alternativeClassFileName.
+ ok := self fileInSourceFile:filenameToSet lazy:loadLazy silent:beSilent
+ ]
+ ]
+ ]
+ ].
+ ].
+ ].
+ ]
+ ].
+ "
+ if that did not work, and the classes package is known,
+ look for a zipArchive containing a class entry.
+ "
+ ok ifFalse:[
+ packageDir notNil ifTrue:[
+ zarFn := self getPackageFileName:(packageDir / 'source.zip').
+ zarFn isNil ifTrue:[
+ zarFn := packageDir withSuffix:'zip'.
+ zarFn := self getSourceFileName:zarFn.
+ ].
+ (zarFn notNil and:[zarFn asFilename exists]) ifTrue:[
+ zar := ZipArchive oldFileNamed:zarFn.
+ zar notNil ifTrue:[
+ entry := zar extract:(classFileName , '.st').
+ (entry isNil and:[alternativeClassFileName notNil]) ifTrue:[
+ entry := zar extract:(alternativeClassFileName , '.st').
+ ].
+ entry notNil ifTrue:[
+ filenameToSet := zarFn.
+ ok := self
+ fileInStream:(entry asString readStream)
+ lazy:loadLazy
+ silent:beSilent
+ logged:false
+ addPath:nil
+ ].
+ ]
+ ]
+ ]
+ ].
+
+ "
+ if that did not work,
+ look for a zipArchive containing a class entry.
+ "
+ ok ifFalse:[
+ zarFn := self getSourceFileName:'source.zip'.
+ zarFn notNil ifTrue:[
+ zar := ZipArchive oldFileNamed:zarFn.
+ zar notNil ifTrue:[
+ entry := zar extract:(zarFn := classFileName , '.st').
+ (entry isNil and:[alternativeClassFileName notNil]) ifTrue:[
+ entry := zar extract:(zarFn := alternativeClassFileName , '.st').
+ ].
+ entry notNil ifTrue:[
+ filenameToSet := zarFn.
+ ok := self
+ fileInStream:(entry asString readStream)
+ lazy:loadLazy
+ silent:beSilent
+ logged:false
+ addPath:nil
+ ].
+ ]
+ ]
+ ].
+ ok ifFalse:[
+ "
+ if there is a sourceCodeManager, ask it for the classes sourceCode
+ "
+ (mgr := Smalltalk at:#SourceCodeManager) notNil ifTrue:[
+ inStream := mgr getMostRecentSourceStreamForClassNamed:aClassName inPackage:package.
+ inStream notNil ifTrue:[
+ filenameToSet := nil.
+ ok := self fileInStream:inStream lazy:loadLazy silent:beSilent logged:false addPath:nil.
+ ]
+ ].
+ ].
+ ].
+ ]
+ ].
+ ] ensure:[
+ Compiler compileLazy:wasLazy.
+ wasSilent notNil ifTrue:[
+ self silentLoading:wasSilent
+ ]
+ ].
+ ].
+
+ ok ifTrue:[
+ newClass := self at:(aClassName asSymbol).
+ newClass notNil ifTrue:[
+ "set the classes name - but do not change if already set"
+ filenameToSet notNil ifTrue:[
+ newClass getClassFilename isNil ifTrue:[
+ newClass setClassFilename:(filenameToSet asFilename baseName)
+ ].
+ ].
+
+ doInit ifTrue:[
+ newClass initialize
+ ]
+ ]
+ ].
].
^ newClass
--- a/SmalltalkChunkFileSourceWriter.st Tue May 17 10:05:14 2016 +0100
+++ b/SmalltalkChunkFileSourceWriter.st Thu May 19 07:07:52 2016 +0200
@@ -730,8 +730,7 @@
copyrightText := copyrightMethod comment.
copyrightText notEmptyOrNil ifTrue:[
copyrightText := copyrightText asCollectionOfLines asStringCollection.
- copyrightText := copyrightText withoutLeadingBlankLines.
- copyrightText := copyrightText withoutTrailingBlankLines.
+ copyrightText := copyrightText withoutLeadingAndTrailingBlankLines.
copyrightText notEmpty ifTrue:[
copyrightText addFirst:'"'.
copyrightText addLast:'"'.
--- a/StandaloneStartup.st Tue May 17 10:05:14 2016 +0100
+++ b/StandaloneStartup.st Thu May 19 07:07:52 2016 +0200
@@ -787,12 +787,14 @@
handleScriptingOptionsFromArguments:argv
"handle scripting command line argument:
- --scripting portNr ... start a scripting server
+ --scripting portNr ... start a scripting server on port (or default, if missing)
--allowHost host ..... add host to the allowed scripting hosts
"
|scripting idx nextArg portNr allowedScriptingHosts|
+ self verboseInfo:('handle scripting: ',argv asArray printString).
+
scripting := false.
idx := argv indexOfAny:#('--scripting').
@@ -835,7 +837,7 @@
"/ scripting on port/stdin_out/8008
self verboseInfo:('start scripting').
- STXScriptingServer startAt:portNr
+ STXScriptingServer server:(STXScriptingServer startAt:portNr)
] ifFalse:[
self verboseInfo:('missing STXScriptingServer class').
].
@@ -1135,7 +1137,7 @@
Stderr nextPutLine:' --newAppInstance ........ start as its own application process (do not reuse a running instance)'.
].
self allowScriptingOption ifTrue:[
- Stderr nextPutLine:' --scripting portNr ...... enable scripting via port (or stdin/stdOut, if 0)'.
+ Stderr nextPutLine:' --scripting <portNr> .... enable scripting via port (or stdin/stdOut, if 0. Default is 8008)'.
].
self allowDebugOption ifTrue:[
Stderr nextPutLine:' --debug ................. enable Debugger'.
--- a/String.st Tue May 17 10:05:14 2016 +0100
+++ b/String.st Thu May 19 07:07:52 2016 +0200
@@ -40,6 +40,11 @@
# include <stdlib.h>
#endif
+#ifdef __MINGW__
+# include <string.h>
+# include <stdlib.h>
+#endif
+
/*
* old st/x creates strings with spaces in it;
* new st/x will fill it with zeros (for st-80 compatibility)
@@ -54,7 +59,7 @@
%{
static int
-nextOnKeyboard(char1, char2)
+nextOnKeyboard(int char1, int char2)
{
/* compare two characters if they are next to each other on a (US-) keyboard */
@@ -4100,18 +4105,18 @@
unsigned char *cp = __stringVal(self);
unsigned char *last = cp + __stringSize(self);
int max = 1;
-
+
if (!__isStringLike(self)) {
- cp += __OBJS2BYTES__(__intVal(__ClassInstPtr(__qClass(self))->c_ninstvars));
+ cp += __OBJS2BYTES__(__intVal(__ClassInstPtr(__qClass(self))->c_ninstvars));
}
for ( ; cp < last; cp++) {
- unsigned char mask = *cp & 0xF0;
- if (mask != 0) {
- if ((mask & 0xE0 )== 0xC0) { if (max < 2) max = 2; }
- else if (mask == 0xE0) { if (max < 3) max = 3; }
- else if (mask == 0xF0) { max = 4; break;}
- }
+ unsigned char mask = *cp & 0xF0;
+ if (mask != 0) {
+ if ((mask & 0xE0 )== 0xC0) { if (max < 2) max = 2; }
+ else if (mask == 0xE0) { if (max < 3) max = 3; }
+ else if (mask == 0xF0) { max = 4; break;}
+ }
}
RETURN (__mkSmallInteger(max));
%}.
@@ -4134,11 +4139,11 @@
unsigned INT len = 0;
if (!__isStringLike(self)) {
- cp += __OBJS2BYTES__(__intVal(__ClassInstPtr(__qClass(self))->c_ninstvars));
+ cp += __OBJS2BYTES__(__intVal(__ClassInstPtr(__qClass(self))->c_ninstvars));
}
// count the number of start-bytes
for ( ; cp < last; cp++) {
- if ((*cp & 0xC0) != 0x80) len++;
+ if ((*cp & 0xC0) != 0x80) len++;
}
RETURN (__mkSmallInteger(len));
%}.
@@ -4868,4 +4873,3 @@
version_CVS
^ '$Header$'
! !
-
--- a/StringCollection.st Tue May 17 10:05:14 2016 +0100
+++ b/StringCollection.st Thu May 19 07:07:52 2016 +0200
@@ -234,6 +234,29 @@
^ super copyEmpty:size.
!
+withoutLeadingAndTrailingBlankLines
+ "return a copy of the receiver with leading and trailing blank lines removed.
+ If there are no trailing blank lines, the original receiver is returned.
+ If all lines are blank, an empty string collection is returned."
+
+ ^ self withoutLeadingBlankLines withoutTrailingBlankLines.
+
+ "
+'1
+2
+3' asStringCollection withoutLeadingAndTrailingBlankLines
+ "
+
+ "
+'
+
+2
+3
+
+' asStringCollection withoutLeadingAndTrailingBlankLines
+ "
+!
+
withoutLeadingBlankLines
"return a copy of the receiver with leading blank lines removed.
If there are no leading blank lines, the original receiver is returned.
--- a/Win32OperatingSystem.st Tue May 17 10:05:14 2016 +0100
+++ b/Win32OperatingSystem.st Thu May 19 07:07:52 2016 +0200
@@ -6149,7 +6149,7 @@
(aPathName endsWith:'.lnk') ifTrue:[
type := #symbolicLink.
- "/ now done lazyly in FileStatusInfo, when the path is accessed
+ "/ now done lazily in FileStatusInfo, when the path is accessed
"/ path := self getLinkTarget:aPathName.
].