--- a/TwoByteString.st Fri Feb 25 14:05:47 1994 +0100
+++ b/TwoByteString.st Fri Feb 25 14:07:09 1994 +0100
@@ -10,7 +10,7 @@
hereby transferred.
"
-ArrayedCollection variableWordSubclass:#TwoByteString
+AbstractString subclass:#TwoByteString
instanceVariableNames:''
classVariableNames:''
poolDictionaries:''
@@ -25,7 +25,7 @@
TwoByteStrings are like strings, but storing 16bits per character.
The integration of them into the system is not completed ....
-$Header: /cvs/stx/stx/libbasic/TwoByteString.st,v 1.4 1994-01-08 16:29:16 claus Exp $
+$Header: /cvs/stx/stx/libbasic/TwoByteString.st,v 1.5 1994-02-25 13:06:57 claus Exp $
'!
!TwoByteString class methodsFor:'instance creation'!
@@ -33,29 +33,39 @@
basicNew:anInteger
"return a new empty string with anInteger characters"
- ^ super basicNew:anInteger atAllPut:(Character space asciiValue)
+ ^ (super basicNew:(anInteger*2)) atAllPut:(Character space)
! !
+!TwoByteString methodsFor:'queries'!
+
+basicSize
+ "return the size of the receiver.
+ (i.e. the number of characters in this String)"
+
+ ^ super basicSize // 2
+! !
+
!TwoByteString methodsFor:'accessing'!
basicAt:index
"return the character at position index, an Integer
- reimplemented here since we return characters"
- ^ Character value:(super basicAt:index)
+ |val i|
+
+ i := (index * 2) - 1.
+ val := (super basicAt:i) + ((super basicAt:(i+1)) * 256).
+ ^ Character value:val
!
basicAt:index put:aCharacter
"store the argument, aCharacter at position index, an Integer
- reimplemented here since we store characters"
- super basicAt:index put:(aCharacter asciiValue)
+ |val i|
+ val := aCharacter asciiValue.
+ i := (index * 2) - 1.
+ super basicAt:i put:(val bitAnd:16rFF).
+ super basicAt:(i+1) put:(val // 256).
+ ^ aCharacter
! !
-
-!TwoByteString methodsFor:'converting'!
-
-asString
- "return myself - I am a string"
-
- ^ self
-! !
--- a/UIBytes.st Fri Feb 25 14:05:47 1994 +0100
+++ b/UIBytes.st Fri Feb 25 14:07:09 1994 +0100
@@ -24,7 +24,7 @@
this class has been added for ST-80 compatibility.
-$Header: /cvs/stx/stx/libbasic/Attic/UIBytes.st,v 1.3 1993-10-13 00:18:47 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Attic/UIBytes.st,v 1.4 1994-02-25 13:06:59 claus Exp $
'!
!UninterpretedBytes class methodsFor:'queries'!
@@ -51,13 +51,3 @@
%}
"UninterpretedBytes isBigEndian"
! !
-
-!UninterpretedBytes methodsFor:'accessing'!
-
-byteAt:index
- ^ self basicAt:index
-!
-
-byteAt:index put:value
- ^ self basicAt:index put:value
-! !
--- a/UndefObj.st Fri Feb 25 14:05:47 1994 +0100
+++ b/UndefObj.st Fri Feb 25 14:07:09 1994 +0100
@@ -24,7 +24,7 @@
there is only one instance of this class: nil
-$Header: /cvs/stx/stx/libbasic/Attic/UndefObj.st,v 1.7 1994-02-05 12:27:47 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Attic/UndefObj.st,v 1.8 1994-02-25 13:07:01 claus Exp $
'!
!UndefinedObject class methodsFor:'instance creation'!
@@ -169,6 +169,20 @@
"return a string for storing myself"
^ 'nil'
+!
+
+printOn:aStream
+ "append a printed representation of the receiver to the
+ argument, aStream"
+
+ aStream nextPutAll:'nil'
+!
+
+storeOn:aStream
+ "append a printed representation of the receiver to the
+ argument, aStream, which allows reconstruction of it"
+
+ ^ self printOn:aStream
! !
!UndefinedObject methodsFor:'binary storage'!
--- a/UndefinedObject.st Fri Feb 25 14:05:47 1994 +0100
+++ b/UndefinedObject.st Fri Feb 25 14:07:09 1994 +0100
@@ -24,7 +24,7 @@
there is only one instance of this class: nil
-$Header: /cvs/stx/stx/libbasic/UndefinedObject.st,v 1.7 1994-02-05 12:27:47 claus Exp $
+$Header: /cvs/stx/stx/libbasic/UndefinedObject.st,v 1.8 1994-02-25 13:07:01 claus Exp $
'!
!UndefinedObject class methodsFor:'instance creation'!
@@ -169,6 +169,20 @@
"return a string for storing myself"
^ 'nil'
+!
+
+printOn:aStream
+ "append a printed representation of the receiver to the
+ argument, aStream"
+
+ aStream nextPutAll:'nil'
+!
+
+storeOn:aStream
+ "append a printed representation of the receiver to the
+ argument, aStream, which allows reconstruction of it"
+
+ ^ self printOn:aStream
! !
!UndefinedObject methodsFor:'binary storage'!
--- a/UninterpretedBytes.st Fri Feb 25 14:05:47 1994 +0100
+++ b/UninterpretedBytes.st Fri Feb 25 14:07:09 1994 +0100
@@ -24,7 +24,7 @@
this class has been added for ST-80 compatibility.
-$Header: /cvs/stx/stx/libbasic/UninterpretedBytes.st,v 1.3 1993-10-13 00:18:47 claus Exp $
+$Header: /cvs/stx/stx/libbasic/UninterpretedBytes.st,v 1.4 1994-02-25 13:06:59 claus Exp $
'!
!UninterpretedBytes class methodsFor:'queries'!
@@ -51,13 +51,3 @@
%}
"UninterpretedBytes isBigEndian"
! !
-
-!UninterpretedBytes methodsFor:'accessing'!
-
-byteAt:index
- ^ self basicAt:index
-!
-
-byteAt:index put:value
- ^ self basicAt:index put:value
-! !
--- a/Unix.st Fri Feb 25 14:05:47 1994 +0100
+++ b/Unix.st Fri Feb 25 14:07:09 1994 +0100
@@ -22,7 +22,7 @@
COPYRIGHT (c) 1988 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/Attic/Unix.st,v 1.11 1994-02-05 12:27:58 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Attic/Unix.st,v 1.12 1994-02-25 13:07:02 claus Exp $
written 1988 by claus
'!
@@ -139,7 +139,7 @@
char *env;
- if (_isString(aString)) {
+ if (__isString(aString)) {
env = (char *)getenv(_stringVal(aString));
if (env) {
RETURN ( _MKSTRING(env COMMA_CON) );
@@ -633,22 +633,82 @@
^ msg
! !
-!OperatingSystem class methodsFor:'interrupts'!
+!OperatingSystem class methodsFor:'interrupts & signals'!
+
+nameForSignal:aSignalNumber
+ "for a given Unix signalnumber, return a descriptive string"
+ ^ #('hangup' "SIGHUP" "terminal hangup"
+ 'interrupt' "SIGINT" "user (^C) interrupt"
+ 'quit' "SIGQUIT" "user quit interrupt"
+ 'illegal instruction' "SIGILL" "should not happen"
+ 'trap' "SIGTRAP" "should not happen"
+ 'iot trap' "SIGIOT" "old PDP-11 leftover .."
+ 'emt trap' "SIGEMT" "old PDP-11 leftover .."
+ 'fp exception' "SIGFP" "floating pnt error"
+ 'kill' "SIGKILL" "cannot be cought"
+ 'bus error' "SIGBUS" "usually bug in ST/X"
+ 'segmentation violation' "SIGSEGV" "usually bug in ST/X"
+ 'bad system call' "SIGSYS" "should not happen"
+ 'broken pipe' "SIGPIPE" "no reader on pipe"
+ 'alarm timer' "SIGALRM" "timer expired"
+ 'termination' "SIGTERM" "soft termination signal"
+ 'urgent' "SIGURG" "urgent io condition"
+ 'stop' "SIGSTOP" "stop signal"
+ 'tty stop' "SIGTSTP" "stop signal from terminal"
+ 'continue' "SIGCONT" "continue after stop"
+ 'child death' "SIGCHLD" "death of a child process"
+ 'background input' "SIGTTIN" "input of a bg process"
+ 'background output' "SIGTTOU" "output of a bg process"
+ 'io available' "SIGIO" "i/o possible"
+ 'cpu time expired' "SIGXCPU" "running for too long"
+ 'file size limit' "SIGXFSZ" "file size limit reached"
+ 'vt alarm timer' "SIGVTALRM" "virtual timer"
+ 'profiling timer' "SIGPROF" "profiling timer"
+ 'winsize changed' "SIGWINCH" "terminal window size changed"
+ 'resource lost' "SIGLOST" "resource (lock) lost"
+ 'user signal 1' "SIGUSR1" "user defined signal 1"
+ 'user signal 2' "SIGUSR2" "user defined signal 2"
+ ) at:aSignalNumber ifAbsent:['unknown signal']
+!
+
blockInterrupts
- "needed, for proper semaphore handling"
+ "disable interrupt processing - pending interrupts will
+ be handled when reenabled by unblockInterrupts.
+ Needed, for proper semaphore/process handling."
%{
BLOCKINTERRUPTS();
%}
!
unblockInterrupts
- "needed, for proper semaphore handling"
+ "enable interrupt processing - if any interrupts are pending,
+ these will be handled immediately.
+ Needed, for proper semaphore/process handling"
%{
UNBLOCKINTERRUPTS();
%}
!
+disableSignal:signalNumber
+ "disable signal processing for signalNumber.
+ WARNING: for some signals, it is no good idea to disable
+ them; for example, disabling the interrupt signal turns off ^C
+ handling.
+ Use only for fully debugged stand alone applications."
+
+%{ /* NOCONTEXT */
+ extern void userInterrupt();
+
+ if (_isSmallInteger(signalNumber)) {
+ signal(_intVal(signalNumber), SIG_IGN);
+ RETURN (self);
+ }
+%}
+.
+ self primitiveFailed
+!
+
enableUserInterrupts
"enable userInterrupt (^C) handling;
after enabling, ^C will send the message 'userInterrupt'
@@ -658,7 +718,30 @@
extern void userInterrupt();
signal(SIGINT, userInterrupt);
- /* signal(SIGQUIT, userInterrupt); */
+%}
+!
+
+enableQuitInterrupts
+ "enable quitInterrupt (usually ^\) handling, and make it a userinterrupt"
+
+%{ /* NOCONTEXT */
+ extern void userInterrupt();
+
+ signal(SIGQUIT, userInterrupt);
+%}
+!
+
+disableUserInterrupts
+ "disable userInterrupt processing;
+ after disabling, no ^C processing takes place.
+ Use this only for debugged stand-alone applications, since
+ no exit to the debugger is possible with user interrupts disabled.
+ Be WARNED."
+
+%{ /* NOCONTEXT */
+ extern void userInterrupt();
+
+ signal(SIGINT, SIG_IGN);
%}
!
@@ -757,13 +840,16 @@
extern void signalChildInterrupt();
#ifdef SIGCHLD
- signal(SIGCHLD, signalChildInterrupt);
- RETURN(true);
+# define CHILD_SIGNAL SIGCHLD
#else
# ifdef SIGCLD
- signal(SIGCLD, signalChildInterrupt);
+# define CHILD_SIGNAL SIGCLD
+# endif
+#endif
+
+#ifdef CHILD_SIGNAL
+ signal(CHILD_SIGNAL, signalChildInterrupt);
RETURN(true);
-# endif
#endif
%}
.
@@ -771,8 +857,11 @@
!
startSpyTimer
- "trigger a spyInterrupt, to be signalled after some (short) time.
- This is used by MessageTally for profiling."
+ "trigger a spyInterrupt, to be signalled after some short (virtual) time.
+ This is used by MessageTally for profiling.
+ Should be changed to use real profiling timer if available.
+ On systems, where no virtual timer is abailable, use the real timer
+ (which is of course less correct)"
%{ /* NOCONTEXT */
@@ -825,7 +914,7 @@
!
enableTimer:millis
- "trigger a timerInterrupt, to be signalled after some time."
+ "trigger a timerInterrupt, to be signalled after some (real) time."
%{ /* NOCONTEXT */
@@ -876,10 +965,11 @@
getTimeLow
"return low 16 bits of current time.
- Obsolete: Dont use this method, use getTimeParts below.
+
+ OBSOLETE: Dont use this method, use getTimeParts below.
This method will not always return the correct time
- if used together with getTimeHi.
- (a wrap between the two getTimeXXX calls could occur)"
+ if used together with getTimeHi, since a wrap between
+ the two getTimeXXX sends could occur."
%{ /* NOCONTEXT */
@@ -893,10 +983,11 @@
getTimeHi
"return hi 16 bits of current time.
- Obsolete: Dont use this method, use getTimeParts below.
+
+ OBSOLETE: Dont use this method, use getTimeParts below.
This method will NOT always return the correct time
- if used together with getTimeHi.
- (a wrap between the two getTimeXXX calls could occur)"
+ if used together with getTimeHi, since a wrap between
+ the two getTimeXXX sends could occur."
%{ /* NOCONTEXT */
@@ -908,9 +999,35 @@
"OperatingSystem getTimeHi"
!
+getTimeParts
+ "return the current time as an array of 2 integers representing
+ the current time (usually low 16bits / hi 16 bits) in some OS
+ dependent way.
+
+ On unix, the values represent the seconds since 1970, on other
+ systems this may be different.
+ - for portability never use these values directly, but pass them
+ to 'computeDatePartsOf:', which knows how to interpret them."
+
+ |low hi|
+%{
+ int now;
+
+ now = time(0);
+ hi = _MKSMALLINT((now >> 16) & 0xFFFF);
+ low = _MKSMALLINT(now & 0xFFFF);
+%}
+.
+ ^ Array with:low with:hi
+
+ "OperatingSystem getTimeParts"
+!
+
getTimeInto:aBlock
"evaluate the argument aBlock, passing the time-parts of
- the current time as arguments."
+ the current time as arguments.
+ See comment in 'OperatingSystem>>getTimeParts' on what to
+ do with those parts."
|low hi|
%{
@@ -927,19 +1044,38 @@
!
getTime
- "return current Time (in seconds since 1970).
- This might return a LargeInteger some time."
+ "return current Time in some OS dependent representation.
+ (on unix, its the seconds since 1970).
- ^ self getTimeHi * 16r10000 + self getTimeLow
+ WARNING: this is OperatingSystem dependent - for portable code,
+ use getTimeParts and compute*PartsOf:and:for:"
+
+ OperatingSystem getTimeInto:[:low :hi | ^ hi*16r10000 + low]
"OperatingSystem getTime"
!
+computeDatePartsOf:timeParts for:aBlock
+ "compute year, month and day from the ostime in timeParts,
+ and evaluate the argument, a 3-arg block with these."
+
+ ^ self computeDatePartsOf:(timeParts at:1) and:(timeParts at:2) for:aBlock
+!
+
+computeTimePartsOf:timeParts for:aBlock
+ "compute hour, minute and seconds from the ostime in timeParts,
+ and evaluate the argument, a 3-arg block with these."
+
+ ^ self computeTimePartsOf:(timeParts at:1) and:(timeParts at:2) for:aBlock
+!
+
computeDatePartsOf:timeLow and:timeHi for:aBlock
"compute year, month and day from the time-parts timeLow and
timeHi and evaluate the argument, a 3-arg block with these.
- This method was added to avoid LargeInteger arithmetic; the time-parts
- are those returned by getTimeLow and getTimeHi."
+
+ This method was added to avoid LargeInteger arithmetic and to be
+ independent of how the OperatingSystem represents time;
+ the time-parts expected are those returned by getTimeParts."
|year month day|
@@ -963,7 +1099,11 @@
computeTimePartsOf:timeLow and:timeHi for:aBlock
"compute hours, minutes and seconds from the time-parts timeLow and
- timeHi and evaluate the argument, a 3-arg block with these."
+ timeHi and evaluate the argument, a 3-arg block with these.
+
+ This method was added to avoid LargeInteger arithmetic and to be
+ independent of how the OperatingSystem represents time;
+ the time-parts expected are those returned by getTimeParts."
|hours minutes seconds|
@@ -985,23 +1125,64 @@
aBlock value:hours value:minutes value:seconds
!
+computeTimeAndDateFrom:timeParts
+ "given an Array containing the OS-dependent time, return an Array
+ containing year, month, day, hour, minute and seconds"
+
+ |low hi year month day hours minutes seconds ret|
+
+ low := timeParts at:1.
+ hi := timeParts at:2.
+%{
+ struct tm *tmPtr;
+ long t;
+
+ if (_isSmallInteger(low)
+ && _isSmallInteger(hi)) {
+ t = (_intVal(hi) << 16) | _intVal(low);
+ tmPtr = localtime(&t);
+ hours = _MKSMALLINT(tmPtr->tm_hour);
+ minutes = _MKSMALLINT(tmPtr->tm_min);
+ seconds = _MKSMALLINT(tmPtr->tm_sec);
+
+ year = _MKSMALLINT(tmPtr->tm_year + 1900);
+ month = _MKSMALLINT(tmPtr->tm_mon + 1);
+ day = _MKSMALLINT(tmPtr->tm_mday);
+ }
+%}
+.
+ year notNil ifTrue:[
+ ret := Array new:6.
+ ret at:1 put:year.
+ ret at:2 put:month.
+ ret at:3 put:day.
+ ret at:4 put:hours.
+ ret at:5 put:minutes.
+ ret at:6 put:seconds.
+ ^ ret
+ ].
+ ^ self primitiveFailed
+!
+
getMillisecondTime
"since range is limited to 0..1ffffff and value is wrapping around
- at 1fffffff, this can only be used for relative time deltas.
- Use methods below to compare and add time deltas (should move to Time)"
+ in regular intervals, this can only be used for relative time deltas.
+ Use the methods below to compare and add time deltas.
+
+ This should be changed to return some instance of RelativeTIme,
+ abd these computations moved there."
%{ /* NOCONTEXT */
long t;
-#ifdef SYSV
-# ifdef HZ
+#if defined(SYSV) && defined(HZ)
/* sys5 time */
long ticks;
struct tms tb;
ticks = times(&tb);
t = (ticks * 1000) / HZ;
-# endif
+ RETURN ( _MKSMALLINT(t & 0x0FFFFFFF) );
#else
/* bsd time */
struct timeval tb;
@@ -1009,8 +1190,8 @@
gettimeofday(&tb, &tzb);
t = tb.tv_sec*1000 + tb.tv_usec/1000;
+ RETURN ( _MKSMALLINT(t & 0x0FFFFFFF) );
#endif
- RETURN ( _MKSMALLINT(t & 0x0FFFFFFF) );
%}
.
self error:'time not available'
@@ -1018,7 +1199,9 @@
millisecondTimeDeltaBetween:msTime1 and:msTime2
"subtract two millisecond times (such as returned getMillisecondTime).
- The returned value is msTime1 - msTime2 where a wrap occurs at:16r0FFFFFFF."
+ The returned value is msTime1 - msTime2 where a wrap occurs at:16r0FFFFFFF.
+
+ This should really be moved to some RelativeTime class."
(msTime1 > msTime2) ifTrue:[
^ msTime1 - msTime2
@@ -1029,7 +1212,9 @@
millisecondTime:msTime1 isAfter:msTime2
"return true if msTime1 is after msTime2, false if not.
handling wrap at 16r0FFFFFFF. The two arguments are
- millisecond times (such as returned getMillisecondTime)."
+ millisecond times (such as returned getMillisecondTime).
+
+ This should really be moved to some RelativeTime class."
(msTime1 > msTime2) ifTrue:[
((msTime1 - msTime2) > 16r08000000) ifTrue:[
@@ -1045,7 +1230,9 @@
millisecondTimeAdd:msTime1 and:msTime2
"add two millisecond times (such as returned getMillisecondTime).
- The returned value is msTime1 + msTime2 where a wrap occurs at:16r0FFFFFFF."
+ The returned value is msTime1 + msTime2 where a wrap occurs at:16r0FFFFFFF.
+
+ This should really be moved to some RelativeTime class."
|sum|
@@ -1291,11 +1478,11 @@
int nargs, i;
OBJ arg;
- if (_isString(aPath) && _isArray(argArray)) {
+ if (__isString(aPath) && __isArray(argArray)) {
nargs = _arraySize(argArray);
for (i=0; i < nargs; i++) {
arg = _ArrayInstPtr(argArray)->a_element[i];
- if (_isString(arg)) {
+ if (__isString(arg)) {
argv[i] = (char *) _stringVal(arg);
}
}
@@ -1319,7 +1506,7 @@
int status;
extern OBJ ErrorNumber;
- if (_isString(aCommandString)) {
+ if (__isString(aCommandString)) {
status = system((char *) _stringVal(aCommandString));
if (status == 0) {
RETURN ( true );
@@ -1402,7 +1589,7 @@
].
(aPathString startsWith:sepString) ifFalse:[
(aPathString endsWith:sepString) ifTrue:[
- ^ aPathString copyFrom:1 to:(aPathString size - 1)
+ ^ aPathString copyTo:(aPathString size - 1)
].
].
last := 1.
@@ -1410,7 +1597,7 @@
index := aPathString indexOf:sep startingAt:(last + 1).
index == 0 ifTrue:[
(last == 1) ifTrue:[^ sepString].
- ^ aPathString copyFrom:1 to:(last - 1)
+ ^ aPathString copyTo:(last - 1)
].
last := index.
]
@@ -1430,7 +1617,7 @@
int ret;
extern errno;
- if (_isString(aPathName)) {
+ if (__isString(aPathName)) {
do {
ret = stat((char *) _stringVal(aPathName), &buf);
} while (ret < 0 && errno == EINTR);
@@ -1451,7 +1638,7 @@
int ret;
extern errno;
- if (_isString(aPathName)) {
+ if (__isString(aPathName)) {
do {
ret = stat((char *) _stringVal(aPathName), &buf);
} while (ret < 0 && errno == EINTR);
@@ -1472,7 +1659,7 @@
extern OBJ ErrorNumber;
- if (_isString(aPathName)) {
+ if (__isString(aPathName)) {
if (access(_stringVal(aPathName), R_OK) == 0) {
RETURN ( true );
}
@@ -1491,7 +1678,7 @@
extern OBJ ErrorNumber;
- if (_isString(aPathName)) {
+ if (__isString(aPathName)) {
if (access(_stringVal(aPathName), W_OK) == 0) {
RETURN ( true );
}
@@ -1510,7 +1697,7 @@
extern OBJ ErrorNumber;
- if (_isString(aPathName)) {
+ if (__isString(aPathName)) {
if (access(_stringVal(aPathName), X_OK) == 0) {
RETURN ( true );
}
@@ -1545,7 +1732,7 @@
int ret;
extern errno;
- if (_isString(aPathName)) {
+ if (__isString(aPathName)) {
do {
ret = stat((char *) _stringVal(aPathName), &buf);
} while (ret < 0 && errno == EINTR);
@@ -1631,7 +1818,7 @@
int ret;
extern errno;
- if (_isString(aPathName)) {
+ if (__isString(aPathName)) {
do {
ret = stat((char *) _stringVal(aPathName), &buf);
} while (ret < 0 && errno == EINTR);
@@ -1655,7 +1842,7 @@
%{ /* NOCONTEXT */
- if (_isString(aPathName) && _isSmallInteger(modeBits)) {
+ if (__isString(aPathName) && _isSmallInteger(modeBits)) {
RETURN ( (chmod((char *) _stringVal(aPathName), _intVal(modeBits) ) < 0) ?
false : true );
}
@@ -1674,7 +1861,7 @@
extern errno;
time_t mtime;
- if (_isString(aPathName)) {
+ if (__isString(aPathName)) {
do {
ret = stat((char *) _stringVal(aPathName), &buf);
} while (ret < 0 && errno == EINTR);
@@ -1702,7 +1889,7 @@
int ret;
extern errno;
- if (_isString(aPathName)) {
+ if (__isString(aPathName)) {
do {
ret = stat((char *) _stringVal(aPathName), &buf);
} while (ret < 0 && errno == EINTR);
@@ -1735,7 +1922,7 @@
int ret;
extern errno;
- if (_isString(aPathName)) {
+ if (__isString(aPathName)) {
do {
ret = stat((char *) _stringVal(aPathName), &buf);
} while (ret < 0 && errno == EINTR);
@@ -1766,7 +1953,7 @@
int ret;
extern errno;
- if (_isString(aPathName)) {
+ if (__isString(aPathName)) {
do {
ret = stat((char *) _stringVal(aPathName), &buf);
} while (ret < 0 && errno == EINTR);
@@ -1839,7 +2026,7 @@
%{ /* NOCONTEXT */
- if (_isString(fullPathName)) {
+ if (__isString(fullPathName)) {
RETURN ( (unlink((char *) _stringVal(fullPathName)) >= 0) ? true : false );
}
%}
@@ -1853,7 +2040,7 @@
%{ /* NOCONTEXT */
- if (_isString(fullPathName)) {
+ if (__isString(fullPathName)) {
RETURN ( (rmdir((char *) _stringVal(fullPathName)) >= 0) ? true : false );
}
%}
@@ -1868,13 +2055,13 @@
^ self executeCommand:('rm -rf ' , fullPathName)
!
-link:oldPath to:newPath
+linkFile:oldPath to:newPath
"link the file 'oldPath' to 'newPath'. The link will be a hard link.
Return true if successful, false if not."
%{ /* NOCONTEXT */
- if (_isString(oldPath) && _isString(newPath)) {
+ if (__isString(oldPath) && __isString(newPath)) {
RETURN ( (link((char *) _stringVal(oldPath), (char *) _stringVal(newPath)) >= 0) ?
true : false );
}
@@ -1882,16 +2069,16 @@
.
self primitiveFailed
- "OperatingSystem link:'foo' to:'bar'"
+ "OperatingSystem linkFile:'foo' to:'bar'"
!
-rename:oldPath to:newPath
+renameFile:oldPath to:newPath
"rename the file 'oldPath' to 'newPath'.
Return true if sucessfull, false if not"
%{ /* NOCONTEXT */
- if (_isString(oldPath) && _isString(newPath)) {
+ if (__isString(oldPath) && __isString(newPath)) {
#if defined(BSD)
if (rename((char *) _stringVal(oldPath), (char *) _stringVal(newPath)) >= 0) {
RETURN ( true );
@@ -1910,5 +2097,5 @@
.
self primitiveFailed
- "OperatingSystem rename:'foo' to:'bar'"
+ "OperatingSystem renameFile:'foo' to:'bar'"
! !
--- a/WeakIdDict.st Fri Feb 25 14:05:47 1994 +0100
+++ b/WeakIdDict.st Fri Feb 25 14:07:09 1994 +0100
@@ -22,7 +22,7 @@
COPYRIGHT (c) 1992 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/Attic/WeakIdDict.st,v 1.2 1993-11-08 02:32:38 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Attic/WeakIdDict.st,v 1.3 1994-02-25 13:07:07 claus Exp $
written dec 92 by claus
'!
@@ -34,7 +34,7 @@
this is a special class to support keeping track of dependents without
keeping the values alive - values simply become nil when no one else
references it. The original dependency mechanism used a regular Dictionary,
-which usually leads to a lot of garbage beeing kept due to a forgotten
+which usually leads to a lot of garbage being kept due to a forgotten
release. Using a WeakDictionary may be incompatible to ST-80 but is much
more comfortable.
"
--- a/WeakIdentityDictionary.st Fri Feb 25 14:05:47 1994 +0100
+++ b/WeakIdentityDictionary.st Fri Feb 25 14:07:09 1994 +0100
@@ -22,7 +22,7 @@
COPYRIGHT (c) 1992 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/WeakIdentityDictionary.st,v 1.2 1993-11-08 02:32:38 claus Exp $
+$Header: /cvs/stx/stx/libbasic/WeakIdentityDictionary.st,v 1.3 1994-02-25 13:07:07 claus Exp $
written dec 92 by claus
'!
@@ -34,7 +34,7 @@
this is a special class to support keeping track of dependents without
keeping the values alive - values simply become nil when no one else
references it. The original dependency mechanism used a regular Dictionary,
-which usually leads to a lot of garbage beeing kept due to a forgotten
+which usually leads to a lot of garbage being kept due to a forgotten
release. Using a WeakDictionary may be incompatible to ST-80 but is much
more comfortable.
"
--- a/WriteStr.st Fri Feb 25 14:05:47 1994 +0100
+++ b/WriteStr.st Fri Feb 25 14:07:09 1994 +0100
@@ -26,7 +26,7 @@
streamed-upon collection if it cannot grow. Thus its slightly incompatible to ST-80 since
aStream contents does not always return the original collection. This will change soon.
-$Header: /cvs/stx/stx/libbasic/Attic/WriteStr.st,v 1.5 1993-11-08 02:32:41 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Attic/WriteStr.st,v 1.6 1994-02-25 13:07:09 claus Exp $
'!
!WriteStream class methodsFor:'instance creation'!
@@ -72,7 +72,7 @@
(aNumber < collection size) ifTrue:[writeLimit := aNumber]
! !
-!WriteStream methodsFor:'reading/writing'!
+!WriteStream methodsFor:'reading'!
next
"catch read access to write stream - report an error"
@@ -84,11 +84,75 @@
"catch read access to write stream - report an error"
self shouldNotImplement
-!
+! !
+
+!WriteStream methodsFor:'writing'!
nextPut:anObject
"append the argument, anObject to the stream"
+%{ /* NOCONTEXT */
+
+#ifdef NOTDEF
+
+ REGISTER int pos;
+ unsigned ch;
+ OBJ coll;
+
+ coll = _INST(collection);
+ if (_isNonNilObject(coll)
+ && _isSmallInteger(_INST(position))) {
+
+ pos = _intVal(_INST(position));
+
+ if (_isSmallInteger(_INST(writeLimit))
+ && (pos <= _intVal(_INST(writeLimit)))
+ && (pos > 0)) {
+ OBJ cls;
+
+ cls = _qClass(coll);
+ if (cls == String) {
+ if (__isCharacter(anObject)
+ && (pos <= _stringSize(coll))) {
+ _StringInstPtr(coll)->s_element[pos-1] = _intVal(_characterVal(anObject));
+ _INST(position) = _MKSMALLINT(pos + 1);
+ if (_isSmallInteger(_INST(readLimit))
+ && (pos >= _intVal(_INST(readLimit)))) {
+ _INST(readLimit) = _MKSMALLINT(pos + 1);
+ }
+ RETURN ( anObject );
+ }
+ } else if (cls == ByteArray) {
+ if (_isSmallInteger(anObject)
+ && ((ch = _intVal(anObject)) >= 0)
+ && (ch <= 255)
+ && (pos <= _byteArraySize(coll))) {
+ _ByteArrayInstPtr(coll)->ba_element[pos-1] = ch;
+ _INST(position) = _MKSMALLINT(pos + 1);
+ if (_isSmallInteger(_INST(readLimit))
+ && (pos >= _intVal(_INST(readLimit)))) {
+ _INST(readLimit) = _MKSMALLINT(pos + 1);
+ }
+ RETURN ( anObject );
+ }
+ } else if (cls == Array) {
+ if (pos <= _arraySize(coll)) {
+ _ArrayInstPtr(coll)->a_element[pos-1] = anObject;
+ __STORE(coll, anObject);
+ _INST(position) = _MKSMALLINT(pos + 1);
+ if (_isSmallInteger(_INST(readLimit))
+ && (pos >= _intVal(_INST(readLimit)))) {
+ _INST(readLimit) = _MKSMALLINT(pos + 1);
+ }
+ RETURN ( anObject );
+ }
+ }
+ }
+ }
+#endif
+
+%}
+.
(position > collection size) ifTrue:[self growCollection].
collection at:position put:anObject.
(position > readLimit) ifTrue:[readLimit := position].
@@ -96,8 +160,28 @@
^anObject
!
+next:count put:anObject
+ "append anObject count times to the receiver.
+ Redefined to avoid count grows of the underlying collection -
+ instead a single grow on the final size is performed."
+
+ |nMore final|
+
+ final := position + count - 1.
+ (final > collection size) ifTrue:[
+ self growCollection:final
+ ].
+ collection atAll:(position to:final) put:anObject.
+
+ position := position + count.
+ (position > readLimit) ifTrue:[readLimit := position - 1].
+ ^ anObject
+!
+
nextPutAll:aCollection
- "append all elements of the argument, aCollection to the stream"
+ "append all elements of the argument, aCollection to the stream.
+ Redefined to avoid count grows of the underlying collection -
+ instead a single grow on the final size is performed."
|nMore final|
@@ -114,62 +198,23 @@
position := position + nMore.
(position > readLimit) ifTrue:[readLimit := position - 1].
^ aCollection
-!
-
-cr
- "append a carriage-return to the stream"
-
- self nextPut:(Character cr)
-!
-
-tab
- "append a tab-character to the stream"
-
- self nextPut:(Character tab)
-!
-
-crTab
- "append a carriage-return followed by a tab to the stream"
-
- self nextPut:(Character cr).
- self nextPut:(Character tab)
-!
-
-space
- "append a space character to the receiver-stream"
-
- self nextPut:(Character space)
-!
-
-spaces:count
- "append count space-characters to the receiver-stream"
-
- 1 to:count do:[:dummy |
- self nextPut:(Character space)
- ]
-!
-
-ff
- "append a form-feed (new-pagee) to the receiver-stream"
-
- self nextPut:(Character ff)
! !
!WriteStream methodsFor:'ignored'!
bold
- "ignore font change - this allows WriteStreams to be compatible
- to PrinterStreams"
+ "change font to bold - ignored here.
+ - this allows WriteStreams to be compatible to PrinterStreams"
!
italic
- "ignore font change - this allows WriteStreams to be compatible
- to PrinterStreams"
+ "change font to italic - ignored here.
+ - this allows WriteStreams to be compatible to PrinterStreams"
!
normal
- "ignore font change - this allows WriteStreams to be compatible
- to PrinterStreams"
+ "change font to normal - ignored here.
+ - this allows WriteStreams to be compatible to PrinterStreams"
! !
!WriteStream methodsFor:'private'!
--- a/WriteStream.st Fri Feb 25 14:05:47 1994 +0100
+++ b/WriteStream.st Fri Feb 25 14:07:09 1994 +0100
@@ -26,7 +26,7 @@
streamed-upon collection if it cannot grow. Thus its slightly incompatible to ST-80 since
aStream contents does not always return the original collection. This will change soon.
-$Header: /cvs/stx/stx/libbasic/WriteStream.st,v 1.5 1993-11-08 02:32:41 claus Exp $
+$Header: /cvs/stx/stx/libbasic/WriteStream.st,v 1.6 1994-02-25 13:07:09 claus Exp $
'!
!WriteStream class methodsFor:'instance creation'!
@@ -72,7 +72,7 @@
(aNumber < collection size) ifTrue:[writeLimit := aNumber]
! !
-!WriteStream methodsFor:'reading/writing'!
+!WriteStream methodsFor:'reading'!
next
"catch read access to write stream - report an error"
@@ -84,11 +84,75 @@
"catch read access to write stream - report an error"
self shouldNotImplement
-!
+! !
+
+!WriteStream methodsFor:'writing'!
nextPut:anObject
"append the argument, anObject to the stream"
+%{ /* NOCONTEXT */
+
+#ifdef NOTDEF
+
+ REGISTER int pos;
+ unsigned ch;
+ OBJ coll;
+
+ coll = _INST(collection);
+ if (_isNonNilObject(coll)
+ && _isSmallInteger(_INST(position))) {
+
+ pos = _intVal(_INST(position));
+
+ if (_isSmallInteger(_INST(writeLimit))
+ && (pos <= _intVal(_INST(writeLimit)))
+ && (pos > 0)) {
+ OBJ cls;
+
+ cls = _qClass(coll);
+ if (cls == String) {
+ if (__isCharacter(anObject)
+ && (pos <= _stringSize(coll))) {
+ _StringInstPtr(coll)->s_element[pos-1] = _intVal(_characterVal(anObject));
+ _INST(position) = _MKSMALLINT(pos + 1);
+ if (_isSmallInteger(_INST(readLimit))
+ && (pos >= _intVal(_INST(readLimit)))) {
+ _INST(readLimit) = _MKSMALLINT(pos + 1);
+ }
+ RETURN ( anObject );
+ }
+ } else if (cls == ByteArray) {
+ if (_isSmallInteger(anObject)
+ && ((ch = _intVal(anObject)) >= 0)
+ && (ch <= 255)
+ && (pos <= _byteArraySize(coll))) {
+ _ByteArrayInstPtr(coll)->ba_element[pos-1] = ch;
+ _INST(position) = _MKSMALLINT(pos + 1);
+ if (_isSmallInteger(_INST(readLimit))
+ && (pos >= _intVal(_INST(readLimit)))) {
+ _INST(readLimit) = _MKSMALLINT(pos + 1);
+ }
+ RETURN ( anObject );
+ }
+ } else if (cls == Array) {
+ if (pos <= _arraySize(coll)) {
+ _ArrayInstPtr(coll)->a_element[pos-1] = anObject;
+ __STORE(coll, anObject);
+ _INST(position) = _MKSMALLINT(pos + 1);
+ if (_isSmallInteger(_INST(readLimit))
+ && (pos >= _intVal(_INST(readLimit)))) {
+ _INST(readLimit) = _MKSMALLINT(pos + 1);
+ }
+ RETURN ( anObject );
+ }
+ }
+ }
+ }
+#endif
+
+%}
+.
(position > collection size) ifTrue:[self growCollection].
collection at:position put:anObject.
(position > readLimit) ifTrue:[readLimit := position].
@@ -96,8 +160,28 @@
^anObject
!
+next:count put:anObject
+ "append anObject count times to the receiver.
+ Redefined to avoid count grows of the underlying collection -
+ instead a single grow on the final size is performed."
+
+ |nMore final|
+
+ final := position + count - 1.
+ (final > collection size) ifTrue:[
+ self growCollection:final
+ ].
+ collection atAll:(position to:final) put:anObject.
+
+ position := position + count.
+ (position > readLimit) ifTrue:[readLimit := position - 1].
+ ^ anObject
+!
+
nextPutAll:aCollection
- "append all elements of the argument, aCollection to the stream"
+ "append all elements of the argument, aCollection to the stream.
+ Redefined to avoid count grows of the underlying collection -
+ instead a single grow on the final size is performed."
|nMore final|
@@ -114,62 +198,23 @@
position := position + nMore.
(position > readLimit) ifTrue:[readLimit := position - 1].
^ aCollection
-!
-
-cr
- "append a carriage-return to the stream"
-
- self nextPut:(Character cr)
-!
-
-tab
- "append a tab-character to the stream"
-
- self nextPut:(Character tab)
-!
-
-crTab
- "append a carriage-return followed by a tab to the stream"
-
- self nextPut:(Character cr).
- self nextPut:(Character tab)
-!
-
-space
- "append a space character to the receiver-stream"
-
- self nextPut:(Character space)
-!
-
-spaces:count
- "append count space-characters to the receiver-stream"
-
- 1 to:count do:[:dummy |
- self nextPut:(Character space)
- ]
-!
-
-ff
- "append a form-feed (new-pagee) to the receiver-stream"
-
- self nextPut:(Character ff)
! !
!WriteStream methodsFor:'ignored'!
bold
- "ignore font change - this allows WriteStreams to be compatible
- to PrinterStreams"
+ "change font to bold - ignored here.
+ - this allows WriteStreams to be compatible to PrinterStreams"
!
italic
- "ignore font change - this allows WriteStreams to be compatible
- to PrinterStreams"
+ "change font to italic - ignored here.
+ - this allows WriteStreams to be compatible to PrinterStreams"
!
normal
- "ignore font change - this allows WriteStreams to be compatible
- to PrinterStreams"
+ "change font to normal - ignored here.
+ - this allows WriteStreams to be compatible to PrinterStreams"
! !
!WriteStream methodsFor:'private'!