--- a/.hgtags Thu Jul 25 13:04:52 2013 +0100
+++ b/.hgtags Thu Aug 01 10:22:20 2013 +0100
@@ -14,7 +14,6 @@
471ed2bb3bf16111afbf2e0d6dfb422d78294aca expecco_1_0_3
520c27f8cae267240021277e257e013b60b9cdb8 rel5_2_2
54dd825d531c7adec355b2ffbdd6b66d00d4678a expecco_1_6_0rc5
-550b68e18f9671024c10c0319a9839b90c32795e expecco_2_5_1
5fcd709c7fd282e9c55d8642d1a6b1d5d77baf5e expecco_2_5_0
615c4fe0f449a6be077b11450d39fb6560b1695a rel4_1_3_1
62ff001533901d30b624539b2f404d73f01db468 expecco_1_6_0
@@ -26,8 +25,10 @@
7637b5e86692e36907a176161940d8453e854c8a test
7b32ff0e0c72e6d96f5db1470e04f1f7919678e4 expeccoNET_1_6_0_0
86239edb7b7de95492d82032c4e8adb1f0ec6222 rel2_10_8_6_last2
+88cefb6e5d94dfa777b7ffe3cc699541447c85b8 exepcco_2_5_1
8b83b6cb00ac9b0195bab75970ccec06701b9dbc stable_expecco_sel
8c59f73d3ab64139429870d798bd55d5420fee1f expeccoNET_1_4_0rc1
+8cc3823444968fcadfeefbfba64b061342f25358 expecco_2_5_1
8d10113a89a936d0e702cabc9df87f694ffd4595 rel3_6_1
9770f4ad54ff34fef3e47c556ec916053b1fc5e1 rel5_2_1
983d045c17f5f23c4d5b7e3644ec8921f68c11d8 rel2_10_8_5
@@ -35,7 +36,7 @@
9cdd427527503c68f07643a213c28421188bb185 expecco_2_0_0
a7ae2d96849615e5d3a46f24faf788506428db65 dtm2_1
a91a569695ec39ec5e7f0fe0aa215b134430202b expecco_2_1_0
-afc9b62897015a39da547a5f7dade61a3d7aabdc stable
+ac2e51b3000c43098dab9c6333f4d4b568351a85 stable
b0b377ad4df192b9fdda9f2c1038c5e05c48290c expecco_2_2_0
b2c70b0a0acfd9c4f6a2c1304b1a6eab18521f81 expecco_1_7_0rc3
b64647b51eca20f04c15fa476abbc2c815cca8d7 expecco_1_5_0
--- a/Autoload.st Thu Jul 25 13:04:52 2013 +0100
+++ b/Autoload.st Thu Aug 01 10:22:20 2013 +0100
@@ -766,11 +766,12 @@
isLoaded
"return true, if the class has been loaded.
Autoload itself is loaded, subclasses are not.
- This allows testing wether a class has already been loaded."
+ This allows testing whether a class has already been loaded."
^ (self == Autoload)
- "Modified: / 16.2.1998 / 11:57:35 / stefan"
+ "Modified: / 16-02-1998 / 11:57:35 / stefan"
+ "Modified (comment): / 27-07-2013 / 15:35:01 / cg"
!
loadedClasses
@@ -827,11 +828,11 @@
!Autoload class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Autoload.st,v 1.165 2013-05-13 13:41:06 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Autoload.st,v 1.166 2013-07-27 13:52:45 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Autoload.st,v 1.165 2013-05-13 13:41:06 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Autoload.st,v 1.166 2013-07-27 13:52:45 cg Exp $'
! !
--- a/Behavior.st Thu Jul 25 13:04:52 2013 +0100
+++ b/Behavior.st Thu Aug 01 10:22:20 2013 +0100
@@ -1876,10 +1876,13 @@
allSubclassesInOrderDo:aBlock
"evaluate aBlock for all of my subclasses.
- There is no specific order, in which the entries are enumerated.
+ The subclasses are enumerated breath first (i.e. all of a classes superclasses
+ come before a class, which comes before any of its subclasses).
+ However, within one inheritance level, there is no specific order,
+ in which the entries are enumerated.
Warning:
- This will only enumerate globally known classes - for anonymous
- behaviors, you have to walk over all instances of Behavior."
+ This will only enumerate globally known classes - for anonymous
+ behaviors, you have to walk over all instances of Behavior."
|meta toDo cls|
@@ -1888,13 +1891,13 @@
toDo := OrderedCollection new.
toDo addAll:self theNonMetaclass subclasses.
[toDo notEmpty] whileTrue:[
- cls := toDo removeFirst.
- toDo addAll:cls subclasses.
- meta ifTrue:[
- aBlock value:cls class.
- ] ifFalse:[
- aBlock value:cls.
- ]
+ cls := toDo removeFirst.
+ toDo addAll:cls subclasses.
+ meta ifTrue:[
+ aBlock value:cls class.
+ ] ifFalse:[
+ aBlock value:cls.
+ ]
].
"/ self isMeta ifTrue:[
@@ -1916,7 +1919,8 @@
Collection class allSubclassesInOrderDo:[:c | Transcript showCR:(c name)]
"
- "Modified: / 25.10.1997 / 21:17:13 / cg"
+ "Modified: / 25-10-1997 / 21:17:13 / cg"
+ "Modified (comment): / 27-07-2013 / 08:13:04 / cg"
!
allSuperclassesDo:aBlock
@@ -5006,10 +5010,10 @@
!Behavior class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.344 2013-06-03 10:38:12 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.345 2013-07-27 08:46:36 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.344 2013-06-03 10:38:12 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.345 2013-07-27 08:46:36 cg Exp $'
! !
--- a/ClassDescription.st Thu Jul 25 13:04:52 2013 +0100
+++ b/ClassDescription.st Thu Aug 01 10:22:20 2013 +0100
@@ -363,7 +363,7 @@
!
fileOutNameSpaceQuerySignal
- "return the signal used as an upQuery wether the current
+ "return the signal used as an upQuery whether the current
namespace should be prepended on fileOut."
^ FileOutNameSpaceQuerySignal
@@ -372,8 +372,9 @@
Transcript showCR:Class fileOutNameSpaceQuerySignal raise
"
- "Modified: 5.11.1996 / 20:08:38 / cg"
- "Created: 2.4.1997 / 17:28:41 / stefan"
+ "Modified: / 05-11-1996 / 20:08:38 / cg"
+ "Created: / 02-04-1997 / 17:28:41 / stefan"
+ "Modified (comment): / 27-07-2013 / 15:35:32 / cg"
!
forceNoNameSpaceQuerySignal
@@ -3328,10 +3329,15 @@
self isPrivate ifTrue:[^ self topOwningClass topNameSpace].
ns := self nameSpace.
- ns isNameSpace ifFalse:[
- "detect the problem, that a class has the same name as a namsSpace"
- self halt:'Not a namspace'.
+ ns isNil ifTrue:[
+ "/ probably an unbound class
ns := Smalltalk. "/ What a KLUDGE
+ ] ifFalse:[
+ ns isNameSpace ifFalse:[
+ "detect the problem, that a class has the same name as a namsSpace"
+ self halt:'Not a namspace'.
+ ns := Smalltalk. "/ What a KLUDGE
+ ]
].
^ ns.
!
@@ -4291,11 +4297,11 @@
!ClassDescription class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/ClassDescription.st,v 1.242 2013-07-11 10:08:47 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/ClassDescription.st,v 1.244 2013-07-27 13:53:30 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/ClassDescription.st,v 1.242 2013-07-11 10:08:47 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/ClassDescription.st,v 1.244 2013-07-27 13:53:30 cg Exp $'
!
version_HG
--- a/Continuation.st Thu Jul 25 13:04:52 2013 +0100
+++ b/Continuation.st Thu Aug 01 10:22:20 2013 +0100
@@ -67,6 +67,8 @@
!Continuation class methodsFor:'instance creation'!
current
+ "this is called current-continuation in scheme"
+
|cont id|
cont := self basicNew.
@@ -76,12 +78,12 @@
__cId = __continuationCreate(cont);
if (__cId > 0) {
- id = __mkSmallInteger(__cId);
+ id = __mkSmallInteger(__cId);
}
%}.
id isNil ifTrue:[
- self error:'could not create continuation' mayProceed:true.
- ^ nil.
+ self error:'could not create continuation' mayProceed:true.
+ ^ nil.
].
cont setId:id process:(Processor activeProcess).
^ cont
@@ -90,13 +92,16 @@
self current
"
- "Modified: / 29-11-2006 / 10:12:35 / cg"
+ "Modified: / 25-07-2013 / 11:37:27 / cg"
!
currentDo: aBlock
+ "this is is called call/cc in scheme"
+
^ aBlock value:self current
"Modified: / 29-11-2006 / 10:14:03 / cg"
+ "Modified (comment): / 25-07-2013 / 11:37:00 / cg"
!
new
@@ -186,12 +191,10 @@
!Continuation class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Continuation.st,v 1.15 2008/11/03 11:20:32 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Continuation.st,v 1.16 2013-07-25 09:37:35 cg Exp $'
!
version_SVN
^ '$Id: Continuation.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
-
-
--- a/Delay.st Thu Jul 25 13:04:52 2013 +0100
+++ b/Delay.st Thu Aug 01 10:22:20 2013 +0100
@@ -42,16 +42,17 @@
or for delaying until a specific time has reached.
Once created, a delay is waited upon with Delay>>wait.
- Notice: due to delays (both within unix AND within Smalltalk itself,
+ Notice: due to delays (both within Unix AND within Smalltalk itself,
the resumption time will ALWAYS be after the actual delay time.
(i.e. a Delay for n-millis will actually suspend for more than n milliseconds)
- Warning: currently, the implementation does not support delays longer than
- a system specific maximum - future versions may remove this limitation.
- For now, do not use delays longer than the value returned by
+ Warning:
+ currently, the implementation does not support delays longer than
+ a system specific maximum - future versions may remove this limitation.
+ For now, do not use delays longer than the value returned by
OperatingSystem maximumMillisecondTimeDelta
- Also notice: the clock resolution of the operatingSystem is usually limited
+ Also notice: the clock resolution of the operating system is usually limited
(1/100, 1/60, 1/50, or even 1/20 of a second). Thus very small delays will
delay for at least this minimum time interval. See examples.
@@ -311,7 +312,7 @@
[
[
Processor signal:delaySemaphore atMilliseconds:then.
- Processor activeProcess state:#timeWait.
+ Processor activeProcess setStateTo:#timeWait if:#active.
delaySemaphore wait.
] doWhile:[
(dueTime notNil
@@ -363,9 +364,10 @@
!Delay class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Delay.st,v 1.45 2011-10-27 16:43:56 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Delay.st,v 1.47 2013-07-25 09:35:36 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Delay.st,v 1.45 2011-10-27 16:43:56 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Delay.st,v 1.47 2013-07-25 09:35:36 cg Exp $'
! !
+
--- a/EncodedStream.st Thu Jul 25 13:04:52 2013 +0100
+++ b/EncodedStream.st Thu Aug 01 10:22:20 2013 +0100
@@ -413,6 +413,8 @@
size
"not correct, but probably better than 0"
+ "/ is that better?
+ "/ self error:'size of input is unknown (due to decoding)'
^ stream size
"Created: / 31-08-2012 / 16:52:40 / cg"
@@ -484,11 +486,11 @@
!EncodedStream class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/EncodedStream.st,v 1.29 2013-07-06 06:41:24 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/EncodedStream.st,v 1.30 2013-07-30 19:20:50 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/EncodedStream.st,v 1.29 2013-07-06 06:41:24 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/EncodedStream.st,v 1.30 2013-07-30 19:20:50 cg Exp $'
!
version_HG
--- a/FileStream.st Thu Jul 25 13:04:52 2013 +0100
+++ b/FileStream.st Thu Aug 01 10:22:20 2013 +0100
@@ -445,48 +445,48 @@
|nameString random prevRandom prevNameString newTempFilename stream|
[
- prevRandom := random.
- prevNameString := nameString.
+ prevRandom := random.
+ prevNameString := nameString.
- "Use random numbers in order to improve the security
- by making the generated names less predictable"
- [
- random := RandomGenerator new nextInteger.
- ] doWhile:[random = prevRandom].
+ "Use random numbers in order to improve the security
+ by making the generated names less predictable"
+ [
+ random := RandomGenerator new nextInteger.
+ ] doWhile:[random = prevRandom].
- nameString := template bindWith:(OperatingSystem getProcessId) with:random.
+ nameString := template bindWith:(OperatingSystem getProcessId) with:random.
- aDirectoryOrNil isNil ifTrue:[
- newTempFilename := nameString.
- ] ifFalse:[
- newTempFilename := aDirectoryOrNil asFilename constructString:nameString.
- ].
+ aDirectoryOrNil isNil ifTrue:[
+ newTempFilename := nameString.
+ ] ifFalse:[
+ newTempFilename := aDirectoryOrNil asFilename constructString:nameString.
+ ].
- [
- stream := self open:newTempFilename withMode:#(CREATE_NEW GENERIC_READ_WRITE).
- ] on:OpenError do:[:ex|
- (OperatingSystem errorHolderForNumber:ex errorCode) errorCategory ~~ #existingReferentSignal ifFalse:[
- "some fundamental error, raise exception"
- ex reject.
- ].
- prevNameString = nameString ifTrue:[
- "no more names - probably a bad template"
- ex reject.
- ].
- "file exists, retry another one"
- ].
+ [
+ stream := self open:newTempFilename withMode:#(CREATE_NEW GENERIC_READ_WRITE).
+ ] on:OpenError do:[:ex|
+ ex errorCategory ~~ #existingReferentSignal ifTrue:[
+ "some fundamental error, raise exception"
+ ex reject.
+ ].
+ prevNameString = nameString ifTrue:[
+ "no more names - probably a bad template"
+ ex reject.
+ ].
+ "file exists, retry another one"
+ ].
] doWhile:[
- stream isNil and:[prevNameString ~= nameString] "/ if namestring didn't change, the template is bad
+ stream isNil and:[prevNameString ~= nameString] "/ if namestring didn't change, the template is bad
].
^ stream
"temp files in '/tmp':
- FileStream newTemporaryIn:'/tmp' asFilename nameTemplate:'foo%1_%2'
+ FileStream newTemporaryIn:'/tmp' asFilename nameTemplate:'foo%1_%2'
This must fail on the second try:
- FileStream newTemporaryIn:'/tmp' asFilename nameTemplate:'foo'
- FileStream newTemporaryIn:'c:\temp' asFilename nameTemplate:'foo'
+ FileStream newTemporaryIn:'/tmp' asFilename nameTemplate:'foo'
+ FileStream newTemporaryIn:'c:\temp' asFilename nameTemplate:'foo'
"
"temp files somewhere
@@ -1998,11 +1998,11 @@
!FileStream class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/FileStream.st,v 1.167 2013-07-24 19:56:49 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/FileStream.st,v 1.168 2013-07-29 08:11:37 stefan Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/FileStream.st,v 1.167 2013-07-24 19:56:49 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/FileStream.st,v 1.168 2013-07-29 08:11:37 stefan Exp $'
! !
--- a/Filename.st Thu Jul 25 13:04:52 2013 +0100
+++ b/Filename.st Thu Aug 01 10:22:20 2013 +0100
@@ -4263,6 +4263,42 @@
"
!
+isWritableDirectory
+ "return true, if such a directory exists and is writable.
+ Don't believe #isWritable, since on an NFS mounted filesystem
+ with UID mapping and attribute cache enabled, there may be false negatives."
+
+ self isDirectory ifFalse:[
+ ^ false.
+ ].
+
+ self isWritable ifFalse:[
+ "/ on an NFS mounted filesystem with UID mapping and
+ "/ attribute cache enabled,
+ "/ this query may fail, but creation may work actually.
+ "/ check again...
+ [
+ |tempFile|
+
+ tempFile := FileStream newTemporaryIn:self.
+ tempFile close.
+ tempFile fileName remove.
+ ] on:OpenError do:[:ex|
+ ^ false.
+ ].
+ ].
+ ^ true.
+
+ "
+ '/foo/bar' asFilename isWritableDirectory
+ '/tmp' asFilename isWritableDirectory
+ '/etc' asFilename isWritableDirectory
+ 'Makefile' asFilename isWritableDirectory
+ '/net/exeptn/home2/office' asFilename isWritable
+ '/net/exeptn/home2/office' asFilename isWritableDirectory
+ "
+!
+
separator
"return the directory-separator character"
@@ -6014,11 +6050,11 @@
!Filename class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Filename.st,v 1.401 2013-07-08 19:23:30 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Filename.st,v 1.402 2013-07-29 13:38:50 stefan Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Filename.st,v 1.401 2013-07-08 19:23:30 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Filename.st,v 1.402 2013-07-29 13:38:50 stefan Exp $'
! !
--- a/GenericException.st Thu Jul 25 13:04:52 2013 +0100
+++ b/GenericException.st Thu Aug 01 10:22:20 2013 +0100
@@ -1280,13 +1280,14 @@
messageText:aString
"set the messageText.
- If it starts with a space, the signals messageText is prepended,
+ If it starts with a space, the signal's original messageText is prepended,
if it ends with a space, it is appended."
messageText := aString
- "Created: / 5.3.1998 / 16:45:29 / stefan"
- "Modified: / 12.3.1998 / 15:30:45 / stefan"
+ "Created: / 05-03-1998 / 16:45:29 / stefan"
+ "Modified: / 12-03-1998 / 15:30:45 / stefan"
+ "Modified (comment): / 30-07-2013 / 21:04:43 / cg"
!
originalSignal
@@ -2354,11 +2355,11 @@
!GenericException class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/GenericException.st,v 1.142 2013-06-19 06:34:00 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/GenericException.st,v 1.143 2013-07-30 19:18:01 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/GenericException.st,v 1.142 2013-06-19 06:34:00 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/GenericException.st,v 1.143 2013-07-30 19:18:01 cg Exp $'
!
version_HG
--- a/Integer.st Thu Jul 25 13:04:52 2013 +0100
+++ b/Integer.st Thu Aug 01 10:22:20 2013 +0100
@@ -1,6 +1,6 @@
"
COPYRIGHT (c) 1988 by Claus Gittinger
- All Rights Reserved
+ All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
@@ -30,7 +30,7 @@
copyright
"
COPYRIGHT (c) 1988 by Claus Gittinger
- All Rights Reserved
+ All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
@@ -47,28 +47,28 @@
See details in concrete subclasses LargeInteger and SmallInteger.
Mixed mode arithmetic:
- int op int -> int
- int op fix -> fix; scale is fix's scale
- int op fraction -> fraction
- int op float -> float
+ int op int -> int
+ int op fix -> fix; scale is fix's scale
+ int op fraction -> fraction
+ int op float -> float
[Class variables:]
- DefaultDisplayRadix the radix in which integers present their
- displayString (which is used in inspectors)
- If you are to look at many hex numbers, bitmasks
- etc. you may set this to 2 or 16.
- (avoids typing printStringRadix:.. all the time
- - I know - I am lazy ;-). Default is 10.
+ DefaultDisplayRadix the radix in which integers present their
+ displayString (which is used in inspectors)
+ If you are to look at many hex numbers, bitmasks
+ etc. you may set this to 2 or 16.
+ (avoids typing printStringRadix:.. all the time
+ - I know - I am lazy ;-). Default is 10.
[author:]
- Claus Gittinger
+ Claus Gittinger
[see also:]
- Number
- LargeInteger SmallInteger
- Float ShortFloat Fraction FixedPoint
+ Number
+ LargeInteger SmallInteger
+ Float ShortFloat Fraction FixedPoint
"
! !
@@ -167,11 +167,11 @@
val := 0.
aByteArray do:[:twoDigits |
- |hi lo|
-
- hi := (twoDigits bitShift:-4) bitAnd:16r0F.
- lo := twoDigits bitAnd:16r0F.
- val := (val * 100) + (hi * 10) + lo
+ |hi lo|
+
+ hi := (twoDigits bitShift:-4) bitAnd:16r0F.
+ lo := twoDigits bitAnd:16r0F.
+ val := (val * 100) + (hi * 10) + lo
].
^ val
@@ -198,16 +198,16 @@
val := 0.
aByteArray do:[:twoDigits |
- |hi lo|
-
- lo := (twoDigits bitShift:-4) bitAnd:16r0F.
- hi := twoDigits bitAnd:16r0F.
- lo <= 9 ifTrue:[
- val := (val * 100) + (hi * 10) + lo
- ] ifFalse:[
- "16rF is used to encode an odd number of digits"
- val := (val * 10) + hi.
- ].
+ |hi lo|
+
+ lo := (twoDigits bitShift:-4) bitAnd:16r0F.
+ hi := twoDigits bitAnd:16r0F.
+ lo <= 9 ifTrue:[
+ val := (val * 100) + (hi * 10) + lo
+ ] ifFalse:[
+ "16rF is used to encode an odd number of digits"
+ val := (val * 10) + hi.
+ ].
].
^ val
@@ -231,7 +231,7 @@
The digits can be stored byte-wise into the result, using digitAt:put:"
^ (LargeInteger basicNew numberOfDigits:numberOfBytes)
- sign:(negative ifTrue:[-1] ifFalse:[1])
+ sign:(negative ifTrue:[-1] ifFalse:[1])
!
readFrom:aStringOrStream
@@ -262,41 +262,41 @@
|value|
Error handle:[:ex |
- ^ exceptionBlock value
+ ^ exceptionBlock value
] do:[
- |str nextChar negative|
-
- str := aStringOrStream readStream.
-
- nextChar := str skipSeparators.
- (nextChar == $-) ifTrue:[
- negative := true.
- str next.
- nextChar := str peekOrNil
- ] ifFalse:[
- negative := false
- ].
- (nextChar isNil or:[nextChar isDigit not]) ifTrue:[
- "
- the string does not represent an integer
- "
- ^ exceptionBlock value
- ].
- value := self readFrom:str radix:10.
- nextChar := str peekOrNil.
- ((nextChar == $r) or:[ nextChar == $R]) ifTrue:[
- "-xxr<number> is invalid; should be xxr-<val>"
-
- negative ifTrue:[
- 'Integer [warning]: invalid (negative) radix ignored' errorPrintCR.
- negative := false
- ].
- str next.
- value := self readFrom:str radix:value
- ].
- negative ifTrue:[
- value := value negated
- ].
+ |str nextChar negative|
+
+ str := aStringOrStream readStream.
+
+ nextChar := str skipSeparators.
+ (nextChar == $-) ifTrue:[
+ negative := true.
+ str next.
+ nextChar := str peekOrNil
+ ] ifFalse:[
+ negative := false
+ ].
+ (nextChar isNil or:[nextChar isDigit not]) ifTrue:[
+ "
+ the string does not represent an integer
+ "
+ ^ exceptionBlock value
+ ].
+ value := self readFrom:str radix:10.
+ nextChar := str peekOrNil.
+ ((nextChar == $r) or:[ nextChar == $R]) ifTrue:[
+ "-xxr<number> is invalid; should be xxr-<val>"
+
+ negative ifTrue:[
+ 'Integer [warning]: invalid (negative) radix ignored' errorPrintCR.
+ negative := false
+ ].
+ str next.
+ value := self readFrom:str radix:value
+ ].
+ negative ifTrue:[
+ value := value negated
+ ].
].
^ value
@@ -346,7 +346,7 @@
nextChar := str peekOrNil.
(nextChar notNil and:[nextChar isDigitRadix:radix]) ifFalse:[
- ^ exceptionBlock value
+ ^ exceptionBlock value
].
value := nextChar digitValue.
@@ -372,29 +372,29 @@
r4 := r2 * r2.
[nextChar notNil and:[ (digit1 := nextChar digitValueRadix:r) notNil]] whileTrue:[
- "/ read 4 chars and pre-compute their value to avoid largeInt operations.
-
- str next.
- nextChar2 := str peekOrNil.
- (nextChar2 isNil or:[ (digit2 := nextChar2 digitValueRadix:r) isNil]) ifTrue:[
- ^ (value * r) + digit1.
- ].
-
- str next.
- nextChar3 := str peekOrNil.
- (nextChar3 isNil or:[ (digit3 := nextChar3 digitValueRadix:r) isNil]) ifTrue:[
- ^ (value * r2) + ((digit1*r) + digit2).
- ].
-
- str next.
- nextChar4 := str peekOrNil.
- (nextChar4 isNil or:[ (digit4 := nextChar4 digitValueRadix:r) isNil]) ifTrue:[
- ^ (value * r3) + ((((digit1*r) + digit2)*r) + digit3).
- ].
-
- value := (value * r4) + ((((((digit1*r) + digit2)*r) + digit3)*r) + digit4).
- str next.
- nextChar := str peekOrNil.
+ "/ read 4 chars and pre-compute their value to avoid largeInt operations.
+
+ str next.
+ nextChar2 := str peekOrNil.
+ (nextChar2 isNil or:[ (digit2 := nextChar2 digitValueRadix:r) isNil]) ifTrue:[
+ ^ (value * r) + digit1.
+ ].
+
+ str next.
+ nextChar3 := str peekOrNil.
+ (nextChar3 isNil or:[ (digit3 := nextChar3 digitValueRadix:r) isNil]) ifTrue:[
+ ^ (value * r2) + ((digit1*r) + digit2).
+ ].
+
+ str next.
+ nextChar4 := str peekOrNil.
+ (nextChar4 isNil or:[ (digit4 := nextChar4 digitValueRadix:r) isNil]) ifTrue:[
+ ^ (value * r3) + ((((digit1*r) + digit2)*r) + digit3).
+ ].
+
+ value := (value * r4) + ((((((digit1*r) + digit2)*r) + digit3)*r) + digit4).
+ str next.
+ nextChar := str peekOrNil.
].
^ value
@@ -407,9 +407,9 @@
Integer readFrom:'gg' radix:10 onError:0
Time millisecondsToRun:[
- 1000 timesRepeat:[
- (String new:1000 withAll:$1) asInteger
- ]
+ 1000 timesRepeat:[
+ (String new:1000 withAll:$1) asInteger
+ ]
]
"
@@ -428,14 +428,14 @@
stopOnSeparator finish|
romanValues := Dictionary
- withKeys:#($M $D $C $L $X $V $I)
- andValues:#(1000 500 100 50 10 5 1).
+ withKeys:#($M $D $C $L $X $V $I)
+ andValues:#(1000 500 100 50 10 5 1).
(stopOnSeparator := aStringOrStream isStream) ifFalse:[
- s := aStringOrStream readStream.
+ s := aStringOrStream readStream.
].
s atEnd ifTrue:[
- ^ RomanNumberFormatError raiseErrorString:'empty string'
+ ^ RomanNumberFormatError raiseErrorString:'empty string'
].
val := 0.
prevDigitVal := 99999.
@@ -443,61 +443,61 @@
finish := false.
[s atEnd or:[finish]] whileFalse:[
- c := s next asUppercase.
- c isSeparator ifTrue:[
- stopOnSeparator ifFalse:[
- ^ RomanNumberFormatError raiseErrorString:'garbage at the end'
- ].
- finish := true.
- ] ifFalse:[
- digitVal := romanValues at:c ifAbsent:nil.
- digitVal isNil ifTrue:[
- ^ RomanNumberFormatError raiseErrorString:'invalid character'
- ].
-
- digitVal = prevDigitVal ifTrue:[
- ( #( 1 10 100 1000) includes:digitVal) ifFalse:[
- ^ RomanNumberFormatError raiseErrorString:'character may not be repeated'
- ].
- val := val + digitVal.
- countSame := countSame + 1.
- countSame >= 4 ifTrue:[
- digitVal ~= 1000 ifTrue:[
- countSame > 4 ifTrue:[
- "/ this is a bad roman number (such as MCCCCCCCCXXXXXXII);
- "/ Its not correct, but sometimes encountered on buildings.
- "/ If you do not want to be too picky,
- "/ provide a proceeding handler in order to proceed the conversion.
- BadRomanNumberFormatError raiseRequestErrorString:'more than 4 occurrences of same character'
- ] ifFalse:[
- "/ this is a naive roman number (such as VIIII);
- "/ Its not correct, but very often encountered (especially as page numbers).
- "/ The notification below normally goes unnoticed, unless some input validator
- "/ wants to be very picky, and treat this as an error.
- "/ To do so, provide a handler for NaiveRomanNumberFormatNotification.
- NaiveRomanNumberFormatNotification raiseRequestErrorString:'more than 3 occurrences of same character'.
- ]
- ]
- ].
- ] ifFalse:[
- digitVal < prevDigitVal ifTrue:[
- val := val + digitVal.
- ] ifFalse:[
- countSame == 1 ifFalse:[
- ^ RomanNumberFormatError raiseErrorString:'invalid character combination'
- ].
- delta := digitVal - prevDigitVal.
- ( #( 4 9 40 90 400 900) includes:delta) ifFalse:[
- ^ RomanNumberFormatError raiseErrorString:'invalid character combination'
- ].
- val := val - prevDigitVal.
- val := val + delta.
- digitVal := prevDigitVal - 0.1. "/ trick: prevent prevDigit from arriving again.
- ].
- countSame := 1.
- ].
- prevDigitVal := digitVal.
- ].
+ c := s next asUppercase.
+ c isSeparator ifTrue:[
+ stopOnSeparator ifFalse:[
+ ^ RomanNumberFormatError raiseErrorString:'garbage at the end'
+ ].
+ finish := true.
+ ] ifFalse:[
+ digitVal := romanValues at:c ifAbsent:nil.
+ digitVal isNil ifTrue:[
+ ^ RomanNumberFormatError raiseErrorString:'invalid character'
+ ].
+
+ digitVal = prevDigitVal ifTrue:[
+ ( #( 1 10 100 1000) includes:digitVal) ifFalse:[
+ ^ RomanNumberFormatError raiseErrorString:'character may not be repeated'
+ ].
+ val := val + digitVal.
+ countSame := countSame + 1.
+ countSame >= 4 ifTrue:[
+ digitVal ~= 1000 ifTrue:[
+ countSame > 4 ifTrue:[
+ "/ this is a bad roman number (such as MCCCCCCCCXXXXXXII);
+ "/ Its not correct, but sometimes encountered on buildings.
+ "/ If you do not want to be too picky,
+ "/ provide a proceeding handler in order to proceed the conversion.
+ BadRomanNumberFormatError raiseRequestErrorString:'more than 4 occurrences of same character'
+ ] ifFalse:[
+ "/ this is a naive roman number (such as VIIII);
+ "/ Its not correct, but very often encountered (especially as page numbers).
+ "/ The notification below normally goes unnoticed, unless some input validator
+ "/ wants to be very picky, and treat this as an error.
+ "/ To do so, provide a handler for NaiveRomanNumberFormatNotification.
+ NaiveRomanNumberFormatNotification raiseRequestErrorString:'more than 3 occurrences of same character'.
+ ]
+ ]
+ ].
+ ] ifFalse:[
+ digitVal < prevDigitVal ifTrue:[
+ val := val + digitVal.
+ ] ifFalse:[
+ countSame == 1 ifFalse:[
+ ^ RomanNumberFormatError raiseErrorString:'invalid character combination'
+ ].
+ delta := digitVal - prevDigitVal.
+ ( #( 4 9 40 90 400 900) includes:delta) ifFalse:[
+ ^ RomanNumberFormatError raiseErrorString:'invalid character combination'
+ ].
+ val := val - prevDigitVal.
+ val := val + delta.
+ digitVal := prevDigitVal - 0.1. "/ trick: prevent prevDigit from arriving again.
+ ].
+ countSame := 1.
+ ].
+ prevDigitVal := digitVal.
+ ].
].
"/ val > 5000 ifTrue:[
"/ ^ RomanNumberFormatError raiseErrorStirng:'number out of range (1..5000)'
@@ -525,86 +525,86 @@
Integer readFromRomanString:'MCCCCCCCCXXXXXXIIIIII'
BadRomanNumberFormatError ignoreIn:[
- Integer readFromRomanString:'MCCCCCCCCXXXXXXIIIIII'
+ Integer readFromRomanString:'MCCCCCCCCXXXXXXIIIIII'
]
"
"naive cases:
#(
- 'MCMXCIX' 1999
- 'MCMXCVIIII' 1999
- 'MCMLXXXXIX' 1999
- 'MDCCCCXCIX' 1999
- 'MDCCCCXCVIIII' 1999
- 'MDCCCCLXXXXIX' 1999
- 'MDCCCCLXXXXVIIII' 1999
+ 'MCMXCIX' 1999
+ 'MCMXCVIIII' 1999
+ 'MCMLXXXXIX' 1999
+ 'MDCCCCXCIX' 1999
+ 'MDCCCCXCVIIII' 1999
+ 'MDCCCCLXXXXIX' 1999
+ 'MDCCCCLXXXXVIIII' 1999
) pairWiseDo:[:goodString :expectedValue |
- (Integer readFromRomanString:goodString onError:nil) ~= expectedValue ifTrue:[self halt].
+ (Integer readFromRomanString:goodString onError:nil) ~= expectedValue ifTrue:[self halt].
]
"
"error cases:
#(
- 'XIIX'
- 'VV'
- 'VVV'
- 'XXL'
- 'XLX'
- 'LC'
- 'LL'
- 'DD'
+ 'XIIX'
+ 'VV'
+ 'VVV'
+ 'XXL'
+ 'XLX'
+ 'LC'
+ 'LL'
+ 'DD'
) do:[:badString |
- (Integer readFromRomanString:badString onError:nil) notNil ifTrue:[self halt].
+ (Integer readFromRomanString:badString onError:nil) notNil ifTrue:[self halt].
]
"
"good cases:
#( 'I' 1
- 'II' 2
- 'III' 3
- 'IV' 4
- 'V' 5
- 'VI' 6
- 'VII' 7
- 'VIII' 8
- 'IX' 9
- 'X' 10
- 'XI' 11
- 'XII' 12
- 'XIII' 13
- 'XIV' 14
- 'XV' 15
- 'XVI' 16
- 'XVII' 17
- 'XVIII' 18
- 'XIX' 19
- 'XX' 20
- 'XXX' 30
- 'L' 50
- 'XL' 40
- 'LX' 60
- 'LXX' 70
- 'LXXX' 80
- 'CXL' 140
- 'CL' 150
- 'CLX' 160
- 'MMM' 3000
- 'MMMM' 4000
- 'MMMMCMXCIX' 4999
- 'MMMMMMMMMCMXCIX' 9999
+ 'II' 2
+ 'III' 3
+ 'IV' 4
+ 'V' 5
+ 'VI' 6
+ 'VII' 7
+ 'VIII' 8
+ 'IX' 9
+ 'X' 10
+ 'XI' 11
+ 'XII' 12
+ 'XIII' 13
+ 'XIV' 14
+ 'XV' 15
+ 'XVI' 16
+ 'XVII' 17
+ 'XVIII' 18
+ 'XIX' 19
+ 'XX' 20
+ 'XXX' 30
+ 'L' 50
+ 'XL' 40
+ 'LX' 60
+ 'LXX' 70
+ 'LXXX' 80
+ 'CXL' 140
+ 'CL' 150
+ 'CLX' 160
+ 'MMM' 3000
+ 'MMMM' 4000
+ 'MMMMCMXCIX' 4999
+ 'MMMMMMMMMCMXCIX' 9999
) pairWiseDo:[:goodString :expectedValue |
- (Integer readFromRomanString:goodString onError:nil) ~= expectedValue ifTrue:[self halt].
+ (Integer readFromRomanString:goodString onError:nil) ~= expectedValue ifTrue:[self halt].
]
"
"
1 to:9999 do:[:n |
- |romanString|
-
- romanString := String streamContents:[:stream | n printRomanOn:stream].
- (Integer readFromRomanString:romanString onError:nil) ~= n ifTrue:[self halt].
+ |romanString|
+
+ romanString := String streamContents:[:stream | n printRomanOn:stream].
+ (Integer readFromRomanString:romanString onError:nil) ~= n ifTrue:[self halt].
]
"
!
@@ -619,12 +619,12 @@
|val|
RomanNumberFormatError
- handle:[:ex |
- val := exceptionalValue value
- ]
- do:[
- val := self readFromRomanString:aStringOrStream
- ].
+ handle:[:ex |
+ val := exceptionalValue value
+ ]
+ do:[
+ val := self readFromRomanString:aStringOrStream
+ ].
^ val
@@ -647,85 +647,85 @@
"error cases:
#(
- 'XIIX'
- 'VV'
- 'VVV'
- 'XXL'
- 'XLX'
- 'LC'
- 'LL'
- 'DD'
+ 'XIIX'
+ 'VV'
+ 'VVV'
+ 'XXL'
+ 'XLX'
+ 'LC'
+ 'LL'
+ 'DD'
) do:[:badString |
- (Integer readFromRomanString:badString onError:nil) notNil ifTrue:[self halt].
+ (Integer readFromRomanString:badString onError:nil) notNil ifTrue:[self halt].
]
"
"naive (but handled) cases:
#(
- 'IIII' 4
- 'VIIII' 9
- 'XIIII' 14
- 'XVIIII' 19
+ 'IIII' 4
+ 'VIIII' 9
+ 'XIIII' 14
+ 'XVIIII' 19
) pairWiseDo:[:goodString :expectedValue |
- (Integer readFromRomanString:goodString onError:nil) ~= expectedValue ifTrue:[self halt].
+ (Integer readFromRomanString:goodString onError:nil) ~= expectedValue ifTrue:[self halt].
]
"
"good cases:
#( 'I' 1
- 'II' 2
- 'III' 3
- 'IV' 4
- 'V' 5
- 'VI' 6
- 'VII' 7
- 'VIII' 8
- 'IX' 9
- 'X' 10
- 'XI' 11
- 'XII' 12
- 'XIII' 13
- 'XIV' 14
- 'XV' 15
- 'XVI' 16
- 'XVII' 17
- 'XVIII' 18
- 'XIX' 19
- 'XX' 20
- 'XXX' 30
- 'L' 50
- 'XL' 40
- 'LX' 60
- 'LXX' 70
- 'LXXX' 80
- 'CXL' 140
- 'CL' 150
- 'CLX' 160
- 'MMM' 3000
- 'MMMM' 4000
- 'MMMMCMXCIX' 4999
- 'MMMMMMMMMCMXCIX' 9999
+ 'II' 2
+ 'III' 3
+ 'IV' 4
+ 'V' 5
+ 'VI' 6
+ 'VII' 7
+ 'VIII' 8
+ 'IX' 9
+ 'X' 10
+ 'XI' 11
+ 'XII' 12
+ 'XIII' 13
+ 'XIV' 14
+ 'XV' 15
+ 'XVI' 16
+ 'XVII' 17
+ 'XVIII' 18
+ 'XIX' 19
+ 'XX' 20
+ 'XXX' 30
+ 'L' 50
+ 'XL' 40
+ 'LX' 60
+ 'LXX' 70
+ 'LXXX' 80
+ 'CXL' 140
+ 'CL' 150
+ 'CLX' 160
+ 'MMM' 3000
+ 'MMMM' 4000
+ 'MMMMCMXCIX' 4999
+ 'MMMMMMMMMCMXCIX' 9999
) pairWiseDo:[:goodString :expectedValue |
- (Integer readFromRomanString:goodString onError:nil) ~= expectedValue ifTrue:[self halt].
+ (Integer readFromRomanString:goodString onError:nil) ~= expectedValue ifTrue:[self halt].
]
"
"
1 to:9999 do:[:n |
- |romanString|
-
- romanString := String streamContents:[:stream | n printRomanOn:stream].
- (Integer readFromRomanString:romanString onError:nil) ~= n ifTrue:[self halt].
+ |romanString|
+
+ romanString := String streamContents:[:stream | n printRomanOn:stream].
+ (Integer readFromRomanString:romanString onError:nil) ~= n ifTrue:[self halt].
]
"
"reading naive numbers:
1 to:9999 do:[:n |
- |romanString|
-
- romanString := String streamContents:[:stream | n printRomanOn:stream naive:true].
- (Integer readFromRomanString:romanString onError:nil) ~= n ifTrue:[self halt].
+ |romanString|
+
+ romanString := String streamContents:[:stream | n printRomanOn:stream naive:true].
+ (Integer readFromRomanString:romanString onError:nil) ~= n ifTrue:[self halt].
]
"
!
@@ -764,9 +764,9 @@
initialize
BCDConversionErrorSignal isNil ifTrue:[
- BCDConversionErrorSignal := ConversionError newSignal.
- BCDConversionErrorSignal nameClass:self message:#bcdConversionErrorSignal.
- BCDConversionErrorSignal notifierString:'bcd conversion error'.
+ BCDConversionErrorSignal := ConversionError newSignal.
+ BCDConversionErrorSignal nameClass:self message:#bcdConversionErrorSignal.
+ BCDConversionErrorSignal notifierString:'bcd conversion error'.
].
"Modified: / 15.11.1999 / 20:36:04 / cg"
@@ -844,7 +844,7 @@
PrimeCache := nil.
bits := BooleanArray new:limit//2.
self primesUpTo:limit do:[:p |
- bits at:p//2 put:true
+ bits at:p//2 put:true
].
PrimeCache := bits.
@@ -859,11 +859,11 @@
"
Integer flushPrimeCache.
Transcript showCR:(
- Time millisecondsToRun:[ 1 to:100000 do:[:n | n isPrime] ]
+ Time millisecondsToRun:[ 1 to:100000 do:[:n | n isPrime] ]
).
Integer initializePrimeCacheUpTo:100000.
Transcript showCR:(
- Time millisecondsToRun:[ 1 to:100000 do:[:n | n isPrime] ]
+ Time millisecondsToRun:[ 1 to:100000 do:[:n | n isPrime] ]
).
Integer flushPrimeCache.
"
@@ -900,45 +900,45 @@
index := 6.
2 to: 2309 do:[:n|
- [(primesUpTo2310 at: index) < n]
- whileTrue:[index := index + 1].
- n = (primesUpTo2310 at: index) ifTrue:[
- maskBitIndex at: n+1 put: (bitIndex := bitIndex + 1).
- ] ifFalse:[
- "if modulo any of the prime factors of 2310, then could not be prime"
- (n \\ 2 = 0 or:[n \\ 3 = 0 or:[n \\ 5 = 0 or:[n \\ 7 = 0 or:[n \\ 11 = 0]]]])
- ifTrue:[maskBitIndex at: n+1 put: 0]
- ifFalse:[maskBitIndex at: n+1 put: (bitIndex := bitIndex + 1)].
- ].
+ [(primesUpTo2310 at: index) < n]
+ whileTrue:[index := index + 1].
+ n = (primesUpTo2310 at: index) ifTrue:[
+ maskBitIndex at: n+1 put: (bitIndex := bitIndex + 1).
+ ] ifFalse:[
+ "if modulo any of the prime factors of 2310, then could not be prime"
+ (n \\ 2 = 0 or:[n \\ 3 = 0 or:[n \\ 5 = 0 or:[n \\ 7 = 0 or:[n \\ 11 = 0]]]])
+ ifTrue:[maskBitIndex at: n+1 put: 0]
+ ifFalse:[maskBitIndex at: n+1 put: (bitIndex := bitIndex + 1)].
+ ].
].
"Now the real work begins...
Start with 13 since multiples of 2,3,5,7,11 are handled by the storage method;
increment by 2 for odd numbers only."
13 to: limit by: 2 do:[:n|
- (maskBit := maskBitIndex at: (n \\ 2310 + 1)) = 0 ifFalse:["not a multiple of 2,3,5,7,11"
- byteIndex := n // 2310 * 60 + (maskBit-1 bitShift: -3) + 1.
- bitIndex := 1 bitShift: (maskBit bitAnd: 7).
- ((flags at: byteIndex) bitAnd: bitIndex) = 0 ifFalse:["not marked -- n is prime"
- aBlock value: n.
- "Start with n*n since any integer < n has already been sieved
- (e.g., any multiple of n with a number k < n has been cleared
- when k was sieved); add 2 * i to avoid even numbers and
- mark all multiples of this prime. Note: n < indexLimit below
- limits running into LargeInts -- nothing more."
- n < indexLimit ifTrue:[
- index := n * n.
- (index bitAnd: 1) = 0 ifTrue:[index := index + n].
- [index <= limit] whileTrue:[
- (maskBit := maskBitIndex at: (index \\ 2310 + 1)) = 0 ifFalse:[
- byteIndex := (index // 2310 * 60) + (maskBit-1 bitShift: -3) + 1.
- maskBit := 255 - (1 bitShift: (maskBit bitAnd: 7)).
- flags at: byteIndex put: ((flags at: byteIndex) bitAnd: maskBit).
- ].
- index := index + (2 * n)].
- ].
- ].
- ].
+ (maskBit := maskBitIndex at: (n \\ 2310 + 1)) = 0 ifFalse:["not a multiple of 2,3,5,7,11"
+ byteIndex := n // 2310 * 60 + (maskBit-1 bitShift: -3) + 1.
+ bitIndex := 1 bitShift: (maskBit bitAnd: 7).
+ ((flags at: byteIndex) bitAnd: bitIndex) = 0 ifFalse:["not marked -- n is prime"
+ aBlock value: n.
+ "Start with n*n since any integer < n has already been sieved
+ (e.g., any multiple of n with a number k < n has been cleared
+ when k was sieved); add 2 * i to avoid even numbers and
+ mark all multiples of this prime. Note: n < indexLimit below
+ limits running into LargeInts -- nothing more."
+ n < indexLimit ifTrue:[
+ index := n * n.
+ (index bitAnd: 1) = 0 ifTrue:[index := index + n].
+ [index <= limit] whileTrue:[
+ (maskBit := maskBitIndex at: (index \\ 2310 + 1)) = 0 ifFalse:[
+ byteIndex := (index // 2310 * 60) + (maskBit-1 bitShift: -3) + 1.
+ maskBit := 255 - (1 bitShift: (maskBit bitAnd: 7)).
+ flags at: byteIndex put: ((flags at: byteIndex) bitAnd: maskBit).
+ ].
+ index := index + (2 * n)].
+ ].
+ ].
+ ].
].
"
@@ -960,11 +960,11 @@
"
Integer flushPrimeCache.
Transcript showCR:(
- Time millisecondsToRun:[ 1 to:100000 do:[:n | n isPrime] ]
+ Time millisecondsToRun:[ 1 to:100000 do:[:n | n isPrime] ]
).
Integer initializePrimeCacheUpTo:100000.
Transcript showCR:(
- Time millisecondsToRun:[ 1 to:100000 do:[:n | n isPrime] ]
+ Time millisecondsToRun:[ 1 to:100000 do:[:n | n isPrime] ]
).
Integer flushPrimeCache.
"
@@ -974,30 +974,30 @@
"/ primes up to 1000
^ #(
- 2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71
- 73 79 83 89 97 101 103 107 109 113 127 131 137 139 149 151 157 163 167
- 173 179 181 191 193 197 199 211 223 227 229 233 239 241 251 257 263 269 271
- 277 281 283 293 307 311 313 317 331 337 347 349 353 359 367 373 379 383 389
- 397 401 409 419 421 431 433 439 443 449 457 461 463 467 479 487 491 499 503
- 509 521 523 541 547 557 563 569 571 577 587 593 599 601 607 613 617 619 631
- 641 643 647 653 659 661 673 677 683 691 701 709 719 727 733 739 743 751 757
- 761 769 773 787 797 809 811 821 823 827 829 839 853 857 859 863 877 881 883
- 887 907 911 919 929 937 941 947 953 967 971 977 983 991 997
-
- 1009 1013 1019 1021 1031 1033 1039 1049 1051 1061 1063 1069 1087 1091 1093
- 1097 1103 1109 1117 1123 1129 1151 1153 1163 1171 1181 1187 1193 1201 1213
- 1217 1223 1229 1231 1237 1249 1259 1277 1279 1283 1289 1291 1297 1301 1303
- 1307 1319 1321 1327 1361 1367 1373 1381 1399 1409 1423 1427 1429 1433 1439
- 1447 1451 1453 1459 1471 1481 1483 1487 1489 1493 1499 1511 1523 1531 1543
- 1549 1553 1559 1567 1571 1579 1583 1597 1601 1607 1609 1613 1619 1621 1627
- 1637 1657 1663 1667 1669 1693 1697 1699 1709 1721 1723 1733 1741 1747 1753
- 1759 1777 1783 1787 1789 1801 1811 1823 1831 1847 1861 1867 1871 1873 1877
- 1879 1889 1901 1907 1913 1931 1933 1949 1951 1973 1979 1987 1993 1997 1999
- ).
+ 2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71
+ 73 79 83 89 97 101 103 107 109 113 127 131 137 139 149 151 157 163 167
+ 173 179 181 191 193 197 199 211 223 227 229 233 239 241 251 257 263 269 271
+ 277 281 283 293 307 311 313 317 331 337 347 349 353 359 367 373 379 383 389
+ 397 401 409 419 421 431 433 439 443 449 457 461 463 467 479 487 491 499 503
+ 509 521 523 541 547 557 563 569 571 577 587 593 599 601 607 613 617 619 631
+ 641 643 647 653 659 661 673 677 683 691 701 709 719 727 733 739 743 751 757
+ 761 769 773 787 797 809 811 821 823 827 829 839 853 857 859 863 877 881 883
+ 887 907 911 919 929 937 941 947 953 967 971 977 983 991 997
+
+ 1009 1013 1019 1021 1031 1033 1039 1049 1051 1061 1063 1069 1087 1091 1093
+ 1097 1103 1109 1117 1123 1129 1151 1153 1163 1171 1181 1187 1193 1201 1213
+ 1217 1223 1229 1231 1237 1249 1259 1277 1279 1283 1289 1291 1297 1301 1303
+ 1307 1319 1321 1327 1361 1367 1373 1381 1399 1409 1423 1427 1429 1433 1439
+ 1447 1451 1453 1459 1471 1481 1483 1487 1489 1493 1499 1511 1523 1531 1543
+ 1549 1553 1559 1567 1571 1579 1583 1597 1601 1607 1609 1613 1619 1621 1627
+ 1637 1657 1663 1667 1669 1693 1697 1699 1709 1721 1723 1733 1741 1747 1753
+ 1759 1777 1783 1787 1789 1801 1811 1823 1831 1847 1861 1867 1871 1873 1877
+ 1879 1889 1901 1907 1913 1931 1933 1949 1951 1973 1979 1987 1993 1997 1999
+ ).
!
primesUpTo: max
- "Return a list of prime integers up to abd including the given integer."
+ "Return a list of prime integers up to and including the given integer."
^ Array streamContents:[:s| self primesUpTo: max do:[:prime| s nextPut: prime]]
@@ -1013,8 +1013,8 @@
N := 1000.
p := 1.
a := (1 to:1000)
- collect:[:i | p := p nextPrime. p ]
- thenSelect:[:p | p <= N].
+ collect:[:i | p := p nextPrime. p ]
+ thenSelect:[:p | p <= N].
b := Integer primesUpTo:N.
self assert:(a = b)
"
@@ -1024,8 +1024,8 @@
N := 1000 nextPrime.
p := 1.
a := (1 to:1000)
- collect:[:i | p := p nextPrime. p ]
- thenSelect:[:p | p <= N].
+ collect:[:i | p := p nextPrime. p ]
+ thenSelect:[:p | p <= N].
b := Integer primesUpTo:N.
self assert:(a = b)
"
@@ -1035,8 +1035,8 @@
N := 1000 nextPrime-1.
p := 1.
a := (1 to:1000)
- collect:[:i | p := p nextPrime. p ]
- thenSelect:[:p | p <= N].
+ collect:[:i | p := p nextPrime. p ]
+ thenSelect:[:p | p <= N].
b := Integer primesUpTo:N.
self assert:(a = b)
"
@@ -1046,8 +1046,8 @@
N := 100000.
p := 1.
a := (1 to:N)
- collect:[:i | p := p nextPrime. p ]
- thenSelect:[:p | p <= N].
+ collect:[:i | p := p nextPrime. p ]
+ thenSelect:[:p | p <= N].
b := Integer primesUpTo:N.
self assert:(a = b)
"
@@ -1057,8 +1057,8 @@
N := 100000 nextPrime.
p := 1.
a := (1 to:N)
- collect:[:i | p := p nextPrime. p ]
- thenSelect:[:p | p <= N].
+ collect:[:i | p := p nextPrime. p ]
+ thenSelect:[:p | p <= N].
b := Integer primesUpTo:N.
self assert:(a = b)
"
@@ -1068,8 +1068,8 @@
N := 100000 nextPrime-1.
p := 1.
a := (1 to:N)
- collect:[:i | p := p nextPrime. p ]
- thenSelect:[:p | p <= N].
+ collect:[:i | p := p nextPrime. p ]
+ thenSelect:[:p | p <= N].
b := Integer primesUpTo:N.
self assert:(a = b)
"
@@ -1081,21 +1081,21 @@
| limit flags prime k |
max <= 2000 ifTrue:[
- self primesUpTo2000 do:[:p |
- p > max ifTrue:[^ self].
- aBlock value:p.
- ].
- ^ self.
+ self primesUpTo2000 do:[:p |
+ p > max ifTrue:[^ self].
+ aBlock value:p.
+ ].
+ ^ self.
].
max <= self primeCacheSize ifTrue:[
- aBlock value:2.
- 3 to:max by:2 do:[:p |
- (PrimeCache at:p//2) ifTrue:[
- aBlock value:p
- ].
- ].
- ^ self.
+ aBlock value:2.
+ 3 to:max by:2 do:[:p |
+ (PrimeCache at:p//2) ifTrue:[
+ aBlock value:p
+ ].
+ ].
+ ^ self.
].
limit := max asInteger - 1.
@@ -1106,15 +1106,15 @@
"/ sieve, on the fly
flags := (ByteArray new: limit) atAllPut: 1.
1 to: limit do: [:i |
- (flags at: i) == 1 ifTrue: [
- prime := i + 1.
- k := i + prime.
- [k <= limit] whileTrue: [
- flags at: k put: 0.
- k := k + prime
- ].
- aBlock value: prime
- ]
+ (flags at: i) == 1 ifTrue: [
+ prime := i + 1.
+ k := i + prime.
+ [k <= limit] whileTrue: [
+ flags at: k put: 0.
+ k := k + prime
+ ].
+ aBlock value: prime
+ ]
].
"
@@ -1188,20 +1188,20 @@
"Answer the result of setting/resetting the specified mask in the receiver."
^ aBoolean
- ifTrue: [self maskSet:integerMask]
- ifFalse: [self maskClear:integerMask]
+ ifTrue: [self maskSet:integerMask]
+ ifFalse: [self maskClear:integerMask]
"turn on the 1-bit:
- |v|
-
- v := 2r0100.
- v mask:1 set:true
+ |v|
+
+ v := 2r0100.
+ v mask:1 set:true
turn off the 1-bit:
- |v|
-
- v := 2r0101.
- v mask:1 set:false
+ |v|
+
+ v := 2r0101.
+ v mask:1 set:false
"
!
@@ -1243,7 +1243,7 @@
asByteArray
"return my hexBytes in MSB"
- ^ self digitBytesMSB:true
+ ^ self digitBytesMSB
!
asByteArrayOfSize:size
@@ -1256,13 +1256,15 @@
[repeats timesRepeat: (number asByteArrayOfSize: 1024) ] timeToRun.
)))"
- | bytes |
-
- bytes := self digitBytesMSB:true.
- size < bytes size ifTrue: [
+ | bytes bytesSize|
+
+ bytes := self digitBytesMSB.
+ bytesSize := bytes size.
+ size < bytesSize ifTrue: [
^ ConversionError raiseRequestWith:self errorString:'number too big for ', size asString
].
- ^ (ByteArray new: (size - bytes size)), bytes
+ ^ (ByteArray new:size)
+ replaceFrom:size-bytesSize+1 to:size with:bytes startingAt:1.
"
123 asByteArrayOfSize:1 #[123]
@@ -1349,7 +1351,7 @@
"funny - although the romans did not have negative numbers - squeak has"
self negative ifTrue:[
- ^ '-' , self negated romanPrintString
+ ^ '-' , self negated romanPrintString
].
^ self romanPrintString
!
@@ -1393,15 +1395,15 @@
rslt := 0.
multiplier := 1.
[v > 0] whileTrue:[
- nibble := v bitAnd:16r0F.
- nibble > 9 ifTrue:[
- ^ BCDConversionErrorSignal
- raiseRequestWith:self
- errorString:'bad BCD coded value'
- ].
- rslt := rslt + (nibble * multiplier).
- multiplier := multiplier * 10.
- v := v bitShift:-4.
+ nibble := v bitAnd:16r0F.
+ nibble > 9 ifTrue:[
+ ^ BCDConversionErrorSignal
+ raiseRequestWith:self
+ errorString:'bad BCD coded value'
+ ].
+ rslt := rslt + (nibble * multiplier).
+ multiplier := multiplier * 10.
+ v := v bitShift:-4.
].
^ rslt
@@ -1436,9 +1438,9 @@
v := self.
rslt := shift := 0.
[v > 0] whileTrue:[
- rslt := rslt + ((v \\ 10) bitShift:shift).
- shift := shift + 4.
- v := v // 10.
+ rslt := rslt + ((v \\ 10) bitShift:shift).
+ shift := shift + 4.
+ v := v // 10.
].
^ rslt
@@ -1491,18 +1493,18 @@
result byte|
anInteger isInteger ifFalse:[
- ^ anInteger bitAndFromInteger:self.
+ ^ anInteger bitAndFromInteger:self.
].
n := (anInteger digitLength) min:(self digitLength).
result := self class basicNew numberOfDigits:n.
1 to:n do:[:index |
- byte := (anInteger digitAt:index) bitAnd:(self digitAt:index).
- result digitAt:index put:byte.
+ byte := (anInteger digitAt:index) bitAnd:(self digitAt:index).
+ result digitAt:index put:byte.
].
(byte == 0 or:[n <= SmallInteger maxBytes]) ifTrue:[
- ^ result compressed
+ ^ result compressed
].
^ result
@@ -1519,16 +1521,16 @@
bitAt:index
"return the value of the index's bit (index starts at 1) as 0 or 1.
Notice: the result of bitAt: on negative receivers is not
- defined in the language standard (since the implementation
- is free to choose any internal representation for integers)"
+ defined in the language standard (since the implementation
+ is free to choose any internal representation for integers)"
|i "{Class: SmallInteger}"|
i := index - 1.
i < 0 ifTrue:[
- ^ SubscriptOutOfBoundsSignal
- raiseRequestWith:index
- errorString:'index out of bounds'
+ ^ SubscriptOutOfBoundsError
+ raiseRequestWith:index
+ errorString:'index out of bounds'
].
^ (self digitAt:(i // 8 + 1)) bitAt:(i \\ 8 + 1)
@@ -1570,11 +1572,11 @@
result := self class basicNew numberOfDigits:n.
1 to:n do:[:index |
- byte := (self digitAt:index) bitClear:(anInteger digitAt:index).
- result digitAt:index put:byte.
+ byte := (self digitAt:index) bitClear:(anInteger digitAt:index).
+ result digitAt:index put:byte.
].
(byte == 0 or:[n <= SmallInteger maxBytes]) ifTrue:[
- ^ result compressed
+ ^ result compressed
].
^ result
!
@@ -1609,16 +1611,16 @@
The index for the least significant bit is 1."
1 to:self digitLength do:[:i8 |
- |byte|
-
- byte := self digitAt:i8.
- byte ~~ 0 ifTrue:[
- 1 to:8 do:[:i |
- (byte bitAt:i) == 1 ifTrue:[
- aBlock value:(((i8-1)*8) + i).
- ].
- ].
- ]
+ |byte|
+
+ byte := self digitAt:i8.
+ byte ~~ 0 ifTrue:[
+ 1 to:8 do:[:i |
+ (byte bitAt:i) == 1 ifTrue:[
+ aBlock value:(((i8-1)*8) + i).
+ ].
+ ].
+ ]
].
"
@@ -1695,15 +1697,15 @@
result byte|
anInteger isInteger ifFalse:[
- ^ anInteger bitOrFromInteger:self.
+ ^ anInteger bitOrFromInteger:self.
].
n := (anInteger digitLength) max:(self digitLength).
result := self class basicNew numberOfDigits:n.
1 to:n do:[:index |
- byte := (anInteger digitAt:index) bitOr:(self digitAt:index).
- result digitAt:index put:byte.
+ byte := (anInteger digitAt:index) bitOr:(self digitAt:index).
+ result digitAt:index put:byte.
].
"/ no need to normalize - if the operands were correct
"/ byte == 0 ifTrue:[
@@ -1717,9 +1719,9 @@
leftShift if shiftCount > 0; rightShift otherwise.
Notice: the result of bitShift: on negative receivers is not
- defined in the language standard (since the implementation
- is free to choose any internal representation for integers)
- However, ST/X preserves the sign."
+ defined in the language standard (since the implementation
+ is free to choose any internal representation for integers)
+ However, ST/X preserves the sign."
|result
prev "{ Class: SmallInteger }"
@@ -1734,149 +1736,149 @@
nDigits "{ Class: SmallInteger }" |
shiftCount isInteger ifFalse:[
- ^ shiftCount bitShiftFromInteger:self.
+ ^ shiftCount bitShiftFromInteger:self.
].
shiftCount > 0 ifTrue:[
- "left shift"
-
- 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.
- result sign:self sign.
- result digitBytes replaceFrom:(digitShift + 1) to:n with:self digitBytes.
- "
- no normalize needed, since receiver was already normalized
- "
- ^ result
- ].
-
- "
- less-than-8 shifts can be done faster ...
- "
- digitShift == 0 ifTrue:[
- nn := n+1.
- result := self class basicNew numberOfDigits:nn.
- result sign:self sign.
- prev := 0.
- 1 to:n do:[:index |
- byte := self digitAt:index.
- byte := (byte bitShift:bitShift) bitOr:prev.
- result digitAt:index put:(byte bitAnd:16rFF).
- prev := byte bitShift:-8.
- ].
- result digitAt:nn put:prev.
- "
- might have stored a 0-byte ...
- "
- prev == 0 ifTrue:[
- ^ result compressed
- ].
- ^ result.
- ].
-
- "
- slow case ...
- "
- n := n + digitShift + 1.
- result := self class basicNew numberOfDigits:n.
- result 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.
- byte := byte bitShift:bitShift.
- byte2 := byte2 bitShift:revShift.
- byte := (byte bitOr:byte2) bitAnd:16rFF.
- result digitAt:(index + digitShift) put:byte.
- ].
- byte2 := self digitAt:nDigits.
- byte2 := (byte2 bitShift:revShift) bitAnd:16rFF.
- result digitAt:(nDigits + digitShift + 1) put:byte2.
- "
- might have stored a 0-byte ...
- "
- byte2 == 0 ifTrue:[
- ^ result compressed
- ].
- ^ result
+ "left shift"
+
+ 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.
+ result sign:self sign.
+ result digitBytes replaceFrom:(digitShift + 1) to:n with:self digitBytes.
+ "
+ no normalize needed, since receiver was already normalized
+ "
+ ^ result
+ ].
+
+ "
+ less-than-8 shifts can be done faster ...
+ "
+ digitShift == 0 ifTrue:[
+ nn := n+1.
+ result := self class basicNew numberOfDigits:nn.
+ result sign:self sign.
+ prev := 0.
+ 1 to:n do:[:index |
+ byte := self digitAt:index.
+ byte := (byte bitShift:bitShift) bitOr:prev.
+ result digitAt:index put:(byte bitAnd:16rFF).
+ prev := byte bitShift:-8.
+ ].
+ result digitAt:nn put:prev.
+ "
+ might have stored a 0-byte ...
+ "
+ prev == 0 ifTrue:[
+ ^ result compressed
+ ].
+ ^ result.
+ ].
+
+ "
+ slow case ...
+ "
+ n := n + digitShift + 1.
+ result := self class basicNew numberOfDigits:n.
+ result 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.
+ byte := byte bitShift:bitShift.
+ byte2 := byte2 bitShift:revShift.
+ byte := (byte bitOr:byte2) bitAnd:16rFF.
+ result digitAt:(index + digitShift) put:byte.
+ ].
+ byte2 := self digitAt:nDigits.
+ byte2 := (byte2 bitShift:revShift) bitAnd:16rFF.
+ result digitAt:(nDigits + digitShift + 1) put:byte2.
+ "
+ might have stored a 0-byte ...
+ "
+ byte2 == 0 ifTrue:[
+ ^ result compressed
+ ].
+ ^ result
].
shiftCount < 0 ifTrue:[
- "right shift"
-
- digitShift := shiftCount negated // 8.
- bitShift := shiftCount negated \\ 8.
- n := self digitLength.
-
- digitShift >= n ifTrue:[
- ^ 0
- ].
-
- "
- modulo 8 shifts can be done faster ...
- "
- bitShift == 0 ifTrue:[
- n := n-digitShift.
- result := self class basicNew numberOfDigits:n.
- result sign:self sign.
- result digitBytes replaceFrom:1 to:n with:self digitBytes startingAt:(digitShift + 1) .
- n <= SmallInteger maxBytes ifTrue:[
- ^ result compressed
- ].
- ^ result
- ].
-
- "
- less-than-8 shifts can be done faster ...
- "
- digitShift == 0 ifTrue:[
- result := self class basicNew numberOfDigits:n.
- result sign:self sign.
- prev := 0.
- bitShift := bitShift negated.
- revShift := 8 + bitShift.
- n to:1 by:-1 do:[:index |
- byte := self digitAt:index.
- next := (byte bitShift:revShift) bitAnd:16rFF.
- byte := (byte bitShift:bitShift) bitOr:prev.
- result digitAt:index put:(byte bitAnd:16rFF).
- prev := next.
- ].
- ^ result compressed
- ].
-
- "
- slow case ...
- "
- nn := n-digitShift.
- result := self class basicNew numberOfDigits:nn.
- result sign:self sign.
-
- prev := 0.
- bitShift := bitShift negated.
- revShift := 8 + bitShift.
- nn := digitShift + 1.
- n to:nn by:-1 do:[:index |
- byte := self digitAt:index.
- next := (byte bitShift:revShift) bitAnd:16rFF.
- byte := (byte bitShift:bitShift) bitOr:prev.
- result digitAt:(index - digitShift) put:byte.
- prev := next.
- ].
- "the last stored byte ..."
- ^ result compressed
+ "right shift"
+
+ digitShift := shiftCount negated // 8.
+ bitShift := shiftCount negated \\ 8.
+ n := self digitLength.
+
+ digitShift >= n ifTrue:[
+ ^ 0
+ ].
+
+ "
+ modulo 8 shifts can be done faster ...
+ "
+ bitShift == 0 ifTrue:[
+ n := n-digitShift.
+ result := self class basicNew numberOfDigits:n.
+ result sign:self sign.
+ result digitBytes replaceFrom:1 to:n with:self digitBytes startingAt:(digitShift + 1) .
+ n <= SmallInteger maxBytes ifTrue:[
+ ^ result compressed
+ ].
+ ^ result
+ ].
+
+ "
+ less-than-8 shifts can be done faster ...
+ "
+ digitShift == 0 ifTrue:[
+ result := self class basicNew numberOfDigits:n.
+ result sign:self sign.
+ prev := 0.
+ bitShift := bitShift negated.
+ revShift := 8 + bitShift.
+ n to:1 by:-1 do:[:index |
+ byte := self digitAt:index.
+ next := (byte bitShift:revShift) bitAnd:16rFF.
+ byte := (byte bitShift:bitShift) bitOr:prev.
+ result digitAt:index put:(byte bitAnd:16rFF).
+ prev := next.
+ ].
+ ^ result compressed
+ ].
+
+ "
+ slow case ...
+ "
+ nn := n-digitShift.
+ result := self class basicNew numberOfDigits:nn.
+ result sign:self sign.
+
+ prev := 0.
+ bitShift := bitShift negated.
+ revShift := 8 + bitShift.
+ nn := digitShift + 1.
+ n to:nn by:-1 do:[:index |
+ byte := self digitAt:index.
+ next := (byte bitShift:revShift) bitAnd:16rFF.
+ byte := (byte bitShift:bitShift) bitOr:prev.
+ result digitAt:(index - digitShift) put:byte.
+ prev := next.
+ ].
+ "the last stored byte ..."
+ ^ result compressed
].
^ self "no shift"
@@ -1898,8 +1900,8 @@
n := (anInteger digitLength) min:(self digitLength).
1 to:n do:[:index |
- byte := (anInteger digitAt:index) bitAnd:(self digitAt:index).
- byte ~~ 0 ifTrue:[^ true].
+ byte := (anInteger digitAt:index) bitAnd:(self digitAt:index).
+ byte ~~ 0 ifTrue:[^ true].
].
^ false
@@ -1927,18 +1929,18 @@
result byte|
anInteger isInteger ifFalse:[
- ^ anInteger bitXorFromInteger:self.
+ ^ anInteger bitXorFromInteger:self.
].
n := (anInteger digitLength) max:(self digitLength).
result := self class basicNew numberOfDigits:n.
1 to:n do:[:index |
- byte := (anInteger digitAt:index) bitXor:(self digitAt:index).
- result digitAt:index put:byte.
+ byte := (anInteger digitAt:index) bitXor:(self digitAt:index).
+ result digitAt:index put:byte.
].
(byte == 0 or:[n <= SmallInteger maxBytes]) ifTrue:[
- ^ result compressed
+ ^ result compressed
].
^ result
@@ -2049,7 +2051,7 @@
byteNr := self digitLength.
byteNr == 0 ifTrue:[
- ^ 0
+ ^ 0
].
highByte := self digitAt:byteNr.
^ (byteNr - 1) * 8 + highByte highBit
@@ -2115,10 +2117,10 @@
maxBytes := self digitLength.
1 to:maxBytes do:[:byteIndex |
- byte := self digitAt:byteIndex.
- byte ~~ 0 ifTrue:[
- ^ (byteIndex-1)*8 + (byte lowBit)
- ].
+ byte := self digitAt:byteIndex.
+ byte ~~ 0 ifTrue:[
+ ^ (byteIndex-1)*8 + (byte lowBit)
+ ].
].
^ 0 "/ should not happen
@@ -2183,9 +2185,9 @@
rightShift if shiftCount > 0; leftShift otherwise.
Notice: the result of bitShift: on negative receivers is not
- defined in the language standard (since the implementation
- is free to choose any internal representation for integers)
- However, ST/X preserves the sign."
+ defined in the language standard (since the implementation
+ is free to choose any internal representation for integers)
+ However, ST/X preserves the sign."
^ self bitShift:(shiftCount negated)
@@ -2224,6 +2226,54 @@
"
! !
+!Integer methodsFor:'bit operators-32bit'!
+
+asSigned32
+ "return a 32-bit integer with my bit-pattern. For protocol completeness."
+
+ ^ self
+!
+
+asUnsigned32
+ "return a 32-bit integer with my bit-pattern, but positive.
+ May be required for bit operations on the sign-bit and/or to
+ convert C/Java numbers."
+
+ self < 0 ifTrue:[
+ ^ 16r100000000 + self
+ ].
+ ^ self
+
+ "
+ (-1 asUnsigned32) hexPrintString
+ 1 asUnsigned32
+ (SmallInteger minVal asUnsigned32) hexPrintString
+ (SmallInteger maxVal asUnsigned32) hexPrintString
+ "
+! !
+
+!Integer methodsFor:'bit operators-64bit'!
+
+asUnsigned64
+ "return a 64-bit integer with my bit-pattern, but positive.
+ May be required for bit operations on the sign-bit and/or to
+ convert C/Java numbers."
+
+ self < 0 ifTrue:[
+ ^ 16r10000000000000000 + self
+ ].
+ ^ self
+
+ "
+ (-1 asUnsigned64) hexPrintString
+ 1 asUnsigned64
+ (SmallInteger minVal asUnsigned64) hexPrintString
+ (SmallInteger maxVal asUnsigned64) hexPrintString
+ "
+
+ "Created: / 26-07-2013 / 13:45:11 / cg"
+! !
+
!Integer methodsFor:'byte access'!
byteAt:anIndex
@@ -2265,7 +2315,7 @@
l := self negated digitLength.
(self digitByteAt:l) == 16rFF ifTrue:[
- ^ (l - 1) max:1
+ ^ (l - 1) max:1
].
^ l
@@ -2285,6 +2335,14 @@
^ self subclassResponsibility
!
+digitBytesMSB
+ "return a byteArray filled with the receivers bits
+ (8 bits of the absolute value per element),
+ most significant byte is first"
+
+ ^ self subclassResponsibility
+!
+
digitBytesMSB:msbFlag
"return a byteArray filled with the receivers bits
(8 bits of the absolute value per element),
@@ -2292,7 +2350,7 @@
otherwise least significant byte is first"
msbFlag ifTrue:[
- ^ self digitBytes copyReverse. "digitBytes may be shared - reverse a copy!!"
+ ^ self digitBytesMSB.
].
^ self digitBytes
@@ -2319,7 +2377,7 @@
"return the receiver as a fixedPoint number"
^ FixedPoint basicNew
- setNumerator:self denominator:1 scale:1
+ setNumerator:self denominator:1 scale:1
"
100 asFixedPoint
@@ -2334,7 +2392,7 @@
of post-decimal-point digits."
^ FixedPoint basicNew
- setNumerator:self denominator:1 scale:scale
+ setNumerator:self denominator:1 scale:scale
"
100 asFixedPoint:2
@@ -2460,8 +2518,8 @@
^ self bitAnd:16r3FFFFFFF.
"
- -20000000000000 hash
- 20000000000000 hash
+ -20000000000000 hash
+ 20000000000000 hash
"
"Created: / 14.11.1996 / 12:12:27 / cg"
@@ -2486,8 +2544,8 @@
d := aFraction denominator.
^ aFraction class
- numerator:(aFraction numerator - (self * d))
- denominator:d
+ numerator:(aFraction numerator - (self * d))
+ denominator:d
"Modified: 28.7.1997 / 19:08:30 / cg"
!
@@ -2515,7 +2573,7 @@
denominator := aFraction denominator.
numerator := aFraction numerator.
(denominator == 1) ifFalse:[
- ^ numerator = (self * denominator)
+ ^ numerator = (self * denominator)
].
^ numerator = self
!
@@ -2524,8 +2582,8 @@
"sent when a fraction does not know how to multiply the receiver, an integer"
^ aFraction class
- numerator:(self * aFraction numerator)
- denominator:aFraction denominator
+ numerator:(self * aFraction numerator)
+ denominator:aFraction denominator
"Modified: 28.7.1997 / 19:08:27 / cg"
!
@@ -2535,8 +2593,8 @@
Sent when aFraction does not know how to divide by the receiver."
^ aFraction class
- numerator:aFraction numerator
- denominator:(self * aFraction denominator)
+ numerator:aFraction numerator
+ denominator:(self * aFraction denominator)
"Modified: 28.7.1997 / 19:08:23 / cg"
!
@@ -2548,8 +2606,8 @@
d := aFraction denominator.
^ aFraction class
- numerator:(aFraction numerator + (self * d))
- denominator:d
+ numerator:(aFraction numerator + (self * d))
+ denominator:d
"Modified: 28.7.1997 / 19:08:11 / cg"
!
@@ -2583,12 +2641,12 @@
shift := selfLowBit min:argLowBit.
b := b bitShift:(argLowBit negated).
[a = 0] whileFalse:[
- a := a bitShift:(selfLowBit negated).
- a < b ifTrue:[
- t := a. a := b. b := t
- ].
- a := a - b.
- selfLowBit := a lowBit - 1.
+ a := a bitShift:(selfLowBit negated).
+ a < b ifTrue:[
+ t := a. a := b. b := t
+ ].
+ a := a - b.
+ selfLowBit := a lowBit - 1.
].
^ b bitShift:shift
@@ -2656,7 +2714,7 @@
Sometimes also called C(n,k) (for choose k from n)
binCo is defined as:
- n!!
+ n!!
----------
k!! (n-k)!!
@@ -2677,13 +2735,13 @@
k := kIn.
k > (self / 2) ifTrue:[
- "/ symmetry
- k := self - k.
+ "/ symmetry
+ k := self - k.
].
acc := 1.
1 to:k do:[:i |
- acc := acc * (self - k + i) / i.
+ acc := acc * (self - k + i) / i.
].
^ acc
@@ -2712,8 +2770,8 @@
more performance (where the remainder is generated as a side effect of division)"
^ Array
- with:(self // aNumber)
- with:(self \\ aNumber)
+ with:(self // aNumber)
+ with:(self \\ aNumber)
"
10 divMod:3
@@ -2730,20 +2788,20 @@
|a b gcd gcd1 u u1 v v1 tmp t swap shift "{SmallInteger}"|
self < tb ifTrue:[
- a := self.
- b := tb.
- swap := false.
+ a := self.
+ b := tb.
+ swap := false.
] ifFalse:[
- a := tb.
- b := self.
- swap := true.
+ a := tb.
+ b := self.
+ swap := true.
].
shift := ((a lowBit) min:(b lowBit))-1.
shift > 0 ifTrue:[
- tmp := shift negated.
- a := a bitShift:tmp.
- b := b bitShift:tmp.
+ tmp := shift negated.
+ a := a bitShift:tmp.
+ b := b bitShift:tmp.
].
gcd := a.
@@ -2756,26 +2814,26 @@
[
"/ The following condition is true:
"/ (a * u1) + (b * v1) ~= gcd1 ifTrue:[self halt].
- t := gcd1 divMod:gcd.
- gcd1 := gcd.
- gcd := t at:2.
- t := t at:1.
- tmp := v.
+ t := gcd1 divMod:gcd.
+ gcd1 := gcd.
+ gcd := t at:2.
+ t := t at:1.
+ tmp := v.
"/v1 - (v * t) - v1 + (v * t) ~= 0 ifTrue:[self halt].
- v := v1 - (v * t).
- v1 := tmp.
- tmp := u.
+ v := v1 - (v * t).
+ v1 := tmp.
+ tmp := u.
"/u1 - (u * t) - u1 + (u * t) ~= 0 ifTrue:[self halt].
- u := u1 - (u * t).
- u1 := tmp.
+ u := u1 - (u * t).
+ u1 := tmp.
gcd > 0] whileTrue.
shift > 0 ifTrue:[
- gcd1 := gcd1 bitShift:shift.
+ gcd1 := gcd1 bitShift:shift.
].
swap ifTrue:[
- ^ Array with:v1 with:u1 with:gcd1.
+ ^ Array with:v1 with:u1 with:gcd1.
].
^ Array with:u1 with:v1 with:gcd1.
@@ -2798,24 +2856,24 @@
|p i|
(self < 2) ifTrue:[
- self < 0 ifTrue:[
- "/
- "/ requested factorial of a negative number
- "/
- ^ self class
- raise:#domainErrorSignal
- receiver:self
- selector:#factorial
- arguments:#()
- errorString:'factorial of negative number'
- ].
- ^ 1
+ self < 0 ifTrue:[
+ "/
+ "/ requested factorial of a negative number
+ "/
+ ^ self class
+ raise:#domainErrorSignal
+ receiver:self
+ selector:#factorial
+ arguments:#()
+ errorString:'factorial of negative number'
+ ].
+ ^ 1
].
p := 2.
i := 3.
[i <= self] whileTrue:[
- p := p * i.
- i := i + 1.
+ p := p * i.
+ i := i + 1.
].
^ p
@@ -2841,7 +2899,7 @@
faster and does not suffer from stack overflow problems (with big receivers)."
(self >= 2) ifTrue:[
- ^ self * (self - 1) factorialR
+ ^ self * (self - 1) factorialR
].
^ 1
@@ -2857,12 +2915,12 @@
fib
"compute the fibionacci number for the receiver.
- fib(0) := 0
- fib(1) := 1
- fib(n) := fib(n-1) + fib(n-2)"
+ fib(0) := 0
+ fib(1) := 1
+ fib(n) := fib(n-1) + fib(n-2)"
self <= 0 ifTrue:[
- self == 0 ifTrue:[^ 0].
+ self == 0 ifTrue:[^ 0].
].
^ self fib_helper
@@ -2980,9 +3038,9 @@
b := anInteger abs.
a < b ifTrue:[
- t := a.
- a := b.
- b := t.
+ t := a.
+ a := b.
+ b := t.
].
b = 0 ifTrue: [^ a].
@@ -2994,9 +3052,9 @@
3141589999999999 gcd:1000000000000000
Time millisecondsToRun:[
- 10000 timesRepeat:[
- 123456789012345678901234567890 gcd: 9876543210987654321
- ]
+ 10000 timesRepeat:[
+ 123456789012345678901234567890 gcd: 9876543210987654321
+ ]
]
"
@@ -3126,11 +3184,11 @@
e := self extendedEuclid:n.
(e at:3) == 1 ifTrue:[
- ret := e at:1.
- ret negative ifTrue:[
- ^ ret + n
- ].
- ^ ret.
+ ret := e at:1.
+ ret negative ifTrue:[
+ ^ ret + n
+ ].
+ ^ ret.
].
^ 0
@@ -3143,7 +3201,7 @@
79 inverseMod:3220 -> 1019
3220 inverseMod:79 -> 54 (54 * 3220) \\ 79
1234567891 inverseMod:1111111111119
- -> 148726663534 (148726663534*1234567891) \\ 1111111111119
+ -> 148726663534 (148726663534*1234567891) \\ 1111111111119
14 extendedEuclid:11
@@ -3426,7 +3484,7 @@
both p and q, we can use Euler's theorem, expin^phi(m) = 1 (mod m),
to throw away multiples of phi(p) or phi(q) in e.
Letting ep = e mod phi(p) and
- eq = e mod phi(q)
+ eq = e mod phi(q)
then combining these two speedups, we only need to evaluate
p2 = ((expin mod p) ^ ep) mod p and
q2 = ((expin mod q) ^ eq) mod q.
@@ -3462,7 +3520,7 @@
t := t -= result.
t < 0 ifTrue:[
- t := t + q.
+ t := t + q.
].
t := t *= u.
t := mq modulusOf:t.
@@ -3496,7 +3554,7 @@
|s rest twoDigits hi lo|
self == 0 ifTrue:[
- ^ #[ 16r00 ]
+ ^ #[ 16r00 ]
].
"/ a very rough estimate on the final size ...
@@ -3504,11 +3562,11 @@
rest := self.
[rest > 0] whileTrue:[
- twoDigits := rest \\ 100.
- rest := rest // 100.
- hi := twoDigits \\ 10.
- lo := twoDigits // 10.
- s nextPut:(lo bitShift:4)+hi
+ twoDigits := rest \\ 100.
+ rest := rest // 100.
+ hi := twoDigits \\ 10.
+ lo := twoDigits // 10.
+ s nextPut:(lo bitShift:4)+hi
].
^ s contents reverse
@@ -3724,7 +3782,7 @@
string := stream contents.
actualSize := string size.
actualSize < sz ifTrue:[
- aStream next:sz-actualSize put:fillCharacter.
+ aStream next:sz-actualSize put:fillCharacter.
].
aStream nextPutAll:string.
@@ -3762,10 +3820,10 @@
"test all between 1 and 9999:
1 to:9999 do:[:n |
- |romanString|
-
- romanString := String streamContents:[:stream | n printRomanOn:stream].
- (Integer readFromRomanString:romanString onError:nil) ~= n ifTrue:[self halt].
+ |romanString|
+
+ romanString := String streamContents:[:stream | n printRomanOn:stream].
+ (Integer readFromRomanString:romanString onError:nil) ~= n ifTrue:[self halt].
]
"
!
@@ -3783,46 +3841,46 @@
restValue > 0 ifFalse:[self error:'negative roman'].
naive ifTrue:[
- spec := #(
- " value string repeat "
- 1000 'M' true
- 500 'D' false
- 100 'C' true
- 50 'L' false
- 10 'X' true
- 5 'V' false
- 1 'I' true
- ).
+ spec := #(
+ " value string repeat "
+ 1000 'M' true
+ 500 'D' false
+ 100 'C' true
+ 50 'L' false
+ 10 'X' true
+ 5 'V' false
+ 1 'I' true
+ ).
] ifFalse:[
- spec := #(
- " value string repeat "
- 1000 'M' true
- 900 'CM' false
- 500 'D' false
- 400 'CD' false
- 100 'C' true
- 90 'XC' false
- 50 'L' false
- 40 'XL' false
- 10 'X' true
- 9 'IX' false
- 5 'V' false
- 4 'IV' false
- 1 'I' true
- ).
+ spec := #(
+ " value string repeat "
+ 1000 'M' true
+ 900 'CM' false
+ 500 'D' false
+ 400 'CD' false
+ 100 'C' true
+ 90 'XC' false
+ 50 'L' false
+ 40 'XL' false
+ 10 'X' true
+ 9 'IX' false
+ 5 'V' false
+ 4 'IV' false
+ 1 'I' true
+ ).
].
spec
- inGroupsOf:3
- do:[:rValue :rString :repeatFlag |
-
- [
- (restValue >= rValue) ifTrue:[
- aStream nextPutAll:rString.
- restValue := restValue - rValue.
- ].
- ] doWhile:[ repeatFlag and:[ restValue >= rValue] ].
- ].
+ inGroupsOf:3
+ do:[:rValue :rString :repeatFlag |
+
+ [
+ (restValue >= rValue) ifTrue:[
+ aStream nextPutAll:rString.
+ restValue := restValue - rValue.
+ ].
+ ] doWhile:[ repeatFlag and:[ restValue >= rValue] ].
+ ].
"
1 to:10 do:[:i | i printRomanOn:Transcript naive:false. Transcript cr.].
@@ -3834,19 +3892,19 @@
"test all between 1 and 9999:
1 to:9999 do:[:n |
- |romanString|
-
- romanString := String streamContents:[:stream | n printRomanOn:stream naive:false].
- (Integer readFromRomanString:romanString onError:nil) ~= n ifTrue:[self halt].
+ |romanString|
+
+ romanString := String streamContents:[:stream | n printRomanOn:stream naive:false].
+ (Integer readFromRomanString:romanString onError:nil) ~= n ifTrue:[self halt].
]
"
"test naive all between 1 and 9999:
1 to:9999 do:[:n |
- |romanString|
-
- romanString := String streamContents:[:stream | n printRomanOn:stream naive:true].
- (Integer readFromRomanString:romanString onError:nil) ~= n ifTrue:[self halt].
+ |romanString|
+
+ romanString := String streamContents:[:stream | n printRomanOn:stream naive:true].
+ (Integer readFromRomanString:romanString onError:nil) ~= n ifTrue:[self halt].
]
"
!
@@ -3859,9 +3917,14 @@
^ self printStringRadix:base showRadix:false
+ "
+ 10 printStringRadix:16
+ "
+
"Created: / 19-01-1998 / 17:20:58 / stefan"
"Modified: / 20-01-1998 / 14:10:54 / stefan"
"Modified: / 23-09-2011 / 13:59:36 / cg"
+ "Modified (comment): / 26-07-2013 / 12:55:18 / cg"
!
printStringRadix:base showRadix:showRadixBoolean
@@ -3889,7 +3952,7 @@
s := self printStringRadix:aRadix.
actualSize := s size.
actualSize < sz ifTrue:[
- s := ((String new:(sz - actualSize)) atAllPut:fillCharacter) , s
+ s := ((String new:(sz - actualSize)) atAllPut:fillCharacter) , s
].
^ s
@@ -4029,9 +4092,9 @@
"/ the following is a q&d hack, using existing code.
^ (Integer
- readFromString:(self printStringRadix:p)
- radix:2
- onError:-1) isPowerOfTwo
+ readFromString:(self printStringRadix:p)
+ radix:2
+ onError:-1) isPowerOfTwo
"
16r0000000000000000 isPowerOf:2
@@ -4105,19 +4168,19 @@
self == 1 ifTrue:[^ false ].
self <= (PrimeCache size*2) ifTrue:[
- ^ PrimeCache at:self//2.
+ ^ PrimeCache at:self//2.
].
limit := self sqrt.
firstFewPrimes := self class primesUpTo2000.
firstFewPrimes do:[:p |
- p > limit ifTrue:[^ true].
- (self \\ p) == 0 ifTrue:[ ^ false ].
+ p > limit ifTrue:[^ true].
+ (self \\ p) == 0 ifTrue:[ ^ false ].
].
(firstFewPrimes last+2) to:limit by:2 do:[:i |
- (self \\ i) == 0 ifTrue:[ ^ false ].
+ (self \\ i) == 0 ifTrue:[ ^ false ].
].
^ true
@@ -4195,11 +4258,11 @@
num := self + 1.
num even ifTrue:[
- num == 2 ifTrue:[^ num].
- num := num + 1
+ num == 2 ifTrue:[^ num].
+ num := num + 1
].
[num isPrime] whileFalse:[
- num := num + 2
+ num := num + 2
].
^ num
@@ -4783,7 +4846,7 @@
copyright
"
COPYRIGHT (c) 1999 by eXept Software AG
- All Rights Reserved
+ All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
@@ -4801,31 +4864,31 @@
(with big numbers, this does make a difference)
WARNING: this does only work with numbers which have no common
- divisor (which is true for cryptographic applications).
- So, use this only if you know what you are doing ...
+ divisor (which is true for cryptographic applications).
+ So, use this only if you know what you are doing ...
[author:]
- Stefan Vogel
+ Stefan Vogel
[see also:]
- Integer SmallInteger LargeInsteger
+ Integer SmallInteger LargeInsteger
[instance variables:]
- modulus the modulus
- reciprocal reciprocal of the modulus
- shift shift count to cut off some bits
+ modulus the modulus
+ reciprocal reciprocal of the modulus
+ shift shift count to cut off some bits
"
!
examples
"
- [exBegin]
- 17 asModuloNumber modulusOf:38
- [exEnd]
-
- [exBegin]
- 38 \\ 17
- [exEnd]
+ [exBegin]
+ 17 asModuloNumber modulusOf:38
+ [exEnd]
+
+ [exBegin]
+ 38 \\ 17
+ [exEnd]
"
! !
@@ -4879,12 +4942,12 @@
"this subtract is done max 2 times"
cnt := 2.
[(t := e - modulus) >= 0] whileTrue:[
- e := t.
- cnt == 0 ifTrue:[
- "shortcut didn't work, do it the long way"
- ^ e \\ modulus.
- ].
- cnt := cnt - 1.
+ e := t.
+ cnt == 0 ifTrue:[
+ "shortcut didn't work, do it the long way"
+ ^ e \\ modulus.
+ ].
+ cnt := cnt - 1.
].
^ e.
@@ -4907,9 +4970,9 @@
m := 123456789901398721398721931729371293712943794254034548369328469438562948623498659238469234659823469823658423659823658.
Time millisecondsToRun:[
- 1000 timesRepeat:[
- 874928459437598375937451931729371293712943794254034548369328469438562948623498659238469234659823469823658423659823658 \\ m
- ]
+ 1000 timesRepeat:[
+ 874928459437598375937451931729371293712943794254034548369328469438562948623498659238469234659823469823658423659823658 \\ m
+ ]
]
"
@@ -4918,9 +4981,9 @@
m := self new modulus:123456789901398721398721931729371293712943794254034548369328469438562948623498659238469234659823469823658423659823658.
Time millisecondsToRun:[
- 1000 timesRepeat:[
- m modulusOf:874928459437598375937451931729371293712943794254034548369328469438562948623498659238469234659823469823658423659823658.
- ]
+ 1000 timesRepeat:[
+ m modulusOf:874928459437598375937451931729371293712943794254034548369328469438562948623498659238469234659823469823658423659823658.
+ ]
]
"
@@ -4939,11 +5002,11 @@
!Integer class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Integer.st,v 1.280 2013-07-04 15:45:33 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Integer.st,v 1.285 2013-07-30 10:56:51 stefan Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Integer.st,v 1.280 2013-07-04 15:45:33 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Integer.st,v 1.285 2013-07-30 10:56:51 stefan Exp $'
! !
--- a/LargeInteger.st Thu Jul 25 13:04:52 2013 +0100
+++ b/LargeInteger.st Thu Aug 01 10:22:20 2013 +0100
@@ -1496,6 +1496,14 @@
"Modified: / 5.5.1999 / 14:57:03 / stefan"
!
+digitBytesMSB
+ "return a byteArray filled with the receivers bits
+ (8 bits of the absolute value per element),
+ most significant byte first"
+
+ ^ digitByteArray copyReverse.
+!
+
digitBytesMSB:msbFlag
"return a byteArray filled with the receivers bits
(8 bits of the absolute value per element),
@@ -2523,7 +2531,7 @@
"Modified: / 9.1.1998 / 13:27:37 / cg"
! !
-!LargeInteger methodsFor:'modulu arithmetic'!
+!LargeInteger methodsFor:'modulo arithmetic'!
plus32:aNumber
"return the sum of the receiver and the argument, as SmallInteger.
@@ -5222,10 +5230,10 @@
!LargeInteger class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/LargeInteger.st,v 1.210 2013-05-27 08:13:50 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/LargeInteger.st,v 1.212 2013-07-30 10:56:22 stefan Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/LargeInteger.st,v 1.210 2013-05-27 08:13:50 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/LargeInteger.st,v 1.212 2013-07-30 10:56:22 stefan Exp $'
! !
--- a/Method.st Thu Jul 25 13:04:52 2013 +0100
+++ b/Method.st Thu Aug 01 10:22:20 2013 +0100
@@ -971,6 +971,7 @@
"Modified (format): / 18-11-2011 / 14:47:06 / cg"
! !
+
!Method methodsFor:'accessing-visibility'!
isIgnored
@@ -3037,12 +3038,14 @@
^ valueIfNoSource
"
+ LastParseTreeCache removeAll.
+
(Method compiledMethodAt:#parse:return:or:)
parse:#'parseMethodSilent:' return:#sentMessages or:#()
"
"Modified: / 01-03-2012 / 14:30:50 / cg"
- "Modified (format): / 27-07-2012 / 18:32:58 / cg"
+ "Modified (comment): / 30-07-2013 / 15:53:41 / cg"
!
parseAnnotations
@@ -3598,6 +3601,7 @@
"Created: / 23-07-2012 / 11:16:36 / cg"
! !
+
!Method methodsFor:'source management'!
revisionInfo
@@ -3845,11 +3849,11 @@
!Method class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Method.st,v 1.420 2013-06-29 11:28:21 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Method.st,v 1.421 2013-07-30 13:55:40 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Method.st,v 1.420 2013-06-29 11:28:21 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Method.st,v 1.421 2013-07-30 13:55:40 cg Exp $'
!
version_HG
--- a/Object.st Thu Jul 25 13:04:52 2013 +0100
+++ b/Object.st Thu Aug 01 10:22:20 2013 +0100
@@ -6493,6 +6493,100 @@
^ aMethod valueWithReceiver:self arguments:(Array with:arg1 with:arg2 with:arg3)
"Created: 31.7.1997 / 17:45:20 / cg"
+!
+
+performX:aSelector
+ "send the message aSelector to the receiver"
+
+ <resource: #skipInDebuggersWalkBack>
+
+%{
+ REGISTER OBJ sel = aSelector;
+
+ if (InterruptPending == nil) {
+ struct inlineCache *pIlc;
+
+#define SEL_AND_ILC_INIT_1(l) { nil , __ILCPERF0(l) }
+#define SEL_AND_ILC_INIT_2(l) SEL_AND_ILC_INIT_1(l) , SEL_AND_ILC_INIT_1(l)
+#define SEL_AND_ILC_INIT_4(l) SEL_AND_ILC_INIT_2(l) , SEL_AND_ILC_INIT_2(l)
+#define SEL_AND_ILC_INIT_8(l) SEL_AND_ILC_INIT_4(l) , SEL_AND_ILC_INIT_4(l)
+#define SEL_AND_ILC_INIT_16(l) SEL_AND_ILC_INIT_8(l) , SEL_AND_ILC_INIT_8(l)
+#define SEL_AND_ILC_INIT_32(l) SEL_AND_ILC_INIT_16(l) , SEL_AND_ILC_INIT_16(l)
+#define SEL_AND_ILC_INIT_32(l) SEL_AND_ILC_INIT_16(l) , SEL_AND_ILC_INIT_16(l)
+#define SEL_AND_ILC_INIT_64(l) SEL_AND_ILC_INIT_32(l) , SEL_AND_ILC_INIT_32(l)
+#define SEL_AND_ILC_INIT_128(l) SEL_AND_ILC_INIT_64(l) , SEL_AND_ILC_INIT_64(l)
+#define SEL_AND_ILC_INIT_256(l) SEL_AND_ILC_INIT_128(l) , SEL_AND_ILC_INIT_128(l)
+#define nilcs 256
+
+ static struct sel_and_ilc {
+ OBJ sel;
+ struct inlineCache ilc;
+ struct sel_and_ilc *next;
+ } sel_and_ilc[nilcs] = { SEL_AND_ILC_INIT_256(29) };
+
+#undef SEL_AND_ILC_INIT_1
+#undef SEL_AND_ILC_INIT_2
+#undef SEL_AND_ILC_INIT_4
+#undef SEL_AND_ILC_INIT_8
+#undef SEL_AND_ILC_INIT_16
+#undef SEL_AND_ILC_INIT_32
+#undef SEL_AND_ILC_INIT_64
+#undef SEL_AND_ILC_INIT_128
+#undef SEL_AND_ILC_INIT_256
+
+ static struct sel_and_ilc *nextFree = sel_and_ilc;
+ static struct sel_and_ilc *lastUsed = 0;
+ int n;
+ struct sel_and_ilc *slot, *prev, *prevPrev;
+
+ for (n=0, slot = lastUsed, prev = prevPrev = 0; slot; n++, slot = slot->next) {
+ if (sel == slot->sel) {
+printf("cached slot %d (len=%d)\n", slot-sel_and_ilc, n);
+ pIlc = &(slot->ilc);
+ // move to front
+ if (prev) {
+ prev->next = slot->next;
+ }
+ slot->next = lastUsed;
+ lastUsed = slot;
+ pIlc = &(slot->ilc);
+ goto perform0_send_and_return;
+ }
+ prevPrev = prev;
+ prev = slot;
+ }
+ // not recently used...
+ if (nextFree) {
+ // another free one
+ slot = nextFree;
+ nextFree = nextFree + 1;
+ if (nextFree >= &(sel_and_ilc[nilcs])) nextFree = 0;
+printf("new slot %d\n", slot-sel_and_ilc);
+ } else {
+ // no more for reuse - use least recently used
+ slot = prev;
+ prevPrev->next = 0;
+ slot->next = lastUsed;
+ lastUsed = slot;
+printf("reuse last slot %d\n", slot-sel_and_ilc);
+ }
+
+ /*printf("Object >> #perform: #%s --> no PIC found\n", __symbolVal(aSelector));*/
+ pIlc = &(slot->ilc);
+ slot->sel = sel;
+ pIlc->ilc_func = __SEND0ADDR__;
+ if (pIlc->ilc_poly) {
+ __flushPolyCache(pIlc->ilc_poly);
+ pIlc->ilc_poly = 0;
+ }
+perform0_send_and_return:
+ RETURN ( (*(pIlc->ilc_func))(self, sel, nil, pIlc) );
+ } else {
+ static struct inlineCache ilc0 = __DUMMYILCSELF0(@line+1);
+ RETURN (_SEND0(self, aSelector, nil, &ilc0));
+ }
+%}.
+ ^ self perform:aSelector withArguments:#()
! !
!Object methodsFor:'object persistency'!
@@ -8371,7 +8465,7 @@
if (__InstPtr(self)->i_instvars[i] == anObject) {
__InstPtr(self)->i_instvars[i] = newRef;
__STORE(self, newRef);
-__dumpObject__(self, __LINE__);
+ // __dumpObject__(self, __LINE__);
anyChange = true;
}
}
@@ -8385,6 +8479,8 @@
v replaceReferencesTo:Array with:ByteArray.
v inspect
"
+
+ "Modified: / 30-07-2013 / 21:48:06 / cg"
! !
!Object methodsFor:'testing'!
@@ -9682,11 +9778,11 @@
!Object class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Object.st,v 1.731 2013-07-13 20:35:11 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Object.st,v 1.732 2013-07-30 19:53:23 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Object.st,v 1.731 2013-07-13 20:35:11 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Object.st,v 1.732 2013-07-30 19:53:23 cg Exp $'
!
version_SVN
--- a/ProcessorScheduler.st Thu Jul 25 13:04:52 2013 +0100
+++ b/ProcessorScheduler.st Thu Aug 01 10:22:20 2013 +0100
@@ -2129,7 +2129,7 @@
or:[(processesToDecrease includes:aProcess) not]) ifTrue:[
aProcess priority < range stop ifTrue:[
processesToIncrease isNil ifTrue:[
- processesToIncrease := OrderedCollection new:10.
+ processesToIncrease := OrderedCollection new.
].
processesToIncrease add:aProcess
]
@@ -2145,7 +2145,7 @@
].
].
- "Modified: / 21.9.1998 / 09:07:54 / cg"
+ "Modified: / 30-07-2013 / 19:33:14 / cg"
!
scheduledProcesses
@@ -2799,8 +2799,8 @@
block := timeoutActionArray at:index.
block notNil ifTrue:[
blocksToEvaluate isNil ifTrue:[
- blocksToEvaluate := OrderedCollection new:10.
- processes := OrderedCollection new:10.
+ blocksToEvaluate := OrderedCollection new.
+ processes := OrderedCollection new.
].
blocksToEvaluate add:block.
processes add:(timeoutProcessArray at:index).
@@ -2841,7 +2841,7 @@
]
]
- "Modified: / 9.11.1998 / 21:25:02 / cg"
+ "Modified: / 30-07-2013 / 19:33:24 / cg"
!
removeTimedBlock:aBlock
@@ -3377,11 +3377,11 @@
!ProcessorScheduler class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/ProcessorScheduler.st,v 1.272 2013-07-10 11:51:52 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/ProcessorScheduler.st,v 1.273 2013-07-30 17:38:33 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/ProcessorScheduler.st,v 1.272 2013-07-10 11:51:52 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/ProcessorScheduler.st,v 1.273 2013-07-30 17:38:33 cg Exp $'
! !
--- a/ReadStream.st Thu Jul 25 13:04:52 2013 +0100
+++ b/ReadStream.st Thu Aug 01 10:22:20 2013 +0100
@@ -124,6 +124,15 @@
!ReadStream methodsFor:'queries'!
+collectionSize
+ "return the overall number of elements in the streamed collection
+ (both already read and to be read)."
+
+ ^ collection size
+
+ "Created: / 30-07-2013 / 20:55:51 / cg"
+!
+
copyFrom:beginning to:end
^ collection copyFrom:beginning to:end
!
@@ -144,10 +153,22 @@
^ false
!
+remainingSize
+ "return the number of remaining elements in the streamed collection."
+
+ ^ collection size - position
+
+ "Created: / 30-07-2013 / 20:18:12 / cg"
+!
+
size
"return the number of remaining elements in the streamed collection."
- ^ collection size - position
+ "/ will change back soon for VW and Squeak compatibility.
+ "/ ^ self collectionSize.
+ ^ self remainingSize
+
+ "Modified (comment): / 30-07-2013 / 20:57:23 / cg"
! !
!ReadStream methodsFor:'reading'!
@@ -847,10 +868,10 @@
!ReadStream class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/ReadStream.st,v 1.69 2013-06-03 18:39:38 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/ReadStream.st,v 1.71 2013-07-30 19:02:48 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/ReadStream.st,v 1.69 2013-06-03 18:39:38 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/ReadStream.st,v 1.71 2013-07-30 19:02:48 cg Exp $'
! !
--- a/RecursionLock.st Thu Jul 25 13:04:52 2013 +0100
+++ b/RecursionLock.st Thu Aug 01 10:22:20 2013 +0100
@@ -166,7 +166,9 @@
wouldBlock
"Check if the resource represented by the receiver is
- already in use by another Process."
+ already in use by another process.
+ Attention: if asked without some global lock (blockedInterrupts),
+ the returned value may be outdated right away."
^ process notNil and:[Processor activeProcess ~~ process]
! !
@@ -300,10 +302,10 @@
!RecursionLock class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/RecursionLock.st,v 1.38 2013-02-08 21:13:20 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/RecursionLock.st,v 1.39 2013-07-25 09:22:03 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/RecursionLock.st,v 1.38 2013-02-08 21:13:20 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/RecursionLock.st,v 1.39 2013-07-25 09:22:03 cg Exp $'
! !
--- a/Semaphore.st Thu Jul 25 13:04:52 2013 +0100
+++ b/Semaphore.st Thu Aug 01 10:22:20 2013 +0100
@@ -695,7 +695,7 @@
"return true, if the receiver would block the activeProcess
if a wait was performed. False otherwise.
Attention: if asked without some global lock (blockedInterrupts),
- the returned value may be wrong right away."
+ the returned value may be outdated right away."
^ count <= 0
! !
@@ -998,10 +998,10 @@
!Semaphore class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Semaphore.st,v 1.92 2013-02-08 16:21:33 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Semaphore.st,v 1.93 2013-07-25 09:22:14 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Semaphore.st,v 1.92 2013-02-08 16:21:33 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Semaphore.st,v 1.93 2013-07-25 09:22:14 cg Exp $'
! !
--- a/SequenceableCollection.st Thu Jul 25 13:04:52 2013 +0100
+++ b/SequenceableCollection.st Thu Aug 01 10:22:20 2013 +0100
@@ -644,7 +644,7 @@
copy := self shallowCopy.
copy size to: 1 by: -1 do:[:i |
- copy swap: i with: ((1 to: i) atRandom: aRandom)
+ copy swap: i with: (aRandom nextIntegerBetween:1 and:i)
].
^ copy
@@ -4472,6 +4472,25 @@
"
!
+from:startIndex doWithExit:aBlock
+ "evaluate the argument, aBlock for the elements starting with the
+ element at startIndex to the end. Passes an additional exitBlock as second
+ argument, which can be used to exit the loop early."
+
+ ^ self from:startIndex to:self size doWithExit:aBlock
+
+ "
+ #(one two three four five six)
+ from:3
+ doWithExit:[:element :exit |
+ Transcript showCR:element.
+ element = 'four' ifTrue:[ exit value:nil ]
+ ]
+ "
+
+ "Created: / 28-07-2013 / 22:37:28 / cg"
+!
+
from:startIndex keysAndValuesDo:aBlock
"evaluate the argument, aBlock for the elements and indices starting with the
element at startIndex to the end."
@@ -4576,6 +4595,29 @@
"Modified: / 02-06-2011 / 13:23:06 / cg"
!
+from:index1 to:index2 doWithExit:aBlock
+ "evaluate the argument, aBlock for the elements with index index1 to
+ index2 in the collection. Pass an additional exitBlock as second argument,
+ which can be used to exit the loop early."
+
+ |exitBlock|
+
+ exitBlock := [:value | ^ value].
+ ^ self from:index1 to:index2 do:[:el |
+ aBlock value:el value:exitBlock
+ ].
+
+ "
+ #(one two three four five six)
+ from:3 to:5 doWithExit:[:element :exit |
+ Transcript showCR:element.
+ element = 'four' ifTrue:[ exit value:nil].
+ ]
+ "
+
+ "Created: / 28-07-2013 / 22:40:06 / cg"
+!
+
from:index1 to:index2 doWithIndex:aBlock
"Squeak/V'Age compatibility;
like keysAndValuesDo:, but passes the index as second argument."
@@ -9000,11 +9042,11 @@
!SequenceableCollection class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/SequenceableCollection.st,v 1.343 2013-07-22 08:25:50 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/SequenceableCollection.st,v 1.345 2013-07-30 10:55:49 stefan Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/SequenceableCollection.st,v 1.343 2013-07-22 08:25:50 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/SequenceableCollection.st,v 1.345 2013-07-30 10:55:49 stefan Exp $'
! !
--- a/SmallInteger.st Thu Jul 25 13:04:52 2013 +0100
+++ b/SmallInteger.st Thu Aug 01 10:22:20 2013 +0100
@@ -808,6 +808,7 @@
! !
+
!SmallInteger methodsFor:'bit operators'!
bitAnd:anInteger
@@ -831,25 +832,25 @@
bitAt:anIntegerIndex
"return the value of the index's bit (index starts at 1) as 0 or 1.
Notice: the result of bitAt: on negative receivers is not
- defined in the language standard (since the implementation
- is free to choose any internal representation for integers)"
+ defined in the language standard (since the implementation
+ is free to choose any internal representation for integers)"
%{ /* NOCONTEXT */
if (__isSmallInteger(anIntegerIndex)) {
- INT idx = __smallIntegerVal(anIntegerIndex);
- if (idx > 0) {
- if (idx > N_INT_BITS) {
- RETURN(__mkSmallInteger(0));
- }
- RETURN((__smallIntegerVal(self) & (1 << (idx-1))) ? __mkSmallInteger(1) : __mkSmallInteger(0));
- }
+ INT idx = __smallIntegerVal(anIntegerIndex);
+ if (idx > 0) {
+ if (idx > N_INT_BITS) {
+ RETURN(__mkSmallInteger(0));
+ }
+ RETURN((__smallIntegerVal(self) & (1 << (idx-1))) ? __mkSmallInteger(1) : __mkSmallInteger(0));
+ }
}
%}.
- ^ SubscriptOutOfBoundsSignal
- raiseRequestWith:anIntegerIndex
- errorString:'index out of bounds'
+ ^ SubscriptOutOfBoundsError
+ raiseRequestWith:anIntegerIndex
+ errorString:'index out of bounds'
"
16r00000001 bitAt:0
@@ -869,9 +870,9 @@
|mask|
anIntegerIndex <= 0 ifTrue:[
- ^ SubscriptOutOfBoundsSignal
- raiseRequestWith:anIntegerIndex
- errorString:'index out of bounds'
+ ^ SubscriptOutOfBoundsSignal
+ raiseRequestWith:anIntegerIndex
+ errorString:'index out of bounds'
].
(anIntegerIndex > SmallInteger maxBits) ifTrue:[^ 0].
mask := 1 bitShift:(anIntegerIndex - 1).
@@ -1547,30 +1548,6 @@
!SmallInteger methodsFor:'bit operators-32bit'!
-asSigned32
- "return a 32-bit integer with my bit-pattern. For protocol completeness."
-
- ^ self
-!
-
-asUnsigned32
- "return a 32-bit integer with my bit-pattern, but positive.
- May be required for bit operations on the sign-bit and/or to
- convert C/Java numbers."
-
- self < 0 ifTrue:[
- ^ 16r100000000 + self
- ].
- ^ self
-
- "
- (-1 asUnsigned32) hexPrintString
- 1 asUnsigned32
- (SmallInteger minVal asUnsigned32) hexPrintString
- (SmallInteger maxVal asUnsigned32) hexPrintString
- "
-!
-
bitInvert32
"return the value of the receiver with all bits inverted in 32bit signed int space
(changes the sign)"
@@ -1939,111 +1916,199 @@
overhead of producing any intermediate byte-arrays (and the scanning)
"
self == 0 ifTrue: [
- ^ ByteArray with:0.
+ ^ ByteArray with:0.
].
self < 0 ifTrue: [
- absValue := self negated
+ absValue := self negated
] ifFalse: [
- absValue := self.
+ absValue := self.
].
b1 := absValue bitAnd:16rFF.
absValue := absValue bitShift:-8.
absValue == 0 ifTrue:[
- digitByteArray := ByteArray with:b1
+ digitByteArray := ByteArray with:b1
] ifFalse:[
- b2 := absValue bitAnd:16rFF.
- absValue := absValue bitShift:-8.
- absValue == 0 ifTrue:[
- digitByteArray := ByteArray with:b1 with:b2
- ] ifFalse:[
- b3 := absValue bitAnd:16rFF.
- absValue := absValue bitShift:-8.
- absValue == 0 ifTrue:[
- digitByteArray := ByteArray with:b1 with:b2 with:b3
- ] ifFalse:[
- b4 := absValue bitAnd:16rFF.
- absValue := absValue bitShift:-8.
- absValue == 0 ifTrue:[
- digitByteArray := ByteArray with:b1 with:b2 with:b3 with:b4
- ] ifFalse:[
- b5 := absValue bitAnd:16rFF.
- absValue := absValue bitShift:-8.
- absValue == 0 ifTrue:[
- digitByteArray := ByteArray new:5.
- digitByteArray at:1 put:b1.
- digitByteArray at:2 put:b2.
- digitByteArray at:3 put:b3.
- digitByteArray at:4 put:b4.
- digitByteArray at:5 put:b5.
- ] ifFalse:[
- b6 := absValue bitAnd:16rFF.
- absValue := absValue bitShift:-8.
- absValue == 0 ifTrue:[
- digitByteArray := ByteArray new:6.
- digitByteArray at:1 put:b1.
- digitByteArray at:2 put:b2.
- digitByteArray at:3 put:b3.
- digitByteArray at:4 put:b4.
- digitByteArray at:5 put:b5.
- digitByteArray at:6 put:b6.
- ] ifFalse:[
- b7 := absValue bitAnd:16rFF.
- absValue := absValue bitShift:-8.
- absValue == 0 ifTrue:[
- digitByteArray := ByteArray new:7.
- digitByteArray at:1 put:b1.
- digitByteArray at:2 put:b2.
- digitByteArray at:3 put:b3.
- digitByteArray at:4 put:b4.
- digitByteArray at:5 put:b5.
- digitByteArray at:6 put:b6.
- digitByteArray at:7 put:b7.
- ] ifFalse:[
- digitByteArray := ByteArray new:8.
- digitByteArray at:1 put:b1.
- digitByteArray at:2 put:b2.
- digitByteArray at:3 put:b3.
- digitByteArray at:4 put:b4.
- digitByteArray at:5 put:b5.
- digitByteArray at:6 put:b6.
- digitByteArray at:7 put:b7.
- digitByteArray at:8 put:absValue.
- ]
- ]
- ]
- ]
- ]
- ]
+ b2 := absValue bitAnd:16rFF.
+ absValue := absValue bitShift:-8.
+ absValue == 0 ifTrue:[
+ digitByteArray := ByteArray with:b1 with:b2
+ ] ifFalse:[
+ b3 := absValue bitAnd:16rFF.
+ absValue := absValue bitShift:-8.
+ absValue == 0 ifTrue:[
+ digitByteArray := ByteArray with:b1 with:b2 with:b3
+ ] ifFalse:[
+ b4 := absValue bitAnd:16rFF.
+ absValue := absValue bitShift:-8.
+ absValue == 0 ifTrue:[
+ digitByteArray := ByteArray with:b1 with:b2 with:b3 with:b4
+ ] ifFalse:[
+ b5 := absValue bitAnd:16rFF.
+ absValue := absValue bitShift:-8.
+ absValue == 0 ifTrue:[
+ digitByteArray := ByteArray new:5.
+ digitByteArray at:1 put:b1.
+ digitByteArray at:2 put:b2.
+ digitByteArray at:3 put:b3.
+ digitByteArray at:4 put:b4.
+ digitByteArray at:5 put:b5.
+ ] ifFalse:[
+ b6 := absValue bitAnd:16rFF.
+ absValue := absValue bitShift:-8.
+ absValue == 0 ifTrue:[
+ digitByteArray := ByteArray new:6.
+ digitByteArray at:1 put:b1.
+ digitByteArray at:2 put:b2.
+ digitByteArray at:3 put:b3.
+ digitByteArray at:4 put:b4.
+ digitByteArray at:5 put:b5.
+ digitByteArray at:6 put:b6.
+ ] ifFalse:[
+ b7 := absValue bitAnd:16rFF.
+ absValue := absValue bitShift:-8.
+ absValue == 0 ifTrue:[
+ digitByteArray := ByteArray new:7.
+ digitByteArray at:1 put:b1.
+ digitByteArray at:2 put:b2.
+ digitByteArray at:3 put:b3.
+ digitByteArray at:4 put:b4.
+ digitByteArray at:5 put:b5.
+ digitByteArray at:6 put:b6.
+ digitByteArray at:7 put:b7.
+ ] ifFalse:[
+ digitByteArray := ByteArray new:8.
+ digitByteArray at:1 put:b1.
+ digitByteArray at:2 put:b2.
+ digitByteArray at:3 put:b3.
+ digitByteArray at:4 put:b4.
+ digitByteArray at:5 put:b5.
+ digitByteArray at:6 put:b6.
+ digitByteArray at:7 put:b7.
+ digitByteArray at:8 put:absValue.
+ ]
+ ]
+ ]
+ ]
+ ]
+ ]
].
^ digitByteArray
"
- 16r12 digitBytes
- 16r1234 digitBytes
- 16r12345678 digitBytes
+ 16r12 digitBytes hexPrintString
+ 16r1234 digitBytes hexPrintString
+ 16r12345678 digitBytes hexPrintString
"
!
-digitBytesMSB:msbFlag
+digitBytesMSB
"return a byteArray filled with the receivers bits
(8 bits of the absolute value per element),
- if msbflag = true, most significant byte is first,
- otherwise least significant byte is first"
-
- msbFlag ifTrue:[
- ^ self digitBytes reversed. "digitBytes has been just created - reverse inplace"
- ].
- ^ self digitBytes
+ most significant byte is first"
+
+ |absValue
+ b1 "{ Class: SmallInteger }"
+ b2 "{ Class: SmallInteger }"
+ b3 "{ Class: SmallInteger }"
+ b4 "{ Class: SmallInteger }"
+ b5 "{ Class: SmallInteger }"
+ b6 "{ Class: SmallInteger }"
+ b7 "{ Class: SmallInteger }" digitByteArray|
"
- 16r12 digitBytesMSB:true
- 16r1234 digitBytesMSB:true
- 16r1234 digitBytesMSB:false
- 16r12345678 digitBytesMSB:true
- 16r12345678 digitBytesMSB:false
+ could have simply created a 4-byte largeinteger and normalize it.
+ The code below does the normalize right away, avoiding the
+ overhead of producing any intermediate byte-arrays (and the scanning)
+ "
+ self == 0 ifTrue: [
+ ^ ByteArray with:0.
+ ].
+
+ self < 0 ifTrue: [
+ absValue := self negated
+ ] ifFalse: [
+ absValue := self.
+ ].
+
+ b1 := absValue bitAnd:16rFF.
+ absValue := absValue bitShift:-8.
+ absValue == 0 ifTrue:[
+ digitByteArray := ByteArray with:b1
+ ] ifFalse:[
+ b2 := absValue bitAnd:16rFF.
+ absValue := absValue bitShift:-8.
+ absValue == 0 ifTrue:[
+ digitByteArray := ByteArray with:b2 with:b1
+ ] ifFalse:[
+ b3 := absValue bitAnd:16rFF.
+ absValue := absValue bitShift:-8.
+ absValue == 0 ifTrue:[
+ digitByteArray := ByteArray with:b3 with:b2 with:b1
+ ] ifFalse:[
+ b4 := absValue bitAnd:16rFF.
+ absValue := absValue bitShift:-8.
+ absValue == 0 ifTrue:[
+ digitByteArray := ByteArray with:b4 with:b3 with:b2 with:b1
+ ] ifFalse:[
+ b5 := absValue bitAnd:16rFF.
+ absValue := absValue bitShift:-8.
+ absValue == 0 ifTrue:[
+ digitByteArray := ByteArray new:5.
+ digitByteArray at:1 put:b5.
+ digitByteArray at:2 put:b4.
+ digitByteArray at:3 put:b3.
+ digitByteArray at:4 put:b2.
+ digitByteArray at:5 put:b1.
+ ] ifFalse:[
+ b6 := absValue bitAnd:16rFF.
+ absValue := absValue bitShift:-8.
+ absValue == 0 ifTrue:[
+ digitByteArray := ByteArray new:6.
+ digitByteArray at:1 put:b6.
+ digitByteArray at:2 put:b5.
+ digitByteArray at:3 put:b4.
+ digitByteArray at:4 put:b3.
+ digitByteArray at:5 put:b2.
+ digitByteArray at:6 put:b1.
+ ] ifFalse:[
+ b7 := absValue bitAnd:16rFF.
+ absValue := absValue bitShift:-8.
+ absValue == 0 ifTrue:[
+ digitByteArray := ByteArray new:7.
+ digitByteArray at:1 put:b7.
+ digitByteArray at:2 put:b6.
+ digitByteArray at:3 put:b5.
+ digitByteArray at:4 put:b4.
+ digitByteArray at:5 put:b3.
+ digitByteArray at:6 put:b2.
+ digitByteArray at:7 put:b1.
+ ] ifFalse:[
+ digitByteArray := ByteArray new:8.
+ digitByteArray at:1 put:absValue.
+ digitByteArray at:2 put:b7.
+ digitByteArray at:3 put:b6.
+ digitByteArray at:4 put:b5.
+ digitByteArray at:5 put:b4.
+ digitByteArray at:6 put:b3.
+ digitByteArray at:7 put:b2.
+ digitByteArray at:8 put:b1.
+ ]
+ ]
+ ]
+ ]
+ ]
+ ]
+ ].
+
+ ^ digitByteArray
+
+ "
+ 16r12 digitBytesMSB hexPrintString
+ 16r1234 digitBytesMSB hexPrintString
+ 16r12345678 digitBytesMSB hexPrintString
"
!
@@ -4232,11 +4297,11 @@
!SmallInteger class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/SmallInteger.st,v 1.208 2013-06-25 20:37:31 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/SmallInteger.st,v 1.211 2013-07-28 19:35:06 stefan Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/SmallInteger.st,v 1.208 2013-06-25 20:37:31 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/SmallInteger.st,v 1.211 2013-07-28 19:35:06 stefan Exp $'
! !
--- a/Smalltalk.st Thu Jul 25 13:04:52 2013 +0100
+++ b/Smalltalk.st Thu Aug 01 10:22:20 2013 +0100
@@ -4513,7 +4513,7 @@
i.e. NOT a stripped or a linked application (such as the webServer)
and NOT a plugIn (i.e. running in a browser)
and NOT a sharedLibrary component (i.e. a dll in another app).
- This is used to determine, wether debugging is possible or not."
+ This is used to determine, whether debugging is possible or not."
self isPlugin ifTrue:[^ false]. "/ I am a browser-plugin
self isSharedLibraryComponent ifTrue:[^ false]. "/ I am a COM-ponent
@@ -4526,6 +4526,7 @@
"Created: / 10-08-2006 / 13:12:49 / cg"
"Modified: / 06-12-2006 / 16:42:56 / cg"
+ "Modified (comment): / 27-07-2013 / 15:36:20 / cg"
!
isStandAloneApp
@@ -7985,11 +7986,11 @@
!Smalltalk class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.1030 2013-05-27 13:23:58 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.1031 2013-07-27 13:54:13 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.1030 2013-05-27 13:23:58 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.1031 2013-07-27 13:54:13 cg Exp $'
!
version_HG
--- a/StreamError.st Thu Jul 25 13:04:52 2013 +0100
+++ b/StreamError.st Thu Aug 01 10:22:20 2013 +0100
@@ -42,6 +42,19 @@
!StreamError methodsFor:'accessing'!
+errorCategory
+ "return the generi OS independent error category.
+ return #unknown, if this is not an OS error"
+
+ |holder|
+
+ holder := self osErrorHolder.
+ holder isNil ifTrue:[
+ ^ #unknown
+ ].
+ ^ holder errorCategory.
+!
+
errorCode
^ errorCode
!
@@ -67,10 +80,10 @@
!StreamError class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/StreamError.st,v 1.8 2013-07-09 11:57:15 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/StreamError.st,v 1.9 2013-07-29 08:09:49 stefan Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/StreamError.st,v 1.8 2013-07-09 11:57:15 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/StreamError.st,v 1.9 2013-07-29 08:09:49 stefan Exp $'
! !
--- a/Win32OperatingSystem.st Thu Jul 25 13:04:52 2013 +0100
+++ b/Win32OperatingSystem.st Thu Aug 01 10:22:20 2013 +0100
@@ -824,6 +824,7 @@
"Modified: 7.1.1997 / 19:36:11 / stefan"
! !
+
!Win32OperatingSystem class methodsFor:'OS signal constants'!
sigABRT
@@ -15751,7 +15752,9 @@
__AT_PUT_(symbTable , @symbol(SHAREADMIN), __MKUINT( RESOURCEDISPLAYTYPE_SHAREADMIN ) );
__AT_PUT_(symbTable , @symbol(DIRECTORY), __MKUINT( RESOURCEDISPLAYTYPE_DIRECTORY ) );
__AT_PUT_(symbTable , @symbol(TREE), __MKUINT( RESOURCEDISPLAYTYPE_TREE ) );
+#ifdef RESOURCEDISPLAYTYPE_NDSCONTAINER
__AT_PUT_(symbTable , @symbol(NDSCONTAINER), __MKUINT( RESOURCEDISPLAYTYPE_NDSCONTAINER ) );
+#endif
%}.
DisplayTypeMappingTable := Dictionary new.
@@ -16779,13 +16782,15 @@
%{ /* STACK:32000 */
#if !defined(NO_SOCKET)
char *__hostName, *__serviceName;
+ char __hostNameCopy[1024], __serviceNameCopy[256];
int ret;
int cnt = 0;
if (hostName == nil) {
__hostName = 0;
} else if (__isStringLike(hostName)) {
- __hostName = __stringVal(hostName);
+ strncpy(__hostNameCopy, __stringVal(hostName), sizeof(__hostNameCopy)-1);
+ __hostName = __hostNameCopy;
} else {
error = @symbol(badArgument1);
goto exitPrim;
@@ -16793,7 +16798,8 @@
if (serviceName == nil) {
__serviceName = 0;
} else if (__isStringLike(serviceName)) {
- __serviceName = __stringVal(serviceName);
+ strncpy(__serviceNameCopy, __stringVal(serviceName), sizeof(__serviceNameCopy)-1);
+ __serviceName = __serviceNameCopy;
} else {
error = @symbol(badArgument2);
goto exitPrim;
@@ -16808,6 +16814,7 @@
/*
* Use getaddrinfo()
*/
+ extern getaddrinfo();
struct addrinfo hints;
struct addrinfo *info = NULL, *infop;
@@ -16820,18 +16827,6 @@
hints.ai_protocol = __intVal(proto);
do {
- /* must refetch in loop */
- if (hostName == nil) {
- __hostName = 0;
- } else if (__isStringLike(hostName)) {
- __hostName = __stringVal(hostName);
- }
- if (serviceName == nil) {
- __serviceName = 0;
- } else if (__isStringLike(serviceName)) {
- __serviceName = __stringVal(serviceName);
- }
-
# ifdef DO_WRAP_CALLS
do {
__threadErrno = 0;
@@ -16960,12 +16955,6 @@
if (__hostName) {
# ifdef USE_H_ERRNO
do {
- /* must refetch in loop */
- if (hostName == nil) {
- __hostName = 0;
- } else if (__isStringLike(hostName)) {
- __hostName = __stringVal(hostName);
- }
# ifdef DO_WRAP_CALLS
hp = STX_WSA_NOINT_CALL1("gethostbyname", gethostbyname, __hostName);
if ((INT)hp < 0) hp = NULL;
@@ -17203,6 +17192,7 @@
}
{
+ extern getnameinfo();
bp = (char *)(__byteArrayVal(socketAddress));
bp += nInstBytes;
# ifdef DO_WRAP_CALLS
@@ -17430,15 +17420,15 @@
!Win32OperatingSystem class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Win32OperatingSystem.st,v 1.475 2013-07-24 22:03:42 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Win32OperatingSystem.st,v 1.476 2013-07-30 16:34:20 stefan Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Win32OperatingSystem.st,v 1.475 2013-07-24 22:03:42 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Win32OperatingSystem.st,v 1.476 2013-07-30 16:34:20 stefan Exp $'
!
version_SVN
- ^ '$Id: Win32OperatingSystem.st,v 1.475 2013-07-24 22:03:42 cg Exp $'
+ ^ '$Id: Win32OperatingSystem.st,v 1.476 2013-07-30 16:34:20 stefan Exp $'
! !