--- a/ByteArray.st Thu Jun 02 13:20:08 1994 +0200
+++ b/ByteArray.st Thu Jun 02 13:21:56 1994 +0200
@@ -24,7 +24,7 @@
ByteArrays store integers in the range 0..255
-$Header: /cvs/stx/stx/libbasic/ByteArray.st,v 1.11 1994-05-17 10:06:47 claus Exp $
+$Header: /cvs/stx/stx/libbasic/ByteArray.st,v 1.12 1994-06-02 11:18:50 claus Exp $
written spring 89 by claus
'!
@@ -332,7 +332,7 @@
}
%}
.
- ^ ((self wordAt:index+2) * (256 *256)) + (self wordAt:index)
+ ^ ((256 * 256) * (self wordAt:index+2)) + (self wordAt:index)
!
doubleWordAt:index put:value
@@ -374,7 +374,7 @@
].
t := value // (256 * 256).
self wordAt:(index+2) put:t.
- self wordAt:(index) put:(value - (t * 256 * 256)).
+ self wordAt:(index) put:(value - (256 * 256 * t)).
^ value
!
--- a/Class.st Thu Jun 02 13:20:08 1994 +0200
+++ b/Class.st Thu Jun 02 13:21:56 1994 +0200
@@ -22,7 +22,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/Class.st,v 1.12 1994-05-17 10:06:53 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Class.st,v 1.13 1994-06-02 11:19:23 claus Exp $
written Spring 89 by claus
'!
@@ -487,6 +487,23 @@
(self classVarNames includes:aString) ifFalse:[
self classVariableString:(self classVariableString , ' ' , aString)
]
+!
+
+renameCategory:oldCategory to:newCategory
+ "change methods categories"
+
+ |any|
+
+ any := false.
+ methods do:[:aMethod |
+ aMethod category = oldCategory ifTrue:[
+ aMethod category:newCategory.
+ any := true.
+ ]
+ ].
+ any ifTrue:[
+ self addChangeRecordForRenameCategory:oldCategory to:newCategory
+ ]
! !
!Class methodsFor:'adding/removing'!
@@ -720,6 +737,37 @@
]
!
+addChangeRecordForRenameCategory:oldCategory to:newCategory
+ "add a category-rename record to the changes file"
+
+ |aStream|
+
+ aStream := self changesStream.
+ aStream notNil ifTrue:[
+ self printClassNameOn:aStream.
+ aStream nextPutAll:(' renameCategory:' , oldCategory storeString).
+ aStream nextPutAll:(' to:' , newCategory storeString).
+ aStream nextPut:(aStream class chunkSeparator).
+ aStream cr.
+ aStream close
+ ]
+!
+
+addChangeRecordForChangeCategory
+ "add a category change record to the changes file"
+
+ |aStream|
+
+ aStream := self changesStream.
+ aStream notNil ifTrue:[
+ self printClassNameOn:aStream.
+ aStream nextPutAll:(' category:' , category storeString).
+ aStream nextPut:(aStream class chunkSeparator).
+ aStream cr.
+ aStream close
+ ]
+!
+
addChangeRecordForSnapshot:aFileName
"add a snapshot-record to the changes file"
--- a/Date.st Thu Jun 02 13:20:08 1994 +0200
+++ b/Date.st Thu Jun 02 13:21:56 1994 +0200
@@ -23,7 +23,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/Date.st,v 1.9 1994-05-17 10:07:06 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Date.st,v 1.10 1994-06-02 11:19:50 claus Exp $
written spring 89
total rewrite feb 94
@@ -414,14 +414,14 @@
fromDays:dayCount
"return a new Date, given the day-number starting at 1.Jan 1901;
- i.e. 'Date fromDays:1' returns 1st Jan. 1901.
+ i.e. 'Date fromDays:0' returns 1st Jan. 1901.
for GNU/ST-80 compatibility"
|yr rest d|
"approx. year"
yr := (dayCount // 366) + 1901.
- rest := dayCount - (self yearAsDays:yr).
+ rest := dayCount - (self yearAsDays:yr) + 1. "+1 for ST-80 compatibility"
d := self daysInYear:yr.
(rest > d) ifTrue:[
"adjust"
@@ -431,11 +431,11 @@
^ self day:rest year:yr
- "Date fromDays:1" "1 jan 1901"
- "Date fromDays:365" "31 dec 1901"
- "Date fromDays:730" "31 dec 1902"
- "Date fromDays:1095" "31 dec 1903"
- "Date fromDays:1460" "30 dec 1904 since 1904 was a leap year"
+ "Date fromDays:0" "1 jan 1901"
+ "Date fromDays:365" "1 jan 1902"
+ "Date fromDays:730" "1 jan 1903"
+ "Date fromDays:1095" "1 jan 1903"
+ "Date fromDays:1460" "31 dec 1904 since 1904 was a leap year"
!
day:dayInYear year:year
@@ -581,7 +581,7 @@
dayCount
"return the number of days since 1st. Jan. 1901;
- starting with 1 for this date."
+ starting with 0 for this date."
|yr|
@@ -589,6 +589,7 @@
^ (self class yearAsDays:yr)
+ (self class daysUntilMonth:self month forYear:yr)
+ self day
+ - 1
"(Date day:1 month:1 year:1901) dayCount"
"Date fromDays:(Date day:1 month:1 year:1994) dayCount"
@@ -596,15 +597,13 @@
asDays
"return the number of days elapsed since 01-Jan-1901
- and the receiver's day.
+ and the receiver's day; starts with 0 for 1-1-1901.
For ST-80 compatibility."
- ^self dayCount -1.
-
-"NOTE: 01-Jan-1901 asDays is 0 in ST-80 but
- 01-Jan-1901 dayCount is 1 in ST-X."
+ ^ self dayCount.
"(Date day: 5 month: 8 year: 1962) asDays" "should be 22496"
+ "(Date day: 1 month: 1 year: 1901) asDays" "0"
!
asSeconds
@@ -614,7 +613,8 @@
^ "60*60*24" 86400 * self asDays
- "(Date day: 5 month: 8 year: 1962) asSeconds" "should be 1943654400"
+ "(Date day: 5 month: 8 year: 1962) asSeconds"
+ "(Date day: 1 month: 1 year: 1901) asSeconds"
!
dayOfMonth
@@ -628,7 +628,7 @@
"return the week-day of the receiver - 1 for monday, 7 for sunday"
^ (1 "know, that 1st Jan 1901 was a tuesday"
- + self dayCount - 1) \\ 7 + 1
+ + self dayCount) \\ 7 + 1
"Date today dayInWeek"
"(Date day:15 month:4 year:1959) dayInWeek"
--- a/DirStr.st Thu Jun 02 13:20:08 1994 +0200
+++ b/DirStr.st Thu Jun 02 13:21:56 1994 +0200
@@ -22,7 +22,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/Attic/DirStr.st,v 1.9 1994-05-17 10:07:14 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Attic/DirStr.st,v 1.10 1994-06-02 11:19:56 claus Exp $
'!
%{
@@ -81,7 +81,6 @@
struct dirent *dp;
#endif
extern errno;
- extern OBJ ErrorNumber;
if (_INST(dirPointer) != nil) {
d = (DIR *)MKFD(_INST(dirPointer));
@@ -91,7 +90,7 @@
if (dp != NULL) {
nextEntry = _MKSTRING((char *)(dp->d_name) COMMA_CON);
}
- ErrorNumber = _MKSMALLINT(errno);
+ ExternalStream_LastErrorNumber = _MKSMALLINT(errno);
}
#endif
%}
@@ -113,7 +112,6 @@
#ifdef HAS_OPENDIR
DIR *d;
OBJ path;
- extern OBJ ErrorNumber, ErrorString;
extern errno;
retVal = false;
@@ -124,8 +122,7 @@
d = opendir((char *) _stringVal(path));
} while ((d == NULL) && (errno == EINTR));
if (d == NULL) {
- /* ErrorString = _MKSTRING(perror("popen:") COMMA_CON); */
- ErrorNumber = _MKSMALLINT(errno);
+ ExternalStream_LastErrorNumber = _MKSMALLINT(errno);
} else {
_INST(dirPointer) = MKOBJ(d);
retVal = true;
--- a/DirectoryStream.st Thu Jun 02 13:20:08 1994 +0200
+++ b/DirectoryStream.st Thu Jun 02 13:21:56 1994 +0200
@@ -22,7 +22,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/DirectoryStream.st,v 1.9 1994-05-17 10:07:14 claus Exp $
+$Header: /cvs/stx/stx/libbasic/DirectoryStream.st,v 1.10 1994-06-02 11:19:56 claus Exp $
'!
%{
@@ -81,7 +81,6 @@
struct dirent *dp;
#endif
extern errno;
- extern OBJ ErrorNumber;
if (_INST(dirPointer) != nil) {
d = (DIR *)MKFD(_INST(dirPointer));
@@ -91,7 +90,7 @@
if (dp != NULL) {
nextEntry = _MKSTRING((char *)(dp->d_name) COMMA_CON);
}
- ErrorNumber = _MKSMALLINT(errno);
+ ExternalStream_LastErrorNumber = _MKSMALLINT(errno);
}
#endif
%}
@@ -113,7 +112,6 @@
#ifdef HAS_OPENDIR
DIR *d;
OBJ path;
- extern OBJ ErrorNumber, ErrorString;
extern errno;
retVal = false;
@@ -124,8 +122,7 @@
d = opendir((char *) _stringVal(path));
} while ((d == NULL) && (errno == EINTR));
if (d == NULL) {
- /* ErrorString = _MKSTRING(perror("popen:") COMMA_CON); */
- ErrorNumber = _MKSMALLINT(errno);
+ ExternalStream_LastErrorNumber = _MKSMALLINT(errno);
} else {
_INST(dirPointer) = MKOBJ(d);
retVal = true;
--- a/ExtStream.st Thu Jun 02 13:20:08 1994 +0200
+++ b/ExtStream.st Thu Jun 02 13:21:56 1994 +0200
@@ -12,7 +12,7 @@
ReadWriteStream subclass:#ExternalStream
instanceVariableNames:'filePointer mode buffered binary useCRLF hitEOF'
- classVariableNames:'Lobby'
+ classVariableNames:'Lobby LastErrorNumber'
poolDictionaries:''
category:'Streams-External'
!
@@ -22,7 +22,7 @@
COPYRIGHT (c) 1988 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/Attic/ExtStream.st,v 1.16 1994-05-17 10:07:23 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Attic/ExtStream.st,v 1.17 1994-06-02 11:20:13 claus Exp $
written 88 by claus
'!
@@ -71,6 +71,27 @@
reOpen in subclasses for more information.
For streams sitting on some communication channel (i.e. Pipes and Sockets) you should
reestablish the stream upon image restart (make someone dependent on ObjectMemory).
+
+ Instance variables:
+
+ filePointer <Integer> the unix FILE*; somehow mapped to an integer
+ (notice: not the fd)
+ mode <Symbol> #readwrite, #readonly or #writeonly
+ buffered <Boolean> true, if buffered (i.e. collects characters - does
+ not output immediately)
+ binary <Boolean> true if in binary mode (reads bytes instead of chars)
+ useCRLF <Boolean> true, if lines should be terminated with crlf instead
+ of lf. (i.e. if file is an MSDOS-type file)
+ hitEOF <Boolean> true, if EOF was reached
+
+
+ Class variables:
+ Lobby <Registry> keeps track of used ext-streams (to free up FILE*'s)
+
+ LastErrorNumber <Integer> the value of errno (only valid right after the error -
+ updated with next i/o operation)
+
+ Question: should lastErrorNumber be kept instance-specific ?
"
! !
@@ -153,6 +174,12 @@
!ExternalStream methodsFor:'error handling'!
+lastErrorNumber
+ "return the last error"
+
+ ^ LastErrorNumber
+!
+
errorNotOpen
"report an error, that the stream has not been opened"
@@ -415,7 +442,6 @@
int ret, ioNum, ioArg;
int savInt;
extern int _immediateInterrupt;
- extern OBJ ErrorNumber;
extern errno;
if (_INST(filePointer) != nil) {
@@ -431,7 +457,7 @@
if (ret >= 0) {
RETURN ( _MKSMALLINT(ret) );
}
- ErrorNumber = _MKSMALLINT(errno);
+ ExternalStream_LastErrorNumber = _MKSMALLINT(errno);
RETURN ( nil );
}
}
@@ -456,7 +482,6 @@
FILE *f;
int ret, ioNum, savInt;
extern int _immediateInterrupt;
- extern OBJ ErrorNumber;
extern errno;
if (_INST(filePointer) != nil) {
@@ -477,7 +502,7 @@
if (ret >= 0) {
RETURN ( _MKSMALLINT(ret) );
}
- ErrorNumber = _MKSMALLINT(errno);
+ ExternalStream_LastErrorNumber = _MKSMALLINT(errno);
RETURN ( nil );
}
}
@@ -499,7 +524,6 @@
FILE *f;
unsigned char byte;
int cnt, savInt;
- extern OBJ ErrorNumber;
extern errno;
extern int _immediateInterrupt;
@@ -523,7 +547,7 @@
RETURN ( _MKSMALLINT(byte) );
}
if (cnt < 0) {
- ErrorNumber = _MKSMALLINT(errno);
+ ExternalStream_LastErrorNumber = _MKSMALLINT(errno);
}
_INST(hitEOF) = true;
RETURN ( nil );
@@ -566,7 +590,6 @@
int cnt, offs;
int objSize, nInstVars, nInstBytes, savInt;
char *cp;
- extern OBJ ErrorNumber;
extern errno;
OBJ pos;
extern int _immediateInterrupt;
@@ -613,7 +636,7 @@
_INST(hitEOF) = true;
RETURN ( _MKSMALLINT(cnt) );
}
- ErrorNumber = _MKSMALLINT(errno);
+ ExternalStream_LastErrorNumber = _MKSMALLINT(errno);
RETURN ( nil );
}
}
@@ -636,7 +659,6 @@
%{ /* NOCONTEXT */
extern int _immediateInterrupt;
- extern OBJ ErrorNumber;
int savInt;
if (_INST(binary) == true) {
@@ -663,7 +685,7 @@
if (cnt == 0)
_INST(hitEOF) = true;
else
- ErrorNumber = _MKSMALLINT(errno);
+ ExternalStream_LastErrorNumber = _MKSMALLINT(errno);
RETURN ( nil );
}
do {
@@ -684,7 +706,7 @@
if (cnt == 0)
_INST(hitEOF) = true;
else
- ErrorNumber = _MKSMALLINT(errno);
+ ExternalStream_LastErrorNumber = _MKSMALLINT(errno);
RETURN ( _MKSMALLINT(hi & 0xFF) );
}
if (_INST(position) != nil) {
@@ -1009,7 +1031,6 @@
FILE *f;
char c;
- extern OBJ ErrorNumber;
extern errno;
OBJ pos;
int cnt, savInt;
@@ -1043,7 +1064,7 @@
_INST(position) = _MKSMALLINT(_intVal(pos) + 1);
RETURN ( self );
}
- ErrorNumber = _MKSMALLINT(errno);
+ ExternalStream_LastErrorNumber = _MKSMALLINT(errno);
RETURN (nil);
}
}
@@ -1088,7 +1109,6 @@
int cnt, offs;
int objSize, nInstVars, nInstBytes;
char *cp;
- extern OBJ ErrorNumber;
extern errno;
OBJ oClass;
OBJ pos;
@@ -1141,7 +1161,7 @@
_INST(position) = _MKSMALLINT(_intVal(pos) + cnt);
RETURN ( _MKSMALLINT(cnt) );
}
- ErrorNumber = _MKSMALLINT(errno);
+ ExternalStream_LastErrorNumber = _MKSMALLINT(errno);
RETURN ( nil );
}
}
@@ -1165,7 +1185,6 @@
int num;
char bytes[2];
FILE *f;
- extern OBJ ErrorNumber;
extern errno;
int savInt;
extern int _immediateInterrupt;
@@ -1207,7 +1226,7 @@
}
RETURN ( self );
}
- ErrorNumber = _MKSMALLINT(errno);
+ ExternalStream_LastErrorNumber = _MKSMALLINT(errno);
return ( nil );
}
}
@@ -1229,7 +1248,6 @@
int num;
char bytes[4];
FILE *f;
- extern OBJ ErrorNumber;
extern errno;
int cnt, savInt;
extern int _immediateInterrupt;
@@ -1272,7 +1290,7 @@
}
RETURN ( self );
}
- ErrorNumber = _MKSMALLINT(errno);
+ ExternalStream_LastErrorNumber = _MKSMALLINT(errno);
return ( nil );
}
}
@@ -1440,7 +1458,6 @@
FILE *f;
char c;
- extern OBJ ErrorNumber;
extern errno;
int cnt;
OBJ pos;
@@ -1480,7 +1497,7 @@
}
RETURN ( self );
}
- ErrorNumber = _MKSMALLINT(errno);
+ ExternalStream_LastErrorNumber = _MKSMALLINT(errno);
RETURN ( nil );
}
} else {
@@ -1509,7 +1526,6 @@
FILE *f;
unsigned char *cp;
int len, cnt;
- extern OBJ ErrorNumber;
extern errno;
OBJ pos;
int savInt;
@@ -1566,7 +1582,7 @@
}
RETURN ( self );
}
- ErrorNumber = _MKSMALLINT(errno);
+ ExternalStream_LastErrorNumber = _MKSMALLINT(errno);
RETURN ( nil );
}
}
@@ -1585,7 +1601,6 @@
FILE *f;
unsigned char *cp;
int len, cnt, index1, index2;
- extern OBJ ErrorNumber;
extern errno;
int savInt;
extern int _immediateInterrupt;
@@ -1649,7 +1664,7 @@
}
RETURN ( self );
}
- ErrorNumber = _MKSMALLINT(errno);
+ ExternalStream_LastErrorNumber = _MKSMALLINT(errno);
RETURN ( nil );
}
}
@@ -1665,7 +1680,6 @@
%{ /* NOCONTEXT */
FILE *f;
- extern OBJ ErrorNumber;
extern errno;
extern int _immediateInterrupt;
int cnt, savInt;
@@ -1698,7 +1712,7 @@
}
RETURN ( self );
}
- ErrorNumber = _MKSMALLINT(errno);
+ ExternalStream_LastErrorNumber = _MKSMALLINT(errno);
return ( nil );
}
}
@@ -1821,7 +1835,6 @@
int len, cnt;
OBJ pos;
char *s;
- extern OBJ ErrorNumber;
extern errno;
int savInt;
extern int _immediateInterrupt;
@@ -1869,7 +1882,7 @@
}
}
_immediateInterrupt = savInt;
- ErrorNumber = _MKSMALLINT(errno);
+ ExternalStream_LastErrorNumber = _MKSMALLINT(errno);
RETURN ( nil );
}
}
--- a/ExternalStream.st Thu Jun 02 13:20:08 1994 +0200
+++ b/ExternalStream.st Thu Jun 02 13:21:56 1994 +0200
@@ -12,7 +12,7 @@
ReadWriteStream subclass:#ExternalStream
instanceVariableNames:'filePointer mode buffered binary useCRLF hitEOF'
- classVariableNames:'Lobby'
+ classVariableNames:'Lobby LastErrorNumber'
poolDictionaries:''
category:'Streams-External'
!
@@ -22,7 +22,7 @@
COPYRIGHT (c) 1988 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/ExternalStream.st,v 1.16 1994-05-17 10:07:23 claus Exp $
+$Header: /cvs/stx/stx/libbasic/ExternalStream.st,v 1.17 1994-06-02 11:20:13 claus Exp $
written 88 by claus
'!
@@ -71,6 +71,27 @@
reOpen in subclasses for more information.
For streams sitting on some communication channel (i.e. Pipes and Sockets) you should
reestablish the stream upon image restart (make someone dependent on ObjectMemory).
+
+ Instance variables:
+
+ filePointer <Integer> the unix FILE*; somehow mapped to an integer
+ (notice: not the fd)
+ mode <Symbol> #readwrite, #readonly or #writeonly
+ buffered <Boolean> true, if buffered (i.e. collects characters - does
+ not output immediately)
+ binary <Boolean> true if in binary mode (reads bytes instead of chars)
+ useCRLF <Boolean> true, if lines should be terminated with crlf instead
+ of lf. (i.e. if file is an MSDOS-type file)
+ hitEOF <Boolean> true, if EOF was reached
+
+
+ Class variables:
+ Lobby <Registry> keeps track of used ext-streams (to free up FILE*'s)
+
+ LastErrorNumber <Integer> the value of errno (only valid right after the error -
+ updated with next i/o operation)
+
+ Question: should lastErrorNumber be kept instance-specific ?
"
! !
@@ -153,6 +174,12 @@
!ExternalStream methodsFor:'error handling'!
+lastErrorNumber
+ "return the last error"
+
+ ^ LastErrorNumber
+!
+
errorNotOpen
"report an error, that the stream has not been opened"
@@ -415,7 +442,6 @@
int ret, ioNum, ioArg;
int savInt;
extern int _immediateInterrupt;
- extern OBJ ErrorNumber;
extern errno;
if (_INST(filePointer) != nil) {
@@ -431,7 +457,7 @@
if (ret >= 0) {
RETURN ( _MKSMALLINT(ret) );
}
- ErrorNumber = _MKSMALLINT(errno);
+ ExternalStream_LastErrorNumber = _MKSMALLINT(errno);
RETURN ( nil );
}
}
@@ -456,7 +482,6 @@
FILE *f;
int ret, ioNum, savInt;
extern int _immediateInterrupt;
- extern OBJ ErrorNumber;
extern errno;
if (_INST(filePointer) != nil) {
@@ -477,7 +502,7 @@
if (ret >= 0) {
RETURN ( _MKSMALLINT(ret) );
}
- ErrorNumber = _MKSMALLINT(errno);
+ ExternalStream_LastErrorNumber = _MKSMALLINT(errno);
RETURN ( nil );
}
}
@@ -499,7 +524,6 @@
FILE *f;
unsigned char byte;
int cnt, savInt;
- extern OBJ ErrorNumber;
extern errno;
extern int _immediateInterrupt;
@@ -523,7 +547,7 @@
RETURN ( _MKSMALLINT(byte) );
}
if (cnt < 0) {
- ErrorNumber = _MKSMALLINT(errno);
+ ExternalStream_LastErrorNumber = _MKSMALLINT(errno);
}
_INST(hitEOF) = true;
RETURN ( nil );
@@ -566,7 +590,6 @@
int cnt, offs;
int objSize, nInstVars, nInstBytes, savInt;
char *cp;
- extern OBJ ErrorNumber;
extern errno;
OBJ pos;
extern int _immediateInterrupt;
@@ -613,7 +636,7 @@
_INST(hitEOF) = true;
RETURN ( _MKSMALLINT(cnt) );
}
- ErrorNumber = _MKSMALLINT(errno);
+ ExternalStream_LastErrorNumber = _MKSMALLINT(errno);
RETURN ( nil );
}
}
@@ -636,7 +659,6 @@
%{ /* NOCONTEXT */
extern int _immediateInterrupt;
- extern OBJ ErrorNumber;
int savInt;
if (_INST(binary) == true) {
@@ -663,7 +685,7 @@
if (cnt == 0)
_INST(hitEOF) = true;
else
- ErrorNumber = _MKSMALLINT(errno);
+ ExternalStream_LastErrorNumber = _MKSMALLINT(errno);
RETURN ( nil );
}
do {
@@ -684,7 +706,7 @@
if (cnt == 0)
_INST(hitEOF) = true;
else
- ErrorNumber = _MKSMALLINT(errno);
+ ExternalStream_LastErrorNumber = _MKSMALLINT(errno);
RETURN ( _MKSMALLINT(hi & 0xFF) );
}
if (_INST(position) != nil) {
@@ -1009,7 +1031,6 @@
FILE *f;
char c;
- extern OBJ ErrorNumber;
extern errno;
OBJ pos;
int cnt, savInt;
@@ -1043,7 +1064,7 @@
_INST(position) = _MKSMALLINT(_intVal(pos) + 1);
RETURN ( self );
}
- ErrorNumber = _MKSMALLINT(errno);
+ ExternalStream_LastErrorNumber = _MKSMALLINT(errno);
RETURN (nil);
}
}
@@ -1088,7 +1109,6 @@
int cnt, offs;
int objSize, nInstVars, nInstBytes;
char *cp;
- extern OBJ ErrorNumber;
extern errno;
OBJ oClass;
OBJ pos;
@@ -1141,7 +1161,7 @@
_INST(position) = _MKSMALLINT(_intVal(pos) + cnt);
RETURN ( _MKSMALLINT(cnt) );
}
- ErrorNumber = _MKSMALLINT(errno);
+ ExternalStream_LastErrorNumber = _MKSMALLINT(errno);
RETURN ( nil );
}
}
@@ -1165,7 +1185,6 @@
int num;
char bytes[2];
FILE *f;
- extern OBJ ErrorNumber;
extern errno;
int savInt;
extern int _immediateInterrupt;
@@ -1207,7 +1226,7 @@
}
RETURN ( self );
}
- ErrorNumber = _MKSMALLINT(errno);
+ ExternalStream_LastErrorNumber = _MKSMALLINT(errno);
return ( nil );
}
}
@@ -1229,7 +1248,6 @@
int num;
char bytes[4];
FILE *f;
- extern OBJ ErrorNumber;
extern errno;
int cnt, savInt;
extern int _immediateInterrupt;
@@ -1272,7 +1290,7 @@
}
RETURN ( self );
}
- ErrorNumber = _MKSMALLINT(errno);
+ ExternalStream_LastErrorNumber = _MKSMALLINT(errno);
return ( nil );
}
}
@@ -1440,7 +1458,6 @@
FILE *f;
char c;
- extern OBJ ErrorNumber;
extern errno;
int cnt;
OBJ pos;
@@ -1480,7 +1497,7 @@
}
RETURN ( self );
}
- ErrorNumber = _MKSMALLINT(errno);
+ ExternalStream_LastErrorNumber = _MKSMALLINT(errno);
RETURN ( nil );
}
} else {
@@ -1509,7 +1526,6 @@
FILE *f;
unsigned char *cp;
int len, cnt;
- extern OBJ ErrorNumber;
extern errno;
OBJ pos;
int savInt;
@@ -1566,7 +1582,7 @@
}
RETURN ( self );
}
- ErrorNumber = _MKSMALLINT(errno);
+ ExternalStream_LastErrorNumber = _MKSMALLINT(errno);
RETURN ( nil );
}
}
@@ -1585,7 +1601,6 @@
FILE *f;
unsigned char *cp;
int len, cnt, index1, index2;
- extern OBJ ErrorNumber;
extern errno;
int savInt;
extern int _immediateInterrupt;
@@ -1649,7 +1664,7 @@
}
RETURN ( self );
}
- ErrorNumber = _MKSMALLINT(errno);
+ ExternalStream_LastErrorNumber = _MKSMALLINT(errno);
RETURN ( nil );
}
}
@@ -1665,7 +1680,6 @@
%{ /* NOCONTEXT */
FILE *f;
- extern OBJ ErrorNumber;
extern errno;
extern int _immediateInterrupt;
int cnt, savInt;
@@ -1698,7 +1712,7 @@
}
RETURN ( self );
}
- ErrorNumber = _MKSMALLINT(errno);
+ ExternalStream_LastErrorNumber = _MKSMALLINT(errno);
return ( nil );
}
}
@@ -1821,7 +1835,6 @@
int len, cnt;
OBJ pos;
char *s;
- extern OBJ ErrorNumber;
extern errno;
int savInt;
extern int _immediateInterrupt;
@@ -1869,7 +1882,7 @@
}
}
_immediateInterrupt = savInt;
- ErrorNumber = _MKSMALLINT(errno);
+ ExternalStream_LastErrorNumber = _MKSMALLINT(errno);
RETURN ( nil );
}
}
--- a/FileStr.st Thu Jun 02 13:20:08 1994 +0200
+++ b/FileStr.st Thu Jun 02 13:21:56 1994 +0200
@@ -24,7 +24,7 @@
This class provides access to the operating systems underlying file
system (i.e. its an interface to the stdio library).
-$Header: /cvs/stx/stx/libbasic/Attic/FileStr.st,v 1.11 1994-05-17 10:07:32 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Attic/FileStr.st,v 1.12 1994-06-02 11:20:21 claus Exp $
'!
%{
@@ -293,7 +293,7 @@
%{
FILE *f;
OBJ path;
- extern OBJ ErrorNumber, Filename;
+ extern OBJ Filename;
extern errno;
if (_INST(filePointer) == nil) {
@@ -313,7 +313,7 @@
#endif
} while ((f == NULL) && (errno == EINTR));
if (f == NULL) {
- ErrorNumber = _MKSMALLINT(errno);
+ ExternalStream_LastErrorNumber = _MKSMALLINT(errno);
_INST(position) = nil;
} else {
_INST(filePointer) = MKOBJ((int)f);
@@ -424,7 +424,6 @@
struct stat buf;
int ret;
extern errno;
- extern OBJ ErrorNumber;
int fd;
if (_INST(filePointer) != nil) {
@@ -436,7 +435,7 @@
if (ret >= 0) {
RETURN ( _MKSMALLINT(buf.st_size) );
}
- ErrorNumber = _MKSMALLINT(errno);
+ ExternalStream_LastErrorNumber = _MKSMALLINT(errno);
}
#endif
%}
@@ -462,7 +461,6 @@
FILE *f;
long currentPosition;
extern errno;
- extern OBJ ErrorNumber;
if (_INST(filePointer) != nil) {
f = (FILE *)MKFD(_INST(filePointer));
@@ -479,7 +477,7 @@
*/
RETURN ( _MKSMALLINT(currentPosition + 1) );
}
- ErrorNumber = _MKSMALLINT(errno);
+ ExternalStream_LastErrorNumber = _MKSMALLINT(errno);
}
%}
.
@@ -494,7 +492,6 @@
FILE *f;
int ret;
- extern OBJ ErrorNumber;
extern errno;
if (_INST(filePointer) != nil) {
@@ -518,7 +515,7 @@
_INST(hitEOF) = false;
RETURN ( self );
}
- ErrorNumber = _MKSMALLINT(errno);
+ ExternalStream_LastErrorNumber = _MKSMALLINT(errno);
}
}
%}
@@ -533,7 +530,6 @@
%{
FILE *f;
int ret;
- extern OBJ ErrorNumber;
extern errno;
if (_INST(filePointer) != nil) {
@@ -549,7 +545,7 @@
if (ret >= 0) {
RETURN ( self );
}
- ErrorNumber = _MKSMALLINT(errno);
+ ExternalStream_LastErrorNumber = _MKSMALLINT(errno);
}
%}
.
--- a/FileStream.st Thu Jun 02 13:20:08 1994 +0200
+++ b/FileStream.st Thu Jun 02 13:21:56 1994 +0200
@@ -24,7 +24,7 @@
This class provides access to the operating systems underlying file
system (i.e. its an interface to the stdio library).
-$Header: /cvs/stx/stx/libbasic/FileStream.st,v 1.11 1994-05-17 10:07:32 claus Exp $
+$Header: /cvs/stx/stx/libbasic/FileStream.st,v 1.12 1994-06-02 11:20:21 claus Exp $
'!
%{
@@ -293,7 +293,7 @@
%{
FILE *f;
OBJ path;
- extern OBJ ErrorNumber, Filename;
+ extern OBJ Filename;
extern errno;
if (_INST(filePointer) == nil) {
@@ -313,7 +313,7 @@
#endif
} while ((f == NULL) && (errno == EINTR));
if (f == NULL) {
- ErrorNumber = _MKSMALLINT(errno);
+ ExternalStream_LastErrorNumber = _MKSMALLINT(errno);
_INST(position) = nil;
} else {
_INST(filePointer) = MKOBJ((int)f);
@@ -424,7 +424,6 @@
struct stat buf;
int ret;
extern errno;
- extern OBJ ErrorNumber;
int fd;
if (_INST(filePointer) != nil) {
@@ -436,7 +435,7 @@
if (ret >= 0) {
RETURN ( _MKSMALLINT(buf.st_size) );
}
- ErrorNumber = _MKSMALLINT(errno);
+ ExternalStream_LastErrorNumber = _MKSMALLINT(errno);
}
#endif
%}
@@ -462,7 +461,6 @@
FILE *f;
long currentPosition;
extern errno;
- extern OBJ ErrorNumber;
if (_INST(filePointer) != nil) {
f = (FILE *)MKFD(_INST(filePointer));
@@ -479,7 +477,7 @@
*/
RETURN ( _MKSMALLINT(currentPosition + 1) );
}
- ErrorNumber = _MKSMALLINT(errno);
+ ExternalStream_LastErrorNumber = _MKSMALLINT(errno);
}
%}
.
@@ -494,7 +492,6 @@
FILE *f;
int ret;
- extern OBJ ErrorNumber;
extern errno;
if (_INST(filePointer) != nil) {
@@ -518,7 +515,7 @@
_INST(hitEOF) = false;
RETURN ( self );
}
- ErrorNumber = _MKSMALLINT(errno);
+ ExternalStream_LastErrorNumber = _MKSMALLINT(errno);
}
}
%}
@@ -533,7 +530,6 @@
%{
FILE *f;
int ret;
- extern OBJ ErrorNumber;
extern errno;
if (_INST(filePointer) != nil) {
@@ -549,7 +545,7 @@
if (ret >= 0) {
RETURN ( self );
}
- ErrorNumber = _MKSMALLINT(errno);
+ ExternalStream_LastErrorNumber = _MKSMALLINT(errno);
}
%}
.
--- a/Filename.st Thu Jun 02 13:20:08 1994 +0200
+++ b/Filename.st Thu Jun 02 13:21:56 1994 +0200
@@ -24,7 +24,7 @@
Filenames; originally added for ST-80 compatibility, is
taking over functionality from other classes (FileDirectory).
-$Header: /cvs/stx/stx/libbasic/Filename.st,v 1.8 1994-05-17 10:07:34 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Filename.st,v 1.9 1994-06-02 11:20:23 claus Exp $
'!
!Filename class methodsFor:'instance creation'!
@@ -62,9 +62,17 @@
filename for an entry within this directory (i.e. for a file
or a subdirectory in that directory)."
+ nameString = self class separator asString ifTrue:[
+ "I am the root"
+ ^ (self class basicNew) setName:(nameString , subname)
+ ].
^ (self class basicNew) setName:(nameString , self class separator asString , subname)
- "('/tmp' asFilename construct:'foo') asString"
+ "
+ ('/tmp' asFilename construct:'foo') asString
+ ('/' asFilename construct:'foo') asString
+ ('/usr/tmp' asFilename construct:'foo') asString
+ "
! !
!Filename methodsFor:'converting'!
@@ -107,18 +115,34 @@
^ OperatingSystem baseNameOf:nameString
- "/foo/bar' asFilename baseName"
+ "
+ /foo/bar' asFilename baseName
+ "
!
isAbsolute
"return true, if the receiver represents an absolute pathname
(in contrast to one relative to the current directory)"
- ^ (nameString startsWith:self separator)
+ ^ (nameString startsWith:self class separator)
+
+ "
+ /foo/bar' asFilename isAbsolute
+ '..' asFilename isAbsolute
+ 'source/SBrowser.st' asFilename isAbsolute
+ "
+!
- "/foo/bar' asFilename isAbsolute"
- "'..' asFilename isAbsolute"
- "'source/SBrowser.st' asFilename isAbsolute"
+isDirectory
+ "return true, if the receiver represents an existing,
+ readable directories pathname."
+
+ ^ OperatingSystem isDirectory:nameString
+
+ "
+ '/foo/bar' asFilename isDirectory
+ '/tmp' asFilename isDirectory
+ "
!
exists
@@ -126,8 +150,10 @@
^ OperatingSystem isValidPath:nameString
- "'/foo/bar' asFilename exists"
- "'/tmp' asFilename exists"
+ "
+ '/foo/bar' asFilename exists
+ '/tmp' asFilename exists
+ "
!
isReadable
@@ -135,8 +161,10 @@
^ OperatingSystem isReadable:nameString
- "'/foo/bar' asFilename isReadable"
- "'/tmp' asFilename isReadable"
+ "
+ '/foo/bar' asFilename isReadable
+ '/tmp' asFilename isReadable
+ "
!
isWritable
@@ -144,8 +172,10 @@
^ OperatingSystem isWritable:nameString
- "'/foo/bar' asFilename isWritable"
- "'/tmp' asFilename isWritable"
+ "
+ '/foo/bar' asFilename isWritable
+ '/tmp' asFilename isWritable
+ "
! !
!Filename methodsFor:'file access'!
--- a/Float.st Thu Jun 02 13:20:08 1994 +0200
+++ b/Float.st Thu Jun 02 13:21:56 1994 +0200
@@ -12,7 +12,7 @@
LimitedPrecisionReal variableByteSubclass:#Float
instanceVariableNames:''
- classVariableNames:''
+ classVariableNames:'LastErrorNumber'
poolDictionaries:''
category:'Magnitude-Numbers'
!
@@ -22,7 +22,7 @@
COPYRIGHT (c) 1988 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/Float.st,v 1.13 1994-05-17 10:07:36 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Float.st,v 1.14 1994-06-02 11:20:25 claus Exp $
'!
@@ -50,6 +50,10 @@
instances will not be recognized as float-like objects, thus mixed mode arithmetic
will always coerce them, effectively slowing things down.
This may be changed, to use a flag bit in the class.
+
+ Class Variables:
+
+ LastErrorNumber <Integer> value of errno (after a trig- or other math err)
"
! !
@@ -95,6 +99,17 @@
"this class is known by the run-time-system"
^ self == Float
+!
+
+lastErrorNumber
+ "return the value of errno after an error"
+
+ ^ LastErrorNumber
+
+ "
+ 2 arcSin.
+ OperatingSystem errorTextForNumber:(Float lastErrorNumber)
+ "
! !
!Float methodsFor:'arithmetic'!
@@ -472,13 +487,12 @@
double log();
double result;
extern errno;
- extern OBJ ErrorNumber;
errno = 0;
result = log(_floatVal(self));
if (errno == 0)
RETURN ( _MKFLOAT(result COMMA_SND) );
- ErrorNumber = _MKSMALLINT(errno);
+ Float_LastErrorNumber = _MKSMALLINT(errno);
%}
.
DomainErrorSignal raise
@@ -493,7 +507,6 @@
double pow();
double result;
extern errno;
- extern OBJ ErrorNumber;
if (__isFloat(n)) {
errno = 0;
@@ -501,7 +514,7 @@
errno = 0; /* XXXX */
if (errno == 0)
RETURN ( _MKFLOAT(result COMMA_CON) );
- ErrorNumber = _MKSMALLINT(errno);
+ Float_LastErrorNumber = _MKSMALLINT(errno);
}
%}
.
@@ -516,13 +529,12 @@
double exp();
double result;
extern errno;
- extern OBJ ErrorNumber;
errno = 0;
result = exp(_floatVal(self));
if (errno == 0)
RETURN ( _MKFLOAT(result COMMA_SND) );
- ErrorNumber = _MKSMALLINT(errno);
+ Float_LastErrorNumber = _MKSMALLINT(errno);
%}
.
DomainErrorSignal raise
@@ -536,13 +548,12 @@
double sin();
double result;
extern errno;
- extern OBJ ErrorNumber;
errno = 0;
result = sin(_floatVal(self));
if (errno == 0)
RETURN ( _MKFLOAT(result COMMA_SND) );
- ErrorNumber = _MKSMALLINT(errno);
+ Float_LastErrorNumber = _MKSMALLINT(errno);
%}
.
DomainErrorSignal raise
@@ -556,13 +567,12 @@
double cos();
double result;
extern errno;
- extern OBJ ErrorNumber;
errno = 0;
result = cos(_floatVal(self));
if (errno == 0)
RETURN ( _MKFLOAT(result COMMA_SND) );
- ErrorNumber = _MKSMALLINT(errno);
+ Float_LastErrorNumber = _MKSMALLINT(errno);
%}
.
DomainErrorSignal raise
@@ -576,13 +586,12 @@
double tan();
double result;
extern errno;
- extern OBJ ErrorNumber;
errno = 0;
result = tan(_floatVal(self));
if (errno == 0)
RETURN ( _MKFLOAT(result COMMA_SND) );
- ErrorNumber = _MKSMALLINT(errno);
+ Float_LastErrorNumber = _MKSMALLINT(errno);
%}
.
DomainErrorSignal raise
@@ -596,13 +605,12 @@
double asin();
double result;
extern errno;
- extern OBJ ErrorNumber;
errno = 0;
result = asin(_floatVal(self));
if (errno == 0)
RETURN ( _MKFLOAT(result COMMA_SND) );
- ErrorNumber = _MKSMALLINT(errno);
+ Float_LastErrorNumber = _MKSMALLINT(errno);
%}
.
DomainErrorSignal raise
@@ -616,13 +624,12 @@
double acos();
double result;
extern errno;
- extern OBJ ErrorNumber;
errno = 0;
result = acos(_floatVal(self));
if (errno == 0)
RETURN ( _MKFLOAT(result COMMA_SND) );
- ErrorNumber = _MKSMALLINT(errno);
+ Float_LastErrorNumber = _MKSMALLINT(errno);
%}
.
DomainErrorSignal raise
@@ -636,13 +643,12 @@
double atan();
double result;
extern errno;
- extern OBJ ErrorNumber;
errno = 0;
result = atan(_floatVal(self));
if (errno == 0)
RETURN ( _MKFLOAT(result COMMA_SND) );
- ErrorNumber = _MKSMALLINT(errno);
+ Float_LastErrorNumber = _MKSMALLINT(errno);
%}
.
DomainErrorSignal raise
@@ -656,13 +662,12 @@
double sqrt();
double result;
extern errno;
- extern OBJ ErrorNumber;
errno = 0;
result = sqrt(_floatVal(self));
if (errno == 0)
RETURN ( _MKFLOAT(result COMMA_SND) );
- ErrorNumber = _MKSMALLINT(errno);
+ Float_LastErrorNumber = _MKSMALLINT(errno);
%}
.
DomainErrorSignal raise
--- a/IdSet.st Thu Jun 02 13:20:08 1994 +0200
+++ b/IdSet.st Thu Jun 02 13:21:56 1994 +0200
@@ -27,7 +27,7 @@
Since compare is on identity, hashing is also done via
identityHash instead of hash.
-$Header: /cvs/stx/stx/libbasic/Attic/IdSet.st,v 1.6 1994-01-09 21:17:25 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Attic/IdSet.st,v 1.7 1994-06-02 11:20:33 claus Exp $
written jan 93 by claus
'!
@@ -82,11 +82,12 @@
index := startIndex.
[true] whileTrue:[
probe := keyArray basicAt:index.
+ (probe isNil or: [key == probe]) ifTrue:[^ index].
probe == DeletedEntry ifTrue:[
keyArray basicAt:index put:nil.
^ index
].
- (probe isNil or: [key == probe]) ifTrue:[^ index].
+"/ (probe isNil or: [key == probe]) ifTrue:[^ index].
index == length ifTrue:[
index := 1
--- a/IdentitySet.st Thu Jun 02 13:20:08 1994 +0200
+++ b/IdentitySet.st Thu Jun 02 13:21:56 1994 +0200
@@ -27,7 +27,7 @@
Since compare is on identity, hashing is also done via
identityHash instead of hash.
-$Header: /cvs/stx/stx/libbasic/IdentitySet.st,v 1.6 1994-01-09 21:17:25 claus Exp $
+$Header: /cvs/stx/stx/libbasic/IdentitySet.st,v 1.7 1994-06-02 11:20:33 claus Exp $
written jan 93 by claus
'!
@@ -82,11 +82,12 @@
index := startIndex.
[true] whileTrue:[
probe := keyArray basicAt:index.
+ (probe isNil or: [key == probe]) ifTrue:[^ index].
probe == DeletedEntry ifTrue:[
keyArray basicAt:index put:nil.
^ index
].
- (probe isNil or: [key == probe]) ifTrue:[^ index].
+"/ (probe isNil or: [key == probe]) ifTrue:[^ index].
index == length ifTrue:[
index := 1
--- a/Integer.st Thu Jun 02 13:20:08 1994 +0200
+++ b/Integer.st Thu Jun 02 13:21:56 1994 +0200
@@ -24,7 +24,7 @@
abstract superclass for all integer numbers
-$Header: /cvs/stx/stx/libbasic/Integer.st,v 1.11 1994-05-17 10:07:48 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Integer.st,v 1.12 1994-06-02 11:20:36 claus Exp $
written 88 by claus
'!
@@ -143,6 +143,59 @@
result digitAt:index put:((anInteger digitAt:index) bitXor:(self digitAt:index)).
].
^ result normalize
+!
+
+bitAt:index
+ "return the value of the index's bit (index starts at 1)"
+
+ |i "{Class: SmallInteger}"|
+
+ i := index - 1.
+ ^ (self digitAt:(i // 8 + 1)) bitAt:(i \\ 8 + 1)
+!
+
+bitShift:shiftCount
+ "return the value of the receiver shifted by shiftCount bits;
+ leftShift if shiftCount > 0; rightShift otherwise.
+ The result is undefined for negative numbers."
+
+ |result n digitShift bitShift byte|
+
+ shiftCount > 0 ifTrue:[
+ "left shift"
+ n := self digitLength + (shiftCount // 8) + 1.
+ result := LargeInteger basicNew numberOfDigits:n.
+ result sign:self sign.
+
+ digitShift := shiftCount // 8.
+ bitShift := shiftCount \\ 8.
+ byte := ((self digitAt:1) bitShift:bitShift) bitAnd:16rFF.
+ result digitAt:(digitShift + 1) put:byte.
+ 2 to:(self digitLength) do:[:index |
+ byte := (self digitAt:index) bitShift:bitShift.
+ byte := byte bitOr:((self digitAt:index-1) bitShift:(-8+bitShift)).
+ result digitAt:(index + digitShift) put:(byte bitAnd:16rFF)
+ ]
+ ] ifFalse:[
+ "right shift"
+
+ n := self digitLength - (shiftCount // 8) + 1.
+ n <= 0 ifTrue:[^ 0].
+
+ result := LargeInteger basicNew numberOfDigits:n.
+ result sign:self sign.
+
+ digitShift := shiftCount // 8.
+ bitShift := shiftCount \\ 8.
+ byte := ((self digitAt:digitShift + 1) bitShift:bitShift) bitAnd:16rFF.
+ result digitAt:(digitShift + 1) put:byte.
+ 2 to:(self digitLength) do:[:index |
+ byte := (self digitAt:index) bitShift:bitShift.
+ byte := byte bitOr:((self digitAt:index-1) bitShift:(-8+bitShift)).
+ result digitAt:(index + digitShift) put:(byte bitAnd:16rFF)
+ ]
+ ].
+ ^ result normalize
! !
!Integer methodsFor:'truncation & rounding'!
@@ -260,7 +313,9 @@
].
^ 1
- "Time millisecondsToRun:[30 fib]"
+ "
+ Transcript showCr:(Time millisecondsToRun:[30 fib])
+ "
!
fastFib
@@ -284,7 +339,10 @@
FibCache at:self put:fib.
^ fib
- "Time millisecondsToRun:[30 fastFib]"
+ "
+ Transcript showCr:[Time millisecondsToRun:[30 fastFib]]
+ Transcript showCr:[Time millisecondsToRun:[60 fastFib]]
+ "
!
acker:n
@@ -580,6 +638,22 @@
"1 recur2"
!
+blockEvaluation
+ "evaluating a simple block"
+
+ |t|
+
+ t := Time millisecondsToRun:[
+ |b|
+
+ b := [99].
+ 1000000 timesRepeat:[b value]
+ ].
+ Transcript showCr:(t printString)
+
+ "1 blockEvaluation"
+!
+
countDown
"count down - notice, that index is a method var"
@@ -633,8 +707,23 @@
"1000000 send"
!
+send2
+ "lots of dummy message sends"
+
+ |t|
+
+ t := Time millisecondsToRun:[
+ 1000000 timesRepeat:[
+ self noop
+ ].
+ ].
+ Transcript showCr:(t printString)
+
+ "1 send2"
+!
+
instAccess1
- "check instvar access time"
+ "check simple send & instvar access time"
|t|
@@ -650,7 +739,7 @@
!
instAccess2
- "check instvar access time"
+ "check simple send & instvar access time"
|t|
@@ -666,7 +755,10 @@
!
memory
- "lots of memory allocation"
+ "lots of memory allocation
+ (GC benchmark; allocates, nils & collects about 400Mb).
+ Run this benchmark a few times - its outcome depends on
+ newSpace fill-grade & cache patterns ..."
|t|
@@ -680,8 +772,30 @@
"100000 memory"
!
+memory2
+ "lots of memory allocation
+ (GC benchmark; allocates, nils & collects about 400Mb).
+ Run this benchmark a few times - its outcome depends on
+ newSpace fill-grade & cache patterns ..."
+
+ |t|
+
+ t := Time millisecondsToRun:[
+ 100000 timesRepeat:[
+ Array new:500
+ ].
+ ].
+ Transcript showCr:(t printString)
+
+ "1 memory2"
+!
+
benchArithmetic
- "arithmetic speed bench (actually, this is a GC benchmark)"
+ "arithmetic speed bench
+ (actually, this is a GC, and block evaluation benchmark.
+ it allocates & collects about 40Mb during its run).
+ Run this benchmark a few times - its outcome depends on
+ newSpace fill-grade & cache patterns ..."
|p n m t|
@@ -699,9 +813,13 @@
!
benchArithmetic2
- "arithmetic speed bench (actually, this is a GC benchmark)"
+ "arithmetic speed bench (comp.lang.smalltalk)
+ (actually, this is a GC benchmark,
+ it allocates & collects about 20Mb during its run).
+ Run this benchmark a few times - its outcome depends on
+ newSpace fill-grade & cache patterns ..."
- |t x|
+ |t|
t := Time millisecondsToRun:[
|x|
@@ -714,9 +832,14 @@
!
benchArithmetic3
- "arithmetic speed bench (actually, this is a GC benchmark)"
+ "arithmetic speed bench
+ (actually, this is a GC, and block evaluation benchmark.
+ it allocates & collects about 20Mb during its run;
+ compare the time to benchBasicNew-time).
+ Run this benchmark a few times - its outcome depends on
+ newSpace fill-grade & cache patterns ..."
- |t x|
+ |t|
t := Time millisecondsToRun:[
|x|
@@ -728,8 +851,24 @@
"1000000 benchArithmetic3"
!
+benchArithmetic4
+ |t|
+
+ t := Time millisecondsToRun:[
+ |x "{ Class: Float }" |
+ x := 0.0.
+ self timesRepeat:[x := x + 1.0]
+ ].
+ Transcript showCr:(t printString)
+
+ "1000000 benchArithmetic3"
+!
+
benchNew
- "instance creation speed bench"
+ "instance creation speed bench
+ (GC benchmark; allocating & collecting about 12Mb).
+ Run this benchmark a few times - its outcome depends on
+ newSpace fill-grade & cache patterns ..."
|t|
@@ -744,7 +883,10 @@
!
benchBasicNew
- "instance creation speed bench"
+ "instance creation speed bench
+ (GC benchmark; allocating & collecting about 12Mb).
+ Run this benchmark a few times - its outcome depends on
+ newSpace fill-grade & cache patterns ..."
|t|
@@ -759,7 +901,11 @@
!
benchArrayBasicNew
- "instance creation speed bench"
+ "instance creation speed bench
+ (GC benchmark; allocating & collecting about 12Mb).
+ Run this benchmark a few times - its outcome depends on
+ newSpace fill-grade & cache patterns ..."
+
|t|
@@ -774,7 +920,10 @@
!
benchArrayNew
- "instance creation speed bench"
+ "instance creation speed bench
+ (GC benchmark; allocating & collecting about 12Mb).
+ Run this benchmark a few times - its outcome depends on
+ newSpace fill-grade & cache patterns ..."
|t|
@@ -788,12 +937,64 @@
"1000000 benchArrayNew"
!
+benchSetCreation
+ "benchmark set grow (from comp.lang.smalltalk)"
+
+ |s t|
+
+ s := Set new.
+ t := Time millisecondsToRun:[
+ 1 to:4500 do:[:i | s add:i]
+ ].
+
+ Transcript showCr:(t printString)
+
+ "1 benchSetCreation"
+!
+
+benchSetCreation2
+ "benchmark set grow (from comp.lang.smalltalk).
+ also shows the effect of using block-local variables."
+
+ |t|
+
+ t := Time millisecondsToRun:[
+ |s|
+ s := Set new.
+ 1 to:4500 do:[:i | s add:i]
+ ].
+
+ Transcript showCr:(t printString)
+
+ "1 benchSetCreation2"
+!
+
+benchSetCreation3
+ "benchmark set grow (from comp.lang.smalltalk).
+ also shows the effect of using block-local variables
+ and preallocating the set."
+
+ |t|
+
+ t := Time millisecondsToRun:[
+ |s|
+ s := Set new:4500.
+ 1 to:4500 do:[:i | s add:i]
+ ].
+
+ Transcript showCr:(t printString)
+
+ "1 benchSetCreation3"
+!
+
loopTimes
- Transcript showCr:(Time millisecondsToRun:[1 fastSumTo]).
- Transcript showCr:(Time millisecondsToRun:[1 nestedLoop]).
- Transcript showCr:(Time millisecondsToRun:[1 atAllPut]).
- Transcript showCr:(Time millisecondsToRun:[1 sumAll]).
- Transcript showCr:(Time millisecondsToRun:[1 sumTo]).
+ "runs the self low-level loop benchmarks"
+
+ Transcript show:'fastSumTo: '; showCr:(Time millisecondsToRun:[1 fastSumTo]).
+ Transcript show:'nextedLoop: '; showCr:(Time millisecondsToRun:[1 nestedLoop]).
+ Transcript show:'atAllput: '; showCr:(Time millisecondsToRun:[1 atAllPut]).
+ Transcript show:'sumAll: '; showCr:(Time millisecondsToRun:[1 sumAll]).
+ Transcript show:'sumTo: '; showCr:(Time millisecondsToRun:[1 sumTo]).
"1 loopTimes"
!
--- a/LPReal.st Thu Jun 02 13:20:08 1994 +0200
+++ b/LPReal.st Thu Jun 02 13:21:56 1994 +0200
@@ -22,7 +22,7 @@
COPYRIGHT (c) 1994 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/Attic/LPReal.st,v 1.1 1994-02-25 12:59:09 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Attic/LPReal.st,v 1.2 1994-06-02 11:20:40 claus Exp $
Abstract superclass for single and double (and maybe more) precision real numbers (i.e. Float and Double).
'!
@@ -228,12 +228,12 @@
sign := self sign.
v := self abs.
- (v >= 10) ifTrue:[
+ (v >= 10.0) ifTrue:[
l := (v / 10.0) asInteger * 10
] ifFalse:[
l := 0
].
- v := v - ((v / 10.0) floor * 10.0) floor.
+ v := v - ((v / 10.0) floor * 10) floor.
l := l + v truncated.
^ l * sign
--- a/LargeInt.st Thu Jun 02 13:20:08 1994 +0200
+++ b/LargeInt.st Thu Jun 02 13:21:56 1994 +0200
@@ -22,7 +22,7 @@
COPYRIGHT (c) 1994 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/Attic/LargeInt.st,v 1.9 1994-05-17 10:07:56 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Attic/LargeInt.st,v 1.10 1994-06-02 11:20:42 claus Exp $
'!
!LargeInteger class methodsFor:'documentation'!
@@ -119,7 +119,7 @@
otherSign := aNumber sign.
(aNumber class == SmallInteger) ifTrue:[
- (aNumber between:1 and:255) ifTrue:[
+ (aNumber abs between:1 and:16r3fffff) ifTrue:[
sign < 0 ifTrue:[
(sign == otherSign) ifTrue:[^ (self negated absFastDiv:aNumber negated) at:1].
^ ((self negated absFastDiv:aNumber) at:1) negated
@@ -194,14 +194,14 @@
otherSign := aNumber sign.
(aNumber class == SmallInteger) ifTrue:[
- (aNumber between:1 and:255) ifTrue:[
+ (aNumber abs between:1 and:16r003fffff) ifTrue:[
sign < 0 ifTrue:[
(sign == otherSign) ifTrue:[^ (self negated absFastDiv:aNumber negated) at:2].
^ ((self negated absFastDiv:aNumber) at:2) negated
].
(sign == otherSign) ifTrue:[^ (self absFastDiv:aNumber) at:2].
^ ((self absFastDiv:aNumber negated) at:2) negated
- ].
+ ]
].
(aNumber class == self class) ifTrue:[
sign < 0 ifTrue:[
@@ -310,7 +310,8 @@
val "{ Class: SmallInteger }"
len "{ Class: SmallInteger }"
carry "{ Class: SmallInteger }"
- prod "{ Class: SmallInteger }" |
+ prod "{ Class: SmallInteger }"
+ ok|
"multiplying by a small integer is done here"
@@ -329,7 +330,7 @@
result := self class basicNew numberOfDigits:(len + 4).
- "used to be; which was replaced, to avoid another multiplication"
+ "used to be the following. replaced, to avoid another multiplication"
"
result sign:(sign * anInteger sign).
"
@@ -348,15 +349,42 @@
carry := 0.
val := num.
- 1 to:len do:[:i |
- prod := (digitByteArray basicAt:i) * val + carry.
- resultDigitByteArray basicAt:i put:(prod bitAnd:16rFF).
- carry := prod bitShift:-8.
- ].
- [carry ~~ 0] whileTrue:[
- len := len + 1.
- resultDigitByteArray basicAt:len put:(carry bitAnd:16rFF).
- carry := carry bitShift:-8
+ ok := false.
+%{
+ if (_isSmallInteger(len)
+ && _isSmallInteger(val)
+ && __isByteArray(_INST(digitByteArray))
+ && __isByteArray(resultDigitByteArray)) {
+ int _l = _intVal(len);
+ int _v = _intVal(val);
+ unsigned _carry = 0;
+ unsigned _prod;
+ unsigned char *digitP = _ByteArrayInstPtr(_INST(digitByteArray))->ba_element;
+ unsigned char *resultP = _ByteArrayInstPtr(resultDigitByteArray)->ba_element;
+
+ while (_l-- > 0) {
+ _prod = *digitP++ * _v + _carry;
+ *resultP++ = _prod & 0xFF;
+ _carry = _prod >> 8;
+ }
+ while (_carry) {
+ *resultP++ = _carry & 0xFF;
+ _carry >>= 8;
+ }
+ ok = true;
+ }
+%}.
+ ok ifFalse:[
+ 1 to:len do:[:i |
+ prod := (digitByteArray basicAt:i) * val + carry.
+ resultDigitByteArray basicAt:i put:(prod bitAnd:16rFF).
+ carry := prod bitShift:-8.
+ ].
+ [carry ~~ 0] whileTrue:[
+ len := len + 1.
+ resultDigitByteArray basicAt:len put:(carry bitAnd:16rFF).
+ carry := carry bitShift:-8
+ ].
].
^ result normalize
! !
@@ -514,7 +542,8 @@
|tmp1 "{ Class: SmallInteger }"
prevRest "{ Class: SmallInteger }"
count "{ Class: SmallInteger }"
- newDigitByteArray result|
+ newDigitByteArray result
+ ok|
aSmallInteger == 0 ifTrue:[
^ DivisionByZeroSignal raise
@@ -525,17 +554,47 @@
^ Array with:0 with:self
].
"
- prevRest := 0.
count := digitByteArray size.
result := self class basicNew numberOfDigits:count.
result sign:1.
newDigitByteArray := result digits.
+ ok := false.
+%{
+ if (__isByteArray(_INST(digitByteArray))
+ && __isByteArray(newDigitByteArray)
+ && _isSmallInteger(count)
+ && _isSmallInteger(aSmallInteger)) {
+ unsigned int rest = 0;
+ int index = _intVal(count);
+ int divisor = _intVal(aSmallInteger);
+ unsigned char *digitBytes = _ByteArrayInstPtr(_INST(digitByteArray))->ba_element;
+ unsigned char *resultBytes = _ByteArrayInstPtr(newDigitByteArray)->ba_element;
- count to:1 by:-1 do:[:i |
- tmp1 := digitByteArray at:i.
- tmp1 := (tmp1 + (prevRest * 256)).
- newDigitByteArray at:i put:tmp1 // aSmallInteger.
- prevRest := (tmp1 \\ aSmallInteger).
+ while (index > 0) {
+ unsigned int t;
+
+ index--;
+ t = digitBytes[index];
+ t = t | (rest << 8);
+ resultBytes[index] = t / divisor;
+ rest = t % divisor;
+ }
+ prevRest = _MKSMALLINT(rest);
+ ok = true;
+ }
+%}.
+ "
+ slow code - not normally reached
+ (could also do a primitiveFailure here)
+ "
+ ok ifTrue:[
+ prevRest := 0.
+ count to:1 by:-1 do:[:i |
+ tmp1 := digitByteArray at:i.
+ tmp1 := (tmp1 + (prevRest * 256)).
+ newDigitByteArray at:i put:tmp1 // aSmallInteger.
+ prevRest := (tmp1 \\ aSmallInteger).
+ ]
].
^ Array with:(result normalize) with:prevRest
--- a/LargeInteger.st Thu Jun 02 13:20:08 1994 +0200
+++ b/LargeInteger.st Thu Jun 02 13:21:56 1994 +0200
@@ -22,7 +22,7 @@
COPYRIGHT (c) 1994 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/LargeInteger.st,v 1.9 1994-05-17 10:07:56 claus Exp $
+$Header: /cvs/stx/stx/libbasic/LargeInteger.st,v 1.10 1994-06-02 11:20:42 claus Exp $
'!
!LargeInteger class methodsFor:'documentation'!
@@ -119,7 +119,7 @@
otherSign := aNumber sign.
(aNumber class == SmallInteger) ifTrue:[
- (aNumber between:1 and:255) ifTrue:[
+ (aNumber abs between:1 and:16r3fffff) ifTrue:[
sign < 0 ifTrue:[
(sign == otherSign) ifTrue:[^ (self negated absFastDiv:aNumber negated) at:1].
^ ((self negated absFastDiv:aNumber) at:1) negated
@@ -194,14 +194,14 @@
otherSign := aNumber sign.
(aNumber class == SmallInteger) ifTrue:[
- (aNumber between:1 and:255) ifTrue:[
+ (aNumber abs between:1 and:16r003fffff) ifTrue:[
sign < 0 ifTrue:[
(sign == otherSign) ifTrue:[^ (self negated absFastDiv:aNumber negated) at:2].
^ ((self negated absFastDiv:aNumber) at:2) negated
].
(sign == otherSign) ifTrue:[^ (self absFastDiv:aNumber) at:2].
^ ((self absFastDiv:aNumber negated) at:2) negated
- ].
+ ]
].
(aNumber class == self class) ifTrue:[
sign < 0 ifTrue:[
@@ -310,7 +310,8 @@
val "{ Class: SmallInteger }"
len "{ Class: SmallInteger }"
carry "{ Class: SmallInteger }"
- prod "{ Class: SmallInteger }" |
+ prod "{ Class: SmallInteger }"
+ ok|
"multiplying by a small integer is done here"
@@ -329,7 +330,7 @@
result := self class basicNew numberOfDigits:(len + 4).
- "used to be; which was replaced, to avoid another multiplication"
+ "used to be the following. replaced, to avoid another multiplication"
"
result sign:(sign * anInteger sign).
"
@@ -348,15 +349,42 @@
carry := 0.
val := num.
- 1 to:len do:[:i |
- prod := (digitByteArray basicAt:i) * val + carry.
- resultDigitByteArray basicAt:i put:(prod bitAnd:16rFF).
- carry := prod bitShift:-8.
- ].
- [carry ~~ 0] whileTrue:[
- len := len + 1.
- resultDigitByteArray basicAt:len put:(carry bitAnd:16rFF).
- carry := carry bitShift:-8
+ ok := false.
+%{
+ if (_isSmallInteger(len)
+ && _isSmallInteger(val)
+ && __isByteArray(_INST(digitByteArray))
+ && __isByteArray(resultDigitByteArray)) {
+ int _l = _intVal(len);
+ int _v = _intVal(val);
+ unsigned _carry = 0;
+ unsigned _prod;
+ unsigned char *digitP = _ByteArrayInstPtr(_INST(digitByteArray))->ba_element;
+ unsigned char *resultP = _ByteArrayInstPtr(resultDigitByteArray)->ba_element;
+
+ while (_l-- > 0) {
+ _prod = *digitP++ * _v + _carry;
+ *resultP++ = _prod & 0xFF;
+ _carry = _prod >> 8;
+ }
+ while (_carry) {
+ *resultP++ = _carry & 0xFF;
+ _carry >>= 8;
+ }
+ ok = true;
+ }
+%}.
+ ok ifFalse:[
+ 1 to:len do:[:i |
+ prod := (digitByteArray basicAt:i) * val + carry.
+ resultDigitByteArray basicAt:i put:(prod bitAnd:16rFF).
+ carry := prod bitShift:-8.
+ ].
+ [carry ~~ 0] whileTrue:[
+ len := len + 1.
+ resultDigitByteArray basicAt:len put:(carry bitAnd:16rFF).
+ carry := carry bitShift:-8
+ ].
].
^ result normalize
! !
@@ -514,7 +542,8 @@
|tmp1 "{ Class: SmallInteger }"
prevRest "{ Class: SmallInteger }"
count "{ Class: SmallInteger }"
- newDigitByteArray result|
+ newDigitByteArray result
+ ok|
aSmallInteger == 0 ifTrue:[
^ DivisionByZeroSignal raise
@@ -525,17 +554,47 @@
^ Array with:0 with:self
].
"
- prevRest := 0.
count := digitByteArray size.
result := self class basicNew numberOfDigits:count.
result sign:1.
newDigitByteArray := result digits.
+ ok := false.
+%{
+ if (__isByteArray(_INST(digitByteArray))
+ && __isByteArray(newDigitByteArray)
+ && _isSmallInteger(count)
+ && _isSmallInteger(aSmallInteger)) {
+ unsigned int rest = 0;
+ int index = _intVal(count);
+ int divisor = _intVal(aSmallInteger);
+ unsigned char *digitBytes = _ByteArrayInstPtr(_INST(digitByteArray))->ba_element;
+ unsigned char *resultBytes = _ByteArrayInstPtr(newDigitByteArray)->ba_element;
- count to:1 by:-1 do:[:i |
- tmp1 := digitByteArray at:i.
- tmp1 := (tmp1 + (prevRest * 256)).
- newDigitByteArray at:i put:tmp1 // aSmallInteger.
- prevRest := (tmp1 \\ aSmallInteger).
+ while (index > 0) {
+ unsigned int t;
+
+ index--;
+ t = digitBytes[index];
+ t = t | (rest << 8);
+ resultBytes[index] = t / divisor;
+ rest = t % divisor;
+ }
+ prevRest = _MKSMALLINT(rest);
+ ok = true;
+ }
+%}.
+ "
+ slow code - not normally reached
+ (could also do a primitiveFailure here)
+ "
+ ok ifTrue:[
+ prevRest := 0.
+ count to:1 by:-1 do:[:i |
+ tmp1 := digitByteArray at:i.
+ tmp1 := (tmp1 + (prevRest * 256)).
+ newDigitByteArray at:i put:tmp1 // aSmallInteger.
+ prevRest := (tmp1 \\ aSmallInteger).
+ ]
].
^ Array with:(result normalize) with:prevRest
--- a/LimitedPrecisionReal.st Thu Jun 02 13:20:08 1994 +0200
+++ b/LimitedPrecisionReal.st Thu Jun 02 13:21:56 1994 +0200
@@ -22,7 +22,7 @@
COPYRIGHT (c) 1994 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/LimitedPrecisionReal.st,v 1.1 1994-02-25 12:59:09 claus Exp $
+$Header: /cvs/stx/stx/libbasic/LimitedPrecisionReal.st,v 1.2 1994-06-02 11:20:40 claus Exp $
Abstract superclass for single and double (and maybe more) precision real numbers (i.e. Float and Double).
'!
@@ -228,12 +228,12 @@
sign := self sign.
v := self abs.
- (v >= 10) ifTrue:[
+ (v >= 10.0) ifTrue:[
l := (v / 10.0) asInteger * 10
] ifFalse:[
l := 0
].
- v := v - ((v / 10.0) floor * 10.0) floor.
+ v := v - ((v / 10.0) floor * 10) floor.
l := l + v truncated.
^ l * sign
--- a/Message.st Thu Jun 02 13:20:08 1994 +0200
+++ b/Message.st Thu Jun 02 13:21:56 1994 +0200
@@ -29,7 +29,7 @@
This allows for re-evaluation of the failed send (after some cleanup).
As an example of its use, see the implementation of the Autoload-class.
-$Header: /cvs/stx/stx/libbasic/Message.st,v 1.6 1994-02-25 13:00:38 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Message.st,v 1.7 1994-06-02 11:20:49 claus Exp $
'!
!Message class methodsFor:'instance creation'!
@@ -77,6 +77,12 @@
"send the selector with argument to a receiver"
aReceiver perform:selector withArguments:args
+!
+
+reinvokeFor: aReceiver
+ "send the selector with argument to a receiver.
+ Same as sendTo: - for GNU-ST compatibility."
+ ^ self sendTo:aReceiver
! !
!Message methodsFor:'accessing'!
--- a/Metaclass.st Thu Jun 02 13:20:08 1994 +0200
+++ b/Metaclass.st Thu Jun 02 13:21:56 1994 +0200
@@ -26,7 +26,7 @@
Metaclass provides support for creating new (sub)classes and/or
changing the definition of an already existing class.
-$Header: /cvs/stx/stx/libbasic/Metaclass.st,v 1.11 1994-05-17 10:08:07 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Metaclass.st,v 1.12 1994-06-02 11:20:51 claus Exp $
'!
!Metaclass methodsFor:'creating classes'!
@@ -709,8 +709,9 @@
newClass dependents:(oldClass dependents).
newClass changed.
- "just to make certain ..."
- oldClass changed.
+ "just to make certain ... - telle dependents of oldClass, that something changed
+ (systemBrowsers will react on this, and update their views)"
+ oldClass changed:newClass.
ObjectMemory flushCaches.
--- a/Method.st Thu Jun 02 13:20:08 1994 +0200
+++ b/Method.st Thu Jun 02 13:21:56 1994 +0200
@@ -10,9 +10,8 @@
hereby transferred.
"
-Object subclass:#Method
- instanceVariableNames:'code flags byteCode literals
- source sourcePosition category'
+ExecutableCodeObject subclass:#Method
+ instanceVariableNames:'source sourcePosition category'
classVariableNames:''
poolDictionaries:''
category:'Kernel-Methods'
@@ -23,7 +22,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/Method.st,v 1.13 1994-05-17 10:08:11 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Method.st,v 1.14 1994-06-02 11:20:54 claus Exp $
written spring 89 by claus
'!
@@ -66,42 +65,6 @@
!Method methodsFor:'accessing'!
-instVarAt:index
- "redefined to catch access to code-field - it is a non-object"
-
- index == 1 ifTrue:[^ self code].
- ^ super instVarAt:index
-!
-
-instVarAt:index put:value
- "redefined to catch access to code-field - it is a non-object"
-
- index == 1 ifTrue:[^ self code:value].
- ^ super instVarAt:index put:value
-!
-
-code
- "return code field - since its a non-object return address as integer"
-%{
- if (_MethodInstPtr(self)->m_code != (OBJFUNC)0) {
- RETURN ( _MKSMALLINT((int)(_MethodInstPtr(self)->m_code)) );
- }
-%}.
- ^ nil
-!
-
-code:anAddress
- "set the code field - you should know what you do if doing this -
- should only be done by compiler or dynamic code loaders.
- Smalltalk can crash badly if playing around here ..."
-%{
- if (_isSmallInteger(anAddress))
- _INST(code) = (OBJ)(_intVal(anAddress));
- else
- _INST(code) = nil;
-%}
-!
-
source
"return the sourcestring for the receiver"
@@ -185,32 +148,6 @@
"(Method compiledMethodAt:#comment) comment"
!
-literals
- "return the methods literal array"
-
- ^ literals
-!
-
-literals:anArray
- "set the methods literal array.
- WARNING: for internal use by compiler only."
-
- literals := anArray
-!
-
-byteCode
- "return the methods byteCode array"
-
- ^ byteCode
-!
-
-byteCode:aByteArray
- "set the methods byteCode array.
- WARNING: for internal use by compiler only."
-
- byteCode := aByteArray
-!
-
category
"return the methods category or nil"
@@ -241,23 +178,6 @@
]
!
-dynamic:aBoolean
- "set the flag bit stating that the machine code was created
- dynamically and should be flushed on image-restart.
- WARNING: obsolete & for internal use by the compiler only."
-
-%{ /* NOCONTEXT */
- int f = _intVal(_INST(flags));
-
- /* made this a primitive to get define in stc.h */
- if (aBoolean == true)
- f = f | F_DYNAMIC;
- else
- f = f & ~F_DYNAMIC;
- _INST(flags) = _MKSMALLINT(f);
-%}
-!
-
private:aBoolean
"set the flag bit stating that this method is private, and should only be
allowed for self-sends from the class or self/super sends from subclasses.
@@ -565,38 +485,6 @@
self error:'invalid method - not executable'
!
-noByteCode
- "this error is triggered when the interpreter tries to execute a
- method, where the byteCode is nil.
-
- Normally, this can only happen when compiler/runtime system is broken,
- or a methods code field has been nilled out by someone.
- However, for lazy compilation, this can be used to trap unloaded
- methods."
-
- self error:'nil byteCode in method - not executable'
-!
-
-invalidByteCode
- "this error is triggered when the interpreter tries to execute a
- method, where the byteCode is nonNil, but not a ByteArray.
-
- Can only happen when playing with a methods byteCodes, or
- compiler/runtime system is broken."
-
- self error:'invalid byteCode in method - not executable'
-!
-
-invalidInstruction
- "this error is triggered when the bytecode-interpreter tries to
- execute an invalid bytecode instruction.
-
- Can only happen when playing with a methods byteCodes, or
- compiler/runtime system is broken."
-
- self error:'invalid instruction in methods code - not executable'
-!
-
tooManySendArguments
"this error is triggered, when a method tries to perform a send with
more arguments than supported by the interpreter. This can only happen,
@@ -611,26 +499,6 @@
compiler has been changed without updating the VM."
self error:'method has too many args - should not happen'
-!
-
-badLiteralTable
- "this error is triggered, when a method is called with a bad literal
- array (i.e. non-array). This can only happen, if the
- compiler is broken or someone played around with a methods
- literal table or the GC is broken and corrupted it."
-
- self error:'method has too many args - should not happen'
-!
-
-receiverNotBoolean
- "this error is triggered when the bytecode-interpreter tries to
- execute ifTrue:/ifFalse or whileTrue:/whileFalse:-type of expressions,
- where the receiver is neither true nor false.
- (Actually, this shows a weak area in the current design: ifTrue: type
- of messages are hardcoded to Booleans - it is not possible to define
- it for other classes)"
-
- self error:'if/while on non-boolean receiver'
! !
!Method methodsFor:'executing'!
--- a/ObjMem.st Thu Jun 02 13:20:08 1994 +0200
+++ b/ObjMem.st Thu Jun 02 13:21:56 1994 +0200
@@ -17,6 +17,7 @@
ErrorInterruptHandler MemoryInterruptHandler SignalInterruptHandler
ChildSignalInterruptHandler DisposeInterruptHandler
RecursionInterruptHandler IOInterruptHandler
+ CustomInterruptHandler
AllocationFailureSignal
IncrementalGCLimit
@@ -31,7 +32,7 @@
COPYRIGHT (c) 1992 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/Attic/ObjMem.st,v 1.10 1994-05-17 10:08:17 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Attic/ObjMem.st,v 1.11 1994-06-02 11:21:00 claus Exp $
'!
!ObjectMemory class methodsFor:'documentation'!
@@ -68,7 +69,8 @@
DisposeInterruptHandler gets informed, when an object is disposed from
a shadowArray
RecursionInterruptHandler gets recursion limit violations
- IOInterruptHandler get SIGIO unix signals
+ IOInterruptHandler gets SIGIO unix signals
+ CustomInterruptHandler gets custom interrupts
AllocationFailureSignal signal raised when a new fails (see Behavior)
IngrementalGCLimit number of bytes, that must be allocated since
@@ -183,7 +185,11 @@
!ObjectMemory class methodsFor:'enumeration'!
allObjectsDo:aBlock
- "evaluate the argument, aBlock for all objects in the system"
+ "evaluate the argument, aBlock for all objects in the system.
+ There is one caveat: if a compressing oldSpace collect
+ occurs while looping over the objects, the loop cannot be
+ continued (for some internal reasons). In this case, false
+ is returned."
|work|
@@ -192,16 +198,22 @@
/*
* allObjectsDo needs a temporary to hold newSpace objects
*/
- __allObjectsDo(&aBlock, &work COMMA_CON);
-%}
+ if (__allObjectsDo(&aBlock, &work COMMA_CON) < 0) {
+ RETURN (false);
+ }
+%}.
+ ^ true
!
allOldObjectsDo:aBlock
"evaluate the argument, aBlock for all old objects in the system.
For debugging and tests only - do not use"
%{
- __allObjectsDo(&aBlock, (OBJ *)0 COMMA_CON);
-%}
+ if (__allObjectsDo(&aBlock, (OBJ *)0 COMMA_CON) < 0) {
+ RETURN (false);
+ }
+%}.
+ ^ true
! !
!ObjectMemory class methodsFor:'handler access'!
@@ -333,6 +345,18 @@
"set the handler for I/O available signal interrupts (SIGIO/SIGPOLL)"
IOInterruptHandler := aHandler
+!
+
+customInterruptHandler
+ "return the handler for custom interrupts"
+
+ ^ CustomInterruptHandler
+!
+
+customInterruptHandler:aHandler
+ "set the handler for custom interrupts"
+
+ CustomInterruptHandler := aHandler
! !
!ObjectMemory class methodsFor:'queries'!
@@ -578,7 +602,7 @@
scavenge
"collect young objects, without aging.
Can be used to quickly get rid of shortly before allocated
- stuff."
+ stuff. Is relatively fast (compared to oldspace collect)"
%{
nonTenuringScavenge(__context);
%}
@@ -588,7 +612,8 @@
tenuringScavenge
"collect newspace stuff, with aging.
- For debugging only. This method may vanish."
+ For debugging only. This method may vanish.
+ Is relatively fast (compared to oldspace collect)"
%{
scavenge(__context);
%}
@@ -599,6 +624,7 @@
tenure
"force all new stuff into old-space - effectively making
all living young objects become old objects.
+ Is relatively fast (compared to oldspace collect).
For debugging only. This method may vanish."
%{
tenure(__context);
@@ -611,7 +637,6 @@
"mark/sweep garbage collector; perform a
full mark&sweep collect.
Warning: this may take some time."
-
%{
markAndSweep(__context);
%}
@@ -622,26 +647,33 @@
gcStep
"one incremental garbage collect step.
Mark or sweep some small number of objects. This
- method will return after a reasonable (short) time."
+ method will return after a reasonable (short) time.
+ This is used by the ProcessorScheduler at idle times."
%{
incrGCstep(__context);
%}
!
incrementalGCLimit:aNumber
- "set the limit for incremental GC activation"
+ "set the limit for incremental GC activation.
+ This is used by the ProcessorScheduler."
IncrementalGCLimit := aNumber
- "ObjectMemory incrementalGCLimit:100000"
+ "
+ ObjectMemory incrementalGCLimit:100000
+ "
!
incrementalGCLimit
- "return the limit for incremental GC activation"
+ "return the limit for incremental GC activation.
+ This is used by the ProcessorScheduler."
^ IncrementalGCLimit
- "ObjectMemory incrementalGCLimit"
+ "
+ ObjectMemory incrementalGCLimit
+ "
!
turnGarbageCollectorOff
@@ -666,6 +698,57 @@
%}
! !
+!ObjectMemory class methodsFor:'physical memory access'!
+
+makeOld:anObject
+ "move anObject into oldSpace - for debugging only;
+ may vanish. Dont use it."
+%{
+ if (__moveToOldSpace(anObject, __context) < 0) {
+ RETURN (false);
+ }
+%}.
+ ^ true
+!
+
+oldSpacePagesDo:aBlock
+ "evaluates aBlock for all pages in the oldSpace, passing
+ the pages address as argument.
+ For internal use only."
+%{
+ if (__oldSpacePagesDo(&aBlock COMMA_CON) < 0) {
+ RETURN (false);
+ }
+%}.
+ ^ true
+!
+
+pageIsInCore:aPageNumber
+ "return true, if the page (as enumerated via oldSpacePagesDo:)
+ is in memory; false, if currently paged out. For internal
+ use / monitors only; may vanish."
+
+%{
+#ifdef HAS_MINCORE
+ int pageSize = getpagesize();
+ char result[10];
+ INT addr;
+
+ if (_isSmallInteger(aPageNumber)) {
+ addr = _intVal(aPageNumber) & ~(pageSize - 1);
+ } else {
+ addr = ((INT)aPageNumber) & ~(pageSize - 1);
+ }
+ if (mincore(addr, pageSize-1, result) < 0) {
+ RETURN (true);
+ }
+ RETURN ((result[0] & 1) ? true : false);
+#endif
+%}.
+ "OS does not supply this info - assume yes"
+ ^ true
+! !
+
!ObjectMemory class methodsFor:'low memory handling'!
memoryInterrupt
--- a/Object.st Thu Jun 02 13:20:08 1994 +0200
+++ b/Object.st Thu Jun 02 13:21:56 1994 +0200
@@ -30,7 +30,7 @@
COPYRIGHT (c) 1988 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/Object.st,v 1.15 1994-05-17 10:08:20 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Object.st,v 1.16 1994-06-02 11:21:03 claus Exp $
'!
"these will become classVariables soon ..."
@@ -329,24 +329,66 @@
type of indexed instance variables). If the structures do not match, or any
of the objects is nil or a Smallinteger, a primitive error is triggered."
- |myClass|
-
- myClass := self class.
- myClass flags == otherClass flags ifTrue:[
- myClass instSize == otherClass instSize ifTrue:[
- "its ok to do it"
+ |myClass ok|
+
+ "check for UndefinedObject/SmallInteger receiver or newClass"
%{
- if (_isNonNilObject(self)
- && _isNonNilObject(otherClass)
- && (otherClass != UndefinedObject)
- && (otherClass != SmallInteger)) {
- _qClass(self) = otherClass;
- __STORE(self, otherClass);
- RETURN ( self );
- }
-%}
+ if (_isNonNilObject(self)
+ && _isNonNilObject(otherClass)
+ && (otherClass != UndefinedObject)
+ && (otherClass != SmallInteger)) {
+ ok = true;
+ } else {
+ ok = false;
+ }
+%}.
+ ok ifTrue:[
+ ok := false.
+ myClass := self class.
+ myClass flags == otherClass flags ifTrue:[
+ myClass instSize == otherClass instSize ifTrue:[
+ "same instance layout and types: its ok to do it"
+ ok := true.
+ ] ifFalse:[
+ myClass isPointers ifTrue:[
+ myClass isVariable ifTrue:[
+ ok := true
+ ]
+ ]
+ ]
+ ] ifFalse:[
+ myClass isPointers ifTrue:[
+ "if newClass is a variable class, with instSize <= my instsize,
+ we can do it (effectively mapping additional instvars into the
+ variable part) - usefulness is questionable, though"
+
+ otherClass isPointers ifTrue:[
+ otherClass isVariable ifTrue:[
+ otherClass instSize <= (myClass instSize + self basicSize) ifTrue:[
+ ok := true
+ ]
+ ] ifFalse:[
+ otherClass instSize == (myClass instSize + self basicSize) ifTrue:[
+ ok := true
+ ]
+ ]
+ ] ifFalse:[
+ "it does not make sense to convert pointers to bytes ..."
+ ]
+ ] ifFalse:[
+ "does it make sense, to convert bits ?"
+ "could allow byteArray->wordArray->longArray->floatArray->doubleArray here ..."
+ ]
]
].
+ ok ifTrue:[
+ "now, change the receivers class ..."
+%{
+ _qClass(self) = otherClass;
+ __STORE(self, otherClass);
+ RETURN ( self );
+%}.
+ ].
self primitiveFailed
!
@@ -577,7 +619,8 @@
be avoided; it limits the reusability of your classes by limiting use
to instances of a certain class.
Use check-methods to check an object for a certain attributes/protocol
- (such as respondsTo: or isNumber)"
+ (such as respondsTo: or isNumber);
+ or check via #respondsTo: if a it understands your message."
^ (self class) == aClass
!
@@ -590,10 +633,9 @@
to instances of certain classes and fences you into a specific inheritance
hierarchy.
Use check-methods to check an object for a certain attributes/protocol
- (such as respondsTo: or isNumber)"
+ (such as isXXXX, respondsTo: or isNumber)"
%{ /* NOCONTEXT */
-
register OBJ thisClass;
thisClass = _Class(self);
@@ -605,6 +647,15 @@
}
%}
.
+"/
+"/ the above code is equivalent to:
+"/
+"/ thisClass := self class.
+"/ [thisClass notNil] whileTrue:[
+"/ thisClass == aClass ifTrue:[^ true].
+"/ thisClass := thisClass superclass
+"/ ]
+"/
^ false
!
@@ -984,7 +1035,7 @@
integer, nil etc).
Its not guaranteed, that the system is in a working condition ...."
- self error:msg
+ ^ self error:msg
!
userInterrupt
@@ -1276,6 +1327,10 @@
] ifFalse:[
errorString := 'Message not understood: ' , aMessage selector
].
+ MessageNotUnderstoodSignal isNil ifTrue:[
+ self enterDebuggerWith:'oops - MessageNotUnderstoodSignal is gone'.
+ ^ self
+ ].
MessageNotUnderstoodSignal
raiseRequestWith:aMessage
errorString:errorString
@@ -1286,15 +1341,15 @@
If Debugger is DebugView, try switching to MiniDebugger (as
a last chance) otherwise abort.
There should not be an error in the debugger, this will only
- happen if some classes has been changed badly."
-
- |con|
-
- con := thisContext.
- con := con sender.
- [con notNil] whileTrue:[
- ((con receiver class == Debugger)
- and:[con selector == #enterWithMessage:]) ifTrue:[
+ happen if some classes have been changed badly."
+
+ |context|
+
+ context := thisContext.
+ context := context sender.
+ [context notNil] whileTrue:[
+ ((context receiver class == Debugger)
+ and:[context selector == #enterWithMessage:]) ifTrue:[
"we are already in some Debugger"
(Debugger == MiniDebugger) ifTrue:[
"we are in the MiniDebugger"
@@ -1310,7 +1365,7 @@
lets try MiniDebugger"
^ MiniDebugger
].
- con := con sender
+ context := context sender
].
"not within Debugger - go there"
^ Debugger
@@ -1955,6 +2010,7 @@
static struct inlineCache ilc = _ILC0;
static OBJ lastSelector = nil;
+ struct inlineCache lilc = _DUMMYILC0;
#if defined(THIS_CONTEXT)
/*
@@ -1968,10 +2024,18 @@
lastSelector = aSelector;
}
#if defined(THIS_CONTEXT)
+# ifdef PRE_2_11
ilc.ilc_lineNo = __pilc->ilc_lineNo;
+# else
+ lilc.ilc_lineNo = __pilc->ilc_lineNo;
+# endif
#endif
+#ifdef PRE_2_11
RETURN ( (*ilc.ilc_func)(self, aSelector, CON_COMMA nil, &ilc) );
+#else
+ RETURN ( (*ilc.ilc_func)(self, aSelector, CON_COMMA nil, &lilc) );
+#endif
%}
!
@@ -1982,6 +2046,7 @@
static struct inlineCache ilc = _ILC1;
static OBJ lastSelector = nil;
+ struct inlineCache lilc = _DUMMYILC1;
#if defined(THIS_CONTEXT)
/*
@@ -1994,10 +2059,18 @@
lastSelector = aSelector;
}
#ifdef THIS_CONTEXT
+# ifdef PRE_2_11
ilc.ilc_lineNo = __pilc->ilc_lineNo;
+# else
+ lilc.ilc_lineNo = __pilc->ilc_lineNo;
+# endif
#endif
+#ifdef PRE_2_11
RETURN ( (*ilc.ilc_func)(self, aSelector, CON_COMMA nil, &ilc, anObject) );
+#else
+ RETURN ( (*ilc.ilc_func)(self, aSelector, CON_COMMA nil, &lilc, anObject) );
+#endif
%}
!
@@ -2008,6 +2081,7 @@
static struct inlineCache ilc = _ILC2;
static OBJ lastSelector = nil;
+ struct inlineCache lilc = _DUMMYILC2;
#if defined(THIS_CONTEXT)
/*
@@ -2020,10 +2094,18 @@
lastSelector = aSelector;
}
#ifdef THIS_CONTEXT
+# ifdef PRE_2_11
ilc.ilc_lineNo = __pilc->ilc_lineNo;
+# else
+ lilc.ilc_lineNo = __pilc->ilc_lineNo;
+# endif
#endif
- RETURN ( (*ilc.ilc_func)(self, aSelector, CON_COMMA nil, &ilc, firstObject, secondObject) );
+# ifdef PRE_2_11
+ RETURN ((*ilc.ilc_func)(self, aSelector, CON_COMMA nil, &ilc, firstObject, secondObject));
+# else
+ RETURN ((*ilc.ilc_func)(self, aSelector, CON_COMMA nil, &lilc, firstObject, secondObject));
+# endif
%}
!
@@ -2288,7 +2370,7 @@
argP[0], argP[1], argP[2], argP[3], argP[4],
argP[5], argP[6], argP[7], argP[8], argP[9],
argP[10], argP[11], argP[12], argP[13],
- argP[14]));
+ argP[14]));
}
}
%}
@@ -2401,17 +2483,17 @@
case 13:
RETURN ( _SEND13(self, aSelector, CON_COMMA aClass, &ilc13,
a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12,
- a13));
+ a13));
case 14:
RETURN ( _SEND14(self, aSelector, CON_COMMA aClass, &ilc14,
a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12,
- a13, a14));
+ a13, a14));
case 15:
RETURN ( _SEND15(self, aSelector, CON_COMMA aClass, &ilc15,
a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12,
- a13, a14, a15));
+ a13, a14, a15));
}
}
%}
@@ -2558,16 +2640,10 @@
(dont expect me to write national variants for this ... :-)
If you have special preferences, redefine it ..."
- |article classname firstChar|
+ |classname|
classname := self className.
- firstChar := (classname at:1) asLowercase.
- (firstChar isVowel or:[firstChar == $x]) ifTrue:[
- article := 'an '
- ] ifFalse:[
- article := 'a '
- ].
- ^ (article , classname)
+ ^ classname article , ' ' , classname
"1 classNameWithArticle"
"(1->2) classNameWithArticle"
--- a/ObjectMemory.st Thu Jun 02 13:20:08 1994 +0200
+++ b/ObjectMemory.st Thu Jun 02 13:21:56 1994 +0200
@@ -17,6 +17,7 @@
ErrorInterruptHandler MemoryInterruptHandler SignalInterruptHandler
ChildSignalInterruptHandler DisposeInterruptHandler
RecursionInterruptHandler IOInterruptHandler
+ CustomInterruptHandler
AllocationFailureSignal
IncrementalGCLimit
@@ -31,7 +32,7 @@
COPYRIGHT (c) 1992 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/ObjectMemory.st,v 1.10 1994-05-17 10:08:17 claus Exp $
+$Header: /cvs/stx/stx/libbasic/ObjectMemory.st,v 1.11 1994-06-02 11:21:00 claus Exp $
'!
!ObjectMemory class methodsFor:'documentation'!
@@ -68,7 +69,8 @@
DisposeInterruptHandler gets informed, when an object is disposed from
a shadowArray
RecursionInterruptHandler gets recursion limit violations
- IOInterruptHandler get SIGIO unix signals
+ IOInterruptHandler gets SIGIO unix signals
+ CustomInterruptHandler gets custom interrupts
AllocationFailureSignal signal raised when a new fails (see Behavior)
IngrementalGCLimit number of bytes, that must be allocated since
@@ -183,7 +185,11 @@
!ObjectMemory class methodsFor:'enumeration'!
allObjectsDo:aBlock
- "evaluate the argument, aBlock for all objects in the system"
+ "evaluate the argument, aBlock for all objects in the system.
+ There is one caveat: if a compressing oldSpace collect
+ occurs while looping over the objects, the loop cannot be
+ continued (for some internal reasons). In this case, false
+ is returned."
|work|
@@ -192,16 +198,22 @@
/*
* allObjectsDo needs a temporary to hold newSpace objects
*/
- __allObjectsDo(&aBlock, &work COMMA_CON);
-%}
+ if (__allObjectsDo(&aBlock, &work COMMA_CON) < 0) {
+ RETURN (false);
+ }
+%}.
+ ^ true
!
allOldObjectsDo:aBlock
"evaluate the argument, aBlock for all old objects in the system.
For debugging and tests only - do not use"
%{
- __allObjectsDo(&aBlock, (OBJ *)0 COMMA_CON);
-%}
+ if (__allObjectsDo(&aBlock, (OBJ *)0 COMMA_CON) < 0) {
+ RETURN (false);
+ }
+%}.
+ ^ true
! !
!ObjectMemory class methodsFor:'handler access'!
@@ -333,6 +345,18 @@
"set the handler for I/O available signal interrupts (SIGIO/SIGPOLL)"
IOInterruptHandler := aHandler
+!
+
+customInterruptHandler
+ "return the handler for custom interrupts"
+
+ ^ CustomInterruptHandler
+!
+
+customInterruptHandler:aHandler
+ "set the handler for custom interrupts"
+
+ CustomInterruptHandler := aHandler
! !
!ObjectMemory class methodsFor:'queries'!
@@ -578,7 +602,7 @@
scavenge
"collect young objects, without aging.
Can be used to quickly get rid of shortly before allocated
- stuff."
+ stuff. Is relatively fast (compared to oldspace collect)"
%{
nonTenuringScavenge(__context);
%}
@@ -588,7 +612,8 @@
tenuringScavenge
"collect newspace stuff, with aging.
- For debugging only. This method may vanish."
+ For debugging only. This method may vanish.
+ Is relatively fast (compared to oldspace collect)"
%{
scavenge(__context);
%}
@@ -599,6 +624,7 @@
tenure
"force all new stuff into old-space - effectively making
all living young objects become old objects.
+ Is relatively fast (compared to oldspace collect).
For debugging only. This method may vanish."
%{
tenure(__context);
@@ -611,7 +637,6 @@
"mark/sweep garbage collector; perform a
full mark&sweep collect.
Warning: this may take some time."
-
%{
markAndSweep(__context);
%}
@@ -622,26 +647,33 @@
gcStep
"one incremental garbage collect step.
Mark or sweep some small number of objects. This
- method will return after a reasonable (short) time."
+ method will return after a reasonable (short) time.
+ This is used by the ProcessorScheduler at idle times."
%{
incrGCstep(__context);
%}
!
incrementalGCLimit:aNumber
- "set the limit for incremental GC activation"
+ "set the limit for incremental GC activation.
+ This is used by the ProcessorScheduler."
IncrementalGCLimit := aNumber
- "ObjectMemory incrementalGCLimit:100000"
+ "
+ ObjectMemory incrementalGCLimit:100000
+ "
!
incrementalGCLimit
- "return the limit for incremental GC activation"
+ "return the limit for incremental GC activation.
+ This is used by the ProcessorScheduler."
^ IncrementalGCLimit
- "ObjectMemory incrementalGCLimit"
+ "
+ ObjectMemory incrementalGCLimit
+ "
!
turnGarbageCollectorOff
@@ -666,6 +698,57 @@
%}
! !
+!ObjectMemory class methodsFor:'physical memory access'!
+
+makeOld:anObject
+ "move anObject into oldSpace - for debugging only;
+ may vanish. Dont use it."
+%{
+ if (__moveToOldSpace(anObject, __context) < 0) {
+ RETURN (false);
+ }
+%}.
+ ^ true
+!
+
+oldSpacePagesDo:aBlock
+ "evaluates aBlock for all pages in the oldSpace, passing
+ the pages address as argument.
+ For internal use only."
+%{
+ if (__oldSpacePagesDo(&aBlock COMMA_CON) < 0) {
+ RETURN (false);
+ }
+%}.
+ ^ true
+!
+
+pageIsInCore:aPageNumber
+ "return true, if the page (as enumerated via oldSpacePagesDo:)
+ is in memory; false, if currently paged out. For internal
+ use / monitors only; may vanish."
+
+%{
+#ifdef HAS_MINCORE
+ int pageSize = getpagesize();
+ char result[10];
+ INT addr;
+
+ if (_isSmallInteger(aPageNumber)) {
+ addr = _intVal(aPageNumber) & ~(pageSize - 1);
+ } else {
+ addr = ((INT)aPageNumber) & ~(pageSize - 1);
+ }
+ if (mincore(addr, pageSize-1, result) < 0) {
+ RETURN (true);
+ }
+ RETURN ((result[0] & 1) ? true : false);
+#endif
+%}.
+ "OS does not supply this info - assume yes"
+ ^ true
+! !
+
!ObjectMemory class methodsFor:'low memory handling'!
memoryInterrupt
--- a/PipeStr.st Thu Jun 02 13:20:08 1994 +0200
+++ b/PipeStr.st Thu Jun 02 13:21:56 1994 +0200
@@ -22,7 +22,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/Attic/PipeStr.st,v 1.9 1994-02-25 13:01:59 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Attic/PipeStr.st,v 1.10 1994-06-02 11:21:15 claus Exp $
'!
%{
@@ -150,7 +150,6 @@
#ifndef transputer
{
FILE *f;
- extern OBJ ErrorNumber;
extern errno;
extern int _immediateInterrupt;
int savInt;
@@ -173,7 +172,7 @@
} while ((f == NULL) && (errno == EINTR));
_immediateInterrupt = savInt;
if (f == NULL) {
- ErrorNumber = _MKSMALLINT(errno);
+ ExternalStream_LastErrorNumber = _MKSMALLINT(errno);
} else {
_INST(filePointer) = MKOBJ(f);
retVal = self;
--- a/PipeStream.st Thu Jun 02 13:20:08 1994 +0200
+++ b/PipeStream.st Thu Jun 02 13:21:56 1994 +0200
@@ -22,7 +22,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/PipeStream.st,v 1.9 1994-02-25 13:01:59 claus Exp $
+$Header: /cvs/stx/stx/libbasic/PipeStream.st,v 1.10 1994-06-02 11:21:15 claus Exp $
'!
%{
@@ -150,7 +150,6 @@
#ifndef transputer
{
FILE *f;
- extern OBJ ErrorNumber;
extern errno;
extern int _immediateInterrupt;
int savInt;
@@ -173,7 +172,7 @@
} while ((f == NULL) && (errno == EINTR));
_immediateInterrupt = savInt;
if (f == NULL) {
- ErrorNumber = _MKSMALLINT(errno);
+ ExternalStream_LastErrorNumber = _MKSMALLINT(errno);
} else {
_INST(filePointer) = MKOBJ(f);
retVal = self;
--- a/Process.st Thu Jun 02 13:20:08 1994 +0200
+++ b/Process.st Thu Jun 02 13:21:56 1994 +0200
@@ -23,7 +23,7 @@
COPYRIGHT (c) 1992 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/Process.st,v 1.10 1994-03-30 09:40:59 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Process.st,v 1.11 1994-06-02 11:21:22 claus Exp $
'!
!Process methodsFor:'accessing'!
@@ -232,7 +232,8 @@
!Process methodsFor:'printing'!
printOn:aStream
- aStream nextPutAll:'a ';
+ aStream nextPutAll:state article;
+ space;
nextPutAll:state;
nextPutAll:' Process (';
nextPutAll:self nameOrId;
--- a/SmallInt.st Thu Jun 02 13:20:08 1994 +0200
+++ b/SmallInt.st Thu Jun 02 13:21:56 1994 +0200
@@ -22,7 +22,7 @@
COPYRIGHT (c) 1988 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/Attic/SmallInt.st,v 1.12 1994-05-17 10:09:08 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Attic/SmallInt.st,v 1.13 1994-06-02 11:21:37 claus Exp $
'!
!SmallInteger class methodsFor:'documentation'!
@@ -1042,15 +1042,33 @@
count = _intVal(shiftCount);
bits = _intVal(self);
if (count > 0) {
- RETURN ( _MKSMALLINT(bits << count) );
- }
- if (count < 0) {
- RETURN ( _MKSMALLINT(bits >> -count) );
- }
- RETURN (self );
+ /*
+ * check for overflow
+ */
+ if (count < (N_INT_BITS-1)) {
+ if (! (bits >> (N_INT_BITS - 1 - count))) {
+ RETURN ( _MKSMALLINT(bits << count) );
+ }
+ /*
+ * so, there is an overflow ...
+ * handle it as largeInteger
+ */
+ /* FALL THROUGH */
+ }
+ } else {
+ /*
+ * right shifts cannot overflow
+ */
+ if (count < 0) {
+ RETURN ( _MKSMALLINT(bits >> -count) );
+ }
+ RETURN (self );
+ }
}
-%}
-.
+%}.
+ (shiftCount isMemberOf:SmallInteger) ifTrue:[
+ ^ (LargeInteger value:self) bitShift:shiftCount
+ ].
^ self bitShift:(shiftCount coerce:1)
!
--- a/SmallInteger.st Thu Jun 02 13:20:08 1994 +0200
+++ b/SmallInteger.st Thu Jun 02 13:21:56 1994 +0200
@@ -22,7 +22,7 @@
COPYRIGHT (c) 1988 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/SmallInteger.st,v 1.12 1994-05-17 10:09:08 claus Exp $
+$Header: /cvs/stx/stx/libbasic/SmallInteger.st,v 1.13 1994-06-02 11:21:37 claus Exp $
'!
!SmallInteger class methodsFor:'documentation'!
@@ -1042,15 +1042,33 @@
count = _intVal(shiftCount);
bits = _intVal(self);
if (count > 0) {
- RETURN ( _MKSMALLINT(bits << count) );
- }
- if (count < 0) {
- RETURN ( _MKSMALLINT(bits >> -count) );
- }
- RETURN (self );
+ /*
+ * check for overflow
+ */
+ if (count < (N_INT_BITS-1)) {
+ if (! (bits >> (N_INT_BITS - 1 - count))) {
+ RETURN ( _MKSMALLINT(bits << count) );
+ }
+ /*
+ * so, there is an overflow ...
+ * handle it as largeInteger
+ */
+ /* FALL THROUGH */
+ }
+ } else {
+ /*
+ * right shifts cannot overflow
+ */
+ if (count < 0) {
+ RETURN ( _MKSMALLINT(bits >> -count) );
+ }
+ RETURN (self );
+ }
}
-%}
-.
+%}.
+ (shiftCount isMemberOf:SmallInteger) ifTrue:[
+ ^ (LargeInteger value:self) bitShift:shiftCount
+ ].
^ self bitShift:(shiftCount coerce:1)
!
--- a/Smalltalk.st Thu Jun 02 13:20:08 1994 +0200
+++ b/Smalltalk.st Thu Jun 02 13:21:56 1994 +0200
@@ -26,7 +26,7 @@
COPYRIGHT (c) 1988 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.16 1994-05-17 10:09:12 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.17 1994-06-02 11:21:41 claus Exp $
'!
"
@@ -34,8 +34,6 @@
class variables of some class ...
Being global is a historical leftover ...
"
-Smalltalk at:#ErrorNumber put:nil!
-Smalltalk at:#ErrorString put:nil!
Smalltalk at:#Language put:#english!
Smalltalk at:#LanguageTerritory put:#usa!
@@ -79,27 +77,41 @@
!Smalltalk class methodsFor:'time-versions'!
majorVersion
- "return the major version number"
+ "return the major version number.
+ This is only incremented for very fundamental changes,
+ which make old object files totally incompatible
+ (for example, if the layout/representation of fundamental
+ classes changes)."
^ 2
- "Smalltalk majorVersion"
+ "
+ Smalltalk majorVersion
+ "
!
minorVersion
- "return the minor version number"
+ "return the minor version number.
+ This is incremented for changes which make some old object
+ files incompatible, or the protocol changes such that some
+ classes need rework."
^ 10
- "Smalltalk minorVersion"
+ "
+ Smalltalk minorVersion
+ "
!
revision
- "return the revision number"
+ "return the revision number.
+ Incremented for releases which fix bugs/add features."
- ^ 1
+ ^ 2
- "Smalltalk revision"
+ "
+ Smalltalk revision
+ "
!
version
@@ -111,29 +123,59 @@
'.',
self revision printString)
- "Smalltalk version"
+ "
+ Smalltalk version
+ "
!
versionDate
- "return the version date"
+ "return the version date - thats the date, this version
+ was linked."
+
+%{
+#ifdef VERSIONDATE_STRING
+ RETURN ( _MKSTRING(VERSIONDATE_STRING COMMA_SND) );
+#endif
+%}.
+ ^ '17-may-1994'
+
+ "
+ Smalltalk versionDate
+ "
+!
- ^ '19-apr-1994'
+configuration
+ "for developers only: return the configuration, with which
+ this smalltalk was compiled"
- "Smalltalk versionDate"
-!
+%{
+#ifdef CONFIGURATION_STRING
+ RETURN ( _MKSTRING(CONFIGURATION_STRING COMMA_SND) );
+#endif
+%}.
+ ^ 'unknown'
+
+ "
+ Smalltalk configuration
+ "
+!
copyright
"return a copyright string"
^ 'Copyright (c) 1988-94 by Claus Gittinger'
- "Smalltalk copyright"
+ "
+ Smalltalk copyright
+ "
!
hello
"return a greeting string"
- "stupid: this should come from a resource file ..."
+ "stupid: this should come from a resource file ...
+ but I dont use it here, to allow mini-systems without
+ Resource-stuff."
(Language == #german) ifTrue:[
^ 'Willkommen bei SmallTalk/X version '
@@ -146,7 +188,9 @@
^ 'Hello World - here is SmallTalk/X version '
, self version , ' of ' , self versionDate
- "Smalltalk hello"
+ "
+ Smalltalk hello
+ "
!
timeStamp
@@ -215,6 +259,9 @@
aClass initialize
]
].
+ "
+ now we can enable the graphical debugger/inspector
+ "
self initStandardTools.
self initInterrupts.
@@ -408,14 +455,22 @@
Initializing := false.
- "let display install itself into Processors dispatch"
+ "
+ reenable the graphical debugger/inspector (they could have been
+ defined as autoloaded in the patches file)
+ "
+ self initStandardTools.
+
+ "
+ let display install itself into Processors dispatch
+ "
Display notNil ifTrue:[
Display startDispatch.
"this is a leftover - will vanish"
- ModalDisplay notNil ifTrue:[
- ModalDisplay startDispatch
- ]
+"/ ModalDisplay notNil ifTrue:[
+"/ ModalDisplay startDispatch
+"/ ]
].
(StartupClass notNil and:[StartupSelector notNil]) ifTrue:[
@@ -513,9 +568,9 @@
"if there is a display, make it add itself to the dispatcher"
Display notNil ifTrue:[
Display startDispatch.
- ModalDisplay notNil ifTrue:[
- ModalDisplay startDispatch
- ]
+"/ ModalDisplay notNil ifTrue:[
+"/ ModalDisplay startDispatch
+"/ ]
].
"this allows firing an application by defining
--- a/String.st Thu Jun 02 13:20:08 1994 +0200
+++ b/String.st Thu Jun 02 13:21:56 1994 +0200
@@ -22,7 +22,7 @@
COPYRIGHT (c) 1988 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/String.st,v 1.14 1994-05-17 10:09:21 claus Exp $
+$Header: /cvs/stx/stx/libbasic/String.st,v 1.15 1994-06-02 11:21:47 claus Exp $
'!
%{
@@ -108,6 +108,18 @@
memset(cp, ' ', len);
*(cp + len) = '\0';
#else
+ while (len >= 8) {
+ cp[0] = ' ';
+ cp[1] = ' ';
+ cp[2] = ' ';
+ cp[3] = ' ';
+ cp[4] = ' ';
+ cp[5] = ' ';
+ cp[6] = ' ';
+ cp[7] = ' ';
+ cp += 8;
+ len -= 8;
+ }
while (len--)
*cp++ = ' ';
*cp = '\0';
--- a/Unix.st Thu Jun 02 13:20:08 1994 +0200
+++ b/Unix.st Thu Jun 02 13:21:56 1994 +0200
@@ -12,7 +12,7 @@
Object subclass:#OperatingSystem
instanceVariableNames:''
- classVariableNames:'HostName'
+ classVariableNames:'HostName LastErrorNumber LastExecStatus'
poolDictionaries:''
category:'System-Support'
!
@@ -22,7 +22,7 @@
COPYRIGHT (c) 1988 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/Attic/Unix.st,v 1.14 1994-05-17 10:09:37 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Attic/Unix.st,v 1.15 1994-06-02 11:21:56 claus Exp $
written 1988 by claus
'!
@@ -124,6 +124,10 @@
Class variables:
HostName <String> remembered hostname
+
+ LastErrorNumber <Integer> the value of errno
+ LastExecStatus <Integer> the returned exec status after
+ the last call of system
"
! !
@@ -404,7 +408,7 @@
%}
.
sys isNil ifTrue:[
- ^ self getOSType
+ ^ self getOSType
].
^ sys
@@ -437,7 +441,7 @@
struct utsname ubuff;
if (uname(&ubuff) == 0) {
- name = _MKSTRING(ubuff.nodename COMMA_CON);
+ name = _MKSTRING(ubuff.nodename COMMA_CON);
}
# endif
#endif
@@ -652,25 +656,47 @@
!OperatingSystem class methodsFor:'error messages'!
-errorNumber
+currentErrorNumber
"returns the OS's last error nr (i.e. the value of errno).
Notice, that the value of this flag is only valid immediately
after the error occurred - it gets updated with every other
- request to the OS"
+ request to the OS.
+ Use lastErrorNumber - currentErrorNumber is invalidated by
+ many, many internal calls."
%{ /* NOCONTEXT */
RETURN ( _MKSMALLINT(errno) );
%}
"
- OperatingSystem errorNumber
+ OperatingSystem currentErrorNumber
+ "
+!
+
+lastErrorNumber
+ "return the last error number"
+
+ ^ LastErrorNumber
+
+ "
+ OperatingSystem lastErrorNumber
+ "
+!
+
+lastExecStatus
+ "return the last execution status"
+
+ ^ LastExecStatus
+
+ "
+ OperatingSystem lastExecStatus
"
!
lastErrorString
"return a message string describing the last error"
- ^ self errorTextForNumber:ErrorNumber
+ ^ self errorTextForNumber:LastErrorNumber
"
OperatingSystem lastErrorString
@@ -692,297 +718,297 @@
if (_isSmallInteger(errNr)) {
switch (_intVal(errNr)) {
- /*
- * POSIX errnos - these should be defined
- */
- case EPERM:
- msg = "Operation not permitted";
- break;
- case ENOENT:
+ /*
+ * POSIX errnos - these should be defined
+ */
+ case EPERM:
+ msg = "Operation not permitted";
+ break;
+ case ENOENT:
msg = "No such file or directory";
- break;
- case ESRCH:
+ break;
+ case ESRCH:
msg = "No such process";
- break;
- case EINTR:
+ break;
+ case EINTR:
msg = "Interrupted system call";
- break;
- case EIO:
+ break;
+ case EIO:
msg = "I/O error";
- break;
- case ENXIO:
+ break;
+ case ENXIO:
msg = "No such device or address";
- break;
- case E2BIG:
+ break;
+ case E2BIG:
msg = "Arg list too long";
- break;
- case ENOEXEC:
+ break;
+ case ENOEXEC:
msg = "Exec format error";
- break;
- case EBADF:
+ break;
+ case EBADF:
msg = "Bad file number";
- break;
- case ECHILD:
+ break;
+ case ECHILD:
msg = "No child processes";
- break;
+ break;
#if !defined(EWOULDBLOCK) && defined(EAGAIN) && (EWOULDBLOCK != EAGAIN)
- case EAGAIN:
+ case EAGAIN:
msg = "Try again";
- break;
+ break;
#endif
- case ENOMEM:
+ case ENOMEM:
msg = "Out of memory";
- break;
- case EACCES:
+ break;
+ case EACCES:
msg = "Permission denied";
- break;
- case EFAULT:
+ break;
+ case EFAULT:
msg = "Bad address";
- break;
- case EBUSY:
+ break;
+ case EBUSY:
msg = "Device or resource busy";
- break;
- case EEXIST:
+ break;
+ case EEXIST:
msg = "File exists";
- break;
- case EXDEV:
+ break;
+ case EXDEV:
msg = "Cross-device link";
- break;
- case ENODEV:
+ break;
+ case ENODEV:
msg = "No such device";
- break;
- case ENOTDIR:
+ break;
+ case ENOTDIR:
msg = "Not a directory";
- break;
- case EISDIR:
+ break;
+ case EISDIR:
msg = "Is a directory";
- break;
- case EINVAL:
+ break;
+ case EINVAL:
msg = "Invalid argument";
- break;
- case ENFILE:
+ break;
+ case ENFILE:
msg = "File table overflow";
- break;
- case EMFILE:
+ break;
+ case EMFILE:
msg = "Too many open files";
- break;
- case ENOTTY:
+ break;
+ case ENOTTY:
msg = "Not a typewriter";
- break;
- case EFBIG:
+ break;
+ case EFBIG:
msg = "File too large";
- break;
- case ENOSPC:
+ break;
+ case ENOSPC:
msg = "No space left on device";
- break;
- case ESPIPE:
+ break;
+ case ESPIPE:
msg = "Illegal seek";
- break;
- case EROFS:
+ break;
+ case EROFS:
msg = "Read-only file system";
- break;
- case EMLINK:
+ break;
+ case EMLINK:
msg = "Too many links";
- break;
- case EPIPE:
+ break;
+ case EPIPE:
msg = "Broken pipe";
- break;
- case EDOM:
+ break;
+ case EDOM:
msg = "Math argument out of domain";
- break;
- case ERANGE:
+ break;
+ case ERANGE:
msg = "Math result not representable";
- break;
+ break;
#ifdef EDEADLK
- case EDEADLK:
+ case EDEADLK:
msg = "Resource deadlock would occur";
- break;
+ break;
#endif
#ifdef ENAMETOOLONG
- case ENAMETOOLONG:
+ case ENAMETOOLONG:
msg = "File name too long";
- break;
+ break;
#endif
#ifdef ENOLCK
- case ENOLCK:
+ case ENOLCK:
msg = "No record locks available";
- break;
+ break;
#endif
#ifdef ENOSYS
- case ENOSYS:
+ case ENOSYS:
msg = "Function not implemented";
- break;
+ break;
#endif
#ifdef ENOTEMPTY
- case ENOTEMPTY:
+ case ENOTEMPTY:
msg = "Directory not empty";
- break;
+ break;
#endif
#ifdef EILSEQ
- case EILSEQ:
- msg = "Illegal byte sequence";
- break;
+ case EILSEQ:
+ msg = "Illegal byte sequence";
+ break;
#endif
- /*
- * XPG3 errnos - defined on most systems
- */
+ /*
+ * XPG3 errnos - defined on most systems
+ */
#ifdef ENOTBLK
- case ENOTBLK:
+ case ENOTBLK:
msg = "Block device required";
- break;
+ break;
#endif
#ifdef ETXTBSY
- case ETXTBSY:
+ case ETXTBSY:
msg = "Text file busy";
- break;
+ break;
#endif
- /*
- * some others
- */
+ /*
+ * some others
+ */
#ifdef EWOULDBLOCK
- case EWOULDBLOCK:
- msg = "Operation would block";
- break;
+ case EWOULDBLOCK:
+ msg = "Operation would block";
+ break;
#endif
#ifdef ENOMSG
- case ENOMSG:
- msg = "No message of desired type";
- break;
+ case ENOMSG:
+ msg = "No message of desired type";
+ break;
#endif
#ifdef ELOOP
- case ELOOP:
- msg = "Too many levels of symbolic links";
- break;
+ case ELOOP:
+ msg = "Too many levels of symbolic links";
+ break;
#endif
- /*
- * some stream errors
- */
+ /*
+ * some stream errors
+ */
#ifdef ETIME
- case ETIME:
- msg = "Timer expired";
- break;
+ case ETIME:
+ msg = "Timer expired";
+ break;
#endif
#ifdef ENOSR
- case ENOSR:
- msg = "Out of streams resources";
- break;
+ case ENOSR:
+ msg = "Out of streams resources";
+ break;
#endif
#ifdef ENOSTR
- case ENOSTR:
- msg = "Device not a stream";
- break;
+ case ENOSTR:
+ msg = "Device not a stream";
+ break;
#endif
#ifdef ECOMM
- case ECOMM:
- msg = "Communication error on send";
- break;
+ case ECOMM:
+ msg = "Communication error on send";
+ break;
#endif
#ifdef EPROTO
- case EPROTO:
- msg = "Protocol error";
- break;
+ case EPROTO:
+ msg = "Protocol error";
+ break;
#endif
- /*
- * nfs errors
- */
+ /*
+ * nfs errors
+ */
#ifdef ESTALE
- case ESTALE:
- msg = "Stale NFS file handle";
- break;
+ case ESTALE:
+ msg = "Stale NFS file handle";
+ break;
#endif
#ifdef EREMOTE
- case EREMOTE:
- msg = "Too many levels of remote in path";
- break;
+ case EREMOTE:
+ msg = "Too many levels of remote in path";
+ break;
#endif
- /*
- * some networking errors
- */
+ /*
+ * some networking errors
+ */
#ifdef EINPROGRESS
- case EINPROGRESS:
- msg = "Operation now in progress";
- break;
+ case EINPROGRESS:
+ msg = "Operation now in progress";
+ break;
#endif
#ifdef EALREADY
- case EALREADY:
- msg = "Operation already in progress";
- break;
+ case EALREADY:
+ msg = "Operation already in progress";
+ break;
#endif
#ifdef ENOTSOCK
- case ENOTSOCK:
- msg = "Socket operation on non-socket";
- break;
+ case ENOTSOCK:
+ msg = "Socket operation on non-socket";
+ break;
#endif
#ifdef EDESTADDRREQ
- case EDESTADDRREQ:
- msg = "Destination address required";
- break;
+ case EDESTADDRREQ:
+ msg = "Destination address required";
+ break;
#endif
#ifdef EMSGSIZE
- case EMSGSIZE:
- msg = "Message too long";
- break;
+ case EMSGSIZE:
+ msg = "Message too long";
+ break;
#endif
#ifdef EPROTOTYPE
- case EPROTOTYPE:
- msg = "Protocol wrong type for socket";
- break;
+ case EPROTOTYPE:
+ msg = "Protocol wrong type for socket";
+ break;
#endif
#ifdef ENOPROTOOPT
- case ENOPROTOOPT:
- msg = "Protocol not available";
- break;
+ case ENOPROTOOPT:
+ msg = "Protocol not available";
+ break;
#endif
#ifdef EPROTONOSUPPORT
- case EPROTONOSUPPORT:
- msg = "Protocol not supported";
- break;
+ case EPROTONOSUPPORT:
+ msg = "Protocol not supported";
+ break;
#endif
#ifdef ESOCKTNOSUPPORT
- case ESOCKTNOSUPPORT:
- msg = "Socket type not supported";
- break;
+ case ESOCKTNOSUPPORT:
+ msg = "Socket type not supported";
+ break;
#endif
#ifdef EOPNOTSUPP
- case EOPNOTSUPP:
- msg = "Operation not supported on socket";
- break;
+ case EOPNOTSUPP:
+ msg = "Operation not supported on socket";
+ break;
#endif
#ifdef EPFNOSUPPORT
- case EPFNOSUPPORT:
- msg = "Protocol family not supported";
- break;
+ case EPFNOSUPPORT:
+ msg = "Protocol family not supported";
+ break;
#endif
#ifdef EAFNOSUPPORT
- case EAFNOSUPPORT:
- msg = "Address family not supported by protocol family";
- break;
+ case EAFNOSUPPORT:
+ msg = "Address family not supported by protocol family";
+ break;
#endif
#ifdef EADDRINUSE
- case EADDRINUSE:
- msg = "Address already in use";
- break;
+ case EADDRINUSE:
+ msg = "Address already in use";
+ break;
#endif
#ifdef EADDRNOTAVAIL
- case EADDRNOTAVAIL:
- msg = "Can\'t assign requested address";
- break;
+ case EADDRNOTAVAIL:
+ msg = "Can\'t assign requested address";
+ break;
#endif
#ifdef ETIMEDOUT
- case ETIMEDOUT:
- msg = "Connection timed out";
- break;
+ case ETIMEDOUT:
+ msg = "Connection timed out";
+ break;
#endif
#ifdef ECONNREFUSED
- case ECONNREFUSED:
- msg = "Connection refused";
- break;
+ case ECONNREFUSED:
+ msg = "Connection refused";
+ break;
#endif
- default:
- sprintf(buffer, "ErrorNr: %d", _intVal(errNr));
- msg = buffer;
- break;
+ default:
+ sprintf(buffer, "ErrorNr: %d", _intVal(errNr));
+ msg = buffer;
+ break;
}
}
RETURN (_MKSTRING(msg COMMA_CON));
@@ -2424,29 +2450,35 @@
executeCommand:aCommandString
"execute the unix command specified by the argument, aCommandString.
- Return true if successful, false otherwise. Smalltalk is suspended,
- while the command is executing."
+ Return true if successful, false otherwise.
+ Smalltalk is suspended, while the command is executing.
+ The return value of the system()-call is available in the variable
+ LastExecStatus (which is zero after successful execution); this value
+ consists of the reason for termination (0=normal) in the upper 8bits and,
+ iff it was a normal return, the value passed to exit() in the low 8bits."
%{ /* NOCONTEXT */
int status;
- extern OBJ ErrorNumber;
if (__isString(aCommandString)) {
status = system((char *) _stringVal(aCommandString));
+ OperatingSystem_LastExecStatus = _MKSMALLINT(status);
if (status == 0) {
RETURN ( true );
}
- ErrorNumber = _MKSMALLINT(errno);
RETURN ( false );
}
%}
.
self primitiveFailed
- "OperatingSystem executeCommand:'pwd'"
- "OperatingSystem executeCommand:'ls -l'"
- "OperatingSystem executeCommand:'invalidCommand'"
+ "
+ OperatingSystem executeCommand:'pwd'. OperatingSystem lastExecStatus printNL.
+ OperatingSystem executeCommand:'ls -l'. OperatingSystem lastExecStatus printNL.
+ OperatingSystem executeCommand:'invalidCommand'. (OperatingSystem lastExecStatus printStringRadix:16) printNL.
+ OperatingSystem executeCommand:'rm /tmp/foofoofoofoo'. (OperatingSystem lastExecStatus printStringRadix:16) printNL.
+ "
! !
!OperatingSystem class methodsFor:'file access'!
@@ -2651,13 +2683,11 @@
%{ /* NOCONTEXT */
- extern OBJ ErrorNumber;
-
if (__isString(aPathName)) {
if (access(_stringVal(aPathName), R_OK) == 0) {
RETURN ( true );
}
- ErrorNumber = _MKSMALLINT(errno);
+ OperatingSystem_LastErrorNumber = _MKSMALLINT(errno);
RETURN ( false );
}
%}
@@ -2670,13 +2700,11 @@
%{ /* NOCONTEXT */
- extern OBJ ErrorNumber;
-
if (__isString(aPathName)) {
if (access(_stringVal(aPathName), W_OK) == 0) {
RETURN ( true );
}
- ErrorNumber = _MKSMALLINT(errno);
+ OperatingSystem_LastErrorNumber = _MKSMALLINT(errno);
RETURN ( false );
}
%}
@@ -2689,13 +2717,11 @@
%{ /* NOCONTEXT */
- extern OBJ ErrorNumber;
-
if (__isString(aPathName)) {
if (access(_stringVal(aPathName), X_OK) == 0) {
RETURN ( true );
}
- ErrorNumber = _MKSMALLINT(errno);
+ OperatingSystem_LastErrorNumber = _MKSMALLINT(errno);
RETURN ( false );
}
%}
@@ -2722,7 +2748,7 @@
ret = stat((char *) _stringVal(aPathName), &buf);
} while (ret < 0 && errno == EINTR);
if (ret < 0) {
- ErrorNumber = _MKSMALLINT(errno);
+ OperatingSystem_LastErrorNumber = _MKSMALLINT(errno);
RETURN ( nil );
}
switch (buf.st_mode & S_IFMT) {
@@ -2808,7 +2834,7 @@
ret = stat((char *) _stringVal(aPathName), &buf);
} while (ret < 0 && errno == EINTR);
if (ret < 0) {
- ErrorNumber = _MKSMALLINT(errno);
+ OperatingSystem_LastErrorNumber = _MKSMALLINT(errno);
RETURN ( nil );
}
RETURN ( _MKSMALLINT(buf.st_mode & 0777) );
@@ -2854,7 +2880,7 @@
timeLow = _MKSMALLINT(buf.st_mtime & 0xFFFF);
timeHi = _MKSMALLINT((buf.st_mtime >> 16) & 0xFFFF);
}
- ErrorNumber = _MKSMALLINT(errno);
+ OperatingSystem_LastErrorNumber = _MKSMALLINT(errno);
}
%}
.
@@ -2882,7 +2908,7 @@
timeLow = _MKSMALLINT(buf.st_atime & 0xFFFF);
timeHi = _MKSMALLINT((buf.st_atime >> 16) & 0xFFFF);
}
- ErrorNumber = _MKSMALLINT(errno);
+ OperatingSystem_LastErrorNumber = _MKSMALLINT(errno);
}
%}
.
@@ -2914,7 +2940,7 @@
if (ret >= 0) {
RETURN (_MKSMALLINT(buf.st_ino));
}
- ErrorNumber = _MKSMALLINT(errno);
+ OperatingSystem_LastErrorNumber = _MKSMALLINT(errno);
}
%}
.
@@ -2943,7 +2969,7 @@
ret = stat((char *) _stringVal(aPathName), &buf);
} while (ret < 0 && errno == EINTR);
if (ret < 0) {
- ErrorNumber = _MKSMALLINT(errno);
+ OperatingSystem_LastErrorNumber = _MKSMALLINT(errno);
RETURN ( nil );
}
switch (buf.st_mode & S_IFMT) {