.
--- a/Array.st Fri Jul 28 04:38:43 1995 +0200
+++ b/Array.st Thu Aug 03 03:17:14 1995 +0200
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/Array.st,v 1.32 1995-07-28 02:35:37 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Array.st,v 1.33 1995-08-03 01:14:27 claus Exp $
'!
!Array class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libbasic/Array.st,v 1.32 1995-07-28 02:35:37 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Array.st,v 1.33 1995-08-03 01:14:27 claus Exp $
"
!
@@ -491,8 +491,11 @@
and the single new element, newElement.
This is different from concatentation, which expects another collection
as argument, but equivalent to copy-and-addLast.
- Reimplemented for speed if receiver is an Array"
-%{
+ Reimplemented for speed if receiver is an Array.
+ (since the inherited copyWith uses replaceFromTo:, which is also
+ tuned, it is questionable, if we need this)"
+
+%{ /* NOCONTEXT */
OBJ nObj, element;
unsigned int sz;
unsigned int nIndex;
@@ -502,17 +505,25 @@
if (__qClass(self) == Array) {
sz = __qSize(self) + sizeof(OBJ);
PROTECT(something);
+ PROTECT(self);
_qAlignedNew(nObj, sz, __context);
+ UNPROTECT(self);
UNPROTECT(something);
if (nObj) {
_InstPtr(nObj)->o_class = Array;
nIndex = __BYTES2OBJS__(sz - OHDR_SIZE - sizeof(OBJ));
- /* sorry: must take care of stores ... */
+ /*
+ * sorry:
+ * cannot use bcopy, since we must take care of stores ...
+ * could check for: notRemembered + inOld + notLifoRem
+ * + not incrGCRunning
+ * but copyWith: is not heavily used by real programmers ...
+ */
+ spc = __qSpace(nObj);
srcP = _ArrayInstPtr(self)->a_element;
dstP = _ArrayInstPtr(nObj)->a_element;
- spc = __qSpace(nObj);
while (nIndex--) {
element = *srcP++;
*dstP++ = element;
@@ -587,6 +598,24 @@
if ((INT)anObject == 0) {
memset(dst, 0, __OBJS2BYTES__(endIndex-index+1));
} else {
+#if defined(IRIX5) || defined(UNROLL_LOOPS)
+ {
+ int i8;
+
+ while ((i8 = index + 8) <= endIndex) {
+ dst[0] = anObject;
+ dst[1] = anObject;
+ dst[2] = anObject;
+ dst[3] = anObject;
+ dst[4] = anObject;
+ dst[5] = anObject;
+ dst[6] = anObject;
+ dst[7] = anObject;
+ dst += 8;
+ index = i8;
+ }
+ }
+#endif
for (; index <= endIndex; index++) {
*dst++ = anObject;
}
@@ -639,12 +668,33 @@
src = &(_InstPtr(aCollection)->i_instvars[repStartIndex]);
dst = &(_InstPtr(self)->i_instvars[startIndex]);
if (aCollection == self) {
- /* no need to check stores */
- /* take care of overlapping copy */
+ /*
+ * no need to check stores if copying
+ * from myself
+ */
+ /*
+ * take care of overlapping copy
+ * do not depend on memset being smart enough
+ * (some are not ;-)
+ */
if (src < dst) {
/* must do a reverse copy */
src += count;
dst += count;
+#if defined(IRIX5) || defined(UNROLL_LOOPS)
+ while (count > 8) {
+ dst[-1] = src[-1];
+ dst[-2] = src[-2];
+ dst[-3] = src[-3];
+ dst[-4] = src[-4];
+ dst[-5] = src[-5];
+ dst[-6] = src[-6];
+ dst[-7] = src[-7];
+ dst[-8] = src[-8];
+ dst -= 8; src -= 8;
+ count -= 8;
+ }
+#endif
while (count-- > 0) {
*--dst = *--src;
}
@@ -665,6 +715,15 @@
REGISTER int spc;
spc = __qSpace(self);
+#if defined(IRIX5) || defined(UNROLL_LOOPS)
+ while (count >= 4) {
+ t = src[0]; dst[0] = t; __STORE_SPC(self, t, spc);
+ t = src[1]; dst[1] = t; __STORE_SPC(self, t, spc);
+ t = src[2]; dst[2] = t; __STORE_SPC(self, t, spc);
+ t = src[3]; dst[3] = t; __STORE_SPC(self, t, spc);
+ count -= 4; src += 4; dst += 4;
+ }
+#endif
while (count-- > 0) {
t = *src++;
*dst++ = t;
@@ -677,13 +736,19 @@
}
}
}
-%}
-.
+%}.
^ super replaceFrom:start to:stop with:aCollection startingAt:repStart
! !
!Array methodsFor:'queries'!
+isArray
+ "return true, if the receiver is some kind of array (or weakArray etc).
+ true is returned here"
+
+ ^ true
+!
+
isLiteral
"return true, if the receiver can be used as a literal
(i.e. can be used in constant arrays)"
@@ -728,7 +793,7 @@
/*
* first, do a quick check using ==
* this does not need a context or message send.
- * in many cases this will already find a match
+ * In many cases this will already find a match.
*/
REGISTER int index;
REGISTER OBJ o;
@@ -737,6 +802,13 @@
nIndex = __BYTES2OBJS__(__qSize(self) - OHDR_SIZE);
index = _intVal(_ClassInstPtr(__qClass(self))->c_ninstvars);
+ /*
+ * however, the search is limited to the first 1000
+ * elements, since otherwise, we may spend too much time
+ * searching for identity if an equal value is found early
+ */
+ if (nIndex > 1000) nIndex = 1000;
+
o = anObject;
#if defined(IRIX5) || defined(UNROLL_LOOPS)
{
@@ -773,6 +845,9 @@
unsigned int nIndex;
static struct inlineCache eq = _ILC1;
+ /*
+ * sorry: cannot access the stuff from above ...
+ */
nIndex = __BYTES2OBJS__(__qSize(self) - OHDR_SIZE);
index = _intVal(_ClassInstPtr(__qClass(self))->c_ninstvars);
@@ -822,6 +897,24 @@
}
} else {
/* search for nil */
+#if defined(IRIX5) || defined(UNROLL_LOOPS)
+ {
+ unsigned int i8;
+
+ while ((i8 = index + 8) < nIndex) {
+ if (_InstPtr(self)->i_instvars[index] == nil) { RETURN ( __MKSMALLINT(index - nInsts + 1) ); }
+ if (_InstPtr(self)->i_instvars[index+1] == nil) { RETURN ( __MKSMALLINT(index - nInsts + 2) ); }
+ if (_InstPtr(self)->i_instvars[index+2] == nil) { RETURN ( __MKSMALLINT(index - nInsts + 3) ); }
+ if (_InstPtr(self)->i_instvars[index+3] == nil) { RETURN ( __MKSMALLINT(index - nInsts + 4) ); }
+ if (_InstPtr(self)->i_instvars[index+4] == nil) { RETURN ( __MKSMALLINT(index - nInsts + 5) ); }
+ if (_InstPtr(self)->i_instvars[index+5] == nil) { RETURN ( __MKSMALLINT(index - nInsts + 6) ); }
+ if (_InstPtr(self)->i_instvars[index+6] == nil) { RETURN ( __MKSMALLINT(index - nInsts + 7) ); }
+ if (_InstPtr(self)->i_instvars[index+7] == nil) { RETURN ( __MKSMALLINT(index - nInsts + 8) ); }
+ index = i8;
+ }
+ }
+#endif
+
while (index < nIndex) {
if (_InstPtr(self)->i_instvars[index++] == nil) {
RETURN ( __MKSMALLINT(index - nInsts) );
@@ -1001,6 +1094,23 @@
/*
* home will not move - keep in a fast register
*/
+#if defined(IRIX5) || defined(UNROLL_LOOPS)
+ {
+ int i4;
+
+ while ((i4 = index+4) < nIndex) {
+ if (InterruptPending != nil) interruptL(__LINE__ COMMA_CON);
+ (*codeVal)(rHome, CON_COMMA _InstPtr(self)->i_instvars[index]);
+ if (InterruptPending != nil) interruptL(__LINE__ COMMA_CON);
+ (*codeVal)(rHome, CON_COMMA _InstPtr(self)->i_instvars[index+1]);
+ if (InterruptPending != nil) interruptL(__LINE__ COMMA_CON);
+ (*codeVal)(rHome, CON_COMMA _InstPtr(self)->i_instvars[index+2]);
+ if (InterruptPending != nil) interruptL(__LINE__ COMMA_CON);
+ (*codeVal)(rHome, CON_COMMA _InstPtr(self)->i_instvars[index+3]);
+ index = i4;
+ }
+ }
+#endif
for (; index < nIndex; index++) {
if (InterruptPending != nil) interruptL(__LINE__ COMMA_CON);
@@ -1062,30 +1172,33 @@
/*
* home will not move - keep in a fast register
*/
- for (; index < nIndex; index++) {
+ while (index < nIndex) {
if (InterruptPending != nil) interruptL(__LINE__ COMMA_CON);
- (*codeVal)(rHome, CON_COMMA __MKSMALLINT(index+1),
- _InstPtr(self)->i_instvars[index]);
+ index++;
+ (*codeVal)(rHome, CON_COMMA __MKSMALLINT(index),
+ _InstPtr(self)->i_instvars[index-1]);
}
} else {
- for (; index < nIndex; index++) {
+ while (index < nIndex) {
if (InterruptPending != nil) interruptL(__LINE__ COMMA_CON);
- (*codeVal)(home, CON_COMMA __MKSMALLINT(index+1),
- _InstPtr(self)->i_instvars[index]);
+ index++;
+ (*codeVal)(home, CON_COMMA __MKSMALLINT(index),
+ _InstPtr(self)->i_instvars[index-1]);
}
}
#endif
} else {
- for (; index < nIndex; index++) {
+ while (index < nIndex) {
if (InterruptPending != nil) interruptL(__LINE__ COMMA_CON);
+ index++;
(*val2.ilc_func)(aBlock,
@symbol(value:value:),
CON_COMMA nil, &val2,
- __MKSMALLINT(index+1),
- _InstPtr(self)->i_instvars[index]);
+ __MKSMALLINT(index),
+ _InstPtr(self)->i_instvars[index-1]);
}
}
%}
@@ -1177,7 +1290,25 @@
home = _BlockInstPtr(aBlock)->b_home;
rHome = home;
if ((rHome == nil) || (__qSpace(rHome) >= STACKSPACE)) {
- for (index=indexLow; index <= indexHigh; index++) {
+ index = indexLow;
+#if defined(IRIX5) || defined(UNROLL_LOOPS)
+ {
+ int i4;
+
+ while ((i4 = index+4) <= indexHigh) {
+ if (InterruptPending != nil) interruptL(__LINE__ COMMA_CON);
+ (*codeVal)(rHome, CON_COMMA _InstPtr(self)->i_instvars[index]);
+ if (InterruptPending != nil) interruptL(__LINE__ COMMA_CON);
+ (*codeVal)(rHome, CON_COMMA _InstPtr(self)->i_instvars[index+1]);
+ if (InterruptPending != nil) interruptL(__LINE__ COMMA_CON);
+ (*codeVal)(rHome, CON_COMMA _InstPtr(self)->i_instvars[index+2]);
+ if (InterruptPending != nil) interruptL(__LINE__ COMMA_CON);
+ (*codeVal)(rHome, CON_COMMA _InstPtr(self)->i_instvars[index+3]);
+ index = i4;
+ }
+ }
+#endif
+ for (; index <= indexHigh; index++) {
if (InterruptPending != nil) interruptL(__LINE__ COMMA_CON);
(*codeVal)(rHome, CON_COMMA _InstPtr(self)->i_instvars[index]);
}
@@ -1313,7 +1444,7 @@
element = _InstPtr(self)->i_instvars[index];
if (element != nil)
- (*codeVal)(home, CON_COMMA element);
+ (*codeVal)(rHome, CON_COMMA element);
}
} else {
for (; index < nIndex; index++) {
@@ -1351,7 +1482,7 @@
as well."
self do: [:el |
- (el isKindOf: Array)
+ el isArray
ifTrue: [el traverse: aBlock]
ifFalse: [aBlock value: el]]
--- a/CCReader.st Fri Jul 28 04:38:43 1995 +0200
+++ b/CCReader.st Thu Aug 03 03:17:14 1995 +0200
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/Attic/CCReader.st,v 1.15 1995-05-18 22:49:17 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Attic/CCReader.st,v 1.16 1995-08-03 01:14:43 claus Exp $
'!
!ClassCategoryReader class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libbasic/Attic/CCReader.st,v 1.15 1995-05-18 22:49:17 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Attic/CCReader.st,v 1.16 1995-08-03 01:14:43 claus Exp $
"
!
@@ -142,11 +142,12 @@
compiler := myClass compilerClass.
"/
- "/ kludge - have to make ST/X's compiler protocol
- "/ be compatible to ST-80's
+ "/ kludge - for now;
+ "/ have to make ST/X's compiler protocol be compatible to ST-80's
"/
(compiler respondsTo:#compile:forClass:inCategory:notifying:install:skipIfSame:)
ifTrue:[
+ "/ ST/X's compiler
method :=compiler
compile:aString
forClass:myClass
@@ -156,6 +157,7 @@
skipIfSame:true.
] ifFalse:[
+ "/ some generated (TGEN) compiler
method := compiler new
compile:aString
in:myClass
--- a/ClassCategoryReader.st Fri Jul 28 04:38:43 1995 +0200
+++ b/ClassCategoryReader.st Thu Aug 03 03:17:14 1995 +0200
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/ClassCategoryReader.st,v 1.15 1995-05-18 22:49:17 claus Exp $
+$Header: /cvs/stx/stx/libbasic/ClassCategoryReader.st,v 1.16 1995-08-03 01:14:43 claus Exp $
'!
!ClassCategoryReader class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libbasic/ClassCategoryReader.st,v 1.15 1995-05-18 22:49:17 claus Exp $
+$Header: /cvs/stx/stx/libbasic/ClassCategoryReader.st,v 1.16 1995-08-03 01:14:43 claus Exp $
"
!
@@ -142,11 +142,12 @@
compiler := myClass compilerClass.
"/
- "/ kludge - have to make ST/X's compiler protocol
- "/ be compatible to ST-80's
+ "/ kludge - for now;
+ "/ have to make ST/X's compiler protocol be compatible to ST-80's
"/
(compiler respondsTo:#compile:forClass:inCategory:notifying:install:skipIfSame:)
ifTrue:[
+ "/ ST/X's compiler
method :=compiler
compile:aString
forClass:myClass
@@ -156,6 +157,7 @@
skipIfSame:true.
] ifFalse:[
+ "/ some generated (TGEN) compiler
method := compiler new
compile:aString
in:myClass
--- a/CompCode.st Fri Jul 28 04:38:43 1995 +0200
+++ b/CompCode.st Thu Aug 03 03:17:14 1995 +0200
@@ -23,7 +23,7 @@
COPYRIGHT (c) 1994 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/Attic/CompCode.st,v 1.15 1995-06-27 02:12:19 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Attic/CompCode.st,v 1.16 1995-08-03 01:14:55 claus Exp $
'!
!CompiledCode class methodsFor:'documentation'!
@@ -44,7 +44,7 @@
version
"
-$Header: /cvs/stx/stx/libbasic/Attic/CompCode.st,v 1.15 1995-06-27 02:12:19 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Attic/CompCode.st,v 1.16 1995-08-03 01:14:55 claus Exp $
"
!
@@ -156,12 +156,12 @@
symbolSet := IdentitySet new.
literals notNil ifTrue:[
literals do: [ :lit |
- (lit isSymbol) ifTrue: [
+ lit isSymbol ifTrue: [
symbolSet add: lit
] ifFalse: [
- (lit isKindOf:Array) ifTrue: [
+ lit isArray ifTrue: [
lit traverse: [ :el |
- (el isSymbol) ifTrue: [symbolSet add: el]
+ el isSymbol ifTrue: [symbolSet add: el]
]
]
]
--- a/CompiledCode.st Fri Jul 28 04:38:43 1995 +0200
+++ b/CompiledCode.st Thu Aug 03 03:17:14 1995 +0200
@@ -23,7 +23,7 @@
COPYRIGHT (c) 1994 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/CompiledCode.st,v 1.15 1995-06-27 02:12:19 claus Exp $
+$Header: /cvs/stx/stx/libbasic/CompiledCode.st,v 1.16 1995-08-03 01:14:55 claus Exp $
'!
!CompiledCode class methodsFor:'documentation'!
@@ -44,7 +44,7 @@
version
"
-$Header: /cvs/stx/stx/libbasic/CompiledCode.st,v 1.15 1995-06-27 02:12:19 claus Exp $
+$Header: /cvs/stx/stx/libbasic/CompiledCode.st,v 1.16 1995-08-03 01:14:55 claus Exp $
"
!
@@ -156,12 +156,12 @@
symbolSet := IdentitySet new.
literals notNil ifTrue:[
literals do: [ :lit |
- (lit isSymbol) ifTrue: [
+ lit isSymbol ifTrue: [
symbolSet add: lit
] ifFalse: [
- (lit isKindOf:Array) ifTrue: [
+ lit isArray ifTrue: [
lit traverse: [ :el |
- (el isSymbol) ifTrue: [symbolSet add: el]
+ el isSymbol ifTrue: [symbolSet add: el]
]
]
]
--- a/ExtStream.st Fri Jul 28 04:38:43 1995 +0200
+++ b/ExtStream.st Thu Aug 03 03:17:14 1995 +0200
@@ -24,7 +24,7 @@
COPYRIGHT (c) 1988 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/Attic/ExtStream.st,v 1.42 1995-07-28 02:36:22 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Attic/ExtStream.st,v 1.43 1995-08-03 01:15:09 claus Exp $
'!
!ExternalStream primitiveDefinitions!
@@ -86,7 +86,7 @@
version
"
-$Header: /cvs/stx/stx/libbasic/Attic/ExtStream.st,v 1.42 1995-07-28 02:36:22 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Attic/ExtStream.st,v 1.43 1995-08-03 01:15:09 claus Exp $
"
!
@@ -1729,7 +1729,7 @@
next:count
"return the next count elements of the stream as a collection.
- Redefined to return a String or ByteArray instead of the default Array."
+ Redefined to return a String or ByteArray instead of the default: Array."
|coll|
@@ -1738,6 +1738,10 @@
] ifFalse:[
coll := String new:count
].
+ "/
+ "/ Q: should we use:
+ "/ self nextBytes:count into:coll startingAt:1
+ "/
1 to:count do: [:index |
coll at:index put:(self next)
].
@@ -2052,7 +2056,7 @@
FILE *f;
int len;
char buffer[1024];
- char *rslt;
+ char *rslt, *limit;
int fd, ch;
int _buffered;
OBJ fp;
@@ -2085,6 +2089,8 @@
#else
rslt = buffer;
+ limit = buffer + sizeof(buffer) - 2;
+
for (;;) {
if (_buffered) {
/*
@@ -2125,7 +2131,7 @@
*rslt = '\0';
break;
}
- if (rslt == (buffer + sizeof(buffer) - 1)) {
+ if (rslt >= limit) {
*rslt = '\0';
break;
}
@@ -2133,6 +2139,9 @@
#endif
__END_INTERRUPTABLE__
if (rslt != NULL) {
+ /*
+ * that strlen can be avoided and replaced by (rslt - buffer)
+ */
len = strlen(buffer);
if (_INST(position) != nil) {
_INST(position) = __MKSMALLINT(__intVal(_INST(position)) + len + 1);
@@ -2262,7 +2271,7 @@
__WRITING__(dst)
for (;;) {
- if (fgets(buffer, sizeof(buffer), src) == NULL) {
+ if (fgets(buffer, sizeof(buffer)-1, src) == NULL) {
if (ferror(src)) {
readError = __MKSMALLINT(errno);
__END_INTERRUPTABLE__
@@ -2340,8 +2349,9 @@
__BEGIN_INTERRUPTABLE__
do {
- cp = fgets(buffer, sizeof(buffer), f);
+ cp = fgets(buffer, sizeof(buffer)-1, f);
} while ((cp == NULL) && (errno == EINTR));
+ buffer[sizeof(buffer)-1] = '\0';
__END_INTERRUPTABLE__
if (cp == NULL) {
@@ -2748,7 +2758,7 @@
__READING__(f)
__BEGIN_INTERRUPTABLE__
- if (fgets(buffer, sizeof(buffer), f) != NULL) {
+ if (fgets(buffer, sizeof(buffer)-1, f) != NULL) {
__END_INTERRUPTABLE__
RETURN ( self );
}
@@ -3056,6 +3066,9 @@
__BEGIN_INTERRUPTABLE__
__READING__(f)
+ /*
+ * skip whiteSpace first ...
+ */
for (;;) {
do {
ch = getc(f);
@@ -3103,7 +3116,7 @@
}
cnt++;
buffer[len++] = ch;
- if (len >= sizeof(buffer)-1) {
+ if (len >= (sizeof(buffer)-1)) {
/* emergency */
break;
}
@@ -3141,7 +3154,7 @@
binary ifTrue:[^ self errorBinary].
(mode == #writeonly) ifTrue:[^ self errorWriteOnly].
-%{ /* STACK: 2000 */
+%{ /* STACK: 4000 */
FILE *f;
int done = 0;
REGISTER int c;
@@ -3297,15 +3310,21 @@
buffer = (char *)0;
}
%}.
- lastErrorNumber notNil ifTrue:[^ self readError].
- outOfMemory == true ifTrue:[
- "
- memory allocation failed.
- When we arrive here, there was no (unix) memory available for the
- chunk. (seems to be too big of a chunk ...)
- Bad luck - you should increase the swap space on your machine.
- "
- ^ ObjectMemory allocationFailureSignal raise.
+ retVal isNil ifTrue:[
+ "/
+ "/ arrive here with retVal==nil either on error or premature EOF
+ "/ or if running out of malloc-memory
+ "/
+ lastErrorNumber notNil ifTrue:[^ self readError].
+ outOfMemory == true ifTrue:[
+ "
+ memory allocation failed.
+ When we arrive here, there was no (unix) memory available for the
+ chunk. (seems to be too big of a chunk ...)
+ Bad luck - you should increase the swap space on your machine.
+ "
+ ^ ObjectMemory allocationFailureSignal raise.
+ ]
].
^ retVal
! !
--- a/ExternalStream.st Fri Jul 28 04:38:43 1995 +0200
+++ b/ExternalStream.st Thu Aug 03 03:17:14 1995 +0200
@@ -24,7 +24,7 @@
COPYRIGHT (c) 1988 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/ExternalStream.st,v 1.42 1995-07-28 02:36:22 claus Exp $
+$Header: /cvs/stx/stx/libbasic/ExternalStream.st,v 1.43 1995-08-03 01:15:09 claus Exp $
'!
!ExternalStream primitiveDefinitions!
@@ -86,7 +86,7 @@
version
"
-$Header: /cvs/stx/stx/libbasic/ExternalStream.st,v 1.42 1995-07-28 02:36:22 claus Exp $
+$Header: /cvs/stx/stx/libbasic/ExternalStream.st,v 1.43 1995-08-03 01:15:09 claus Exp $
"
!
@@ -1729,7 +1729,7 @@
next:count
"return the next count elements of the stream as a collection.
- Redefined to return a String or ByteArray instead of the default Array."
+ Redefined to return a String or ByteArray instead of the default: Array."
|coll|
@@ -1738,6 +1738,10 @@
] ifFalse:[
coll := String new:count
].
+ "/
+ "/ Q: should we use:
+ "/ self nextBytes:count into:coll startingAt:1
+ "/
1 to:count do: [:index |
coll at:index put:(self next)
].
@@ -2052,7 +2056,7 @@
FILE *f;
int len;
char buffer[1024];
- char *rslt;
+ char *rslt, *limit;
int fd, ch;
int _buffered;
OBJ fp;
@@ -2085,6 +2089,8 @@
#else
rslt = buffer;
+ limit = buffer + sizeof(buffer) - 2;
+
for (;;) {
if (_buffered) {
/*
@@ -2125,7 +2131,7 @@
*rslt = '\0';
break;
}
- if (rslt == (buffer + sizeof(buffer) - 1)) {
+ if (rslt >= limit) {
*rslt = '\0';
break;
}
@@ -2133,6 +2139,9 @@
#endif
__END_INTERRUPTABLE__
if (rslt != NULL) {
+ /*
+ * that strlen can be avoided and replaced by (rslt - buffer)
+ */
len = strlen(buffer);
if (_INST(position) != nil) {
_INST(position) = __MKSMALLINT(__intVal(_INST(position)) + len + 1);
@@ -2262,7 +2271,7 @@
__WRITING__(dst)
for (;;) {
- if (fgets(buffer, sizeof(buffer), src) == NULL) {
+ if (fgets(buffer, sizeof(buffer)-1, src) == NULL) {
if (ferror(src)) {
readError = __MKSMALLINT(errno);
__END_INTERRUPTABLE__
@@ -2340,8 +2349,9 @@
__BEGIN_INTERRUPTABLE__
do {
- cp = fgets(buffer, sizeof(buffer), f);
+ cp = fgets(buffer, sizeof(buffer)-1, f);
} while ((cp == NULL) && (errno == EINTR));
+ buffer[sizeof(buffer)-1] = '\0';
__END_INTERRUPTABLE__
if (cp == NULL) {
@@ -2748,7 +2758,7 @@
__READING__(f)
__BEGIN_INTERRUPTABLE__
- if (fgets(buffer, sizeof(buffer), f) != NULL) {
+ if (fgets(buffer, sizeof(buffer)-1, f) != NULL) {
__END_INTERRUPTABLE__
RETURN ( self );
}
@@ -3056,6 +3066,9 @@
__BEGIN_INTERRUPTABLE__
__READING__(f)
+ /*
+ * skip whiteSpace first ...
+ */
for (;;) {
do {
ch = getc(f);
@@ -3103,7 +3116,7 @@
}
cnt++;
buffer[len++] = ch;
- if (len >= sizeof(buffer)-1) {
+ if (len >= (sizeof(buffer)-1)) {
/* emergency */
break;
}
@@ -3141,7 +3154,7 @@
binary ifTrue:[^ self errorBinary].
(mode == #writeonly) ifTrue:[^ self errorWriteOnly].
-%{ /* STACK: 2000 */
+%{ /* STACK: 4000 */
FILE *f;
int done = 0;
REGISTER int c;
@@ -3297,15 +3310,21 @@
buffer = (char *)0;
}
%}.
- lastErrorNumber notNil ifTrue:[^ self readError].
- outOfMemory == true ifTrue:[
- "
- memory allocation failed.
- When we arrive here, there was no (unix) memory available for the
- chunk. (seems to be too big of a chunk ...)
- Bad luck - you should increase the swap space on your machine.
- "
- ^ ObjectMemory allocationFailureSignal raise.
+ retVal isNil ifTrue:[
+ "/
+ "/ arrive here with retVal==nil either on error or premature EOF
+ "/ or if running out of malloc-memory
+ "/
+ lastErrorNumber notNil ifTrue:[^ self readError].
+ outOfMemory == true ifTrue:[
+ "
+ memory allocation failed.
+ When we arrive here, there was no (unix) memory available for the
+ chunk. (seems to be too big of a chunk ...)
+ Bad luck - you should increase the swap space on your machine.
+ "
+ ^ ObjectMemory allocationFailureSignal raise.
+ ]
].
^ retVal
! !
--- a/Integer.st Fri Jul 28 04:38:43 1995 +0200
+++ b/Integer.st Thu Aug 03 03:17:14 1995 +0200
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1988 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/Integer.st,v 1.28 1995-06-27 02:13:06 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Integer.st,v 1.29 1995-08-03 01:15:29 claus Exp $
'!
!Integer class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libbasic/Integer.st,v 1.28 1995-06-27 02:13:06 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Integer.st,v 1.29 1995-08-03 01:15:29 claus Exp $
"
!
@@ -598,7 +598,7 @@
"
ds3100 486/50 Indy(no cache)
- 20804 4800 2500
+ 20804 4800 2145
"
!
--- a/LinkList.st Fri Jul 28 04:38:43 1995 +0200
+++ b/LinkList.st Thu Aug 03 03:17:14 1995 +0200
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/Attic/LinkList.st,v 1.14 1995-07-27 04:01:12 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Attic/LinkList.st,v 1.15 1995-08-03 01:15:38 claus Exp $
'!
!LinkedList class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libbasic/Attic/LinkList.st,v 1.14 1995-07-27 04:01:12 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Attic/LinkList.st,v 1.15 1995-08-03 01:15:38 claus Exp $
"
!
@@ -172,6 +172,12 @@
"return true, if the collection is empty"
^ firstLink isNil
+!
+
+notEmpty
+ "return true, if the collection is not empty"
+
+ ^ firstLink notNil
! !
!LinkedList methodsFor:'testing'!
--- a/LinkedList.st Fri Jul 28 04:38:43 1995 +0200
+++ b/LinkedList.st Thu Aug 03 03:17:14 1995 +0200
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/LinkedList.st,v 1.14 1995-07-27 04:01:12 claus Exp $
+$Header: /cvs/stx/stx/libbasic/LinkedList.st,v 1.15 1995-08-03 01:15:38 claus Exp $
'!
!LinkedList class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libbasic/LinkedList.st,v 1.14 1995-07-27 04:01:12 claus Exp $
+$Header: /cvs/stx/stx/libbasic/LinkedList.st,v 1.15 1995-08-03 01:15:38 claus Exp $
"
!
@@ -172,6 +172,12 @@
"return true, if the collection is empty"
^ firstLink isNil
+!
+
+notEmpty
+ "return true, if the collection is not empty"
+
+ ^ firstLink notNil
! !
!LinkedList methodsFor:'testing'!
--- a/ObjMem.st Fri Jul 28 04:38:43 1995 +0200
+++ b/ObjMem.st Thu Aug 03 03:17:14 1995 +0200
@@ -34,7 +34,7 @@
COPYRIGHT (c) 1992 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/Attic/ObjMem.st,v 1.47 1995-07-28 02:37:08 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Attic/ObjMem.st,v 1.48 1995-08-03 01:15:54 claus Exp $
'!
!ObjectMemory class methodsFor:'documentation'!
@@ -55,7 +55,7 @@
version
"
-$Header: /cvs/stx/stx/libbasic/Attic/ObjMem.st,v 1.47 1995-07-28 02:37:08 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Attic/ObjMem.st,v 1.48 1995-08-03 01:15:54 claus Exp $
"
!
@@ -1257,9 +1257,9 @@
"
|p|
p := Point new.
- (ObjectMemory addressOf:p) printNL.
+ ((ObjectMemory addressOf:p) printStringRadix:16) printNL.
ObjectMemory scavenge.
- (ObjectMemory addressOf:p) printNL.
+ ((ObjectMemory addressOf:p) printStringRadix:16) printNL.
"
!
@@ -1382,12 +1382,14 @@
"for ST-80 compatibility: return the maximum value
a hashKey as returned by identityHash can get.
Since ST/X uses direct pointers, a field in the objectHeader
- is used, which is currently 12 bits in size."
-
- "/ BOGUS: here we should have define of stc.h somehow
- "/ to have that knowledge at one place only ...
-
- ^ 4095
+ is used, which is currently 11 bits in size."
+
+%{ /* NOCONTEXT */
+ RETURN ( __MKSMALLINT( __MAX_HASH__ << __HASH_SHIFT__) );
+%}
+ "
+ ObjectMemory maximumIdentityHashValue
+ "
! !
!ObjectMemory class methodsFor:'garbage collection'!
@@ -1572,25 +1574,26 @@
"perform a compessing garbage collect and show some informational
output on the Transcript"
- |nBytesBefore nReclaimed|
+ |nBytesBefore nReclaimed value unit|
nBytesBefore := self oldSpaceUsed.
self garbageCollect.
nReclaimed := nBytesBefore - self oldSpaceUsed.
nReclaimed > 0 ifTrue:[
- Transcript show:'reclaimed '.
nReclaimed > 1024 ifTrue:[
nReclaimed > (1024 * 1024) ifTrue:[
- Transcript show:(nReclaimed // (1024 * 1024)) printString.
- Transcript showCr:' Mb.'
+ value := nReclaimed // (1024 * 1024).
+ unit := ' Mb.'
] ifFalse:[
- Transcript show:(nReclaimed // 1024) printString.
- Transcript showCr:' Kb.'
+ value := nReclaimed // 1024.
+ unit := ' Kb.'
]
] ifFalse:[
- Transcript show:nReclaimed printString.
- Transcript showCr:' bytes.'
- ]
+ value := nReclaimed.
+ unit := ' bytes.'
+ ].
+ Transcript show:'reclaimed '; show:value printString.
+ Transcript showCr:unit
]
"
@@ -1953,6 +1956,8 @@
value should be used to switch back."
%{ /* NOCONTEXT */
+ extern int __fastMoreOldSpaceAllocation();
+
RETURN (__fastMoreOldSpaceAllocation(aBoolean == true ? 1 : 0) ? true : false);
%}
"
@@ -1967,6 +1972,41 @@
ObjectMemory fastMoreOldSpaceAllocation:previousSetting
]
"
+
+ "
+ |prev this|
+
+ prev := ObjectMemory fastMoreOldSpaceAllocation:true.
+ ObjectMemory fastMoreOldSpaceAllocation:prev.
+ ^ prev
+ "
+!
+
+fastMoreOldSpaceLimit:aNumber
+ "this method sets and returns the fastMoreOldSpace limit.
+ If fastMoreOldSpaceAllocation is true, and the current oldSpace size is
+ below this limit, the memory manager will NOT do a GC when running out of
+ oldSpace, but instead quickly go ahead increasing the size of the oldSpace.
+ Setting the limit to 0 turns off any limit (i.e. it will continue to
+ increase the oldSpace forwever - actually, until the OS refuses to give us
+ more memory). The returned value is the previous setting of the limit."
+
+%{ /* NOCONTEXT */
+ extern int __fastMoreOldSpaceLimit();
+
+ if (__isSmallInteger(aNumber)) {
+ RETURN ( __MKSMALLINT( __fastMoreOldSpaceLimit(__intVal(aNumber))));
+ }
+%}.
+ self primitiveFailed
+
+ "
+ |prev this|
+
+ prev := ObjectMemory fastMoreOldSpaceLimit:10*1024*1024.
+ ObjectMemory fastMoreOldSpaceLimit:prev.
+ ^ prev
+ "
!
checkForFastNew:amount
@@ -1982,7 +2022,7 @@
This is experimental and not guaranteed to be in future versions."
%{ /* NOCONTEXT */
- extern __checkForFastNew();
+ extern int __checkForFastNew();
if (__isSmallInteger(amount)) {
if (! __checkForFastNew(_intVal(amount))) {
@@ -2040,6 +2080,70 @@
%{ /* NOCONTEXT */
__tenureParams(magic);
%}.
+!
+
+lockTenure:aBoolean
+ "set/clear the tenureLock. If the lock is set, the system
+ completely turns off tenuring, and objects remain in newSpace (forever).
+ The system will completely operatate in the newSpace and no memory
+ allocations from oldSpace are allowed, once this lock is
+ set (except for explicit tenure calls).
+ If any allocation request cannot be resoved, the VM raises a memory interrupt,
+ clears the flag and returns nil. This, it automatically falls back into
+ the normal mode of operation, to avoid big trouble (fail to allocate memory
+ when handling the exception).
+
+ This interface can be used in applications, which are guaranteed to have their
+ working set completely in the newSpace AND want to limit the worst case
+ pause times to the worst case scavenge time (which itself is limitd by the
+ size of the newSpace).
+ I.e. systems which go into some event loop after initial startup,
+ may turn on the tenureLock to make certain that no oldSpace memory is
+ allocated in the future; thereby limiting any GC activity to newSpace
+ scavenges only."
+
+%{
+ if (aBoolean == true) {
+ __tenure(__context);
+ }
+ __lockTenure(aBoolean == true ? 1 : 0);
+%}
+!
+
+newSpaceSize:newSize
+ "change the size of the newSpace. To do this, the current contents
+ of the newSpace may have to be tenured (if size is smaller).
+ Returns false, if it failed for any reason.
+ Experimental: this interface may valish without notice.
+
+ DANGER ALERT:
+ be careful too big of a size may lead to longer scavenge pauses.
+ Too small of a newSpace may lead to more CPU overhead, due to
+ excessive scavenges. You have been warned."
+
+%{
+ extern int __setNewSpaceSize();
+
+ if (__isSmallInteger(newSize)) {
+ RETURN (__setNewSpaceSize(__intVal(newSize)) ? true : false);
+ }
+%}.
+ self primitiveFailed
+
+ " less absolute CPU overhead (but longer pauses):
+
+ ObjectMemory newSpaceSize:800*1024
+ "
+
+ " smaller pauses, but more overall CPU overhead:
+
+ ObjectMemory newSpaceSize:200*1024
+ "
+
+ " the default:
+
+ ObjectMemory newSpaceSize:400*1024
+ "
! !
!ObjectMemory class ignoredMethodsFor:'object finalization'!
--- a/Object.st Fri Jul 28 04:38:43 1995 +0200
+++ b/Object.st Thu Aug 03 03:17:14 1995 +0200
@@ -30,7 +30,7 @@
COPYRIGHT (c) 1988 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/Object.st,v 1.54 1995-07-28 02:37:20 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Object.st,v 1.55 1995-08-03 01:16:04 claus Exp $
'!
!Object class methodsFor:'documentation'!
@@ -51,7 +51,7 @@
version
"
-$Header: /cvs/stx/stx/libbasic/Object.st,v 1.54 1995-07-28 02:37:20 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Object.st,v 1.55 1995-08-03 01:16:04 claus Exp $
"
!
@@ -639,6 +639,13 @@
^ false
!
+isArray
+ "return true, if the receiver is some kind of array (or weakArray etc);
+ false is returned here - the method is only redefined in Array."
+
+ ^ false
+!
+
isString
"return true, if the receiver is some kind of string;
false is returned here - the method is only redefined in String."
@@ -1324,8 +1331,8 @@
no object-table exists and the hashval must not change when objects
are moved by the collector. Therefore we assign each object a unique
Id in the object header itself as its hashed upon.
- (luckily we have 12 bits spare to do this - unluckily its only 12 bits).
- Time will show, if 12 bits are enough; if not, another entry in the
+ (luckily we have 11 bits spare to do this - unluckily its only 11 bits).
+ Time will show, if 11 bits are enough; if not, another entry in the
object header will be needed, adding 4 bytes to every object. Alternatively,
hashed-upon objects could add an instvar containing the hash value."
@@ -1349,13 +1356,13 @@
}
/*
- * now, we got 12 bits for hashing;
+ * now, we got 11 bits for hashing;
* make it as large as possible; since most hashers use the returned
* key and take it modulu some prime number, this will allow for
* better distribution (i.e. bigger empty spaces) in hashed collection.
* we could shift it up to the 30 bit limit - not making it negative.
*/
- RETURN ( _MKSMALLINT(hash << 12) );
+ RETURN ( _MKSMALLINT(hash << __HASH_SHIFT__) );
}
%}.
^ 0 "never reached, since redefined in UndefinedObject and SmallInteger"
--- a/ObjectMemory.st Fri Jul 28 04:38:43 1995 +0200
+++ b/ObjectMemory.st Thu Aug 03 03:17:14 1995 +0200
@@ -34,7 +34,7 @@
COPYRIGHT (c) 1992 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/ObjectMemory.st,v 1.47 1995-07-28 02:37:08 claus Exp $
+$Header: /cvs/stx/stx/libbasic/ObjectMemory.st,v 1.48 1995-08-03 01:15:54 claus Exp $
'!
!ObjectMemory class methodsFor:'documentation'!
@@ -55,7 +55,7 @@
version
"
-$Header: /cvs/stx/stx/libbasic/ObjectMemory.st,v 1.47 1995-07-28 02:37:08 claus Exp $
+$Header: /cvs/stx/stx/libbasic/ObjectMemory.st,v 1.48 1995-08-03 01:15:54 claus Exp $
"
!
@@ -1257,9 +1257,9 @@
"
|p|
p := Point new.
- (ObjectMemory addressOf:p) printNL.
+ ((ObjectMemory addressOf:p) printStringRadix:16) printNL.
ObjectMemory scavenge.
- (ObjectMemory addressOf:p) printNL.
+ ((ObjectMemory addressOf:p) printStringRadix:16) printNL.
"
!
@@ -1382,12 +1382,14 @@
"for ST-80 compatibility: return the maximum value
a hashKey as returned by identityHash can get.
Since ST/X uses direct pointers, a field in the objectHeader
- is used, which is currently 12 bits in size."
-
- "/ BOGUS: here we should have define of stc.h somehow
- "/ to have that knowledge at one place only ...
-
- ^ 4095
+ is used, which is currently 11 bits in size."
+
+%{ /* NOCONTEXT */
+ RETURN ( __MKSMALLINT( __MAX_HASH__ << __HASH_SHIFT__) );
+%}
+ "
+ ObjectMemory maximumIdentityHashValue
+ "
! !
!ObjectMemory class methodsFor:'garbage collection'!
@@ -1572,25 +1574,26 @@
"perform a compessing garbage collect and show some informational
output on the Transcript"
- |nBytesBefore nReclaimed|
+ |nBytesBefore nReclaimed value unit|
nBytesBefore := self oldSpaceUsed.
self garbageCollect.
nReclaimed := nBytesBefore - self oldSpaceUsed.
nReclaimed > 0 ifTrue:[
- Transcript show:'reclaimed '.
nReclaimed > 1024 ifTrue:[
nReclaimed > (1024 * 1024) ifTrue:[
- Transcript show:(nReclaimed // (1024 * 1024)) printString.
- Transcript showCr:' Mb.'
+ value := nReclaimed // (1024 * 1024).
+ unit := ' Mb.'
] ifFalse:[
- Transcript show:(nReclaimed // 1024) printString.
- Transcript showCr:' Kb.'
+ value := nReclaimed // 1024.
+ unit := ' Kb.'
]
] ifFalse:[
- Transcript show:nReclaimed printString.
- Transcript showCr:' bytes.'
- ]
+ value := nReclaimed.
+ unit := ' bytes.'
+ ].
+ Transcript show:'reclaimed '; show:value printString.
+ Transcript showCr:unit
]
"
@@ -1953,6 +1956,8 @@
value should be used to switch back."
%{ /* NOCONTEXT */
+ extern int __fastMoreOldSpaceAllocation();
+
RETURN (__fastMoreOldSpaceAllocation(aBoolean == true ? 1 : 0) ? true : false);
%}
"
@@ -1967,6 +1972,41 @@
ObjectMemory fastMoreOldSpaceAllocation:previousSetting
]
"
+
+ "
+ |prev this|
+
+ prev := ObjectMemory fastMoreOldSpaceAllocation:true.
+ ObjectMemory fastMoreOldSpaceAllocation:prev.
+ ^ prev
+ "
+!
+
+fastMoreOldSpaceLimit:aNumber
+ "this method sets and returns the fastMoreOldSpace limit.
+ If fastMoreOldSpaceAllocation is true, and the current oldSpace size is
+ below this limit, the memory manager will NOT do a GC when running out of
+ oldSpace, but instead quickly go ahead increasing the size of the oldSpace.
+ Setting the limit to 0 turns off any limit (i.e. it will continue to
+ increase the oldSpace forwever - actually, until the OS refuses to give us
+ more memory). The returned value is the previous setting of the limit."
+
+%{ /* NOCONTEXT */
+ extern int __fastMoreOldSpaceLimit();
+
+ if (__isSmallInteger(aNumber)) {
+ RETURN ( __MKSMALLINT( __fastMoreOldSpaceLimit(__intVal(aNumber))));
+ }
+%}.
+ self primitiveFailed
+
+ "
+ |prev this|
+
+ prev := ObjectMemory fastMoreOldSpaceLimit:10*1024*1024.
+ ObjectMemory fastMoreOldSpaceLimit:prev.
+ ^ prev
+ "
!
checkForFastNew:amount
@@ -1982,7 +2022,7 @@
This is experimental and not guaranteed to be in future versions."
%{ /* NOCONTEXT */
- extern __checkForFastNew();
+ extern int __checkForFastNew();
if (__isSmallInteger(amount)) {
if (! __checkForFastNew(_intVal(amount))) {
@@ -2040,6 +2080,70 @@
%{ /* NOCONTEXT */
__tenureParams(magic);
%}.
+!
+
+lockTenure:aBoolean
+ "set/clear the tenureLock. If the lock is set, the system
+ completely turns off tenuring, and objects remain in newSpace (forever).
+ The system will completely operatate in the newSpace and no memory
+ allocations from oldSpace are allowed, once this lock is
+ set (except for explicit tenure calls).
+ If any allocation request cannot be resoved, the VM raises a memory interrupt,
+ clears the flag and returns nil. This, it automatically falls back into
+ the normal mode of operation, to avoid big trouble (fail to allocate memory
+ when handling the exception).
+
+ This interface can be used in applications, which are guaranteed to have their
+ working set completely in the newSpace AND want to limit the worst case
+ pause times to the worst case scavenge time (which itself is limitd by the
+ size of the newSpace).
+ I.e. systems which go into some event loop after initial startup,
+ may turn on the tenureLock to make certain that no oldSpace memory is
+ allocated in the future; thereby limiting any GC activity to newSpace
+ scavenges only."
+
+%{
+ if (aBoolean == true) {
+ __tenure(__context);
+ }
+ __lockTenure(aBoolean == true ? 1 : 0);
+%}
+!
+
+newSpaceSize:newSize
+ "change the size of the newSpace. To do this, the current contents
+ of the newSpace may have to be tenured (if size is smaller).
+ Returns false, if it failed for any reason.
+ Experimental: this interface may valish without notice.
+
+ DANGER ALERT:
+ be careful too big of a size may lead to longer scavenge pauses.
+ Too small of a newSpace may lead to more CPU overhead, due to
+ excessive scavenges. You have been warned."
+
+%{
+ extern int __setNewSpaceSize();
+
+ if (__isSmallInteger(newSize)) {
+ RETURN (__setNewSpaceSize(__intVal(newSize)) ? true : false);
+ }
+%}.
+ self primitiveFailed
+
+ " less absolute CPU overhead (but longer pauses):
+
+ ObjectMemory newSpaceSize:800*1024
+ "
+
+ " smaller pauses, but more overall CPU overhead:
+
+ ObjectMemory newSpaceSize:200*1024
+ "
+
+ " the default:
+
+ ObjectMemory newSpaceSize:400*1024
+ "
! !
!ObjectMemory class ignoredMethodsFor:'object finalization'!
--- a/OrdColl.st Fri Jul 28 04:38:43 1995 +0200
+++ b/OrdColl.st Thu Aug 03 03:17:14 1995 +0200
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/Attic/OrdColl.st,v 1.27 1995-07-02 01:07:38 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Attic/OrdColl.st,v 1.28 1995-08-03 01:16:13 claus Exp $
'!
!OrderedCollection class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libbasic/Attic/OrdColl.st,v 1.27 1995-07-02 01:07:38 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Attic/OrdColl.st,v 1.28 1995-08-03 01:16:13 claus Exp $
"
!
@@ -437,9 +437,9 @@
self makeRoomAtLast.
idx := lastIndex.
].
- idx := idx + 1.
+ idx := lastIndex := idx + 1.
contentsArray at:idx put:anObject.
- lastIndex := idx.
+"/ lastIndex := idx.
^ anObject
"
--- a/OrderedCollection.st Fri Jul 28 04:38:43 1995 +0200
+++ b/OrderedCollection.st Thu Aug 03 03:17:14 1995 +0200
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/OrderedCollection.st,v 1.27 1995-07-02 01:07:38 claus Exp $
+$Header: /cvs/stx/stx/libbasic/OrderedCollection.st,v 1.28 1995-08-03 01:16:13 claus Exp $
'!
!OrderedCollection class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libbasic/OrderedCollection.st,v 1.27 1995-07-02 01:07:38 claus Exp $
+$Header: /cvs/stx/stx/libbasic/OrderedCollection.st,v 1.28 1995-08-03 01:16:13 claus Exp $
"
!
@@ -437,9 +437,9 @@
self makeRoomAtLast.
idx := lastIndex.
].
- idx := idx + 1.
+ idx := lastIndex := idx + 1.
contentsArray at:idx put:anObject.
- lastIndex := idx.
+"/ lastIndex := idx.
^ anObject
"
--- a/Project.st Fri Jul 28 04:38:43 1995 +0200
+++ b/Project.st Thu Aug 03 03:17:14 1995 +0200
@@ -23,7 +23,7 @@
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/Project.st,v 1.22 1995-07-28 02:37:55 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Project.st,v 1.23 1995-08-03 01:16:24 claus Exp $
'!
!Project class methodsFor:'documentation'!
@@ -44,7 +44,7 @@
version
"
-$Header: /cvs/stx/stx/libbasic/Project.st,v 1.22 1995-07-28 02:37:55 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Project.st,v 1.23 1995-08-03 01:16:24 claus Exp $
"
!
@@ -249,7 +249,7 @@
|classes methods|
- classes := self classes.
+ classes := self classes asIdentitySet.
methods := IdentitySet new.
Smalltalk allBehaviorsDo:[:cls |
--- a/SmallInt.st Fri Jul 28 04:38:43 1995 +0200
+++ b/SmallInt.st Thu Aug 03 03:17:14 1995 +0200
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1988 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/Attic/SmallInt.st,v 1.30 1995-07-28 02:38:10 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Attic/SmallInt.st,v 1.31 1995-08-03 01:16:41 claus Exp $
'!
!SmallInteger class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libbasic/Attic/SmallInt.st,v 1.30 1995-07-28 02:38:10 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Attic/SmallInt.st,v 1.31 1995-08-03 01:16:41 claus Exp $
"
!
@@ -1433,6 +1433,19 @@
/*
* home will not move - keep in in a register
*/
+#if defined(IRIX5) || defined(UNROLL_LOOPS)
+ while (tmp > 4) {
+ if (InterruptPending != nil) interrupt(CONARG);
+ (*code)(rHome COMMA_CON);
+ if (InterruptPending != nil) interrupt(CONARG);
+ (*code)(rHome COMMA_CON);
+ if (InterruptPending != nil) interrupt(CONARG);
+ (*code)(rHome COMMA_CON);
+ if (InterruptPending != nil) interrupt(CONARG);
+ (*code)(rHome COMMA_CON);
+ tmp -= 4;
+ }
+#endif
do {
if (InterruptPending != nil) interrupt(CONARG);
(*code)(rHome COMMA_CON);
@@ -1505,6 +1518,23 @@
/*
* home will not move - keep in in a register
*/
+#if defined(IRIX5) || defined(UNROLL_LOOPS)
+ {
+ int t4;
+
+ while ((t4 = tmp+4) < final) {
+ if (InterruptPending != nil) interrupt(CONARG);
+ (*code)(rHome, CON_COMMA _MKSMALLINT(tmp));
+ if (InterruptPending != nil) interrupt(CONARG);
+ (*code)(rHome, CON_COMMA _MKSMALLINT(tmp+1));
+ if (InterruptPending != nil) interrupt(CONARG);
+ (*code)(rHome, CON_COMMA _MKSMALLINT(tmp+2));
+ if (InterruptPending != nil) interrupt(CONARG);
+ (*code)(rHome, CON_COMMA _MKSMALLINT(tmp+3));
+ tmp = t4;
+ }
+ }
+#endif
while (tmp <= final) {
if (InterruptPending != nil) interrupt(CONARG);
(*code)(rHome, CON_COMMA _MKSMALLINT(tmp));
--- a/SmallInteger.st Fri Jul 28 04:38:43 1995 +0200
+++ b/SmallInteger.st Thu Aug 03 03:17:14 1995 +0200
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1988 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/SmallInteger.st,v 1.30 1995-07-28 02:38:10 claus Exp $
+$Header: /cvs/stx/stx/libbasic/SmallInteger.st,v 1.31 1995-08-03 01:16:41 claus Exp $
'!
!SmallInteger class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libbasic/SmallInteger.st,v 1.30 1995-07-28 02:38:10 claus Exp $
+$Header: /cvs/stx/stx/libbasic/SmallInteger.st,v 1.31 1995-08-03 01:16:41 claus Exp $
"
!
@@ -1433,6 +1433,19 @@
/*
* home will not move - keep in in a register
*/
+#if defined(IRIX5) || defined(UNROLL_LOOPS)
+ while (tmp > 4) {
+ if (InterruptPending != nil) interrupt(CONARG);
+ (*code)(rHome COMMA_CON);
+ if (InterruptPending != nil) interrupt(CONARG);
+ (*code)(rHome COMMA_CON);
+ if (InterruptPending != nil) interrupt(CONARG);
+ (*code)(rHome COMMA_CON);
+ if (InterruptPending != nil) interrupt(CONARG);
+ (*code)(rHome COMMA_CON);
+ tmp -= 4;
+ }
+#endif
do {
if (InterruptPending != nil) interrupt(CONARG);
(*code)(rHome COMMA_CON);
@@ -1505,6 +1518,23 @@
/*
* home will not move - keep in in a register
*/
+#if defined(IRIX5) || defined(UNROLL_LOOPS)
+ {
+ int t4;
+
+ while ((t4 = tmp+4) < final) {
+ if (InterruptPending != nil) interrupt(CONARG);
+ (*code)(rHome, CON_COMMA _MKSMALLINT(tmp));
+ if (InterruptPending != nil) interrupt(CONARG);
+ (*code)(rHome, CON_COMMA _MKSMALLINT(tmp+1));
+ if (InterruptPending != nil) interrupt(CONARG);
+ (*code)(rHome, CON_COMMA _MKSMALLINT(tmp+2));
+ if (InterruptPending != nil) interrupt(CONARG);
+ (*code)(rHome, CON_COMMA _MKSMALLINT(tmp+3));
+ tmp = t4;
+ }
+ }
+#endif
while (tmp <= final) {
if (InterruptPending != nil) interrupt(CONARG);
(*code)(rHome, CON_COMMA _MKSMALLINT(tmp));
--- a/String.st Fri Jul 28 04:38:43 1995 +0200
+++ b/String.st Thu Aug 03 03:17:14 1995 +0200
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1988 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/String.st,v 1.39 1995-07-27 04:12:43 claus Exp $
+$Header: /cvs/stx/stx/libbasic/String.st,v 1.40 1995-08-03 01:16:53 claus Exp $
'!
!String class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libbasic/String.st,v 1.39 1995-07-27 04:12:43 claus Exp $
+$Header: /cvs/stx/stx/libbasic/String.st,v 1.40 1995-08-03 01:16:53 claus Exp $
"
!
@@ -560,13 +560,13 @@
if (__isString(formatString)) {
#ifdef THISCONTEXT_IN_REGISTER
- /*
- * actually only needed on sparc: since thisContext is
- * in a global register, which gets destroyed by printf,
- * manually save it here - very stupid ...
- */
- extern OBJ __thisContext__;
- __thisContext__ = __thisContext;
+ /*
+ * actually only needed on sparc: since thisContext is
+ * in a global register, which gets destroyed by printf,
+ * manually save it here - very stupid ...
+ */
+ extern OBJ __thisContext__;
+ __thisContext__ = __thisContext;
#endif
cp = (char *)_stringVal(self);
@@ -990,6 +990,7 @@
#else
REGISTER int byteValue;
REGISTER int index;
+ char c;
#endif
OBJ cls;
@@ -1005,16 +1006,14 @@
#else
byteValue = _intVal(_characterVal(aCharacter));
index = 1;
- while (*cp) {
- if (*cp++ == byteValue) {
- RETURN ( _MKSMALLINT(index) );
- }
+ while (c = *cp++) {
+ if (c == byteValue) { RETURN ( _MKSMALLINT(index) ); }
index++;
}
#endif
}
-%}
-.
+%}.
+ "/ cannot include anything but characters ...
^ 0
"
@@ -1034,6 +1033,8 @@
REGISTER int index, byteValue;
#ifdef FAST_STRCHR
char *strchr();
+#else
+ char c;
#endif
int len;
OBJ cls;
@@ -1055,8 +1056,8 @@
RETURN ( _MKSMALLINT(cp - _stringVal(self) + 1) );
}
#else
- while (*cp) {
- if (*cp++ == byteValue) {
+ while (c = *cp++) {
+ if (c == byteValue) {
RETURN ( _MKSMALLINT(index) );
}
index++;
@@ -1066,8 +1067,7 @@
}
RETURN ( _MKSMALLINT(0) );
}
-%}
-.
+%}.
^ super indexOf:aCharacter startingAt:start
"
@@ -1133,6 +1133,7 @@
REGISTER unsigned char *src1, *src2;
REGISTER OBJ s = aString;
OBJ cls;
+ char c;
len1 = __qSize(self);
src1 = _stringVal(self);
@@ -1151,8 +1152,8 @@
if (len1 < len2) {
RETURN ( false );
}
- while (*src2)
- if (*src2++ != *src1++) {
+ while (c = *src2++)
+ if (c != *src1++) {
RETURN ( false );
}
%}
@@ -1180,6 +1181,7 @@
REGISTER unsigned char *src1, *src2;
REGISTER OBJ s = aString;
OBJ cls;
+ char c;
len1 = __qSize(self);
src1 = _stringVal(self);
@@ -1200,12 +1202,11 @@
}
src1 = _stringVal(self) + len1 - len2;
src2 = _stringVal(aString);
- while (*src2)
- if (*src2++ != *src1++) {
+ while (c = *src2++)
+ if (c != *src1++) {
RETURN ( false );
}
-%}
-.
+%}.
^ true
"
@@ -1217,7 +1218,8 @@
!String methodsFor:'testing'!
isBlank
- "return true, if the receiver contains spaces only"
+ "return true, if the receivers size is 0 or if it contains only spaces.
+ Q: should we care for whiteSpace in general here ?"
%{ /* NOCONTEXT */
@@ -1229,6 +1231,11 @@
if ((cls = __qClass(self)) != String)
src += __OBJS2BYTES__(_intVal(_ClassInstPtr(cls)->c_ninstvars));
+#ifndef NON_ASCII
+ while (*((unsigned *)src) == 0x20202020) {
+ src += 4;
+ }
+#endif
while (c = *src++)
if (c != ' ') {
RETURN ( false );
--- a/Symbol.st Fri Jul 28 04:38:43 1995 +0200
+++ b/Symbol.st Thu Aug 03 03:17:14 1995 +0200
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1988 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/Symbol.st,v 1.24 1995-05-24 12:44:31 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Symbol.st,v 1.25 1995-08-03 01:17:01 claus Exp $
'!
!Symbol class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libbasic/Symbol.st,v 1.24 1995-05-24 12:44:31 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Symbol.st,v 1.25 1995-08-03 01:17:01 claus Exp $
"
!
@@ -52,7 +52,7 @@
exists exactly once in the system; Symbols are used for selectors, global
variable-keys etc. Symbols can also be used to represent things which are
enumeration type values in other programming languages (since symbols are
- created at compile time, comparing them using == is a fast pointer compare.
+ created at compile time, comparing them using == is a fast pointer compare).
A symbol may not change its characters - i.e. it is constant over its lifetime.
Other than that, symbols behave much like strings.
@@ -335,6 +335,52 @@
}
%}.
^ super identityHash
+!
+
+= something
+ "return true, if the receiver and argument consist of the same characters.
+ Redefined here, for more efficient #= comparison of symbols
+ (which ought to be compared using #==).
+ If the argument is a symbol, we use a quick pointer compare, instead of
+ the inherited value compare."
+
+%{ /* NOCONTEXT */
+ OBJ cls;
+
+ if (! __isNonNilObject(something)) RETURN(false);
+ if ((cls = __qClass(something)) == Symbol) {
+ RETURN (self == something ? true : false);
+ }
+ if (cls == String) {
+ RETURN (strcmp(__stringVal(self), __stringVal(something)) == 0 ? true : false);
+ }
+%}.
+ "fall back; could be a TwoByteString, or a collection of Characters"
+
+ ^ super = something
+!
+
+~= something
+ "return true, if the receiver and argument do not consist of the same characters.
+ Redefined here, for more efficient #~= comparison of symbols
+ (which ought to be compared using #~~).
+ If the argument is a symbol, we use a quick pointer compare, instead of
+ the inherited value compare."
+
+%{ /* NOCONTEXT */
+ OBJ cls;
+
+ if (! __isNonNilObject(something)) RETURN(true); /* cannot be equal */
+ if ((cls = __qClass(something)) == Symbol) {
+ RETURN (self == something ? false : true);
+ }
+ if (cls == String) {
+ RETURN (strcmp(__stringVal(self), __stringVal(something)) == 0 ? false : true);
+ }
+%}.
+ "fall back; could be a TwoByteString, or a collection of Characters"
+
+ ^ super ~= something
! !
!Symbol methodsFor:'system primitives'!
--- a/Unix.st Fri Jul 28 04:38:43 1995 +0200
+++ b/Unix.st Thu Aug 03 03:17:14 1995 +0200
@@ -22,7 +22,7 @@
COPYRIGHT (c) 1988 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/Attic/Unix.st,v 1.42 1995-07-28 02:38:29 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Attic/Unix.st,v 1.43 1995-08-03 01:17:14 claus Exp $
'!
!OperatingSystem primitiveDefinitions!
@@ -159,7 +159,7 @@
version
"
-$Header: /cvs/stx/stx/libbasic/Attic/Unix.st,v 1.42 1995-07-28 02:38:29 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Attic/Unix.st,v 1.43 1995-08-03 01:17:14 claus Exp $
"
!
@@ -168,7 +168,7 @@
this class gives access to some operating system services;
some of it is very specific for unix, so do not depend on
things available here in your applications - some may not
- be found in other OS's or be slightly dfferent ...
+ be found in other OS's or be slightly different ...
Currently, there is only this class available - once more than
Unix is supported, the corresponding class will be bound to the
global variable OperatingSystem.
@@ -1734,6 +1734,19 @@
return _MKSMALLINT(0);
#endif
%}
+!
+
+sigDANGER
+ "return the signal number for SIGDANGER - 0 if not supported
+ (seems to be an AIX special)"
+
+%{ /* NOCONTEXT */
+#if defined(SIGSAK)
+ return _MKSMALLINT(SIGSAK);
+#else
+ return _MKSMALLINT(0);
+#endif
+%}
! !
!OperatingSystem class methodsFor:'interrupts & signals'!
@@ -1778,6 +1791,7 @@
aSignalNumber == self sigGRANT ifTrue:[^ 'HFT access wanted'].
aSignalNumber == self sigRETRACT ifTrue:[^ 'HFT access relinquish'].
aSignalNumber == self sigSOUND ifTrue:[^ 'HFT sound complete'].
+ aSignalNumber == self sigDANGER ifTrue:[^ 'low on paging space'].
"notice: many systems map SIGPOLL and/or SIGUSR onto SIGIO
therefore, keep SIGIO always above the two below"
@@ -2300,6 +2314,23 @@
OSSignals := Array new:32
].
OSSignals at:signalNumber put:aSignal
+!
+
+sendSignal:signalNumber to:processId
+ "send a unix signal to some process (maybe myself).
+ Returns false if any error occurred, true otherwise.
+
+ Do not confuse UNIX signals with Smalltalk-Signals."
+%{
+ if (__bothSmallInteger(signalNumber, processId)) {
+ if (kill(__intVal(processId), __intVal(signalNumber)) < 0) {
+ OperatingSystem_LastErrorNumber = _MKSMALLINT(errno);
+ RETURN ( false );
+ }
+ RETURN ( true );
+ }
+%}.
+ self primitiveFailed
! !
!OperatingSystem class methodsFor:'time and date'!
@@ -3061,23 +3092,6 @@
OperatingSystem executeCommand:'rm /tmp/foofoofoofoo'.
(OperatingSystem lastExecStatus printStringRadix:16) printNL.
"
-!
-
-sendSignal:signalNumber to:processId
- "send a unix signal to some process (maybe myself).
- Returns false if any error occurred, true otherwise.
-
- Do not confuse UNIX signals with Smalltalk-Signals."
-%{
- if (__bothSmallInteger(signalNumber, processId)) {
- if (kill(__intVal(processId), __intVal(signalNumber)) < 0) {
- OperatingSystem_LastErrorNumber = _MKSMALLINT(errno);
- RETURN ( false );
- }
- RETURN ( true );
- }
-%}.
- self primitiveFailed
! !
!OperatingSystem class methodsFor:'file access'!