--- a/ApplicationDefinition.st Tue May 28 00:23:55 2013 +0100
+++ b/ApplicationDefinition.st Fri May 31 00:35:21 2013 +0100
@@ -1788,7 +1788,7 @@
# build all mandatory prerequisite packages (containing superclasses) for this package
prereq:
- $(MAKE) -N -f bc.mak FORCE=FORCE_BUILD $(REQUIRED_LIBS)
+ $(MAKE) -N -f bc.mak $(USE_ARG) FORCE=FORCE_BUILD $(REQUIRED_LIBS)
FORCE_BUILD:
@rem Dummy target to force a build
@@ -3044,11 +3044,11 @@
!ApplicationDefinition class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/ApplicationDefinition.st,v 1.242 2013-05-07 17:56:48 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/ApplicationDefinition.st,v 1.243 2013-05-28 12:17:49 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/ApplicationDefinition.st,v 1.242 2013-05-07 17:56:48 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/ApplicationDefinition.st,v 1.243 2013-05-28 12:17:49 cg Exp $'
!
version_SVN
--- a/ArithmeticValue.st Tue May 28 00:23:55 2013 +0100
+++ b/ArithmeticValue.st Fri May 31 00:35:21 2013 +0100
@@ -203,6 +203,7 @@
^ self == ArithmeticValue
! !
+
!ArithmeticValue methodsFor:'arithmetic'!
* something
@@ -392,7 +393,7 @@
mul2
"Return the product of self multiplied by 2.
The receiver MAY, but NEED NOT be changed to contain the result.
- So this method must be used as: 'a := a mul2.
+ So this method must be used as: a := a mul2.
This method can be redefined for constructed datatypes to do optimisations"
^ self * 2
@@ -1353,11 +1354,11 @@
!ArithmeticValue class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/ArithmeticValue.st,v 1.91 2013-02-05 14:24:46 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/ArithmeticValue.st,v 1.92 2013-05-27 08:14:43 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/ArithmeticValue.st,v 1.91 2013-02-05 14:24:46 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/ArithmeticValue.st,v 1.92 2013-05-27 08:14:43 cg Exp $'
! !
--- a/Block.st Tue May 28 00:23:55 2013 +0100
+++ b/Block.st Fri May 31 00:35:21 2013 +0100
@@ -2484,10 +2484,11 @@
"the receiver must be a block of one argument. It is evaluated, and is passed a block,
which, if sent a value-message, will restart the receiver block from the beginning"
- |myContext|
+ |myContext restartAction|
myContext := thisContext.
- ^ self value:[ myContext restart ].
+ restartAction := [ myContext unwindAndRestart ].
+ ^ self value:restartAction.
"
[:restart |
@@ -2504,10 +2505,11 @@
"the receiver must be a block of two arguments, a restart and an exit block.
See description of valueWithExit and valueWithRestart for their use"
- |myContext|
+ |myContext restartAction|
myContext := thisContext.
- ^ self value:[myContext restart] value:[:exitValue | ^exitValue].
+ restartAction := [ myContext unwindAndRestart ].
+ ^ self value:restartAction value:[:exitValue | ^exitValue].
"
[:restart :exit |
@@ -3118,11 +3120,11 @@
!Block class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Block.st,v 1.196 2013-05-13 19:21:34 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Block.st,v 1.198 2013-05-24 18:13:53 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Block.st,v 1.196 2013-05-13 19:21:34 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Block.st,v 1.198 2013-05-24 18:13:53 cg Exp $'
! !
--- a/BlockContext.st Tue May 28 00:23:55 2013 +0100
+++ b/BlockContext.st Fri May 31 00:35:21 2013 +0100
@@ -127,13 +127,15 @@
|con h|
+ home isNil ifTrue:[^ nil].
home isContext ifFalse:[^ nil]. "copying blocks have no method home"
+ con := self.
h := home.
- [
+ [h notNil] whileTrue:[
con := h.
h := con home
- ] doWhile:[h notNil].
+ ].
^ con
!
@@ -167,7 +169,7 @@
|cls who mHome m className sel homeSel|
- home isContext ifFalse:[
+ (home isNil or:[home isContext not]) ifTrue:[
"
mhmh - an optimized blocks context
should get the block here, and get the method from
@@ -252,10 +254,10 @@
!BlockContext class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/BlockContext.st,v 1.36 2013-05-07 13:23:42 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/BlockContext.st,v 1.37 2013-05-24 17:11:15 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/BlockContext.st,v 1.36 2013-05-07 13:23:42 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/BlockContext.st,v 1.37 2013-05-24 17:11:15 cg Exp $'
! !
--- a/ByteArray.st Tue May 28 00:23:55 2013 +0100
+++ b/ByteArray.st Fri May 31 00:35:21 2013 +0100
@@ -162,6 +162,9 @@
! !
+
+
+
!ByteArray class methodsFor:'queries'!
elementByteSize
@@ -179,6 +182,8 @@
"Modified: 23.4.1996 / 15:56:25 / cg"
! !
+
+
!ByteArray methodsFor:'Compatibility-Squeak'!
bitXor:aByteArray
@@ -2381,7 +2386,9 @@
swapBytes
"swap bytes inplace -
- written as a primitive for speed on image grabbing (if display order is different)"
+ Expects that the receiver has an even number of bytes;
+ if not, only the pairs excluding the last byte are swapped.
+ written as a primitive for speed on image grabbing (if display order is different)."
%{ /* NOCONTEXT */
@@ -2390,32 +2397,40 @@
REGISTER unsigned t;
if (__qClass(self) == @global(ByteArray)) {
- cnt = __byteArraySize(self);
- cnt = cnt & ~1; /* make it even */
- p = __ByteArrayInstPtr(self)->ba_element;
- while (cnt > 0) {
-#ifdef OLD
- t = p[0];
- p[0] = p[1];
- p[1] = t;
+ cnt = __byteArraySize(self);
+ cnt = cnt & ~1; /* make it even */
+ p = __ByteArrayInstPtr(self)->ba_element;
+
+ while (cnt >= sizeof(INT)) {
+ unsigned INT i = ((unsigned INT *)p)[0];
+
+#if __POINTER_SIZE__ == 8
+ i = ((i>>8) & 0x00FF00FF00FF00FF) | ((i & 0x00FF00FF00FF00FF) << 8);
#else
- unsigned short s;
-
- s = ((unsigned short *)p)[0];
- s = (s >> 8) | (s << 8);
- ((unsigned short *)p)[0] = s;
-#endif
- p += 2;
- cnt -= 2;
- }
- RETURN ( self );
+ i = ((i>>8) & 0x00FF00FF) | ((i & 0x00FF00FF) << 8);
+#endif /* __POINTER_SIZE__ */
+ ((unsigned INT *)p)[0] = i;
+ p += sizeof(INT);
+ cnt -= sizeof(INT);
+ }
+ while (cnt > 0) {
+ unsigned short s;
+
+ s = ((unsigned short *)p)[0];
+ s = (s >> 8) | (s << 8);
+ ((unsigned short *)p)[0] = s;
+ p += 2;
+ cnt -= 2;
+ }
+ RETURN ( self );
}
%}.
^ super swapBytes "/ rubbish - there is no one currenly
"
- #[1 2 3 4 5 6 7 8 9 10] copy swapBytes
- #[1 2 3 4 5 6 7 8 9 10 11] copy swapBytes
+ #[1 2 3 4 5 6 7 8 9 10] copy swapBytes -> #[2 1 4 3 6 5 8 7 10 9]
+ #[1 2 3 4 5 6 7 8 9 10 11] copy swapBytes -> #[2 1 4 3 6 5 8 7 10 9 11]
+ #[1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18] copy swapBytes
"
!
@@ -2426,20 +2441,20 @@
REGISTER unsigned char *p;
unsigned int __i1, __i2;
- int cnt;
+ int sz;
unsigned int t;
if (__qClass(self) == @global(ByteArray) && __bothSmallInteger(i1, i2)) {
- __i1 = __intVal(i1) - 1;
- __i2 = __intVal(i2) - 1;
- cnt = __byteArraySize(self);
- p = __ByteArrayInstPtr(self)->ba_element;
- if (__i1 < cnt && __i2 < cnt) {
- t = p[__i1];
- p[__i1] = p[__i2];
- p[__i2] = t;
- }
- RETURN ( self );
+ __i1 = __intVal(i1) - 1;
+ __i2 = __intVal(i2) - 1;
+ sz = __byteArraySize(self);
+ p = __ByteArrayInstPtr(self)->ba_element;
+ if (__i1 < sz && __i2 < sz) {
+ t = p[__i1];
+ p[__i1] = p[__i2];
+ p[__i2] = t;
+ }
+ RETURN ( self );
}
%}.
^ super swapIndex:i1 and:i2 "/ rubbish - there is no one currently
@@ -2908,6 +2923,7 @@
"
! !
+
!ByteArray methodsFor:'searching'!
indexOf:aByte startingAt:start
@@ -2973,6 +2989,7 @@
"
! !
+
!ByteArray methodsFor:'testing'!
isByteArray
@@ -3000,9 +3017,10 @@
!ByteArray class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/ByteArray.st,v 1.208 2012-10-10 17:00:30 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/ByteArray.st,v 1.210 2013-05-27 08:23:00 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/ByteArray.st,v 1.208 2012-10-10 17:00:30 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/ByteArray.st,v 1.210 2013-05-27 08:23:00 cg Exp $'
! !
+
--- a/Class.st Tue May 28 00:23:55 2013 +0100
+++ b/Class.st Fri May 31 00:35:21 2013 +0100
@@ -1880,6 +1880,7 @@
"Created: / 18-07-2011 / 09:14:38 / cg"
! !
+
!Class methodsFor:'adding & removing'!
removeFromSystem
@@ -2492,9 +2493,9 @@
mySourceFileName sameFile s mySourceFileID anySourceRef|
self isLoaded ifFalse:[
- ^ FileOutErrorSignal
- raiseRequestWith:self
- errorString:' - will not fileOut unloaded class: ', self name
+ ^ FileOutErrorSignal
+ raiseRequestWith:self
+ errorString:' - will not fileOut unloaded class: ', self name
].
fileName := fileNameString asFilename.
@@ -2505,94 +2506,94 @@
and, if that worked rename afterwards ...
"
(fileName exists) ifTrue:[
- sameFile := false.
-
- "/ check carefully - maybe, my source does not really come from that
- "/ file (i.e. all of my methods have their source as string)
-
- anySourceRef := false.
- self instAndClassMethodsDo:[:m |
- m sourcePosition notNil ifTrue:[
- anySourceRef := true
- ]
- ].
-
- anySourceRef ifTrue:[
- s := self sourceStream.
- s notNil ifTrue:[
- OperatingSystem isUNIXlike ifTrue:[
- mySourceFileID := s pathName asFilename info id.
- sameFile := (fileName info id) == mySourceFileID.
- ] ifFalse:[
- mySourceFileID := s pathName asFilename asAbsoluteFilename.
- sameFile := (fileName asFilename asAbsoluteFilename) = mySourceFileID.
- ].
- s close.
- ] ifFalse:[
- classFilename notNil ifTrue:[
- "
- check for overwriting my current source file
- this is not allowed, since it would clobber my methods source
- file ... you have to save it to some other place.
- This happens if you ask for a fileOut into the source-directory
- (from which my methods get their source)
- "
- mySourceFileName := Smalltalk getSourceFileName:classFilename.
- sameFile := (fileNameString = mySourceFileName).
- sameFile ifFalse:[
- mySourceFileName notNil ifTrue:[
- OperatingSystem isUNIXlike ifTrue:[
- sameFile := (fileName info id) == (mySourceFileName asFilename info id)
- ]
- ]
- ].
- ]
- ].
- ].
-
- sameFile ifTrue:[
- ^ FileOutErrorSignal
- raiseRequestWith:fileNameString
- errorString:(' - may not overwrite sourcefile:', fileNameString)
- ].
-
- savFilename := Filename newTemporary.
- fileName copyTo:savFilename.
- newFileName := fileName withSuffix:'new'.
- needRename := true
+ sameFile := false.
+
+ "/ check carefully - maybe, my source does not really come from that
+ "/ file (i.e. all of my methods have their source as string)
+
+ anySourceRef := false.
+ self instAndClassMethodsDo:[:m |
+ m sourcePosition notNil ifTrue:[
+ anySourceRef := true
+ ]
+ ].
+
+ anySourceRef ifTrue:[
+ s := self sourceStream.
+ s notNil ifTrue:[
+ OperatingSystem isUNIXlike ifTrue:[
+ mySourceFileID := s pathName asFilename info id.
+ sameFile := (fileName info id) == mySourceFileID.
+ ] ifFalse:[
+ mySourceFileID := s pathName asFilename asAbsoluteFilename.
+ sameFile := (fileName asFilename asAbsoluteFilename) = mySourceFileID.
+ ].
+ s close.
+ ] ifFalse:[
+ classFilename notNil ifTrue:[
+ "
+ check for overwriting my current source file
+ this is not allowed, since it would clobber my methods source
+ file ... you have to save it to some other place.
+ This happens if you ask for a fileOut into the source-directory
+ (from which my methods get their source)
+ "
+ mySourceFileName := Smalltalk getSourceFileName:classFilename.
+ sameFile := (fileNameString = mySourceFileName).
+ sameFile ifFalse:[
+ mySourceFileName notNil ifTrue:[
+ OperatingSystem isUNIXlike ifTrue:[
+ sameFile := (fileName info id) == (mySourceFileName asFilename info id)
+ ]
+ ]
+ ].
+ ]
+ ].
+ ].
+
+ sameFile ifTrue:[
+ ^ FileOutErrorSignal
+ raiseRequestWith:fileNameString
+ errorString:(' - may not overwrite sourcefile: %1\try again after loading sources in the browser' withCRs bindWith:fileNameString)
+ ].
+
+ savFilename := Filename newTemporary.
+ fileName copyTo:savFilename.
+ newFileName := fileName withSuffix:'new'.
+ needRename := true
] ifFalse:[
- "/ another possible trap: if my sourceFileName is
- "/ the same as the written one AND the new files directory
- "/ is along the sourcePath, we also need a temporary file
- "/ first, to avoid accessing the newly written file.
-
- anySourceRef := false.
- self instAndClassMethodsDo:[:m |
- |mSrc|
-
- (mSrc := m sourceFilename) notNil ifTrue:[
- mSrc asFilename baseName = fileName baseName ifTrue:[
- anySourceRef := true
- ]
- ]
- ].
- anySourceRef ifTrue:[
- newFileName := fileName withSuffix:'new'.
- needRename := true
- ] ifFalse:[
- newFileName := fileName.
- needRename := false
- ]
+ "/ another possible trap: if my sourceFileName is
+ "/ the same as the written one AND the new files directory
+ "/ is along the sourcePath, we also need a temporary file
+ "/ first, to avoid accessing the newly written file.
+
+ anySourceRef := false.
+ self instAndClassMethodsDo:[:m |
+ |mSrc|
+
+ (mSrc := m sourceFilename) notNil ifTrue:[
+ mSrc asFilename baseName = fileName baseName ifTrue:[
+ anySourceRef := true
+ ]
+ ]
+ ].
+ anySourceRef ifTrue:[
+ newFileName := fileName withSuffix:'new'.
+ needRename := true
+ ] ifFalse:[
+ newFileName := fileName.
+ needRename := false
+ ]
].
[
- aStream := newFileName writeStream.
+ aStream := newFileName writeStream.
] on:FileStream openErrorSignal do:[:ex|
- savFilename notNil ifTrue:[
- savFilename delete
- ].
- ^ FileOutErrorSignal
- raiseRequestWith:newFileName name
- errorString:(' - cannot create file:', newFileName name)
+ savFilename notNil ifTrue:[
+ savFilename delete
+ ].
+ ^ FileOutErrorSignal
+ raiseRequestWith:newFileName name
+ errorString:(' - cannot create file:', newFileName name)
].
self fileOutOn:aStream.
aStream close.
@@ -2603,11 +2604,11 @@
we have to do a copy ...
"
needRename ifTrue:[
- newFileName copyTo:fileName.
- newFileName delete
+ newFileName copyTo:fileName.
+ newFileName delete
].
savFilename notNil ifTrue:[
- savFilename delete
+ savFilename delete
].
"
@@ -5666,11 +5667,11 @@
!Class class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Class.st,v 1.625 2013-05-16 23:41:48 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Class.st,v 1.626 2013-05-27 08:45:38 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Class.st,v 1.625 2013-05-16 23:41:48 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Class.st,v 1.626 2013-05-27 08:45:38 cg Exp $'
!
version_SVN
--- a/Context.st Tue May 28 00:23:55 2013 +0100
+++ b/Context.st Fri May 31 00:35:21 2013 +0100
@@ -731,7 +731,12 @@
!
senderIsNil
- "return true, if I have no sender"
+ "return true, if I have no sender.
+ This little ugly piece of code is needed (instead of the obvious
+ 'sender isNil') because sender is a protected field, which cannot be
+ directly accessed by smalltalk code. The reason is that the sender field
+ is lazily filled in by the VM, in the sender-accessor, and is usually
+ invalid until needed."
%{ /* NOCONTEXT */
if ( __INST(sender_) == nil ) {
@@ -739,7 +744,6 @@
}
RETURN (false);
%}.
- ^ self sender isNil
!
setLineNumber:aNumber
@@ -880,8 +884,10 @@
!
invalidReturnOrRestart:returnValue
- "this message is sent by the VM, when a methods context
- which was compiled non-returnable is about to return again.
+ "this message is sent by the VM, when a method's or block's context
+ which was compiled non-returnable is about to return again,
+ or a non-restartable context is tried to be restarted.
+ In ST/X, not all contexts are restartable/returnable.
We raise a signal here, to allow catching of that situation."
^ CannotReturnError
@@ -2477,11 +2483,11 @@
!Context class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Context.st,v 1.182 2013-05-10 18:46:37 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Context.st,v 1.184 2013-05-24 18:13:31 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Context.st,v 1.182 2013-05-10 18:46:37 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Context.st,v 1.184 2013-05-24 18:13:31 cg Exp $'
!
version_SVN
--- a/EncodedStream.st Tue May 28 00:23:55 2013 +0100
+++ b/EncodedStream.st Fri May 31 00:35:21 2013 +0100
@@ -224,7 +224,7 @@
handledSignals handle:[:ex |
|sig|
- sig := ex signal.
+ sig := ex creator.
((passedSignals includes:sig) and:[sig isHandledIn:outerContext]) ifTrue:[
ex reject
].
--- a/Fraction.st Tue May 28 00:23:55 2013 +0100
+++ b/Fraction.st Fri May 31 00:35:21 2013 +0100
@@ -526,7 +526,8 @@
!
asLongFloat
- "return a long float with (approximately) my value"
+ "return a long float with (approximately) my value.
+ Since floats have a limited precision, you usually loose bits when doing this."
|num den numShift denShift numBits rslt|
@@ -539,19 +540,11 @@
numBits := LongFloat precision * 2. "number of bits to preserve (conservative)"
num := numerator abs.
numShift := numBits - num highBit. "(num highBit - bits) negated"
- numShift < 0 ifTrue:[
- num := num bitShift:numShift
- ] ifFalse:[
- numShift := 0
- ].
+ numShift < 0 ifTrue:[num := num bitShift:numShift] ifFalse:[ numShift := 0].
den := denominator.
denShift := numBits - den highBit. "(den highBit - bits) negated"
- denShift < 0 ifTrue:[
- den := den bitShift:denShift
- ] ifFalse:[
- denShift := 0
- ].
+ denShift < 0 ifTrue:[den := den bitShift:denShift] ifFalse:[denShift := 0].
rslt := (num asLongFloat / den asLongFloat) * (2 raisedToInteger:denShift-numShift).
numerator negative ifTrue:[ ^ rslt negated ].
@@ -1158,11 +1151,12 @@
!Fraction class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Fraction.st,v 1.81 2011-05-03 09:08:52 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Fraction.st,v 1.82 2013-05-27 08:14:32 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Fraction.st,v 1.81 2011-05-03 09:08:52 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Fraction.st,v 1.82 2013-05-27 08:14:32 cg Exp $'
! !
+
Fraction initialize!
--- a/GenericException.st Tue May 28 00:23:55 2013 +0100
+++ b/GenericException.st Fri May 31 00:35:21 2013 +0100
@@ -1191,12 +1191,9 @@
!
creator
- "return the creator of the exception;
- same as signal, for compatibility"
-
- ^ signal ? self class
-
- "Modified: / 10-08-2010 / 09:23:18 / cg"
+ "return the creator of the exception"
+
+ signal notNil ifTrue:[^ signal] ifFalse:[^ self class]
!
errorString
@@ -1393,10 +1390,7 @@
the creator. Marked as obsolete, until the change is done!!"
self obsoleteMethodWarning:'meaning of #signal will change. Use #creator'.
-
- ^ signal ? self class
-
- "Modified: / 10-08-2010 / 09:22:33 / cg"
+ ^ self creator.
!
suspendedContext
@@ -1457,7 +1451,7 @@
"
try per signal handler
"
- (handlerBlock := signal handlerBlock) notNil ifTrue:[
+ (handlerBlock := self creator handlerBlock) notNil ifTrue:[
"... and call it"
^ handlerBlock value:self.
].
@@ -1686,9 +1680,12 @@
|con|
con := handlerContext.
- thisContext evaluateUnwindActionsUpTo:con.
handlerContext := suspendedContext := raiseContext := nil.
- con restart
+ con unwindAndRestart.
+
+"/ thisContext evaluateUnwindActionsUpTo:con.
+"/ handlerContext := suspendedContext := raiseContext := nil.
+"/ con restart
"
|rslt n|
@@ -1719,9 +1716,11 @@
"/ ].
con receiver handlerProtectedBlock:aBlock inContext:con.
- thisContext evaluateUnwindActionsUpTo:con.
+"/ thisContext evaluateUnwindActionsUpTo:con.
+"/ handlerContext := suspendedContext := raiseContext := nil.
+"/ con restart
handlerContext := suspendedContext := raiseContext := nil.
- con restart
+ con unwindAndRestart.
"
|sig rslt|
@@ -1794,7 +1793,7 @@
return
"Continue after the handle:do: - the handle:do: returns nil"
- |con|
+ |con value|
con := handlerContext.
"/ cg: moving the following clearing of the handlerContext
@@ -1806,10 +1805,11 @@
"/ these are unmarkedForUnwind anyway, so there should be no danger
"/ for endless recursion here... (i.e. each unwind action can at most
"/ reraise that exception once).
+ value := self defaultReturnValue. "/ evaluate before unwinding
handlerContext := suspendedContext := raiseContext := nil.
thisContext evaluateUnwindActionsUpTo:con.
"/ handlerContext := suspendedContext := raiseContext := nil.
- con return:(self defaultReturnValue)
+ con return:value
"Modified: / 7.9.2001 / 13:29:34 / cg"
!
@@ -1881,8 +1881,8 @@
|sigDescr|
- sigDescr := signal description.
- (messageText isNil or:[ messageText isString not])
+ sigDescr := self creator description.
+ (messageText isNil or:[messageText isString not])
ifTrue:[
^ sigDescr
].
@@ -1923,7 +1923,7 @@
self mayProceed ifFalse:[
StrictRaising ifTrue:[
"/ proceeding from wrongProceedabilitySignal grants the raiseRequest
- WrongProceedabilityError raiseRequestWith:signal
+ WrongProceedabilityError raiseRequestWith:self creator.
] ifFalse:[
self class name infoPrint.
' [warning]: raised with wrong proceedability' infoPrintCR.
@@ -1984,16 +1984,16 @@
"is nil a valid originator? If so, we need an extra
instanceVariable to record the originator setting"
-
originator isNil ifTrue:[
originator := suspendedContext homeReceiver
].
+
signal isNil ifTrue:[
signal := self class
] ifFalse:[
signal isExceptionCreator ifFalse:[
"not an exception or Signal - there is something wrong here..."
- Error "GenericException" raiseWith:signal errorString:'unexpected non-ExceptionCreator in calling context'.
+ SignalError raiseWith:signal errorString:'unexpected non-ExceptionCreator in calling context'.
]
].
@@ -2018,9 +2018,12 @@
Maybe we should better treat a default action like a #handle:do:
at the outest level. But the DebugView currently can't handle this,
because it tries to raise e.g. AbortOperationRequest even if it has bee invoked
- by e.g. NoHandlerError"
-
- (ex1 creator == signal) ifTrue:[
+ by e.g. NoHandlerError.
+
+ Note that if raiseContext is nil, the exception
+ did already return."
+
+ (ex1 creator == signal and:[ex1 raiseContext notNil]) ifTrue:[
"the same exception that has been cought by a default action is raised again.
don't recurse"
^ self noHandler.
@@ -2294,8 +2297,6 @@
signal := aSignal.
!
-
-
suspendedContext:sContext errorString:aString
"set required fields
- only to be sent from the signal when raising"
@@ -2353,11 +2354,11 @@
!GenericException class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/GenericException.st,v 1.139 2013-05-21 20:26:48 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/GenericException.st,v 1.141 2013-05-27 14:13:24 stefan Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/GenericException.st,v 1.139 2013-05-21 20:26:48 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/GenericException.st,v 1.141 2013-05-27 14:13:24 stefan Exp $'
!
version_HG
--- a/Integer.st Tue May 28 00:23:55 2013 +0100
+++ b/Integer.st Fri May 31 00:35:21 2013 +0100
@@ -758,6 +758,8 @@
"Modified: / 15.11.1999 / 20:35:20 / cg"
! !
+
+
!Integer class methodsFor:'class initialization'!
initialize
@@ -818,6 +820,7 @@
"
! !
+
!Integer class methodsFor:'prime numbers'!
flushPrimeCache
@@ -1140,6 +1143,7 @@
^ self == Integer
! !
+
!Integer methodsFor:'Compatibility-Dolphin'!
& aNumber
@@ -2237,8 +2241,10 @@
!
byteSwapped
- ^ LargeInteger
- digitBytes:(self digitBytes) MSB:true
+ "lsb -> msb;
+ i.e. a.b.c.d -> d.c.b.a"
+
+ ^ LargeInteger digitBytes:(self digitBytes) MSB:true
"Created: / 31-01-2012 / 12:17:57 / cg"
!
@@ -4246,6 +4252,7 @@
"Created: / 09-01-2012 / 17:18:06 / cg"
! !
+
!Integer methodsFor:'special modulu arithmetic'!
add_32:anInteger
@@ -4932,11 +4939,11 @@
!Integer class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Integer.st,v 1.278 2013-05-13 14:43:36 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Integer.st,v 1.279 2013-05-27 08:08:41 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Integer.st,v 1.278 2013-05-13 14:43:36 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Integer.st,v 1.279 2013-05-27 08:08:41 cg Exp $'
! !
--- a/LargeInteger.st Tue May 28 00:23:55 2013 +0100
+++ b/LargeInteger.st Fri May 31 00:35:21 2013 +0100
@@ -290,6 +290,8 @@
"Modified: / 8.5.1998 / 21:40:41 / cg"
! !
+
+
!LargeInteger class methodsFor:'queries'!
isBuiltInClass
@@ -3930,267 +3932,267 @@
&& __isByteArray(otherDigitByteArray)
&& __isByteArray(resultDigitByteArray)
&& __bothSmallInteger(len1, len2)) {
- unsigned char *myBytes = __ByteArrayInstPtr(__INST(digitByteArray))->ba_element;
- unsigned char *otherBytes = __ByteArrayInstPtr(otherDigitByteArray)->ba_element;
- unsigned char *resultBytes = __ByteArrayInstPtr(resultDigitByteArray)->ba_element;
- unsigned char *_p1, *_p2, *_pResult, *_pResult0, *_pResult1, *_p1Last, *_p2Last;
- unsigned char *_pResultLast1;
- unsigned INT _v;
- int _len1 = __intVal(len1);
- int _len2 = __intVal(len2);
-
- _p1Last = myBytes + _len1 - 1; /* the last byte */
- _p2Last = otherBytes + _len2 - 1; /* the last byte */
- _pResult0 = resultBytes;
-
- /*
- * aaa...aaa f1[0] * f2
- * bbb...bbb f1[1] * f2
- * ccc...ccc f1[2] * f2
- * ...
- * xxx...xxx f1[high] * f2
- *
- * start short-wise
- * bounds: (16rFFFF * 16rFFFF) + 16rFFFF -> FFFF0000
- */
- _p1 = myBytes;
+ unsigned char *myBytes = __ByteArrayInstPtr(__INST(digitByteArray))->ba_element;
+ unsigned char *otherBytes = __ByteArrayInstPtr(otherDigitByteArray)->ba_element;
+ unsigned char *resultBytes = __ByteArrayInstPtr(resultDigitByteArray)->ba_element;
+ unsigned char *_p1, *_p2, *_pResult, *_pResult0, *_pResult1, *_p1Last, *_p2Last;
+ unsigned char *_pResultLast1;
+ unsigned INT _v;
+ int _len1 = __intVal(len1);
+ int _len2 = __intVal(len2);
+
+ _p1Last = myBytes + _len1 - 1; /* the last byte */
+ _p2Last = otherBytes + _len2 - 1; /* the last byte */
+ _pResult0 = resultBytes;
+
+ /*
+ * aaa...aaa f1[0] * f2
+ * bbb...bbb f1[1] * f2
+ * ccc...ccc f1[2] * f2
+ * ...
+ * xxx...xxx f1[high] * f2
+ *
+ * start short-wise
+ * bounds: (16rFFFF * 16rFFFF) + 16rFFFF -> FFFF0000
+ */
+ _p1 = myBytes;
#if defined(__LSBFIRST__) && (__POINTER_SIZE__ == 8)
- /* loop over ints of f1 */
- for (; _p1 < _p1Last-2; _p1 += 4, _pResult0 += 4) {
- unsigned INT word1 = ((unsigned int *)_p1)[0];
-
- _pResult = _pResult0;
- _p2 = otherBytes;
-
- /* loop over ints of f2 */
- while (_p2 < (_p2Last-2)) {
- _v = (word1 * ((unsigned int *)_p2)[0]) + ((unsigned int *)_pResult)[0];
- ((unsigned int *)_pResult)[0] = _v /* & 0xFFFFFFFF */;
- _v >>= 32; /* now _v contains the carry*/
- _pResult += 4;
- if (_v) {
- unsigned char *_pResultLast3;
-
- /* distribute carry - int-wise, then byte-wise */
- _pResultLast3 = _pResult0 + _len1 + _len2 - 1 - 3;
- for (_pResult1 = _pResult; _v; _pResult1 += 4) {
- if (_pResult1 > _pResultLast3) break;
- _v += ((unsigned int *)_pResult1)[0];
- ((unsigned int *)_pResult1)[0] = _v /* & 0xFFFFFFFF */;
- _v >>= 32;
- }
- for (; _v; _pResult1++) {
- _v += _pResult1[0];
- _pResult1[0] = _v /* & 0xFF */;
- _v >>= 8;
- }
- }
- _p2 += 4;
- }
-
- /* possible odd highByte of f2 */
- while (_p2 <= _p2Last) {
- _v = (word1 * _p2[0]) + ((unsigned int *)_pResult)[0];
- ((unsigned int *)_pResult)[0] = _v /* & 0xFFFFFFFF */;
- _v >>= 32; /* now _v contains the carry*/
- _pResult += 4;
- if (_v) {
- unsigned char *_pResultLast3;
-
- /* distribute carry - int-wise, then byte-wise */
- _pResultLast3 = _pResult0 + _len1 + _len2 - 1 - 3;
- for (_pResult1 = _pResult; _v; _pResult1 += 4) {
- if (_pResult1 > _pResultLast3) break;
- _v += ((unsigned int *)_pResult1)[0];
- ((unsigned int *)_pResult1)[0] = _v /* & 0xFFFFFFFF */;
- _v >>= 32;
- }
- for (; _v; _pResult1++) {
- _v += _pResult1[0];
- _pResult1[0] = _v /* & 0xFF */;
- _v >>= 8;
- }
- }
- _p2++;
- }
- }
+ /* loop over ints of f1 */
+ for (; _p1 < _p1Last-3; _p1 += 4, _pResult0 += 4) {
+ unsigned INT word1 = ((unsigned int *)_p1)[0];
+
+ _pResult = _pResult0;
+ _p2 = otherBytes;
+
+ /* loop over ints of f2 */
+ while (_p2 < (_p2Last-3)) {
+ _v = (word1 * ((unsigned int *)_p2)[0]) + ((unsigned int *)_pResult)[0];
+ ((unsigned int *)_pResult)[0] = _v /* & 0xFFFFFFFF */;
+ _v >>= 32; /* now _v contains the carry*/
+ _pResult += 4;
+ if (_v) {
+ unsigned char *_pResultLast3;
+
+ /* distribute carry - int-wise, then byte-wise */
+ _pResultLast3 = _pResult0 + _len1 + _len2 - 1 - 3;
+ for (_pResult1 = _pResult; _v; _pResult1 += 4) {
+ if (_pResult1 > _pResultLast3) break;
+ _v += ((unsigned int *)_pResult1)[0];
+ ((unsigned int *)_pResult1)[0] = _v /* & 0xFFFFFFFF */;
+ _v >>= 32;
+ }
+ for (; _v; _pResult1++) {
+ _v += _pResult1[0];
+ _pResult1[0] = _v /* & 0xFF */;
+ _v >>= 8;
+ }
+ }
+ _p2 += 4;
+ }
+
+ /* possible odd highByte of f2 */
+ while (_p2 <= _p2Last) {
+ _v = (word1 * _p2[0]) + ((unsigned int *)_pResult)[0];
+ ((unsigned int *)_pResult)[0] = _v /* & 0xFFFFFFFF */;
+ _v >>= 32; /* now _v contains the carry*/
+ _pResult += 4;
+ if (_v) {
+ unsigned char *_pResultLast3;
+
+ /* distribute carry - int-wise, then byte-wise */
+ _pResultLast3 = _pResult0 + _len1 + _len2 - 1 - 3;
+ for (_pResult1 = _pResult; _v; _pResult1 += 4) {
+ if (_pResult1 > _pResultLast3) break;
+ _v += ((unsigned int *)_pResult1)[0];
+ ((unsigned int *)_pResult1)[0] = _v /* & 0xFFFFFFFF */;
+ _v >>= 32;
+ }
+ for (; _v; _pResult1++) {
+ _v += _pResult1[0];
+ _pResult1[0] = _v /* & 0xFF */;
+ _v >>= 8;
+ }
+ }
+ _p2++;
+ }
+ }
#endif /* 64bit */
- /* loop over shorts of f1 */
- for (; _p1 < _p1Last; _p1 += 2, _pResult0 += 2) {
- unsigned int short1 = ((unsigned short *)_p1)[0];
+ /* loop over shorts of f1 */
+ for (; _p1 < _p1Last; _p1 += 2, _pResult0 += 2) {
+ unsigned int short1 = ((unsigned short *)_p1)[0];
#if !defined(__LSBFIRST__)
- short1 = ((short1 >> 8) & 0xFF) | ((short1 & 0xFF) << 8);
+ short1 = ((short1 >> 8) & 0xFF) | ((short1 & 0xFF) << 8);
#endif
- _pResult = _pResult0;
- _p2 = otherBytes;
-
- /* loop over shorts of f2 */
- while (_p2 < _p2Last) {
+ _pResult = _pResult0;
+ _p2 = otherBytes;
+
+ /* loop over shorts of f2 */
+ while (_p2 < _p2Last) {
#if !defined(__LSBFIRST__)
- unsigned int _short2;
- unsigned int _short3;
-
- _short2 = ((unsigned short *)_p2)[0];
- _short2 = ((_short2 >> 8) /* & 0xFF */) | ((_short2 & 0xFF) << 8);
- _short3 = ((unsigned short *)_pResult)[0];
- _short3 = ((_short3 >> 8) /* & 0xFF */) | ((_short3 & 0xFF) << 8);
- _v = (short1 * _short2) + _short3;
- _pResult[0] = _v;
- _pResult[1] = _v >> 8;
+ unsigned int _short2;
+ unsigned int _short3;
+
+ _short2 = ((unsigned short *)_p2)[0];
+ _short2 = ((_short2 >> 8) /* & 0xFF */) | ((_short2 & 0xFF) << 8);
+ _short3 = ((unsigned short *)_pResult)[0];
+ _short3 = ((_short3 >> 8) /* & 0xFF */) | ((_short3 & 0xFF) << 8);
+ _v = (short1 * _short2) + _short3;
+ _pResult[0] = _v;
+ _pResult[1] = _v >> 8;
#else /* __LSBFIRST__ */
- _v = (short1 * ((unsigned short *)_p2)[0]) + ((unsigned short *)_pResult)[0];
- ((unsigned short *)_pResult)[0] = _v /* & 0xFFFF */;
+ _v = (short1 * ((unsigned short *)_p2)[0]) + ((unsigned short *)_pResult)[0];
+ ((unsigned short *)_pResult)[0] = _v /* & 0xFFFF */;
#endif
- _v >>= 16; /* now _v contains the carry*/
- _pResult += 2;
- if (_v) {
- /* distribute carry - short-wise, then byte-wise */
- _pResult1 = _pResult;
+ _v >>= 16; /* now _v contains the carry*/
+ _pResult += 2;
+ if (_v) {
+ /* distribute carry - short-wise, then byte-wise */
+ _pResult1 = _pResult;
#if defined(__LSBFIRST__)
- _pResultLast1 = _pResult0 + _len1 + _len2 - 1 - 1;
- for (; _v; _pResult1 += 2) {
- if (_pResult1 > _pResultLast1) break;
- _v += ((unsigned short *)_pResult1)[0];
- ((unsigned short *)_pResult1)[0] = _v /* & 0xFFFF */;
- _v >>= 16;
- }
+ _pResultLast1 = _pResult0 + _len1 + _len2 - 1 - 1;
+ for (; _v; _pResult1 += 2) {
+ if (_pResult1 > _pResultLast1) break;
+ _v += ((unsigned short *)_pResult1)[0];
+ ((unsigned short *)_pResult1)[0] = _v /* & 0xFFFF */;
+ _v >>= 16;
+ }
#endif
- for (; _v; _pResult1++) {
- _v += _pResult1[0];
- _pResult1[0] = _v /* & 0xFF */;
- _v >>= 8;
- }
- }
- _p2 += 2;
- }
-
- /* possible odd highByte of f2 */
- if (_p2 <= _p2Last) {
+ for (; _v; _pResult1++) {
+ _v += _pResult1[0];
+ _pResult1[0] = _v /* & 0xFF */;
+ _v >>= 8;
+ }
+ }
+ _p2 += 2;
+ }
+
+ /* possible odd highByte of f2 */
+ if (_p2 <= _p2Last) {
#if !defined(__LSBFIRST__)
- unsigned int _short3;
-
- _short3 = ((unsigned short *)_pResult)[0];
- _short3 = ((_short3 >> 8) /* & 0xFF */) | ((_short3 & 0xFF) << 8);
- _v = (short1 * _p2[0]) + _short3;
- _pResult[0] = _v;
- _pResult[1] = _v >> 8;
+ unsigned int _short3;
+
+ _short3 = ((unsigned short *)_pResult)[0];
+ _short3 = ((_short3 >> 8) /* & 0xFF */) | ((_short3 & 0xFF) << 8);
+ _v = (short1 * _p2[0]) + _short3;
+ _pResult[0] = _v;
+ _pResult[1] = _v >> 8;
#else /* __LSBFIRST__ */
- _v = (short1 * _p2[0]) + ((unsigned short *)_pResult)[0];
- ((unsigned short *)_pResult)[0] = _v /* & 0xFFFF */;
+ _v = (short1 * _p2[0]) + ((unsigned short *)_pResult)[0];
+ ((unsigned short *)_pResult)[0] = _v /* & 0xFFFF */;
#endif
- _v >>= 16; /* now _v contains the carry*/
- _pResult += 2;
- if (_v) {
- /* distribute carry - short-wise, then byte-wise */
- _pResult1 = _pResult;
+ _v >>= 16; /* now _v contains the carry*/
+ _pResult += 2;
+ if (_v) {
+ /* distribute carry - short-wise, then byte-wise */
+ _pResult1 = _pResult;
#if defined(__LSBFIRST__)
- _pResultLast1 = _pResult0 + _len1 + _len2 - 1 - 1;
- for (; _v; _pResult1 += 2) {
- if (_pResult1 > _pResultLast1) break;
- _v += ((unsigned short *)_pResult1)[0];
- ((unsigned short *)_pResult1)[0] = _v /* & 0xFFFF */;
- _v >>= 16;
- }
+ _pResultLast1 = _pResult0 + _len1 + _len2 - 1 - 1;
+ for (; _v; _pResult1 += 2) {
+ if (_pResult1 > _pResultLast1) break;
+ _v += ((unsigned short *)_pResult1)[0];
+ ((unsigned short *)_pResult1)[0] = _v /* & 0xFFFF */;
+ _v >>= 16;
+ }
#endif
- for (; _v; _pResult1++) {
- _v += _pResult1[0];
- _pResult1[0] = _v /* & 0xFF */;
- _v >>= 8;
- }
- }
- _p2++;
- }
- }
-
- /* possible odd highByte of f1 (or byteLoop, if not __LSBFIRST__) */
- for (; _p1 <= _p1Last; _p1++, _pResult0++) {
- unsigned int byte1 = _p1[0];
-
- _pResult = _pResult0;
- _p2 = otherBytes;
-
- /* loop over shorts of f2 */
- while (_p2 < _p2Last) {
+ for (; _v; _pResult1++) {
+ _v += _pResult1[0];
+ _pResult1[0] = _v /* & 0xFF */;
+ _v >>= 8;
+ }
+ }
+ _p2++;
+ }
+ }
+
+ /* possible odd highByte of f1 (or byteLoop, if not __LSBFIRST__) */
+ for (; _p1 <= _p1Last; _p1++, _pResult0++) {
+ unsigned int byte1 = _p1[0];
+
+ _pResult = _pResult0;
+ _p2 = otherBytes;
+
+ /* loop over shorts of f2 */
+ while (_p2 < _p2Last) {
#if !defined(__LSBFIRST__)
- unsigned int _short2;
- unsigned int _short3;
-
- _short2 = ((unsigned short *)_p2)[0];
- _short2 = ((_short2 >> 8) /* & 0xFF */) | ((_short2 & 0xFF) << 8);
- _short3 = ((unsigned short *)_pResult)[0];
- _short3 = ((_short3 >> 8) /* & 0xFF */) | ((_short3 & 0xFF) << 8);
- _v = (byte1 * _short2) + _short3;
- _pResult[0] = _v;
- _pResult[1] = _v >> 8;
+ unsigned int _short2;
+ unsigned int _short3;
+
+ _short2 = ((unsigned short *)_p2)[0];
+ _short2 = ((_short2 >> 8) /* & 0xFF */) | ((_short2 & 0xFF) << 8);
+ _short3 = ((unsigned short *)_pResult)[0];
+ _short3 = ((_short3 >> 8) /* & 0xFF */) | ((_short3 & 0xFF) << 8);
+ _v = (byte1 * _short2) + _short3;
+ _pResult[0] = _v;
+ _pResult[1] = _v >> 8;
#else /* __LSBFIRST__ */
- _v = (byte1 * ((unsigned short *)_p2)[0]) + ((unsigned short *)_pResult)[0];
- ((unsigned short *)_pResult)[0] = _v /* & 0xFFFF */;
+ _v = (byte1 * ((unsigned short *)_p2)[0]) + ((unsigned short *)_pResult)[0];
+ ((unsigned short *)_pResult)[0] = _v /* & 0xFFFF */;
#endif
- _v >>= 16; /* now _v contains the carry*/
- _pResult += 2;
- if (_v) {
- /* distribute carry - short-wise, then byte-wise */
- _pResult1 = _pResult;
+ _v >>= 16; /* now _v contains the carry*/
+ _pResult += 2;
+ if (_v) {
+ /* distribute carry - short-wise, then byte-wise */
+ _pResult1 = _pResult;
#if defined(__LSBFIRST__)
- _pResultLast1 = _pResult0 + _len1 + _len2 - 1 - 1;
- for (_pResult1 = _pResult; _v; _pResult1 += 2) {
- if (_pResult1 > _pResultLast1) break;
- _v += ((unsigned short *)_pResult1)[0];
- ((unsigned short *)_pResult1)[0] = _v /* & 0xFFFF */;
- _v >>= 16;
- }
+ _pResultLast1 = _pResult0 + _len1 + _len2 - 1 - 1;
+ for (_pResult1 = _pResult; _v; _pResult1 += 2) {
+ if (_pResult1 > _pResultLast1) break;
+ _v += ((unsigned short *)_pResult1)[0];
+ ((unsigned short *)_pResult1)[0] = _v /* & 0xFFFF */;
+ _v >>= 16;
+ }
#endif /* __LSBFIRST__ */
- for (; _v; _pResult1++) {
- _v += _pResult1[0];
- _pResult1[0] = _v /* & 0xFF */;
- _v >>= 8;
- }
- }
- _p2 += 2;
- }
-
- /* possible odd highByte of f2 (or byteLoop, if not __LSBFIRST__) */
- while (_p2 <= _p2Last) {
- _v = (byte1 * _p2[0]) + _pResult[0];
- _pResult[0] = _v /* & 0xFF */;
- _v >>= 8; /* now _v contains the carry*/
- _pResult++;
- if (_v) {
- /* distribute carry */
- for (_pResult1 = _pResult; _v; _pResult1++) {
- _v += _pResult1[0];
- _pResult1[0] = _v /* & 0xFF */;
- _v >>= 8;
- }
- }
- _p2++;
- }
- }
- ok = true;
+ for (; _v; _pResult1++) {
+ _v += _pResult1[0];
+ _pResult1[0] = _v /* & 0xFF */;
+ _v >>= 8;
+ }
+ }
+ _p2 += 2;
+ }
+
+ /* possible odd highByte of f2 (or byteLoop, if not __LSBFIRST__) */
+ while (_p2 <= _p2Last) {
+ _v = (byte1 * _p2[0]) + _pResult[0];
+ _pResult[0] = _v /* & 0xFF */;
+ _v >>= 8; /* now _v contains the carry*/
+ _pResult++;
+ if (_v) {
+ /* distribute carry */
+ for (_pResult1 = _pResult; _v; _pResult1++) {
+ _v += _pResult1[0];
+ _pResult1[0] = _v /* & 0xFF */;
+ _v >>= 8;
+ }
+ }
+ _p2++;
+ }
+ }
+ ok = true;
}
%}.
ok ifFalse:[
- 1 to:len1 do:[:index1 |
- 1 to:len2 do:[:index2 |
- dstIndex := index1 + index2 - 1.
- prod := (digitByteArray basicAt:index1) * (otherDigitByteArray basicAt:index2).
- prod := prod + (resultDigitByteArray basicAt:dstIndex).
- resultDigitByteArray basicAt:dstIndex put:(prod bitAnd:16rFF).
- carry := prod bitShift:-8.
- carry ~~ 0 ifTrue:[
- idx := dstIndex + 1.
- [carry ~~ 0] whileTrue:[
- v := (resultDigitByteArray basicAt:idx) + carry.
- resultDigitByteArray basicAt:idx put:(v bitAnd:255).
- carry := v bitShift:-8.
- idx := idx + 1
- ]
- ]
- ]
- ].
+ 1 to:len1 do:[:index1 |
+ 1 to:len2 do:[:index2 |
+ dstIndex := index1 + index2 - 1.
+ prod := (digitByteArray basicAt:index1) * (otherDigitByteArray basicAt:index2).
+ prod := prod + (resultDigitByteArray basicAt:dstIndex).
+ resultDigitByteArray basicAt:dstIndex put:(prod bitAnd:16rFF).
+ carry := prod bitShift:-8.
+ carry ~~ 0 ifTrue:[
+ idx := dstIndex + 1.
+ [carry ~~ 0] whileTrue:[
+ v := (resultDigitByteArray basicAt:idx) + carry.
+ resultDigitByteArray basicAt:idx put:(v bitAnd:255).
+ carry := v bitShift:-8.
+ idx := idx + 1
+ ]
+ ]
+ ]
+ ].
].
^ result compressed
!
@@ -4714,13 +4716,13 @@
absSubtract:aLargeInteger
"private helper for division:
- destructively subtract aLargeInteger from myself
- AND return true, if the result is non-zero, false otherwise.
- (i.e. this method has both a return value and a side-effect
- on the receiver)
- Only allowed for positive receiver and argument
- The receiver must be >= the argument.
- The receiver must be a temporary scratch-number"
+ destructively subtract aLargeInteger from myself
+ AND return true, if the result is non-zero, false otherwise.
+ (i.e. this method has both a return value and a side-effect
+ on the receiver)
+ Only allowed for positive receiver and argument
+ The receiver must be >= the argument.
+ The receiver must be a temporary scratch-number"
|otherDigitByteArray
len1 "{ Class: SmallInteger }"
@@ -4736,12 +4738,12 @@
otherDigitByteArray := aLargeInteger digitBytes.
len2 := otherDigitByteArray size.
len2 > len1 ifTrue:[
- [(otherDigitByteArray at:len2) == 0] whileTrue:[
- len2 := len2 - 1
- ].
- len2 > len1 ifTrue:[
- self error:'operation failed' "/ may not be called that way
- ].
+ [(otherDigitByteArray at:len2) == 0] whileTrue:[
+ len2 := len2 - 1
+ ].
+ len2 > len1 ifTrue:[
+ self error:'operation failed' "/ may not be called that way
+ ].
].
"/ knowing that len2 is <= len1
%{
@@ -4750,147 +4752,147 @@
if (__isByteArray(_digitByteArray)
&& __isByteArray(otherDigitByteArray)) {
- int _len1 = __intVal(len1),
- _len2 = __intVal(len2);
- unsigned char *_myDigits, *_otherDigits;
- int _index = 1, _borrow = 0;
- INT _diff;
- INT anyBitNonZero = 0;
-
- _otherDigits = __ByteArrayInstPtr(otherDigitByteArray)->ba_element;
- _myDigits = __ByteArrayInstPtr(_digitByteArray)->ba_element;
+ int _len1 = __intVal(len1),
+ _len2 = __intVal(len2);
+ unsigned char *_myDigits, *_otherDigits;
+ int _index = 1, _borrow = 0;
+ INT _diff;
+ int anyBitNonZero = 0;
+
+ _otherDigits = __ByteArrayInstPtr(otherDigitByteArray)->ba_element;
+ _myDigits = __ByteArrayInstPtr(_digitByteArray)->ba_element;
#if defined(__LSBFIRST__)
# if __POINTER_SIZE__ == 8
- {
- int _len2Q;
- /*
- * subtract int-wise
- */
- _len2Q = _len2-2;
- while (_index < _len2Q) {
- /* do not combine the expression below (may lead to unsigned result on some machines */
- _diff = ((unsigned int *)(_myDigits+_index-1))[0];
- _diff -= ((unsigned int *)(_otherDigits+_index-1))[0];
- _diff -= _borrow;
- if (_diff >= 0) {
- _borrow = 0;
- } else {
- _borrow = 1;
- /* _diff += 0x10000; */
- }
- ((unsigned int *)(_myDigits+_index-1))[0] = _diff;
- anyBitNonZero |= (_diff & 0xFFFFFFFFL);
- _index += 4;
- }
- }
+ {
+ int _len2Q;
+ /*
+ * subtract int-wise
+ */
+ _len2Q = _len2-2;
+ while (_index < _len2Q) {
+ /* do not combine the expression below (may lead to unsigned result on some machines */
+ _diff = ((unsigned int *)(_myDigits+_index-1))[0];
+ _diff -= ((unsigned int *)(_otherDigits+_index-1))[0];
+ _diff -= _borrow;
+ if (_diff >= 0) {
+ _borrow = 0;
+ } else {
+ _borrow = 1;
+ /* _diff += 0x10000; */
+ }
+ ((unsigned int *)(_myDigits+_index-1))[0] = _diff;
+ anyBitNonZero |= (_diff & 0xFFFFFFFFL);
+ _index += 4;
+ }
+ }
# endif
- /*
- * subtract short-wise
- */
- while (_index < _len2) {
- /* do not combine the expression below (may lead to unsigned result on some machines */
- _diff = ((unsigned short *)(_myDigits+_index-1))[0];
- _diff -= ((unsigned short *)(_otherDigits+_index-1))[0];
- _diff -= _borrow;
- if (_diff >= 0) {
- _borrow = 0;
- } else {
- _borrow = 1;
- /* _diff += 0x10000; */
- }
- ((unsigned short *)(_myDigits+_index-1))[0] = _diff;
- anyBitNonZero |= (_diff & 0xFFFF);
- _index += 2;
- }
-
- if (_index <= _len2) {
- /*
- * cannot continue with shorts - there is an odd number of
- * bytes in the minuent
- */
- } else {
- while (_index < _len1) {
- /* do not combine the expression below (may lead to unsigned result on some machines */
- _diff = ((unsigned short *)(_myDigits+_index-1))[0];
- _diff -= _borrow;
- if (_diff >= 0) {
- /* _borrow = 0; */
- ((unsigned short *)(_myDigits+_index-1))[0] = _diff;
- anyBitNonZero |= (_diff & 0xFFFF);
- _index += 2;
- while (_index < _len1) {
- anyBitNonZero |= ((unsigned short *)(_myDigits+_index-1))[0];
- if (anyBitNonZero) {
- RETURN (true);
- }
- _index += 2;
- }
- /* last odd index */
- if (_index <= _len1) {
- anyBitNonZero |= _myDigits[_index - 1];;
- if (anyBitNonZero) {
- RETURN (true);
- }
- _index++;
- }
- RETURN (anyBitNonZero ? true : false);
- }
- _borrow = 1;
- /* _diff += 0x10000; */
-
- ((unsigned short *)(_myDigits+_index-1))[0] = _diff;
- anyBitNonZero |= (_diff & 0xFFFF);
- _index += 2;
- }
- }
+ /*
+ * subtract short-wise
+ */
+ while (_index < _len2) {
+ /* do not combine the expression below (may lead to unsigned result on some machines */
+ _diff = ((unsigned short *)(_myDigits+_index-1))[0];
+ _diff -= ((unsigned short *)(_otherDigits+_index-1))[0];
+ _diff -= _borrow;
+ if (_diff >= 0) {
+ _borrow = 0;
+ } else {
+ _borrow = 1;
+ /* _diff += 0x10000; */
+ }
+ ((unsigned short *)(_myDigits+_index-1))[0] = _diff;
+ anyBitNonZero |= (_diff & 0xFFFF);
+ _index += 2;
+ }
+
+ if (_index <= _len2) {
+ /*
+ * cannot continue with shorts - there is an odd number of
+ * bytes in the minuent
+ */
+ } else {
+ while (_index < _len1) {
+ /* do not combine the expression below (may lead to unsigned result on some machines */
+ _diff = ((unsigned short *)(_myDigits+_index-1))[0];
+ _diff -= _borrow;
+ if (_diff >= 0) {
+ /* _borrow = 0; */
+ ((unsigned short *)(_myDigits+_index-1))[0] = _diff;
+ anyBitNonZero |= (_diff & 0xFFFF);
+ _index += 2;
+ while (_index < _len1) {
+ anyBitNonZero |= ((unsigned short *)(_myDigits+_index-1))[0];
+ if (anyBitNonZero) {
+ RETURN (true);
+ }
+ _index += 2;
+ }
+ /* last odd index */
+ if (_index <= _len1) {
+ anyBitNonZero |= _myDigits[_index - 1];;
+ if (anyBitNonZero) {
+ RETURN (true);
+ }
+ _index++;
+ }
+ RETURN (anyBitNonZero ? true : false);
+ }
+ _borrow = 1;
+ /* _diff += 0x10000; */
+
+ ((unsigned short *)(_myDigits+_index-1))[0] = _diff;
+ anyBitNonZero |= (_diff & 0xFFFF);
+ _index += 2;
+ }
+ }
#endif
- /*
- * subtract byte-wise
- */
- while (_index <= _len2) {
- /* do not combine the expression below (may lead to unsigned result on some machines */
- _diff = _myDigits[_index - 1];
- _diff -= _otherDigits[_index - 1];
- _diff -= _borrow;
- if (_diff >= 0) {
- _borrow = 0;
- } else {
- _borrow = 1;
- /* _diff += 0x100; */
- }
- _myDigits[_index - 1] = _diff;
- anyBitNonZero |= (_diff & 0xFF);
- _index++;
- }
-
- while (_index <= _len1) {
- /* do not combine the expression below (may lead to unsigned result on some machines */
- _diff = _myDigits[_index - 1];
- _diff -= _borrow;
- if (_diff >= 0) {
- /* _borrow = 0; */
- _myDigits[_index - 1] = _diff;
- anyBitNonZero |= (_diff & 0xFF);
- _index++;
- while (_index <= _len1) {
- anyBitNonZero |= _myDigits[_index - 1];
- if (anyBitNonZero) {
- RETURN (true);
- }
- _index++;
- }
- break;
- }
- _borrow = 1;
- /* _diff += 0x100; */
-
- _myDigits[_index - 1] = _diff;
- anyBitNonZero |= (_diff & 0xFF);
- _index++;
- }
- RETURN (anyBitNonZero ? true : false);
+ /*
+ * subtract byte-wise
+ */
+ while (_index <= _len2) {
+ /* do not combine the expression below (may lead to unsigned result on some machines */
+ _diff = _myDigits[_index - 1];
+ _diff -= _otherDigits[_index - 1];
+ _diff -= _borrow;
+ if (_diff >= 0) {
+ _borrow = 0;
+ } else {
+ _borrow = 1;
+ /* _diff += 0x100; */
+ }
+ _myDigits[_index - 1] = _diff;
+ anyBitNonZero |= (_diff & 0xFF);
+ _index++;
+ }
+
+ while (_index <= _len1) {
+ /* do not combine the expression below (may lead to unsigned result on some machines */
+ _diff = _myDigits[_index - 1];
+ _diff -= _borrow;
+ if (_diff >= 0) {
+ /* _borrow = 0; */
+ _myDigits[_index - 1] = _diff;
+ anyBitNonZero |= (_diff & 0xFF);
+ _index++;
+ while (_index <= _len1) {
+ anyBitNonZero |= _myDigits[_index - 1];
+ if (anyBitNonZero) {
+ RETURN (true);
+ }
+ _index++;
+ }
+ break;
+ }
+ _borrow = 1;
+ /* _diff += 0x100; */
+
+ _myDigits[_index - 1] = _diff;
+ anyBitNonZero |= (_diff & 0xFF);
+ _index++;
+ }
+ RETURN (anyBitNonZero ? true : false);
}
%}.
@@ -4898,26 +4900,26 @@
borrow := 0.
[index <= len1] whileTrue:[
- diff := borrow.
- diff := diff + (digitByteArray basicAt:index).
- index <= len2 ifTrue:[
- diff := diff - (otherDigitByteArray basicAt:index).
- ].
-
- "/ workaround for
- "/ gcc code generator bug
-
- (diff >= 0) ifTrue:[
- borrow := 0
- ] ifFalse:[
- borrow := -1.
- diff := diff + 16r100
- ].
- diff ~~ 0 ifTrue:[
- notZero := true
- ].
- digitByteArray basicAt:index put:diff.
- index := index + 1
+ diff := borrow.
+ diff := diff + (digitByteArray basicAt:index).
+ index <= len2 ifTrue:[
+ diff := diff - (otherDigitByteArray basicAt:index).
+ ].
+
+ "/ workaround for
+ "/ gcc code generator bug
+
+ (diff >= 0) ifTrue:[
+ borrow := 0
+ ] ifFalse:[
+ borrow := -1.
+ diff := diff + 16r100
+ ].
+ diff ~~ 0 ifTrue:[
+ notZero := true
+ ].
+ digitByteArray basicAt:index put:diff.
+ index := index + 1
].
^ notZero
@@ -4929,7 +4931,8 @@
div2
"private helper for division:
- destructively divide the receiver by 2."
+ destructively divide the receiver by 2.
+ may leave the receiver unnormalized (i.e. with a leftover 0 high-byte)"
|prevBit|
@@ -4937,100 +4940,103 @@
OBJ __digits = __INST(digitByteArray);
if (__isByteArray(__digits)) {
- int __nBytes = __byteArraySize(__digits);
- unsigned char *__bp = __ByteArrayInstPtr(__digits)->ba_element;
- unsigned INT __this, __next;
- int __idx;
-
- if (__nBytes == 1) {
- __bp[0] >>= 1;
- RETURN (self);
- }
-
- __idx = 1;
-
-#if defined(__LSBFIRST__) && (__POINTER_SIZE__ == 8)
- if (sizeof(unsigned INT) == 8) {
- int __endIndex = __nBytes - 8;
-
- if (__idx < __endIndex) {
- __this = ((unsigned INT *)__bp)[0];
-
- while (__idx < __endIndex) {
- __next = ((unsigned INT *)__bp)[1];
- __this = (__this >> 1) /* & 0x7FFFFFFFFFFFFFF */;
- __this |= __next << 63;
- ((unsigned INT *)__bp)[0] = __this;
- __this = __next;
- __bp += 8;
- __idx += 8;
- }
- }
- }
-#else
-# if defined(__LSBFIRST__)
- if (sizeof(unsigned int) == 4) {
- int __endIndex = __nBytes - 4;
-
- if (__idx < __endIndex) {
- __this = ((unsigned INT *)__bp)[0];
-
-# if 0
- __idx += 4;
- while (__idx < __endIndex) {
- __next = ((unsigned int *)__bp)[1];
- __this = (__this >> 1) /* & 0x7FFFFFF */;
- __this |= __next << 31;
- ((unsigned int *)__bp)[0] = __this;
- __this = __next;
-
- __next = ((unsigned int *)__bp)[2];
- __this = (__this >> 1) /* & 0x7FFFFFF */;
- __this |= __next << 31;
- ((unsigned int *)__bp)[1] = __this;
- __this = __next;
-
- __bp += 8;
- __idx += 8;
- }
- __idx -= 4;
-# endif
- while (__idx < __endIndex) {
- __next = ((unsigned int *)__bp)[1];
- __this = (__this >> 1) /* & 0x7FFFFFF */;
- __this |= __next << 31;
- ((unsigned int *)__bp)[0] = __this;
- __this = __next;
- __bp += 4;
- __idx += 4;
- }
- }
- }
+ int __nBytes = __byteArraySize(__digits);
+ unsigned char *__bp = __ByteArrayInstPtr(__digits)->ba_element;
+ unsigned INT __this, __next;
+ int __idx;
+
+ if (__nBytes == 1) {
+ __bp[0] >>= 1;
+ RETURN (self);
+ }
+
+ __idx = 1;
+
+#if defined(__LSBFIRST__)
+# if (__POINTER_SIZE__ == 8)
+ if (sizeof(unsigned INT) == 8) {
+ int __endIndex = __nBytes - 8;
+
+ if (__idx < __endIndex) {
+ __this = ((unsigned INT *)__bp)[0];
+
+ while (__idx < __endIndex) {
+ __next = ((unsigned INT *)__bp)[1];
+ __this = (__this >> 1) /* & 0x7FFFFFFFFFFFFFF */;
+ __this |= __next << 63;
+ ((unsigned INT *)__bp)[0] = __this;
+ __this = __next;
+ __bp += 8;
+ __idx += 8;
+ }
+ }
+
+ if (__idx < (__nBytes - 4)) {
+ __this = ((unsigned int *)__bp)[0];
+
+ __next = ((unsigned int *)__bp)[1];
+ __this = (__this >> 1) /* & 0x7FFFFFF */;
+ __this |= __next << 31;
+ ((unsigned int *)__bp)[0] = __this;
+ __this = __next;
+ __bp += 4;
+ __idx += 4;
+ }
+ if (__idx < (__nBytes - 2)) {
+ __this = ((unsigned short *)__bp)[0];
+
+ __next = ((unsigned short *)__bp)[1];
+ __this = (__this >> 1) /* & 0x7FFFFFF */;
+ __this |= __next << 15;
+ ((unsigned short *)__bp)[0] = __this;
+ __this = __next;
+ __bp += 2;
+ __idx += 2;
+ }
+ }
+# else
+ if (sizeof(unsigned int) == 4) {
+ int __endIndex = __nBytes - 4;
+
+ if (__idx < __endIndex) {
+ __this = ((unsigned int *)__bp)[0];
+
+ while (__idx < __endIndex) {
+ __next = ((unsigned int *)__bp)[1];
+ __this = (__this >> 1) /* & 0x7FFFFFF */;
+ __this |= __next << 31;
+ ((unsigned int *)__bp)[0] = __this;
+ __this = __next;
+ __bp += 4;
+ __idx += 4;
+ }
+ }
+ }
# endif
#endif
- __this = __bp[0];
- while (__idx < __nBytes) {
- __next = __bp[1];
- __this >>= 1;
- __this |= __next << 7;
- __bp[0] = __this;
- __this = __next;
- __bp++;
- __idx++;
- }
- __bp[0] = __this >> 1;
- RETURN (self);
+ __this = __bp[0];
+ while (__idx < __nBytes) {
+ __next = __bp[1];
+ __this >>= 1;
+ __this |= __next << 7;
+ __bp[0] = __this;
+ __this = __next;
+ __bp++;
+ __idx++;
+ }
+ __bp[0] = __this >> 1;
+ RETURN (self);
}
%}.
prevBit := 0.
digitByteArray size to:1 by:-1 do:[:idx |
- |thisByte|
-
- thisByte := digitByteArray at:idx.
- digitByteArray at:idx put:((thisByte bitShift:-1) bitOr:prevBit).
- prevBit := (thisByte bitAnd:1) bitShift:7.
+ |thisByte|
+
+ thisByte := digitByteArray at:idx.
+ digitByteArray at:idx put:((thisByte bitShift:-1) bitOr:prevBit).
+ prevBit := (thisByte bitAnd:1) bitShift:7.
].
"
@@ -5054,71 +5060,81 @@
b := digitByteArray at:nBytes.
(b bitAnd:16r80) ~~ 0 ifTrue:[
- "/ need another byte
- nBytes := nBytes + 1.
- t := ByteArray uninitializedNew:nBytes.
- t replaceFrom:1 to:nBytes-1 with:digitByteArray startingAt:1.
- t at:nBytes put:0.
- digitByteArray := t.
+ "/ need another byte
+ nBytes := nBytes + 1.
+ t := ByteArray uninitializedNew:nBytes.
+ t replaceFrom:1 to:nBytes-1 with:digitByteArray startingAt:1.
+ t at:nBytes put:0.
+ digitByteArray := t.
].
%{
OBJ __digits = __INST(digitByteArray);
if (__isByteArray(__digits)) {
- int __nBytes = __intVal(nBytes);
- unsigned char *__bp = __ByteArrayInstPtr(__digits)->ba_element;
- unsigned INT __carry = 0, __newCarry;
+ int __nBytes = __intVal(nBytes);
+ unsigned char *__bp = __ByteArrayInstPtr(__digits)->ba_element;
+ unsigned INT __carry = 0, __newCarry;
#if defined(__LSBFIRST__)
# if (__POINTER_SIZE__ == 8)
- if (sizeof(unsigned INT) == 8) {
- while (__nBytes >= 8) {
- unsigned INT __this;
-
- __this = ((unsigned INT *)__bp)[0];
- __newCarry = (__this >> 63) /* & 1 */;
- ((unsigned INT *)__bp)[0] = (__this << 1) | __carry;
- __carry = __newCarry;
- __bp += 8;
- __nBytes -= 8;
- }
- }
+ if (sizeof(unsigned INT) == 8) {
+ while (__nBytes >= 8) {
+ unsigned INT __this;
+
+ __this = ((unsigned INT *)__bp)[0];
+ __newCarry = (__this >> 63) /* & 1 */;
+ ((unsigned INT *)__bp)[0] = (__this << 1) | __carry;
+ __carry = __newCarry;
+ __bp += 8;
+ __nBytes -= 8;
+ }
+ }
# endif
- if (sizeof(unsigned int) == 4) {
- while (__nBytes >= 4) {
- unsigned int __this;
-
- __this = ((unsigned int *)__bp)[0];
- __newCarry = (__this >> 31) /* & 1 */;
- ((unsigned int *)__bp)[0] = (__this << 1) | __carry;
- __carry = __newCarry;
- __bp += 4;
- __nBytes -= 4;
- }
- }
+ if (sizeof(unsigned int) == 4) {
+ while (__nBytes >= 4) {
+ unsigned int __this;
+
+ __this = ((unsigned int *)__bp)[0];
+ __newCarry = (__this >> 31) /* & 1 */;
+ ((unsigned int *)__bp)[0] = (__this << 1) | __carry;
+ __carry = __newCarry;
+ __bp += 4;
+ __nBytes -= 4;
+ }
+ }
+ if (__nBytes >= 2) {
+ unsigned short __this;
+
+ __this = ((unsigned short *)__bp)[0];
+ __newCarry = (__this >> 15) /* & 1 */;
+ ((unsigned short *)__bp)[0] = (__this << 1) | __carry;
+ __carry = __newCarry;
+ __bp += 2;
+ __nBytes -= 2;
+ }
#endif /* LSBFIRST */
- while (__nBytes) {
- unsigned char __this;
-
- __this = __bp[0];
- __newCarry = (__this >> 7) /* & 1 */;
- __bp[0] = (__this << 1) | __carry;
- __carry = __newCarry;
- __bp++;
- __nBytes--;
- }
- RETURN (self);
+ while (__nBytes) {
+ unsigned char __this;
+
+ __this = __bp[0];
+ __newCarry = (__this >> 7) /* & 1 */;
+ __bp[0] = (__this << 1) | __carry;
+ __carry = __newCarry;
+ __bp++;
+ __nBytes--;
+ }
+ RETURN (self);
}
%}.
prevBit := 0.
1 to:digitByteArray size do:[:idx |
- |thisByte|
-
- thisByte := digitByteArray at:idx.
- digitByteArray at:idx put:(((thisByte bitShift:1) bitAnd:16rFF) bitOr:prevBit).
- prevBit := (thisByte bitShift:-7) bitAnd:1.
+ |thisByte|
+
+ thisByte := digitByteArray at:idx.
+ digitByteArray at:idx put:(((thisByte bitShift:1) bitAnd:16rFF) bitOr:prevBit).
+ prevBit := (thisByte bitShift:-7) bitAnd:1.
].
"
@@ -5206,10 +5222,10 @@
!LargeInteger class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/LargeInteger.st,v 1.209 2013-05-21 20:44:47 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/LargeInteger.st,v 1.210 2013-05-27 08:13:50 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/LargeInteger.st,v 1.209 2013-05-21 20:44:47 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/LargeInteger.st,v 1.210 2013-05-27 08:13:50 cg Exp $'
! !
--- a/LongFloat.st Tue May 28 00:23:55 2013 +0100
+++ b/LongFloat.st Fri May 31 00:35:21 2013 +0100
@@ -507,27 +507,30 @@
numBitsInExponent
"answer the number of bits in the exponent
i386: This is an 80bit longfloat stored in 96 bits (upper 16 bits are unused),
- where 15 bits are available in the exponent (i bit is ignored):
- 00000000 00000000 seeeeeee eeeeeeee immmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm
+ where 15 bits are available in the exponent (i bit is ignored):
+ 00000000 00000000 seeeeeee eeeeeeee immmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm
+ x86_64: This is an 80bit longfloat stored in 128 bits (upper 48 bits are unused),
+ where 1+63 bits are available in the mantissa:
+ 00000000 00000000 seeeeeee eeeeeeee immmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm
"
%{
if (sizeof(LONGFLOAT) == 10) {
- RETURN (__mkSmallInteger(15)); /* i386 - WIN32 */
+ RETURN (__mkSmallInteger(15)); /* i386 - WIN32 */
}
if (sizeof(LONGFLOAT) == 12) {
- RETURN (__mkSmallInteger(15)); /* i386 */
+ RETURN (__mkSmallInteger(15)); /* i386 */
}
if (sizeof(LONGFLOAT) == 16) {
#ifdef __x86_64__
- RETURN (__mkSmallInteger(15)); /* amd64, i386-64bit */
+ RETURN (__mkSmallInteger(15)); /* amd64, i386-64bit */
#else
- RETURN (__mkSmallInteger(15)); /* sparc */
+ RETURN (__mkSmallInteger(15)); /* sparc */
#endif
}
%}.
"systems without longFloat support use doubles instead"
self basicNew basicSize == Float basicNew basicSize ifTrue:[
- ^ Float numBitsInExponent
+ ^ Float numBitsInExponent
].
self error:'missing definition' "ifdef missing in above primitive code for this architecture"
@@ -539,27 +542,30 @@
numBitsInIntegerPart
"answer the number of bits in the integer part of the mantissa
i386: This is an 80bit longfloat stored in 96 bits (upper 16 bits are unused),
- where 1 bit is used for the integer part in the mantissa:
- 00000000 00000000 seeeeeee eeeeeeee immmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm
+ where 1 bit is used for the integer part in the mantissa:
+ 00000000 00000000 seeeeeee eeeeeeee immmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm
+ x86_64: This is an 80bit longfloat stored in 128 bits (upper 48 bits are unused),
+ where 1+63 bits are available in the mantissa:
+ 00000000 00000000 seeeeeee eeeeeeee immmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm
"
%{
if (sizeof(LONGFLOAT) == 10) {
- RETURN (__mkSmallInteger(1)); /* i386 - WIN32 */
+ RETURN (__mkSmallInteger(1)); /* i386 - WIN32 */
}
if (sizeof(LONGFLOAT) == 12) {
- RETURN (__mkSmallInteger(1)); /* i386 */
+ RETURN (__mkSmallInteger(1)); /* i386 */
}
if (sizeof(LONGFLOAT) == 16) {
#ifdef __x86_64__
- RETURN (__mkSmallInteger(1)); /* amd64 */
+ RETURN (__mkSmallInteger(1)); /* amd64 */
#else
- RETURN (__mkSmallInteger(0)); /* sparc */
+ RETURN (__mkSmallInteger(0)); /* sparc */
#endif
}
%}.
"systems without longFloat support use doubles instead"
self basicNew basicSize == Float basicNew basicSize ifTrue:[
- ^ Float numBitsInIntegerPart
+ ^ Float numBitsInIntegerPart
].
self error:'missing definition' "ifdef missing in above primitive code for this architecture"
@@ -571,30 +577,33 @@
numBitsInMantissa
"answer the number of bits in the mantissa
i386: This is an 80bit longfloat stored in 96 bits (upper 16 bits are unused),
- where 1+63 bits are available in the mantissa:
- 00000000 00000000 seeeeeee eeeeeeee immmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm
+ where 1+63 bits are available in the mantissa:
+ 00000000 00000000 seeeeeee eeeeeeee immmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm
+ x86_64: This is an 80bit longfloat stored in 128 bits (upper 48 bits are unused),
+ where 1+63 bits are available in the mantissa:
+ 00000000 00000000 seeeeeee eeeeeeee immmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm
sparc: This is an 128bit longfloat,
- where 1+112 bits are available in the mantissa:
- 00000000 00000000 seeeeeee eeeeeeee immmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm
+ where 1+112 bits are available in the mantissa:
+ 00000000 00000000 seeeeeee eeeeeeee immmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm
"
%{
if (sizeof(LONGFLOAT) == 10) {
- RETURN (__mkSmallInteger(64)); /* i386 - WIN32 */
+ RETURN (__mkSmallInteger(64)); /* i386 - WIN32 */
}
if (sizeof(LONGFLOAT) == 12) {
- RETURN (__mkSmallInteger(64)); /* i386 */
+ RETURN (__mkSmallInteger(64)); /* i386 */
}
if (sizeof(LONGFLOAT) == 16) {
#ifdef __x86_64__
- RETURN (__mkSmallInteger(64)); /* amd64 */
+ RETURN (__mkSmallInteger(64)); /* amd64 */
#else
- RETURN (__mkSmallInteger(112)); /* sparc */
+ RETURN (__mkSmallInteger(112)); /* sparc */
#endif
}
%}.
"systems without longFloat support use doubles instead"
self basicNew basicSize == Float basicNew basicSize ifTrue:[
- ^ Float numBitsInMantissa
+ ^ Float numBitsInMantissa
].
self error:'missing definition' "ifdef missing in above primitive code for this architecture"
@@ -2692,11 +2701,11 @@
!LongFloat class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/LongFloat.st,v 1.79 2013-05-21 20:45:20 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/LongFloat.st,v 1.80 2013-05-27 08:14:16 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/LongFloat.st,v 1.79 2013-05-21 20:45:20 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/LongFloat.st,v 1.80 2013-05-27 08:14:16 cg Exp $'
! !
--- a/Notification.st Tue May 28 00:23:55 2013 +0100
+++ b/Notification.st Fri May 31 00:35:21 2013 +0100
@@ -304,7 +304,7 @@
"try per signal handler.
I may have been created from a QuerySignal"
- (handlerBlock := signal handlerBlock) notNil ifTrue:[
+ (handlerBlock := self creator handlerBlock) notNil ifTrue:[
"... and call it"
^ handlerBlock value:self.
].
@@ -375,11 +375,11 @@
!Notification class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Notification.st,v 1.29 2013-04-19 08:41:19 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Notification.st,v 1.30 2013-05-27 14:12:02 stefan Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Notification.st,v 1.29 2013-04-19 08:41:19 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Notification.st,v 1.30 2013-05-27 14:12:02 stefan Exp $'
! !
--- a/SmallInteger.st Tue May 28 00:23:55 2013 +0100
+++ b/SmallInteger.st Fri May 31 00:35:21 2013 +0100
@@ -808,6 +808,7 @@
! !
+
!SmallInteger methodsFor:'bit operators'!
bitAnd:anInteger
@@ -906,31 +907,31 @@
unsigned int _cnt;
unsigned INT _self = __intVal(self);
-#define ALGORIHTM_3
-
-#ifdef ALGORITHM_1
+# define ALGORIHTM_3
+
+# ifdef ALGORITHM_1
// old k&r code; might be better if only one or two bits are set
_cnt = 0;
while (_self) {
- _cnt++;
- _self = _self & (_self - 1);
+ _cnt++;
+ _self = _self & (_self - 1);
}
-#else
-# ifdef ALGORITHM_2
+# else
+# ifdef ALGORITHM_2
// seems to be faster on the average (and has better worst case)
static unsigned char table[] = { 0, 1, 1, 2, 1, 2, 2, 3, 1, 2, 2, 3, 2, 3, 3, 4 };
_cnt = 0;
while (_self) {
- _cnt += table[ _self & 0x0F ];
- _self >>= 4;
+ _cnt += table[ _self & 0x0F ];
+ _self >>= 4;
}
-# else
-# ifdef ALGORIHTM_3
+# else
+# ifdef ALGORIHTM_3
// the fastest, but hard (impossible) to understand (google for fastest bit count)
-# if __POINTER_SIZE__ == 8
+# if __POINTER_SIZE__ == 8
unsigned int _v1, _v2;
_v1 = _self & 0xFFFFFFFF;
@@ -944,42 +945,43 @@
_v2 = ((_v2 + (_v2 >> 4)) & 0x0F0F0F0F);
_cnt = ((_v1 * 0x01010101) >> 24) + ((_v2 * 0x01010101) >> 24);
-# else
+# else
_cnt = _self - ((_self >> 1) & 0x55555555);
_cnt = (_cnt & 0x33333333) + ((_cnt >> 2) & 0x33333333);
_cnt = ((_cnt + (_cnt >> 4)) & 0x0F0F0F0F);
_cnt = (_cnt * 0x01010101) >> 24;
+# endif
+# else
+ error error error
# endif
-# else
- error error error
# endif
# endif
-#endif
RETURN ( __MKSMALLINT(_cnt));
%}
"
+
1 to:1000000 do:[:n |
- self assert:(n bitCount = ((n printStringRadix:2) occurrencesOf:$1))
+ self assert:(n bitCount = ((n printStringRadix:2) occurrencesOf:$1))
].
#(
- 16r00010000 16r00100000 16r01000000 16r10000000
- 16r00020000 16r00200000 16r02000000 16r20000000
- 16r00040000 16r00400000 16r04000000 16r40000000
- 16r00080000 16r00800000 16r08000000 16r80000000
-
- 16rFFFFFFFF 16r7FFFFFFF 16r3FFFFFFF 16r1FFFFFFF
- 16rEEEEEEEE 16r7EEEEEEE 16r3EEEEEEE 16r1EEEEEEE
- 16rDDDDDDDD 16r7DDDDDDD 16r3DDDDDDD 16r1DDDDDDD
- 16rCCCCCCCC 16r7CCCCCCC 16r3CCCCCCC 16r1CCCCCCC
+ 16r00010000 16r00100000 16r01000000 16r10000000
+ 16r00020000 16r00200000 16r02000000 16r20000000
+ 16r00040000 16r00400000 16r04000000 16r40000000
+ 16r00080000 16r00800000 16r08000000 16r80000000
+
+ 16rFFFFFFFF 16r7FFFFFFF 16r3FFFFFFF 16r1FFFFFFF
+ 16rEEEEEEEE 16r7EEEEEEE 16r3EEEEEEE 16r1EEEEEEE
+ 16rDDDDDDDD 16r7DDDDDDD 16r3DDDDDDD 16r1DDDDDDD
+ 16rCCCCCCCC 16r7CCCCCCC 16r3CCCCCCC 16r1CCCCCCC
) do:[:n |
- self assert:(n bitCount = ((n printStringRadix:2) occurrencesOf:$1))
+ self assert:(n bitCount = ((n printStringRadix:2) occurrencesOf:$1))
]
1 to:10000000 do:[:n |
- (n bitCount)
+ (n bitCount)
]
"
@@ -2114,19 +2116,26 @@
%{ /* NOCONTEXT */
-#if __POINTER_SIZE__ == 4
- unsigned int v = __intVal(self);
- unsigned int swapped;
-
- swapped = ((v&0xFF000000)>>8) | ((v&0xFF0000) << 8) | ((v & 0xFF00)>>8) | ((v & 0xFF)<<8);
+ unsigned INT v = __intVal(self);
+ unsigned INT swapped;
+
+#if __POINTER_SIZE__ == 8
+ swapped = ((v >> 8) & 0x00FF00FF00FF00FF) | ((v & 0x00FF00FF00FF00FF) << 8);
+#else
+ swapped = ((v >> 8) & 0x00FF00FF) | ((v & 0x00FF00FF) << 8);
+#endif /* __POINTER_SIZE__ */
+ if (__ISVALIDINTEGER(swapped)) {
+ RETURN ( __mkSmallInteger(swapped) );
+ }
RETURN (__MKUINT(swapped));
-#endif /* __POINTER_SIZE__ */
%}.
^ super swapBytes
"
- 16r11223344 swapBytes hexPrintString
- 16r44332211 swapBytes hexPrintString
+ 16r11223344 swapBytes hexPrintString
+ 16r44332211 swapBytes hexPrintString
+ 16r1122334455667788 swapBytes hexPrintString
+ 16r11223344556677889900 swapBytes hexPrintString
"
"Created: / 09-01-2012 / 23:01:33 / cg"
@@ -3393,28 +3402,42 @@
(i.e. without log)."
self <= 0 ifTrue:[
- ^ self class
- raise:#domainErrorSignal
- receiver:self
- selector:#intlog10
- arguments:#()
- errorString:'logarithm of negative integer'
+ ^ self class
+ raise:#domainErrorSignal
+ receiver:self
+ selector:#intlog10
+ arguments:#()
+ errorString:'logarithm of negative integer'
].
self < 10000 ifTrue:[
- self < 10 ifTrue:[^ 0].
- self < 100 ifTrue:[^ 1].
- self < 1000 ifTrue:[^ 2].
- ^ 3
+ self < 10 ifTrue:[^ 0].
+ self < 100 ifTrue:[^ 1].
+ self < 1000 ifTrue:[^ 2].
+ ^ 3
].
self < 100000000 ifTrue:[
- self < 100000 ifTrue:[^ 4].
- self < 1000000 ifTrue:[^ 5].
- self < 10000000 ifTrue:[^ 6].
- ^ 7
+ self < 100000 ifTrue:[^ 4].
+ self < 1000000 ifTrue:[^ 5].
+ self < 10000000 ifTrue:[^ 6].
+ ^ 7
].
self < 1000000000 ifTrue:[^ 8].
- ^ 9
-
+
+ SmallInteger maxBytes == 4 ifTrue:[
+ ^ 9
+ ] ifFalse:[
+ self < 10000000000 ifTrue:[^ 9].
+ self < 100000000000 ifTrue:[^ 10].
+ self < 1000000000000 ifTrue:[^ 11].
+ self < 10000000000000 ifTrue:[^ 12].
+ self < 100000000000000 ifTrue:[^ 13].
+ self < 1000000000000000 ifTrue:[^ 14].
+ self < 10000000000000000 ifTrue:[^ 15].
+ self < 100000000000000000 ifTrue:[^ 16].
+ self < 1000000000000000000 ifTrue:[^ 17].
+ ^ 18.
+ ].
+ "/ not reached
"
99 intlog10
100 intlog10
@@ -4199,11 +4222,11 @@
!SmallInteger class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/SmallInteger.st,v 1.205 2013-05-21 20:17:58 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/SmallInteger.st,v 1.207 2013-05-27 08:12:49 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/SmallInteger.st,v 1.205 2013-05-21 20:17:58 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/SmallInteger.st,v 1.207 2013-05-27 08:12:49 cg Exp $'
! !
--- a/Smalltalk.st Tue May 28 00:23:55 2013 +0100
+++ b/Smalltalk.st Fri May 31 00:35:21 2013 +0100
@@ -3827,15 +3827,15 @@
#earlySystemInstallation is sent for ST80 compatibility
#earlyRestart is send first, nothing has been setup yet.
- (should be used to flush all device dependent entries)
+ (should be used to flush all device dependent entries)
#restarted is send right after.
- (should be used to recreate external resources (fds, bitmaps etc)
+ (should be used to recreate external resources (fds, bitmaps etc)
#returnFromSnapshot is sent last
- (should be used to restart processes, reOpen Streams which cannot
- be automatically be reopened (i.e. Sockets, Pipes) and so on.
- (Notice that positionable fileStreams are already reopened and repositioned)
+ (should be used to restart processes, reOpen Streams which cannot
+ be automatically be reopened (i.e. Sockets, Pipes) and so on.
+ (Notice that positionable fileStreams are already reopened and repositioned)
"
|deb insp transcript idx|
@@ -3859,12 +3859,12 @@
idx := CommandLineArguments indexOf:'-q'.
idx == 0 ifTrue:[
- idx := CommandLineArguments indexOf:'--silent'.
+ idx := CommandLineArguments indexOf:'--silent'.
].
idx ~~ 0 ifTrue:[
- Object infoPrinting:false.
- ObjectMemory infoPrinting:false.
- CommandLineArguments removeAtIndex:idx.
+ Object infoPrinting:false.
+ ObjectMemory infoPrinting:false.
+ CommandLineArguments removeAtIndex:idx.
].
"/
@@ -3879,6 +3879,7 @@
"/ flush cached path directories (may have changed in the meanwhile)
self flushPathCaches.
+ self reinitializePackagePath.
"/
"/ reinit the default streams: Stdin, Stdout and Stderr
@@ -3899,7 +3900,7 @@
insp := Inspector.
deb := Debugger.
deb notNil ifTrue:[
- deb reinitialize
+ deb reinitialize
].
Inspector := MiniInspector.
Debugger := MiniDebugger.
@@ -3912,7 +3913,7 @@
"/ ObjectFileLoader; therefore, must reload before doing any notifications.
ObjectFileLoader notNil ifTrue:[
- ObjectFileLoader reloadAllRememberedObjectFiles.
+ ObjectFileLoader reloadAllRememberedObjectFiles.
].
"/
@@ -3921,9 +3922,9 @@
"/ a display during early startup.
Screen notNil ifTrue:[
- Screen allScreens do:[:aDisplay |
- aDisplay invalidateConnection
- ].
+ Screen allScreens do:[:aDisplay |
+ aDisplay invalidateConnection
+ ].
].
ObjectMemory changed:#earlySystemInstallation.
@@ -3939,7 +3940,7 @@
"/ (mostly view/GC/color & font stuff)
ObjectMemory
- changed:#earlyRestart; changed:#restarted.
+ changed:#earlyRestart; changed:#restarted.
"/
"/ start catching SIGINT and SIGQUIT
@@ -3953,80 +3954,80 @@
idx := CommandLineArguments indexOf:'--faststart'.
idx == 0 ifTrue:[
- idx := CommandLineArguments indexOf:'--fastStart'.
+ idx := CommandLineArguments indexOf:'--fastStart'.
].
idx ~~ 0 ifTrue:[
- CommandLineArguments removeAtIndex:idx.
+ CommandLineArguments removeAtIndex:idx.
] ifFalse:[
- CallbackSignal := QuerySignal new.
- [
- Class withoutUpdatingChangesDo:[
- (self fileIn:(self commandName , '_r.rc')) ifFalse:[
- "no _r.rc file where executable is; try default smalltalk_r.rc"
- self fileIn:'smalltalk_r.rc'
- ].
- ]
- ] on:CallbackSignal do:[:ex|
- "/ now, display and view-stuff works;
- "/ back to the previous debugging interface
-
- Inspector := insp.
- Debugger := deb.
-
- "/ reinstall Transcript, if not changed during restart.
- "/ if there was no Transcript, go to stderr
-
- (transcript notNil and:[Transcript == Stderr]) ifTrue:[
- Transcript := transcript.
- ].
- Initializing := false.
- ex proceed.
- ].
- CallbackSignal := nil.
+ CallbackSignal := QuerySignal new.
+ [
+ Class withoutUpdatingChangesDo:[
+ (self fileIn:(self commandName , '_r.rc')) ifFalse:[
+ "no _r.rc file where executable is; try default smalltalk_r.rc"
+ self fileIn:'smalltalk_r.rc'
+ ].
+ ]
+ ] on:CallbackSignal do:[:ex|
+ "/ now, display and view-stuff works;
+ "/ back to the previous debugging interface
+
+ Inspector := insp.
+ Debugger := deb.
+
+ "/ reinstall Transcript, if not changed during restart.
+ "/ if there was no Transcript, go to stderr
+
+ (transcript notNil and:[Transcript == Stderr]) ifTrue:[
+ Transcript := transcript.
+ ].
+ Initializing := false.
+ ex proceed.
+ ].
+ CallbackSignal := nil.
].
"/ reinitialization (restart) of Display is normally performed
"/ in the restart script. If this has not been run for some reason,
"/ do in now.
Initializing ifTrue:[
- Display notNil ifTrue:[
- [
- Display reinitializeFor:Screen defaultDisplayName.
- ] on:Screen deviceOpenErrorSignal do:[
- 'Smalltalk [error]: Cannot restart connection to: ' errorPrint.
- Screen defaultDisplayName errorPrintCR.
- OperatingSystem exit:1.
- ].
- ].
- "/ now, display and view-stuff works;
- "/ back to the previous debugging interface
-
- Inspector := insp.
- Debugger := deb.
-
- "/ reinstall Transcript, if not changed during restart.
- "/ if there was no Transcript, go to stderr
-
- (transcript notNil and:[Transcript == Stderr]) ifTrue:[
- Transcript := transcript.
- ].
- Initializing := false.
+ Display notNil ifTrue:[
+ [
+ Display reinitializeFor:Screen defaultDisplayName.
+ ] on:Screen deviceOpenErrorSignal do:[
+ 'Smalltalk [error]: Cannot restart connection to: ' errorPrint.
+ Screen defaultDisplayName errorPrintCR.
+ OperatingSystem exit:1.
+ ].
+ ].
+ "/ now, display and view-stuff works;
+ "/ back to the previous debugging interface
+
+ Inspector := insp.
+ Debugger := deb.
+
+ "/ reinstall Transcript, if not changed during restart.
+ "/ if there was no Transcript, go to stderr
+
+ (transcript notNil and:[Transcript == Stderr]) ifTrue:[
+ Transcript := transcript.
+ ].
+ Initializing := false.
].
Screen notNil ifTrue:[
- "clean up leftover screens (and views) that haven't been reopened.
- Operate on a copy, since brokenConnection removes us from AllScreens"
- Screen allScreens copy do:[:eachDisplay |
- eachDisplay isOpen ifFalse:[
- 'Smalltalk [info]: cannot reopen secondary display: ' errorPrint.
- eachDisplay errorPrintCR.
- eachDisplay cleanupAfterDispatch; brokenConnection.
- ]
- ].
+ "clean up leftover screens (and views) that haven't been reopened.
+ Operate on a copy, since brokenConnection removes us from AllScreens"
+ Screen allScreens copy do:[:eachDisplay |
+ eachDisplay isOpen ifFalse:[
+ 'Smalltalk [info]: cannot reopen secondary display: ' errorPrint.
+ eachDisplay errorPrintCR.
+ eachDisplay cleanupAfterDispatch; brokenConnection.
+ ]
+ ].
].
deb := insp := transcript := nil. "avoid dangling refs"
(StartupClass perform:#keepSplashWindowOpen ifNotUnderstood:[false]) ifFalse:[
- self hideSplashWindow. "/ if there is one, it's now time to hide it
+ self hideSplashWindow. "/ if there is one, it's now time to hide it
].
self mainStartup:true
@@ -6452,7 +6453,7 @@
(for example, if you created a private resource directory)"
RealSystemPath := ResourcePath := SourcePath :=
- BinaryPath := FileInPath := nil
+ BinaryPath := FileInPath := nil.
"
Smalltalk flushPathCaches
@@ -7153,6 +7154,17 @@
].
!
+reinitializePackagePath
+ "{ Pragma: +optSpace }"
+
+ PackagePath notNil ifTrue:[
+ PackagePath := PackagePath select:[:p | p asFilename exists].
+ ].
+ PackagePath isEmptyOrNil ifTrue:[
+ PackagePath := OperatingSystem defaultPackagePath
+ ].
+!
+
relativePackagePathForPackage:aPackage
|path|
@@ -7973,11 +7985,11 @@
!Smalltalk class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.1027 2013-05-21 23:28:19 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.1030 2013-05-27 13:23:58 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.1027 2013-05-21 23:28:19 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.1030 2013-05-27 13:23:58 cg Exp $'
!
version_HG
--- a/Win32OperatingSystem.st Tue May 28 00:23:55 2013 +0100
+++ b/Win32OperatingSystem.st Fri May 31 00:35:21 2013 +0100
@@ -5528,16 +5528,16 @@
"return some object filled with info for the file 'aPathName';
the info (for which corresponding access methods are understood by
the returned object) is:
- type - a symbol giving the files type
- mode - numeric access mode
- uid - owners user id
- gid - owners group id
- size - files size
- id - files number (i.e. inode number)
- accessed - last access time (as Timestamp)
- modified - last modification time (as Timestamp)
- statusChanged - last status change time (as Timestamp)
- alternativeName - (windows only:) the MSDOS name of the file
+ type - a symbol giving the files type
+ mode - numeric access mode
+ uid - owners user id
+ gid - owners group id
+ size - files size
+ id - files number (i.e. inode number)
+ accessed - last access time (as Timestamp)
+ modified - last modification time (as Timestamp)
+ statusChanged - last status change time (as Timestamp)
+ alternativeName - (windows only:) the MSDOS name of the file
Some of the fields may be returned as nil on systems which do not provide
all of the information.
@@ -5564,45 +5564,45 @@
wchar_t _aPathName[MAXPATHLEN+1];
if (__isStringLike(aPathName)) {
- int i;
- int l = __stringSize(aPathName);
- if (l > MAXPATHLEN) l = MAXPATHLEN;
-
- for (i=0; i<l; i++) {
- _aPathName[i] = __stringVal(aPathName)[i];
- }
- _aPathName[i] = 0;
+ int i;
+ int l = __stringSize(aPathName);
+ if (l > MAXPATHLEN) l = MAXPATHLEN;
+
+ for (i=0; i<l; i++) {
+ _aPathName[i] = __stringVal(aPathName)[i];
+ }
+ _aPathName[i] = 0;
} else if (__isUnicode16String(aPathName)) {
- int i;
- int l = __unicode16StringSize(aPathName);
- if (l > MAXPATHLEN) l = MAXPATHLEN;
-
- for (i=0; i<l; i++) {
- _aPathName[i] = __unicode16StringVal(aPathName)[i];
- }
- _aPathName[i] = 0;
+ int i;
+ int l = __unicode16StringSize(aPathName);
+ if (l > MAXPATHLEN) l = MAXPATHLEN;
+
+ for (i=0; i<l; i++) {
+ _aPathName[i] = __unicode16StringVal(aPathName)[i];
+ }
+ _aPathName[i] = 0;
} else
- goto badArgument;
+ goto badArgument;
#ifdef DO_WRAP_CALLS
{
- do {
- __threadErrno = 0;
- result = STX_API_NOINT_CALL3( "GetFileAttributesExW", GetFileAttributesExW, _aPathName, GetFileExInfoStandard, &fileAttributeData);
- } while (!result && (__threadErrno == EINTR));
+ do {
+ __threadErrno = 0;
+ result = STX_API_NOINT_CALL3( "GetFileAttributesExW", GetFileAttributesExW, _aPathName, GetFileExInfoStandard, &fileAttributeData);
+ } while (!result && (__threadErrno == EINTR));
}
#else
result = GetFileAttributesExW(_aPathName, GetFileExInfoStandard, &fileAttributeData);
if (!result) {
- __threadErrno = __WIN32_ERR(GetLastError());
+ __threadErrno = __WIN32_ERR(GetLastError());
}
#endif
if (!result) {
- @global(LastErrorNumber) = __mkSmallInteger(__threadErrno);
+ @global(LastErrorNumber) = __mkSmallInteger(__threadErrno);
} else {
- id = __mkSmallInteger(0); /* could get it by opening ... */
- size = __MKLARGEINT64(1, fileAttributeData.nFileSizeLow, fileAttributeData.nFileSizeHigh);
+ id = __mkSmallInteger(0); /* could get it by opening ... */
+ size = __MKLARGEINT64(1, fileAttributeData.nFileSizeLow, fileAttributeData.nFileSizeHigh);
// if (fileAttributeData.cFileName[0] != '\0') {
// bcopy(fileAttributeData.cFileName, fileNameBuffer, MAXPATHLEN*sizeof(wchar_t));
@@ -5616,83 +5616,83 @@
// alternativeName = __MKU16STRING(alternativeFileNameBuffer); /* DOS name */
// }
- /*
- * simulate access bits
- */
- if (fileAttributeData.dwFileAttributes & FILE_ATTRIBUTE_READONLY) {
- modeBits = 0444;
- } else {
- modeBits = 0666;
- }
-
- if (fileAttributeData.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY) {
- type = @symbol(directory);
- modeBits = 0777; /* executable and WRITABLE - refer to comment in #isWritable: */
- } else if (fileAttributeData.dwFileAttributes & FILE_ATTRIBUTE_REPARSE_POINT) {
- type = @symbol(symbolicLink);
- modeBits = 0777; /* even in UNIX symlinks have 0777 */
- } else {
- type = @symbol(regular);
- }
-
- mode = __mkSmallInteger(modeBits);
-
- cOsTime = FileTimeToOsTime(&fileAttributeData.ftCreationTime);
- aOsTime = FileTimeToOsTime(&fileAttributeData.ftLastAccessTime);
- mOsTime = FileTimeToOsTime(&fileAttributeData.ftLastWriteTime);
+ /*
+ * simulate access bits
+ */
+ if (fileAttributeData.dwFileAttributes & FILE_ATTRIBUTE_READONLY) {
+ modeBits = 0444;
+ } else {
+ modeBits = 0666;
+ }
+
+ if (fileAttributeData.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY) {
+ type = @symbol(directory);
+ modeBits = 0777; /* executable and WRITABLE - refer to comment in #isWritable: */
+ } else if (fileAttributeData.dwFileAttributes & FILE_ATTRIBUTE_REPARSE_POINT) {
+ type = @symbol(symbolicLink);
+ modeBits = 0777; /* even in UNIX symlinks have 0777 */
+ } else {
+ type = @symbol(regular);
+ }
+
+ mode = __mkSmallInteger(modeBits);
+
+ cOsTime = FileTimeToOsTime(&fileAttributeData.ftCreationTime);
+ aOsTime = FileTimeToOsTime(&fileAttributeData.ftLastAccessTime);
+ mOsTime = FileTimeToOsTime(&fileAttributeData.ftLastWriteTime);
}
badArgument: ;
%}.
(aPathName endsWith:'.lnk') ifTrue:[
- type := #symbolicLink.
- "/ now done lazyly in FileStatusInfo, when the path is accessed
- "/ path := self getLinkTarget:aPathName.
+ type := #symbolicLink.
+ "/ now done lazyly in FileStatusInfo, when the path is accessed
+ "/ path := self getLinkTarget:aPathName.
].
mode isNil ifTrue:[
- (self isDirectory:aPathName) ifTrue:[
- "/ the code above fails for root directories (these do not exist).
- "/ simulate here
- mode := 8r777.
- type := #directory.
- uid := gid := 0.
- size := 0.
- id := 0.
- atime := mtime := ctime := Timestamp now.
- ].
+ (self isDirectory:aPathName) ifTrue:[
+ "/ the code above fails for root directories (these do not exist).
+ "/ simulate here
+ mode := 8r777.
+ type := #directory.
+ uid := gid := 0.
+ size := 0.
+ id := 0.
+ atime := mtime := ctime := Timestamp now.
+ ].
].
mode notNil ifTrue:[
- atime isNil ifTrue:[
- atime := Timestamp new fromOSTime:aOsTime.
- ].
- mtime isNil ifTrue:[
- mtime := Timestamp new fromOSTime:mOsTime.
- ].
- ctime isNil ifTrue:[
- ctime := Timestamp new fromOSTime:cOsTime.
- ].
- fileName notNil ifTrue:[
- fileName := fileName asSingleByteStringIfPossible
- ].
- alternativeName notNil ifTrue:[
- alternativeName := alternativeName asSingleByteStringIfPossible
- ].
- info := FileStatusInfo
- type:type
- mode:mode
- uid:uid
- gid:gid
- size:size
- id:id
- accessed:atime
- modified:mtime
- created:ctime
- sourcePath:aPathName
- fullName:fileName
- alternativeName:alternativeName.
- ^ info
+ atime isNil ifTrue:[
+ atime := Timestamp new fromOSTime:aOsTime.
+ ].
+ mtime isNil ifTrue:[
+ mtime := Timestamp new fromOSTime:mOsTime.
+ ].
+ ctime isNil ifTrue:[
+ ctime := Timestamp new fromOSTime:cOsTime.
+ ].
+ fileName notNil ifTrue:[
+ fileName := fileName asSingleByteStringIfPossible
+ ].
+ alternativeName notNil ifTrue:[
+ alternativeName := alternativeName asSingleByteStringIfPossible
+ ].
+ info := FileStatusInfo
+ type:type
+ mode:mode
+ uid:uid
+ gid:gid
+ size:size
+ id:id
+ accessed:atime
+ modified:mtime
+ created:ctime
+ sourcePath:aPathName
+ fullName:fileName
+ alternativeName:alternativeName.
+ ^ info
].
^ nil
@@ -5865,21 +5865,21 @@
%{
if (__isStringLike(aPathName)) {
- char nameBuffer[MAXPATHLEN + 1];
- char nameBuffer2[MAXPATHLEN + 1];
- char *returnedName = NULL;
- int rslt;
+ char nameBuffer[MAXPATHLEN + 1];
+ char nameBuffer2[MAXPATHLEN + 1];
+ char *returnedName = NULL;
+ int rslt;
#ifdef DO_WRAP_CALLS
- char _aPathName[MAXPATHLEN+1];
-
- strncpy(_aPathName, __stringVal(aPathName), MAXPATHLEN-1); _aPathName[MAXPATHLEN-1] = '\0';
- do {
- __threadErrno = 0;
- rslt = STX_API_NOINT_CALL4( "GetFullPathNameA", GetFullPathNameA, _aPathName, MAXPATHLEN, nameBuffer, NULL);
- } while ((rslt < 0) && (__threadErrno == EINTR));
-#else
- rslt = GetFullPathNameA(__stringVal(aPathName), MAXPATHLEN, nameBuffer, NULL);
+ char _aPathName[MAXPATHLEN+1];
+
+ strncpy(_aPathName, __stringVal(aPathName), MAXPATHLEN-1); _aPathName[MAXPATHLEN-1] = '\0';
+ do {
+ __threadErrno = 0;
+ rslt = STX_API_NOINT_CALL4( "GetFullPathNameA", GetFullPathNameA, _aPathName, MAXPATHLEN, nameBuffer, NULL);
+ } while ((rslt < 0) && (__threadErrno == EINTR));
+#else
+ rslt = GetFullPathNameA(__stringVal(aPathName), MAXPATHLEN, nameBuffer, NULL);
#endif
returnedName = nameBuffer;
@@ -5901,27 +5901,27 @@
RETURN (nil);
}
if (__isUnicode16String(aPathName)) {
- wchar_t nameBuffer[MAXPATHLEN + 1];
- wchar_t nameBuffer2[MAXPATHLEN + 1];
- wchar_t *returnedName = NULL;
- int rslt;
- wchar_t _aPathName[MAXPATHLEN+1];
- int i, l;
-
- l = __unicode16StringSize(aPathName);
- if (l > MAXPATHLEN) l = MAXPATHLEN;
- for (i=0; i<l; i++) {
- _aPathName[i] = __unicode16StringVal(aPathName)[i];
- }
- _aPathName[i] = 0;
+ wchar_t nameBuffer[MAXPATHLEN + 1];
+ wchar_t nameBuffer2[MAXPATHLEN + 1];
+ wchar_t *returnedName = NULL;
+ int rslt;
+ wchar_t _aPathName[MAXPATHLEN+1];
+ int i, l;
+
+ l = __unicode16StringSize(aPathName);
+ if (l > MAXPATHLEN) l = MAXPATHLEN;
+ for (i=0; i<l; i++) {
+ _aPathName[i] = __unicode16StringVal(aPathName)[i];
+ }
+ _aPathName[i] = 0;
#ifdef DO_WRAP_CALLS
- do {
- __threadErrno = 0;
- rslt = STX_API_NOINT_CALL4( "GetFullPathNameW", GetFullPathNameW, _aPathName, MAXPATHLEN, nameBuffer, NULL);
- } while ((rslt < 0) && (__threadErrno == EINTR));
-#else
- rslt = GetFullPathNameW(_aPathName, MAXPATHLEN, nameBuffer, NULL);
+ do {
+ __threadErrno = 0;
+ rslt = STX_API_NOINT_CALL4( "GetFullPathNameW", GetFullPathNameW, _aPathName, MAXPATHLEN, nameBuffer, NULL);
+ } while ((rslt < 0) && (__threadErrno == EINTR));
+#else
+ rslt = GetFullPathNameW(_aPathName, MAXPATHLEN, nameBuffer, NULL);
#endif
returnedName = nameBuffer;
@@ -7163,17 +7163,30 @@
!
primGetLastError
-
- <apicall: dword "GetLastError" () module: "kernel32.dll" >
+%{ /* NOCONTEXT */
+ DWORD e;
+
+ e = GetLastError();
+ RETURN(__MKUINT(e));
+%}.
+
+ "/ <apicall: dword "GetLastError" () module: "kernel32.dll" >
"
self primGetLastError
"
!
-primSetLastError: int
-
- <apicall: void "SetLastError" (dword) module: "kernel32.dll" >
+primSetLastError: i
+%{ /* NOCONTEXT */
+ if (__isSmallInteger(i)) {
+ SetLastError(__intVal(i));
+ RETURN(self);
+ }
+%}.
+ self primitiveFailed.
+
+ "/ <apicall: void "SetLastError" (dword) module: "kernel32.dll" >
"
self primSetLastError: 0
@@ -7782,8 +7795,8 @@
getNetworkMACAddresses
"return a dictionary filled with
- key -> name of interface
- value -> the MAC adress (as ByteArray)
+ key -> name of interface
+ value -> the MAC adress (as ByteArray)
for each interface
"
@@ -7845,16 +7858,16 @@
"Keep the order as reurned by the OS"
info := OrderedDictionary new:nAdapters.
nAdapters notNil ifTrue:[
- 1 to:nAdapters do:[:i |
- |entry name description macAddr ipAddr|
-
- entry := rawData at:i.
- name := entry at:1.
- "/ description := entry at:2.
- macAddr := entry at:3.
- "/ ipAddr := entry at:4.
- info at:name put:macAddr.
- ].
+ 1 to:nAdapters do:[:i |
+ |entry name description macAddr ipAddr|
+
+ entry := rawData at:i.
+ name := entry at:1.
+ "/ description := entry at:2.
+ macAddr := entry at:3.
+ "/ ipAddr := entry at:4.
+ info at:name put:macAddr.
+ ].
].
^ info
@@ -11638,9 +11651,9 @@
isSpecialFile
^ (type ~~ #directory
- and:[type ~~ #remoteDirectory
- and:[type ~~ #regular
- and:[type ~~ #symbolicLink
+ and:[type ~~ #remoteDirectory
+ and:[type ~~ #regular
+ and:[type ~~ #symbolicLink
]]])
!
@@ -17120,15 +17133,15 @@
!Win32OperatingSystem class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Win32OperatingSystem.st,v 1.462 2013-05-15 17:06:14 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Win32OperatingSystem.st,v 1.464 2013-05-28 12:44:56 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Win32OperatingSystem.st,v 1.462 2013-05-15 17:06:14 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Win32OperatingSystem.st,v 1.464 2013-05-28 12:44:56 cg Exp $'
!
version_SVN
- ^ '$Id: Win32OperatingSystem.st,v 1.462 2013-05-15 17:06:14 stefan Exp $'
+ ^ '$Id: Win32OperatingSystem.st,v 1.464 2013-05-28 12:44:56 cg Exp $'
! !