--- a/AbortAllOperationRequest.st Wed Jan 23 10:08:55 2013 +0000
+++ b/AbortAllOperationRequest.st Mon Jan 28 21:53:19 2013 +0000
@@ -41,7 +41,7 @@
If unhandled, this is equivalent to raising the AbortOperationRequest.
However, some applications catch this signal when performing an operation
on multiple objects (such as a fileBrowser, when deleting multiple files).
- In these situations, Abort is typically cought to cancel a single
+ In these situations, Abort is typically caught to cancel a single
operation, while AbortAll is used to cancel the whole action.
"
! !
@@ -85,11 +85,12 @@
!AbortAllOperationRequest class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/AbortAllOperationRequest.st,v 1.8 2011-02-09 12:59:00 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/AbortAllOperationRequest.st,v 1.9 2013-01-24 15:24:00 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/AbortAllOperationRequest.st,v 1.8 2011-02-09 12:59:00 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/AbortAllOperationRequest.st,v 1.9 2013-01-24 15:24:00 cg Exp $'
! !
+
AbortAllOperationRequest initialize!
--- a/Array.st Wed Jan 23 10:08:55 2013 +0000
+++ b/Array.st Mon Jan 28 21:53:19 2013 +0000
@@ -100,7 +100,8 @@
%{ /* NOCONTEXT */
OBJ newobj;
- unsigned INT instsize, nInstVars;
+ unsigned INT nInstVars;
+ unsigned INT instsize;
INT nindexedinstvars;
REGISTER OBJ *op;
@@ -159,7 +160,7 @@
# define LONGLONG INT64
# else
# define LONGLONG long long
-# endif
+# endif
op = __InstPtr(newobj)->i_instvars;
if (nInstVars > 8) {
@@ -190,6 +191,14 @@
op += 2;
}
# endif
+ while (nInstVars >= 8) {
+ nInstVars -= 8;
+ op[0] = nil; op[1] = nil;
+ op[2] = nil; op[3] = nil;
+ op[4] = nil; op[5] = nil;
+ op[6] = nil; op[7] = nil;
+ op += 8;
+ }
while (nInstVars--)
*op++ = nil;
# endif
@@ -210,7 +219,7 @@
* allocation failure)
*/
__PROTECT_CONTEXT__
- newobj = __STX___new(instsize);
+ newobj = __STX___new((INT)instsize);
__UNPROTECT_CONTEXT__
if (newobj != nil) {
goto ok;
@@ -282,9 +291,9 @@
%{ /* NOCONTEXT */
- REGISTER int indx;
+ REGISTER INT indx;
REGISTER OBJ slf;
- REGISTER unsigned int nIndex;
+ REGISTER unsigned INT nIndex;
REGISTER OBJ cls;
if (__isSmallInteger(index)) {
@@ -296,7 +305,7 @@
if (indx < 0) goto badIndex;
indx += __intVal(__ClassInstPtr(cls)->c_ninstvars);
}
- if ((unsigned)indx < (unsigned)nIndex) {
+ if ((unsigned INT)indx < (unsigned INT)nIndex) {
RETURN ( __InstPtr(slf)->i_instvars[indx] );
}
}
@@ -316,9 +325,9 @@
%{ /* NOCONTEXT */
- REGISTER int indx;
+ REGISTER INT indx;
REGISTER OBJ slf;
- REGISTER unsigned int nIndex;
+ REGISTER unsigned INT nIndex;
REGISTER OBJ cls;
if (__isSmallInteger(index)) {
@@ -330,7 +339,7 @@
if (indx < 0) goto badIndex;
indx += __intVal(__ClassInstPtr(cls)->c_ninstvars);
}
- if ((unsigned)indx < (unsigned)nIndex) {
+ if ((unsigned INT)indx < (unsigned INT)nIndex) {
__InstPtr(slf)->i_instvars[indx] = anObject;
__STORE(slf, anObject);
RETURN ( anObject );
@@ -350,9 +359,9 @@
%{ /* NOCONTEXT */
- REGISTER int indx;
+ REGISTER INT indx;
REGISTER OBJ slf;
- REGISTER unsigned int nIndex;
+ REGISTER unsigned INT nIndex;
REGISTER OBJ cls;
if (__isSmallInteger(index)) {
@@ -364,7 +373,7 @@
if (indx < 0) goto badIndex;
indx += __intVal(__ClassInstPtr(cls)->c_ninstvars);
}
- if ((unsigned)indx < (unsigned)nIndex) {
+ if ((unsigned INT)indx < (unsigned INT)nIndex) {
RETURN ( __InstPtr(slf)->i_instvars[indx] );
}
}
@@ -380,9 +389,9 @@
%{ /* NOCONTEXT */
- REGISTER int indx;
+ REGISTER INT indx;
REGISTER OBJ slf;
- REGISTER unsigned int nIndex;
+ REGISTER unsigned INT nIndex;
REGISTER OBJ cls;
if (__isSmallInteger(index)) {
@@ -394,7 +403,7 @@
if (indx < 0) goto badIndex;
indx += __intVal(__ClassInstPtr(cls)->c_ninstvars);
}
- if ((unsigned)indx < (unsigned)nIndex) {
+ if ((unsigned INT)indx < (unsigned INT)nIndex) {
__InstPtr(slf)->i_instvars[indx] = anObject;
__STORE(slf, anObject);
RETURN ( anObject );
@@ -452,8 +461,8 @@
%{ /* NOCONTEXT */
OBJ nObj;
- unsigned int sz;
- unsigned int nIndex;
+ unsigned INT sz;
+ unsigned INT nIndex;
REGISTER OBJ *srcP, *dstP;
REGISTER int spc;
@@ -564,11 +573,11 @@
sz := self size.
%{
REGISTER OBJFUNC codeVal;
- REGISTER int index;
- unsigned int nIndex;
+ REGISTER INT index;
+ unsigned INT nIndex;
static struct inlineCache val = _ILC1;
REGISTER OBJ rHome;
- int actualSize;
+ INT actualSize;
{
OBJ mySelf = self;
@@ -781,12 +790,12 @@
%{
REGISTER OBJFUNC codeVal;
- REGISTER int index;
+ REGISTER INT index;
REGISTER OBJ rHome;
OBJ slf;
- int nIndex, nInsts;
+ INT nIndex, nInsts;
static struct inlineCache val = _ILC1;
- int indexHigh;
+ INT indexHigh;
OBJ myClass;
slf = self;
@@ -803,7 +812,7 @@
}
if (indexHigh <= nIndex) {
OBJ __aBlock = aBlock;
- int n;
+ INT n;
index--; /* 0-based */
n = indexHigh - index;
@@ -1061,11 +1070,11 @@
%{
REGISTER OBJFUNC codeVal;
- REGISTER int index;
+ REGISTER INT index;
REGISTER OBJ rHome;
- int nIndex;
+ INT nIndex;
static struct inlineCache val = _ILC1;
- int indexLow, indexHigh;
+ INT indexLow, indexHigh;
if (__bothSmallInteger(start, stop)
&& (__qClass(self) == @global(Array))
@@ -1148,7 +1157,7 @@
REGISTER INT index;
static struct inlineCache val2 = _ILC2;
REGISTER OBJ rHome;
- int actualSize;
+ INT actualSize;
OBJ myClass;
myClass = __qClass(self);
@@ -1323,11 +1332,11 @@
sz := self size.
%{
REGISTER OBJFUNC codeVal;
- REGISTER int index;
- unsigned int nIndex;
- int endIndex;
+ REGISTER INT index;
+ unsigned INT nIndex;
+ INT endIndex;
static struct inlineCache val = _ILC1;
- int actualSize;
+ INT actualSize;
OBJ myClass;
myClass = __qClass(self);
@@ -1439,9 +1448,9 @@
%{ /* NOCONTEXT */
- REGISTER int index;
- unsigned int nIndex;
- unsigned int endIndex;
+ REGISTER INT index;
+ unsigned INT nIndex;
+ unsigned INT endIndex;
REGISTER OBJ *dst;
if ((__qClass(self) == Array)
@@ -1468,7 +1477,7 @@
{
# ifdef __UNROLL_LOOPS__
{
- int i8;
+ INT i8;
while ((i8 = index + 8) <= endIndex) {
dst[3] = dst[2] = dst[1] = dst[0] = anObject;
@@ -1500,15 +1509,15 @@
%{ /* NOCONTEXT */
- unsigned int nIndex;
- unsigned int repNIndex;
- int startIndex, stopIndex;
+ unsigned INT nIndex;
+ unsigned INT repNIndex;
+ INT startIndex, stopIndex;
REGISTER OBJ *src;
REGISTER OBJ *dst;
- int repStopIndex;
- REGISTER int repStartIndex;
+ INT repStopIndex;
+ REGISTER INT repStartIndex;
REGISTER OBJ t;
- REGISTER int count;
+ REGISTER INT count;
OBJ myClass;
if (
@@ -1850,7 +1859,7 @@
REGISTER OBJ *op;
REGISTER unsigned INT nIndex;
INT altIndex = 0;
- int nInsts;
+ INT nInsts;
index = 0;
nInsts = __intVal(__ClassInstPtr(__qClass(self))->c_ninstvars);
@@ -1894,7 +1903,7 @@
REGISTER OBJ el;
REGISTER OBJ *op;
REGISTER unsigned INT nIndex;
- int nInsts;
+ INT nInsts;
if (__isSmallInteger(start)) {
index = __intVal(start) - 1;
@@ -1938,7 +1947,7 @@
* Pipelined CPUs do usually not like taken branches.
*/
- unsigned int i8;
+ unsigned INT i8;
while ((i8 = index + 8) < nIndex) {
if (op[0] == el) goto found1;
@@ -1999,9 +2008,9 @@
REGISTER INT index;
REGISTER OBJ el;
REGISTER OBJ *op;
- REGISTER unsigned int lastIndex;
+ REGISTER unsigned INT lastIndex;
unsigned INT nIndex;
- int nInsts;
+ INT nInsts;
if (__bothSmallInteger(start, stop)) {
index = __intVal(start) - 1;
@@ -2030,7 +2039,7 @@
# ifdef __UNROLL_LOOPS__
{
- unsigned int i8;
+ unsigned INT i8;
while ((i8 = index + 8) < lastIndex) {
if (op[0] == el) goto found1;
@@ -2091,7 +2100,7 @@
%{
REGISTER INT index;
unsigned INT nIndex;
- unsigned int nInsts;
+ unsigned INT nInsts;
static struct inlineCache eq = _ILC1;
OBJ myClass, e;
@@ -2187,7 +2196,7 @@
*/
#ifdef __UNROLL_LOOPS__
{
- unsigned int i8;
+ unsigned INT i8;
while ((i8 = index + 8) < nIndex) {
if (__InstPtr(slf)->i_instvars[index] == nil) { RETURN ( __mkSmallInteger(index - nInsts + 1) ); }
@@ -2225,7 +2234,7 @@
%{
REGISTER INT index;
unsigned INT lastIndex, nIndex;
- unsigned int nInsts;
+ unsigned INT nInsts;
static struct inlineCache eq = _ILC1;
OBJ myClass, e;
@@ -2319,7 +2328,7 @@
*/
#ifdef __UNROLL_LOOPS__
{
- unsigned int i8;
+ unsigned INT i8;
while ((i8 = index + 8) < lastIndex) {
if (__InstPtr(slf)->i_instvars[index] == nil) { RETURN ( __mkSmallInteger(index - nInsts + 1) ); }
@@ -2361,9 +2370,9 @@
* this does not need a context or message send.
* In many cases this will already find a match.
*/
- REGISTER int index;
+ REGISTER INT index;
REGISTER OBJ o;
- unsigned int nIndex;
+ unsigned INT nIndex;
nIndex = __BYTES2OBJS__(__qSize(self) - OHDR_SIZE);
index = __intVal(__ClassInstPtr(__qClass(self))->c_ninstvars);
@@ -2414,7 +2423,7 @@
*/
# ifdef __UNROLL_LOOPS__
{
- unsigned int i8;
+ unsigned INT i8;
REGISTER OBJ slf = self;
while ((i8 = index + 8) < nIndex) {
@@ -2447,9 +2456,9 @@
%}.
%{
- REGISTER int index;
+ REGISTER INT index;
REGISTER OBJ o;
- unsigned int nIndex;
+ unsigned INT nIndex;
static struct inlineCache eq = _ILC1;
/*
@@ -2559,9 +2568,9 @@
!Array class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Array.st,v 1.155 2013-01-16 10:30:10 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Array.st,v 1.156 2013-01-23 17:57:32 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Array.st,v 1.155 2013-01-16 10:30:10 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Array.st,v 1.156 2013-01-23 17:57:32 cg Exp $'
! !
--- a/Bag.st Wed Jan 23 10:08:55 2013 +0000
+++ b/Bag.st Mon Jan 28 21:53:19 2013 +0000
@@ -106,7 +106,7 @@
to the bags elements.
Same as #contents for dolphin compatibility."
- ^ contents
+ ^ self contents
! !
!Bag methodsFor:'accessing'!
@@ -356,8 +356,8 @@
!Bag methodsFor:'printing & storing'!
printElementsDo:aBlock
- contents keysAndValuesDo:[:key :value|
- aBlock value:('%1(*%2)' bindWith:key with:value).
+ self valuesAndCountsDo:[:value :count|
+ aBlock value:('%1(*%2)' bindWith:value with:count).
]
! !
@@ -404,7 +404,7 @@
includes:anObject
"return true, if anObject is in the receiver"
- ^ contents includesKey:anObject
+ ^ (self occurrencesOf:anObject) > 0
!
occurrencesOf:anObject
@@ -416,9 +416,10 @@
!Bag class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Bag.st,v 1.41 2010-03-30 13:38:23 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Bag.st,v 1.42 2013-01-23 17:14:50 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Bag.st,v 1.41 2010-03-30 13:38:23 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Bag.st,v 1.42 2013-01-23 17:14:50 cg Exp $'
! !
+
--- a/Behavior.st Wed Jan 23 10:08:55 2013 +0000
+++ b/Behavior.st Mon Jan 28 21:53:19 2013 +0000
@@ -300,6 +300,7 @@
"
! !
+
!Behavior class methodsFor:'creating new classes'!
new
@@ -337,6 +338,7 @@
"Modified: 7.6.1996 / 15:38:58 / stefan"
! !
+
!Behavior class methodsFor:'flag bit constants'!
flagAlien
@@ -810,6 +812,7 @@
%}
! !
+
!Behavior class methodsFor:'helpers'!
classesSortedByLoadOrder:someClasses
@@ -949,6 +952,7 @@
"Modified: 5.9.1996 / 19:34:41 / cg"
! !
+
!Behavior class methodsFor:'misc'!
autoload
@@ -958,6 +962,7 @@
! !
+
!Behavior class methodsFor:'queries'!
definitionSelectorFirstParts
@@ -1073,6 +1078,7 @@
^ self compiledMethodAt:selector
! !
+
!Behavior methodsFor:'Compatibility-Squeak'!
classComment:comment stamp:commentStamp
@@ -1125,6 +1131,7 @@
"Modified (comment): / 20-08-2011 / 16:35:07 / cg"
! !
+
!Behavior methodsFor:'Compatibility-VW'!
>> aSelector
@@ -1187,7 +1194,6 @@
! !
-
!Behavior methodsFor:'accessing'!
addSelector:newSelector withMethod:newMethod
@@ -1310,6 +1316,13 @@
"Modified: / 19-07-2010 / 11:22:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
+containingNameSpace
+ "return the namespace which contains me.
+ Defined here as a dummy; actually only real classes should ever be put into a namespace."
+
+ ^ nil
+!
+
flags
"return the receivers flag bits"
@@ -1421,6 +1434,7 @@
^ superclass
! !
+
!Behavior methodsFor:'autoload check'!
autoload
@@ -1531,6 +1545,7 @@
^ self class syntaxHighlighterClass.
! !
+
!Behavior methodsFor:'compiling'!
compile:code notifying:requestor
@@ -1547,6 +1562,7 @@
"Created: 1.4.1997 / 23:43:43 / stefan"
! !
+
!Behavior methodsFor:'copying'!
canCloneFrom:anObject
@@ -1642,6 +1658,7 @@
^ self
! !
+
!Behavior methodsFor:'dummy changes management'!
addChangeRecordForClassRemove:aClassName
@@ -1654,6 +1671,7 @@
"Modified: 16.4.1996 / 18:10:35 / cg"
! !
+
!Behavior methodsFor:'dummy fileOut'!
fileOutDefinitionOn:aStream
@@ -1666,6 +1684,7 @@
"Created: 16.4.1996 / 16:28:01 / cg"
! !
+
!Behavior methodsFor:'enumerating'!
allDerivedInstancesDo:aBlock
@@ -1936,6 +1955,7 @@
"
! !
+
!Behavior methodsFor:'error handling'!
abstractClassInstantiationError
@@ -1946,6 +1966,7 @@
"Created: / 02-11-2012 / 10:07:01 / cg"
! !
+
!Behavior methodsFor:'initialization'!
deinitialize
@@ -2020,8 +2041,8 @@
%{ /* NOCONTEXT */
REGISTER OBJ newobj;
REGISTER char *nextPtr;
- unsigned int instsize;
- REGISTER unsigned int nInstVars;
+ unsigned INT instsize;
+ REGISTER unsigned INT nInstVars;
/*
* the following ugly code is nothing more than a __new() followed
@@ -2132,10 +2153,18 @@
# if defined(FAST_MEMSET)
memset(__InstPtr(newobj)->i_instvars, 0, instsize-OHDR_SIZE);
# else
- do {
+ while (nInstVars >= 8) {
+ nInstVars -= 8;
+ op[0] = nil; op[1] = nil;
+ op[2] = nil; op[3] = nil;
+ op[4] = nil; op[5] = nil;
+ op[6] = nil; op[7] = nil;
+ op += 8;
+ }
+ while (nInstVars != 0) {
*op++ = nil;
nInstVars--;
- } while (nInstVars != 0);
+ }
# endif
# endif
# endif
@@ -2149,7 +2178,7 @@
* the slow case - a GC will occur
*/
__PROTECT_CONTEXT__
- newobj = __STX___new(instsize);
+ newobj = __STX___new((INT)instsize);
__UNPROTECT_CONTEXT__
if (newobj != nil) goto ok;
%}
@@ -2174,7 +2203,8 @@
%{ /* NOCONTEXT */
OBJ newobj;
- unsigned INT instsize, nInstVars;
+ unsigned INT nInstVars;
+ unsigned INT instsize;
INT nindexedinstvars;
unsigned INT flags;
#if ! defined(FAST_ARRAY_MEMSET)
@@ -2212,10 +2242,10 @@
memset(__InstPtr(newobj)->i_instvars, 0, nindexedinstvars);
# else
cp = (char *)__InstPtr(newobj)->i_instvars;
- while (nindexedinstvars >= sizeof(long)) {
- *(long *)cp = 0;
- cp += sizeof(long);
- nindexedinstvars -= sizeof(long);
+ while (nindexedinstvars >= sizeof(INT)) {
+ *(INT *)cp = (INT)0;
+ cp += sizeof(INT);
+ nindexedinstvars -= sizeof(INT);
}
while (nindexedinstvars--)
*cp++ = '\0';
@@ -2250,10 +2280,10 @@
while (nInstVars--)
*op++ = nil;
cp = (char *)op;
- while (nindexedinstvars >= sizeof(long)) {
- *(long *)cp = 0;
- cp += sizeof(long);
- nindexedinstvars -= sizeof(long);
+ while (nindexedinstvars >= sizeof(INT)) {
+ *(INT *)cp = 0;
+ cp += sizeof(INT);
+ nindexedinstvars -= sizeof(INT);
}
while (nindexedinstvars--)
*cp++ = '\0';
@@ -2509,6 +2539,14 @@
memset(__InstPtr(newobj)->i_instvars, 0, instsize - OHDR_SIZE);
# else
op = __InstPtr(newobj)->i_instvars;
+ while (nInstVars >= 8) {
+ nInstVars -= 8;
+ op[0] = nil; op[1] = nil;
+ op[2] = nil; op[3] = nil;
+ op[4] = nil; op[5] = nil;
+ op[6] = nil; op[7] = nil;
+ op += 8;
+ }
while (nInstVars--)
*op++ = nil;
# endif
@@ -2776,6 +2814,7 @@
^ self basicNew:anInteger
! !
+
!Behavior methodsFor:'misc'!
browse
@@ -2840,6 +2879,7 @@
"Created: / 19.6.1998 / 02:14:02 / cg"
! !
+
!Behavior methodsFor:'printing & storing'!
displayOn:aGCOrStream
@@ -2865,6 +2905,7 @@
aStream nextPutAll:(self name).
! !
+
!Behavior methodsFor:'private-accessing'!
flags:aNumber
@@ -2995,6 +3036,7 @@
"Modified: 22.1.1997 / 18:42:12 / cg"
! !
+
!Behavior methodsFor:'private-helpers'!
addAllClassVarNamesTo:aCollection
@@ -3068,6 +3110,7 @@
"Modified: / 22-07-2010 / 18:10:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+
!Behavior methodsFor:'queries'!
category
@@ -3373,6 +3416,7 @@
"Modified: 3.1.1997 / 19:18:49 / cg"
! !
+
!Behavior methodsFor:'queries-inheritance'!
allSubclasses
@@ -3616,6 +3660,7 @@
"
! !
+
!Behavior methodsFor:'queries-instances'!
allDerivedInstances
@@ -3818,6 +3863,7 @@
"
! !
+
!Behavior methodsFor:'queries-instlayout'!
elementByteSize
@@ -4139,6 +4185,7 @@
%}
! !
+
!Behavior methodsFor:'queries-protocol'!
allSelectors
@@ -4558,6 +4605,7 @@
"
! !
+
!Behavior methodsFor:'queries-variables'!
allClassVarNames
@@ -4795,6 +4843,7 @@
"Modified: / 23-07-2012 / 11:21:17 / cg"
! !
+
!Behavior methodsFor:'snapshots'!
postSnapshot
@@ -4813,6 +4862,7 @@
"Modified: 16.4.1996 / 18:12:14 / cg"
! !
+
!Behavior methodsFor:'tracing'!
traceInto:aRequestor level:level from:referrer
@@ -4823,6 +4873,7 @@
! !
+
!Behavior methodsFor:'visiting'!
acceptVisitor:aVisitor with:aParameter
@@ -4830,12 +4881,14 @@
^ aVisitor visitBehavior:self with:aParameter
! !
+
!Behavior class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.329 2012-12-11 17:26:07 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.331 2013-01-24 15:50:52 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.329 2012-12-11 17:26:07 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.331 2013-01-24 15:50:52 cg Exp $'
! !
+
--- a/Block.st Wed Jan 23 10:08:55 2013 +0000
+++ b/Block.st Mon Jan 28 21:53:19 2013 +0000
@@ -629,7 +629,6 @@
"Created: / 28-08-2010 / 14:41:15 / cg"
! !
-
!Block methodsFor:'accessing'!
home
@@ -2375,15 +2374,15 @@
|exitBlock|
exitBlock := [:exitValue | ^ exitValue].
- [true] whileTrue:[self value:exitBlock]
+ [true] whileTrue:[ self value:exitBlock ]
"
|i|
i := 1.
[:exit |
- Transcript showCR:i.
- i == 5 ifTrue:[exit value:'thats it'].
- i := i + 1
+ Transcript showCR:i.
+ i == 5 ifTrue:[exit value:'thats it'].
+ i := i + 1
] loopWithExit
"
!
@@ -2420,6 +2419,9 @@
!
valueWithRestart
+ "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 fro mthe beginning"
+
|myContext restartAction|
myContext := thisContext.
@@ -2428,15 +2430,43 @@
"
[:restart |
- (self confirm:'try again ?') ifTrue:[
- restart value.
- ]
+ (self confirm:'try again ?') ifTrue:[
+ restart value.
+ ]
] valueWithRestart
"
"Modified: / 25.1.2000 / 21:47:50 / cg"
!
+valueWithRestartAndExit
+ "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 restartAction|
+
+ myContext := thisContext.
+ restartAction := [ myContext restart ].
+ ^ self value:restartAction value:[:exitValue | ^exitValue].
+
+ "
+ [:restart :exit |
+ |i|
+
+ i := 0.
+ [
+ i := i + 1.
+ (self confirm:('i is ',i printString,'; start over ?')) ifTrue:[
+ restart value.
+ ].
+ (self confirm:'enough ?') ifTrue:[
+ exit value:nil.
+ ].
+ ] loop
+ ] valueWithRestartAndExit
+ "
+!
+
whileFalse
"evaluate the receiver while it evaluates to false (ST80 compatibility)"
@@ -3028,11 +3058,12 @@
!Block class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Block.st,v 1.189 2012-11-24 12:51:52 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Block.st,v 1.190 2013-01-22 18:43:43 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Block.st,v 1.189 2012-11-24 12:51:52 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Block.st,v 1.190 2013-01-22 18:43:43 cg Exp $'
! !
+
Block initialize!
--- a/Character.st Wed Jan 23 10:08:55 2013 +0000
+++ b/Character.st Mon Jan 28 21:53:19 2013 +0000
@@ -66,7 +66,7 @@
Some of these have been modified a bit.
WARNING: characters are known by compiler and runtime system -
- do not change the instance layout.
+ do not change the instance layout.
Also, although you can create subclasses of Character, the compiler always
creates instances of Character for literals ...
@@ -75,43 +75,43 @@
Therefore, it may not make sense to create a character-subclass.
Case Mapping in Unicode:
- There are a number of complications to case mappings that occur once the repertoire
- of characters is expanded beyond ASCII.
-
- * Because of the inclusion of certain composite characters for compatibility,
- such as U+01F1 'DZ' capital dz, there is a third case, called titlecase,
- which is used where the first letter of a word is to be capitalized
- (e.g. Titlecase, vs. UPPERCASE, or lowercase).
- For example, the title case of the example character is U+01F2 'Dz' capital d with small z.
-
- * Case mappings may produce strings of different length than the original.
- For example, the German character U+00DF small letter sharp s expands when uppercased to
- the sequence of two characters 'SS'.
- This also occurs where there is no precomposed character corresponding to a case mapping.
- *** This is not yet implemented (in 5.2) ***
-
- * Characters may also have different case mappings, depending on the context.
- For example, U+03A3 capital sigma lowercases to U+03C3 small sigma if it is not followed
- by another letter, but lowercases to 03C2 small final sigma if it is.
- *** This is not yet implemented (in 5.2) ***
-
- * Characters may have case mappings that depend on the locale.
- For example, in Turkish the letter 0049 'I' capital letter i lowercases to 0131 small dotless i.
- *** This is not yet implemented (in 5.2) ***
-
- * Case mappings are not, in general, reversible.
- For example, once the string 'McGowan' has been uppercased, lowercased or titlecased,
- the original cannot be recovered by applying another uppercase, lowercase, or titlecase operation.
+ There are a number of complications to case mappings that occur once the repertoire
+ of characters is expanded beyond ASCII.
+
+ * Because of the inclusion of certain composite characters for compatibility,
+ such as U+01F1 'DZ' capital dz, there is a third case, called titlecase,
+ which is used where the first letter of a word is to be capitalized
+ (e.g. Titlecase, vs. UPPERCASE, or lowercase).
+ For example, the title case of the example character is U+01F2 'Dz' capital d with small z.
+
+ * Case mappings may produce strings of different length than the original.
+ For example, the German character U+00DF small letter sharp s expands when uppercased to
+ the sequence of two characters 'SS'.
+ This also occurs where there is no precomposed character corresponding to a case mapping.
+ *** This is not yet implemented (in 5.2) ***
+
+ * Characters may also have different case mappings, depending on the context.
+ For example, U+03A3 capital sigma lowercases to U+03C3 small sigma if it is not followed
+ by another letter, but lowercases to 03C2 small final sigma if it is.
+ *** This is not yet implemented (in 5.2) ***
+
+ * Characters may have case mappings that depend on the locale.
+ For example, in Turkish the letter 0049 'I' capital letter i lowercases to 0131 small dotless i.
+ *** This is not yet implemented (in 5.2) ***
+
+ * Case mappings are not, in general, reversible.
+ For example, once the string 'McGowan' has been uppercased, lowercased or titlecased,
+ the original cannot be recovered by applying another uppercase, lowercase, or titlecase operation.
Collation Sequence:
- *** This is not yet implemented (in 5.2) ***
+ *** This is not yet implemented (in 5.2) ***
[author:]
- Claus Gittinger
+ Claus Gittinger
[see also:]
- String TwoByteString Unicode16String Unicode32String
- StringCollection Text
+ String TwoByteString Unicode16String Unicode32String
+ StringCollection Text
"
! !
@@ -132,7 +132,7 @@
if (__isSmallInteger(anInteger)) {
__codePoint = __smallIntegerVal(anInteger);
- if ((unsigned)(__codePoint) <= MAX_IMMEDIATE_CHARACTER /* (__codePoint >= 0) && (__codePoint <= 255) */) {
+ if ((unsigned INT)(__codePoint) <= MAX_IMMEDIATE_CHARACTER /* (__codePoint >= 0) && (__codePoint <= 255) */) {
RETURN ( __MKCHARACTER(__codePoint) );
} else {
RETURN ( __MKUCHARACTER(__codePoint) );
@@ -182,98 +182,98 @@
c1 := aStream next.
codePoint := c1 codePoint.
codePoint <= 16r7F ifTrue:[
- "/ 0xxxxxxx - 7 bits
- ^ c1.
+ "/ 0xxxxxxx - 7 bits
+ ^ c1.
].
(codePoint bitAnd:2r11000000) == 2r10000000 ifTrue:[
- "/ out of sync (got an intermediate character)
- InvalidEncodingError raiseRequestWith:codePoint errorString:' - out of sync'.
- ^ c1.
+ "/ out of sync (got an intermediate character)
+ InvalidEncodingError raiseRequestWith:codePoint errorString:' - out of sync'.
+ ^ c1.
].
fetchNext := [ |ch|
- ch := aStream next.
- (ch codePoint bitAnd:2r11000000) == 2r10000000 ifFalse:[
- "/ followup chars must have 2r10 in high bits
- InvalidEncodingError raiseRequestWith:ch codePoint.
- ^ c1.
- ].
- ch
- ].
+ ch := aStream next.
+ (ch codePoint bitAnd:2r11000000) == 2r10000000 ifFalse:[
+ "/ followup chars must have 2r10 in high bits
+ InvalidEncodingError raiseRequestWith:ch codePoint.
+ ^ c1.
+ ].
+ ch
+ ].
(codePoint bitAnd:2r11100000) == 2r11000000 ifTrue:[
- "/ 110xxxxx 10xxxxxx - 11 bits
- c2 := fetchNext value.
- codePoint := c1 codePoint bitAnd:16r1F.
- codePoint := (codePoint bitShift:6) bitOr:(c2 codePoint bitAnd:16r3F).
- codePoint <= 16r7F ifTrue:[
- InvalidEncodingError raiseRequestWith:codePoint.
- ].
- ^ Character codePoint:codePoint
+ "/ 110xxxxx 10xxxxxx - 11 bits
+ c2 := fetchNext value.
+ codePoint := c1 codePoint bitAnd:16r1F.
+ codePoint := (codePoint bitShift:6) bitOr:(c2 codePoint bitAnd:16r3F).
+ codePoint <= 16r7F ifTrue:[
+ InvalidEncodingError raiseRequestWith:codePoint.
+ ].
+ ^ Character codePoint:codePoint
].
(codePoint bitAnd:2r11110000) == 2r11100000 ifTrue:[
- "/ 1110xxxx 10xxxxxx 10xxxxxx - 16 bits
- c2 := fetchNext value.
- c3 := fetchNext value.
- codePoint := c1 codePoint bitAnd:16r0F.
- codePoint := (codePoint bitShift:6) bitOr:(c2 codePoint bitAnd:16r3F).
- codePoint := (codePoint bitShift:6) bitOr:(c3 codePoint bitAnd:16r3F).
- codePoint <= 16r7FF ifTrue:[
- InvalidEncodingError raiseRequestWith:codePoint.
- ].
- ^ Character codePoint:codePoint
+ "/ 1110xxxx 10xxxxxx 10xxxxxx - 16 bits
+ c2 := fetchNext value.
+ c3 := fetchNext value.
+ codePoint := c1 codePoint bitAnd:16r0F.
+ codePoint := (codePoint bitShift:6) bitOr:(c2 codePoint bitAnd:16r3F).
+ codePoint := (codePoint bitShift:6) bitOr:(c3 codePoint bitAnd:16r3F).
+ codePoint <= 16r7FF ifTrue:[
+ InvalidEncodingError raiseRequestWith:codePoint.
+ ].
+ ^ Character codePoint:codePoint
].
"/ notice: currently, characters can only have 16bit encoding;
"/ therefore the following will raise a runtime exception,
(codePoint bitAnd:2r11111000) == 2r11110000 ifTrue:[
- "/ 11110xxx 10xxxxxx 10xxxxxx 10xxxxxx - 21 bits
- c2 := fetchNext value.
- c3 := fetchNext value.
- c4 := fetchNext value.
- codePoint := c1 codePoint bitAnd:16r07.
- codePoint := (codePoint bitShift:6) bitOr:(c2 codePoint bitAnd:16r3F).
- codePoint := (codePoint bitShift:6) bitOr:(c3 codePoint bitAnd:16r3F).
- codePoint := (codePoint bitShift:6) bitOr:(c4 codePoint bitAnd:16r3F).
- codePoint <= 16rFFFF ifTrue:[
- InvalidEncodingError raiseRequestWith:codePoint.
- ].
- ^ Character codePoint:codePoint
+ "/ 11110xxx 10xxxxxx 10xxxxxx 10xxxxxx - 21 bits
+ c2 := fetchNext value.
+ c3 := fetchNext value.
+ c4 := fetchNext value.
+ codePoint := c1 codePoint bitAnd:16r07.
+ codePoint := (codePoint bitShift:6) bitOr:(c2 codePoint bitAnd:16r3F).
+ codePoint := (codePoint bitShift:6) bitOr:(c3 codePoint bitAnd:16r3F).
+ codePoint := (codePoint bitShift:6) bitOr:(c4 codePoint bitAnd:16r3F).
+ codePoint <= 16rFFFF ifTrue:[
+ InvalidEncodingError raiseRequestWith:codePoint.
+ ].
+ ^ Character codePoint:codePoint
].
(codePoint bitAnd:2r11111100) == 2r11111000 ifTrue:[
- "/ 111110xx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx - 26 bits
- c2 := fetchNext value.
- c3 := fetchNext value.
- c4 := fetchNext value.
- c5 := fetchNext value.
- codePoint := c1 codePoint bitAnd:16r03.
- codePoint := (codePoint bitShift:6) bitOr:(c2 codePoint bitAnd:16r3F).
- codePoint := (codePoint bitShift:6) bitOr:(c3 codePoint bitAnd:16r3F).
- codePoint := (codePoint bitShift:6) bitOr:(c4 codePoint bitAnd:16r3F).
- codePoint := (codePoint bitShift:6) bitOr:(c5 codePoint bitAnd:16r3F).
- codePoint <= 16r1FFFFF ifTrue:[
- InvalidEncodingError raiseRequestWith:codePoint.
- ].
- ^ Character codePoint:codePoint
+ "/ 111110xx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx - 26 bits
+ c2 := fetchNext value.
+ c3 := fetchNext value.
+ c4 := fetchNext value.
+ c5 := fetchNext value.
+ codePoint := c1 codePoint bitAnd:16r03.
+ codePoint := (codePoint bitShift:6) bitOr:(c2 codePoint bitAnd:16r3F).
+ codePoint := (codePoint bitShift:6) bitOr:(c3 codePoint bitAnd:16r3F).
+ codePoint := (codePoint bitShift:6) bitOr:(c4 codePoint bitAnd:16r3F).
+ codePoint := (codePoint bitShift:6) bitOr:(c5 codePoint bitAnd:16r3F).
+ codePoint <= 16r1FFFFF ifTrue:[
+ InvalidEncodingError raiseRequestWith:codePoint.
+ ].
+ ^ Character codePoint:codePoint
].
(codePoint bitAnd:2r11111110) == 2r11111100 ifTrue:[
- "/ 1111110x ... 10xxxxxx - any number of bits
- codePoint := c1 codePoint bitAnd:16r01.
-
- c2 := aStream peek.
- [ c2 notNil and:[(c2 codePoint bitAnd:2r11000000) == 2r10000000]] whileTrue:[
- codePoint := (codePoint bitShift:6) bitOr:(c2 codePoint bitAnd:16r3F).
- aStream next.
- ].
- codePoint <= 16r3FFFFFF ifTrue:[
- InvalidEncodingError raiseRequestWith:codePoint.
- ].
- ^ Character codePoint:codePoint
+ "/ 1111110x ... 10xxxxxx - any number of bits
+ codePoint := c1 codePoint bitAnd:16r01.
+
+ c2 := aStream peek.
+ [ c2 notNil and:[(c2 codePoint bitAnd:2r11000000) == 2r10000000]] whileTrue:[
+ codePoint := (codePoint bitShift:6) bitOr:(c2 codePoint bitAnd:16r3F).
+ aStream next.
+ ].
+ codePoint <= 16r3FFFFFF ifTrue:[
+ InvalidEncodingError raiseRequestWith:codePoint.
+ ].
+ ^ Character codePoint:codePoint
].
InvalidEncodingError raiseRequestWith:codePoint.
@@ -289,12 +289,12 @@
|utf8Encoding original readBack|
1 to:16rFFFF do:[:codePoint |
- original := Character value:codePoint.
- utf8Encoding := original asString utf8Encoded.
- readBack := Character utf8DecodeFrom:(utf8Encoding readStream).
- readBack codePoint = codePoint ifFalse:[
- self halt
- ]
+ original := Character value:codePoint.
+ utf8Encoding := original asString utf8Encoded.
+ readBack := Character utf8DecodeFrom:(utf8Encoding readStream).
+ readBack codePoint = codePoint ifFalse:[
+ self halt
+ ]
]
"
!
@@ -394,11 +394,11 @@
"
"
0 to:255 do:[:i |
- Transcript
- show:'| '; show:((i printStringRadix:16) leftPaddedTo:2);
- show:' | '; show:(i printStringPaddedTo:3);
- show:' | '; show:(Character value:i);
- cr.
+ Transcript
+ show:'| '; show:((i printStringRadix:16) leftPaddedTo:2);
+ show:' | '; show:(i printStringPaddedTo:3);
+ show:' | '; show:(Character value:i);
+ cr.
]
"
!
@@ -798,8 +798,7 @@
(which is more than mozilla does, btw. ;-)"
%{
- static int
- __mapping[] = {
+ static int __mapping[] = {
/* From To Every Diff */
0x0041, ((0x19 << 8) | 0x01), 0x0020 ,
0x00c0, ((0x16 << 8) | 0x01), 0x0020 ,
@@ -929,7 +928,7 @@
0x10400, ((0x27 << 8) | 0x01), 0x0028
};
- REGISTER unsigned __codePoint;
+ REGISTER unsigned INT __codePoint;
REGISTER int * __p;
__codePoint = __intVal(__INST(asciivalue));
@@ -978,7 +977,7 @@
%{ /* NOCONTEXT */
char buffer[2];
OBJ s;
- unsigned val;
+ unsigned INT val;
val = __intVal(_characterVal(self));
if (val <= 0xFF) {
@@ -1038,19 +1037,18 @@
|ch|
%{
- static unsigned short
- __mapping[] = {
- 0x01F1, 0x01F2,
- 0x01F3, 0x01F2,
+ static unsigned short __mapping[] = {
0x01C4, 0x01C5,
0x01C6, 0x01C5,
0x01C7, 0x01C8,
0x01C9, 0x01C8,
0x01CA, 0x01CB,
0x01CC, 0x01CB,
+ 0x01F1, 0x01F2,
+ 0x01F3, 0x01F2,
};
- REGISTER unsigned __codePoint;
+ REGISTER unsigned INT __codePoint;
REGISTER unsigned short *__p;
__codePoint = __intVal(__INST(asciivalue));
@@ -1105,8 +1103,7 @@
(which is more than mozilla does, btw. ;-)"
%{
- static int
- __mapping[] = {
+ static int __mapping[] = {
/* From To Every Diff */
0x0061, ((0x19 << 8) | 0x01), -32 ,
0x00b5, ((0x00 << 8) | 0x3b), 0x02e7 ,
@@ -1248,7 +1245,7 @@
0x10428, ((0x27 << 8) | 0x01), -40
};
- REGISTER unsigned __codePoint;
+ REGISTER unsigned INT __codePoint;
REGISTER int *__p;
__codePoint = __intVal(__INST(asciivalue));
@@ -1256,7 +1253,7 @@
unsigned rangeStart, rangeSize, rangeEnd, mod;
rangeStart = (unsigned)__p[0];
- if (__codePoint < rangeStart) break;
+ if (rangeStart > __codePoint) break;
rangeSize = ((unsigned)__p[1]) >> 8;
rangeEnd = rangeStart + rangeSize;
@@ -1297,13 +1294,13 @@
code := asciivalue.
(code between:($0 codePoint) and:($9 codePoint)) ifTrue:[
- ^ code - $0 codePoint
+ ^ code - $0 codePoint
].
(code between:($a codePoint) and:($z codePoint)) ifTrue:[
- ^ code + (10 - $a codePoint)
+ ^ code + (10 - $a codePoint)
].
(code between:($A codePoint) and:($Z codePoint)) ifTrue:[
- ^ code + (10 - $A codePoint)
+ ^ code + (10 - $A codePoint)
].
"remove error below for X3J20 conformance ... "
@@ -1320,27 +1317,27 @@
code := asciivalue.
base < 10 ifTrue:[
- (code between:($0 codePoint) and:($0 codePoint + base - 1)) ifTrue:[
- ^ code - $0 codePoint
- ].
- ^ nil.
+ (code between:($0 codePoint) and:($0 codePoint + base - 1)) ifTrue:[
+ ^ code - $0 codePoint
+ ].
+ ^ nil.
].
(code between:($0 codePoint) and:($9 codePoint)) ifTrue:[
- ^ code - $0 codePoint
+ ^ code - $0 codePoint
].
base <= 10 ifTrue:[
- ^ nil.
+ ^ nil.
].
(code between:($a codePoint) and:($a codePoint + base - 1 - 10)) ifTrue:[
- ^ code + (10 - $a codePoint)
+ ^ code + (10 - $a codePoint)
].
(code between:($A codePoint) and:($A codePoint + base - 1 - 10)) ifTrue:[
- ^ code + (10 - $A codePoint)
+ ^ code + (10 - $A codePoint)
].
^ nil
"
- self assert:($0 digitValueRadix:10) == 0.
+ self assert:($0 digitValueRadix:10) == 0.
self assert:($9 digitValueRadix:10) == 9.
self assert:($a digitValueRadix:10) == nil.
self assert:($a digitValueRadix:11) == 10.
@@ -1388,7 +1385,7 @@
|s|
asciivalue <= 16r7F ifTrue:[
- ^ self asString.
+ ^ self asString.
].
s := WriteStream on:(String new:6).
@@ -1396,7 +1393,7 @@
^ s contents
"
- 'ä' utf8Encoded
+ 'ä' utf8Encoded
"
! !
@@ -1465,10 +1462,10 @@
is self-inverse, so the same code can be used for encoding and decoding."
(self isLetter) ifTrue:[
- self isLowercase ifTrue:[
- ^ 'abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz' at:(self-$a+1+n)
- ].
- ^ 'ABCDEFGHIJKLMNOPQRSTUVWXYZABCDEFGHIJKLMNOPQRSTUVWXYZ' at:(self-$A+1+n)
+ self isLowercase ifTrue:[
+ ^ 'abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz' at:(self-$a+1+n)
+ ].
+ ^ 'ABCDEFGHIJKLMNOPQRSTUVWXYZABCDEFGHIJKLMNOPQRSTUVWXYZ' at:(self-$A+1+n)
].
^ self
@@ -1509,7 +1506,7 @@
"/ what a kludge - Dolphin and Squeak mean: printOn: a stream;
"/ ST/X (and some old ST80's) mean: draw-yourself on a GC.
(aGCOrStream isStream and:[aGCOrStream ~~ Transcript]) ifFalse:[
- ^ super displayOn:aGCOrStream
+ ^ super displayOn:aGCOrStream
].
self storeOn:aGCOrStream.
@@ -1633,7 +1630,7 @@
#ifdef NON_ASCII /* i.e. EBCDIC ;-) */
# error not yet implemented - fails when compiled
#else
- REGISTER int val;
+ REGISTER INT val;
val = __intVal(__INST(asciivalue));
if (val < ' ' || val == 0xFF) {
@@ -1654,10 +1651,10 @@
%{ /* NOCONTEXT */
- REGISTER int val;
+ REGISTER INT val;
val = __intVal(__INST(asciivalue));
- if ((unsigned)(val - '0') <= ('9' - '0')) {
+ if ((unsigned INT)(val - '0') <= ('9' - '0')) {
RETURN ( true );
}
RETURN ( false );
@@ -1687,7 +1684,7 @@
%{ /* NOCONTEXT */
- REGISTER int val;
+ REGISTER INT val;
val = __intVal(__INST(asciivalue));
if ((val == '\n')
@@ -1731,13 +1728,13 @@
%{ /* NOCONTEXT */
- REGISTER int val;
+ REGISTER INT val;
val = __intVal(__INST(asciivalue));
- if ((unsigned)(val - 'a') <= ('z' - 'a')) {
+ if ((unsigned INT)(val - 'a') <= ('z' - 'a')) {
RETURN ( true );
}
- if ((unsigned)(val - 'A') <= ('Z' - 'A')) {
+ if ((unsigned INT)(val - 'A') <= ('Z' - 'A')) {
RETURN ( true );
}
RETURN ( false );
@@ -1752,16 +1749,16 @@
%{ /* NOCONTEXT */
- REGISTER int val;
+ REGISTER INT val;
val = __intVal(__INST(asciivalue));
- if ((unsigned)(val - 'a') <= ('z' - 'a')) {
+ if ((unsigned INT)(val - 'a') <= ('z' - 'a')) {
RETURN ( true );
}
- if ((unsigned)(val - 'A') <= ('Z' - 'A')) {
+ if ((unsigned INT)(val - 'A') <= ('Z' - 'A')) {
RETURN ( true );
}
- if ((unsigned)(val - '0') <= ('9' - '0')) {
+ if ((unsigned INT)(val - '0') <= ('9' - '0')) {
RETURN ( true );
}
RETURN ( false );
@@ -1773,227 +1770,231 @@
"return true, if I am a lower-case letter.
This one does care for national characters.
Caveat:
- only returns the correct value for codes up to u+1d6ff (Unicode3.1).
- (which is more than mozilla does, btw. ;-)"
+ only returns the correct value for codes up to u+1d6ff (Unicode3.1).
+ (which is more than mozilla does, btw. ;-)"
%{ /* NOCONTEXT */
- REGISTER int val;
+ REGISTER unsigned INT val;
#define TRUE_IF_ODD(x) ((x & 1) ? true : false)
#define TRUE_IF_EVEN(x) ((x & 1) ? false : true)
+ /* because used so often, this is open coded, instead of table driven */
val = __intVal(__INST(asciivalue));
+
+ /* the most likely case here, outside the switch */
+ if (val <= 0xFF) {
+ if ((unsigned INT)(val - 'a') <= ('z' - 'a')) {
+ RETURN ( true );
+ }
+
+ /* iso8859 puts national lower case characters at e0 .. ff */
+ if ((val >= 0xDF) && (val <= 0xFF)) {
+ if (val != 0xF7) {
+ RETURN(true);
+ }
+ }
+ if (val == 0xAA) RETURN(true); /* FEMININE ORDINAL INDICATOR (high a-underline) */
+ if (val == 0xB5) RETURN(true); /* MICRO SIGN */
+ if (val == 0xBA) RETURN(true); /* MASCULINE ORDINAL INDICATOR (high o-underline) */
+ RETURN (false);
+ }
+
switch (val >> 8) {
- case 0x00:
- if ((unsigned)(val - 'a') <= ('z' - 'a')) {
- RETURN ( true );
- }
-
- /* iso8859 puts national lower case characters at e0 .. ff */
- if ((val >= 0xDF) && (val <= 0xFF)) {
- if (val != 0xF7) {
- RETURN(true);
- }
- }
- if (val == 0xAA) RETURN(true); /* FEMININE ORDINAL INDICATOR (high a-underline) */
- if (val == 0xB5) RETURN(true); /* MICRO SIGN */
- if (val == 0xBA) RETURN(true); /* MASCULINE ORDINAL INDICATOR (high o-underline) */
- RETURN (false);
-
- case 0x01:
- if (val <= 0x0137) { RETURN (TRUE_IF_ODD(val)); }
- if (val <= 0x0148) { RETURN (TRUE_IF_EVEN(val)); }
- if (val <= 0x0178) { RETURN (TRUE_IF_ODD(val)); }
- if (val <= 0x017E) { RETURN (TRUE_IF_EVEN(val)); }
- if (val <= 0x0180) { RETURN (true); }
- if (val < 0x01CD) {
- if (val == 0x0181) { RETURN (false); }
- if (val <= 0x0185) {
- RETURN (TRUE_IF_ODD(val));
- }
- if (val == 0x0188) { RETURN (true); }
- if (val == 0x018C) { RETURN (true); }
- if (val == 0x018D) { RETURN (true); }
- if (val == 0x0192) { RETURN (true); }
- if (val == 0x0195) { RETURN (true); }
- if (val == 0x0199) { RETURN (true); }
- if (val == 0x019A) { RETURN (true); }
- if (val == 0x019B) { RETURN (true); }
- if (val == 0x019E) { RETURN (true); }
- if (val <= 0x01A0) { RETURN (false); }
- if (val <= 0x01A6) { RETURN (TRUE_IF_ODD(val)); }
- if (val <= 0x01AA) { RETURN (TRUE_IF_EVEN(val)); }
- if (val <= 0x01AE) { RETURN (TRUE_IF_ODD(val)); }
- if (val == 0x01B2) { RETURN (false); }
- if (val <= 0x01B6) { RETURN (TRUE_IF_EVEN(val)); }
- if (val == 0x01B9) { RETURN (true); }
- if (val == 0x01BA) { RETURN (true); }
- if (val == 0x01BD) { RETURN (true); }
- if (val == 0x01BE) { RETURN (true); }
- if (val == 0x01BF) { RETURN (true); }
- if (val == 0x01C6) { RETURN (true); }
- if (val == 0x01C9) { RETURN (true); }
- if (val == 0x01CC) { RETURN (true); }
- RETURN (false);
- }
- if (val <= 0x01DC) { RETURN (TRUE_IF_EVEN(val)); }
- if (val <= 0x01EF) { RETURN (TRUE_IF_ODD(val)); }
- if (val == 0x01F0) { RETURN (true); }
- if (val == 0x01F1) { RETURN (false); }
- if (val == 0x01F2) { RETURN (false); }
- if (val == 0x01F3) { RETURN (true); }
- if (val <= 0x01F6) { RETURN (TRUE_IF_ODD(val)); }
- if (val == 0x01F7) { RETURN (false); }
- RETURN (TRUE_IF_ODD(val));
-
- case 0x02:
- if (val <= 0x0233) { RETURN (TRUE_IF_ODD(val)); }
- if (val <= 0x0236) { RETURN (true); }
- if (val < 0x0250) { RETURN (false); }
- if (val < 0x02B0) { RETURN (true); }
- RETURN (false);
-
-
- case 0x03:
- if (val == 0x0390) { RETURN (true); }
- if (val <= 0x03AB) { RETURN (false); }
- if (val <= 0x03D1) { RETURN (true); }
- if (val == 0x03D5) { RETURN (true); }
- if (val == 0x03D6) { RETURN (true); }
- if (val < 0x03D7) { RETURN (false); }
- if (val <= 0x03EF) { RETURN (TRUE_IF_ODD(val)); }
- if (val <= 0x03F3) { RETURN (true); }
- if (val == 0x03F5) { RETURN (true); }
+ case 0x01:
+ if (val <= 0x0137) { RETURN (TRUE_IF_ODD(val)); }
+ if (val <= 0x0148) { RETURN (TRUE_IF_EVEN(val)); }
+ if (val <= 0x0178) { RETURN (TRUE_IF_ODD(val)); }
+ if (val <= 0x017E) { RETURN (TRUE_IF_EVEN(val)); }
+ if (val <= 0x0180) { RETURN (true); }
+ if (val < 0x01CD) {
+ if (val == 0x0181) { RETURN (false); }
+ if (val <= 0x0185) {
+ RETURN (TRUE_IF_ODD(val));
+ }
+ if (val == 0x0188) { RETURN (true); }
+ if (val == 0x018C) { RETURN (true); }
+ if (val == 0x018D) { RETURN (true); }
+ if (val == 0x0192) { RETURN (true); }
+ if (val == 0x0195) { RETURN (true); }
+ if (val == 0x0199) { RETURN (true); }
+ if (val == 0x019A) { RETURN (true); }
+ if (val == 0x019B) { RETURN (true); }
+ if (val == 0x019E) { RETURN (true); }
+ if (val <= 0x01A0) { RETURN (false); }
+ if (val <= 0x01A6) { RETURN (TRUE_IF_ODD(val)); }
+ if (val <= 0x01AA) { RETURN (TRUE_IF_EVEN(val)); }
+ if (val <= 0x01AE) { RETURN (TRUE_IF_ODD(val)); }
+ if (val == 0x01B2) { RETURN (false); }
+ if (val <= 0x01B6) { RETURN (TRUE_IF_EVEN(val)); }
+ if (val == 0x01B9) { RETURN (true); }
+ if (val == 0x01BA) { RETURN (true); }
+ if (val == 0x01BD) { RETURN (true); }
+ if (val == 0x01BE) { RETURN (true); }
+ if (val == 0x01BF) { RETURN (true); }
+ if (val == 0x01C6) { RETURN (true); }
+ if (val == 0x01C9) { RETURN (true); }
+ if (val == 0x01CC) { RETURN (true); }
+ RETURN (false);
+ }
+ if (val <= 0x01DC) { RETURN (TRUE_IF_EVEN(val)); }
+ if (val <= 0x01EF) { RETURN (TRUE_IF_ODD(val)); }
+ if (val == 0x01F0) { RETURN (true); }
+ if (val == 0x01F1) { RETURN (false); }
+ if (val == 0x01F2) { RETURN (false); }
+ if (val == 0x01F3) { RETURN (true); }
+ if (val <= 0x01F6) { RETURN (TRUE_IF_ODD(val)); }
+ if (val == 0x01F7) { RETURN (false); }
+ RETURN (TRUE_IF_ODD(val));
+
+ case 0x02:
+ if (val <= 0x0233) { RETURN (TRUE_IF_ODD(val)); }
+ if (val <= 0x0236) { RETURN (true); }
+ if (val < 0x0250) { RETURN (false); }
+ if (val < 0x02B0) { RETURN (true); }
+ RETURN (false);
+
+
+ case 0x03:
+ if (val == 0x0390) { RETURN (true); }
+ if (val <= 0x03AB) { RETURN (false); }
+ if (val <= 0x03D1) { RETURN (true); }
+ if (val == 0x03D5) { RETURN (true); }
+ if (val == 0x03D6) { RETURN (true); }
+ if (val < 0x03D7) { RETURN (false); }
+ if (val <= 0x03EF) { RETURN (TRUE_IF_ODD(val)); }
+ if (val <= 0x03F3) { RETURN (true); }
+ if (val == 0x03F5) { RETURN (true); }
#ifndef UNICODE_3_2
- if (val == 0x03F8) { RETURN (true); }
- if (val == 0x03FB) { RETURN (true); }
+ if (val == 0x03F8) { RETURN (true); }
+ if (val == 0x03FB) { RETURN (true); }
#endif
- RETURN (false);
-
- case 0x04:
- if (val <= 0x042F) { RETURN (false); }
- if (val <= 0x045F) { RETURN (true); }
- if (val <= 0x0481) { RETURN (TRUE_IF_ODD(val)); }
- if (val < 0x048A) { RETURN (false); }
- if (val <= 0x04C0) { RETURN (TRUE_IF_ODD(val)); }
+ RETURN (false);
+
+ case 0x04:
+ if (val <= 0x042F) { RETURN (false); }
+ if (val <= 0x045F) { RETURN (true); }
+ if (val <= 0x0481) { RETURN (TRUE_IF_ODD(val)); }
+ if (val < 0x048A) { RETURN (false); }
+ if (val <= 0x04C0) { RETURN (TRUE_IF_ODD(val)); }
#ifdef UNICODE_3_2
- if (val == 0x04C5) { RETURN (true); }
+ if (val == 0x04C5) { RETURN (true); }
#endif
#ifdef UNICODE_3_2
- if (val <= 0x04C8) { RETURN (TRUE_IF_EVEN(val)); }
+ if (val <= 0x04C8) { RETURN (TRUE_IF_EVEN(val)); }
#else
- if (val <= 0x04CA) { RETURN (TRUE_IF_EVEN(val)); }
- if (val == 0x04CD) { RETURN (false); }
- if (val == 0x04CE) { RETURN (true); }
+ if (val <= 0x04CA) { RETURN (TRUE_IF_EVEN(val)); }
+ if (val == 0x04CD) { RETURN (false); }
+ if (val == 0x04CE) { RETURN (true); }
#endif
- if (val == 0x04CB) { RETURN (false); }
- if (val == 0x04CC) { RETURN (true); }
- RETURN (TRUE_IF_ODD(val));
-
- case 0x05:
- if (val <= 0x050F) { RETURN (TRUE_IF_ODD(val)); }
- if (val < 0x0561) { RETURN (false); }
- if (val <= 0x0587) { RETURN (true); }
- RETURN (false);
-
- case 0x1D:
+ if (val == 0x04CB) { RETURN (false); }
+ if (val == 0x04CC) { RETURN (true); }
+ RETURN (TRUE_IF_ODD(val));
+
+ case 0x05:
+ if (val <= 0x050F) { RETURN (TRUE_IF_ODD(val)); }
+ if (val < 0x0561) { RETURN (false); }
+ if (val <= 0x0587) { RETURN (true); }
+ RETURN (false);
+
+ case 0x1D:
#ifndef UNICODE_3_2
- if (val <= 0x1D2B) { RETURN (true); }
- if (val <= 0x1D61) { RETURN (false); }
- if (val <= 0x1D70) { RETURN (true); }
+ if (val <= 0x1D2B) { RETURN (true); }
+ if (val <= 0x1D61) { RETURN (false); }
+ if (val <= 0x1D70) { RETURN (true); }
#endif
- RETURN (false);
-
- case 0x1E:
- if (val < 0x1E96) { RETURN (TRUE_IF_ODD(val)); }
- if (val <= 0x1E9F) { RETURN (true); }
- RETURN (TRUE_IF_ODD(val));
-
- case 0x1F:
- if (val <= 0x1F6F) {
- if (val & 0x0008) { RETURN (false); }
- RETURN (true);
- }
- if (val <= 0x1F87) { RETURN (true); }
- if (val < 0x1FB8) {
- if (val & 0x0008) { RETURN (false); }
- RETURN (true);
- }
- if (val == 0x1FBE) { RETURN (true); }
- if (val == 0x1FD4) { RETURN (false); }
- if (val == 0x1FC5) { RETURN (false); }
- if (val == 0x1FD5) { RETURN (false); }
- if (val == 0x1FC1) { RETURN (false); }
- if (val == 0x1FF1) { RETURN (false); }
- if (val == 0x1FC0) { RETURN (false); }
- if (val == 0x1FF0) { RETURN (false); }
- if (((val & 0x000F) >= 0x0000) && ((val & 0x000F) <= 0x0007)) { RETURN (true); }
- RETURN (false);
-
- case 0x20:
+ RETURN (false);
+
+ case 0x1E:
+ if (val < 0x1E96) { RETURN (TRUE_IF_ODD(val)); }
+ if (val <= 0x1E9F) { RETURN (true); }
+ RETURN (TRUE_IF_ODD(val));
+
+ case 0x1F:
+ if (val <= 0x1F6F) {
+ if (val & 0x0008) { RETURN (false); }
+ RETURN (true);
+ }
+ if (val <= 0x1F87) { RETURN (true); }
+ if (val < 0x1FB8) {
+ if (val & 0x0008) { RETURN (false); }
+ RETURN (true);
+ }
+ if (val == 0x1FBE) { RETURN (true); }
+ if (val == 0x1FD4) { RETURN (false); }
+ if (val == 0x1FC5) { RETURN (false); }
+ if (val == 0x1FD5) { RETURN (false); }
+ if (val == 0x1FC1) { RETURN (false); }
+ if (val == 0x1FF1) { RETURN (false); }
+ if (val == 0x1FC0) { RETURN (false); }
+ if (val == 0x1FF0) { RETURN (false); }
+ if (((val & 0x000F) >= 0x0000) && ((val & 0x000F) <= 0x0007)) { RETURN (true); }
+ RETURN (false);
+
+ case 0x20:
#ifndef UNICODE_3_2
- if (val == 0x2071) { RETURN (true); }
+ if (val == 0x2071) { RETURN (true); }
#endif
- if (val == 0x207F) { RETURN (true); }
- RETURN (false);
-
- case 0x21:
- if (val == 0x210A) { RETURN (true); }
- if (val < 0x210E) { RETURN (false); }
- if (val <= 0x210F) { RETURN (true); }
- if (val == 0x2113) { RETURN (true); }
- if (val == 0x212F) { RETURN (true); }
- if (val == 0x2134) { RETURN (true); }
- if (val == 0x2139) { RETURN (true); }
+ if (val == 0x207F) { RETURN (true); }
+ RETURN (false);
+
+ case 0x21:
+ if (val == 0x210A) { RETURN (true); }
+ if (val < 0x210E) { RETURN (false); }
+ if (val <= 0x210F) { RETURN (true); }
+ if (val == 0x2113) { RETURN (true); }
+ if (val == 0x212F) { RETURN (true); }
+ if (val == 0x2134) { RETURN (true); }
+ if (val == 0x2139) { RETURN (true); }
#ifndef UNICODE_3_2
- if (val == 0x213D) { RETURN (true); }
- if (val <= 0x2145) { RETURN (false); }
- if (val <= 0x2149) { RETURN (true); }
+ if (val == 0x213D) { RETURN (true); }
+ if (val <= 0x2145) { RETURN (false); }
+ if (val <= 0x2149) { RETURN (true); }
#endif
- RETURN (false);
-
- case 0xFB:
- if (val <= 0xFB1C) { RETURN (true); }
- RETURN (false);
-
- case 0xFF:
- if ((val >= 0xFF41) && (val <= 0xFF5A)) { RETURN (true); }
- RETURN (false);
-
- case 0x104:
- if (val <= 0x10427) { RETURN (false); }
- if (val <= 0x1044D) { RETURN (true); }
+ RETURN (false);
+
+ case 0xFB:
+ if (val <= 0xFB1C) { RETURN (true); }
+ RETURN (false);
+
+ case 0xFF:
+ if ((val >= 0xFF41) && (val <= 0xFF5A)) { RETURN (true); }
+ RETURN (false);
+
+ case 0x104:
+ if (val <= 0x10427) { RETURN (false); }
+ if (val <= 0x1044D) { RETURN (true); }
#ifdef UNICODE_3_2
- if (val <= 0x1044D) { RETURN (true); }
+ if (val <= 0x1044D) { RETURN (true); }
#else
- if (val <= 0x1044F) { RETURN (true); }
+ if (val <= 0x1044F) { RETURN (true); }
#endif
- RETURN (false);
-
- case 0x1D4:
- case 0x1D5:
- case 0x1D6:
- if (val <= 0x1D419) { RETURN (false); }
- if (val < 0x1D6be) {
- if (((val - 0x1D41A) % 52) <= 25) { RETURN (true); }
- RETURN (false);
- }
- if (val < 0x1D6c2) { RETURN (false); }
- if (val < 0x1D6db) { RETURN (true); }
- if (val == 0x1D6db) { RETURN (false); }
- if (val < 0x1D6e2) { RETURN (true); }
- if (val <= 0x1D6fb) { RETURN (false); }
- RETURN (true);
+ RETURN (false);
+
+ case 0x1D4:
+ case 0x1D5:
+ case 0x1D6:
+ if (val <= 0x1D419) { RETURN (false); }
+ if (val < 0x1D6be) {
+ if (((val - 0x1D41A) % 52) <= 25) { RETURN (true); }
+ RETURN (false);
+ }
+ if (val < 0x1D6c2) { RETURN (false); }
+ if (val < 0x1D6db) { RETURN (true); }
+ if (val == 0x1D6db) { RETURN (false); }
+ if (val < 0x1D6e2) { RETURN (true); }
+ if (val <= 0x1D6fb) { RETURN (false); }
+ RETURN (true);
#ifdef UNICODE_4
- case 0x1D7:
- if (val <= 0x1D71b) { RETURN (true); }
- if (val <= 0x1D735) { RETURN (false); }
- if (val <= 0x1D755) { RETURN (true); }
- if (val <= 0x1D76f) { RETURN (false); }
- if (val <= 0x1D78F) { RETURN (true); }
-
- RETURN (false);
+ case 0x1D7:
+ if (val <= 0x1D71b) { RETURN (true); }
+ if (val <= 0x1D735) { RETURN (false); }
+ if (val <= 0x1D755) { RETURN (true); }
+ if (val <= 0x1D76f) { RETURN (false); }
+ if (val <= 0x1D78F) { RETURN (true); }
+
+ RETURN (false);
#endif
}
#undef TRUE_IF_ODD
@@ -2025,7 +2026,7 @@
%{ /* NOCONTEXT */
- REGISTER int val;
+ REGISTER INT val;
val = __intVal(__INST(asciivalue));
#ifndef NON_ASCII /* i.e. EBCDIC ;-) */
@@ -2059,23 +2060,26 @@
#define TRUE_IF_ODD(x) ((x & 1) ? true : false)
#define TRUE_IF_EVEN(x) ((x & 1) ? false : true)
- REGISTER int val;
+ /* because used so often, this is open coded, instead of table driven */
+ REGISTER unsigned INT val;
val = __intVal(__INST(asciivalue));
+ /* the most likely case here, outside the switch */
+ if (val <= 0xFF) {
+ if ((unsigned INT)(val - 'A') <= ('Z' - 'A')) {
+ RETURN ( true );
+ }
+ /* iso8859 puts national upper case characters at c0 .. df */
+ if ((val >= 0xC0) && (val <= 0xDE)) {
+ if (val != 0xD7) {
+ RETURN(true);
+ }
+ }
+ RETURN (false);
+ }
+
switch (val >> 8) {
- case 0x00:
- if ((unsigned)(val - 'A') <= ('Z' - 'A')) {
- RETURN ( true );
- }
- /* iso8859 puts national upper case characters at c0 .. df */
- if ((val >= 0xC0) && (val <= 0xDE)) {
- if (val != 0xD7) {
- RETURN(true);
- }
- }
- RETURN (false);
-
case 0x01:
if (val <= 0x0137) { RETURN (TRUE_IF_EVEN(val)); }
if (val <= 0x0148) { RETURN (TRUE_IF_ODD(val)); }
@@ -2318,15 +2322,16 @@
%{ /* NOCONTEXT */
- REGISTER int val;
-
+ REGISTER INT val;
+
+ /* because used so often, this is open coded, instead of table driven */
val = __intVal(__INST(asciivalue));
switch (val >> 8) {
case 0x00:
- if ((unsigned)(val - 'A') <= ('Z' - 'A')) {
+ if ((unsigned INT)(val - 'A') <= ('Z' - 'A')) {
RETURN ( true );
}
- if ((unsigned)(val - 'a') <= ('z' - 'a')) {
+ if ((unsigned INT)(val - 'a') <= ('z' - 'a')) {
RETURN ( true );
}
if (val == 0xAA) { RETURN (true); }
@@ -2810,10 +2815,9 @@
!Character class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Character.st,v 1.144 2013-01-16 14:10:58 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Character.st,v 1.145 2013-01-23 10:46:37 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Character.st,v 1.144 2013-01-16 14:10:58 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Character.st,v 1.145 2013-01-23 10:46:37 cg Exp $'
! !
-
--- a/CharacterArray.st Wed Jan 23 10:08:55 2013 +0000
+++ b/CharacterArray.st Mon Jan 28 21:53:19 2013 +0000
@@ -326,7 +326,6 @@
"
! !
-
!CharacterArray class methodsFor:'pattern matching'!
matchEscapeCharacter
@@ -678,7 +677,6 @@
^ self == CharacterArray
! !
-
!CharacterArray methodsFor:'Compatibility-ANSI'!
addLineDelimiters
@@ -755,6 +753,25 @@
"
! !
+!CharacterArray methodsFor:'Compatibility-GNU'!
+
+% anArrayOfOperands
+ "return a copy of the receiver, where a '%i' escape
+ is replaced by the coresponding string from the argument array.
+ 'i' may be between 1 and 9 (i.e. a maximum of 9 placeholders is allowed).
+ Added for GNU-ST compatibility."
+
+ ^ self expandPlaceholdersWith:anArrayOfOperands
+
+ "
+ 'do you prefer %1 or rather %2 (not talking about %3) ?'
+ % #('smalltalk' 'c++' 'c')
+
+ 'do you %(what) ?'
+ % (Dictionary new at:#'what' put:'understand'; yourself)
+ "
+! !
+
!CharacterArray methodsFor:'Compatibility-ST/V'!
byteAt:index put:aByte
@@ -1555,7 +1572,6 @@
! !
-
!CharacterArray methodsFor:'character searching'!
includesMatchCharacters
@@ -4369,7 +4385,6 @@
! !
-
!CharacterArray methodsFor:'padded copying'!
centerPaddedTo:newSize
@@ -4894,7 +4909,6 @@
"Modified: 17.4.1997 / 12:50:23 / cg"
! !
-
!CharacterArray methodsFor:'special string converting'!
expandPlaceholdersWith:argArrayOrDictionary
@@ -5699,7 +5713,6 @@
"
! !
-
!CharacterArray methodsFor:'substring searching'!
findString:subString
@@ -6191,11 +6204,11 @@
!CharacterArray class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/CharacterArray.st,v 1.491 2013-01-16 12:31:17 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/CharacterArray.st,v 1.492 2013-01-22 14:11:02 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/CharacterArray.st,v 1.491 2013-01-16 12:31:17 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/CharacterArray.st,v 1.492 2013-01-22 14:11:02 cg Exp $'
! !
--- a/Class.st Wed Jan 23 10:08:55 2013 +0000
+++ b/Class.st Mon Jan 28 21:53:19 2013 +0000
@@ -526,15 +526,15 @@
subclass:nm classInstanceVariableNames:cIV instanceVariableNames:iV classVariableNames:cV poolDictionaries:p
"{ Pragma: +optSpace }"
- "this method allows fileIn of V'Age classes"
+ "this method allows fileIn of ST/V and V'Age classes"
^ self
- subclass:nm
- instanceVariableNames:iV
- classVariableNames:cV
- poolDictionaries:p
- category:(self defaultCategoryForSTVorVAGEClasses)
- classInstanceVariableNames:cIV
+ subclass:nm
+ instanceVariableNames:iV
+ classVariableNames:cV
+ poolDictionaries:p
+ category:(self defaultCategoryForSTVorVAGEClasses)
+ classInstanceVariableNames:cIV
!
subclass:t instanceVariableNames:f classVariableNames:d poolDictionaries:s
@@ -630,7 +630,6 @@
"Created: / 18.6.1998 / 22:08:45 / cg"
! !
-
!Class methodsFor:'accessing'!
addChangeRecordForClass:aClass andNotifyChangeOf:aspect
@@ -963,6 +962,22 @@
]
!
+containingNameSpace
+ "return the namespace I am really contained in;
+ For private or anonymous classes, nil is returned -
+ for public classes, Smalltalk is returned."
+
+ |e|
+
+ e := self nameSpace.
+ "/ (e at:self nameWithoutNamespacePrefix ifAbsent:nil)
+ "/ or
+ (Smalltalk at:name ifAbsent:nil) == self ifFalse:[
+ ^ nil
+ ].
+ ^ e
+!
+
environment
"return the namespace I am contained in; ST-80 compatible name"
@@ -1025,27 +1040,31 @@
nameSpace
"return the namespace I am contained in;
For private or anonymous classes, nil is returned -
- for public classes, Smalltalk is returned."
+ for public classes, Smalltalk is returned.
+ For now, this also returns Smalltalk for classes which are actually anonymous;
+ this is left in for a while (because many users f this method expect a non-nil return value).
+ but will change in the future to return nil then.
+ In the meantime, use containingNameSpace, which provides the correct answer"
|idx nsName e|
"/ cached in environment
environment isNil ifTrue:[
- e := Smalltalk. "/ default
-
- name notNil ifTrue:[
- "/ due to the implementation, extract this from my name
- "/ (physically, all classes are found in Smalltalk)
-
- idx := name lastIndexOf:$:.
- idx ~~ 0 ifTrue:[
- (name at:idx-1) == $: ifTrue:[
- nsName := name copyTo:(idx - 2).
- e := Smalltalk at:nsName asSymbol.
- ]
- ].
- ].
- environment := e.
+ e := Smalltalk. "/ default
+
+ name notNil ifTrue:[
+ "/ due to the implementation, extract this from my name
+ "/ (physically, all classes are found in Smalltalk)
+
+ idx := name lastIndexOf:$:.
+ idx ~~ 0 ifTrue:[
+ (name at:idx-1) == $: ifTrue:[
+ nsName := name copyTo:(idx - 2).
+ e := Smalltalk at:nsName asSymbol.
+ ]
+ ].
+ ].
+ environment := e.
].
^ environment
@@ -5094,12 +5113,13 @@
sourceCodeManager notNil ifTrue:[
classFilename ~= source ifTrue:[
- sep := self package indexOfAny:'/\:'.
- sep ~~ 0 ifTrue:[
- mod := package copyTo:sep - 1.
- dir := package copyFrom:sep + 1.
-self breakPoint:#fm.
- sourceStream := sourceCodeManager streamForClass:nil fileName:source revision:(self binaryRevision) directory:dir module:mod cache:true.
+ package notNil ifTrue:[
+ sep := package indexOfAny:'/\:'.
+ sep ~~ 0 ifTrue:[
+ mod := package copyTo:sep - 1.
+ dir := package copyFrom:sep + 1.
+ sourceStream := sourceCodeManager streamForClass:nil fileName:source revision:(self binaryRevision) directory:dir module:mod cache:true.
+ ]
].
].
sourceStream isNil ifTrue:[
@@ -5582,11 +5602,11 @@
!Class class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Class.st,v 1.612 2012-12-21 18:42:10 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Class.st,v 1.616 2013-01-24 17:06:21 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Class.st,v 1.612 2012-12-21 18:42:10 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Class.st,v 1.616 2013-01-24 17:06:21 cg Exp $'
!
version_SVN
--- a/ClassBuilder.st Wed Jan 23 10:08:55 2013 +0000
+++ b/ClassBuilder.st Mon Jan 28 21:53:19 2013 +0000
@@ -2094,7 +2094,7 @@
or:[className size == 0]) ifTrue:[
ClassBuildError raiseErrorString:'invalid class name (must be a nonEmpty symbol)'.
].
- className first isLetter ifFalse:[
+ (className first isLetter or:[className first = $_]) ifFalse:[
ClassBuildError raiseErrorString:'invalid class name (must start with a letter)'.
].
@@ -2366,11 +2366,12 @@
!ClassBuilder class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/ClassBuilder.st,v 1.117 2012-10-25 12:15:54 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/ClassBuilder.st,v 1.118 2013-01-18 20:56:08 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/ClassBuilder.st,v 1.117 2012-10-25 12:15:54 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/ClassBuilder.st,v 1.118 2013-01-18 20:56:08 cg Exp $'
! !
+
ClassBuilder initialize!
--- a/ClassDescription.st Wed Jan 23 10:08:55 2013 +0000
+++ b/ClassDescription.st Mon Jan 28 21:53:19 2013 +0000
@@ -820,7 +820,6 @@
"Created: / 28.3.1998 / 21:21:52 / cg"
! !
-
!ClassDescription methodsFor:'Compatibility-V''Age'!
categoriesFor:aSelector are:listOfCategories
@@ -1181,7 +1180,10 @@
].
(super addSelector:newSelector withMethod:newMethod) ifTrue:[
- self addChangeRecordForMethod:newMethod fromOld:oldMethod.
+ "/ only write change records for changes to non-anonymous classes
+ self theNonMetaclass containingNameSpace notNil ifTrue:[
+ self addChangeRecordForMethod:newMethod fromOld:oldMethod.
+ ]
].
"Modified: / 09-09-1996 / 22:39:32 / stefan"
@@ -1219,20 +1221,23 @@
].
(super removeSelector:aSelector) ifTrue:[
- self addChangeRecordForRemoveSelector:aSelector fromOld:oldMethod.
- "/
- "/ also notify a change of mySelf;
- "/
- self changed:#methodDictionary with:aSelector.
-
- "/
- "/ also notify a change of Smalltalk;
- "/ this allows a dependent of Smalltalk to watch all class
- "/ changes (no need for observing all classes)
- "/ - this allows for watchers to find out if its a new method or a method-change
- "/
- MethodRemoveChangeNotificationParameter notNil ifTrue:[
- Smalltalk changed:#methodInClassRemoved with:(MethodRemoveChangeNotificationParameter changeClass:self changeSelector:aSelector).
+ "/ only write change records for changes to non-anonymous classes
+ self theNonMetaclass containingNameSpace notNil ifTrue:[
+ self addChangeRecordForRemoveSelector:aSelector fromOld:oldMethod.
+ "/
+ "/ also notify a change of mySelf;
+ "/
+ self changed:#methodDictionary with:aSelector.
+
+ "/
+ "/ also notify a change of Smalltalk;
+ "/ this allows a dependent of Smalltalk to watch all class
+ "/ changes (no need for observing all classes)
+ "/ - this allows for watchers to find out if its a new method or a method-change
+ "/
+ MethodRemoveChangeNotificationParameter notNil ifTrue:[
+ Smalltalk changed:#methodInClassRemoved with:(MethodRemoveChangeNotificationParameter changeClass:self changeSelector:aSelector).
+ ]
]
]
@@ -1287,17 +1292,21 @@
addChangeRecordForMethod:aMethod
"{ Pragma: +optSpace }"
+ <resource: #obsolete>
+
+ self obsoleteMethodWarning:'use addChangeRecordForMethod:fromOld:'.
+
"add a method-change-record to the changes file and to the current changeSet"
UpdateChangeFileQuerySignal query ifTrue:[
- self writingChangePerform:#addChangeRecordForMethod:to: with:aMethod.
+ self writingChangePerform:#addChangeRecordForMethod:to: with:aMethod.
].
"this test allows a smalltalk without Projects/ChangeSets"
Project notNil ifTrue:[
- UpdateChangeListQuerySignal query ifTrue:[
- Project addMethodChange:aMethod in:self
- ]
+ UpdateChangeListQuerySignal query ifTrue:[
+ Project addMethodChange:aMethod in:self
+ ]
]
"Modified: / 20.1.1997 / 12:36:02 / cg"
@@ -4229,11 +4238,11 @@
!ClassDescription class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/ClassDescription.st,v 1.230 2013-01-03 09:20:11 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/ClassDescription.st,v 1.233 2013-01-25 10:37:50 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/ClassDescription.st,v 1.230 2013-01-03 09:20:11 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/ClassDescription.st,v 1.233 2013-01-25 10:37:50 cg Exp $'
! !
--- a/Collection.st Wed Jan 23 10:08:55 2013 +0000
+++ b/Collection.st Mon Jan 28 21:53:19 2013 +0000
@@ -259,7 +259,6 @@
^ self withSize:n
! !
-
!Collection class methodsFor:'Signal constants'!
emptyCollectionSignal
@@ -510,7 +509,6 @@
].
! !
-
!Collection methodsFor:'accessing'!
anElement
@@ -1529,6 +1527,12 @@
^ self addAllTo:(OrderedCollection new:self size)
!
+asOrderedSet
+ "return a new OrderedSet with the receiver collections elements"
+
+ ^ self addAllTo:(OrderedSet new:self size)
+!
+
asRunArray
"return a new RunArray with the collections elements"
@@ -2836,13 +2840,13 @@
"
!
-triplesDo:aBlock
- "evaluate the argument, aBlock for every element in the collection,
+triplesDo:aThreeArgBlock
+ "evaluate the argument, aThreeArgBlock for every element in the collection,
which is supposed to consist of 3-element collections.
The block is called with 3 arguments for each collection in the receiver."
self do:[:aTriple |
- aBlock value:(aTriple at:1) value:(aTriple at:2) value:(aTriple at:3).
+ aThreeArgBlock value:(aTriple at:1) value:(aTriple at:2) value:(aTriple at:3).
]
"
#(
@@ -2861,13 +2865,13 @@
"Modified: 10.5.1997 / 14:15:43 / cg"
!
-tuplesDo:aBlock
- "evaluate the argument, aBlock for every element in the collection,
+tuplesDo:anNArgBlock
+ "evaluate the argument, anNArgBlock for every element in the collection,
which is supposed to consist of N-element collections.
The block is called with N arguments for each collection in the receiver."
self do:[:aTuple |
- aBlock valueWithArguments:aTuple
+ anNArgBlock valueWithArguments:aTuple
]
"
#(
@@ -4455,11 +4459,11 @@
!Collection class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Collection.st,v 1.286 2012-12-21 11:58:02 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Collection.st,v 1.288 2013-01-25 10:14:44 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Collection.st,v 1.286 2012-12-21 11:58:02 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Collection.st,v 1.288 2013-01-25 10:14:44 cg Exp $'
! !
--- a/Context.st Wed Jan 23 10:08:55 2013 +0000
+++ b/Context.st Mon Jan 28 21:53:19 2013 +0000
@@ -1726,13 +1726,14 @@
newString := receiverClassName
].
- selector notNil ifTrue:[
-"/ implementorClass := self searchClass whichClassIncludesSelector:selector.
+ (selector notNil or:[ method notNil ]) ifTrue:[
+ "/ implementorClass := self searchClass whichClassIncludesSelector:selector.
"
kludge to avoid slow search for containing class
"
- (selector ~~ #doIt and:[selector ~~ #doIt:]) ifTrue:[
+ (method notNil
+ or:[ (selector ~~ #doIt and:[selector ~~ #doIt:]) ]) ifTrue:[
implementorClass := self methodClass.
implementorClass isNil ifTrue:[
"
@@ -1765,9 +1766,17 @@
kludge for doIt - these unbound methods are not
found in the classes methodDictionary
"
- (selector ~~ #doIt and:[selector ~~ #doIt:]) ifTrue:[
- "/ newString := newString , '>>>**NONE**'
- newString := newString , '(**NONE**)'
+ true "(selector ~~ #doIt and:[selector ~~ #doIt:])" ifTrue:[
+ "
+ kludge for methods invoked explicitly via valueWithReceiver...
+ "
+ (self sender notNil
+ and:[ self sender receiver isMethod
+ and:[ self sender selector startsWith:'valueWithReceiver:' ]]) ifTrue:[
+ newString := newString , '(**DIRECTED**)'
+ ] ifFalse:[
+ newString := newString , '(**NONE**)'
+ ]
]
]
].
@@ -2465,15 +2474,16 @@
!Context class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Context.st,v 1.178 2012-12-12 22:59:00 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Context.st,v 1.179 2013-01-24 15:22:59 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Context.st,v 1.178 2012-12-12 22:59:00 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Context.st,v 1.179 2013-01-24 15:22:59 cg Exp $'
!
version_SVN
^ '§ Id: Context.st 10643 2011-06-08 21:53:07Z vranyj1 §'
! !
+
Context initialize!
--- a/Date.st Wed Jan 23 10:08:55 2013 +0000
+++ b/Date.st Mon Jan 28 21:53:19 2013 +0000
@@ -800,7 +800,6 @@
"
! !
-
!Date class methodsFor:'change & update'!
update:something with:aParameter from:changedObject
@@ -1103,7 +1102,7 @@
"Modified: / 08-10-2006 / 14:22:06 / cg"
!
-indexOfMonth:aMonthString language:lang
+indexOfMonth:aMonthString language:languageOrNil
"given the name of a month (either string or symbol),
return the month-index (1 for jan; 12 for december).
The given string may be a full or abbreviated name,
@@ -1114,8 +1113,8 @@
|idx name langMonthNames langMonthAbbrevs|
- langMonthNames := self monthNamesForLanguage:lang.
- langMonthAbbrevs := self monthAbbrevsForLanguage:lang.
+ langMonthNames := self monthNamesForLanguage:languageOrNil.
+ langMonthAbbrevs := self monthAbbrevsForLanguage:languageOrNil.
name := aMonthString asLowercase.
idx := langMonthAbbrevs indexOf:name.
@@ -1384,7 +1383,6 @@
^ self leapYear:yearInteger
! !
-
!Date class methodsFor:'private'!
abbreviatedMonthNamesForLanguage:languageOrNilForDefault
@@ -1642,7 +1640,6 @@
"
! !
-
!Date methodsFor:'Compatibility-ANSI'!
dayOfWeek
@@ -2728,7 +2725,6 @@
! !
-
!Date methodsFor:'obsolete'!
asAbsoluteTime
@@ -2799,7 +2795,6 @@
^ self addDays:days
! !
-
!Date methodsFor:'printing & storing'!
addPrintBindingsTo:aDictionary
@@ -3159,11 +3154,12 @@
!Date class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Date.st,v 1.144 2013-01-02 12:35:40 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Date.st,v 1.145 2013-01-25 13:34:56 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Date.st,v 1.144 2013-01-02 12:35:40 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Date.st,v 1.145 2013-01-25 13:34:56 cg Exp $'
! !
+
Date initialize!
--- a/Float.st Wed Jan 23 10:08:55 2013 +0000
+++ b/Float.st Mon Jan 28 21:53:19 2013 +0000
@@ -38,6 +38,10 @@
extern errno;
#endif
+#if !defined (WIN32)
+# include <locale.h>
+#endif
+
#if defined (_AIX)
# include <float.h>
#endif
@@ -284,15 +288,15 @@
%{ /* NOCONTEXT */
if (__isStringLike(aString) && __isSmallInteger(startIndex)) {
- char *cp = (char *)(__stringVal(aString));
- int idx = __intVal(startIndex) - 1;
- double atof();
- double val;
-
- if ((unsigned)idx < __stringSize(aString)) {
- val = atof(cp + idx);
- RETURN (__MKFLOAT(val));
- }
+ char *cp = (char *)(__stringVal(aString));
+ int idx = __intVal(startIndex) - 1;
+ double atof();
+ double val;
+
+ if ((unsigned)idx < __stringSize(aString)) {
+ val = atof(cp + idx);
+ RETURN (__MKFLOAT(val));
+ }
}
%}.
self primitiveFailed.
@@ -312,17 +316,17 @@
Float fastFromString:'hello123.45E4' at:1
Time millisecondsToRun:[
- 100000 timesRepeat:[
- Float readFrom:'123.45'
- ]
+ 100000 timesRepeat:[
+ Float readFrom:'123.45'
+ ]
]
"
"
Time millisecondsToRun:[
- 100000 timesRepeat:[
- Float fastFromString:'123.45' at:1
- ]
+ 100000 timesRepeat:[
+ Float fastFromString:'123.45' at:1
+ ]
]
"
!
@@ -371,7 +375,7 @@
num := super readFrom:aStringOrStream onError:nil.
num isNil ifTrue:[
- ^ exceptionBlock value
+ ^ exceptionBlock value
].
^ num asFloat
@@ -471,16 +475,16 @@
initialize
Pi isNil ifTrue:[
- DefaultPrintFormat := '.15'. "/ print 15 valid digits
- Pi := 3.14159265358979323846264338327950288419716939937510582097494459.
- Halfpi := Pi / 2.0.
- HalfpiNegative := Halfpi negated.
- Twopi := Pi * 2.0.
- E := 2.7182818284590452353602874713526625.
- Sqrt2 := 1.41421356237309504880168872420969808.
- RadiansPerDegree := Pi / 180.0.
- Ln2 := 0.69314718055994530941723212145817657.
- Ln10 := 10.0 ln.
+ DefaultPrintFormat := '.15'. "/ print 15 valid digits
+ Pi := 3.14159265358979323846264338327950288419716939937510582097494459.
+ Halfpi := Pi / 2.0.
+ HalfpiNegative := Halfpi negated.
+ Twopi := Pi * 2.0.
+ E := 2.7182818284590452353602874713526625.
+ Sqrt2 := 1.41421356237309504880168872420969808.
+ RadiansPerDegree := Pi / 180.0.
+ Ln2 := 0.69314718055994530941723212145817657.
+ Ln10 := 10.0 ln.
].
"
@@ -594,7 +598,7 @@
%}
"
- self getFPUControl
+ self getFPUControl
"
!
@@ -613,7 +617,7 @@
%}
"
- self setFPUControl
+ self setFPUControl
"
! !
@@ -716,13 +720,18 @@
__qMKFLOAT(newFloat, result);
RETURN ( newFloat );
}
- if (__isFloatLike(aNumber)) {
- result = __floatVal(self) * __floatVal(aNumber);
- goto retResult;
- }
- if (__isShortFloat(aNumber)) {
- result = __floatVal(self) * (double)(__shortFloatVal(aNumber));
- goto retResult;
+ /* knowing that aNumber is not a SmallInt, we only need to check for nil;
+ * then can use qIsXXX macros which saves us some checks
+ */
+ if (aNumber != nil) {
+ if (__qIsFloatLike(aNumber)) {
+ result = __floatVal(self) * __floatVal(aNumber);
+ goto retResult;
+ }
+ if (__qIsShortFloat(aNumber)) {
+ result = __floatVal(self) * (double)(__shortFloatVal(aNumber));
+ goto retResult;
+ }
}
%}.
^ aNumber productFromFloat:self
@@ -751,13 +760,18 @@
__qMKFLOAT(newFloat, result);
RETURN ( newFloat );
}
- if (__isFloatLike(aNumber)) {
- result = __floatVal(self) + __floatVal(aNumber);
- goto retResult;
- }
- if (__isShortFloat(aNumber)) {
- result = __floatVal(self) + (double)(__shortFloatVal(aNumber));
- goto retResult;
+ /* knowing that aNumber is not a SmallInt, we only need to check for nil;
+ * then can use qIsXXX macros which saves us some checks
+ */
+ if (aNumber != nil) {
+ if (__qIsFloatLike(aNumber)) {
+ result = __floatVal(self) + __floatVal(aNumber);
+ goto retResult;
+ }
+ if (__qIsShortFloat(aNumber)) {
+ result = __floatVal(self) + (double)(__shortFloatVal(aNumber));
+ goto retResult;
+ }
}
%}.
^ aNumber sumFromFloat:self
@@ -786,13 +800,18 @@
__qMKFLOAT(newFloat, result);
RETURN ( newFloat );
}
- if (__isFloatLike(aNumber)) {
- result = __floatVal(self) - __floatVal(aNumber);
- goto retResult;
- }
- if (__isShortFloat(aNumber)) {
- result = __floatVal(self) - (double)(__shortFloatVal(aNumber));
- goto retResult;
+ /* knowing that aNumber is not a SmallInt, we only need to check for nil;
+ * then can use qIsXXX macros which saves us some checks
+ */
+ if (aNumber != nil) {
+ if (__qIsFloatLike(aNumber)) {
+ result = __floatVal(self) - __floatVal(aNumber);
+ goto retResult;
+ }
+ if (__qIsShortFloat(aNumber)) {
+ result = __floatVal(self) - (double)(__shortFloatVal(aNumber));
+ goto retResult;
+ }
}
%}.
^ aNumber differenceFromFloat:self
@@ -845,6 +864,65 @@
^ aNumber quotientFromFloat:self
!
+rem: aNumber
+ "return the floating point remainder of the receiver and the argument, aNumber"
+
+%{ /* NOCONTEXT */
+
+ /*
+ * notice:
+ * the following inline code handles some common cases,
+ * and exists as an optimization, to speed up those cases.
+ *
+ * Conceptionally, (and for most other argument types),
+ * mixed arithmetic is implemented by double dispatching
+ * (see the message send at the bottom)
+ */
+ OBJ newFloat;
+ double result, val;
+
+ if (__isSmallInteger(aNumber)) {
+ if (aNumber != __mkSmallInteger(0)) {
+ val = (double)__intVal(aNumber);
+computeResult:
+ result = fmod(__floatVal(self), val) ;
+ __qMKFLOAT(newFloat, result);
+ RETURN ( newFloat );
+ }
+ } else if (__isFloatLike(aNumber)) {
+ val = __floatVal(aNumber);
+ if (val != 0.0) {
+ goto computeResult;
+ }
+ } else if (__isShortFloat(aNumber)) {
+ val = (double)(__shortFloatVal(aNumber));
+ if (val != 0.0) {
+ goto computeResult;
+ }
+#ifdef LONGFLOAT_KNOWN_HERE
+ } else if (__isLongFloat(aNumber)) {
+ long double lval;
+
+ lval = (long double)(__longFloatVal(aNumber));
+ if (val != 0.0) {
+ long double lResult;
+
+ lResult = fmodl((long double)(__floatVal(self)), lval);
+ __qMKLFLOAT(newFloat, lResult);
+ RETURN (newFloat);
+ }
+#endif
+ }
+%}.
+ ((aNumber == 0) or:[aNumber = 0.0]) ifTrue:[
+ "
+ No, you shalt not divide by zero
+ "
+ ^ ZeroDivide raiseRequestWith:thisContext.
+ ].
+ ^ aNumber remainderFromFloat:self
+!
+
abs
"return the absolute value of the receiver
reimplemented here for speed"
@@ -1374,26 +1452,26 @@
if (val > 0.0)
#endif
{
- __threadErrno = 0;
- rslt = log10(val);
- if (! isnan(rslt)) /* Currently all our systems support isnan() */
- {
- if (__threadErrno == 0) {
- __qMKFLOAT(newFloat, rslt);
- RETURN ( newFloat );
- }
- }
+ __threadErrno = 0;
+ rslt = log10(val);
+ if (! isnan(rslt)) /* Currently all our systems support isnan() */
+ {
+ if (__threadErrno == 0) {
+ __qMKFLOAT(newFloat, rslt);
+ RETURN ( newFloat );
+ }
+ }
}
%}.
"
an invalid value for logarithm
"
^ self class
- raise:#domainErrorSignal
- receiver:self
- selector:#log10
- arguments:#()
- errorString:'bad receiver in log10'
+ raise:#domainErrorSignal
+ receiver:self
+ selector:#log10
+ arguments:#()
+ errorString:'bad receiver in log10'
"Modified: / 16.11.2001 / 14:14:33 / cg"
!
@@ -1494,12 +1572,12 @@
int len;
if (__isStringLike(@global(DefaultPrintFormat))) {
- fmt = (char *) __stringVal(@global(DefaultPrintFormat));
+ fmt = (char *) __stringVal(@global(DefaultPrintFormat));
} else {
- /*
- * in case we get called before #initialize ...
- */
- fmt = ".15";
+ /*
+ * in case we get called before #initialize ...
+ */
+ fmt = ".15";
}
/*
@@ -1518,33 +1596,33 @@
__END_PROTECT_REGISTERS__
if (len >= 0 && len < sizeof(buffer)-3) {
- /*
- * kludge to make integral float f prints as "f.0" (not as "f" as printf does)
- * (i.e. look if string contains '.' or 'e' and append '.0' if not)
- */
- for (cp = buffer; *cp; cp++) {
- if ((*cp == '.') || (*cp == ',') || (*cp == 'E') || (*cp == 'e')) break;
- }
- if (!*cp && (cp[-1] >= '0') && (cp[-1] <= '9')) {
- if (__isCharacter(@global(DecimalPointCharacterForPrinting))) {
- *cp++ = __intVal(__characterVal(@global(DecimalPointCharacterForPrinting)));
- } else {
- *cp++ = '.';
- }
- *cp++ = '0';
- *cp = '\0';
- } else {
- if (cp && ((*cp == '.') || (*cp == ','))) {
- if (__isCharacter(@global(DecimalPointCharacterForPrinting))) {
- *cp = __intVal(__characterVal(@global(DecimalPointCharacterForPrinting)));
- }
- }
- }
-
- s = __MKSTRING(buffer);
- if (s != nil) {
- RETURN (s);
- }
+ /*
+ * kludge to make integral float f prints as "f.0" (not as "f" as printf does)
+ * (i.e. look if string contains '.' or 'e' and append '.0' if not)
+ */
+ for (cp = buffer; *cp; cp++) {
+ if ((*cp == '.') || (*cp == ',') || (*cp == 'E') || (*cp == 'e')) break;
+ }
+ if (!*cp && (cp[-1] >= '0') && (cp[-1] <= '9')) {
+ if (__isCharacter(@global(DecimalPointCharacterForPrinting))) {
+ *cp++ = __intVal(__characterVal(@global(DecimalPointCharacterForPrinting)));
+ } else {
+ *cp++ = '.';
+ }
+ *cp++ = '0';
+ *cp = '\0';
+ } else {
+ if (cp && ((*cp == '.') || (*cp == ','))) {
+ if (__isCharacter(@global(DecimalPointCharacterForPrinting))) {
+ *cp = __intVal(__characterVal(@global(DecimalPointCharacterForPrinting)));
+ }
+ }
+ }
+
+ s = __MKSTRING(buffer);
+ if (s != nil) {
+ RETURN (s);
+ }
}
%}.
"
@@ -1557,24 +1635,24 @@
^ ObjectMemory allocationFailureSignal raise.
"
- 1.0 printString
- 1.234 printString
- 1e10 printString
- 1.2e3 printString
- 1.2e30 printString
- (1.0 uncheckedDivide:0) printString
- (0.0 uncheckedDivide:0) printString
- self pi printString.
-
- DecimalPointCharacter := $,.
- 1.234 printString.
- 1.0 printString.
- 1e10 printString.
- 1.2e3 printString.
- 1.2e30 printString.
- (1.0 uncheckedDivide:0) printString.
- (0.0 uncheckedDivide:0) printString.
- DecimalPointCharacter := $.
+ 1.0 printString
+ 1.234 printString
+ 1e10 printString
+ 1.2e3 printString
+ 1.2e30 printString
+ (1.0 uncheckedDivide:0) printString
+ (0.0 uncheckedDivide:0) printString
+ self pi printString.
+
+ DecimalPointCharacter := $,.
+ 1.234 printString.
+ 1.0 printString.
+ 1e10 printString.
+ 1.2e3 printString.
+ 1.2e30 printString.
+ (1.0 uncheckedDivide:0) printString.
+ (0.0 uncheckedDivide:0) printString.
+ DecimalPointCharacter := $.
"
!
@@ -1597,23 +1675,23 @@
int len;
if (__isStringLike(formatString)) {
- /*
- * actually only needed on sparc: since thisContext is
- * in a global register, which gets destroyed by printf,
- * manually save it here - very stupid ...
- */
- __BEGIN_PROTECT_REGISTERS__
-
- len = snprintf(buffer, sizeof(buffer), __stringVal(formatString), __floatVal(self));
-
- __END_PROTECT_REGISTERS__
-
- if (len < 0) goto fail;
-
- s = __MKSTRING_L(buffer, len);
- if (s != nil) {
- RETURN (s);
- }
+ /*
+ * actually only needed on sparc: since thisContext is
+ * in a global register, which gets destroyed by printf,
+ * manually save it here - very stupid ...
+ */
+ __BEGIN_PROTECT_REGISTERS__
+
+ len = snprintf(buffer, sizeof(buffer), __stringVal(formatString), __floatVal(self));
+
+ __END_PROTECT_REGISTERS__
+
+ if (len < 0) goto fail;
+
+ s = __MKSTRING_L(buffer, len);
+ if (s != nil) {
+ RETURN (s);
+ }
}
fail: ;
%}.
@@ -1653,23 +1731,23 @@
__END_PROTECT_REGISTERS__
if (len >= 0 && len < sizeof(buffer)-3) {
- /*
- * kludge to make integral float f prints as "f.0" (not as "f" as printf does)
- * (i.e. look if string contains '.' or 'e' and append '.0' if not)
- */
- for (cp = buffer; *cp; cp++) {
- if ((*cp == '.') || (*cp == ',') || (*cp == 'E') || (*cp == 'e')) break;
- }
- if (!*cp && (cp[-1] >= '0') && (cp[-1] <= '9')) {
- *cp++ = '.';
- *cp++ = '0';
- *cp = '\0';
- }
-
- s = __MKSTRING(buffer);
- if (s != nil) {
- RETURN (s);
- }
+ /*
+ * kludge to make integral float f prints as "f.0" (not as "f" as printf does)
+ * (i.e. look if string contains '.' or 'e' and append '.0' if not)
+ */
+ for (cp = buffer; *cp; cp++) {
+ if ((*cp == '.') || (*cp == ',') || (*cp == 'E') || (*cp == 'e')) break;
+ }
+ if (!*cp && (cp[-1] >= '0') && (cp[-1] <= '9')) {
+ *cp++ = '.';
+ *cp++ = '0';
+ *cp = '\0';
+ }
+
+ s = __MKSTRING(buffer);
+ if (s != nil) {
+ RETURN (s);
+ }
}
%}.
"
@@ -1682,26 +1760,26 @@
^ ObjectMemory allocationFailureSignal raise.
"
- 1.0 storeString
- 1.234 storeString
- 1e10 storeString
- 1.2e3 storeString
- 1.2e30 storeString
- Float pi storeString
- (1.0 uncheckedDivide:0) storeString
- (0.0 uncheckedDivide:0) storeString
+ 1.0 storeString
+ 1.234 storeString
+ 1e10 storeString
+ 1.2e3 storeString
+ 1.2e30 storeString
+ Float pi storeString
+ (1.0 uncheckedDivide:0) storeString
+ (0.0 uncheckedDivide:0) storeString
notice that the storeString is NOT affected by DecimalPointCharacterForPrinting:
- DecimalPointCharacterForPrinting := $,.
- 1.234 storeString.
- 1.0 storeString.
- 1e10 storeString.
- 1.2e3 storeString.
- 1.2e30 storeString.
- (1.0 uncheckedDivide:0) storeString.
- (0.0 uncheckedDivide:0) storeString.
- DecimalPointCharacterForPrinting := $.
+ DecimalPointCharacterForPrinting := $,.
+ 1.234 storeString.
+ 1.0 storeString.
+ 1e10 storeString.
+ 1.2e3 storeString.
+ 1.2e30 storeString.
+ (1.0 uncheckedDivide:0) storeString.
+ (0.0 uncheckedDivide:0) storeString.
+ DecimalPointCharacterForPrinting := $.
"
! !
@@ -1829,20 +1907,20 @@
__threadErrno = 0;
frac = frexp(__floatVal(self), &exp);
if (__threadErrno == 0) {
- RETURN (__mkSmallInteger(exp));
+ RETURN (__mkSmallInteger(exp));
}
%}.
^ self primitiveFailed
"
- 1.0 exponent
- 2.0 exponent
- 3.0 exponent
- 4.0 exponent
- 0.5 exponent
- 0.4 exponent
- 0.25 exponent
- 0.2 exponent
+ 1.0 exponent
+ 2.0 exponent
+ 3.0 exponent
+ 4.0 exponent
+ 0.5 exponent
+ 0.4 exponent
+ 0.25 exponent
+ 0.2 exponent
0.00000011111 exponent
"
!
@@ -2778,11 +2856,11 @@
!Float class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Float.st,v 1.182 2013-01-04 15:36:58 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Float.st,v 1.185 2013-01-26 15:04:17 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Float.st,v 1.182 2013-01-04 15:36:58 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Float.st,v 1.185 2013-01-26 15:04:17 cg Exp $'
! !
--- a/FloatArray.st Wed Jan 23 10:08:55 2013 +0000
+++ b/FloatArray.st Mon Jan 28 21:53:19 2013 +0000
@@ -40,13 +40,13 @@
See documentation in DoubleArray for more information.
[memory requirements:]
- OBJ-HEADER + (size * float-size)
+ OBJ-HEADER + (size * float-size)
[See also:]
- DoubleArray Array
+ DoubleArray Array
[author:]
- Claus Gittinger
+ Claus Gittinger
"
! !
@@ -70,7 +70,7 @@
^ self clone *= anObject
"
- #(1 2 3 4) asFloatArray * 3
+ #(1 2 3 4) asFloatArray * 3
#(1 2 3 4) asFloatArray * #(1 2 3 4) asFloatArray
"
!
@@ -82,8 +82,8 @@
^ self clone += anObject
"
- #(1 2 3 4) asFloatArray + 3
- #(1 2 3 4) asFloatArray + #(1 2 3 4) asFloatArray
+ #(1 2 3 4) asFloatArray + 3
+ #(1 2 3 4) asFloatArray + #(1 2 3 4) asFloatArray
"
!
@@ -94,8 +94,8 @@
^ self clone -= anObject
"
- #(1 2 3 4) asFloatArray - 3
- #(1 2 3 4) asFloatArray - #(1 2 3 4) asFloatArray
+ #(1 2 3 4) asFloatArray - 3
+ #(1 2 3 4) asFloatArray - #(1 2 3 4) asFloatArray
"
"Created: / 30-05-2007 / 17:41:46 / cg"
@@ -108,8 +108,8 @@
^ self clone /= anObject
"
- #(1 2 3 4) asFloatArray / 3
- #(1 2 3 4) asFloatArray / #(1 2 3 4) asFloatArray
+ #(1 2 3 4) asFloatArray / 3
+ #(1 2 3 4) asFloatArray / #(1 2 3 4) asFloatArray
"
"Created: / 30-05-2007 / 17:46:05 / cg"
@@ -132,28 +132,28 @@
%{
if (__ClassInstPtr(__qClass(self))->c_ninstvars == __mkSmallInteger(0)) {
- int _sz = __floatArraySize(self);
- int i;
- float *_p = __FloatArrayInstPtr(self)->f_element;
+ INT _sz = __floatArraySize(self);
+ INT i;
+ float *_p = __FloatArrayInstPtr(self)->f_element;
- /* how about inline-mmx-asm for this ... */
- for (i=0; i<_sz; i++) {
- float f = _p[i];
+ /* how about inline-mmx-asm for this ... */
+ for (i=0; i<_sz; i++) {
+ float f = _p[i];
- if (f < 0) {
- _p[i] = -f;
- }
- }
- RETURN (self);
+ if (f < 0) {
+ _p[i] = -f;
+ }
+ }
+ RETURN (self);
}
-%}.
+%}.
1 to: self size do:[:i| self at: i put: (self at: i) abs].
"
|f|
f := FloatArray withAll:#(-1 2 -3 4 -5).
- f abs.
+ f abs.
f
"
@@ -168,21 +168,21 @@
if ((__ClassInstPtr(__qClass(self))->c_ninstvars == __mkSmallInteger(0))
&& __isFloats(floatArray)
&& (__ClassInstPtr(__qClass(floatArray))->c_ninstvars == __mkSmallInteger(0))) {
- int _sz1 = __floatArraySize(self);
- int _sz2 = __floatArraySize(floatArray);
- int i;
- float *_p1 = __FloatArrayInstPtr(self)->f_element;
- float *_p2 = __FloatArrayInstPtr(floatArray)->f_element;
+ INT _sz1 = __floatArraySize(self);
+ INT _sz2 = __floatArraySize(floatArray);
+ INT i;
+ float *_p1 = __FloatArrayInstPtr(self)->f_element;
+ float *_p2 = __FloatArrayInstPtr(floatArray)->f_element;
- if (_sz2 >= _sz1) {
- /* how about inline-mmx-asm for this ... */
- for (i=0; i<_sz1; i++) {
- _p1[i] += _p2[i];
- }
- }
- RETURN (self);
+ if (_sz2 >= _sz1) {
+ /* how about inline-mmx-asm for this ... */
+ for (i=0; i<_sz1; i++) {
+ _p1[i] += _p2[i];
+ }
+ }
+ RETURN (self);
}
-%}.
+%}.
1 to: self size do:[:i| self at: i put: (self at: i) + (floatArray at: i)].
"
@@ -191,7 +191,7 @@
f1 := FloatArray withAll:#(1 2 3 4 5).
f2 := FloatArray withAll:#(2 2 2 3 3).
f1 += f2.
- f1
+ f1
"
!
@@ -200,28 +200,28 @@
%{
if (__ClassInstPtr(__qClass(self))->c_ninstvars == __mkSmallInteger(0)) {
- int _sz1 = __floatArraySize(self);
- int i;
- float *_p1 = __FloatArrayInstPtr(self)->f_element;
- float v;
+ INT _sz1 = __floatArraySize(self);
+ INT i;
+ float *_p1 = __FloatArrayInstPtr(self)->f_element;
+ float v;
- if (__isFloat(aScalar)) {
- v = (float)(__floatVal(aScalar));
- } else if (__isShortFloat(aScalar)) {
- v = __shortFloatVal(aScalar);
- } else if (__isSmallInteger(aScalar)) {
- v = (float)(__intVal(aScalar));
- } else
- goto badArg;
+ if (__isFloat(aScalar)) {
+ v = (float)(__floatVal(aScalar));
+ } else if (__isShortFloat(aScalar)) {
+ v = __shortFloatVal(aScalar);
+ } else if (__isSmallInteger(aScalar)) {
+ v = (float)(__intVal(aScalar));
+ } else
+ goto badArg;
- /* how about inline-mmx-asm for this ... */
- for (i=0; i<_sz1; i++) {
- _p1[i] += v;
- }
- RETURN (self);
+ /* how about inline-mmx-asm for this ... */
+ for (i=0; i<_sz1; i++) {
+ _p1[i] += v;
+ }
+ RETURN (self);
}
badArg: ;
-%}.
+%}.
1 to: self size do:[:i| self at: i put: (self at: i) + aScalar].
"
@@ -229,11 +229,11 @@
f1 := FloatArray withAll:#(1 2 3 4 5).
f1 += 2.0.
- Transcript showCR:f1.
+ Transcript showCR:f1.
f1 += 2.0 asShortFloat.
- Transcript showCR:f1.
+ Transcript showCR:f1.
f1 += 2.
- Transcript showCR:f1.
+ Transcript showCR:f1.
"
!
@@ -245,19 +245,19 @@
if ((__ClassInstPtr(__qClass(self))->c_ninstvars == __mkSmallInteger(0))
&& __isFloats(floatArray)
&& (__ClassInstPtr(__qClass(floatArray))->c_ninstvars == __mkSmallInteger(0))) {
- int _sz1 = __floatArraySize(self);
- int _sz2 = __floatArraySize(floatArray);
- int i;
- float *_p1 = __FloatArrayInstPtr(self)->f_element;
- float *_p2 = __FloatArrayInstPtr(floatArray)->f_element;
+ INT _sz1 = __floatArraySize(self);
+ INT _sz2 = __floatArraySize(floatArray);
+ INT i;
+ float *_p1 = __FloatArrayInstPtr(self)->f_element;
+ float *_p2 = __FloatArrayInstPtr(floatArray)->f_element;
- if (_sz2 >= _sz1) {
- /* how about inline-mmx-asm for this ... */
- for (i=0; i<_sz1; i++) {
- _p1[i] /= _p2[i];
- }
- }
- RETURN (self);
+ if (_sz2 >= _sz1) {
+ /* how about inline-mmx-asm for this ... */
+ for (i=0; i<_sz1; i++) {
+ _p1[i] /= _p2[i];
+ }
+ }
+ RETURN (self);
}
%}.
1 to: self size do:[:i| self at: i put: (self at: i) / (floatArray at: i)].
@@ -268,7 +268,7 @@
f1 := FloatArray withAll:#(1 2 3 4 5).
f2 := FloatArray withAll:#(2 2 2 3 3).
f1 /= f2.
- f1
+ f1
"
"Modified: / 29-05-2007 / 16:01:34 / cg"
@@ -279,25 +279,25 @@
%{
if (__ClassInstPtr(__qClass(self))->c_ninstvars == __mkSmallInteger(0)) {
- int _sz1 = __floatArraySize(self);
- int i;
- float *_p1 = __FloatArrayInstPtr(self)->f_element;
- float v;
+ INT _sz1 = __floatArraySize(self);
+ INT i;
+ float *_p1 = __FloatArrayInstPtr(self)->f_element;
+ float v;
- if (__isFloat(aScalar)) {
- v = (float)(__floatVal(aScalar));
- } else if (__isShortFloat(aScalar)) {
- v = __shortFloatVal(aScalar);
- } else if (__isSmallInteger(aScalar)) {
- v = (float)(__intVal(aScalar));
- } else
- goto badArg;
+ if (__isFloat(aScalar)) {
+ v = (float)(__floatVal(aScalar));
+ } else if (__isShortFloat(aScalar)) {
+ v = __shortFloatVal(aScalar);
+ } else if (__isSmallInteger(aScalar)) {
+ v = (float)(__intVal(aScalar));
+ } else
+ goto badArg;
- /* how about inline-mmx-asm for this ... */
- for (i=0; i<_sz1; i++) {
- _p1[i] /= v;
- }
- RETURN (self);
+ /* how about inline-mmx-asm for this ... */
+ for (i=0; i<_sz1; i++) {
+ _p1[i] /= v;
+ }
+ RETURN (self);
}
badArg: ;
%}.
@@ -308,11 +308,11 @@
f1 := FloatArray withAll:#(1 2 3 4 5).
f1 /= 2.0.
- Transcript showCR:f1.
+ Transcript showCR:f1.
f1 /= 2.0 asShortFloat.
- Transcript showCR:f1.
+ Transcript showCR:f1.
f1 /= 2.
- Transcript showCR:f1.
+ Transcript showCR:f1.
"
"Modified: / 29-05-2007 / 16:01:39 / cg"
@@ -326,19 +326,19 @@
if ((__ClassInstPtr(__qClass(self))->c_ninstvars == __mkSmallInteger(0))
&& __isFloats(floatArray)
&& (__ClassInstPtr(__qClass(floatArray))->c_ninstvars == __mkSmallInteger(0))) {
- int _sz1 = __floatArraySize(self);
- int _sz2 = __floatArraySize(floatArray);
- int i;
- float *_p1 = __FloatArrayInstPtr(self)->f_element;
- float *_p2 = __FloatArrayInstPtr(floatArray)->f_element;
+ INT _sz1 = __floatArraySize(self);
+ INT _sz2 = __floatArraySize(floatArray);
+ INT i;
+ float *_p1 = __FloatArrayInstPtr(self)->f_element;
+ float *_p2 = __FloatArrayInstPtr(floatArray)->f_element;
- if (_sz2 >= _sz1) {
- /* how about inline-mmx-asm for this ... */
- for (i=0; i<_sz1; i++) {
- _p1[i] *= _p2[i];
- }
- }
- RETURN (self);
+ if (_sz2 >= _sz1) {
+ /* how about inline-mmx-asm for this ... */
+ for (i=0; i<_sz1; i++) {
+ _p1[i] *= _p2[i];
+ }
+ }
+ RETURN (self);
}
%}.
1 to: self size do:[:i| self at: i put: (self at: i) * (floatArray at: i)].
@@ -349,7 +349,7 @@
f1 := FloatArray withAll:#(1 2 3 4 5).
f2 := FloatArray withAll:#(2 2 2 3 3).
f1 *= f2.
- f1
+ f1
"
!
@@ -358,25 +358,25 @@
%{
if (__ClassInstPtr(__qClass(self))->c_ninstvars == __mkSmallInteger(0)) {
- int _sz1 = __floatArraySize(self);
- int i;
- float *_p1 = __FloatArrayInstPtr(self)->f_element;
- float v;
+ INT _sz1 = __floatArraySize(self);
+ INT i;
+ float *_p1 = __FloatArrayInstPtr(self)->f_element;
+ float v;
- if (__isFloat(aScalar)) {
- v = (float)(__floatVal(aScalar));
- } else if (__isShortFloat(aScalar)) {
- v = __shortFloatVal(aScalar);
- } else if (__isSmallInteger(aScalar)) {
- v = (float)(__intVal(aScalar));
- } else
- goto badArg;
+ if (__isFloat(aScalar)) {
+ v = (float)(__floatVal(aScalar));
+ } else if (__isShortFloat(aScalar)) {
+ v = __shortFloatVal(aScalar);
+ } else if (__isSmallInteger(aScalar)) {
+ v = (float)(__intVal(aScalar));
+ } else
+ goto badArg;
- /* how about inline-mmx-asm for this ... */
- for (i=0; i<_sz1; i++) {
- _p1[i] *= v;
- }
- RETURN (self);
+ /* how about inline-mmx-asm for this ... */
+ for (i=0; i<_sz1; i++) {
+ _p1[i] *= v;
+ }
+ RETURN (self);
}
badArg: ;
%}.
@@ -387,11 +387,11 @@
f1 := FloatArray withAll:#(1 2 3 4 5).
f1 *= 2.0.
- Transcript showCR:f1.
+ Transcript showCR:f1.
f1 *= 2.0 asShortFloat.
- Transcript showCR:f1.
+ Transcript showCR:f1.
f1 *= 2.
- Transcript showCR:f1.
+ Transcript showCR:f1.
"
!
@@ -400,27 +400,27 @@
%{
if (__ClassInstPtr(__qClass(self))->c_ninstvars == __mkSmallInteger(0)) {
- int _sz = __floatArraySize(self);
- int i;
- float *_p = __FloatArrayInstPtr(self)->f_element;
+ INT _sz = __floatArraySize(self);
+ INT i;
+ float *_p = __FloatArrayInstPtr(self)->f_element;
- /* how about inline-mmx-asm for this ... */
- for (i=0; i<_sz; i++) {
- float f = _p[i];
+ /* how about inline-mmx-asm for this ... */
+ for (i=0; i<_sz; i++) {
+ float f = _p[i];
- _p[i] = -f;
- }
- RETURN (self);
+ _p[i] = -f;
+ }
+ RETURN (self);
}
-%}.
+%}.
1 to: self size do:[:i| self at: i put: (self at: i) negated].
"
|f|
f := FloatArray withAll:#(-1 2 -3 4 -5).
- f negated.
- f
+ f negated.
+ f
"
"Created: / 30-05-2007 / 17:51:29 / cg"
@@ -434,21 +434,21 @@
if ((__ClassInstPtr(__qClass(self))->c_ninstvars == __mkSmallInteger(0))
&& __isFloats(floatArray)
&& (__ClassInstPtr(__qClass(floatArray))->c_ninstvars == __mkSmallInteger(0))) {
- int _sz1 = __floatArraySize(self);
- int _sz2 = __floatArraySize(floatArray);
- int i;
- float *_p1 = __FloatArrayInstPtr(self)->f_element;
- float *_p2 = __FloatArrayInstPtr(floatArray)->f_element;
+ INT _sz1 = __floatArraySize(self);
+ INT _sz2 = __floatArraySize(floatArray);
+ INT i;
+ float *_p1 = __FloatArrayInstPtr(self)->f_element;
+ float *_p2 = __FloatArrayInstPtr(floatArray)->f_element;
- if (_sz2 >= _sz1) {
- /* how about inline-mmx-asm for this ... */
- for (i=0; i<_sz1; i++) {
- _p1[i] -= _p2[i];
- }
- }
- RETURN (self);
+ if (_sz2 >= _sz1) {
+ /* how about inline-mmx-asm for this ... */
+ for (i=0; i<_sz1; i++) {
+ _p1[i] -= _p2[i];
+ }
+ }
+ RETURN (self);
}
-%}.
+%}.
1 to: self size do:[:i| self at: i put: (self at: i) - (floatArray at: i)].
"
@@ -457,7 +457,7 @@
f1 := FloatArray withAll:#(1 2 3 4 5).
f2 := FloatArray withAll:#(2 2 2 3 3).
f1 -= f2.
- f1
+ f1
"
"Created: / 30-05-2007 / 17:42:41 / cg"
@@ -468,28 +468,28 @@
%{
if (__ClassInstPtr(__qClass(self))->c_ninstvars == __mkSmallInteger(0)) {
- int _sz1 = __floatArraySize(self);
- int i;
- float *_p1 = __FloatArrayInstPtr(self)->f_element;
- float v;
+ INT _sz1 = __floatArraySize(self);
+ INT i;
+ float *_p1 = __FloatArrayInstPtr(self)->f_element;
+ float v;
- if (__isFloat(aScalar)) {
- v = (float)(__floatVal(aScalar));
- } else if (__isShortFloat(aScalar)) {
- v = __shortFloatVal(aScalar);
- } else if (__isSmallInteger(aScalar)) {
- v = (float)(__intVal(aScalar));
- } else
- goto badArg;
+ if (__isFloat(aScalar)) {
+ v = (float)(__floatVal(aScalar));
+ } else if (__isShortFloat(aScalar)) {
+ v = __shortFloatVal(aScalar);
+ } else if (__isSmallInteger(aScalar)) {
+ v = (float)(__intVal(aScalar));
+ } else
+ goto badArg;
- /* how about inline-mmx-asm for this ... */
- for (i=0; i<_sz1; i++) {
- _p1[i] -= v;
- }
- RETURN (self);
+ /* how about inline-mmx-asm for this ... */
+ for (i=0; i<_sz1; i++) {
+ _p1[i] -= v;
+ }
+ RETURN (self);
}
badArg: ;
-%}.
+%}.
1 to: self size do:[:i| self at: i put: (self at: i) - aScalar].
"
@@ -497,11 +497,11 @@
f1 := FloatArray withAll:#(1 2 3 4 5).
f1 -= 2.0.
- Transcript showCR:f1.
+ Transcript showCR:f1.
f1 -= 2.0 asShortFloat.
- Transcript showCR:f1.
+ Transcript showCR:f1.
f1 -= 2.
- Transcript showCR:f1.
+ Transcript showCR:f1.
"
"Created: / 30-05-2007 / 17:43:06 / cg"
@@ -514,22 +514,22 @@
The argument may either be a scalar or another vector"
^ anObject isNumber
- ifTrue:[self primMulScalar: anObject asFloat]
- ifFalse:[self primMulArray: anObject]
+ ifTrue:[self primMulScalar: anObject asFloat]
+ ifFalse:[self primMulArray: anObject]
"
|f|
f := #(1 2 3 4) asFloatArray.
f *= 3.
- f
+ f
"
"
|f|
f := #(1 2 3 4) asFloatArray.
f *= #(1 2 3 4) asFloatArray.
- f
+ f
"
!
@@ -538,22 +538,22 @@
The argument may either be a scalar or another vector"
^ anObject isNumber
- ifTrue:[self primAddScalar: anObject asFloat]
- ifFalse:[self primAddArray: anObject]
+ ifTrue:[self primAddScalar: anObject asFloat]
+ ifFalse:[self primAddArray: anObject]
"
|f|
f := #(1 2 3 4) asFloatArray.
f += 3.
- f
+ f
"
"
|f|
f := #(1 2 3 4) asFloatArray.
f += #(1 2 3 4) asFloatArray.
- f
+ f
"
!
@@ -562,22 +562,22 @@
The argument may either be a scalar or another vector"
^ anObject isNumber
- ifTrue:[self primSubtractScalar: anObject asFloat]
- ifFalse:[self primSubtractArray: anObject]
+ ifTrue:[self primSubtractScalar: anObject asFloat]
+ ifFalse:[self primSubtractArray: anObject]
"
|f|
f := #(1 2 3 4) asFloatArray.
f -= 3.
- f
+ f
"
"
|f|
f := #(1 2 3 4) asFloatArray.
f += #(1 2 3 4) asFloatArray.
- f
+ f
"
"Created: / 30-05-2007 / 17:42:13 / cg"
@@ -588,8 +588,8 @@
The argument may either be a scalar or another vector"
^ anObject isNumber
- ifTrue:[self primDivScalar: anObject asFloat]
- ifFalse:[self primDivArray: anObject]
+ ifTrue:[self primDivScalar: anObject asFloat]
+ ifFalse:[self primDivArray: anObject]
"Modified: / 30-05-2007 / 17:45:46 / cg"
! !
@@ -604,13 +604,13 @@
newArr := self class new:(self size).
%{
if (__ClassInstPtr(__qClass(self))->c_ninstvars == __mkSmallInteger(0)) {
- int _sz = __floatArraySize(self);
+ INT _sz = __floatArraySize(self);
- bcopy(__FloatArrayInstPtr(self)->f_element,
- __FloatArrayInstPtr(newArr)->f_element,
- sizeof(float) * _sz);
+ bcopy(__FloatArrayInstPtr(self)->f_element,
+ __FloatArrayInstPtr(newArr)->f_element,
+ sizeof(float) * _sz);
- RETURN (newArr);
+ RETURN (newArr);
}
%}.
newArr replaceFrom:1 to:self size with:self startingAt:1.
@@ -620,7 +620,7 @@
|f1 f2|
f1 := FloatArray withAll:#(1 2 3 4 5).
- f1 clone
+ f1 clone
"
!
@@ -629,40 +629,40 @@
%{
if (__ClassInstPtr(__qClass(self))->c_ninstvars == __mkSmallInteger(0)) {
- if (__bothSmallInteger(start, stop)) {
- int __start = __intVal(start) - 1;
- int __stop = __intVal(stop) - 1 ;
+ if (__bothSmallInteger(start, stop)) {
+ INT __start = __intVal(start) - 1;
+ INT __stop = __intVal(stop) - 1 ;
- if (__stop >= __start) {
- int __sz = __floatArraySize(self);
+ if (__stop >= __start) {
+ INT __sz = __floatArraySize(self);
- if (((unsigned)__start < __sz)
- && ((unsigned)__stop < __sz)) {
- int __n = __stop - __start + 1;
- OBJ __nObj;
+ if (((unsigned INT)__start < __sz)
+ && ((unsigned INT)__stop < __sz)) {
+ INT __n = __stop - __start + 1;
+ OBJ __nObj;
- __nObj = __STX___new(sizeof(struct __FloatArray) + (__n - 1) * sizeof(float));
- if (__nObj != nil) {
- __objPtr(__nObj)->o_class = __qClass(self);
- __STORE(__nObj, __qClass(self));
- bcopy(__FloatArrayInstPtr(self)->f_element + __start,
- __FloatArrayInstPtr(__nObj)->f_element,
- sizeof(float) * __n);
- RETURN(__nObj);
- }
- }
- }
- }
+ __nObj = __STX___new(sizeof(struct __FloatArray) + (__n - 1) * sizeof(float));
+ if (__nObj != nil) {
+ __objPtr(__nObj)->o_class = __qClass(self);
+ __STORE(__nObj, __qClass(self));
+ bcopy(__FloatArrayInstPtr(self)->f_element + __start,
+ __FloatArrayInstPtr(__nObj)->f_element,
+ sizeof(float) * __n);
+ RETURN(__nObj);
+ }
+ }
+ }
+ }
}
-%}.
+%}.
^ super copyFrom:start to:stop
"
|f1 f2|
f1 := FloatArray withAll:#(1 2 3 4 5 6).
- f2 := f1 copyFrom:2 to:4.
- f2
+ f2 := f1 copyFrom:2 to:4.
+ f2
"
!
@@ -671,32 +671,32 @@
if ((__ClassInstPtr(__qClass(self))->c_ninstvars == __mkSmallInteger(0))
&& __isFloats(aCollection)
&& (__ClassInstPtr(__qClass(aCollection))->c_ninstvars == __mkSmallInteger(0))) {
- if (__bothSmallInteger(start, stop)
- && __isSmallInteger(replStart)) {
- int __start = __intVal(start) - 1;
- int __stop = __intVal(stop) - 1 ;
- int __replStart = __intVal(replStart) - 1 ;
+ if (__bothSmallInteger(start, stop)
+ && __isSmallInteger(replStart)) {
+ INT __start = __intVal(start) - 1;
+ INT __stop = __intVal(stop) - 1 ;
+ INT __replStart = __intVal(replStart) - 1 ;
- if (__stop >= __start) {
- int __sz = __floatArraySize(self);
- int __otherSz = __floatArraySize(aCollection);
- int __replStop = __replStart + (__stop-__start);
+ if (__stop >= __start) {
+ INT __sz = __floatArraySize(self);
+ INT __otherSz = __floatArraySize(aCollection);
+ INT __replStop = __replStart + (__stop-__start);
- if (((unsigned)__start < __sz)
- && ((unsigned)__stop < __sz)
- && ((unsigned)__replStart < __otherSz)
- && ((unsigned)__replStop < __otherSz)) {
- int __n = __stop - __start + 1;
+ if (((unsigned INT)__start < __sz)
+ && ((unsigned INT)__stop < __sz)
+ && ((unsigned INT)__replStart < __otherSz)
+ && ((unsigned INT)__replStop < __otherSz)) {
+ INT __n = __stop - __start + 1;
- if (aCollection != self) {
- bcopy(&(__FloatArrayInstPtr(aCollection)->f_element[__replStart]),
- &(__FloatArrayInstPtr(self)->f_element[__start]),
- sizeof(float) * __n);
- RETURN(self);
- }
- }
- }
- }
+ if (aCollection != self) {
+ bcopy(&(__FloatArrayInstPtr(aCollection)->f_element[__replStart]),
+ &(__FloatArrayInstPtr(self)->f_element[__start]),
+ sizeof(float) * __n);
+ RETURN(self);
+ }
+ }
+ }
+ }
}
%}.
^ super replaceFrom:start to:stop with:aCollection startingAt:replStart
@@ -706,7 +706,7 @@
f1 := (1 to:5) asFloatArray.
f2 := #(10 9 8 7 6) asFloatArray.
- f1 replaceFrom:1 to:3 with:f2 startingAt:3
+ f1 replaceFrom:1 to:3 with:f2 startingAt:3
"
! !
@@ -731,31 +731,31 @@
|f1|
f1 := FloatArray withAll:#(1 2 3 4 5).
- f1 absMax
+ f1 absMax
"
"
|f1|
f1 := FloatArray withAll:#(5 4 3 2 1).
- f1 absMax
+ f1 absMax
"
"
|f1|
f1 := FloatArray withAll:#(5 -4 3 2 1).
- f1 absMax
+ f1 absMax
"
"
|f1|
f1 := FloatArray withAll:#(5 -5 3 2 1).
- f1 absMax
+ f1 absMax
"
"
|f1|
f1 := FloatArray withAll:#(5 -6 3 2 1).
- f1 absMax
+ f1 absMax
"
!
@@ -764,15 +764,15 @@
!
length
- "Return the length of the receiver interpreted as vector
+ "Return the length of the receiver interpreted as vector
(that is the length of the vector from 0.0 @ 0.0 @ ... @ 0.0
to the point in the n-dimensional space represented by the receiver)"
^ self squaredLength sqrt
"
- #(10.0 10.0) asFloatArray length
- #(10.0 10.0 10.0) asFloatArray length
+ #(10.0 10.0) asFloatArray length
+ #(10.0 10.0 10.0) asFloatArray length
"
!
@@ -781,28 +781,28 @@
redefined for speed"
%{
if (__ClassInstPtr(__qClass(self))->c_ninstvars == __mkSmallInteger(0)) {
- int _sz = __floatArraySize(self);
+ INT _sz = __floatArraySize(self);
- if (_sz > 0) {
- float *_p = __FloatArrayInstPtr(self)->f_element;
- float _max;
+ if (_sz > 0) {
+ float *_p = __FloatArrayInstPtr(self)->f_element;
+ float _max;
- _max = _p[0];
- if (_sz > 1) {
- int _i;
- float _prev, _this;
+ _max = _p[0];
+ if (_sz > 1) {
+ INT _i;
+ float _prev, _this;
- /* how about inline-mmx-asm for this ... */
- _this = _p[1];
- for (_i=2; _i<_sz; _i++) {
- _prev = _this;
- _this = _p[_i];
- if (_prev > _max) _max = _prev;
- }
- if (_this > _max) _max = _this;
- }
- RETURN (__MKFLOAT(_max));
- }
+ /* how about inline-mmx-asm for this ... */
+ _this = _p[1];
+ for (_i=2; _i<_sz; _i++) {
+ _prev = _this;
+ _this = _p[_i];
+ if (_prev > _max) _max = _prev;
+ }
+ if (_this > _max) _max = _this;
+ }
+ RETURN (__MKFLOAT(_max));
+ }
}
%}.
^ super max
@@ -817,13 +817,13 @@
|f1|
f1 := FloatArray withAll:#(1 2 3 4 5).
- f1 max
+ f1 max
"
"
|f1|
f1 := FloatArray withAll:#(5 4 3 2 1).
- f1 max
+ f1 max
"
!
@@ -832,28 +832,28 @@
redefined for speed"
%{
if (__ClassInstPtr(__qClass(self))->c_ninstvars == __mkSmallInteger(0)) {
- int _sz = __floatArraySize(self);
+ INT _sz = __floatArraySize(self);
- if (_sz > 0) {
- float *_p = __FloatArrayInstPtr(self)->f_element;
- float _min;
+ if (_sz > 0) {
+ float *_p = __FloatArrayInstPtr(self)->f_element;
+ float _min;
- _min = _p[0];
- if (_sz > 1) {
- int _i;
- float _prev, _this;
+ _min = _p[0];
+ if (_sz > 1) {
+ INT _i;
+ float _prev, _this;
- /* how about inline-mmx-asm for this ... */
- _this = _p[1];
- for (_i=2; _i<_sz; _i++) {
- _prev = _this;
- _this = _p[_i];
- if (_prev < _min) _min = _prev;
- }
- if (_this < _min) _min = _this;
- }
- RETURN (__MKFLOAT(_min));
- }
+ /* how about inline-mmx-asm for this ... */
+ _this = _p[1];
+ for (_i=2; _i<_sz; _i++) {
+ _prev = _this;
+ _this = _p[_i];
+ if (_prev < _min) _min = _prev;
+ }
+ if (_this < _min) _min = _this;
+ }
+ RETURN (__MKFLOAT(_min));
+ }
}
%}.
^ super min
@@ -868,13 +868,13 @@
|f1|
f1 := FloatArray withAll:#(1 2 3 4 5).
- f1 min
+ f1 min
"
"
|f1|
f1 := FloatArray withAll:#(5 4 3 2 1).
- f1 min
+ f1 min
"
!
@@ -886,51 +886,51 @@
%{
if (__ClassInstPtr(__qClass(self))->c_ninstvars == __mkSmallInteger(0)) {
- int _sz = __floatArraySize(self);
- if (_sz > 0) {
- int _i;
- float *_p = __FloatArrayInstPtr(self)->f_element;
- float _min, _max;
+ INT _sz = __floatArraySize(self);
+ if (_sz > 0) {
+ INT _i;
+ float *_p = __FloatArrayInstPtr(self)->f_element;
+ float _min, _max;
- _min = _max = _p[0];
+ _min = _max = _p[0];
#ifdef PRE_4_OCT_2011
- if (_sz > 1) {
- float _this = _p[1];
- float _prev;
+ if (_sz > 1) {
+ float _this = _p[1];
+ float _prev;
- /* how about inline-mmx-asm for this ... */
- for (_i=2; _i<_sz; _i++) {
- _prev = _this;
- _this = _p[_i];
- if (_prev < _min) {
- _min = _prev;
- } else if (_prev > _max) {
- _max = _prev;
- }
- }
- if (_this < _min) {
- _min = _this;
- } else if (_this > _max) {
- _max = _this;
- }
- }
+ /* how about inline-mmx-asm for this ... */
+ for (_i=2; _i<_sz; _i++) {
+ _prev = _this;
+ _this = _p[_i];
+ if (_prev < _min) {
+ _min = _prev;
+ } else if (_prev > _max) {
+ _max = _prev;
+ }
+ }
+ if (_this < _min) {
+ _min = _this;
+ } else if (_this > _max) {
+ _max = _this;
+ }
+ }
#else
- for (_i=_sz-1; _i>0; _i-=2) {
- float _v1 = _p[_i];
- float _v2 = _p[_i-1];
- if (_v1 < _v2) {
- if (_v1 < _min) _min = _v1;
- if (_v2 > _max) _max = _v2;
- } else {
- if (_v2 < _min) _min = _v2;
- if (_v1 > _max) _max = _v1;
- }
- }
+ for (_i=_sz-1; _i>0; _i-=2) {
+ float _v1 = _p[_i];
+ float _v2 = _p[_i-1];
+ if (_v1 < _v2) {
+ if (_v1 < _min) _min = _v1;
+ if (_v2 > _max) _max = _v2;
+ } else {
+ if (_v2 < _min) _min = _v2;
+ if (_v1 > _max) _max = _v1;
+ }
+ }
#endif
- min = __MKFLOAT(_min);
- max = __MKFLOAT(_max);
- RETURN (__ARRAY_WITH2(min, max));
- }
+ min = __MKFLOAT(_min);
+ max = __MKFLOAT(_max);
+ RETURN (__ARRAY_WITH2(min, max));
+ }
}
%}.
^ Array with:(super min) with:(super max)
@@ -939,19 +939,19 @@
|f1|
f1 := (1 to:10000) asFloatArray.
- Time millisecondsToRun:[ 1000 timesRepeat:[ f1 minMax ] ]
+ Time millisecondsToRun:[ 1000 timesRepeat:[ f1 minMax ] ]
"
"
|f1|
f1 := FloatArray withAll:#(1 2 3 4 5).
- f1 minMax
+ f1 minMax
"
"
|f1|
f1 := FloatArray withAll:#(5 4 3 2 1).
- f1 minMax
+ f1 minMax
"
"Modified (comment): / 07-10-2011 / 13:03:30 / cg"
@@ -980,20 +980,20 @@
if (__isFloats(aFloatVector)
&& (__ClassInstPtr(__qClass(self))->c_ninstvars == __mkSmallInteger(0))
&& (__ClassInstPtr(__qClass(aFloatVector))->c_ninstvars == __mkSmallInteger(0))) {
- int __mySize = __floatArraySize(self);
- int __otherSize = __floatArraySize(aFloatVector);
- if (__mySize == __otherSize) {
- float *__p1 = __FloatArrayInstPtr(self)->f_element;
- float *__p2 = __FloatArrayInstPtr(aFloatVector)->f_element;
- float __result = 0.0;
- int __i;
+ INT __mySize = __floatArraySize(self);
+ INT __otherSize = __floatArraySize(aFloatVector);
+ if (__mySize == __otherSize) {
+ float *__p1 = __FloatArrayInstPtr(self)->f_element;
+ float *__p2 = __FloatArrayInstPtr(aFloatVector)->f_element;
+ float __result = 0.0;
+ INT __i;
- /* how about inline-mmx-asm for this ... */
- for (__i=0; __i<__mySize; __i++) {
- __result = __result + (__p1[__i] * __p2[__i]);
- }
- RETURN (__MKFLOAT(__result));
- }
+ /* how about inline-mmx-asm for this ... */
+ for (__i=0; __i<__mySize; __i++) {
+ __result = __result + (__p1[__i] * __p2[__i]);
+ }
+ RETURN (__MKFLOAT(__result));
+ }
}
%}.
@@ -1001,7 +1001,7 @@
mySize = aFloatVector size ifFalse:[^self error:'Must be of equal size'].
result := 0.0.
1 to: mySize do:[:i|
- result := result + ((self at: i) * (aFloatVector at: i)).
+ result := result + ((self at: i) * (aFloatVector at: i)).
].
^result
@@ -1009,7 +1009,7 @@
|v|
v := #(2.0 2.0 1.0) asFloatArray.
- v dot:v.
+ v dot:v.
"
"Created: / 29-05-2007 / 13:13:39 / cg"
@@ -1018,9 +1018,9 @@
!FloatArray class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/FloatArray.st,v 1.30 2011-11-25 15:38:18 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/FloatArray.st,v 1.31 2013-01-23 18:03:01 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/FloatArray.st,v 1.30 2011-11-25 15:38:18 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/FloatArray.st,v 1.31 2013-01-23 18:03:01 cg Exp $'
! !
--- a/Integer.st Wed Jan 23 10:08:55 2013 +0000
+++ b/Integer.st Mon Jan 28 21:53:19 2013 +0000
@@ -817,7 +817,6 @@
"
! !
-
!Integer class methodsFor:'prime numbers'!
flushPrimeCache
@@ -1140,7 +1139,6 @@
^ self == Integer
! !
-
!Integer methodsFor:'Compatibility-Dolphin'!
& aNumber
@@ -4112,6 +4110,64 @@
"
!
+nextMultipleOf: n
+ "return the multiple of n at or above the receiver.
+ Useful for padding."
+
+ |rest|
+
+ rest := self \\ n.
+ rest == 0 ifTrue:[ ^ self ].
+ ^ self + (n - rest)
+
+ "
+ 1 nextMultipleOf: 4
+ 2 nextMultipleOf: 4
+ 3 nextMultipleOf: 4
+ 4 nextMultipleOf: 4
+
+ 22 nextMultipleOf: 4
+ "
+!
+
+nextPowerOf2
+ "return the power of 2 at or above the receiver.
+ Useful for padding."
+
+ |x t sh|
+
+ x := self - 1.
+ x := x bitOr: (x bitShift: -1).
+ x := x bitOr: (x bitShift: -2).
+ x := x bitOr: (x bitShift: -4).
+ x := x bitOr: (x bitShift: -8).
+ x := x bitOr: (t := x bitShift: -16).
+ t == 0 ifFalse:[
+ sh := -32.
+ [
+ x := x bitOr: (t := x bitShift: sh).
+ sh := sh + sh.
+ ] doWhile: [t ~~ 0]
+ ].
+ ^ x + 1
+
+ "
+ 1 nextPowerOf2
+ 2 nextPowerOf2
+ 3 nextPowerOf2
+ 4 nextPowerOf2
+ 5 nextPowerOf2
+ 6 nextPowerOf2
+ 7 nextPowerOf2
+ 8 nextPowerOf2
+
+ 22 nextPowerOf2
+ 12 factorial nextPowerOf2 isPowerOf:2
+ 100 factorial nextPowerOf2 isPowerOf:2
+ 1000 factorial nextPowerOf2 isPowerOf:2
+ "
+!
+
nextPrime
"return the next prime after the receiver"
@@ -4176,7 +4232,6 @@
"Created: / 09-01-2012 / 17:18:06 / cg"
! !
-
!Integer methodsFor:'special modulu arithmetic'!
add_32:anInteger
@@ -4863,11 +4918,12 @@
!Integer class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Integer.st,v 1.271 2012-11-04 15:05:51 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Integer.st,v 1.273 2013-01-22 14:10:37 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Integer.st,v 1.271 2012-11-04 15:05:51 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Integer.st,v 1.273 2013-01-22 14:10:37 cg Exp $'
! !
+
Integer initialize!
--- a/LongFloat.st Wed Jan 23 10:08:55 2013 +0000
+++ b/LongFloat.st Mon Jan 28 21:53:19 2013 +0000
@@ -38,6 +38,10 @@
extern errno;
#endif
+#if !defined (WIN32)
+# include <locale.h>
+#endif
+
#if defined (_AIX)
# include <float.h>
#endif
@@ -234,46 +238,46 @@
(thus, longFloat code is not guaranteed to be portable).
NO GARANTY:
- on systems which do not support 'long doubles', LongFloats are (silently)
- represented as 'doubles'.
+ on systems which do not support 'long doubles', LongFloats are (silently)
+ represented as 'doubles'.
Representation:
- gcc-i386:
- 80bit extended IEE floats stored in in 96bits (12bytes);
- 64 bit mantissa,
- 16 bit exponent,
- 19 decimal digits (approx)
-
- borland-i386 (WIN32):
- 80bit extended IEE floats stored in in 80bits (10bytes);
- 64 bit mantissa,
- 16 bit exponent,
- 19 decimal digits (approx)
-
- gcc-sparc:
- 128bit quad IEE floats (16bytes);
- 112 bit mantissa,
- 16 bit exponent,
- 34 decimal digits (approx)
+ gcc-i386:
+ 80bit extended IEE floats stored in in 96bits (12bytes);
+ 64 bit mantissa,
+ 16 bit exponent,
+ 19 decimal digits (approx)
+
+ borland-i386 (WIN32):
+ 80bit extended IEE floats stored in in 80bits (10bytes);
+ 64 bit mantissa,
+ 16 bit exponent,
+ 19 decimal digits (approx)
+
+ gcc-sparc:
+ 128bit quad IEE floats (16bytes);
+ 112 bit mantissa,
+ 16 bit exponent,
+ 34 decimal digits (approx)
Mixed mode arithmetic:
- longFloat op longFloat -> longFloat
- longFloat op fix -> longFloat
- longFloat op fraction -> longFloat
- longFloat op integer -> longFloat
- longFloat op shortFloat -> longFloat
- longFloat op float -> longFloat
- longFloat op complex -> complex
+ longFloat op longFloat -> longFloat
+ longFloat op fix -> longFloat
+ longFloat op fraction -> longFloat
+ longFloat op integer -> longFloat
+ longFloat op shortFloat -> longFloat
+ longFloat op float -> longFloat
+ longFloat op complex -> complex
Range and Precision of Storage Formats: see LimitedPrecisionReal >> documentation
[author:]
- Claus Gittinger
+ Claus Gittinger
[see also:]
- Number
- Float ShortFloat Fraction FixedPoint Integer Complex
- FloatArray DoubleArray
+ Number
+ Float ShortFloat Fraction FixedPoint Integer Complex
+ FloatArray DoubleArray
"
! !
@@ -403,11 +407,11 @@
"do not write a literal constant here - we cannot depend on the underlying C-compiler here..."
Pi isNil ifTrue:[
- DefaultPrintFormat := '.19'. "/ 19 valid digits
-
- "/ enough digits for 128bit IEEE quads
- Pi := self readFrom:'3.1415926535897932384626433832795029'. "/ 3.14159265358979323846264338327950288419716939937510582097494459q
- E := self readFrom:'2.7182818284590452353602874713526625'.
+ DefaultPrintFormat := '.19'. "/ 19 valid digits
+
+ "/ enough digits for 128bit IEEE quads
+ Pi := self readFrom:'3.1415926535897932384626433832795029'. "/ 3.14159265358979323846264338327950288419716939937510582097494459q
+ E := self readFrom:'2.7182818284590452353602874713526625'.
].
"
@@ -595,25 +599,25 @@
LONGFLOAT result, val;
if (__isSmallInteger(aNumber)) {
- val = (LONGFLOAT)(__intVal(aNumber));
+ val = (LONGFLOAT)(__intVal(aNumber));
doMul:
- result = __longFloatVal(self) * val;
- __qMKLFLOAT(newFloat, result);
- RETURN ( newFloat );
+ result = __longFloatVal(self) * val;
+ __qMKLFLOAT(newFloat, result);
+ RETURN ( newFloat );
}
if (aNumber != nil) {
- if (__qIsLongFloat(aNumber)) {
- val = __longFloatVal(aNumber);
- goto doMul;
- }
- if (__qIsFloatLike(aNumber)) {
- val = (LONGFLOAT)(__floatVal(aNumber));
- goto doMul;
- }
- if (__qIsShortFloat(aNumber)) {
- val = (LONGFLOAT)(__shortFloatVal(aNumber));
- goto doMul;
- }
+ if (__qIsLongFloat(aNumber)) {
+ val = __longFloatVal(aNumber);
+ goto doMul;
+ }
+ if (__qIsFloatLike(aNumber)) {
+ val = (LONGFLOAT)(__floatVal(aNumber));
+ goto doMul;
+ }
+ if (__qIsShortFloat(aNumber)) {
+ val = (LONGFLOAT)(__shortFloatVal(aNumber));
+ goto doMul;
+ }
}
%}.
^ aNumber productFromLongFloat:self
@@ -628,25 +632,25 @@
LONGFLOAT result, val;
if (__isSmallInteger(aNumber)) {
- val = (LONGFLOAT)(__intVal(aNumber));
+ val = (LONGFLOAT)(__intVal(aNumber));
doAdd:
- result = __longFloatVal(self) + val;
- __qMKLFLOAT(newFloat, result);
- RETURN ( newFloat );
+ result = __longFloatVal(self) + val;
+ __qMKLFLOAT(newFloat, result);
+ RETURN ( newFloat );
}
if (aNumber != nil) {
- if (__qIsLongFloat(aNumber)) {
- val = __longFloatVal(aNumber);
- goto doAdd;
- }
- if (__qIsFloatLike(aNumber)) {
- val = (LONGFLOAT)(__floatVal(aNumber));
- goto doAdd;
- }
- if (__qIsShortFloat(aNumber)) {
- val = (LONGFLOAT)(__shortFloatVal(aNumber));
- goto doAdd;
- }
+ if (__qIsLongFloat(aNumber)) {
+ val = __longFloatVal(aNumber);
+ goto doAdd;
+ }
+ if (__qIsFloatLike(aNumber)) {
+ val = (LONGFLOAT)(__floatVal(aNumber));
+ goto doAdd;
+ }
+ if (__qIsShortFloat(aNumber)) {
+ val = (LONGFLOAT)(__shortFloatVal(aNumber));
+ goto doAdd;
+ }
}
%}.
^ aNumber sumFromLongFloat:self
@@ -661,25 +665,25 @@
LONGFLOAT result, val;
if (__isSmallInteger(aNumber)) {
- val = (LONGFLOAT)(__intVal(aNumber));
+ val = (LONGFLOAT)(__intVal(aNumber));
doSub:
- result = __longFloatVal(self) - val;
- __qMKLFLOAT(newFloat, result);
- RETURN ( newFloat );
+ result = __longFloatVal(self) - val;
+ __qMKLFLOAT(newFloat, result);
+ RETURN ( newFloat );
}
if (aNumber != nil) {
- if (__qIsLongFloat(aNumber)) {
- val = __longFloatVal(aNumber);
- goto doSub;
- }
- if (__qIsFloatLike(aNumber)) {
- val = (LONGFLOAT)(__floatVal(aNumber));
- goto doSub;
- }
- if (__qIsShortFloat(aNumber)) {
- val = (LONGFLOAT)(__shortFloatVal(aNumber));
- goto doSub;
- }
+ if (__qIsLongFloat(aNumber)) {
+ val = __longFloatVal(aNumber);
+ goto doSub;
+ }
+ if (__qIsFloatLike(aNumber)) {
+ val = (LONGFLOAT)(__floatVal(aNumber));
+ goto doSub;
+ }
+ if (__qIsShortFloat(aNumber)) {
+ val = (LONGFLOAT)(__shortFloatVal(aNumber));
+ goto doSub;
+ }
}
%}.
^ aNumber differenceFromLongFloat:self
@@ -694,39 +698,86 @@
LONGFLOAT result, val;
if (__isSmallInteger(aNumber)) {
- val = (LONGFLOAT)(__intVal(aNumber));
+ val = (LONGFLOAT)(__intVal(aNumber));
doDiv:
- if (val == 0.0) goto badArg;
-
- result = __longFloatVal(self) / val;
- __qMKLFLOAT(newFloat, result);
- RETURN ( newFloat );
+ if (val == 0.0) goto badArg;
+
+ result = __longFloatVal(self) / val;
+ __qMKLFLOAT(newFloat, result);
+ RETURN ( newFloat );
}
if (aNumber != nil) {
- if (__qIsLongFloat(aNumber)) {
- val = __longFloatVal(aNumber);
- goto doDiv;
- }
- if (__qIsFloatLike(aNumber)) {
- val = (LONGFLOAT)(__floatVal(aNumber));
- goto doDiv;
- }
- if (__qIsShortFloat(aNumber)) {
- val = (LONGFLOAT)(__shortFloatVal(aNumber));
- goto doDiv;
- }
+ if (__qIsLongFloat(aNumber)) {
+ val = __longFloatVal(aNumber);
+ goto doDiv;
+ }
+ if (__qIsFloatLike(aNumber)) {
+ val = (LONGFLOAT)(__floatVal(aNumber));
+ goto doDiv;
+ }
+ if (__qIsShortFloat(aNumber)) {
+ val = (LONGFLOAT)(__shortFloatVal(aNumber));
+ goto doDiv;
+ }
}
badArg: ;
%}.
((aNumber == 0) or:[aNumber = 0.0]) ifTrue:[
- "
- No, you shalt not divide by zero
- "
- ^ ZeroDivide raiseRequestWith:thisContext.
+ "
+ No, you shalt not divide by zero
+ "
+ ^ ZeroDivide raiseRequestWith:thisContext.
].
^ aNumber quotientFromLongFloat:self
!
+rem: aNumber
+ "return the floating point remainder of the receiver and the argument, aNumber"
+
+%{ /* NOCONTEXT */
+
+ /*
+ * notice:
+ * the following inline code handles some common cases,
+ * and exists as an optimization, to speed up those cases.
+ *
+ * Conceptionally, (and for most other argument types),
+ * mixed arithmetic is implemented by double dispatching
+ * (see the message send at the bottom)
+ */
+ OBJ newFloat;
+ LONGFLOAT result, val;
+
+ if (__isSmallInteger(aNumber)) {
+ if (aNumber != __mkSmallInteger(0)) {
+ val = (LONGFLOAT)__intVal(aNumber);
+ if (val == 0.0) goto badArg;
+computeResult:
+ result = fmodl(__longFloatVal(self), val) ;
+ __qMKLFLOAT(newFloat, result);
+ RETURN ( newFloat );
+ }
+ } else if (__isFloatLike(aNumber)) {
+ val = (LONGFLOAT)__floatVal(aNumber);
+ goto computeResult;
+ } else if (__isShortFloat(aNumber)) {
+ val = (LONGFLOAT)__shortFloatVal(aNumber);
+ goto computeResult;
+ } else if (__isLongFloat(aNumber)) {
+ val = __longFloatVal(aNumber);
+ goto computeResult;
+ }
+badArg: ;
+%}.
+ ((aNumber == 0) or:[aNumber = 0.0]) ifTrue:[
+ "
+ No, you shalt not divide by zero
+ "
+ ^ ZeroDivide raiseRequestWith:thisContext.
+ ].
+ ^ aNumber remainderFromLongFloat:self
+!
+
abs
"return the absolute value of the receiver
reimplemented here for speed"
@@ -774,25 +825,25 @@
LONGFLOAT result, val;
if (__isSmallInteger(aNumber)) {
- val = (LONGFLOAT)(__intVal(aNumber));
+ val = (LONGFLOAT)(__intVal(aNumber));
doDiv:
- result = __longFloatVal(self) / val;
- __qMKLFLOAT(newFloat, result);
- RETURN ( newFloat );
+ result = __longFloatVal(self) / val;
+ __qMKLFLOAT(newFloat, result);
+ RETURN ( newFloat );
}
if (aNumber != nil) {
- if (__qIsLongFloat(aNumber)) {
- val = __longFloatVal(aNumber);
- goto doDiv;
- }
- if (__qIsShortFloat(aNumber)) {
- val = (LONGFLOAT)(__shortFloatVal(aNumber));
- goto doDiv;
- }
- if (__qIsFloatLike(aNumber)) {
- val = (LONGFLOAT)(__floatVal(aNumber));
- goto doDiv;
- }
+ if (__qIsLongFloat(aNumber)) {
+ val = __longFloatVal(aNumber);
+ goto doDiv;
+ }
+ if (__qIsShortFloat(aNumber)) {
+ val = (LONGFLOAT)(__shortFloatVal(aNumber));
+ goto doDiv;
+ }
+ if (__qIsFloatLike(aNumber)) {
+ val = (LONGFLOAT)(__floatVal(aNumber));
+ goto doDiv;
+ }
}
%}.
^ aNumber quotientFromLongFloat:self
@@ -1341,9 +1392,9 @@
int len ;
if (__isStringLike(@global(DefaultPrintFormat))) {
- fmt = (char *) __stringVal(@global(DefaultPrintFormat));
+ fmt = (char *) __stringVal(@global(DefaultPrintFormat));
} else {
- fmt = ".19";
+ fmt = ".19";
}
/*
* build a printf format string
@@ -1352,12 +1403,12 @@
strncpy(fmtBuffer+1, fmt, 10);
if (sizeof(LONGFLOAT) == sizeof(double)) {
#ifdef SYSV
- strcat(fmtBuffer, "lg");
+ strcat(fmtBuffer, "lg");
#else
- strcat(fmtBuffer, "G");
+ strcat(fmtBuffer, "G");
#endif
} else {
- strcat(fmtBuffer, "LG");
+ strcat(fmtBuffer, "LG");
}
/*
@@ -1370,33 +1421,33 @@
__END_PROTECT_REGISTERS__
if (len >= 0 && len < sizeof(buffer)-3) {
- /*
- * kludge to make integral float f prints as "f.0" (not as "f" as printf does)
- * (i.e. look if string contains '.' or 'e' and append '.0' if not)
- */
- for (cp = buffer; *cp; cp++) {
- if ((*cp == '.') || (*cp == ',') || (*cp == 'E') || (*cp == 'e')) break;
- }
- if (!*cp && (cp[-1] >= '0') && (cp[-1] <= '9')) {
- if (__isCharacter(@global(DecimalPointCharacterForPrinting))) {
- *cp++ = __intVal(__characterVal(@global(DecimalPointCharacterForPrinting)));
- } else {
- *cp++ = '.';
- }
- *cp++ = '0';
- *cp = '\0';
- } else {
- if (cp && (*cp == '.')) {
- if (__isCharacter(@global(DecimalPointCharacterForPrinting))) {
- *cp = __intVal(__characterVal(@global(DecimalPointCharacterForPrinting)));
- }
- }
- }
-
- s = __MKSTRING(buffer);
- if (s != nil) {
- RETURN (s);
- }
+ /*
+ * kludge to make integral float f prints as "f.0" (not as "f" as printf does)
+ * (i.e. look if string contains '.' or 'e' and append '.0' if not)
+ */
+ for (cp = buffer; *cp; cp++) {
+ if ((*cp == '.') || (*cp == ',') || (*cp == 'E') || (*cp == 'e')) break;
+ }
+ if (!*cp && (cp[-1] >= '0') && (cp[-1] <= '9')) {
+ if (__isCharacter(@global(DecimalPointCharacterForPrinting))) {
+ *cp++ = __intVal(__characterVal(@global(DecimalPointCharacterForPrinting)));
+ } else {
+ *cp++ = '.';
+ }
+ *cp++ = '0';
+ *cp = '\0';
+ } else {
+ if (cp && (*cp == '.')) {
+ if (__isCharacter(@global(DecimalPointCharacterForPrinting))) {
+ *cp = __intVal(__characterVal(@global(DecimalPointCharacterForPrinting)));
+ }
+ }
+ }
+
+ s = __MKSTRING(buffer);
+ if (s != nil) {
+ RETURN (s);
+ }
}
%}.
"
@@ -1409,24 +1460,24 @@
^ ObjectMemory allocationFailureSignal raise.
"
- 1.234 asLongFloat printString.
- 1.0 asLongFloat printString.
- 1e10 asLongFloat printString.
- 1.2e3 asLongFloat printString.
- 1.2e30 asLongFloat printString.
- (1.0 uncheckedDivide:0) asLongFloat printString.
- (0.0 uncheckedDivide:0) asLongFloat printString.
- self pi printString.
-
- DecimalPointCharacterForPrinting := $,.
- 1.234 asLongFloat printString.
- 1.0 asLongFloat printString.
- 1e10 asLongFloat printString.
- 1.2e3 asLongFloat printString.
- 1.2e30 asLongFloat printString.
- (1.0 uncheckedDivide:0) asLongFloat printString.
- (0.0 uncheckedDivide:0) asLongFloat printString.
- DecimalPointCharacterForPrinting := $.
+ 1.234 asLongFloat printString.
+ 1.0 asLongFloat printString.
+ 1e10 asLongFloat printString.
+ 1.2e3 asLongFloat printString.
+ 1.2e30 asLongFloat printString.
+ (1.0 uncheckedDivide:0) asLongFloat printString.
+ (0.0 uncheckedDivide:0) asLongFloat printString.
+ self pi printString.
+
+ DecimalPointCharacterForPrinting := $,.
+ 1.234 asLongFloat printString.
+ 1.0 asLongFloat printString.
+ 1e10 asLongFloat printString.
+ 1.2e3 asLongFloat printString.
+ 1.2e30 asLongFloat printString.
+ (1.0 uncheckedDivide:0) asLongFloat printString.
+ (0.0 uncheckedDivide:0) asLongFloat printString.
+ DecimalPointCharacterForPrinting := $.
"
!
@@ -1447,23 +1498,23 @@
int len;
if (__isStringLike(formatString)) {
- /*
- * actually only needed on sparc: since thisContext is
- * in a global register, which gets destroyed by printf,
- * manually save it here - very stupid ...
- */
- __BEGIN_PROTECT_REGISTERS__
-
- len = snprintf(buffer, sizeof(buffer), __stringVal(formatString), __longFloatVal(self));
-
- __END_PROTECT_REGISTERS__
-
- if (len < 0) goto fail;
-
- s = __MKSTRING_L(buffer, len);
- if (s != nil) {
- RETURN (s);
- }
+ /*
+ * actually only needed on sparc: since thisContext is
+ * in a global register, which gets destroyed by printf,
+ * manually save it here - very stupid ...
+ */
+ __BEGIN_PROTECT_REGISTERS__
+
+ len = snprintf(buffer, sizeof(buffer), __stringVal(formatString), __longFloatVal(self));
+
+ __END_PROTECT_REGISTERS__
+
+ if (len < 0) goto fail;
+
+ s = __MKSTRING_L(buffer, len);
+ if (s != nil) {
+ RETURN (s);
+ }
}
fail: ;
%}.
@@ -1491,41 +1542,41 @@
int len;
char *fmtBuffer;
- if (sizeof(LONGFLOAT) == sizeof(double)) {
-#ifdef SYSV
- fmtBuffer = "%.19lg";
-#else
- fmtBuffer = "%.19G";
-#endif
- } else {
- fmtBuffer = "%.19LG";
- }
/*
* build a printf format string
*/
+ if (sizeof(LONGFLOAT) == sizeof(double)) {
+#ifdef SYSV
+ fmtBuffer = "%.19lg";
+#else
+ fmtBuffer = "%.19G";
+#endif
+ } else {
+ fmtBuffer = "%.19LG";
+ }
__BEGIN_PROTECT_REGISTERS__
len = snprintf(buffer, sizeof(buffer), fmtBuffer, __longFloatVal(self));
__END_PROTECT_REGISTERS__
if (len >= 0 && len < sizeof(buffer)-3) {
- /*
- * kludge to make integral float f prints as "f.0" (not as "f" as printf does)
- * (i.e. look if string contains '.' or 'e' and append '.0' if not)
- */
- for (cp = buffer; *cp; cp++) {
- if ((*cp == '.') || (*cp == ',') || (*cp == 'E') || (*cp == 'e')) break;
- }
- if (!*cp && (cp[-1] >= '0') && (cp[-1] <= '9')) {
- *cp++ = '.';
- *cp++ = '0';
- *cp = '\0';
- }
-
- s = __MKSTRING(buffer);
- if (s != nil) {
- RETURN (s);
- }
+ /*
+ * kludge to make integral float f prints as "f.0" (not as "f" as printf does)
+ * (i.e. look if string contains '.' or 'e' and append '.0' if not)
+ */
+ for (cp = buffer; *cp; cp++) {
+ if ((*cp == '.') || (*cp == ',') || (*cp == 'E') || (*cp == 'e')) break;
+ }
+ if (!*cp && (cp[-1] >= '0') && (cp[-1] <= '9')) {
+ *cp++ = '.';
+ *cp++ = '0';
+ *cp = '\0';
+ }
+
+ s = __MKSTRING(buffer);
+ if (s != nil) {
+ RETURN (s);
+ }
}
%}.
"
@@ -1538,26 +1589,26 @@
^ ObjectMemory allocationFailureSignal raise.
"
- 1.0 asLongFloat storeString
- 1.234 asLongFloat storeString
- 1e10 asLongFloat storeString
- 1.2e3 asLongFloat storeString
- 1.2e30 asLongFloat storeString
- LongFloat pi asLongFloat storeString
- (1.0 uncheckedDivide:0) asLongFloat storeString
- (0.0 uncheckedDivide:0) asLongFloat storeString
+ 1.0 asLongFloat storeString
+ 1.234 asLongFloat storeString
+ 1e10 asLongFloat storeString
+ 1.2e3 asLongFloat storeString
+ 1.2e30 asLongFloat storeString
+ LongFloat pi asLongFloat storeString
+ (1.0 uncheckedDivide:0) asLongFloat storeString
+ (0.0 uncheckedDivide:0) asLongFloat storeString
notice that the storeString is NOT affected by DecimalPointCharacterForPrinting:
- DecimalPointCharacterForPrinting := $,.
- 1.234 asLongFloat storeString.
- 1.0 asLongFloat storeString.
- 1e10 asLongFloat storeString.
- 1.2e3 asLongFloat storeString.
- 1.2e30 asLongFloat storeString.
- (1.0 uncheckedDivide:0) asLongFloat storeString.
- (0.0 uncheckedDivide:0) asLongFloat storeString.
- DecimalPointCharacterForPrinting := $.
+ DecimalPointCharacterForPrinting := $,.
+ 1.234 asLongFloat storeString.
+ 1.0 asLongFloat storeString.
+ 1e10 asLongFloat storeString.
+ 1.2e3 asLongFloat storeString.
+ 1.2e30 asLongFloat storeString.
+ (1.0 uncheckedDivide:0) asLongFloat storeString.
+ (0.0 uncheckedDivide:0) asLongFloat storeString.
+ DecimalPointCharacterForPrinting := $.
"
! !
@@ -2540,11 +2591,11 @@
!LongFloat class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/LongFloat.st,v 1.71 2012-12-17 18:28:24 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/LongFloat.st,v 1.73 2013-01-23 18:02:20 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/LongFloat.st,v 1.71 2012-12-17 18:28:24 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/LongFloat.st,v 1.73 2013-01-23 18:02:20 cg Exp $'
! !
--- a/MD5Stream.st Wed Jan 23 10:08:55 2013 +0000
+++ b/MD5Stream.st Mon Jan 28 21:53:19 2013 +0000
@@ -77,6 +77,7 @@
[see also:]
SHA1Stream
+ SHA256Stream SHA512Stream (in libcrypt)
[class variables:]
HashSize size of returned hash value
@@ -267,12 +268,10 @@
"reset the stream in order to compute a new hash value"
%{
- if (__isNonNilObject(__INST(hashContext)) &&
- __qClass(__INST(hashContext)) == @global(ByteArray) &&
+ if (__isByteArray(__INST(hashContext)) &&
__byteArraySize(__INST(hashContext)) == sizeof(MD5_CTX)
) {
- MD5_CTX *ctx =
- (MD5_CTX *)__ByteArrayInstPtr(__INST(hashContext))->ba_element;
+ MD5_CTX *ctx = (MD5_CTX *)__ByteArrayInstPtr(__INST(hashContext))->ba_element;
MD5Init(ctx);
RETURN(self);
@@ -297,15 +296,12 @@
digest := ByteArray new:HashSize.
%{
- if (__isNonNilObject(__INST(hashContext)) &&
- __qClass(__INST(hashContext)) == @global(ByteArray) &&
+ if (__isByteArray(__INST(hashContext)) &&
__byteArraySize(__INST(hashContext)) == sizeof(MD5_CTX) &&
- __isNonNilObject(digest) &&
- __qClass(digest) == @global(ByteArray) &&
+ __isByteArray(digest) &&
__byteArraySize(digest) == 16
) {
- MD5_CTX *ctx =
- (MD5_CTX *)__ByteArrayInstPtr(__INST(hashContext))->ba_element;
+ MD5_CTX *ctx = (MD5_CTX *)__ByteArrayInstPtr(__INST(hashContext))->ba_element;
MD5_CTX copyContext;
memcpy(©Context, ctx, sizeof(copyContext));
@@ -326,17 +322,16 @@
or an externalBytes object (with known size)"
%{
- int len, offs;
- int objSize, nInstVars, nInstBytes;
+ INT len, offs;
+ INT objSize;
+ int nInstVars, nInstBytes;
char *extPtr;
- if (__isNonNilObject(__INST(hashContext))
- &&__qClass(__INST(hashContext)) == @global(ByteArray)
+ if (__isByteArray(__INST(hashContext))
&&__byteArraySize(__INST(hashContext)) == sizeof(MD5_CTX)
&& __bothSmallInteger(count, start)
) {
- MD5_CTX *ctx =
- (MD5_CTX *)__ByteArrayInstPtr(__INST(hashContext))->ba_element;
+ MD5_CTX *ctx = (MD5_CTX *)__ByteArrayInstPtr(__INST(hashContext))->ba_element;
len = __intVal(count);
offs = __intVal(start) - 1;
@@ -390,11 +385,12 @@
!MD5Stream class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/MD5Stream.st,v 1.22 2013-01-17 22:41:35 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/MD5Stream.st,v 1.24 2013-01-27 13:55:22 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/MD5Stream.st,v 1.22 2013-01-17 22:41:35 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/MD5Stream.st,v 1.24 2013-01-27 13:55:22 cg Exp $'
! !
+
MD5Stream initialize!
--- a/NameSpace.st Wed Jan 23 10:08:55 2013 +0000
+++ b/NameSpace.st Mon Jan 28 21:53:19 2013 +0000
@@ -143,7 +143,7 @@
|currentNameSpace newNameSpace existing ok nameSym fullName|
- ok := aStringOrSymbol first isLetter.
+ ok := aStringOrSymbol first isLetter or:[aStringOrSymbol first == $_].
ok ifTrue:[
(aStringOrSymbol
findFirst:[:ch | (ch isLetterOrDigit or:[ch == $_]) not]
@@ -734,9 +734,10 @@
!NameSpace class methodsFor:'documentation'!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/NameSpace.st,v 1.75 2012-10-22 20:26:16 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/NameSpace.st,v 1.76 2013-01-18 20:56:20 cg Exp $'
!
version_SVN
^ '§ Id: NameSpace.st 10643 2011-06-08 21:53:07Z vranyj1 §'
! !
+
--- a/Object.st Wed Jan 23 10:08:55 2013 +0000
+++ b/Object.st Mon Jan 28 21:53:19 2013 +0000
@@ -504,7 +504,6 @@
InfoPrinting := aBoolean
! !
-
!Object class methodsFor:'queries'!
isAbstract
@@ -527,8 +526,6 @@
! !
-
-
!Object methodsFor:'Compatibility-Dolphin'!
stbFixup: anSTBInFiler at: newObjectIndex
@@ -551,6 +548,22 @@
self expressInterestIn:anAspect for:anObject sendBack:anAspect
! !
+!Object methodsFor:'Compatibility-GNU'!
+
+display
+ "print the receiver on the standard output stream (which is not the Transcript).
+ Added for GNU-ST compatibility"
+
+ self print
+!
+
+displayNl
+ "print the receiver followed by a cr on the standard output stream (which is not the Transcript).
+ Added for GNU-ST compatibility"
+
+ self printCR
+! !
+
!Object methodsFor:'Compatibility-ST/V'!
triggerEvent:aSymbol
@@ -686,7 +699,6 @@
"
! !
-
!Object methodsFor:'accessing'!
_at:index
@@ -719,6 +731,63 @@
"Created: / 21-03-2011 / 14:10:12 / cg"
!
+addSlot: slotName
+ "dynamically add a new slot to the receiver.
+ The receiver must be a real object, not nil or a smallInteger"
+
+ |classGetter myClass anonCls newObj|
+
+ myClass := self class.
+ classGetter := ('%__get_',slotName,'__') asSymbol.
+
+ anonCls := self perform:classGetter ifNotUnderstood:nil.
+ anonCls isNil ifTrue:[
+ anonCls := myClass
+ subclass:(myClass name,'+',slotName) asSymbol
+ instanceVariableNames:slotName
+ classVariableNames:''
+ poolDictionaries:'' category:nil
+ inEnvironment:nil.
+ anonCls compile:('%1 ^ %1' bindWith:slotName).
+ anonCls compile:('%1:v %1 := v' bindWith:slotName).
+ Class withoutUpdatingChangesDo:[
+ |m|
+ m := Compiler compile:('__get_',slotName,' ^ #fooBar' bindWith:slotName) forClass:myClass install:false.
+ m literalAt:(m literals indexOf:#fooBar) put:anonCls.
+ myClass addSelector:classGetter withMethod:m.
+ ].
+ ].
+ newObj := anonCls cloneFrom:self.
+ self become:newObj.
+
+ "
+ |p1 p2 p3|
+
+ p1 := Point x:10 y:20.
+ p2 := Point x:100 y:200.
+ Transcript show:'p1 is '; showCR:p1.
+ Transcript show:'p2 is '; showCR:p2.
+ p1 addSlot:'z'.
+ p1 z:30.
+ Transcript show:'p1 is '; showCR:p1.
+ Transcript show:'p2 is '; showCR:p2.
+ ObjectMemory dumpObject:p1.
+ ObjectMemory dumpObject:p2.
+
+ p1 addSlot:'t'.
+ p1 t:30.
+ Transcript show:'p1 is '; showCR:p1.
+ ObjectMemory dumpObject:p1.
+
+ p3 := Point x:110 y:120.
+ p3 addSlot:'z'.
+ p3 addSlot:'t'.
+ p1 inspect.
+ p2 inspect.
+ p3 inspect.
+ "
+!
+
at:index
"return the indexed instance variable with index, anInteger;
this method can be redefined in subclasses."
@@ -1920,7 +1989,6 @@
^ self
! !
-
!Object methodsFor:'comparing'!
= anObject
@@ -2281,41 +2349,58 @@
The variable slots are copied as available
(i.e. the min of both indexed sizes is used)."
- |myInfo otherInfo|
-
- myInfo := self class instanceVariableOffsets.
- otherInfo := aPrototype class instanceVariableOffsets.
- myInfo keysAndValuesDo:[:name :index | |varIndexAssoc|
- varIndexAssoc := otherInfo at:name ifAbsent:[].
- varIndexAssoc notNil ifTrue:[
- self instVarAt:index put:(aPrototype instVarAt:(varIndexAssoc value))
- ]
- ].
- self isVariable ifTrue:[
- 1 to:(self basicSize min:aPrototype basicSize) do:[:index |
- self basicAt:index put:(aPrototype basicAt:index)
- ].
+ |myClass prototypesClass myInfo prototypesInfo|
+
+
+ myClass := self class.
+ prototypesClass := aPrototype class.
+ (myClass == prototypesClass
+ or:[ myClass isSubclassOf:prototypesClass ]) ifTrue:[
+ "/ can do better, if my class is a subclass of the prototype's class
+ 1 to: prototypesClass instSize do:[:index |
+ self instVarAt:index put:(aPrototype instVarAt:index)
+ ]
+ ] ifFalse:[
+ "/ map instvars by name
+ myInfo := myClass instanceVariableOffsets.
+ prototypesInfo := prototypesClass instanceVariableOffsets.
+ myInfo keysAndValuesDo:[:name :index | |varIndexAssoc|
+ varIndexAssoc := prototypesInfo at:name ifAbsent:[].
+ varIndexAssoc notNil ifTrue:[
+ self instVarAt:index put:(aPrototype instVarAt:(varIndexAssoc value))
+ ]
+ ]
+ ].
+ myClass isVariable ifTrue:[
+ prototypesClass isVariable ifTrue:[
+ 1 to:(self basicSize min:aPrototype basicSize) do:[:index |
+ self basicAt:index put:(aPrototype basicAt:index)
+ ].
+ ].
].
"
Class withoutUpdatingChangesDo:[
- Point subclass:#Point3D
- instanceVariableNames:'z'
- classVariableNames:''
- poolDictionaries:''
- category:'testing'.
- (Point3D new cloneInstanceVariablesFrom:1@2) inspect.
+ |point3D|
+
+ point3D := Point subclass:#Point3D
+ instanceVariableNames:'z'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'testing'
+ inEnvironment:nil.
+ (point3D new cloneInstanceVariablesFrom:1@2) inspect.
]
"
"
Class withoutUpdatingChangesDo:[
- Point variableSubclass:#Point3D
- instanceVariableNames:'z'
- classVariableNames:''
- poolDictionaries:''
- category:'testing'.
- ((Point3D new:2) cloneInstanceVariablesFrom:#(1 2 3)) inspect.
+ Point variableSubclass:#Point3D_test
+ instanceVariableNames:'z'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'testing'.
+ (((Smalltalk at:#Point3D_test) new:2) cloneInstanceVariablesFrom:#(1 2 3)) inspect.
]
"
@@ -2323,19 +2408,19 @@
|someObject|
Class withoutUpdatingChangesDo:[
- Object subclass:#TestClass1
- instanceVariableNames:'foo bar'
- classVariableNames:''
- poolDictionaries:''
- category:'testing'.
- someObject := TestClass1 new.
- someObject instVarAt:1 put:'foo'; instVarAt:2 put:'bar'.
- Object subclass:#TestClass2
- instanceVariableNames:'bar foo'
- classVariableNames:''
- poolDictionaries:''
- category:'testing'.
- (TestClass2 new cloneInstanceVariablesFrom:someObject) inspect.
+ Object subclass:#TestClass1
+ instanceVariableNames:'foo bar'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'testing'.
+ someObject := TestClass1 new.
+ someObject instVarAt:1 put:'foo'; instVarAt:2 put:'bar'.
+ Object subclass:#TestClass2
+ instanceVariableNames:'bar foo'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'testing'.
+ (TestClass2 new cloneInstanceVariablesFrom:someObject) inspect.
]
"
@@ -7384,7 +7469,6 @@
^ self
! !
-
!Object methodsFor:'secure message sending'!
?: selector
@@ -7987,7 +8071,6 @@
"
! !
-
!Object methodsFor:'synchronized evaluation'!
freeSynchronizationSemaphore
@@ -9605,11 +9688,11 @@
!Object class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Object.st,v 1.706 2013-01-16 14:08:50 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Object.st,v 1.709 2013-01-24 16:26:16 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Object.st,v 1.706 2013-01-16 14:08:50 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Object.st,v 1.709 2013-01-24 16:26:16 cg Exp $'
!
version_SVN
--- a/ObjectMemory.st Wed Jan 23 10:08:55 2013 +0000
+++ b/ObjectMemory.st Mon Jan 28 21:53:19 2013 +0000
@@ -918,6 +918,19 @@
!ObjectMemory class methodsFor:'access debugging'!
+debugPrivacyChecks:aBoolean
+ "turn on/off checks for private methods being called.
+ By default, this is on in the ST/X IDE, but off for standAlone (packaged) endUser
+ applications. Method privacy is an experimental feature, which may be removed in later
+ versions, if it turns out to be not useful."
+
+%{ /* NOCONTEXT */
+ extern int __setPrivacyChecks__();
+
+ RETURN ( __setPrivacyChecks__( (aBoolean == true) ) ? true : false);
+%}
+!
+
setTrapOnAccessFor:anObject
"install an access trap for anObject;
An accessSignal will be raised, whenever any instvar of anObject is either read or written.
@@ -3046,9 +3059,9 @@
The default is zero."
%{ /* NOCONTEXT */
- extern unsigned __maxOldSpace();
-
- RETURN (__MKUINT( __maxOldSpace((unsigned int)-1) ));
+ extern unsigned INT __maxOldSpace();
+
+ RETURN (__MKUINT( __maxOldSpace((unsigned INT)-1) ));
%}.
^ 0
"
@@ -3069,7 +3082,7 @@
|result|
%{
- extern unsigned __maxOldSpace();
+ extern unsigned INT __maxOldSpace();
if (__isInteger(amount)) {
result = __MKUINT( __maxOldSpace(__unsignedLongIntVal(amount)));
@@ -5501,7 +5514,7 @@
!ObjectMemory class methodsFor:'documentation'!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/ObjectMemory.st,v 1.264 2013-01-11 14:30:08 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/ObjectMemory.st,v 1.266 2013-01-26 21:42:14 cg Exp $'
!
version_SVN
--- a/Process.st Wed Jan 23 10:08:55 2013 +0000
+++ b/Process.st Mon Jan 28 21:53:19 2013 +0000
@@ -40,7 +40,7 @@
documentation
"
- Instances of Process represent lightweight smalltalk processes
+ Instances of Process represent lightweight smalltalk processes
(i.e. threads). These all run in a shared smalltalk/X address space,
and can thus access and communicate via any objects.
Do not confuse these with (heavy-weight) unix processes, which are
@@ -68,18 +68,18 @@
Processes can be terminated either soft or via a hardTerminate.
A soft terminate (see Process>>terminate) will raise a TerminationSignal
- in the process, which can be handled by the process.
- If no other handler was specified, the processes own handler
- (see Process>>start) will catch the signal and terminate the process.
+ in the process, which can be handled by the process.
+ If no other handler was specified, the processes own handler
+ (see Process>>start) will catch the signal and terminate the process.
During this signal processing, normal unwind processing takes place,
- this means that with a soft terminate, all valueOnUnwind:/valueNowOrOnUnwind:
+ this means that with a soft terminate, all valueOnUnwind:/valueNowOrOnUnwind:
cleanup blocks are evaluated.
(so a process which has set up those blocks correctly does not have to
care especially about cleanup in case of termination).
Other than that, the TerminateSignal can be caught for special cleanup or
even to make the process continue execution.
If the process is suspended at termination time, it will be resumed
- in order to perform its cleanup actions (i.e. the cleanup is always
+ in order to perform its cleanup actions (i.e. the cleanup is always
done in the context of the terminating process itself).
A hard terminate (Process>>terminateNoSignal) will NOT do all of the above,
@@ -91,173 +91,173 @@
Leaving the processes startBlock has the same effct as a soft-terminate
(i.e. there is no need to send an explicit terminate).
- Notice:
- in Smalltalk/X, processes are gone, when an image is restarted;
- this means, that you have to take care of process re-creation yourself.
- Usually, this is done by depending on ObjectMemory, recreating the
- process(es) when the #returnFromSnapshot-change notifiction arrives.
+ Notice:
+ in Smalltalk/X, processes are gone, when an image is restarted;
+ this means, that you have to take care of process re-creation yourself.
+ Usually, this is done by depending on ObjectMemory, recreating the
+ process(es) when the #returnFromSnapshot-change notifiction arrives.
- All views (actually windowGroups) recreate their window process
- on image-restart. You have to do so manually for your own processes.
+ All views (actually windowGroups) recreate their window process
+ on image-restart. You have to do so manually for your own processes.
A later version will allow specification of automatic restart, but
that's not yet implemented. However, even when implemented, restartable processes
will be recreated to restart from the beginning. It will not be possible to
automatically continue a processes execution where it left off.
This is a consequence of the portable implementation of ST/X, since in order to
- implement process continuation, the machines stack had to be preserved and
- recreated. Although this is possible to do (and actually not too complicated),
- this has not been implemented, since the machines stack layout is highly machine/compiler
+ implement process continuation, the machines stack had to be preserved and
+ recreated. Although this is possible to do (and actually not too complicated),
+ this has not been implemented, since the machines stack layout is highly machine/compiler
dependent, thus leading to much bigger porting effort of ST/X (which conflicts
with ST/X's design goal of being highly portable).
Process synchronization:
- Synchronization with cooperating processes is supported as usual,
- via Semaphores (see Semaphore, Delay, SharedQueue etc.)
+ Synchronization with cooperating processes is supported as usual,
+ via Semaphores (see Semaphore, Delay, SharedQueue etc.)
- With uncooperative processes, only synchronization on suspend
- and termination is possible:
- any other process can wait for a process to suspend or terminate.
- This waiting is implemented by using suspendSemaphore and exitBlocks
- (where an exitSemaphore is signalled).
- See waitUntilSuspended / waitUntilTerminated.
+ With uncooperative processes, only synchronization on suspend
+ and termination is possible:
+ any other process can wait for a process to suspend or terminate.
+ This waiting is implemented by using suspendSemaphore and exitBlocks
+ (where an exitSemaphore is signalled).
+ See waitUntilSuspended / waitUntilTerminated.
Process states:
- #dead process has (been) terminated;
- the process instance has no underlting
- thread.
+ #dead process has (been) terminated;
+ the process instance has no underlting
+ thread.
- #run the process is willing to run,
- but not active (i.e. another higher prio
- process is currently executing)
+ #run the process is willing to run,
+ but not active (i.e. another higher prio
+ process is currently executing)
- #active the process is the current process
- (there is only one)
+ #active the process is the current process
+ (there is only one)
- #ioWait waiting on some io-related semaphore
- (typically in #readWait / #writeWait)
+ #ioWait waiting on some io-related semaphore
+ (typically in #readWait / #writeWait)
- #eventWait waiting on some GUI event
+ #eventWait waiting on some GUI event
- #timeWait waiting on a timer-related semaphore
+ #timeWait waiting on a timer-related semaphore
- #wait waiting on some (other) semaphore
+ #wait waiting on some (other) semaphore
- #suspended stopped from execution; however, an interrupt
- will return it into the run state.
+ #suspended stopped from execution; however, an interrupt
+ will return it into the run state.
- #stopped stopped from execution; an interrupt will
- NOT return it into the run state (for debugging)
+ #stopped stopped from execution; an interrupt will
+ NOT return it into the run state (for debugging)
- #debug debugger sitting on top of the processes
- stack.
+ #debug debugger sitting on top of the processes
+ stack.
Win32 only:
- #osWait waiting on an OS-API call to finish.
- can be interrupted, terminated and aborted
- (i.e. the usual context actions are is possible).
+ #osWait waiting on an OS-API call to finish.
+ can be interrupted, terminated and aborted
+ (i.e. the usual context actions are is possible).
- #halted thread was cought while in a blocking API call
- or primitive endless loop and has been halted by
- the scheduler.
- Can only be resumed or hard-terminated - abort
- or soft terminate or unwind actions are not possible.
- (due to win32 limitations)
+ #halted thread was cought while in a blocking API call
+ or primitive endless loop and has been halted by
+ the scheduler.
+ Can only be resumed or hard-terminated - abort
+ or soft terminate or unwind actions are not possible.
+ (due to win32 limitations)
[Instance variables:]
- id <SmallInteger> a unique process-id
+ id <SmallInteger> a unique process-id
- creatorId <SmallInteger> the id of the process that
- created me (useful for debugging
- or monitoring).
+ creatorId <SmallInteger> the id of the process that
+ created me (useful for debugging
+ or monitoring).
- processGroupId usually the id of the creator,
- unless the process detached from
- the group and became a groupLeader.
- Groups can be easily terminated
- as a whole.
- Group leaders have a groupId of nil.
- A groupId of 0 (zero) marks a system
- process; these do not prevent a standAlone
- app from exiting.
+ processGroupId usually the id of the creator,
+ unless the process detached from
+ the group and became a groupLeader.
+ Groups can be easily terminated
+ as a whole.
+ Group leaders have a groupId of nil.
+ A groupId of 0 (zero) marks a system
+ process; these do not prevent a standAlone
+ app from exiting.
- prio <SmallInteger> the processes priority
+ prio <SmallInteger> the processes priority
- priorityRange <Interval> the processes dynamic priority range
- (or nil)
+ priorityRange <Interval> the processes dynamic priority range
+ (or nil)
- state <Symbol> the processes state
- (for process-monitor)
+ state <Symbol> the processes state
+ (for process-monitor)
- startBlock <Block> the startup-block (the one that forked)
+ startBlock <Block> the startup-block (the one that forked)
- name <String-or-nil> the processes name (if any)
- (for process-monitor)
+ name <String-or-nil> the processes name (if any)
+ (for process-monitor)
- suspendSemaphore <Semaphore> triggered when suspend (if nonNil)
+ suspendSemaphore <Semaphore> triggered when suspend (if nonNil)
- restartable <Boolean> is restartable; if true, the process
- will be restarted when an image is
- restarted. Otherwise, it remains dead.
- Running processes cannot be continued
- at the point where leftOff after an
- image-restart.
+ restartable <Boolean> is restartable; if true, the process
+ will be restarted when an image is
+ restarted. Otherwise, it remains dead.
+ Running processes cannot be continued
+ at the point where leftOff after an
+ image-restart.
- interruptActions <Collection> interrupt actions as defined by interruptWith:,
- performed at interrupt time
+ interruptActions <Collection> interrupt actions as defined by interruptWith:,
+ performed at interrupt time
- exitActions <Collection of Block>
- additional cleanup actions to perform
- on termination (if nonEmpty)
-
- emergencySignalHandler <Block> can be used for per-process
- emergency signal handling
+ exitActions <Collection of Block>
+ additional cleanup actions to perform
+ on termination (if nonEmpty)
+
+ emergencySignalHandler <Block> can be used for per-process
+ emergency signal handling
- interruptsDisabled <Boolean> flag if interrupts (as installed
- via #interruptWith:) are currently
- disabled. (i.e. on-hold).
- Interrupts will be delivered when
- reenabled.
+ interruptsDisabled <Boolean> flag if interrupts (as installed
+ via #interruptWith:) are currently
+ disabled. (i.e. on-hold).
+ Interrupts will be delivered when
+ reenabled.
- exceptionHandlerSet <ExceptionhandlerSet>
- Handled by any process; allows for
- exceptionHandlers and query-answerers to
- be added/removed dynamically.
+ exceptionHandlerSet <ExceptionhandlerSet>
+ Handled by any process; allows for
+ exceptionHandlers and query-answerers to
+ be added/removed dynamically.
[Class variables:]
- TerminateSignal <Signal> signal used to terminate processes
- (should not be caught - or at least
- rejected in handlers).
- If caught and proceeded, a process
- cannot be terminated via #terminate.
- For hardTermination (in case of emergency),
- send it a #erminateNoSignal message.
+ TerminateSignal <Signal> signal used to terminate processes
+ (should not be caught - or at least
+ rejected in handlers).
+ If caught and proceeded, a process
+ cannot be terminated via #terminate.
+ For hardTermination (in case of emergency),
+ send it a #erminateNoSignal message.
- RestartSignal <Signal> signal used to restart a process.
- Can be caught in additional handler(s),
- to perform all kind of re-initialization.
- However, these handlers should reject,
- for the restart to be really performed.
+ RestartSignal <Signal> signal used to restart a process.
+ Can be caught in additional handler(s),
+ to perform all kind of re-initialization.
+ However, these handlers should reject,
+ for the restart to be really performed.
[see also:]
- ProcessorScheduler
- Block
- Sempahore SemaphoreSet Delay SharedQueue
- WindowGroup
- (``Working with processes'': programming/processes.html)
+ ProcessorScheduler
+ Block
+ Sempahore SemaphoreSet Delay SharedQueue
+ WindowGroup
+ (``Working with processes'': programming/processes.html)
[author:]
- Claus Gittinger
+ Claus Gittinger
"
!
-examples
+examples
"
start a background process, computing 1000 factorial 100 times;
the processes priority is set to not disturb any interactive process.
@@ -276,7 +276,7 @@
start a background process, computing 1000 factorial 100 times;
the processes priority is set to not disturb any process.
The prio is set to 1 (which is the lowest possible) notice that now,
- the 3D animation demos also continue to run.
+ the 3D animation demos also continue to run.
[exBegin]
[
'starting' printNL.
@@ -303,7 +303,7 @@
] forkAt:1.
[exEnd]
- see more examples in doc/coding
+ see more examples in doc/coding
(or search in the browser for senders of fork*)
"
! !
@@ -312,16 +312,16 @@
initialize
TerminateSignal isNil ifTrue:[
- TerminateSignal := TerminateProcessRequest.
- TerminateSignal notifierString:'unhandled process termination'.
+ TerminateSignal := TerminateProcessRequest.
+ TerminateSignal notifierString:'unhandled process termination'.
- RestartSignal := RestartProcessRequest.
- RestartSignal notifierString:'unhandled process restart'.
+ RestartSignal := RestartProcessRequest.
+ RestartSignal notifierString:'unhandled process restart'.
- CoughtSignals := SignalSet
- with:AbortAllOperationRequest
- with:TerminateProcessRequest
- with:RestartProcessRequest.
+ CoughtSignals := SignalSet
+ with:AbortAllOperationRequest
+ with:TerminateProcessRequest
+ with:RestartProcessRequest.
]
"Modified: / 17.11.2001 / 11:07:29 / cg"
@@ -369,8 +369,8 @@
defaultMaximumStackSize
"return the default max stack size. All new processes get
- this limit initially.
- It may be changed for individual processes with:
+ this limit initially.
+ It may be changed for individual processes with:
aProcess setMaximumStackSize:limit"
%{ /* NOCONTEXT */
@@ -386,9 +386,9 @@
!
defaultMaximumStackSize:numberOfBytes
- "set the default max stack size, return the previous value.
- All new processes get this stack limit initially.
- It may be changed for individual processes with:
+ "set the default max stack size, return the previous value.
+ All new processes get this stack limit initially.
+ It may be changed for individual processes with:
aProcess setMaximumStackSize:limit
Notice:
There is seldom any need to change the default setting,
@@ -581,19 +581,19 @@
priorityRange := anInterval.
anInterval notNil ifTrue:[
- lowPri := priorityRange start.
- hiPri := priorityRange stop.
- prio isNil ifTrue:[
- prio := lowPri
- ] ifFalse:[
- prio < lowPri ifTrue:[
- prio := lowPri
- ] ifFalse:[
- prio > hiPri ifTrue:[
- prio := hiPri
- ].
- ].
- ].
+ lowPri := priorityRange start.
+ hiPri := priorityRange stop.
+ prio isNil ifTrue:[
+ prio := lowPri
+ ] ifFalse:[
+ prio < lowPri ifTrue:[
+ prio := lowPri
+ ] ifFalse:[
+ prio > hiPri ifTrue:[
+ prio := hiPri
+ ].
+ ].
+ ].
].
"Modified: / 3.8.1998 / 22:56:05 / cg"
@@ -632,7 +632,7 @@
restartable:aBoolean
"set/clear, the restartable flag.
Restartable processes will automatically be restarted by the
- ProcessorScheduler upon image restart.
+ ProcessorScheduler upon image restart.
Others have to be restarted manually."
startBlock isNil ifTrue:[
@@ -667,9 +667,9 @@
!
suspendedContext
- "return the processes suspended context
+ "return the processes suspended context
- this is the context from which a process switch into the scheduler
- or another process occured.
+ or another process occured.
For the active process, a dead process, or one which
had no chance to run yet, nil is returned.
Typically, only the debugger is interested in this one."
@@ -706,7 +706,7 @@
addSuspendAction:aBlock
"add aBlock to the processes suspend actions.
This block will be evaluated when a process gets suspended.
- You may ask what that is useful for - it is useful to flush
+ You may ask what that is useful for - it is useful to flush
buffered graphic commands of a GUI process (i.e. to force xlib
to send buffered commands to the display)."
@@ -754,7 +754,7 @@
if not, return the value from evaluating exceptionBlock"
exitActions notNil ifTrue:[
- ^ exitActions removeIdentical:anExitAction ifAbsent:exceptionBlock.
+ ^ exitActions removeIdentical:anExitAction ifAbsent:exceptionBlock.
].
^ exceptionBlock value.
! !
@@ -762,7 +762,7 @@
!Process methodsFor:'accessing-stack'!
maximumStackSize
- "returns the processes stack limit - i.e. the process will be
+ "returns the processes stack limit - i.e. the process will be
interrupted with a recursionSignal-raise, if it ever
needs more stack (in bytes) than this number"
@@ -787,7 +787,7 @@
extern int __threadSetMaxStackSize();
OBJ i;
- if (__isSmallInteger(i = __INST(id))
+ if (__isSmallInteger(i = __INST(id))
&& __isSmallInteger(limit) ) {
RETURN ( __mkSmallInteger(__threadSetMaxStackSize(__intVal(i), __intVal(limit))) );
}
@@ -815,7 +815,7 @@
!Process methodsFor:'interrupts'!
-addInterruptAction:aBlock
+addInterruptAction:aBlock
"make the receiver evaluate aBlock when resumed/interrupted.
The name is somewhat misleading (actually, its historic):
the block is also evaluated on resume."
@@ -824,22 +824,22 @@
wasBlocked := OperatingSystem blockInterrupts.
interruptActions isNil ifTrue:[
- interruptActions := OrderedCollection with:aBlock.
+ interruptActions := OrderedCollection with:aBlock.
] ifFalse:[
- interruptActions addFirst:aBlock.
+ interruptActions addFirst:aBlock.
].
wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
!
blockInterrupts
"disable interrupt processing for the receiver process
- - if disabled, incoming interrupts will be registered and handled as
+ - if disabled, incoming interrupts will be registered and handled as
soon as interrupts are reenabled via unblockInterrupts.
Returns the previous blocking status i.e. true if interrupts
where already blocked. You need this information for proper
unblocking, in case of nested block/unblock calls.
This is similar to OperatingSystem>>blockInterrupts, but only
- affects interrupts for the receiver process
+ affects interrupts for the receiver process
(i.e. those which are installed via #interruptWith:)"
|disabledBefore|
@@ -870,12 +870,12 @@
|action wasBlocked|
[interruptActions size ~~ 0] whileTrue:[
- wasBlocked := OperatingSystem blockInterrupts.
- action := interruptActions removeFirst.
- interruptActions size == 0 ifTrue:[ interruptActions := nil ].
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+ wasBlocked := OperatingSystem blockInterrupts.
+ action := interruptActions removeFirst.
+ interruptActions size == 0 ifTrue:[ interruptActions := nil ].
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
- action valueWithOptionalArgument:aContext
+ action valueWithOptionalArgument:aContext
].
!
@@ -891,7 +891,7 @@
__threadContextStepInterrupt(__intVal(i), 1);
}
%}
-
+
!
hasInterruptActions
@@ -937,16 +937,16 @@
"/ and will be redelivered.
interruptsDisabled == true ifTrue:[
- "/ no, I dont want interrupts right now;
- "/ try again later.
- ^ false
+ "/ no, I dont want interrupts right now;
+ "/ try again later.
+ ^ false
].
"/ I tend to disable interrupts, while processing interrupt actions;
"/ however, this leads to a blocking Debugger sometimes (scroll).
"/ [
"/ interruptsDisabled := true.
- self evaluateInterruptActionsWithContext:aContext.
+ self evaluateInterruptActionsWithContext:aContext.
"/ ] ensure:[
"/ interruptsDisabled := false.
"/ ].
@@ -990,14 +990,14 @@
calls - you should only unblock after a blockcall if they where
really not blocked before.
This is similar to OperatingSystem>>unblockInterrupts, but only
- affects interrupts for the receiver process
+ affects interrupts for the receiver process
(i.e. those which are installed via #interruptWith:)"
interruptsDisabled := false.
interruptActions size ~~ 0 ifTrue:[
- Processor activeProcess == self ifTrue:[
- self interrupt
- ]
+ Processor activeProcess == self ifTrue:[
+ self interrupt
+ ]
]
! !
@@ -1012,9 +1012,9 @@
OBJ i;
if (__isSmallInteger(i = __INST(id))) {
- n = __threadNumberOfStackBoundaryHits(__intVal(i));
- n &= _MAX_INT;
- RETURN( __mkSmallInteger(n) );
+ n = __threadNumberOfStackBoundaryHits(__intVal(i));
+ n &= _MAX_INT;
+ RETURN( __mkSmallInteger(n) );
}
%}.
^ nil
@@ -1055,7 +1055,7 @@
This method is for monitoring purposes only - it may vanish."
%{ /* NOCONTEXT */
- extern int __threadUsedStackSize();
+ extern unsigned __threadUsedStackSize();
OBJ i;
if (__isSmallInteger(i = __INST(id))) {
@@ -1093,7 +1093,7 @@
self obsoleteMethodWarning:'use addExitAction: / removeAllExitActions'.
aBlock isNil ifTrue:[
- ^ self removeAllExitActions.
+ ^ self removeAllExitActions.
].
^ self addExitAction:aBlock
@@ -1114,7 +1114,7 @@
self obsoleteMethodWarning:'use addSuspendAction: / removeAllSuspendActions'.
aBlock isNil ifTrue:[
- ^ self removeAllSuspendActions.
+ ^ self removeAllSuspendActions.
].
^ self addSuspendAction:aBlock
@@ -1140,17 +1140,17 @@
"a little more info in my printed representation"
aStream nextPutAll:state article;
- space;
- nextPutAll:state;
- nextPutAll:' Process (';
- nextPutAll:self nameOrId.
+ space;
+ nextPutAll:state;
+ nextPutAll:' Process (';
+ nextPutAll:self nameOrId.
name notNil ifTrue:[
- aStream
- nextPutAll:', id=';
- nextPutAll:id printString.
+ aStream
+ nextPutAll:', id=';
+ nextPutAll:id printString.
].
- aStream
- nextPutAll:')'
+ aStream
+ nextPutAll:')'
! !
!Process methodsFor:'private'!
@@ -1172,18 +1172,18 @@
"
active := Processor activeProcess.
(nm := active name) notNil ifTrue:[
- "
- avoid name inflation
- "
- (nm endsWith:' sub') ifFalse:[
- nm := nm , ' [' , active id printString , '] sub'
- ].
- name := nm
+ "
+ avoid name inflation
+ "
+ (nm endsWith:' sub') ifFalse:[
+ nm := nm , ' [' , active id printString , '] sub'
+ ].
+ name := nm
].
creatorId := active id.
processGroupId := active processGroupId.
(processGroupId isNil or:[processGroupId == 0]) ifTrue:[
- processGroupId := creatorId.
+ processGroupId := creatorId.
].
"/ since groupId is used to detect a systemProcess (0),
@@ -1203,13 +1203,13 @@
processGroupId := nil.
state := stateSymbol.
singleStepping isNil ifTrue:[
- singleStepping := false
+ singleStepping := false
].
restartable isNil ifTrue:[
- restartable := false
+ restartable := false
].
interruptsDisabled isNil ifTrue:[
- interruptsDisabled := false
+ interruptsDisabled := false
].
"Modified: 30.10.1996 / 00:35:29 / cg"
@@ -1292,11 +1292,11 @@
"return true if aProcess is a system process,
which should not be suspended/terminated etc.."
- ^ (Processor isPureEventDriven
+ ^ (Processor isPureEventDriven
or:[id == 0
or:[processGroupId == 0
or:[(Display notNil and:[Display dispatchProcess == self])
- ]]])
+ ]]])
"
Processor activeProcessIsSystemProcess
@@ -1315,8 +1315,8 @@
parentProcess
"answer my parent"
- ProcessorScheduler knownProcessesDo:[:p|
- p id = creatorId ifTrue:[^ p].
+ ProcessorScheduler knownProcessesDo:[:p|
+ p id = creatorId ifTrue:[^ p].
].
^ nil.
@@ -1335,13 +1335,13 @@
processes := ProcessorScheduler knownProcesses.
leader := processes detect:[:p| p id = processGroupId] ifNone:nil.
leader isNil ifTrue:[
- leader := self.
- [
- creatorId := leader creatorId.
- next := processes detect:[:p| p id = creatorId
- and:[p processGroupId = processGroupId]]
- ifNone:nil.
- ] doWhile:[next notNil and:[leader := next. true]].
+ leader := self.
+ [
+ creatorId := leader creatorId.
+ next := processes detect:[:p| p id = creatorId
+ and:[p processGroupId = processGroupId]]
+ ifNone:nil.
+ ] doWhile:[next notNil and:[leader := next. true]].
].
^ leader.
@@ -1390,15 +1390,15 @@
!
uninterruptablyDo:aBlock
- "execute aBlock with interrupts blocked.
+ "execute aBlock with interrupts blocked.
This does not prevent preemption by a higher priority processes
if any becomes runnable due to the evaluation of aBlock
(i.e. if a semaphore is signalled there)."
"we must keep track of blocking-state if this is called nested"
(OperatingSystem blockInterrupts) ifTrue:[
- "/ already blocked
- ^ aBlock value
+ "/ already blocked
+ ^ aBlock value
].
^ aBlock ensure:[OperatingSystem unblockInterrupts]
@@ -1408,16 +1408,16 @@
"wait until the receiver is suspended."
self isDead ifFalse:[
- [
- "/ must check again - interrupt could have happened
- "/ and process already terminated.
- self isDead ifFalse:[
- suspendSemaphore isNil ifTrue:[
- suspendSemaphore := Semaphore new name:'process suspend'
- ].
- suspendSemaphore wait
- ]
- ] valueUninterruptably
+ [
+ "/ must check again - interrupt could have happened
+ "/ and process already terminated.
+ self isDead ifFalse:[
+ suspendSemaphore isNil ifTrue:[
+ suspendSemaphore := Semaphore new name:'process suspend'
+ ].
+ suspendSemaphore wait
+ ]
+ ] valueUninterruptably
]
"Modified: 8.11.1996 / 23:05:24 / cg"
@@ -1444,7 +1444,7 @@
waitUntilTerminatedWithTimeout:secondsOrNil
"wait until the receiver is terminated or (if non-nil) until
- the time period exired.
+ the time period exired.
Returns true if a timeout occurred.
This method allows another process to wait until the receiver finishes
(optionally) within some time."
@@ -1454,15 +1454,15 @@
didTimeout := false.
self isDead ifFalse:[
- [
- "/ must check again - interrupt could have happened
- "/ and process already terminated.
- self isDead ifFalse:[
- sema := Semaphore new name:'process termination'.
- self addExitAction:[sema signal].
- didTimeout := (sema waitWithTimeout:secondsOrNil) isNil
- ]
- ] valueUninterruptably.
+ [
+ "/ must check again - interrupt could have happened
+ "/ and process already terminated.
+ self isDead ifFalse:[
+ sema := Semaphore new name:'process termination'.
+ self addExitAction:[sema signal].
+ didTimeout := (sema waitWithTimeout:secondsOrNil) isNil
+ ]
+ ] valueUninterruptably.
].
^ didTimeout
@@ -1473,7 +1473,7 @@
Transcript showCR:'now waiting ...'.
(p waitUntilTerminatedWithTimeout:2) ifTrue:[
- Transcript showCR:'timeout occurred.'
+ Transcript showCR:'timeout occurred.'
]
"
@@ -1514,7 +1514,7 @@
self priority:aPrio.
^ aBlock ensure:[
- self priority:oldprio
+ self priority:oldprio
]
"
@@ -1539,8 +1539,8 @@
self priorityRange:(lowPrio to:highPrio).
^ aBlock ensure:[
- self priorityRange:oldRange.
- self priority:oldprio.
+ self priorityRange:oldRange.
+ self priority:oldprio.
]
"
@@ -1549,7 +1549,7 @@
!
withSystemBackgroundPriorityDo:aBlock
- "execute aBlock at system background priority.
+ "execute aBlock at system background priority.
This can be used to perform
background operations at a more user-friendly priority."
@@ -1588,7 +1588,7 @@
savedGroupId := processGroupId.
- (Processor newProcessFor:self withId:id) ifFalse:[
+ (Processor newProcessFor:self withId:id) ifFalse:[
"for some reason, the Processor was unable to create
a VM process for me ...."
@@ -1619,42 +1619,42 @@
"start the process - this is sent by the VM to the process to get
the process up and running.
Sending #start to the process (instead of directly executing the startBlock)
- allows more flexible handling of processes, since anything that responds
+ allows more flexible handling of processes, since anything that responds
to #start can be handled transparently by the VM then ..."
|block|
(block := startBlock) notNil ifTrue:[
- "/
- "/ just for your convenience ...
- "/
- name isNil ifTrue:[
- name := '(' , block displayString , ')'
- ].
- restartable ~~ true ifTrue:[startBlock := nil].
+ "/
+ "/ just for your convenience ...
+ "/
+ name isNil ifTrue:[
+ name := '(' , block displayString , ')'
+ ].
+ restartable ~~ true ifTrue:[startBlock := nil].
- [
- "/
- "/ handle Process-Termination, Process-Restart and Abort
- "/
- CoughtSignals handle:[:ex |
- ex signal == RestartProcessRequest ifTrue:[
- ex restart
- ].
- ex return
- ] do:[
- exceptionHandlerSet isNil ifTrue:[
- exceptionHandlerSet := ExceptionHandlerSet new.
- ].
- "/
- "/ block is the one which received the fork some time ago...
- "/
- exceptionHandlerSet handleDo:block
- ]
- ] ensure:[self terminateNoSignal].
+ [
+ "/
+ "/ handle Process-Termination, Process-Restart and Abort
+ "/
+ CoughtSignals handle:[:ex |
+ ex signal == RestartProcessRequest ifTrue:[
+ ex restart
+ ].
+ ex return
+ ] do:[
+ exceptionHandlerSet isNil ifTrue:[
+ exceptionHandlerSet := ExceptionHandlerSet new.
+ ].
+ "/
+ "/ block is the one which received the fork some time ago...
+ "/
+ exceptionHandlerSet handleDo:block
+ ]
+ ] ensure:[self terminateNoSignal].
] ifFalse:[
- "is this artificial restriction useful ?"
- self error:'a process cannot be started twice' mayProceed:true
+ "is this artificial restriction useful ?"
+ self error:'a process cannot be started twice' mayProceed:true
]
"Modified: / 17.11.2001 / 16:45:32 / cg"
@@ -1663,17 +1663,17 @@
!Process methodsFor:'suspend & resume'!
abort
- "raise an AbortOperationRequest in the receiver process.
- Most processes willing to handle this will return to some save state
+ "raise an AbortOperationRequest in the receiver process.
+ Most processes willing to handle this will return to some save state
(typically, some kind of event loop).
If not handled, this will result in termination of the process."
Processor activeProcess == self ifTrue:[
- AbortOperationRequest raiseRequest
+ AbortOperationRequest raiseRequest
] ifFalse:[
- self interruptWith:[
- AbortOperationRequest raiseRequest
- ].
+ self interruptWith:[
+ AbortOperationRequest raiseRequest
+ ].
]
"Modified: / 16.11.2001 / 17:39:18 / cg"
@@ -1728,7 +1728,7 @@
suspendSemaphore notNil ifTrue:[suspendSemaphore signalForAll].
suspendActions notNil ifTrue:[
- suspendActions do:[:action | action value]
+ suspendActions do:[:action | action value]
].
"
@@ -1737,17 +1737,17 @@
In this case, do not set the receivers state to #suspend.
(All of this to enhance the output of the process monitor ...)
"
- (state == #active
- or:[state == #run
+ (state == #active
+ or:[state == #run
or:[aStateSymbol == #stopped]]) ifTrue:[
- state := aStateSymbol.
+ state := aStateSymbol.
].
Processor suspend:self
!
terminate
- "terminate the receiver process.
- Termination is done by raising the terminateSignal in the receiver process,
+ "terminate the receiver process.
+ Termination is done by raising the terminateSignal in the receiver process,
which can be caught.
All unwind actions and the exit-actions (if any)
will be performed before the process is really terminated.
@@ -1759,48 +1759,48 @@
|wasBlocked|
Processor activeProcess ~~ self ifTrue:[
- wasBlocked := OperatingSystem blockInterrupts.
- [
- state == #osWait ifTrue:[
- self terminateNoSignal.
- ^ self.
- ].
+ wasBlocked := OperatingSystem blockInterrupts.
+ [
+ state == #osWait ifTrue:[
+ self terminateNoSignal.
+ ^ self.
+ ].
- "if the receiver had no chance to execute yet,
- it can be shot down without a signal"
+ "if the receiver had no chance to execute yet,
+ it can be shot down without a signal"
- self suspendedContext isNil ifTrue:[
- self terminateNoSignal.
- ^ self
- ]
- ] ensure:[
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts]
- ].
+ self suspendedContext isNil ifTrue:[
+ self terminateNoSignal.
+ ^ self
+ ]
+ ] ensure:[
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts]
+ ].
- "register an interrupt action and resume that process"
- self interruptWith:[
- NoHandlerError handle:[:ex |
- ex parameter signal == TerminateProcessRequest ifTrue:[
- ex return.
- ].
- ex reject.
- ] do:[
- TerminateProcessRequest raise.
- ].
- self terminateNoSignal.
- ].
+ "register an interrupt action and resume that process"
+ self interruptWith:[
+ NoHandlerError handle:[:ex |
+ ex parameter signal == TerminateProcessRequest ifTrue:[
+ ex return.
+ ].
+ ex reject.
+ ] do:[
+ TerminateProcessRequest raise.
+ ].
+ self terminateNoSignal.
+ ].
] ifFalse:[
- "terminating myself"
+ "terminating myself"
- NoHandlerError handle:[:ex |
- ex parameter signal == TerminateProcessRequest ifTrue:[
- ex return.
- ].
- ex reject.
- ] do:[
- TerminateProcessRequest raise.
- ].
- self terminateNoSignal.
+ NoHandlerError handle:[:ex |
+ ex parameter signal == TerminateProcessRequest ifTrue:[
+ ex return.
+ ].
+ ex reject.
+ ] do:[
+ TerminateProcessRequest raise.
+ ].
+ self terminateNoSignal.
]
"Modified: / 24.8.1998 / 18:29:46 / cg"
@@ -1812,26 +1812,26 @@
the receiver itself)."
id isNil ifTrue:[
- "/ problem:
- "/ if receiver is already dead, its id is nil.
- "/ children are found by looking for processes with a parentID identical to
- "/ mine - ifNil, system processes are found, which is probably not what you
- "/ want ...
- "/ FIX: remember the id (or dont nil it when terminating)
- "/ requires VM changes.
- ProcessorScheduler invalidProcessSignal
- raiseRequestWith:self
- errorString:'process is already dead - cannot determine child processes'.
- ^ self
+ "/ problem:
+ "/ if receiver is already dead, its id is nil.
+ "/ children are found by looking for processes with a parentID identical to
+ "/ mine - ifNil, system processes are found, which is probably not what you
+ "/ want ...
+ "/ FIX: remember the id (or dont nil it when terminating)
+ "/ requires VM changes.
+ ProcessorScheduler invalidProcessSignal
+ raiseRequestWith:self
+ errorString:'process is already dead - cannot determine child processes'.
+ ^ self
].
ProcessorScheduler knownProcesses do:[:aProcess |
- aProcess ~~ self ifTrue:[
- aProcess creatorId == id ifTrue:[
- aProcess isGUIProcess ifTrue:[
- aProcess terminateWithAllGUISubprocesses
- ]
- ]
- ]
+ aProcess ~~ self ifTrue:[
+ aProcess creatorId == id ifTrue:[
+ aProcess isGUIProcess ifTrue:[
+ aProcess terminateWithAllGUISubprocesses
+ ]
+ ]
+ ]
].
"Created: / 28-10-1996 / 20:43:32 / cg"
@@ -1845,17 +1845,17 @@
and recursively oll of their group processes.)."
id isNil ifTrue:[
- "/ problem:
- "/ if receiver is already dead, its id is nil.
- "/ children are found by looking for processes with a parentID identical to
- "/ mine - ifNil, system processes are found, which is probably not what you
- "/ want ...
- "/ FIX: remember the id (or dont nil it when terminating)
- "/ requires VM changes.
- ProcessorScheduler invalidProcessSignal
- raiseRequestWith:self
- errorString:'process is already dead - cannot determine child processes'.
- ^ self
+ "/ problem:
+ "/ if receiver is already dead, its id is nil.
+ "/ children are found by looking for processes with a parentID identical to
+ "/ mine - ifNil, system processes are found, which is probably not what you
+ "/ want ...
+ "/ FIX: remember the id (or dont nil it when terminating)
+ "/ requires VM changes.
+ ProcessorScheduler invalidProcessSignal
+ raiseRequestWith:self
+ errorString:'process is already dead - cannot determine child processes'.
+ ^ self
].
self terminateAllSubprocessesInGroup:id
!
@@ -1867,11 +1867,11 @@
and recursively oll of their group processes.)."
ProcessorScheduler knownProcesses do:[:aProcess |
- aProcess ~~ self ifTrue:[
- (aProcess processGroupId == aGroup) ifTrue:[
- aProcess terminateWithAllSubprocessesInGroup
- ]
- ]
+ aProcess ~~ self ifTrue:[
+ (aProcess processGroupId == aGroup) ifTrue:[
+ aProcess terminateWithAllSubprocessesInGroup
+ ]
+ ]
].
"Created: / 28.10.1996 / 20:43:32 / cg"
@@ -1879,28 +1879,28 @@
!
terminateGroup
- "terminate the receiver with all of its created subprocesses
+ "terminate the receiver with all of its created subprocesses
that are in the receivers process group."
id isNil ifTrue:[
- "/ problem:
- "/ if receiver is already dead, its id is nil.
- "/ children are found by looking for processes with a parentID identical to
- "/ mine - ifNil, system processes are found, which is probably not what you
- "/ want ...
- "/ FIX: remember the id (or dont nil it when terminating)
- "/ requires VM changes.
- ProcessorScheduler invalidProcessSignal
- raiseRequestWith:self
- errorString:'process is already dead - cannot determine child processes'.
- ^ self
+ "/ problem:
+ "/ if receiver is already dead, its id is nil.
+ "/ children are found by looking for processes with a parentID identical to
+ "/ mine - ifNil, system processes are found, which is probably not what you
+ "/ want ...
+ "/ FIX: remember the id (or dont nil it when terminating)
+ "/ requires VM changes.
+ ProcessorScheduler invalidProcessSignal
+ raiseRequestWith:self
+ errorString:'process is already dead - cannot determine child processes'.
+ ^ self
].
ProcessorScheduler knownProcesses do:[:aProcess |
- aProcess ~~ self ifTrue:[
- aProcess processGroupId == id ifTrue:[
- aProcess terminate
- ]
- ]
+ aProcess ~~ self ifTrue:[
+ aProcess processGroupId == id ifTrue:[
+ aProcess terminate
+ ]
+ ]
].
self terminate
!
@@ -1935,34 +1935,34 @@
!
terminateSubprocesses
- "terminate all the receivers subprocesses
+ "terminate all the receivers subprocesses
(i.e. all processes in the receivers process group, except for
the receiver itself)."
id isNil ifTrue:[
- "/ problem:
- "/ if receiver is already dead, its id is nil.
- "/ children are found by looking for processes with a parentID identical to
- "/ mine - ifNil, system processes are found, which is probably not what you
- "/ want ...
- "/ FIX: remember the id (or dont nil it when terminating)
- "/ requires VM changes.
- ProcessorScheduler invalidProcessSignal
- raiseRequestWith:self
- errorString:'process is already dead - cannot determine child processes'.
- ^ self
+ "/ problem:
+ "/ if receiver is already dead, its id is nil.
+ "/ children are found by looking for processes with a parentID identical to
+ "/ mine - ifNil, system processes are found, which is probably not what you
+ "/ want ...
+ "/ FIX: remember the id (or dont nil it when terminating)
+ "/ requires VM changes.
+ ProcessorScheduler invalidProcessSignal
+ raiseRequestWith:self
+ errorString:'process is already dead - cannot determine child processes'.
+ ^ self
].
processGroupId == 0 ifTrue:[
- ProcessorScheduler invalidProcessSignal
- raiseWith:self errorString:'trying to terminate the system process group'.
+ ProcessorScheduler invalidProcessSignal
+ raiseWith:self errorString:'trying to terminate the system process group'.
].
ProcessorScheduler knownProcesses do:[:aProcess |
- aProcess ~~ self ifTrue:[
- (aProcess processGroupId == processGroupId
- or:[aProcess processGroupId == id]) ifTrue:[
- aProcess terminate
- ]
- ]
+ aProcess ~~ self ifTrue:[
+ (aProcess processGroupId == processGroupId
+ or:[aProcess processGroupId == id]) ifTrue:[
+ aProcess terminate
+ ]
+ ]
].
"Created: 28.10.1996 / 20:41:49 / cg"
@@ -1983,7 +1983,7 @@
"terminate the receiver with
all subprocesses which have the receivers process ID as groupID,
and their group-children as well.
- (i.e. the receiver plus all processes in the receivers process group,
+ (i.e. the receiver plus all processes in the receivers process group,
and recursively all of their group processes)."
self terminateAllSubprocessesInGroup.
@@ -1998,11 +1998,11 @@
environmentAt:aKey
"return the value of a thread local variable, or raise an error, if no such variable exists"
- ^ self
- environmentAt:aKey
- ifAbsent:[
- self errorKeyNotFound:aKey.
- ]
+ ^ self
+ environmentAt:aKey
+ ifAbsent:[
+ self errorKeyNotFound:aKey.
+ ]
!
environmentAt:aKey ifAbsent:defaultValue
@@ -2021,12 +2021,12 @@
|var|
environment isNil ifTrue:[
- environment := IdentityDictionary new
+ environment := IdentityDictionary new
].
var := environment at:aKey ifAbsent:nil.
var isNil ifTrue:[
- var := ValueHolder new.
- environment at:aKey put:var.
+ var := ValueHolder new.
+ environment at:aKey put:var.
].
var value:aValue.
^ aValue
@@ -2045,22 +2045,22 @@
|var oldValue result|
environment isNil ifTrue:[
- environment := IdentityDictionary new
+ environment := IdentityDictionary new
].
var := environment at:variableNameSymbol ifAbsent:nil.
var isNil ifTrue:[
- var := ValueHolder new.
- environment at:variableNameSymbol put:var.
+ var := ValueHolder new.
+ environment at:variableNameSymbol put:var.
].
oldValue := var value.
[
- var value:aValue.
- result := aBlock value.
+ var value:aValue.
+ result := aBlock value.
] ensure:[
- oldValue isNil
- ifTrue:[ environment removeKey:variableNameSymbol]
- ifFalse:[ var value:oldValue ]
+ oldValue isNil
+ ifTrue:[ environment removeKey:variableNameSymbol]
+ ifFalse:[ var value:oldValue ]
].
^ result
! !
@@ -2069,7 +2069,7 @@
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Process.st,v 1.176 2012-10-26 11:19:56 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Process.st,v 1.177 2013-01-27 01:16:31 cg Exp $'
!
version_SVN
--- a/RecursionLock.st Wed Jan 23 10:08:55 2013 +0000
+++ b/RecursionLock.st Mon Jan 28 21:53:19 2013 +0000
@@ -202,6 +202,10 @@
"/
wasBlocked := OperatingSystem blockInterrupts.
[
+ (process notNil and:[process isDead]) ifTrue:[
+ 'RecursionLock [warning]: cleanup lock from dead process' infoPrintCR.
+ process := nil. sema signal.
+ ].
gotSema := sema wait.
process := active.
wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
@@ -318,9 +322,10 @@
!RecursionLock class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/RecursionLock.st,v 1.36 2011-04-27 15:14:06 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/RecursionLock.st,v 1.37 2013-01-23 22:28:47 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/RecursionLock.st,v 1.36 2011-04-27 15:14:06 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/RecursionLock.st,v 1.37 2013-01-23 22:28:47 cg Exp $'
! !
+
--- a/SHA1Stream.st Wed Jan 23 10:08:55 2013 +0000
+++ b/SHA1Stream.st Mon Jan 28 21:53:19 2013 +0000
@@ -320,7 +320,8 @@
Stefan Vogel
[see also:]
- MD5Stream SHA256Stream SHA512Stream
+ MD5Stream
+ SHA256Stream SHA512Stream (in libcrypt)
[class variables:]
HashSize size of returned hash value
@@ -518,7 +519,6 @@
INT objSize;
int nInstVars, nInstBytes;
char *extPtr;
- OBJ oClass;
if (__isByteArray(__INST(hashContext))
&& __byteArraySize(__INST(hashContext)) == sizeof(SHA1_CTX)
@@ -529,8 +529,7 @@
len = __intVal(count);
offs = __intVal(start) - 1;
- oClass = __Class(anObject);
- if (oClass == ExternalBytes) {
+ if (__isExternalBytesLike(anObject)) {
OBJ sz;
nInstBytes = 0;
@@ -543,6 +542,9 @@
objSize = 0; /* unknown */
}
} else {
+ OBJ oClass;
+
+ oClass = __Class(anObject);
switch (__intVal(__ClassInstPtr(oClass)->c_flags) & ARRAYMASK) {
case BYTEARRAY:
case WORDARRAY:
@@ -563,7 +565,7 @@
extPtr = (char *)__byteArrayVal(anObject)+nInstBytes;
}
if ((offs >= 0) && (len >= 0) && (objSize >= (len + offs))) {
- SHA1Update(ctx, extPtr+offs, len);
+ SHA1Update(ctx, extPtr+offs, (unsigned int)len);
RETURN (count);
}
}
@@ -576,11 +578,12 @@
!SHA1Stream class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/SHA1Stream.st,v 1.30 2013-01-17 23:54:04 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/SHA1Stream.st,v 1.33 2013-01-27 13:55:22 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/SHA1Stream.st,v 1.30 2013-01-17 23:54:04 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/SHA1Stream.st,v 1.33 2013-01-27 13:55:22 cg Exp $'
! !
+
SHA1Stream initialize!
--- a/SequenceableCollection.st Wed Jan 23 10:08:55 2013 +0000
+++ b/SequenceableCollection.st Mon Jan 28 21:53:19 2013 +0000
@@ -606,6 +606,21 @@
^ self copyFrom:2
!
+joinWith:separatingElement
+ "return a collection generated by concatenating my elements
+ and embedding separatingElement in between.
+ Similar to asStringWith:, but not specifically targeted towards collections of strings."
+
+ ^ self
+ joinWithAll:(Array with:separatingElement)
+ from:1 to:(self size) as:nil
+
+ "
+ #('hello' 'world' 'foo' 'bar' 'baz') joinWith:$;
+ #('hello' 'world' 'foo' 'bar' 'baz') joinWith:$|
+ "
+!
+
shuffled
"return a randomly shuffled copy of the receiver"
@@ -668,7 +683,6 @@
^ self replaceFrom:start to:stop with:anArray startingAt:repStart
! !
-
!SequenceableCollection methodsFor:'accessing'!
after:anObject
@@ -2390,7 +2404,8 @@
asStringWith:sepChar
"return a string generated by concatenating my elements
(which must be strings or nil) and embedding sepChar characters in between.
- Nil entries and empty strings are counted as empty lines."
+ Nil entries and empty strings are counted as empty lines.
+ Similar to joinWith:, but specifically targeted towards collections of strings."
^ self
from:1 to:(self size)
@@ -2410,13 +2425,14 @@
asStringWith:sepCharacter from:firstLine to:lastLine
"return part of myself as a string with embedded sepCharacters.
My elements must be strings or nil; nil entries and empty strings are
- taken as empty lines."
+ taken as empty lines.
+ Similar to joinWith:, but specifically targeted towards collections of strings."
^ self
- from:firstLine to:lastLine
- asStringWith:sepCharacter
- compressTabs:false
- final:nil
+ from:firstLine to:lastLine
+ asStringWith:sepCharacter
+ compressTabs:false
+ final:nil
"
creating entries for searchpath:
@@ -2434,14 +2450,15 @@
taken as empty lines.
If the argument compressTabs is true, leading spaces are converted
to tab-characters (8col tabs). The last line is followed by a final
- character (if non-nil)."
+ character (if non-nil).
+ Similar to joinWith:, but specifically targeted towards collections of strings."
^ self
- from:firstLine to:lastLine
- asStringWith:sepCharacter
- compressTabs:compressTabs
- final:endCharacter
- withEmphasis:true
+ from:firstLine to:lastLine
+ asStringWith:sepCharacter
+ compressTabs:compressTabs
+ final:endCharacter
+ withEmphasis:true
"Modified: / 17.6.1998 / 12:31:19 / cg"
!
@@ -2459,14 +2476,15 @@
any emphasis. If false, a plain string is returned.
This method is tuned for big collections, in not creating many
intermediate strings (has linear runtime). For very small collections
- and small strings, it may be faster to use the comma , operation."
+ and small strings, it may be faster to use the comma , operation.
+ Similar to joinWith:, but specifically targeted towards collections of strings."
^ self
- from:firstLine to:lastLine
- asStringWith:sepCharacter
- compressTabs:compressTabs
- final:endCharacter
- withEmphasis:withEmphasis
+ from:firstLine to:lastLine
+ asStringWith:sepCharacter
+ compressTabs:compressTabs
+ final:endCharacter
+ withEmphasis:withEmphasis
!
asStringWithCRs
@@ -2531,11 +2549,11 @@
to tab-characters (8col tabs). WithCR controls whether the last line
should be followed by a cr or not."
- ^ self asStringWith:(Character cr)
- from:firstLine
- to:lastLine
- compressTabs:compressTabs
- final:(withCR ifTrue:[Character cr] ifFalse:[nil])
+ ^ self
+ asStringWith:(Character cr)
+ from:firstLine to:lastLine
+ compressTabs:compressTabs
+ final:(withCR ifTrue:[Character cr] ifFalse:[nil])
!
decodeAsLiteralArray
@@ -2892,6 +2910,87 @@
"Modified: / 17.6.1998 / 12:31:59 / cg"
!
+joinWithAll:separatingCollection
+ "return a collection generated by concatenating my elements
+ and slicing separatingCollection in between.
+ Similar to asStringWith:, but not specifically targeted towards collections of strings."
+
+ ^ self
+ joinWithAll:separatingCollection
+ from:1 to:(self size) as:nil
+
+ "
+ #('hello' 'world' 'foo' 'bar' 'baz') joinWithAll:' ; '
+ #('hello' 'world' 'foo' 'bar' 'baz') joinWithAll:' | '
+ "
+!
+
+joinWithAll:separatingCollection from:startIndex to:endIndex as:speciesOrNil
+ "extract parts of myself as a new collection with optional embedded separator.
+ Separator may be nil, or a collection of elements to be sliced in between.
+ SpeciesOrNil specifies the species of the resultig object, allowing for Arrays to be converted
+ as OrderedCollection or vice versa on the fly. If nil is passed in, the species of the first non-nil
+ element is used.
+ This counts the overall size first, then allocates the new collecton once and replaces elements
+ via bulk copies. For very small collections, it may be faster to use the comma , operation.
+ Similar to asStringWith:, but not specifically targeted towards string handling."
+
+ |totalLength "{ Class:SmallInteger }"
+ pos "{ Class:SmallInteger }"
+ sepCnt "{ Class:SmallInteger }"
+ subColl newColl
+ species|
+
+ startIndex = endIndex ifTrue:[ ^ self at:startIndex ].
+
+ species := speciesOrNil.
+
+ "
+ first accumulate the size of the result,
+ to avoid countless reallocations.
+ "
+ totalLength := 0.
+ sepCnt := separatingCollection size.
+
+ startIndex to:endIndex do:[:index |
+ subColl := self at:index.
+ totalLength := totalLength + subColl size.
+ species isNil ifTrue:[
+ subColl notNil ifTrue:[
+ species := subColl species
+ ]
+ ]
+ ].
+ totalLength := totalLength + ((endIndex - startIndex) * sepCnt).
+ newColl := species withSize:totalLength.
+
+ pos := 1.
+ startIndex to:endIndex do:[:index |
+ subColl := self at:index.
+ subColl size ~~ 0 ifTrue:[
+ newColl replaceFrom:pos with:subColl startingAt:1.
+ pos := pos + subColl size.
+ ].
+ ((sepCnt ~~ 0) and:[index ~~ endIndex]) ifTrue:[
+ newColl replaceFrom:pos to:(pos+sepCnt-1) with:separatingCollection startingAt:1.
+ pos := pos + sepCnt.
+ ].
+ ].
+
+ ^ newColl
+
+ "
+ #( 'aa' 'bb' '' 'cc' ) joinWith:'|' from:1 to:4 as:String
+ #( 'aa' 'bb' '' 'cc' ) joinWith:nil from:1 to:4 as:String
+ #( 'aa' 'bb' '' 'cc' ) joinWith:'|' from:1 to:4 as:Array
+ #( (1 2 3) (4 5 6) (7 6 8) ) joinWith:#(nil) from:1 to:3 as:OrderedCollection
+ #( (1 2 3) (4 5 6) (7 6 8) ) joinWith:nil from:1 to:3 as:nil
+ "
+
+ "Created: / 17.6.1998 / 12:30:32 / cg"
+ "Modified: / 17.6.1998 / 12:31:59 / cg"
+!
+
subCollections:aBlock
"Answser an ordered collection of ordered collections
where each subcollection is delimited by an element of the receiver
@@ -4624,6 +4723,22 @@
"
!
+keysAndValuesConform:aTwoArgBlock
+ "evaluate the argument, aBlock for every element in the collection,
+ passing both index and element as arguments.
+ Return false if any such evaluation returns false, true otherwise."
+
+ self keysAndValuesDo:[:index :el |
+ (aTwoArgBlock value:index value:el) ifFalse:[^ false].
+ ].
+ ^ true
+
+ "
+ #(10 20 30 40) keysAndValuesConform:[:key :element | element = (key * 10) ].
+ #(10 20 30 33 40) keysAndValuesConform:[:key :element | element = (key * 10) ].
+ "
+!
+
keysAndValuesDo:aTwoArgBlock
"evaluate the argument, aBlock for every element in the collection,
passing both index and element as arguments."
@@ -8733,11 +8848,11 @@
!SequenceableCollection class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/SequenceableCollection.st,v 1.328 2013-01-01 11:30:33 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/SequenceableCollection.st,v 1.330 2013-01-23 17:40:11 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/SequenceableCollection.st,v 1.328 2013-01-01 11:30:33 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/SequenceableCollection.st,v 1.330 2013-01-23 17:40:11 cg Exp $'
! !
--- a/ShortFloat.st Wed Jan 23 10:08:55 2013 +0000
+++ b/ShortFloat.st Mon Jan 28 21:53:19 2013 +0000
@@ -38,6 +38,10 @@
extern errno;
#endif
+#if !defined (WIN32)
+# include <locale.h>
+#endif
+
#if defined (_AIX)
# include <float.h>
#endif
@@ -167,7 +171,10 @@
ShortFloats give you 32 bit floats.
Notice, that ST/X Floats are what Doubles are in ST-80 and ShortFloats are
- ST-80's Floats respectively.
+ ST-80's Floats respectively. The reason was to make ST/X's floats compatible
+ to bothe visualWorks and other smalltalks, which use C-doubles for the Float class.
+ Thus, STX's Float precision is not worse than that of other ST's.
+
This may change in one of the next versions (at least on machines, which
provide different float and double types in their C-compiler.
@@ -237,15 +244,15 @@
%{ /* NOCONTEXT */
if (__isStringLike(aString) && __isSmallInteger(startIndex)) {
- char *cp = (char *)(__stringVal(aString));
- int idx = __intVal(startIndex) - 1;
- double atof();
- double val;
+ char *cp = (char *)(__stringVal(aString));
+ int idx = __intVal(startIndex) - 1;
+ double atof();
+ double val;
- if ((unsigned)idx < __stringSize(aString)) {
- val = atof(cp + idx);
- RETURN (__MKSFLOAT(val));
- }
+ if ((unsigned)idx < __stringSize(aString)) {
+ val = atof(cp + idx);
+ RETURN (__MKSFLOAT(val));
+ }
}
%}.
self primitiveFailed.
@@ -265,17 +272,17 @@
ShortFloat fastFromString:'hello123.45E4' at:1
Time millisecondsToRun:[
- 100000 timesRepeat:[
- ShortFloat readFrom:'123.45'
- ]
+ 100000 timesRepeat:[
+ ShortFloat readFrom:'123.45'
+ ]
]
"
"
Time millisecondsToRun:[
- 100000 timesRepeat:[
- ShortFloat fastFromString:'123.45' at:1
- ]
+ 100000 timesRepeat:[
+ ShortFloat fastFromString:'123.45' at:1
+ ]
]
"
!
@@ -362,14 +369,14 @@
self isIEEEFormat ifFalse:[self error:'unsupported operation'].
UninterpretedBytes isBigEndian ifFalse:[
- "swap the bytes"
- 4 to:1 by:-1 do:[:i |
- aFloat basicAt:i put:(aStream next)
- ].
- ^ self
+ "swap the bytes"
+ 4 to:1 by:-1 do:[:i |
+ aFloat basicAt:i put:(aStream next)
+ ].
+ ^ self
].
1 to:4 do:[:i |
- aFloat basicAt:i put:aStream next
+ aFloat basicAt:i put:aStream next
]
"not part of libboss, as this is also used by others (TIFFReader)"
@@ -393,14 +400,14 @@
self isIEEEFormat ifFalse:[self error:'unsupported operation'].
UninterpretedBytes isBigEndian ifFalse:[
- "swap the bytes"
- 4 to:1 by:-1 do:[:i |
- aStream nextPut:(float basicAt:i).
- ].
- ^ self
+ "swap the bytes"
+ 4 to:1 by:-1 do:[:i |
+ aStream nextPut:(float basicAt:i).
+ ].
+ ^ self
].
1 to:4 do:[:i |
- aStream nextPut:(float basicAt:i).
+ aStream nextPut:(float basicAt:i).
]
"not part of libboss, as this is also used by others (TIFFReader)"
@@ -438,6 +445,11 @@
"Modified: 23.4.1996 / 09:26:45 / cg"
! !
+!ShortFloat class methodsFor:'odbc queries'!
+
+odbcTypeSymbol
+ ^ #'SQL_FLOAT'
+! !
!ShortFloat class methodsFor:'queries'!
@@ -664,6 +676,60 @@
!
+rem: aNumber
+ "return the floating point remainder of the receiver and the argument, aNumber"
+
+%{ /* NOCONTEXT */
+
+ /*
+ * notice:
+ * the following inline code handles some common cases,
+ * and exists as an optimization, to speed up those cases.
+ *
+ * Conceptionally, (and for most other argument types),
+ * mixed arithmetic is implemented by double dispatching
+ * (see the message send at the bottom)
+ */
+ OBJ newFloat;
+ float result, val;
+ double dResult, dVal;
+
+ if (__isSmallInteger(aNumber)) {
+ if (aNumber != __mkSmallInteger(0)) {
+ val = (float)__intVal(aNumber);
+computeResult:
+#ifdef NO_FMODF
+ dResult = fmod((double)__shortFloatVal(self), (double)val) ;
+ result = (float)dResult;
+#else
+ result = fmodf(__shortFloatVal(self), val) ;
+#endif
+ __qMKSFLOAT(newFloat, result);
+ RETURN ( newFloat );
+ }
+ } else if (__isFloatLike(aNumber)) {
+ dVal = __floatVal(aNumber);
+ if (dVal != 0.0) {
+ dResult = fmod((double)(__shortFloatVal(self)), dVal) ;
+ __qMKFLOAT(newFloat, dResult);
+ RETURN ( newFloat );
+ }
+ } else if (__isShortFloat(aNumber)) {
+ val = __shortFloatVal(aNumber);
+ if (val != 0.0) {
+ goto computeResult;
+ }
+ }
+%}.
+ ((aNumber == 0) or:[aNumber = 0.0]) ifTrue:[
+ "
+ No, you shalt not divide by zero
+ "
+ ^ ZeroDivide raiseRequestWith:thisContext.
+ ].
+ ^ aNumber remainderFromShortFloat:self
+!
+
uncheckedDivide:aNumber
"return the quotient of the receiver and the argument, aNumber.
Do not check for divide by zero (return NaN or Infinity).
@@ -945,23 +1011,23 @@
OBJ newFloat;
if (sizeof(float) == 4) {
- x = __shortFloatVal(self);
- {
- float xhalf = 0.5f * x;
- int i = *(int*)&x; // store floating-point bits in integer
+ x = __shortFloatVal(self);
+ {
+ float xhalf = 0.5f * x;
+ int i = *(int*)&x; // store floating-point bits in integer
- i = 0x5f3759d5 - (i >> 1); // initial guess for Newton's method
- x = *(float*)&i; // convert new bits into float
- x = x*(1.5f - xhalf*x*x); // One round of Newton's method
- __qMKSFLOAT(newFloat, x);
- RETURN ( newFloat );
- }
+ i = 0x5f3759d5 - (i >> 1); // initial guess for Newton's method
+ x = *(float*)&i; // convert new bits into float
+ x = x*(1.5f - xhalf*x*x); // One round of Newton's method
+ __qMKSFLOAT(newFloat, x);
+ RETURN ( newFloat );
+ }
}
%}.
^ 1 / self sqrt
"
- 10.0 asShortFloat fastInverseSqrt
+ 10.0 asShortFloat fastInverseSqrt
(1 / 10.0 asShortFloat sqrt)
"
@@ -970,18 +1036,18 @@
a := 345 asShortFloat.
t0 := Time millisecondsToRun:[
- 1000000 timesRepeat:[
- ]
+ 1000000 timesRepeat:[
+ ]
].
t1 := Time millisecondsToRun:[
- 1000000 timesRepeat:[
- a fastInverseSqrt
- ]
+ 1000000 timesRepeat:[
+ a fastInverseSqrt
+ ]
].
t2 := Time millisecondsToRun:[
- 1000000 timesRepeat:[
- (1 / a sqrt)
- ]
+ 1000000 timesRepeat:[
+ (1 / a sqrt)
+ ]
].
Transcript show:'empty: '; showCR:t0.
Transcript show:'fast: '; showCR:t1.
@@ -1013,56 +1079,56 @@
__END_PROTECT_REGISTERS__
if (len >= 0 && len <= sizeof(buffer)-3) {
- /*
- * kludge to make integral float f prints as "f.0" (not as "f" as printf does)
- * (i.e. look if string contains '.' or 'e' and append '.0' if not)
- */
- for (cp = buffer; *cp; cp++) {
- if ((*cp == '.') || (*cp == ',') || (*cp == 'E') || (*cp == 'e')) break;
- }
- if (!*cp && (cp[-1] >= '0') && (cp[-1] <= '9')) {
- if (__isCharacter(@global(DecimalPointCharacterForPrinting))) {
- *cp++ = __intVal(__characterVal(@global(DecimalPointCharacterForPrinting)));
- } else {
- *cp++ = '.';
- }
- *cp++ = '0';
- *cp = '\0';
- } else {
- if (cp && (*cp == '.')) {
- if (__isCharacter(@global(DecimalPointCharacterForPrinting))) {
- *cp = __intVal(__characterVal(@global(DecimalPointCharacterForPrinting)));
- }
- }
- }
+ /*
+ * kludge to make integral float f prints as "f.0" (not as "f" as printf does)
+ * (i.e. look if string contains '.' or 'e' and append '.0' if not)
+ */
+ for (cp = buffer; *cp; cp++) {
+ if ((*cp == '.') || (*cp == ',') || (*cp == 'E') || (*cp == 'e')) break;
+ }
+ if (!*cp && (cp[-1] >= '0') && (cp[-1] <= '9')) {
+ if (__isCharacter(@global(DecimalPointCharacterForPrinting))) {
+ *cp++ = __intVal(__characterVal(@global(DecimalPointCharacterForPrinting)));
+ } else {
+ *cp++ = '.';
+ }
+ *cp++ = '0';
+ *cp = '\0';
+ } else {
+ if (cp && (*cp == '.')) {
+ if (__isCharacter(@global(DecimalPointCharacterForPrinting))) {
+ *cp = __intVal(__characterVal(@global(DecimalPointCharacterForPrinting)));
+ }
+ }
+ }
- s = __MKSTRING(buffer);
- if (s != nil) {
- RETURN (s);
- }
+ s = __MKSTRING(buffer);
+ if (s != nil) {
+ RETURN (s);
+ }
}
%}.
^ self asFloat printString
"
- 1.234 asShortFloat printString.
- 1.0 asShortFloat printString.
- 1e10 asShortFloat printString.
- 1.2e3 asShortFloat printString.
- 1.2e30 asShortFloat printString.
- (1.0 uncheckedDivide:0) asShortFloat printString.
- (0.0 uncheckedDivide:0) asShortFloat printString.
- self pi printString.
+ 1.234 asShortFloat printString.
+ 1.0 asShortFloat printString.
+ 1e10 asShortFloat printString.
+ 1.2e3 asShortFloat printString.
+ 1.2e30 asShortFloat printString.
+ (1.0 uncheckedDivide:0) asShortFloat printString.
+ (0.0 uncheckedDivide:0) asShortFloat printString.
+ self pi printString.
- DecimalPointCharacterForPrinting := $,.
- 1.234 asShortFloat printString.
- 1.0 asShortFloat printString.
- 1e10 asShortFloat printString.
- 1.2e3 asShortFloat printString.
- 1.2e30 asShortFloat printString.
- (1.0 uncheckedDivide:0) asShortFloat printString.
- (0.0 uncheckedDivide:0) asShortFloat printString.
- DecimalPointCharacterForPrinting := $.
+ DecimalPointCharacterForPrinting := $,.
+ 1.234 asShortFloat printString.
+ 1.0 asShortFloat printString.
+ 1e10 asShortFloat printString.
+ 1.2e3 asShortFloat printString.
+ 1.2e30 asShortFloat printString.
+ (1.0 uncheckedDivide:0) asShortFloat printString.
+ (0.0 uncheckedDivide:0) asShortFloat printString.
+ DecimalPointCharacterForPrinting := $.
"
!
@@ -1084,23 +1150,23 @@
int len;
if (__isStringLike(formatString)) {
- /*
- * actually only needed on sparc: since thisContext is
- * in a global register, which gets destroyed by printf,
- * manually save it here - very stupid ...
- */
- __BEGIN_PROTECT_REGISTERS__
+ /*
+ * actually only needed on sparc: since thisContext is
+ * in a global register, which gets destroyed by printf,
+ * manually save it here - very stupid ...
+ */
+ __BEGIN_PROTECT_REGISTERS__
- len = snprintf(buffer, sizeof(buffer), __stringVal(formatString), __shortFloatVal(self));
+ len = snprintf(buffer, sizeof(buffer), __stringVal(formatString), __shortFloatVal(self));
- __END_PROTECT_REGISTERS__
+ __END_PROTECT_REGISTERS__
- if (len < 0) goto fail;
+ if (len < 0) goto fail;
- s = __MKSTRING_L(buffer, len);
- if (s != nil) {
- RETURN (s);
- }
+ s = __MKSTRING_L(buffer, len);
+ if (s != nil) {
+ RETURN (s);
+ }
}
fail: ;
%}.
@@ -1141,23 +1207,23 @@
__END_PROTECT_REGISTERS__
if (len >= 0 && len < sizeof(buffer)-3) {
- /*
- * kludge to make integral float f prints as "f.0" (not as "f" as printf does)
- * (i.e. look if string contains '.' or 'e' and append '.0' if not)
- */
- for (cp = buffer; *cp; cp++) {
- if ((*cp == '.') || (*cp == ',') || (*cp == 'E') || (*cp == 'e')) break;
- }
- if (!*cp && (cp[-1] >= '0') && (cp[-1] <= '9')) {
- *cp++ = '.';
- *cp++ = '0';
- *cp = '\0';
- }
+ /*
+ * kludge to make integral float f prints as "f.0" (not as "f" as printf does)
+ * (i.e. look if string contains '.' or 'e' and append '.0' if not)
+ */
+ for (cp = buffer; *cp; cp++) {
+ if ((*cp == '.') || (*cp == ',') || (*cp == 'E') || (*cp == 'e')) break;
+ }
+ if (!*cp && (cp[-1] >= '0') && (cp[-1] <= '9')) {
+ *cp++ = '.';
+ *cp++ = '0';
+ *cp = '\0';
+ }
- s = __MKSTRING(buffer);
- if (s != nil) {
- RETURN (s);
- }
+ s = __MKSTRING(buffer);
+ if (s != nil) {
+ RETURN (s);
+ }
}
%}.
"
@@ -1170,26 +1236,26 @@
^ ObjectMemory allocationFailureSignal raise.
"
- 1.0 asShortFloat storeString
- 1.234 asShortFloat storeString
- 1e10 asShortFloat storeString
- 1.2e3 asShortFloat storeString
- 1.2e30 asShortFloat storeString
- Float pi asShortFloat storeString
- (1.0 uncheckedDivide:0) asShortFloat storeString
- (0.0 uncheckedDivide:0) asShortFloat storeString
+ 1.0 asShortFloat storeString
+ 1.234 asShortFloat storeString
+ 1e10 asShortFloat storeString
+ 1.2e3 asShortFloat storeString
+ 1.2e30 asShortFloat storeString
+ Float pi asShortFloat storeString
+ (1.0 uncheckedDivide:0) asShortFloat storeString
+ (0.0 uncheckedDivide:0) asShortFloat storeString
notice that the storeString is NOT affected by DecimalPointCharacterForPrinting:
- DecimalPointCharacterForPrinting := $,.
- 1.234 asShortFloat storeString.
- 1.0 asShortFloat storeString.
- 1e10 asShortFloat storeString.
- 1.2e3 asShortFloat storeString.
- 1.2e30 asShortFloat storeString.
- (1.0 uncheckedDivide:0) asShortFloat storeString.
- (0.0 uncheckedDivide:0) asShortFloat storeString.
- DecimalPointCharacterForPrinting := $.
+ DecimalPointCharacterForPrinting := $,.
+ 1.234 asShortFloat storeString.
+ 1.0 asShortFloat storeString.
+ 1e10 asShortFloat storeString.
+ 1.2e3 asShortFloat storeString.
+ 1.2e30 asShortFloat storeString.
+ (1.0 uncheckedDivide:0) asShortFloat storeString.
+ (0.0 uncheckedDivide:0) asShortFloat storeString.
+ DecimalPointCharacterForPrinting := $.
"
! !
@@ -1201,12 +1267,12 @@
Therefore, this method should be used strictly private.
Notice:
- the need to redefine this method here is due to the
- inability of many machines to store floats in non-double aligned memory.
- Therefore, on some machines, the first 4 bytes of a float are left unused,
- and the actual float is stored at index 5 .. 12.
- To hide this at one place, this method knows about that, and returns
- values as if this filler wasnt present."
+ the need to redefine this method here is due to the
+ inability of many machines to store floats in non-double aligned memory.
+ Therefore, on some machines, the first 4 bytes of a float are left unused,
+ and the actual float is stored at index 5 .. 12.
+ To hide this at one place, this method knows about that, and returns
+ values as if this filler wasnt present."
%{ /* NOCONTEXT */
@@ -1219,11 +1285,11 @@
* and SmallInteger
*/
if (__isSmallInteger(index)) {
- indx = __intVal(index) - 1;
- if (((unsigned)(indx)) < sizeof(float)) {
- cp = (unsigned char *)(& (__ShortFloatInstPtr(self)->f_floatvalue));
- RETURN ( __mkSmallInteger(cp[indx] & 0xFF) );
- }
+ indx = __intVal(index) - 1;
+ if (((unsigned)(indx)) < sizeof(float)) {
+ cp = (unsigned char *)(& (__ShortFloatInstPtr(self)->f_floatvalue));
+ RETURN ( __mkSmallInteger(cp[indx] & 0xFF) );
+ }
}
%}.
^ self indexNotIntegerOrOutOfBounds:index
@@ -1235,12 +1301,12 @@
Therefore, this method should be used strictly private.
Notice:
- the need to redefine this method here is due to the
- inability of many machines to store floats in non-double aligned memory.
- Therefore, on some machines, the first 4 bytes of a float are left unused,
- and the actual float is stored at index 5 .. 12.
- To hide this at one place, this method knows about that, and returns
- values as if this filler wasnt present."
+ the need to redefine this method here is due to the
+ inability of many machines to store floats in non-double aligned memory.
+ Therefore, on some machines, the first 4 bytes of a float are left unused,
+ and the actual float is stored at index 5 .. 12.
+ To hide this at one place, this method knows about that, and returns
+ values as if this filler wasnt present."
%{ /* NOCONTEXT */
register int indx, val;
@@ -1252,28 +1318,28 @@
* and SmallInteger
*/
if (__bothSmallInteger(index, value)) {
- val = __intVal(value);
- if ((val & ~0xFF) == 0 /* i.e. (val >= 0) && (val <= 255) */) {
- indx = __intVal(index) - 1;
- if (((unsigned)(indx)) < sizeof(float)) {
- cp = (unsigned char *)(& (__ShortFloatInstPtr(self)->f_floatvalue));
- cp[indx] = val;
- RETURN ( value );
- }
- }
+ val = __intVal(value);
+ if ((val & ~0xFF) == 0 /* i.e. (val >= 0) && (val <= 255) */) {
+ indx = __intVal(index) - 1;
+ if (((unsigned)(indx)) < sizeof(float)) {
+ cp = (unsigned char *)(& (__ShortFloatInstPtr(self)->f_floatvalue));
+ cp[indx] = val;
+ RETURN ( value );
+ }
+ }
}
%}.
value isInteger ifFalse:[
- "
- the object to store should be an integer number
- "
- ^ self elementNotInteger
+ "
+ the object to store should be an integer number
+ "
+ ^ self elementNotInteger
].
(value between:0 and:255) ifFalse:[
- "
- the object to store must be a bytes value
- "
- ^ self elementBoundsError:value
+ "
+ the object to store must be a bytes value
+ "
+ ^ self elementBoundsError:value
].
^ self indexNotIntegerOrOutOfBounds:index
! !
@@ -1587,14 +1653,14 @@
%{ /* NOCONTEXT */
- double modf();
- double frac, trunc;
+ float modff(float, float*);
+ float frac, trunc;
__threadErrno = 0;
- frac = modf((double)(__shortFloatVal(self)), &trunc);
+ frac = modff(__shortFloatVal(self), &trunc);
if (! isnan(frac)) {
if (__threadErrno == 0) {
- RETURN (__MKSFLOAT((float)frac));
+ RETURN (__MKSFLOAT(frac));
}
}
%}.
@@ -1609,12 +1675,12 @@
1.6 asShortFloat fractionPart + 1.6 asShortFloat truncated
-1.6 asShortFloat fractionPart + -1.6 asShortFloat truncated
- 1.0 asShortFloat fractionalPart
- 0.5 asShortFloat fractionalPart
- 0.25 asShortFloat fractionalPart
- 3.14159 asShortFloat fractionalPart
- 12345673.14159 asShortFloat fractionalPart
- 123456731231231231.14159 asShortFloat fractionalPart
+ 1.0 asShortFloat fractionPart
+ 0.5 asShortFloat fractionPart
+ 0.25 asShortFloat fractionPart
+ 3.14159 asShortFloat fractionPart
+ 12345673.14159 asShortFloat fractionPart
+ 123456731231231231.14159 asShortFloat fractionPart
"
!
@@ -1785,10 +1851,10 @@
!ShortFloat class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/ShortFloat.st,v 1.109 2012-12-17 18:28:33 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/ShortFloat.st,v 1.115 2013-01-26 15:03:23 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/ShortFloat.st,v 1.109 2012-12-17 18:28:33 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/ShortFloat.st,v 1.115 2013-01-26 15:03:23 cg Exp $'
! !
--- a/SmallInteger.st Wed Jan 23 10:08:55 2013 +0000
+++ b/SmallInteger.st Mon Jan 28 21:53:19 2013 +0000
@@ -4020,6 +4020,40 @@
^ self < 0
!
+nextPowerOf2
+ "return the power of 2 at or above the receiver.
+ Useful for padding."
+
+%{ /* NOCONTEXT */
+ INT x;
+
+ x = __intVal(self) - 1;
+ x |= (x >> 1);
+ x |= (x >> 2);
+ x |= (x >> 4);
+ x |= (x >> 8);
+ x |= (x >> 16);
+#if __POINTER_SIZE__ == 8
+ x |= (x >> 32);
+#endif
+ RETURN (__MKINT(x + 1));
+%}
+ "
+ 1 nextPowerOf2
+ 2 nextPowerOf2
+ 3 nextPowerOf2
+ 4 nextPowerOf2
+ 5 nextPowerOf2
+ 6 nextPowerOf2
+ 7 nextPowerOf2
+ 8 nextPowerOf2
+
+ 22 nextPowerOf2
+ 10 factorial nextPowerOf2
+ 20 factorial nextPowerOf2
+ "
+!
+
odd
"return true, if the receiver is odd"
@@ -4123,9 +4157,9 @@
!SmallInteger class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/SmallInteger.st,v 1.199 2013-01-08 17:55:11 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/SmallInteger.st,v 1.200 2013-01-23 18:03:50 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/SmallInteger.st,v 1.199 2013-01-08 17:55:11 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/SmallInteger.st,v 1.200 2013-01-23 18:03:50 cg Exp $'
! !
--- a/Timestamp.st Wed Jan 23 10:08:55 2013 +0000
+++ b/Timestamp.st Mon Jan 28 21:53:19 2013 +0000
@@ -618,6 +618,182 @@
!Timestamp class methodsFor:'reading'!
+readFrom:aStringOrStream format:formatString language:languageOrNil onError:exceptionalValue
+ "return a new Timestamp, reading a printed representation from aStream using a formatString.
+ The formatString is similar to the one used when printing.
+ On error, exceptionalValue is returned. If exceptionalValue is a one-arg block, an error message is
+ passed as argument.
+ format:
+ %h hours, 00..23 (i.e. european) 0-padded to length 2
+ %u hours, 00..12 (i.e. us) 0-padded to length 2
+ %m minutes, 00..59 0-padded to length 2
+ %s seconds, 00..59 0-padded to length 2
+ %i milliseconds, 000..999 0-padded to length 3
+ %a am/pm
+
+ %d - day
+ %D - day
+ %(day) - day
+
+ %m - month
+ %M - month
+ %(month) - month
+
+ %(monthName) - monthName
+
+ %(year) - year, full 4 digits
+ %Y - year, last 2 digits only,
+ 0..71 map to 2000..2071;
+ 72..99 map to 1972..1999;
+ %Y1900 - year, last 2 digits only, map to 1900..1999
+ %Y2000 - year, last 2 digits only, map to 2000..2099
+
+ an optional length after the % gives a field length;
+ i.e. %2h%2m%2s parses 123557 as 12:35:37
+"
+
+ |day month year
+ hour minute second millisecond
+ utcOffset inStream formatStream error fChar format itemHandler
+ len now s|
+
+ error := [:msg |
+ exceptionalValue isBlock ifTrue:[
+ ^ exceptionalValue valueWithOptionalArgument:'format error; space expcected'
+ ] ifFalse:[
+ ^ exceptionalValue value
+ ].
+ ].
+
+ itemHandler := [:format |
+ |input|
+ input := len isNil ifTrue:[ inStream ] ifFalse:[ inStream next: len ].
+
+ ( #('d' 'D' 'day' ) includes:format ) ifTrue:[
+ day := Integer readFrom:input onError:[ error value:'invalid day' ].
+
+ ] ifFalse:[ ( format = 'month' ) ifTrue:[
+ month := Integer readFrom:input onError:[ error value:'invalid month' ].
+
+ ] ifFalse:[ ( format = 'year' or:[ format = 'y' ]) ifTrue:[
+ year := Integer readFrom:input onError:[ error value:'invalid year' ].
+
+ ] ifFalse:[ ( format = 'Y' ) ifTrue:[
+ year := Integer readFrom:input onError:[ error value:'invalid year' ].
+ (year between:0 and: 99) ifFalse:[ error value:'invalid year' ].
+ (year between:0 and:71) ifTrue:[
+ year := year + 1900
+ ] ifFalse:[
+ year := year + 2000
+ ]
+
+ ] ifFalse:[ (format = 'monthName') ifTrue:[
+ s := input nextMatching:[:c | c isLetter] thenMatching:[:c | c isLetter].
+ month := Date indexOfMonth:s asLowercase language:languageOrNil
+
+ ] ifFalse:[ ( format = 'Y1900' ) ifTrue:[
+ year := Integer readFrom:input onError:[ error value:'invalid year' ].
+ (year between:0 and: 99) ifFalse:[ error value:'invalid year' ].
+ year := year + 1900
+
+ ] ifFalse:[ ( format = 'Y2000' ) ifTrue:[
+ year := Integer readFrom:input onError:[ error value:'invalid year' ].
+ (year between:0 and: 99) ifFalse:[ error value:'invalid year' ].
+ year := year + 2000
+
+ ] ifFalse:[ ( format = 'h' or:[ format = 'H' ]) ifTrue:[
+ hour := Integer readFrom:input onError:[ error value:'invalid hour' ].
+
+ ] ifFalse:[ ( format = 'u' or:[ format = 'U']) ifTrue:[
+ hour := Integer readFrom:input onError:[ error value:'invalid hour' ].
+
+ ] ifFalse:[ ( format = 'm' or:[ format = 'M' ]) ifTrue:[
+ minute := Integer readFrom:input onError:[ error value:'invalid minute' ].
+
+ ] ifFalse:[ ( format = 's' or:[ format = 'S' ]) ifTrue:[
+ second := Integer readFrom:input onError:[ error value:'invalid second' ].
+
+ ] ifFalse:[ ( format = 'i' or:[ format = 'I' ]) ifTrue:[
+ millisecond := Integer readFrom:input onError:[ error value:'invalid month' ].
+
+ ] ifFalse:[ ( format = 'tz' ) ifTrue:[
+ utcOffset := self utcOffsetFrom:input.
+ utcOffset isNil ifTrue:[ error value:'invalid timezone' ]
+
+ ] ifFalse:[ ( format = 'a' ) ifTrue:[
+ s := (input next:2) asLowercase.
+ s = 'am' ifTrue:[
+ (hour between:0 and:12) ifFalse:[ error value:'invalid hour' ]
+ ] ifFalse:[
+ s = 'pm' ifTrue:[
+ (hour between:1 and:12) ifFalse:[ error value:'invalid hour' ].
+ hour := hour + 12.
+ ] ifFalse:[
+ error value:'invalid am/pm'
+ ]
+ ]
+
+ ] ifFalse:[
+ error value:'unhandled format:',format
+ ]]]]]]]]]]]]]]
+ ].
+
+ hour := 0.
+ minute := 0.
+ second := 0.
+ millisecond := 0.
+
+ inStream := aStringOrStream readStream.
+ formatStream := formatString readStream.
+
+ [formatStream atEnd] whileFalse:[
+ fChar := formatStream next.
+ fChar = Character space ifTrue:[
+ inStream peek isSeparator ifFalse:[ error value: 'format error; space expcected' ].
+ inStream skipSeparators.
+ ] ifFalse:[
+ fChar == $% ifTrue:[
+ len := nil.
+ (formatStream peek isDigit) ifTrue:[
+ len := Integer readFrom:formatStream onError:[ error value: 'format error; invalid length' ]
+ ].
+ (formatStream peek == $() ifTrue:[
+ formatStream next.
+ format := formatStream upTo:$).
+ ] ifFalse:[
+ (formatStream peek == ${) ifTrue:[
+ formatStream next.
+ format := formatStream upTo:$}.
+ ] ifFalse:[
+ (formatStream peek isLetter) ifTrue:[
+ format := formatStream nextAlphaNumericWord.
+ ] ifFalse:[
+ error value:'unhandled format:',formatStream peek
+ ]
+ ]
+ ].
+ itemHandler value:format.
+ ] ifFalse:[
+ inStream peek = fChar ifFalse:[^ error value: 'format error; ',fChar,' expcected'].
+ inStream next.
+ ]
+ ].
+ ].
+
+ year isNil ifTrue:[
+ year := (now := Timestamp now) year
+ ].
+
+ ^ (self year:year month:month day:day hour:(hour ? 0) minute:(minute ? 0) second:(second ? 0) millisecond:millisecond) - utcOffset
+
+ "
+ Timestamp readFrom:'20-2-1995 13:11:06' format:'%day-%month-%year %h:%m:%s' language:nil onError:[self halt]
+ Timestamp readFrom:'20021995131106' format:'%2d%2month%4y%2h%2m%2s' language:nil onError:[self halt]
+ Timestamp readFrom:'March 7 2009 7:30pm EST' format:'%monthName %day %year %u:%m%a %tz' language:#en onError:[self halt]
+ Timestamp readFrom:'March 7 2009 7:30pm UTC' format:'%monthName %day %year %u:%m%a %tz' language:#en onError:[self halt]
+ "
+!
+
readFrom:aStringOrStream onError:exceptionBlock
"return a new Timestamp, reading a printed representation from aStream.
The string is interpreted as 24 hour format, as printed.
@@ -919,8 +1095,6 @@
!
readRFC1123FormatFrom:rfc1123String onError:exceptionBlock
- |parts indexModifier utcOffsetString utcOffset day year time monthName month|
-
"/ All HTTP/1.0 date/time stamps must be represented in Universal Time (UT),
"/ also known as Greenwich Mean Time (GMT), without exception.
"/ This is indicated in the first two formats by the inclusion of "GMT" as the three-letter abbreviation for time zone,
@@ -953,6 +1127,15 @@
"/ | "Sep" | "Oct" | "Nov" | "Dec"
"/
"/ Mon, 17 Aug 2009 11:11:15 GMT
+"/
+"/ however, occasionally, someone presents us with non-UTC strings which include a timezone;
+"/ thus, this also supports:
+"/ Mon, 17 Aug 2009 11:11:15 +xxxx
+"/ Mon, 17 Aug 2009 11:11:15 -xxxx
+"/ and:
+"/ Mon, 17 Aug 2009 11:11:15 PST
+
+ |parts indexModifier utcOffsetString utcOffset day year time monthName month|
rfc1123String isEmptyOrNil ifTrue:[^ exceptionBlock value].
@@ -967,18 +1150,8 @@
].
].
- utcOffset := 0.
utcOffsetString := (parts at:6 + indexModifier).
- ((utcOffsetString sameAs:'GMT') or:[utcOffsetString sameAs:'UTC']) ifFalse:[
- self assert:utcOffsetString size == 5.
-
- utcOffset := (utcOffsetString from:4 to:5) asString asNumber * 60.
- utcOffset := utcOffset + ((utcOffsetString from:2 to:3) asString asNumber * 60 * 60).
-
- (utcOffsetString at:1) asSymbol == #- ifTrue:[
- utcOffset := -1 * utcOffset.
- ].
- ].
+ utcOffset := (self utcOffsetFrom:utcOffsetString) ? 0.
day := Integer readFrom:(parts at:2 + indexModifier) onError:[^ exceptionBlock].
year := Integer readFrom:(parts at:4 + indexModifier) onError:[^ exceptionBlock].
@@ -991,9 +1164,307 @@
^ (self
fromDate:(Date newDay:day monthIndex:month year:year)
- andTime:time) + utcOffset
+ andTime:time) - utcOffset
+
+ "
+ self readRFC1123FormatFrom:'Mon, 17 Aug 2009 11:11:15 PST' onError:nil
+ self readRFC1123FormatFrom:'Mon, 17 Aug 2009 11:11:15 PDT' onError:nil
+ self readRFC1123FormatFrom:'Mon, 17 Aug 2009 11:11:15 UTC' onError:nil
+ self readRFC1123FormatFrom:'Mon, 17 Aug 2009 11:11:15 +0100' onError:nil
+ "
"Modified: / 05-10-2010 / 16:05:32 / cg"
+!
+
+utcOffsetFrom:aStringOrStream
+ "return the utcOffset (in seconds) for a given time-zone name.
+ Returns nil for invalid formats"
+
+ |table i offset stream tzName sign|
+
+ table :=
+ #(
+ 'GMT' 0
+ 'UTC' 0
+
+ "/ US
+ 'AST' -4 "/ atlantic
+ 'ADT' -3
+
+ 'AKST' -8 "/ alaska
+ 'AKDT' -9
+
+ 'CST' -6 "/ central
+ 'CDT' -5
+
+ 'EST' -5 "/ eastern
+ 'EDT' -4
+
+ 'EGST' 0 "/ east greenland
+ 'EGT' -1
+
+ 'HADT' -9 "/ hawaii
+ 'HAST' -10
+
+ 'MST' -7 "/ mountain
+ 'MDT' -6
+
+ 'NST' -3.5 "/ new foundland
+ 'NDT' -2.5
+
+ 'PST' -8 "/ pacific
+ 'PDT' -7
+
+ 'PMST' -3 "/ pierre & miquelon
+ 'PMDT' -2
+
+ 'WGST' -2 "/ west greenland
+ 'WGT' -3
+
+ "/ europe
+ 'CET' 1 "/ central european
+ 'CEST' 2
+
+ 'EET' 2 "/ east european
+ 'EEST' 3
+
+ 'WET' 0 "/ west european
+ 'WEST' 1
+
+ 'MSK' 4 "/ moscow european
+ 'MSD' 4
+
+ "/ pacific
+ 'NZST' 12 "/ new zealand
+ 'NZDT' 13
+
+ "/ south america
+ 'ART' -3 "/ argentina
+ 'BOT' -4 "/ bolivia
+ 'BRT' -3 "/ brasilia
+ 'BRST' -2
+ 'CLT' -4 "/ chile
+ 'CLST' -3
+ 'ECT' -5 "/ equador
+ 'PET' -5 "/ peru
+ 'PYT' -4 "/ paraguay
+ 'UYT' -3 "/ uruguay
+ 'VET' -4.5 "/ venezuela
+
+ "/ africa
+ 'CAT' 2 "/ central africa
+ 'EAT' 3 "/ east africa
+ 'SAST' 2 "/ south africa
+ 'WAT' 1 "/ west africa
+ 'WAST' 2
+ 'WT' 0 "/ west sahara
+ 'WST' 1
+
+ 'HKT' 8 "/ hongkong
+ 'IST' 5.5 "/ india
+ 'JST' 9 "/ japan
+ 'KST' 9 "/ korea
+ 'SGT' 8 "/ singapore
+
+ "/ military
+ 'A' 1
+ 'B' 2
+ 'C' 3
+ 'D' 4
+ 'E' 5
+ 'F' 6
+ 'G' 7
+ 'H' 8
+ 'I' 9
+ 'K' 10
+ 'L' 11
+ 'M' 12
+ 'N' -1
+ 'O' -2
+ 'P' -3
+ 'Q' -4
+ 'R' -5
+ 'S' -6
+ 'T' -7
+ 'U' -8
+ 'V' -9
+ 'W' -10
+ 'X' -11
+ 'Y' -12
+ ).
+
+ stream := aStringOrStream readStream.
+ stream skipSeparators.
+
+ stream peek isLetter ifTrue:[
+ tzName := stream upToMatching:[:ch | ch isLetter not].
+
+ i := table indexOf:tzName.
+ i ~~ 0 ifTrue:[
+ ^ (table at:i+1) * 60 * 60
+ ].
+ ] ifFalse:[
+ sign := 1.
+ stream peek == $- ifTrue:[
+ sign := -1.
+ stream next.
+ ] ifFalse:[
+ stream peek == $+ ifTrue:[
+ sign := 1.
+ stream next.
+ ] ifFalse:[
+ stream skipSeparators
+ ]
+ ].
+ offset := ((stream next:2) asNumber * 60 * 60).
+ offset := offset + ((stream next:2) asNumber * 60).
+ ^ offset * sign
+ ].
+
+ ^ nil
+
+ "
+ self utcOffsetFrom:'UTC'
+ self utcOffsetFrom:'PST'
+ self utcOffsetFrom:'EST'
+ self utcOffsetFrom:'+0130'
+ "
+!
+
+utcOffsetFromString:aString
+ "return the utcOffset (in seconds) for a given time-zone name.
+ Returns nil for invalid formats"
+
+ |table i offset|
+
+ table :=
+ #(
+ 'GMT' 0
+ 'UTC' 0
+
+ "/ US
+ 'AST' -4 "/ atlantic
+ 'ADT' -3
+
+ 'AKST' -8 "/ alaska
+ 'AKDT' -9
+
+ 'CST' -6 "/ central
+ 'CDT' -5
+
+ 'EST' -5 "/ eastern
+ 'EDT' -4
+
+ 'EGST' 0 "/ east greenland
+ 'EGT' -1
+
+ 'HADT' -9 "/ hawaii
+ 'HAST' -10
+
+ 'MST' -7 "/ mountain
+ 'MDT' -6
+
+ 'NST' -3.5 "/ new foundland
+ 'NDT' -2.5
+
+ 'PST' -8 "/ pacific
+ 'PDT' -7
+
+ 'PMST' -3 "/ pierre & miquelon
+ 'PMDT' -2
+
+ 'WGST' -2 "/ west greenland
+ 'WGT' -3
+
+ "/ europe
+ 'CET' 1 "/ central european
+ 'CEST' 2
+
+ 'EET' 2 "/ east european
+ 'EEST' 3
+
+ 'WET' 0 "/ west european
+ 'WEST' 1
+
+ 'MSK' 4 "/ moscow european
+ 'MSD' 4
+
+ "/ pacific
+ 'NZST' 12 "/ new zealand
+ 'NZDT' 13
+
+ "/ south america
+ 'ART' -3 "/ argentina
+ 'BOT' -4 "/ bolivia
+ 'BRT' -3 "/ brasilia
+ 'BRST' -2
+ 'CLT' -4 "/ chile
+ 'CLST' -3
+ 'ECT' -5 "/ equador
+ 'PET' -5 "/ peru
+ 'PYT' -4 "/ paraguay
+ 'UYT' -3 "/ uruguay
+ 'VET' -4.5 "/ venezuela
+
+ "/ africa
+ 'CAT' 2 "/ central africa
+ 'EAT' 3 "/ east africa
+ 'SAST' 2 "/ south africa
+ 'WAT' 1 "/ west africa
+ 'WAST' 2
+ 'WT' 0 "/ west sahara
+ 'WST' 1
+
+ 'HKT' 8 "/ hongkong
+ 'IST' 5.5 "/ india
+ 'JST' 9 "/ japan
+ 'KST' 9 "/ korea
+ 'SGT' 8 "/ singapore
+
+ "/ military
+ 'A' 1
+ 'B' 2
+ 'C' 3
+ 'D' 4
+ 'E' 5
+ 'F' 6
+ 'G' 7
+ 'H' 8
+ 'I' 9
+ 'K' 10
+ 'L' 11
+ 'M' 12
+ 'N' -1
+ 'O' -2
+ 'P' -3
+ 'Q' -4
+ 'R' -5
+ 'S' -6
+ 'T' -7
+ 'U' -8
+ 'V' -9
+ 'W' -10
+ 'X' -11
+ 'Y' -12
+ ).
+
+ i := table indexOf:aString.
+ i ~~ 0 ifTrue:[ ^ (table at:i+1) * 60 * 60 ].
+
+ aString size == 5 ifTrue:[
+ offset := (aString copyFrom:4 to:5) asNumber * 60.
+ offset := offset + ((offset copyFrom:2 to:3) asNumber * 60 * 60).
+ (aString at:1) == $- ifTrue:[
+ offset := offset negated.
+ ].
+ ^ offset
+ ].
+
+ ^ nil
+
+ "
+ self utcOffsetFrom:'UTC'
+ "
! !
!Timestamp methodsFor:'accessing'!
@@ -2699,11 +3170,12 @@
!Timestamp class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Timestamp.st,v 1.142 2012-10-24 22:42:11 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Timestamp.st,v 1.143 2013-01-25 13:34:35 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Timestamp.st,v 1.142 2012-10-24 22:42:11 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Timestamp.st,v 1.143 2013-01-25 13:34:35 cg Exp $'
! !
+
Timestamp initialize!
--- a/UndefinedObject.st Wed Jan 23 10:08:55 2013 +0000
+++ b/UndefinedObject.st Mon Jan 28 21:53:19 2013 +0000
@@ -154,6 +154,8 @@
+
+
!UndefinedObject methodsFor:'converting'!
asBoolean
@@ -246,6 +248,7 @@
^ self notIndexed
! !
+
!UndefinedObject methodsFor:'printing & storing'!
printOn:aStream
@@ -356,6 +359,9 @@
"create a new class which has nil as superclass
- i.e. traps into #doesNotUnderstand: for all of its messages."
+ "this method allows fileIn of ST/V and V'Age classes
+ (which seem to have no category)"
+
^ self
subclass:nameSymbol
instanceVariableNames:instVarNameString
@@ -690,11 +696,12 @@
!UndefinedObject class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/UndefinedObject.st,v 1.72 2011-08-18 00:35:45 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/UndefinedObject.st,v 1.73 2013-01-22 13:08:06 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/UndefinedObject.st,v 1.72 2011-08-18 00:35:45 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/UndefinedObject.st,v 1.73 2013-01-22 13:08:06 cg Exp $'
! !
+
UndefinedObject initialize!
--- a/UnixOperatingSystem.st Wed Jan 23 10:08:55 2013 +0000
+++ b/UnixOperatingSystem.st Mon Jan 28 21:53:19 2013 +0000
@@ -235,6 +235,9 @@
long tm_gmtoff; /* offset from CUT in seconds */
char *tm_zone; /* timezone abbreviation */
};
+
+# include <crt_externs.h>
+
# endif /* __osx__ */
# ifndef _STDIO_H_INCLUDED_
@@ -525,339 +528,6 @@
%}
! !
-!UnixOperatingSystem primitiveFunctions!
-%{
-
-/*
- * some systems' system() is broken in that it does not correctly
- * handle EINTR and returns failure even though it actually succeeded.
- * (LINUX is one of them)
- * Here is a fixed version. If you encounter EINTR returns from
- * UnixOperatingSystem>>executeCommand, you ought to define WANT_SYSTEM
- * in the xxxIntern.h file to get this fixed version.
- *
- * As an added BONUS, this system() enables interrupts while waiting
- * for the child which enables other threads to continue.
- * (i.e. it is RT safe)
- */
-
-#if defined(WANT_SYSTEM)
-
-/* # define DPRINTF(x) printf x */
-# define DPRINTF(x) /* nothing */
-
-# ifndef _STDDEF_H_INCLUDED_
-# include <stddef.h>
-# define _STDDEF_H_INCLUDED_
-# endif
-
-# ifndef _STDLIB_H_INCLUDED_
-# include <stdlib.h>
-# define _STDLIB_H_INCLUDED_
-# endif
-
-# ifndef _UNISTD_H_INCLUDED_
-# include <unistd.h>
-# define _UNISTD_H_INCLUDED_
-# endif
-
-# ifndef _SYS_WAIT_H_INCLUDED
-# include <sys/wait.h>
-# define _SYS_WAIT_H_INCLUDED
-# endif
-
-# ifndef _SIGNAL_H_INCLUDED_
-# include <signal.h>
-# define _SIGNAL_H_INCLUDED_
-# endif
-
-# ifndef _SYS_TYPES_H_INCLUDED_
-# include <sys/types.h>
-# define _SYS_TYPES_H_INCLUDED_
-# endif
-
-# if (!defined(HAVE_GNU_LD) && !defined (__ELF__)) || !defined(LINUX)
-# define __environ environ
-# if 1 /* !defined(LINUX) */
-# define __sigemptyset sigemptyset
-# define __sigaction sigaction
-# define __sigaddset sigaddset
-# define __sigprocmask sigprocmask
-# define __execve execve
-# define __wait wait
-# define __waitpid waitpid
-# endif /* ! LINUX */
- extern char **environ;
-# endif
-
-# define __sigprocmask sigprocmask
-# define __execve execve
-
-# define SHELL_PATH "/bin/sh" /* Path of the shell. */
-# define SHELL_NAME "sh" /* Name to give it. */
-
-
-static int
-mySystem(line)
- register CONST char *line;
-{
- int status, save;
- pid_t pid;
- struct sigaction sa, intr, quit;
- sigset_t block, omask;
-
- if (line == NULL)
- return -1;
-
- sa.sa_handler = SIG_IGN;
- sa.sa_flags = 0;
- __sigemptyset (&sa.sa_mask);
-
- if (__sigaction (SIGINT, &sa, &intr) < 0) {
- DPRINTF(("1: errno=%d\n", errno));
- return -1;
- }
- if (__sigaction (SIGQUIT, &sa, &quit) < 0) {
- save = errno;
- (void) __sigaction (SIGINT, &intr, (struct sigaction *) NULL);
- errno = save;
- DPRINTF(("2: errno=%d\n", errno));
- return -1;
- }
-
- __sigemptyset (&block);
- __sigaddset (&block, SIGCHLD);
- save = errno;
- if (__sigprocmask(SIG_BLOCK, &block, &omask) < 0) {
- if (errno == ENOSYS)
- errno = save;
- else {
- save = errno;
- (void) __sigaction(SIGINT, &intr, (struct sigaction *) NULL);
- (void) __sigaction (SIGQUIT, &quit, (struct sigaction *) NULL);
- errno = save;
- DPRINTF(("3: errno=%d\n", errno));
- return -1;
- }
- }
-
- pid = FORK ();
- if (pid == (pid_t) 0) {
- /* Child side. */
- CONST char *new_argv[4];
- new_argv[0] = SHELL_NAME;
- new_argv[1] = "-c";
- new_argv[2] = line;
- new_argv[3] = NULL;
-
- /* Restore the signals. */
- (void) __sigaction (SIGINT, &intr, (struct sigaction *) NULL);
- (void) __sigaction (SIGQUIT, &quit, (struct sigaction *) NULL);
- (void) __sigprocmask (SIG_SETMASK, &omask, (sigset_t *) NULL);
-
- /* Exec the shell. */
- (void) __execve (SHELL_PATH, (char *CONST *) new_argv, __environ);
- _exit (127);
- } else {
- if (pid < (pid_t) 0) {
- /* The fork failed. */
- DPRINTF(("4: errno=%d\n", errno));
- status = -1;
- } else {
- /* Parent side. */
-#ifdef NO_WAITPID
- pid_t child;
-
- do {
- __BEGIN_INTERRUPTABLE__
- child = __wait (&status);
- __END_INTERRUPTABLE__
- if (child < 0 && errno != EINTR) {
- DPRINTF(("5: errno=%d\n", errno));
- status = -1;
- break;
- }
- } while (child != pid);
-#else
- pid_t child;
-
- /* claus: the original did not care for EINTR here ... */
- do {
- __BEGIN_INTERRUPTABLE__
- child = __waitpid (pid, &status, 0);
- __END_INTERRUPTABLE__
- } while ((child != pid) && (errno == EINTR));
- if (child != pid) {
- DPRINTF(("6: errno=%d\n", errno));
- status = -1;
- }
-#endif /* NO_WAITPID */
- }
- }
- save = errno;
- if ((__sigaction (SIGINT, &intr, (struct sigaction *) NULL)
- | __sigaction (SIGQUIT, &quit, (struct sigaction *) NULL)
- | __sigprocmask (SIG_SETMASK, &omask, (sigset_t *) NULL)) != 0) {
- if (errno == ENOSYS) {
- errno = save;
- } else {
- status = -1;
- DPRINTF(("7: errno=%d\n", errno));
- }
- }
-
- return status;
-}
-#else
-# define __wait wait
-#endif /* WANT_SYSTEM */
-
-
-/*
- * some systems do not have realpath();
- * the alternative of reading from a 'pwp'-pipe
- * is way too slow. Here is a realpath for the rest of us.
- * define WANT_REALPATH in the xxxIntern-file to get it.
- */
-
-#if defined(HAS_REALPATH)
-# undef WANT_REALPATH
-#endif
-#if !defined(HAS_GETWD) && !defined(HAS_GETCWD)
-# undef WANT_REALPATH
-#endif
-
-#if defined(WANT_REALPATH)
-
-# ifndef NULL
-# define NULL (char *)0
-# endif
-
-# define MAX_READLINKS 32
-
-# ifndef MAXPATHLEN
-# define MAXPATHLEN 1024
-# endif
-
-static
-char *
-realpath(path, resolved_path)
- char *path;
- char resolved_path [];
-{
- char copy_path[MAXPATHLEN];
- char link_path[MAXPATHLEN];
- char *new_path = resolved_path;
- char *max_path;
- int readlinks = 0;
- int n;
-
- /* Make a copy of the source path since we may need to modify it. */
- strcpy(copy_path, path);
- path = copy_path;
- max_path = copy_path + MAXPATHLEN - 2;
- /* If it's a relative pathname use getwd for starters. */
- if (*path != '/') {
-#ifdef HAS_GETCWD
- new_path = getcwd(new_path, MAXPATHLEN - 1);
-#else
- new_path = getwd(new_path);
-#endif
- if (new_path == NULL)
- return(NULL);
-
- new_path += strlen(new_path);
- if (new_path[-1] != '/')
- *new_path++ = '/';
- }
- else {
- *new_path++ = '/';
- path++;
- }
- /* Expand each slash-separated pathname component. */
- while (*path != '\0') {
- /* Ignore stray "/". */
- if (*path == '/') {
- path++;
- continue;
- }
- if (*path == '.') {
- /* Ignore ".". */
- if (path[1] == '\0' || path[1] == '/') {
- path++;
- continue;
- }
- if (path[1] == '.') {
- if (path[2] == '\0' || path[2] == '/') {
- path += 2;
- /* Ignore ".." at root. */
- if (new_path == resolved_path + 1)
- continue;
- /* Handle ".." by backing up. */
- while ((--new_path)[-1] != '/')
- ;
- continue;
- }
- }
- }
- /* Safely copy the next pathname component. */
- while (*path != '\0' && *path != '/') {
- if (path > max_path) {
- errno = ENAMETOOLONG;
- return NULL;
- }
- *new_path++ = *path++;
- }
-#ifdef S_IFLNK
- /* Protect against infinite loops. */
- if (readlinks++ > MAX_READLINKS) {
- errno = ELOOP;
- return NULL;
- }
- /* See if latest pathname component is a symlink. */
- *new_path = '\0';
- n = readlink(resolved_path, link_path, MAXPATHLEN - 1);
- if (n < 0) {
- /* EINVAL means the file exists but isn't a symlink. */
- if (errno != EINVAL)
- return NULL;
- }
- else {
- /* Note: readlink doesn't add the null byte. */
- link_path[n] = '\0';
- if (*link_path == '/')
- /* Start over for an absolute symlink. */
- new_path = resolved_path;
- else
- /* Otherwise back up over this component. */
- while (*(--new_path) != '/')
- ;
- /* Safe sex check. */
- if (strlen(path) + n >= MAXPATHLEN) {
- errno = ENAMETOOLONG;
- return NULL;
- }
- /* Insert symlink contents into path. */
- strcat(link_path, path);
- strcpy(copy_path, link_path);
- path = copy_path;
- }
-#endif /* S_IFLNK */
- *new_path++ = '/';
- }
- /* Delete trailing slash but don't whomp a lone slash. */
- if (new_path != resolved_path + 1 && new_path[-1] == '/')
- new_path--;
- /* Make sure it's null terminated. */
- *new_path = '\0';
- return resolved_path;
-}
-# define HAS_REALPATH
-#endif /* WANT_REALPATH && not HAS_REALPATH */
-
-%}
-! !
-
!UnixOperatingSystem class methodsFor:'documentation'!
copyright
@@ -978,6 +648,7 @@
"
! !
+
!UnixOperatingSystem class methodsFor:'initialization'!
initialize
@@ -1018,6 +689,7 @@
"Modified: / 11.12.1998 / 16:22:48 / cg"
! !
+
!UnixOperatingSystem class methodsFor:'OS signal constants'!
sigABRT
@@ -1744,6 +1416,7 @@
"
! !
+
!UnixOperatingSystem class methodsFor:'error messages'!
currentErrorNumber
@@ -2818,6 +2491,7 @@
"
! !
+
!UnixOperatingSystem class methodsFor:'executing OS commands-implementation'!
exec:aCommandPathArg withArguments:argColl environment:environmentDictionary
@@ -2889,8 +2563,12 @@
%{ /* STACK: 16000 */
char **argv;
int nargs, i, id;
- OBJ arg;
+ OBJ arg;
+#ifdef __osx__
+ char **environ = _NSGetEnviron();
+#else
extern char **environ;
+#endif
char **_env, **_nEnv;
if (__isStringLike(aCommandPath) &&
@@ -3258,6 +2936,7 @@
"Created: / 12.11.1998 / 14:39:20 / cg"
! !
+
!UnixOperatingSystem class methodsFor:'executing OS commands-queries'!
commandAndArgsForOSCommand:aCommandString
@@ -3355,6 +3034,7 @@
"Modified: / 5.6.1998 / 19:03:32 / cg"
! !
+
!UnixOperatingSystem class methodsFor:'file access'!
closeFd:anInteger
@@ -3882,6 +3562,7 @@
^ self primitiveFailed
! !
+
!UnixOperatingSystem class methodsFor:'file access rights'!
accessMaskFor:aSymbol
@@ -4024,6 +3705,7 @@
^ self primitiveFailed
! !
+
!UnixOperatingSystem class methodsFor:'file locking'!
lockFD:aFileDescriptor shared:isSharedReadLock blocking:blockIfLocked
@@ -4250,6 +3932,7 @@
^ false
! !
+
!UnixOperatingSystem class methodsFor:'file queries'!
caseSensitiveFilenames
@@ -5327,6 +5010,7 @@
"Modified: / 5.6.1998 / 18:38:11 / cg"
! !
+
!UnixOperatingSystem class methodsFor:'interrupts & signals'!
defaultSignal:signalNumber
@@ -6026,6 +5710,7 @@
"Modified: / 27.1.1998 / 20:05:59 / cg"
! !
+
!UnixOperatingSystem class methodsFor:'ipc support'!
makeBidirectionalPipe
@@ -6328,6 +6013,7 @@
self primitiveFailed
! !
+
!UnixOperatingSystem class methodsFor:'misc'!
closeLeftOverFiles
@@ -6408,6 +6094,7 @@
"Modified: 22.4.1996 / 13:13:09 / cg"
! !
+
!UnixOperatingSystem class methodsFor:'os queries'!
executableFileExtensions
@@ -6523,9 +6210,12 @@
|resultArray error dict sz "{ Class: SmallInteger }"|
-%{
-
+%{
+#ifdef __osx__
+ char **environ = _NSGetEnviron();
+#else
extern char **environ;
+#endif
char **env;
int nEnv = 0;
@@ -8517,6 +8207,7 @@
! !
+
!UnixOperatingSystem class methodsFor:'path queries'!
decodePath:encodedPathName
@@ -8613,6 +8304,7 @@
"Modified: / 23-01-2013 / 10:00:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+
!UnixOperatingSystem class methodsFor:'private'!
mountPointsFromProcFS
@@ -8645,6 +8337,7 @@
"Created: / 12.6.1998 / 16:30:43 / cg"
! !
+
!UnixOperatingSystem class methodsFor:'shared memory access'!
shmAttach:id address:addr flags:flags
@@ -8727,6 +8420,7 @@
"Modified: 22.4.1996 / 13:14:46 / cg"
! !
+
!UnixOperatingSystem class methodsFor:'socket creation'!
socketAccessor
@@ -8743,6 +8437,7 @@
^ SocketHandle new domain:domainArg type:typeArg protocol:protocolArg
! !
+
!UnixOperatingSystem class methodsFor:'time and date'!
computeOSTimeFromUTCYear:y month:m day:d hour:h minute:min second:s millisecond:millis
@@ -9185,6 +8880,7 @@
"
! !
+
!UnixOperatingSystem class methodsFor:'users & groups'!
getEffectiveGroupID
@@ -9555,6 +9251,7 @@
"
! !
+
!UnixOperatingSystem class methodsFor:'waiting for events'!
blockingChildProcessWait
@@ -10273,6 +9970,7 @@
^ self primitiveFailed
! !
+
!UnixOperatingSystem::FileDescriptorHandle class methodsFor:'change & update'!
update:aspect with:argument from:anObject
@@ -10292,6 +9990,7 @@
"Created: 30.9.1997 / 12:57:35 / stefan"
! !
+
!UnixOperatingSystem::FileDescriptorHandle class methodsFor:'initialization'!
initialize
@@ -10304,6 +10003,7 @@
"Modified: 30.9.1997 / 12:40:55 / stefan"
! !
+
!UnixOperatingSystem::FileDescriptorHandle class methodsFor:'instance creation'!
for:aFileDescriptor
@@ -10314,6 +10014,7 @@
"Created: 30.9.1997 / 14:00:00 / stefan"
! !
+
!UnixOperatingSystem::FileDescriptorHandle methodsFor:'error handling'!
error:anErrorSymbolOrErrno
@@ -10326,6 +10027,7 @@
self primitiveFailed:anErrorSymbolOrErrno.
! !
+
!UnixOperatingSystem::FileDescriptorHandle methodsFor:'file access'!
close
@@ -10340,6 +10042,7 @@
"Modified: 30.9.1997 / 13:06:55 / stefan"
! !
+
!UnixOperatingSystem::FileDescriptorHandle methodsFor:'initialization'!
for:aFileDescriptor
@@ -10360,6 +10063,7 @@
"Modified: 30.9.1997 / 12:41:43 / stefan"
! !
+
!UnixOperatingSystem::FileDescriptorHandle methodsFor:'input/output'!
readBytes:count into:aByteBuffer startingAt:firstIndex
@@ -10634,6 +10338,7 @@
"
! !
+
!UnixOperatingSystem::FileDescriptorHandle methodsFor:'misc functions'!
nextError
@@ -10790,6 +10495,7 @@
! !
+
!UnixOperatingSystem::FileDescriptorHandle methodsFor:'private-accessing'!
fileDescriptor
@@ -10816,6 +10522,7 @@
! !
+
!UnixOperatingSystem::FileDescriptorHandle methodsFor:'queries'!
canReadWithoutBlocking
@@ -10931,6 +10638,7 @@
"
! !
+
!UnixOperatingSystem::FileDescriptorHandle methodsFor:'registering'!
register
@@ -10958,6 +10666,7 @@
"Modified: 30.9.1997 / 12:58:37 / stefan"
! !
+
!UnixOperatingSystem::FileDescriptorHandle methodsFor:'releasing'!
invalidate
@@ -10970,6 +10679,7 @@
"Modified: 30.9.1997 / 12:42:16 / stefan"
! !
+
!UnixOperatingSystem::FileDescriptorHandle methodsFor:'waiting'!
readWaitWithTimeoutMs:timeout
@@ -11038,6 +10748,7 @@
^ canWrite not
! !
+
!UnixOperatingSystem::FilePointerHandle methodsFor:'release'!
closeFile
@@ -11054,6 +10765,7 @@
! !
+
!UnixOperatingSystem::FileStatusInfo class methodsFor:'instance creation'!
type:t mode:m uid:u gid:g size:s id:i accessed:aT modified:mT statusChanged:sT path:lP numLinks:nL
@@ -11061,6 +10773,7 @@
type:t mode:m uid:u gid:g size:s id:i accessed:aT modified:mT statusChanged:sT path:lP numLinks:nL
! !
+
!UnixOperatingSystem::FileStatusInfo methodsFor:'accessing'!
accessTime
@@ -11151,6 +10864,7 @@
^ uid
! !
+
!UnixOperatingSystem::FileStatusInfo methodsFor:'accessing-vms'!
fixedHeaderSize
@@ -11183,6 +10897,7 @@
^ nil
! !
+
!UnixOperatingSystem::FileStatusInfo methodsFor:'backward compatibility'!
accessed
@@ -11214,6 +10929,7 @@
^ self statusChangeTime
! !
+
!UnixOperatingSystem::FileStatusInfo methodsFor:'private-accessing'!
type:t mode:m uid:u gid:g size:s id:i accessed:aT modified:mT statusChanged:sT path:lP numLinks:nL
@@ -11230,6 +10946,7 @@
numLinks := nL.
! !
+
!UnixOperatingSystem::FileStatusInfo methodsFor:'queries-access'!
isGroupExecutable
@@ -11304,6 +11021,7 @@
"
! !
+
!UnixOperatingSystem::FileStatusInfo methodsFor:'queries-type'!
isBlockSpecial
@@ -11338,6 +11056,7 @@
^ type == #unknown
! !
+
!UnixOperatingSystem::MountInfo methodsFor:'accessing'!
mountPointPath
@@ -11355,6 +11074,7 @@
attributeString := attributeStringArg.
! !
+
!UnixOperatingSystem::MountInfo methodsFor:'printing'!
printOn:aStream
@@ -11363,12 +11083,14 @@
nextPutAll:mountPointPath.
! !
+
!UnixOperatingSystem::MountInfo methodsFor:'queries'!
isRemote
^ fsType = 'nfs'
! !
+
!UnixOperatingSystem::OSProcessStatus class methodsFor:'documentation'!
documentation
@@ -11395,6 +11117,7 @@
"
! !
+
!UnixOperatingSystem::OSProcessStatus class methodsFor:'instance creation'!
pid:pid status:status code:code core:core
@@ -11415,6 +11138,7 @@
"Modified: 30.4.1996 / 18:25:05 / cg"
! !
+
!UnixOperatingSystem::OSProcessStatus methodsFor:'accessing'!
code
@@ -11453,6 +11177,7 @@
"Modified: 30.4.1996 / 18:26:54 / cg"
! !
+
!UnixOperatingSystem::OSProcessStatus methodsFor:'initialization'!
pid:newPid status:newStatus code:newCode core:newCore
@@ -11464,6 +11189,7 @@
"Created: 28.12.1995 / 14:18:22 / stefan"
! !
+
!UnixOperatingSystem::OSProcessStatus methodsFor:'printing & storing'!
printOn:aStream
@@ -11475,6 +11201,7 @@
aStream nextPut:$).
! !
+
!UnixOperatingSystem::OSProcessStatus methodsFor:'private-OS interface'!
code:something
@@ -11510,6 +11237,7 @@
"Created: 28.12.1995 / 14:05:07 / stefan"
! !
+
!UnixOperatingSystem::OSProcessStatus methodsFor:'queries'!
couldNotExecute
@@ -11538,6 +11266,7 @@
"Modified: 28.12.1995 / 14:13:41 / stefan"
! !
+
!UnixOperatingSystem::SocketHandle class methodsFor:'constants'!
protocolCodeOf:aNameOrNumber
@@ -11629,6 +11358,7 @@
"
! !
+
!UnixOperatingSystem::SocketHandle class methodsFor:'initialization'!
reinitialize
@@ -11637,6 +11367,7 @@
ProtocolCache := nil.
! !
+
!UnixOperatingSystem::SocketHandle class methodsFor:'queries'!
XXgetAddressInfo:hostName serviceName:serviceNameArg domain:domainArg type:typeArg protocol:protoArg flags:flags
@@ -12637,6 +12368,7 @@
^ result.
! !
+
!UnixOperatingSystem::SocketHandle methodsFor:'accepting'!
acceptWithPeerAddressBuffer:peerOrNil
@@ -12710,6 +12442,7 @@
^ self class for:newFd
! !
+
!UnixOperatingSystem::SocketHandle methodsFor:'binding'!
bindTo:socketAddress
@@ -12764,6 +12497,7 @@
"
! !
+
!UnixOperatingSystem::SocketHandle methodsFor:'connecting'!
cancelConnect
@@ -12886,6 +12620,7 @@
"
! !
+
!UnixOperatingSystem::SocketHandle methodsFor:'datagram transmission'!
receiveFrom:socketAddress buffer:aDataBuffer start:startIndex for:nBytes flags:flags
@@ -13122,6 +12857,7 @@
^ self error:error.
! !
+
!UnixOperatingSystem::SocketHandle methodsFor:'initialization'!
domain:domainArg type:typeArg protocol:protocolArg
@@ -13207,6 +12943,7 @@
"
! !
+
!UnixOperatingSystem::SocketHandle methodsFor:'misc'!
getOptionsLevel:level name:name
@@ -13398,6 +13135,7 @@
^ nil.
! !
+
!UnixOperatingSystem::SocketHandle methodsFor:'queries'!
getNameInto:socketAddress
@@ -13475,14 +13213,15 @@
^ nil
! !
+
!UnixOperatingSystem class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/UnixOperatingSystem.st,v 1.301 2013-01-17 22:37:55 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/UnixOperatingSystem.st,v 1.303 2013-01-24 16:32:16 cg Exp $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/UnixOperatingSystem.st,v 1.301 2013-01-17 22:37:55 cg Exp §'
+ ^ '$Header: /cvs/stx/stx/libbasic/UnixOperatingSystem.st,v 1.303 2013-01-24 16:32:16 cg Exp $'
!
version_HG
@@ -13491,5 +13230,5 @@
! !
+UnixOperatingSystem::FileDescriptorHandle initialize!
UnixOperatingSystem initialize!
-UnixOperatingSystem::FileDescriptorHandle initialize!
--- a/UserPreferences.st Wed Jan 23 10:08:55 2013 +0000
+++ b/UserPreferences.st Mon Jan 28 21:53:19 2013 +0000
@@ -1280,6 +1280,7 @@
"
UserPreferences current avoidConfirmationsForExperiencedUsers
+ UserPreferences current avoidConfirmationsForExperiencedUsers:true
"
"Created: / 05-09-2012 / 11:26:55 / cg"
@@ -3916,7 +3917,6 @@
"Created: / 19-08-2011 / 12:51:58 / cg"
! !
-
!UserPreferences methodsFor:'default settings-syntax colors'!
listOfPredefinedSyntaxColoringSchemes
@@ -4187,13 +4187,14 @@
!UserPreferences class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/UserPreferences.st,v 1.320 2012-12-01 09:51:12 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/UserPreferences.st,v 1.321 2013-01-24 01:19:40 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/UserPreferences.st,v 1.320 2012-12-01 09:51:12 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/UserPreferences.st,v 1.321 2013-01-24 01:19:40 cg Exp $'
!
version_SVN
^ '§ Id: UserPreferences.st 10648 2011-06-23 15:55:10Z vranyj1 §'
! !
+
--- a/ZeroDivide.st Wed Jan 23 10:08:55 2013 +0000
+++ b/ZeroDivide.st Mon Jan 28 21:53:19 2013 +0000
@@ -65,14 +65,48 @@
"
! !
+
!ZeroDivide class methodsFor:'initialization'!
initialize
NotifierString := 'division by zero'.
! !
+
!ZeroDivide methodsFor:'accessing'!
+defaultResumeValue
+ "no, we return infinity here, if ever proceeded"
+
+ ^ parameter receiver class infinity
+
+ "
+ |a b|
+
+ a := 5.
+ b := 0.
+ ZeroDivide handle:[:ex |
+ Transcript showCR:('division by zero - dividend was: ' , ex dividend printString).
+ ex proceed
+ ] do:[
+ a / b
+ ]
+ "
+
+ "
+ |a b|
+
+ a := 5.0.
+ b := 0.0.
+ ZeroDivide handle:[:ex |
+ Transcript showCR:('division by zero - dividend was: ' , ex dividend printString).
+ ex proceed
+ ] do:[
+ a / b
+ ]
+ "
+!
+
dividend
"Return the number that was being divided by zero."
@@ -91,17 +125,16 @@
"
! !
+
!ZeroDivide class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/ZeroDivide.st,v 1.7 2006/12/15 11:02:36 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/ZeroDivide.st,v 1.8 2013-01-25 17:19:34 cg Exp $'
!
version_SVN
^ '$Id: ZeroDivide.st 10761 2012-01-19 11:46:00Z vranyj1 $'
! !
+
ZeroDivide initialize!
-
-
-