--- a/AbstractOperatingSystem.st Wed Jul 06 06:50:27 2016 +0200
+++ b/AbstractOperatingSystem.st Sat Jul 09 21:10:24 2016 +0100
@@ -2627,7 +2627,7 @@
are to be allowed - if false, they are not.
On some systems, all locks are non-exclusive locks.
- Returns true, if the lock was aquired, false otherwise.
+ Returns true, if the lock was acquired, false otherwise.
Notice, that not all OS's support these locks;
on some, this may simply be a no-op.
@@ -2688,7 +2688,7 @@
unlockFD:aFileDescriptor
"clear a file lock on the file represented by aFileDescriptor,
- which was previously aquired by #lockFD:.
+ which was previously acquired by #lockFD:.
Return false, if the unlock failed
(which may happens when a wrong fd is passed,
no lock was set previously, or the systsem does not support locks).
@@ -3917,13 +3917,13 @@
getNetworkMACAddresses
"return a dictionary with key:name of interface and
- value:the MAC adress for each interface"
+ value:the MAC address for each interface"
self subclassResponsibility
!
getNetworkMACAddressesForIf:ifName
- "return the MAC adress for interface ifName"
+ "return the MAC address for interface ifName"
^ self getNetworkMACAddresses at:ifName ifAbsent:nil
--- a/ArithmeticValue.st Wed Jul 06 06:50:27 2016 +0200
+++ b/ArithmeticValue.st Sat Jul 09 21:10:24 2016 +0100
@@ -140,11 +140,11 @@
initialize
"setup the signals"
- "/ notice that we now use class based exceptions;
+ "/ Notice that we now use class based exceptions;
"/ however, for backward compatibility, the class variables
"/ referring to those are kept for a while, for subclass compatibility.
"/ Please convert your code to access those via the Signal-constants class
- "/ messages (accesors) instead of referring to the class variables.
+ "/ messages (accessors) instead of referring to the class variables.
ArithmeticSignal := ArithmeticError.
DomainErrorSignal := DomainError.
--- a/Character.st Wed Jul 06 06:50:27 2016 +0200
+++ b/Character.st Sat Jul 09 21:10:24 2016 +0100
@@ -62,15 +62,15 @@
Always compare using #= if there is any chance of a non-ascii character being involved.
Once again (because beginners sometimes make this mistake):
- This means: you may compare characters using #== ONLY IFF you are certain,
- that the characters ranges is 0..255.
- Otherwise, you HAVE TO compare using #=. (if in doubt, always compare using #=).
- Sorry for this inconvenience, but it is (practically) impossible to keep
- the possible maximum of 2^32 characters (Unicode) around, for that convenience alone.
+ This means: you may compare characters using #== ONLY IFF you are certain,
+ that the characters ranges is 0..255.
+ Otherwise, you HAVE TO compare using #=. (if in doubt, always compare using #=).
+ Sorry for this inconvenience, but it is (practically) impossible to keep
+ the possible maximum of 2^32 characters (Unicode) around, for that convenience alone.
In ST/X, N is (currently) 1024. This means that all the latin characters and some others are
kept as singleton in the CharacterTable class variable (which is also used by the VM when characters
- are instanciated).
+ are instantiated).
Methods marked as (JS) come from the manchester Character goody
(CharacterComparing) by Jan Steinman, which allow Characters to be used as
@@ -79,7 +79,7 @@
Some of these have been modified a bit.
WARNING: characters are known by compiler and runtime system -
- do not change the instance layout.
+ do not change the instance layout.
Also, although you can create subclasses of Character, the compiler always
creates instances of Character for literals ...
@@ -88,43 +88,43 @@
Therefore, it may not make sense to create a character-subclass.
Case Mapping in Unicode:
- There are a number of complications to case mappings that occur once the repertoire
- of characters is expanded beyond ASCII.
-
- * Because of the inclusion of certain composite characters for compatibility,
- such as U+01F1 'DZ' capital dz, there is a third case, called titlecase,
- which is used where the first letter of a word is to be capitalized
- (e.g. Titlecase, vs. UPPERCASE, or lowercase).
- For example, the title case of the example character is U+01F2 'Dz' capital d with small z.
-
- * Case mappings may produce strings of different length than the original.
- For example, the German character U+00DF small letter sharp s expands when uppercased to
- the sequence of two characters 'SS'.
- This also occurs where there is no precomposed character corresponding to a case mapping.
- *** This is not yet implemented (in 5.2) ***
-
- * Characters may also have different case mappings, depending on the context.
- For example, U+03A3 capital sigma lowercases to U+03C3 small sigma if it is not followed
- by another letter, but lowercases to 03C2 small final sigma if it is.
- *** This is not yet implemented (in 5.2) ***
-
- * Characters may have case mappings that depend on the locale.
- For example, in Turkish the letter 0049 'I' capital letter i lowercases to 0131 small dotless i.
- *** This is not yet implemented (in 5.2) ***
-
- * Case mappings are not, in general, reversible.
- For example, once the string 'McGowan' has been uppercased, lowercased or titlecased,
- the original cannot be recovered by applying another uppercase, lowercase, or titlecase operation.
+ There are a number of complications to case mappings that occur once the repertoire
+ of characters is expanded beyond ASCII.
+
+ * Because of the inclusion of certain composite characters for compatibility,
+ such as U+01F1 'DZ' capital dz, there is a third case, called titlecase,
+ which is used where the first letter of a word is to be capitalized
+ (e.g. Titlecase, vs. UPPERCASE, or lowercase).
+ For example, the title case of the example character is U+01F2 'Dz' capital d with small z.
+
+ * Case mappings may produce strings of different length than the original.
+ For example, the German character U+00DF small letter sharp s expands when uppercased to
+ the sequence of two characters 'SS'.
+ This also occurs where there is no precomposed character corresponding to a case mapping.
+ *** This is not yet implemented (in 5.2) ***
+
+ * Characters may also have different case mappings, depending on the context.
+ For example, U+03A3 capital sigma lowercases to U+03C3 small sigma if it is not followed
+ by another letter, but lowercases to 03C2 small final sigma if it is.
+ *** This is not yet implemented (in 5.2) ***
+
+ * Characters may have case mappings that depend on the locale.
+ For example, in Turkish the letter 0049 'I' capital letter i lowercases to 0131 small dotless i.
+ *** This is not yet implemented (in 5.2) ***
+
+ * Case mappings are not, in general, reversible.
+ For example, once the string 'McGowan' has been uppercased, lowercased or titlecased,
+ the original cannot be recovered by applying another uppercase, lowercase, or titlecase operation.
Collation Sequence:
- *** This is not yet implemented (in 5.2) ***
+ *** This is not yet implemented (in 5.2) ***
[author:]
- Claus Gittinger
+ Claus Gittinger
[see also:]
- String TwoByteString Unicode16String Unicode32String
- StringCollection Text
+ String TwoByteString Unicode16String Unicode32String
+ StringCollection Text
"
! !
@@ -601,6 +601,7 @@
"
! !
+
!Character methodsFor:'Compatibility-Dolphin'!
isAlphaNumeric
@@ -648,6 +649,8 @@
or:[ (asciivalue == 247 ) ]]]]]
! !
+
+
!Character methodsFor:'accessing'!
codePoint
@@ -994,9 +997,7 @@
// comon ascii stuff first
if (__codePoint < 0x80) {
if ((__codePoint >= 'A') && (__codePoint <= 'Z')) {
- unsigned newCodePoint;
-
- newCodePoint = __codePoint - 'A' + 'a';
+ unsigned int newCodePoint = __codePoint - 'A' + 'a';
RETURN (__MKCHARACTER(newCodePoint)) ;
}
RETURN (self);
--- a/Class.st Wed Jul 06 06:50:27 2016 +0200
+++ b/Class.st Sat Jul 09 21:10:24 2016 +0100
@@ -1,3 +1,5 @@
+"{ Encoding: utf8 }"
+
"
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
@@ -2099,7 +2101,6 @@
"Created: / 18-07-2011 / 09:14:38 / cg"
! !
-
!Class methodsFor:'adding & removing'!
removeFromSystem
@@ -5404,7 +5405,7 @@
set (for whatever reason)
(ii) do NOT ask source code manager during system startup - source code
managers are not configured anyway!! Also, avoids hangups during
- startup when CVSROOT is set but server is unreacheable.
+ startup when CVSROOT is set, but server is unreacheable.
CAVEAT: When somebody modifies the code after compilation and methods
are recompiled during startup (for whatever reason), a bad code may
used, compilation may fail. However, it may happen anyway as SCM's
@@ -5416,15 +5417,15 @@
or:[Smalltalk isInitialized not
or: [(sourceCodeManager := self sourceCodeManagerFromBinaryRevision) isNil]])
ifTrue:[
- sourceStream := self localSourceStreamFor:source.
+ sourceStream := self localSourceStreamFor:source.
].
sourceStream isNil ifTrue:[
"/ mhmh - still no source file.
- "/ If there is a SourceCodeManager, ask it to aquire the
- "/ the source for my class, and return an open stream on it.
- "/ if that one does not know about the source, look in
- "/ standard places
+ "/ If there is a SourceCodeManager, ask it to acquire the
+ "/ source for my class and return an open stream on it.
+ "/ If that one does not know about the source, look in
+ "/ standard places.
sourceCodeManager notNil ifTrue:[
classFilename ~= source ifTrue:[
--- a/Exception.st Wed Jul 06 06:50:27 2016 +0200
+++ b/Exception.st Sat Jul 09 21:10:24 2016 +0100
@@ -11,6 +11,8 @@
"
"{ Package: 'stx:libbasic' }"
+"{ NameSpace: Smalltalk }"
+
GenericException subclass:#Exception
instanceVariableNames:''
classVariableNames:''
@@ -53,15 +55,16 @@
Error
Warning
UserNotification
- Notifcation
+ Notification
Signal
"
! !
+
!Exception class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Exception.st,v 1.82 2003/10/07 13:25:24 stefan Exp $'
+ ^ '$Header$'
!
--- a/ExternalFunctionCallback.st Wed Jul 06 06:50:27 2016 +0200
+++ b/ExternalFunctionCallback.st Sat Jul 09 21:10:24 2016 +0100
@@ -11,6 +11,8 @@
"
"{ Package: 'stx:libbasic' }"
+"{ NameSpace: Smalltalk }"
+
ExternalFunction subclass:#ExternalFunctionCallback
instanceVariableNames:'returnType argumentTypes flags action'
classVariableNames:'CallBackRegistry'
@@ -272,18 +274,18 @@
Then, the code is generated with:
cb generateClosure.
- After that, the callBack-functions address can be aquired with:
+ After that, the callBack-functions address can be acquired with:
cb address. 'can be passed to C'.
and handed out to C. (you can also hand out the callBack directly - as it is a subclass of
ExternalBytes.
The actual action of the callback can be changed (at any time later) with:
- cb action:[:args | Transcript showCR:args. true].
+ cb action:[:args | Transcript showCR:args. true].
Eventually, the callback MUST be released:
- cb release.
+ cb release.
[author:]
- Claus Gittinger
+ Claus Gittinger
"
!
@@ -846,10 +848,10 @@
!ExternalFunctionCallback class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/ExternalFunctionCallback.st,v 1.22 2013-02-05 16:00:13 stefan Exp $'
+ ^ '$Header$'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/ExternalFunctionCallback.st,v 1.22 2013-02-05 16:00:13 stefan Exp $'
+ ^ '$Header$'
! !
--- a/ExternalStream.st Wed Jul 06 06:50:27 2016 +0200
+++ b/ExternalStream.st Sat Jul 09 21:10:24 2016 +0100
@@ -1990,45 +1990,22 @@
In text-mode, a collection of strings, each representing one line,
is returned."
- |text l chunks sizes chunk byteCount cnt bytes offset|
+ |text|
binary ifTrue:[
- "adding to a ByteArray produces quadratic time-space
- behavior - therefore we allocate chunks, and concatenate them
- at the end."
-
- chunks := OrderedCollection new.
- sizes := OrderedCollection new.
- byteCount := 0.
- [self atEnd] whileFalse:[
- chunk := ByteArray uninitializedNew:4096.
- cnt := self nextBytes:(chunk size) into:chunk.
- cnt notNil ifTrue:[
- chunks add:chunk.
- sizes add:cnt.
- byteCount := byteCount + cnt
- ]
- ].
-
- "now, create one big ByteArray"
- bytes := ByteArray uninitializedNew:byteCount.
- offset := 1.
- 1 to:chunks size do:[:index |
- chunk := chunks at:index.
- cnt := sizes at:index.
- bytes replaceFrom:offset to:(offset + cnt - 1) with:chunk.
- offset := offset + cnt
- ].
- ^ bytes
+ ^ self upToEnd.
].
+ "/ text mode
text := StringCollection new.
[self atEnd] whileFalse:[
- l := self nextLine.
- l isNil ifTrue:[
- ^ text
- ].
- text add:l
+ |line|
+
+ line := self nextLine.
+ line isNil ifTrue:[
+ ^ text
+ ].
+ text add:line
].
^ text
!
@@ -2037,16 +2014,13 @@
"to compensate for the bad naming, use this to make things explicit.
See also #contents, which returns the lines as stringCollection for textFiles."
- ^ self contentsOfEntireFile
+ ^ self upToEnd
!
contentsOfEntireFile
"ST-80 compatibility: return contents as a String (or byteArray, if in binary mode).
See also #contents, which returns the lines as stringCollection for text files."
- binary ifTrue:[
- ^ self contents.
- ].
^ self upToEnd
"Modified: / 3.7.1996 / 13:22:16 / stefan"
@@ -2236,12 +2210,12 @@
!ExternalStream methodsFor:'closing'!
close
- "close the stream.
- No error of the stream is not open."
+ "Close the stream.
+ No error if the stream is not open."
self isOpen ifTrue:[
- self unregisterForFinalization.
- self closeFile.
+ self unregisterForFinalization.
+ self closeFile.
].
!
@@ -3462,11 +3436,13 @@
!ExternalStream methodsFor:'non homogenous reading'!
next:count into:aCollection startingAt:start
+ "return the next count bytes or characters from the stream."
+
|readCount|
readCount := self nextBytes:count into:aCollection startingAt:start.
readCount = count ifTrue:[
- ^ aCollection.
+ ^ aCollection.
].
^ aCollection copyFrom:1 to:start+readCount-1.
!
@@ -3479,21 +3455,17 @@
|buffer n|
- binary ifTrue:[
- buffer := ByteArray uninitializedNew:count
- ] ifFalse:[
- buffer := String uninitializedNew:count
- ].
+ buffer := self contentsSpecies uninitializedNew:count.
n := self nextAvailableBytes:count into:buffer startingAt:1.
n == 0 ifTrue:[
- binary ifTrue:[
- ^ #[]
- ].
- ^ ''
+ binary ifTrue:[
+ ^ #[]
+ ].
+ ^ ''
].
n ~~ count ifTrue:[
- ^ buffer copyTo:n
+ ^ buffer copyTo:n
].
^ buffer.
@@ -3551,99 +3523,99 @@
|| (__INST(handleType) == @symbol(socketFilePointer))
|| (__INST(handleType) == @symbol(socketHandle))
|| (__INST(handleType) == @symbol(pipeFilePointer))) {
- if (((fp = __INST(handle)) != nil)
- && (__INST(mode) != @symbol(writeonly))
- && __bothSmallInteger(count, start)
- ) {
- f = __FILEVal(fp);
-
- cnt = __intVal(count);
- offs = __intVal(start) - 1;
-
- if (__isExternalBytesLike(anObject)) {
- OBJ sz;
-
- nInstBytes = 0;
- extPtr = (char *)(__externalBytesAddress(anObject));
- if (extPtr == NULL) goto bad;
- sz = __externalBytesSize(anObject);
- if (__isSmallInteger(sz)) {
- objSize = __intVal(sz);
- } else {
- objSize = 0; /* unknown */
- }
- } else {
- OBJ oClass = __Class(anObject);
- int nInstVars = __intVal(__ClassInstPtr(oClass)->c_ninstvars);
-
- nInstBytes = OHDR_SIZE + __OBJS2BYTES__(nInstVars);
-
- switch (__intVal(__ClassInstPtr(oClass)->c_flags) & ARRAYMASK) {
- case BYTEARRAY:
- case WORDARRAY:
- case LONGARRAY:
- case SWORDARRAY:
- case SLONGARRAY:
- case FLOATARRAY:
- break;
- case DOUBLEARRAY:
+ if (((fp = __INST(handle)) != nil)
+ && (__INST(mode) != @symbol(writeonly))
+ && __bothSmallInteger(count, start)
+ ) {
+ f = __FILEVal(fp);
+
+ cnt = __intVal(count);
+ offs = __intVal(start) - 1;
+
+ if (__isExternalBytesLike(anObject)) {
+ OBJ sz;
+
+ nInstBytes = 0;
+ extPtr = (char *)(__externalBytesAddress(anObject));
+ if (extPtr == NULL) goto bad;
+ sz = __externalBytesSize(anObject);
+ if (__isSmallInteger(sz)) {
+ objSize = __intVal(sz);
+ } else {
+ objSize = 0; /* unknown */
+ }
+ } else {
+ OBJ oClass = __Class(anObject);
+ int nInstVars = __intVal(__ClassInstPtr(oClass)->c_ninstvars);
+
+ nInstBytes = OHDR_SIZE + __OBJS2BYTES__(nInstVars);
+
+ switch (__intVal(__ClassInstPtr(oClass)->c_flags) & ARRAYMASK) {
+ case BYTEARRAY:
+ case WORDARRAY:
+ case LONGARRAY:
+ case SWORDARRAY:
+ case SLONGARRAY:
+ case FLOATARRAY:
+ break;
+ case DOUBLEARRAY:
#ifdef __NEED_DOUBLE_ALIGN
- nInstBytes = (nInstBytes-1+__DOUBLE_ALIGN) &~ (__DOUBLE_ALIGN-1);
+ nInstBytes = (nInstBytes-1+__DOUBLE_ALIGN) &~ (__DOUBLE_ALIGN-1);
#endif
- break;
- case LONGLONGARRAY:
- case SLONGLONGARRAY:
+ break;
+ case LONGLONGARRAY:
+ case SLONGLONGARRAY:
#ifdef __NEED_LONGLONG_ALIGN
- nInstBytes = (nInstBytes-1+__LONGLONG_ALIGN) &~ (__LONGLONG_ALIGN-1);
+ nInstBytes = (nInstBytes-1+__LONGLONG_ALIGN) &~ (__LONGLONG_ALIGN-1);
#endif
- break;
- default:
- goto bad;
- }
- extPtr = (char *)0;
- objSize = __Size(anObject) - nInstBytes;
- }
-
- if ((offs >= 0) && (cnt >= 0) && (objSize >= (cnt + offs))) {
- _buffered = (__INST(buffered) == true);
- if (_buffered) {
- __READING__(f);
- }
-
- if (extPtr) {
- __READAVAILBYTES__(ret, f, extPtr+offs, cnt, _buffered, __INST(handleType));
- } else {
- /*
- * on interrupt, anObject may be moved to another location.
- * So we pass (char *)__InstPtr(anObject) + nInstBytes + offs to the macro __READ_BYTES__,
- * to get a new address.
- */
- offs += nInstBytes;
- __READAVAILBYTES_OBJ__(ret, f, anObject, offs, cnt, _buffered, __INST(handleType));
- }
- /* 0 is NOT an EOF condition here ... */
- if (ret >= 0) {
- if (__isSmallInteger(__INST(position))) {
- INT np = __intVal(__INST(position)) + ret;
- OBJ t;
-
- t = __MKINT(np); __INST(position) = t; __STORE(self, t);
- } else {
- __INST(position) = nil; /* i.e. do not know */
- }
- RETURN (__mkSmallInteger(ret));
- }
- __INST(position) = nil;
- error = __mkSmallInteger(__threadErrno);
- }
- }
+ break;
+ default:
+ goto bad;
+ }
+ extPtr = (char *)0;
+ objSize = __Size(anObject) - nInstBytes;
+ }
+
+ if ((offs >= 0) && (cnt >= 0) && (objSize >= (cnt + offs))) {
+ _buffered = (__INST(buffered) == true);
+ if (_buffered) {
+ __READING__(f);
+ }
+
+ if (extPtr) {
+ __READAVAILBYTES__(ret, f, extPtr+offs, cnt, _buffered, __INST(handleType));
+ } else {
+ /*
+ * on interrupt, anObject may be moved to another location.
+ * So we pass (char *)__InstPtr(anObject) + nInstBytes + offs to the macro __READ_BYTES__,
+ * to get a new address.
+ */
+ offs += nInstBytes;
+ __READAVAILBYTES_OBJ__(ret, f, anObject, offs, cnt, _buffered, __INST(handleType));
+ }
+ /* 0 is NOT an EOF condition here ... */
+ if (ret >= 0) {
+ if (__isSmallInteger(__INST(position))) {
+ INT np = __intVal(__INST(position)) + ret;
+ OBJ t;
+
+ t = __MKINT(np); __INST(position) = t; __STORE(self, t);
+ } else {
+ __INST(position) = nil; /* i.e. do not know */
+ }
+ RETURN (__mkSmallInteger(ret));
+ }
+ __INST(position) = nil;
+ error = __mkSmallInteger(__threadErrno);
+ }
+ }
}
bad: ;
%}.
- (hitEOF and:[self pastEndRead isNil]) ifTrue:[^ 0].
+ hitEOF ifTrue:[^ 0].
error notNil ifTrue:[
- lastErrorNumber := error.
- ^ self readError:error
+ lastErrorNumber := error.
+ ^ self readError:error
].
handle isNil ifTrue:[^ self errorNotOpen].
(mode == #writeonly) ifTrue:[^ self errorWriteOnly].
@@ -3764,98 +3736,98 @@
|| (__INST(handleType) == @symbol(socketFilePointer))
|| (__INST(handleType) == @symbol(socketHandle))
|| (__INST(handleType) == @symbol(pipeFilePointer))) {
- if (((fp = __INST(handle)) != nil)
- && (__INST(mode) != @symbol(writeonly))
- && __bothSmallInteger(count, start)
- ) {
- f = __FILEVal(fp);
-
- cnt = __intVal(count);
- offs = __intVal(start) - 1;
-
- if (__isExternalBytesLike(anObject)) {
- OBJ sz;
-
- nInstBytes = 0;
- extPtr = (char *)(__externalBytesAddress(anObject));
- if (extPtr == NULL) goto bad;
- sz = __externalBytesSize(anObject);
- if (__isSmallInteger(sz)) {
- objSize = __intVal(sz);
- } else {
- objSize = 0; /* unknown */
- }
- } else {
- OBJ oClass = __Class(anObject);
- int nInstVars = __intVal(__ClassInstPtr(oClass)->c_ninstvars);
-
- nInstBytes = OHDR_SIZE + __OBJS2BYTES__(nInstVars);
- switch (__intVal(__ClassInstPtr(oClass)->c_flags) & ARRAYMASK) {
- case BYTEARRAY:
- case WORDARRAY:
- case LONGARRAY:
- case SWORDARRAY:
- case SLONGARRAY:
- case FLOATARRAY:
- break;
- case DOUBLEARRAY:
+ if (((fp = __INST(handle)) != nil)
+ && (__INST(mode) != @symbol(writeonly))
+ && __bothSmallInteger(count, start)
+ ) {
+ f = __FILEVal(fp);
+
+ cnt = __intVal(count);
+ offs = __intVal(start) - 1;
+
+ if (__isExternalBytesLike(anObject)) {
+ OBJ sz;
+
+ nInstBytes = 0;
+ extPtr = (char *)(__externalBytesAddress(anObject));
+ if (extPtr == NULL) goto bad;
+ sz = __externalBytesSize(anObject);
+ if (__isSmallInteger(sz)) {
+ objSize = __intVal(sz);
+ } else {
+ objSize = 0; /* unknown */
+ }
+ } else {
+ OBJ oClass = __Class(anObject);
+ int nInstVars = __intVal(__ClassInstPtr(oClass)->c_ninstvars);
+
+ nInstBytes = OHDR_SIZE + __OBJS2BYTES__(nInstVars);
+ switch (__intVal(__ClassInstPtr(oClass)->c_flags) & ARRAYMASK) {
+ case BYTEARRAY:
+ case WORDARRAY:
+ case LONGARRAY:
+ case SWORDARRAY:
+ case SLONGARRAY:
+ case FLOATARRAY:
+ break;
+ case DOUBLEARRAY:
#ifdef __NEED_DOUBLE_ALIGN
- nInstBytes = (nInstBytes-1+__DOUBLE_ALIGN) &~ (__DOUBLE_ALIGN-1);
+ nInstBytes = (nInstBytes-1+__DOUBLE_ALIGN) &~ (__DOUBLE_ALIGN-1);
#endif
- break;
- case LONGLONGARRAY:
- case SLONGLONGARRAY:
+ break;
+ case LONGLONGARRAY:
+ case SLONGLONGARRAY:
#ifdef __NEED_LONGLONG_ALIGN
- nInstBytes = (nInstBytes-1+__LONGLONG_ALIGN) &~ (__LONGLONG_ALIGN-1);
+ nInstBytes = (nInstBytes-1+__LONGLONG_ALIGN) &~ (__LONGLONG_ALIGN-1);
#endif
- break;
- default:
- goto bad;
- }
- extPtr = (char *)0;
- objSize = __Size(anObject) - nInstBytes;
- }
- if ((offs >= 0) && (cnt >= 0) && (objSize >= (cnt + offs))) {
- _buffered = (__INST(buffered) == true);
- if (_buffered) {
- __READING__(f);
- }
-
- if (extPtr) {
- __READBYTES__(ret, f, extPtr+offs, cnt, _buffered, __INST(handleType));
- } else {
- /*
- * on interrupt, anObject may be moved to another location.
- * So we pass anObject, and the offset to the __READBYTES_OBJ__ macro.
- */
- offs += nInstBytes;
- __READBYTES_OBJ__(ret, f, anObject, offs, cnt, _buffered, __INST(handleType));
- }
-
- if (ret > 0) {
- if (__isSmallInteger(__INST(position))) {
- INT np = __intVal(__INST(position)) + ret;
- OBJ t = __MKINT(np); __INST(position) = t; __STORE(self, t);
- } else {
- __INST(position) = nil; /* i.e. do not know */
- }
- RETURN (__mkSmallInteger(ret));
- }
- if (ret == 0) {
- __INST(hitEOF) = true;
- } else /* ret < 0 */ {
- __INST(position) = nil;
- error = __mkSmallInteger(__threadErrno);
- }
- }
- }
+ break;
+ default:
+ goto bad;
+ }
+ extPtr = (char *)0;
+ objSize = __Size(anObject) - nInstBytes;
+ }
+ if ((offs >= 0) && (cnt >= 0) && (objSize >= (cnt + offs))) {
+ _buffered = (__INST(buffered) == true);
+ if (_buffered) {
+ __READING__(f);
+ }
+
+ if (extPtr) {
+ __READBYTES__(ret, f, extPtr+offs, cnt, _buffered, __INST(handleType));
+ } else {
+ /*
+ * on interrupt, anObject may be moved to another location.
+ * So we pass anObject, and the offset to the __READBYTES_OBJ__ macro.
+ */
+ offs += nInstBytes;
+ __READBYTES_OBJ__(ret, f, anObject, offs, cnt, _buffered, __INST(handleType));
+ }
+
+ if (ret > 0) {
+ if (__isSmallInteger(__INST(position))) {
+ INT np = __intVal(__INST(position)) + ret;
+ OBJ t = __MKINT(np); __INST(position) = t; __STORE(self, t);
+ } else {
+ __INST(position) = nil; /* i.e. do not know */
+ }
+ RETURN (__mkSmallInteger(ret));
+ }
+ if (ret == 0) {
+ __INST(hitEOF) = true;
+ } else /* ret < 0 */ {
+ __INST(position) = nil;
+ error = __mkSmallInteger(__threadErrno);
+ }
+ }
+ }
}
bad: ;
%}.
- (hitEOF and:[self pastEndRead isNil]) ifTrue:[^ 0].
+ hitEOF ifTrue:[^ 0].
error notNil ifTrue:[
- lastErrorNumber := error.
- ^ self readError:error
+ lastErrorNumber := error.
+ ^ self readError:error
].
handle isNil ifTrue:[^ self errorNotOpen].
(mode == #writeonly) ifTrue:[^ self errorWriteOnly].
@@ -4198,15 +4170,15 @@
nextWord
<resource: #obsolete>
"in text-mode:
- read the alphaNumeric next word (i.e. up to non letter-or-digit).
- return a string containing those characters.
+ read the alphaNumeric next word (i.e. up to non letter-or-digit).
+ return a string containing those characters.
in binary-mode:
- read two bytes (msb-first) and return the value as a 16-bit
- unsigned Integer (for compatibility with other smalltalks)"
+ read two bytes (msb-first) and return the value as a 16-bit
+ unsigned Integer (for compatibility with other smalltalks)"
binary ifTrue:[
- self obsoleteMethodWarning:'use #nextUnsignedShortMSB:true'.
- ^ self nextUnsignedInt16MSB:true
+ self obsoleteMethodWarning:'use #nextUnsignedInt16MSB:true'.
+ ^ self nextUnsignedInt16MSB:true
].
self obsoleteMethodWarning:'use #nextAlphaNumericWord'.
^ self nextAlphaNumericWord
@@ -4634,6 +4606,30 @@
badArg: ;
%}.
self nextPutInt32:anInteger MSB:(UninterpretedBytes isBigEndian)
+!
+
+nextPutUtf16:aCharacter
+ "append my UTF-16 MSB representation to the argument, aStream.
+ UTF-16 can encode only characters with code points between 0 to 16r10FFFF."
+
+ self nextPutUtf16Bytes:aCharacter MSB:true
+
+ "
+ (FileStream newTemporary
+ nextPutUtf16:$B;
+ nextPutUtf16:$;
+ nextPutUtf16:(Character codePoint:16r10CCCC);
+ reset;
+ binary;
+ contents)
+ "
+!
+
+nextPutUtf16:aCharacter MSB:msbFlag
+ "append my UTF-16 MSB representation to the argument, aStream.
+ UTF-16 can encode only characters with code points between 0 to 16r10FFFF."
+
+ self nextPutUtf16Bytes:aCharacter MSB:msbFlag
! !
!ExternalStream methodsFor:'positioning'!
@@ -4965,6 +4961,7 @@
!
setFileDescriptor:anInteger mode:openMode
+ <resource: #obsolete>
"set the handle based upon a given fileDescriptor -
notice: this one is based on the underlying OSs fileDescriptor -
this may not be available on all platforms (i.e. non unix systems)."
@@ -5237,18 +5234,13 @@
|coll nRead|
- binary ifTrue:[
- coll := ByteArray uninitializedNew:count
- ] ifFalse:[
- coll := String new:count
- ].
+ coll := self contentsSpecies uninitializedNew:count.
nRead := self nextBytes:count into:coll startingAt:1.
- "/ for readStream protocol compatibility,
- "/ we must raise an exception here.
-
- nRead < count ifTrue:[
- ^ self pastEndRead
+ nRead ~~ count ifTrue:[
+ "/ for readStream protocol compatibility,
+ "/ we must raise an exception here.
+ ^ self pastEndRead
].
^ coll
@@ -5487,30 +5479,56 @@
upToEnd
"return a collection of the elements up-to the end.
- Return nil if the stream-end is reached before."
-
- |answerStream buffer count|
-
- buffer := self contentsSpecies new:4096.
+ Return an empty collection, if the stream-end is already at the end."
+
+ |chunkSize chunks sizes byteCount data offset|
+
+ "adding to a ByteArray produces quadratic time-space
+ behavior - therefore we allocate chunks, and concatenate them
+ at the end."
+
+ chunkSize := 4096.
+ byteCount := 0.
[self atEnd] whileFalse:[
- count := self nextAvailableBytes:4096 into:buffer startingAt:1.
- count ~~ 0 ifTrue:[
- answerStream isNil ifTrue:[
- answerStream := WriteStream with:buffer.
- answerStream position:count.
- buffer := self contentsSpecies new:4096.
- ] ifFalse:[
- answerStream nextPutAll:buffer startingAt:1 to:count.
- ].
- ].
+ |chunk cnt|
+
+ chunk := self contentsSpecies uninitializedNew:chunkSize.
+ cnt := self nextBytes:chunkSize into:chunk startingAt:1.
+ cnt ~~ 0 ifTrue:[
+ chunks isNil ifTrue:[
+ (cnt < chunkSize and:[self atEnd]) ifTrue:[
+ "all data is in a single chunk, so we are done"
+ ^ chunk copyFrom:1 to:cnt.
+ ].
+ chunks := OrderedCollection new.
+ sizes := OrderedCollection new.
+ ].
+ chunks add:chunk.
+ sizes add:cnt.
+ byteCount := byteCount + cnt
+ ]
].
- answerStream isNil ifTrue:[^ self contentsSpecies new].
- ^ answerStream contents
+
+ "now, create one big array"
+ data := self contentsSpecies uninitializedNew:byteCount.
+ offset := 1.
+ 1 to:chunks size do:[:index |
+ |chunk cnt|
+
+ chunk := chunks at:index.
+ cnt := sizes at:index.
+ data replaceFrom:offset to:(offset + cnt - 1) with:chunk startingAt:1.
+ offset := offset + cnt
+ ].
+ ^ data
+
"
- ('smalltalk.rc' asFilename readStream upToEnd)
- =
- ('smalltalk.rc' asFilename readStream contentsOfEntireFile)
+ '/dev/null' asFilename readStream upToEnd
+ '/proc/self/stat' asFilename readStream upToEnd
+
+ self assert:('smalltalk.rc' asFilename readStream upToEnd size)
+ = ('smalltalk.rc' asFilename readStream size)
"
! !
@@ -5719,6 +5737,27 @@
^ OperatingSystem supportsSelect
!
+numAvailableForRead
+ "answer the nuber of bytes available for reading"
+
+ |available|
+
+ handle isNil ifTrue:[
+ ^ self errorNotOpen
+ ].
+ mode == #writeonly ifTrue:[
+ ^ self errorWriteOnly
+ ].
+ available := OperatingSystem numAvailableForReadOn:self fileDescriptor.
+ readAhead notNil ifTrue:[
+ available := available + 1
+ ].
+ ^ available.
+
+ "
+ '/etc/hosts' asFilename readStream bytesAvailable"
+!
+
readWaitWithTimeoutMs:timeoutOrNil
"suspend the current process, until the receiver
becomes ready for reading or a timeout (in milliseconds) expired.
@@ -5736,22 +5775,31 @@
fd := self fileDescriptor.
(OperatingSystem readCheck:fd) ifTrue:[^ false].
+ "cannot do a readWait (which means possible suspend),
+ if the processor is not yet initialized; i.e. if a read is attempted
+ during early startup.
+ This may happen, for example, if a MiniDebugger is entered, before
+ process scheduling has been setup.
+ In this case, all I/O operations here will be blocking."
+
+ Smalltalk isInitialized ifFalse:[ ^ false ].
+
wasBlocked := OperatingSystem blockInterrupts.
inputSema := Semaphore new name:'readWait'.
[
- timeoutOrNil notNil ifTrue:[
- Processor signal:inputSema afterMilliseconds:timeoutOrNil.
- ].
- Processor signal:inputSema onInput:fd.
- Processor activeProcess state:#ioWait.
- inputSema wait.
- hasTimedout := timeoutOrNil notNil and:[(OperatingSystem readCheck:fd) not].
+ timeoutOrNil notNil ifTrue:[
+ Processor signal:inputSema afterMilliseconds:timeoutOrNil.
+ ].
+ Processor signal:inputSema onInput:fd.
+ Processor activeProcess state:#ioWait.
+ inputSema wait.
+ hasTimedout := timeoutOrNil notNil and:[(OperatingSystem readCheck:fd) not].
] ifCurtailed:[
- Processor disableSemaphore:inputSema.
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+ Processor disableSemaphore:inputSema.
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
].
timeoutOrNil notNil ifTrue:[
- Processor disableSemaphore:inputSema.
+ Processor disableSemaphore:inputSema.
].
wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
^ hasTimedout
@@ -6697,64 +6745,6 @@
self nextPutUtf8:aCharacter.
!
-nextPutUtf16:aCharacter
- "append my UTF-16 MSB representation to the argument, aStream.
- UTF-16 can encode only characters with code points between 0 to 16r10FFFF."
-
- self nextPutUtf16:aCharacter MSB:true
-
- "
- (FileStream newTemporary
- nextPutUtf16:$B;
- nextPutUtf16:$;
- nextPutUtf16:(Character codePoint:16r10CCCC);
- reset;
- binary;
- contents)
- "
-!
-
-nextPutUtf16:aCharacter MSB:msb
- "append my UTF-16 representation to the argument, aStream.
- UTF-16 can encode only characters with code points between 0 to 16r10FFFF."
-
- |codePoint|
-
- codePoint := aCharacter codePoint.
- (codePoint <= 16rD7FF
- or:[codePoint >= 16rE000 and:[codePoint <= 16rFFFF]]) ifTrue:[
- self nextPutInt16:codePoint MSB:msb.
- ] ifFalse:[codePoint <= 16r10FFFF ifTrue:[
- |highBits lowBits|
-
- codePoint := codePoint - 16r100000.
- highBits := codePoint bitShift:-10.
- lowBits := codePoint bitAnd:16r3FF.
- self nextPutInt16:highBits+16rD800 MSB:msb.
- self nextPutInt16:lowBits+16rDC00 MSB:msb.
- ] ifFalse:[
- EncodingError raiseWith:aCharacter errorString:'Character cannot be encoded as UTF-16'.
- ]].
-
- "
- (FileStream newTemporary
- nextPutUtf16:$B MSB:true;
- nextPutUtf16:$ MSB:true;
- nextPutUtf16:(Character codePoint:16r10CCCC) MSB:true;
- reset;
- binary;
- contents)
-
- (FileStream newTemporary
- nextPutUtf16:$B MSB:false;
- nextPutUtf16:$ MSB:false;
- nextPutUtf16:(Character codePoint:16r10CCCC) MSB:false;
- reset;
- binary;
- contents)
- "
-!
-
old_nextPut:aCharacter
"write the argument, aCharacter - return nil if failed, self if ok.
Only single-byte characters are currently supported"
--- a/FileStream.st Wed Jul 06 06:50:27 2016 +0200
+++ b/FileStream.st Sat Jul 09 21:10:24 2016 +0100
@@ -1363,369 +1363,369 @@
int pass = 0;
if (!__isNonNilObject(encodedPathName)
- || !(__isStringLike(openmode) || __isArrayLike(openmode)))
- goto badArgument;
+ || !(__isStringLike(openmode) || __isArrayLike(openmode)))
+ goto badArgument;
retry:
#ifdef __VMS__
if (__isStringLike(encodedPathName)) {
- do {
- /*
- * allow passing additional RMS arguments.
- * stupid: DEC does not seem to offer an interface for passing a char **.
- */
- __threadErrno = 0;
+ do {
+ /*
+ * allow passing additional RMS arguments.
+ * stupid: DEC does not seem to offer an interface for passing a char **.
+ */
+ __threadErrno = 0;
- {
- if (__isArray(attributeSpec)) {
- OBJ *ap = __ArrayInstPtr(attributeSpec)->a_element;
- int numAttrib = 0;
- int i;
+ {
+ if (__isArray(attributeSpec)) {
+ OBJ *ap = __ArrayInstPtr(attributeSpec)->a_element;
+ int numAttrib = 0;
+ int i;
- numAttrib = __arraySize(attributeSpec);
- for (i=0; i<numAttrib;i++) {
- if (! __isStringLike(ap[i])) {
- __threadErrno = EINVAL; /* invalid argument */
- goto getOutOfHere;
- }
- }
- switch (numAttrib) {
- case 0:
- __BEGIN_INTERRUPTABLE__
- f = fopen((char *)__stringVal(pathName), (char *)__stringVal(openmode));
- __END_INTERRUPTABLE__
- break;
- case 1:
- __BEGIN_INTERRUPTABLE__
- f = fopen((char *)__stringVal(pathName), (char *)__stringVal(openmode),
- __stringVal(ap[0]));
- __END_INTERRUPTABLE__
- break;
- case 2:
- __BEGIN_INTERRUPTABLE__
- f = fopen((char *)__stringVal(pathName), (char *)__stringVal(openmode),
- __stringVal(ap[0]), __stringVal(ap[1]));
- __END_INTERRUPTABLE__
- break;
- case 3:
- __BEGIN_INTERRUPTABLE__
- f = fopen((char *)__stringVal(pathName), (char *)__stringVal(openmode),
- __stringVal(ap[0]), __stringVal(ap[1]), __stringVal(ap[2]));
- __END_INTERRUPTABLE__
- break;
- case 4:
- __BEGIN_INTERRUPTABLE__
- f = fopen((char *)__stringVal(pathName), (char *)__stringVal(openmode),
- __stringVal(ap[0]), __stringVal(ap[1]), __stringVal(ap[2]),
- __stringVal(ap[3]));
- __END_INTERRUPTABLE__
- break;
- case 5:
- __BEGIN_INTERRUPTABLE__
- f = fopen((char *)__stringVal(pathName), (char *)__stringVal(openmode),
- __stringVal(ap[0]), __stringVal(ap[1]), __stringVal(ap[2]),
- __stringVal(ap[3]), __stringVal(ap[4]));
- __END_INTERRUPTABLE__
- break;
- case 6:
- __BEGIN_INTERRUPTABLE__
- f = fopen((char *)__stringVal(pathName), (char *)__stringVal(openmode),
- __stringVal(ap[0]), __stringVal(ap[1]), __stringVal(ap[2]),
- __stringVal(ap[3]), __stringVal(ap[4]), __stringVal(ap[5]));
- __END_INTERRUPTABLE__
- break;
- case 7:
- __BEGIN_INTERRUPTABLE__
- f = fopen((char *)__stringVal(pathName), (char *)__stringVal(openmode),
- __stringVal(ap[0]), __stringVal(ap[1]), __stringVal(ap[2]),
- __stringVal(ap[3]), __stringVal(ap[4]), __stringVal(ap[5]),
- __stringVal(ap[6]));
- __END_INTERRUPTABLE__
- break;
- case 8:
- __BEGIN_INTERRUPTABLE__
- f = fopen((char *)__stringVal(pathName), (char *)__stringVal(openmode),
- __stringVal(ap[0]), __stringVal(ap[1]), __stringVal(ap[2]),
- __stringVal(ap[3]), __stringVal(ap[4]), __stringVal(ap[5]),
- __stringVal(ap[6]), __stringVal(ap[7]));
- __END_INTERRUPTABLE__
- break;
- case 9:
- __BEGIN_INTERRUPTABLE__
- f = fopen((char *)__stringVal(pathName), (char *)__stringVal(openmode),
- __stringVal(ap[0]), __stringVal(ap[1]), __stringVal(ap[2]),
- __stringVal(ap[3]), __stringVal(ap[4]), __stringVal(ap[5]),
- __stringVal(ap[6]), __stringVal(ap[7]), __stringVal(ap[8]));
- __END_INTERRUPTABLE__
- break;
- case 10:
- __BEGIN_INTERRUPTABLE__
- f = fopen((char *)__stringVal(pathName), (char *)__stringVal(openmode),
- __stringVal(ap[0]), __stringVal(ap[1]), __stringVal(ap[2]),
- __stringVal(ap[3]), __stringVal(ap[4]), __stringVal(ap[5]),
- __stringVal(ap[6]), __stringVal(ap[7]), __stringVal(ap[8]),
- __stringVal(ap[9]));
- __END_INTERRUPTABLE__
- break;
- default:
- __threadErrno = E2BIG; /* too many args */
- goto getOutOfHere;
- }
- } else if (attributeSpec != nil) {
- __threadErrno = EINVAL; /* invalid argument */
- goto getOutOfHere;
- } else {
- /*
- * create file as sequential streamLF by default.
- */
- __BEGIN_INTERRUPTABLE__
- f = fopen((char *)__stringVal(pathName), (char *)__stringVal(openmode), "rfm=stmlf");
- __END_INTERRUPTABLE__
- }
- }
- } while ((f == NULL) && (__threadErrno == EINTR));
+ numAttrib = __arraySize(attributeSpec);
+ for (i=0; i<numAttrib;i++) {
+ if (! __isStringLike(ap[i])) {
+ __threadErrno = EINVAL; /* invalid argument */
+ goto getOutOfHere;
+ }
+ }
+ switch (numAttrib) {
+ case 0:
+ __BEGIN_INTERRUPTABLE__
+ f = fopen((char *)__stringVal(pathName), (char *)__stringVal(openmode));
+ __END_INTERRUPTABLE__
+ break;
+ case 1:
+ __BEGIN_INTERRUPTABLE__
+ f = fopen((char *)__stringVal(pathName), (char *)__stringVal(openmode),
+ __stringVal(ap[0]));
+ __END_INTERRUPTABLE__
+ break;
+ case 2:
+ __BEGIN_INTERRUPTABLE__
+ f = fopen((char *)__stringVal(pathName), (char *)__stringVal(openmode),
+ __stringVal(ap[0]), __stringVal(ap[1]));
+ __END_INTERRUPTABLE__
+ break;
+ case 3:
+ __BEGIN_INTERRUPTABLE__
+ f = fopen((char *)__stringVal(pathName), (char *)__stringVal(openmode),
+ __stringVal(ap[0]), __stringVal(ap[1]), __stringVal(ap[2]));
+ __END_INTERRUPTABLE__
+ break;
+ case 4:
+ __BEGIN_INTERRUPTABLE__
+ f = fopen((char *)__stringVal(pathName), (char *)__stringVal(openmode),
+ __stringVal(ap[0]), __stringVal(ap[1]), __stringVal(ap[2]),
+ __stringVal(ap[3]));
+ __END_INTERRUPTABLE__
+ break;
+ case 5:
+ __BEGIN_INTERRUPTABLE__
+ f = fopen((char *)__stringVal(pathName), (char *)__stringVal(openmode),
+ __stringVal(ap[0]), __stringVal(ap[1]), __stringVal(ap[2]),
+ __stringVal(ap[3]), __stringVal(ap[4]));
+ __END_INTERRUPTABLE__
+ break;
+ case 6:
+ __BEGIN_INTERRUPTABLE__
+ f = fopen((char *)__stringVal(pathName), (char *)__stringVal(openmode),
+ __stringVal(ap[0]), __stringVal(ap[1]), __stringVal(ap[2]),
+ __stringVal(ap[3]), __stringVal(ap[4]), __stringVal(ap[5]));
+ __END_INTERRUPTABLE__
+ break;
+ case 7:
+ __BEGIN_INTERRUPTABLE__
+ f = fopen((char *)__stringVal(pathName), (char *)__stringVal(openmode),
+ __stringVal(ap[0]), __stringVal(ap[1]), __stringVal(ap[2]),
+ __stringVal(ap[3]), __stringVal(ap[4]), __stringVal(ap[5]),
+ __stringVal(ap[6]));
+ __END_INTERRUPTABLE__
+ break;
+ case 8:
+ __BEGIN_INTERRUPTABLE__
+ f = fopen((char *)__stringVal(pathName), (char *)__stringVal(openmode),
+ __stringVal(ap[0]), __stringVal(ap[1]), __stringVal(ap[2]),
+ __stringVal(ap[3]), __stringVal(ap[4]), __stringVal(ap[5]),
+ __stringVal(ap[6]), __stringVal(ap[7]));
+ __END_INTERRUPTABLE__
+ break;
+ case 9:
+ __BEGIN_INTERRUPTABLE__
+ f = fopen((char *)__stringVal(pathName), (char *)__stringVal(openmode),
+ __stringVal(ap[0]), __stringVal(ap[1]), __stringVal(ap[2]),
+ __stringVal(ap[3]), __stringVal(ap[4]), __stringVal(ap[5]),
+ __stringVal(ap[6]), __stringVal(ap[7]), __stringVal(ap[8]));
+ __END_INTERRUPTABLE__
+ break;
+ case 10:
+ __BEGIN_INTERRUPTABLE__
+ f = fopen((char *)__stringVal(pathName), (char *)__stringVal(openmode),
+ __stringVal(ap[0]), __stringVal(ap[1]), __stringVal(ap[2]),
+ __stringVal(ap[3]), __stringVal(ap[4]), __stringVal(ap[5]),
+ __stringVal(ap[6]), __stringVal(ap[7]), __stringVal(ap[8]),
+ __stringVal(ap[9]));
+ __END_INTERRUPTABLE__
+ break;
+ default:
+ __threadErrno = E2BIG; /* too many args */
+ goto getOutOfHere;
+ }
+ } else if (attributeSpec != nil) {
+ __threadErrno = EINVAL; /* invalid argument */
+ goto getOutOfHere;
+ } else {
+ /*
+ * create file as sequential streamLF by default.
+ */
+ __BEGIN_INTERRUPTABLE__
+ f = fopen((char *)__stringVal(pathName), (char *)__stringVal(openmode), "rfm=stmlf");
+ __END_INTERRUPTABLE__
+ }
+ }
+ } while ((f == NULL) && (__threadErrno == EINTR));
}
#else /* not VMS */
# ifdef __win32__
{
- DWORD share = 0, access = 0, create = 0, attr = 0;
- char * __openmode;
- HANDLE handle;
- SECURITY_ATTRIBUTES sa;
+ DWORD share = 0, access = 0, create = 0, attr = 0;
+ char * __openmode;
+ HANDLE handle;
+ SECURITY_ATTRIBUTES sa;
- if (__isStringLike(openmode)) {
- share = FILE_SHARE_READ|FILE_SHARE_WRITE;
- __openmode = __stringVal(openmode);
- if (strcmp(__openmode, "rb") == 0) {
- access = GENERIC_READ;
- create = OPEN_EXISTING;
- } else if (strcmp(__openmode, "rb+") == 0) {
- access = GENERIC_READ | GENERIC_WRITE;
- create = OPEN_EXISTING;
- } else if (strcmp(__openmode, "wb") == 0) {
- access = GENERIC_WRITE;
- create = CREATE_ALWAYS;
- } else if (strcmp(__openmode, "wb+") == 0) {
- access = GENERIC_READ | GENERIC_WRITE;
- create = CREATE_ALWAYS;
- } else if (strcmp(__openmode, "ab") == 0) {
- access = FILE_APPEND_DATA|FILE_WRITE_ATTRIBUTES|FILE_WRITE_EA|
- STANDARD_RIGHTS_WRITE|SYNCHRONIZE;
- create = OPEN_ALWAYS;
- } else if (strcmp(__openmode, "ab+") == 0) {
- access = GENERIC_READ |FILE_APPEND_DATA|FILE_WRITE_ATTRIBUTES|FILE_WRITE_EA|
- STANDARD_RIGHTS_WRITE|SYNCHRONIZE;
- create = OPEN_ALWAYS;
- } else {
- console_fprintf(stderr, "Win32OS [warning]: unsupported open mode\n");
- }
- } else if (__isArrayLike(openmode)) {
- OBJ *ap = __arrayVal(openmode);
- int numAttrib = __arraySize(openmode);
- int i;
+ if (__isStringLike(openmode)) {
+ share = FILE_SHARE_READ|FILE_SHARE_WRITE;
+ __openmode = __stringVal(openmode);
+ if (strcmp(__openmode, "rb") == 0) {
+ access = GENERIC_READ;
+ create = OPEN_EXISTING;
+ } else if (strcmp(__openmode, "rb+") == 0) {
+ access = GENERIC_READ | GENERIC_WRITE;
+ create = OPEN_EXISTING;
+ } else if (strcmp(__openmode, "wb") == 0) {
+ access = GENERIC_WRITE;
+ create = CREATE_ALWAYS;
+ } else if (strcmp(__openmode, "wb+") == 0) {
+ access = GENERIC_READ | GENERIC_WRITE;
+ create = CREATE_ALWAYS;
+ } else if (strcmp(__openmode, "ab") == 0) {
+ access = FILE_APPEND_DATA|FILE_WRITE_ATTRIBUTES|FILE_WRITE_EA|
+ STANDARD_RIGHTS_WRITE|SYNCHRONIZE;
+ create = OPEN_ALWAYS;
+ } else if (strcmp(__openmode, "ab+") == 0) {
+ access = GENERIC_READ |FILE_APPEND_DATA|FILE_WRITE_ATTRIBUTES|FILE_WRITE_EA|
+ STANDARD_RIGHTS_WRITE|SYNCHRONIZE;
+ create = OPEN_ALWAYS;
+ } else {
+ console_fprintf(stderr, "Win32OS [warning]: unsupported open mode\n");
+ }
+ } else if (__isArrayLike(openmode)) {
+ OBJ *ap = __arrayVal(openmode);
+ int numAttrib = __arraySize(openmode);
+ int i;
- __openmode = "rb+";
+ __openmode = "rb+";
- for (i=0; i<numAttrib; i++) {
- OBJ attrSym = ap[i];
+ for (i=0; i<numAttrib; i++) {
+ OBJ attrSym = ap[i];
- if (attrSym == @symbol(FILE_SHARE_READ)) {
- share |= FILE_SHARE_READ;
- } else if (attrSym == @symbol(FILE_SHARE_WRITE)) {
- share |= FILE_SHARE_WRITE;
+ if (attrSym == @symbol(FILE_SHARE_READ)) {
+ share |= FILE_SHARE_READ;
+ } else if (attrSym == @symbol(FILE_SHARE_WRITE)) {
+ share |= FILE_SHARE_WRITE;
- } else if (attrSym == @symbol(GENERIC_READ)) {
- access |= GENERIC_READ;
- } else if (attrSym == @symbol(GENERIC_WRITE)) {
- access |= GENERIC_WRITE;
- } else if (attrSym == @symbol(GENERIC_READ_WRITE)) {
- access |= GENERIC_READ|GENERIC_WRITE;
+ } else if (attrSym == @symbol(GENERIC_READ)) {
+ access |= GENERIC_READ;
+ } else if (attrSym == @symbol(GENERIC_WRITE)) {
+ access |= GENERIC_WRITE;
+ } else if (attrSym == @symbol(GENERIC_READ_WRITE)) {
+ access |= GENERIC_READ|GENERIC_WRITE;
- } else if (attrSym == @symbol(CREATE_NEW)) {
- create |= CREATE_NEW;
- } else if (attrSym == @symbol(CREATE_ALWAYS)) {
- create |= CREATE_ALWAYS;
- } else if (attrSym == @symbol(OPEN_EXISTING)) {
- create |= OPEN_EXISTING;
- } else if (attrSym == @symbol(OPEN_ALWAYS)) {
- create |= OPEN_ALWAYS;
- } else if (attrSym == @symbol(TRUNCATE_EXISTING)) {
- create |= TRUNCATE_EXISTING;
+ } else if (attrSym == @symbol(CREATE_NEW)) {
+ create |= CREATE_NEW;
+ } else if (attrSym == @symbol(CREATE_ALWAYS)) {
+ create |= CREATE_ALWAYS;
+ } else if (attrSym == @symbol(OPEN_EXISTING)) {
+ create |= OPEN_EXISTING;
+ } else if (attrSym == @symbol(OPEN_ALWAYS)) {
+ create |= OPEN_ALWAYS;
+ } else if (attrSym == @symbol(TRUNCATE_EXISTING)) {
+ create |= TRUNCATE_EXISTING;
- } else if (attrSym == @symbol(FILE_ATTRIBUTE_HIDDEN)) {
- attr |= FILE_ATTRIBUTE_HIDDEN;
- } else if (attrSym == @symbol(FILE_ATTRIBUTE_READONLY)) {
- attr |= FILE_ATTRIBUTE_READONLY;
- } else if (attrSym == @symbol(FILE_FLAG_WRITE_THROUGH)) {
- attr |= FILE_FLAG_WRITE_THROUGH;
- } else if (attrSym == @symbol(FILE_FLAG_SEQUENTIAL_SCAN)) {
- attr |= FILE_FLAG_SEQUENTIAL_SCAN;
- } else if (attrSym == @symbol(FILE_FLAG_DELETE_ON_CLOSE)) {
- attr |= FILE_FLAG_DELETE_ON_CLOSE;
- } else if (!__isSymbol(attrSym) && __isStringLike(attrSym)) {
- __openmode = __stringVal(attrSym);
- } else {
- console_fprintf(stderr, "Win32OS [warning]: unsupported open mode\n");
- }
- }
- }
- if (create == 0) {
+ } else if (attrSym == @symbol(FILE_ATTRIBUTE_HIDDEN)) {
+ attr |= FILE_ATTRIBUTE_HIDDEN;
+ } else if (attrSym == @symbol(FILE_ATTRIBUTE_READONLY)) {
+ attr |= FILE_ATTRIBUTE_READONLY;
+ } else if (attrSym == @symbol(FILE_FLAG_WRITE_THROUGH)) {
+ attr |= FILE_FLAG_WRITE_THROUGH;
+ } else if (attrSym == @symbol(FILE_FLAG_SEQUENTIAL_SCAN)) {
+ attr |= FILE_FLAG_SEQUENTIAL_SCAN;
+ } else if (attrSym == @symbol(FILE_FLAG_DELETE_ON_CLOSE)) {
+ attr |= FILE_FLAG_DELETE_ON_CLOSE;
+ } else if (!__isSymbol(attrSym) && __isStringLike(attrSym)) {
+ __openmode = __stringVal(attrSym);
+ } else {
+ console_fprintf(stderr, "Win32OS [warning]: unsupported open mode\n");
+ }
+ }
+ }
+ if (create == 0) {
// argumentError = @symbol(missingCreateMode);
- goto badArgument;
- }
- if (attr == 0) {
- attr = FILE_ATTRIBUTE_NORMAL;
- }
+ goto badArgument;
+ }
+ if (attr == 0) {
+ attr = FILE_ATTRIBUTE_NORMAL;
+ }
- /*
- * create security attributes - make handle inheritable by subprocesses
- */
- memset(&sa, 0, sizeof (sa));
- sa.nLength = sizeof( sa );
- // sa.bInheritHandle = TRUE;
- sa.bInheritHandle = FALSE;
+ /*
+ * create security attributes - make handle inheritable by subprocesses
+ */
+ memset(&sa, 0, sizeof (sa));
+ sa.nLength = sizeof( sa );
+ // sa.bInheritHandle = TRUE;
+ sa.bInheritHandle = FALSE;
- if (__isStringLike(pathName)) {
- char _aPathName[MAXPATHLEN];
+ if (__isStringLike(pathName)) {
+ char _aPathName[MAXPATHLEN];
- strncpy(_aPathName, __stringVal(pathName), MAXPATHLEN-1); _aPathName[MAXPATHLEN-1] = '\0';
- do {
- __threadErrno = 0;
- handle = STX_API_NOINT_CALL7( "CreateFileA", CreateFileA, _aPathName, access, share, &sa, create, attr, 0 /* hTempl */);
- if (__threadErrno == EINTR) {
- handle = INVALID_HANDLE_VALUE;
- }
- } while ((handle == INVALID_HANDLE_VALUE) && (__threadErrno == EINTR));
- } else if (__isUnicode16String(pathName)) {
- wchar_t _aPathName[MAXPATHLEN+1];
- int i, l;
+ strncpy(_aPathName, __stringVal(pathName), MAXPATHLEN-1); _aPathName[MAXPATHLEN-1] = '\0';
+ do {
+ __threadErrno = 0;
+ handle = STX_API_NOINT_CALL7( "CreateFileA", CreateFileA, _aPathName, access, share, &sa, create, attr, 0 /* hTempl */);
+ if (__threadErrno == EINTR) {
+ handle = INVALID_HANDLE_VALUE;
+ }
+ } while ((handle == INVALID_HANDLE_VALUE) && (__threadErrno == EINTR));
+ } else if (__isUnicode16String(pathName)) {
+ wchar_t _aPathName[MAXPATHLEN+1];
+ int i, l;
- l = __unicode16StringSize(pathName);
- if (l > MAXPATHLEN) l = MAXPATHLEN;
- for (i=0; i<l; i++) {
- _aPathName[i] = __unicode16StringVal(pathName)[i];
- }
- _aPathName[i] = 0;
+ l = __unicode16StringSize(pathName);
+ if (l > MAXPATHLEN) l = MAXPATHLEN;
+ for (i=0; i<l; i++) {
+ _aPathName[i] = __unicode16StringVal(pathName)[i];
+ }
+ _aPathName[i] = 0;
- do {
- __threadErrno = 0;
- handle = STX_API_NOINT_CALL7( "CreateFileW", CreateFileW, _aPathName, access, share, &sa, create, attr, 0 /* hTempl */);
- if (__threadErrno == EINTR) {
- handle = INVALID_HANDLE_VALUE;
- }
- } while ((handle == INVALID_HANDLE_VALUE) && (__threadErrno == EINTR));
- }
- if (handle != INVALID_HANDLE_VALUE) {
- int fd;
- extern void __stxWrapApiEnterCritical(), __stxWrapApiLeaveCritical();
+ do {
+ __threadErrno = 0;
+ handle = STX_API_NOINT_CALL7( "CreateFileW", CreateFileW, _aPathName, access, share, &sa, create, attr, 0 /* hTempl */);
+ if (__threadErrno == EINTR) {
+ handle = INVALID_HANDLE_VALUE;
+ }
+ } while ((handle == INVALID_HANDLE_VALUE) && (__threadErrno == EINTR));
+ }
+ if (handle != INVALID_HANDLE_VALUE) {
+ int fd;
+ extern void __stxWrapApiEnterCritical(), __stxWrapApiLeaveCritical();
- __stxWrapApiEnterCritical();
- fd = _open_osfhandle((long)handle, O_BINARY);
- if (fd < 0) {
- if (__threadErrno == 0) {
- // no more file descriptors
- __threadErrno = EMFILE;
- }
- CloseHandle(handle);
- } else {
- f = fdopen(fd, __openmode);
- }
- __stxWrapApiLeaveCritical();
- } else {
- __threadErrno = __WIN32_ERR(GetLastError());
- }
+ __stxWrapApiEnterCritical();
+ fd = _open_osfhandle((long)handle, O_BINARY);
+ if (fd < 0) {
+ if (__threadErrno == 0) {
+ // no more file descriptors
+ __threadErrno = EMFILE;
+ }
+ CloseHandle(handle);
+ } else {
+ f = fdopen(fd, __openmode);
+ }
+ __stxWrapApiLeaveCritical();
+ } else {
+ __threadErrno = __WIN32_ERR(GetLastError());
+ }
}
# else /* not WIN32 */
if (__isStringLike(encodedPathName)) {
- int accessMode = 0666; // default access mode of fopen(), relies on umask()
- int flags = 0;
- int fd;
- char * __openmode;
+ int accessMode = 0666; // default access mode of fopen(), relies on umask()
+ int flags = 0;
+ int fd;
+ char * __openmode;
- if (__isStringLike(openmode)) {
- __openmode = __stringVal(openmode);
- if (strcmp(__openmode, "r") == 0) {
- flags = O_RDONLY;
- } else if (strcmp(__openmode, "r+") == 0) {
- flags = O_RDWR;
- } else if (strcmp(__openmode, "w") == 0) {
- flags = O_WRONLY | O_CREAT | O_TRUNC;
- } else if (strcmp(__openmode, "w+") == 0) {
- flags = O_RDWR | O_CREAT | O_TRUNC;
- } else if (strcmp(__openmode, "a") == 0) {
- flags = O_WRONLY | O_CREAT | O_APPEND;
- } else if (strcmp(__openmode, "a+") == 0) {
- flags = O_RDWR | O_CREAT| O_APPEND;
- } else {
- console_fprintf(stderr, "UNIXOS [warning]: unsupported open mode\n");
- }
- } else if (__isArrayLike(openmode)) {
- OBJ *ap = __arrayVal(openmode);
- int numAttrib = __arraySize(openmode);
- int i;
+ if (__isStringLike(openmode)) {
+ __openmode = __stringVal(openmode);
+ if (strcmp(__openmode, "r") == 0) {
+ flags = O_RDONLY;
+ } else if (strcmp(__openmode, "r+") == 0) {
+ flags = O_RDWR;
+ } else if (strcmp(__openmode, "w") == 0) {
+ flags = O_WRONLY | O_CREAT | O_TRUNC;
+ } else if (strcmp(__openmode, "w+") == 0) {
+ flags = O_RDWR | O_CREAT | O_TRUNC;
+ } else if (strcmp(__openmode, "a") == 0) {
+ flags = O_WRONLY | O_CREAT | O_APPEND;
+ } else if (strcmp(__openmode, "a+") == 0) {
+ flags = O_RDWR | O_CREAT| O_APPEND;
+ } else {
+ console_fprintf(stderr, "UNIXOS [warning]: unsupported open mode\n");
+ }
+ } else if (__isArrayLike(openmode)) {
+ OBJ *ap = __arrayVal(openmode);
+ int numAttrib = __arraySize(openmode);
+ int i;
- __openmode = "r+";
+ __openmode = "r+";
- for (i=0; i<numAttrib; i++) {
- OBJ attrSym = ap[i];
+ for (i=0; i<numAttrib; i++) {
+ OBJ attrSym = ap[i];
- if (attrSym == @symbol(FILE_SHARE_READ)) {
- // ignore
- } else if (attrSym == @symbol(FILE_SHARE_WRITE)) {
- // ignore
- } else if (attrSym == @symbol(GENERIC_READ)) {
- flags |= O_RDONLY;
- } else if (attrSym == @symbol(GENERIC_WRITE)) {
- flags |= O_WRONLY;
- } else if (attrSym == @symbol(GENERIC_READ_WRITE)) {
- flags |= O_RDWR;
+ if (attrSym == @symbol(FILE_SHARE_READ)) {
+ // ignore
+ } else if (attrSym == @symbol(FILE_SHARE_WRITE)) {
+ // ignore
+ } else if (attrSym == @symbol(GENERIC_READ)) {
+ flags |= O_RDONLY;
+ } else if (attrSym == @symbol(GENERIC_WRITE)) {
+ flags |= O_WRONLY;
+ } else if (attrSym == @symbol(GENERIC_READ_WRITE)) {
+ flags |= O_RDWR;
- } else if (attrSym == @symbol(CREATE_NEW)) {
- flags |= O_CREAT|O_EXCL;
- accessMode = 0600; // simulate mkstemp()
- } else if (attrSym == @symbol(CREATE_ALWAYS)) {
- flags |= O_CREAT|O_TRUNC;
- } else if (attrSym == @symbol(OPEN_EXISTING)) {
- // nothing to be set
- } else if (attrSym == @symbol(OPEN_ALWAYS)) {
- flags |= O_CREAT;
- } else if (attrSym == @symbol(TRUNCATE_EXISTING)) {
- flags |= O_TRUNC;
+ } else if (attrSym == @symbol(CREATE_NEW)) {
+ flags |= O_CREAT|O_EXCL;
+ accessMode = 0600; // simulate mkstemp()
+ } else if (attrSym == @symbol(CREATE_ALWAYS)) {
+ flags |= O_CREAT|O_TRUNC;
+ } else if (attrSym == @symbol(OPEN_EXISTING)) {
+ // nothing to be set
+ } else if (attrSym == @symbol(OPEN_ALWAYS)) {
+ flags |= O_CREAT;
+ } else if (attrSym == @symbol(TRUNCATE_EXISTING)) {
+ flags |= O_TRUNC;
- } else if (attrSym == @symbol(FILE_ATTRIBUTE_HIDDEN)) {
- // ignore
- } else if (attrSym == @symbol(FILE_ATTRIBUTE_READONLY)) {
- accessMode &= 0444;
- } else if (attrSym == @symbol(FILE_FLAG_WRITE_THROUGH)) {
+ } else if (attrSym == @symbol(FILE_ATTRIBUTE_HIDDEN)) {
+ // ignore
+ } else if (attrSym == @symbol(FILE_ATTRIBUTE_READONLY)) {
+ accessMode &= 0444;
+ } else if (attrSym == @symbol(FILE_FLAG_WRITE_THROUGH)) {
#ifdef O_DIRECT
- flags |= O_DIRECT;
+ flags |= O_DIRECT;
#endif
- } else if (attrSym == @symbol(FILE_FLAG_SEQUENTIAL_SCAN)) {
- // ignore
- } else if (attrSym == @symbol(FILE_FLAG_DELETE_ON_CLOSE)) {
- // ignore;
- } else if (!__isSymbol(attrSym) && __isStringLike(attrSym)) {
- __openmode = __stringVal(attrSym);
- } else {
- console_fprintf(stderr, "UNIXOS [warning]: unsupported open mode\n");
- }
- }
- }
- do {
- __BEGIN_INTERRUPTABLE__
- fd = open((char *) __stringVal(encodedPathName), flags, accessMode);
- __END_INTERRUPTABLE__
- } while ((fd < 0) && (__threadErrno == EINTR));
+ } else if (attrSym == @symbol(FILE_FLAG_SEQUENTIAL_SCAN)) {
+ // ignore
+ } else if (attrSym == @symbol(FILE_FLAG_DELETE_ON_CLOSE)) {
+ // ignore;
+ } else if (!__isSymbol(attrSym) && __isStringLike(attrSym)) {
+ __openmode = __stringVal(attrSym);
+ } else {
+ console_fprintf(stderr, "UNIXOS [warning]: unsupported open mode\n");
+ }
+ }
+ }
+ do {
+ __BEGIN_INTERRUPTABLE__
+ fd = open((char *) __stringVal(encodedPathName), flags, accessMode);
+ __END_INTERRUPTABLE__
+ } while ((fd < 0) && (__threadErrno == EINTR));
- if (fd >= 0) {
- __threadErrno = 0;
- f = fdopen(fd, __openmode);
- if (f == NULL) {
- close(fd); // fdopen failed, close before retry.
- }
- }
+ if (fd >= 0) {
+ __threadErrno = 0;
+ f = fdopen(fd, __openmode);
+ if (f == NULL) {
+ close(fd); // fdopen failed, close before retry.
+ }
+ }
}
# endif /* not WIN32 */
@@ -1733,83 +1733,84 @@
if (f == NULL) {
- /*
- * If no filedescriptors available, try to finalize
- * possibly collected fd's and try again.
- */
- if ((__threadErrno == ENFILE || __threadErrno == EMFILE) && pass == 0) {
- pass = 1;
- __SSEND0(@global(ObjectMemory), @symbol(scavenge), 0);
- __SSEND0(@global(ObjectMemory), @symbol(finalize), 0);
- goto retry;
- }
+ /*
+ * If no filedescriptors available, try to finalize
+ * possibly collected fd's and try again.
+ */
+ if ((__threadErrno == ENFILE || __threadErrno == EMFILE) && pass == 0) {
+ pass = 1;
+ __SSEND0(@global(ObjectMemory), @symbol(scavenge), 0);
+ __SSEND0(@global(ObjectMemory), @symbol(finalize), 0);
+ goto retry;
+ }
badArgument:
getOutOfHere:
- error = __mkSmallInteger(__threadErrno);
- __INST(position) = nil;
+ error = __mkSmallInteger(__threadErrno);
+ __INST(position) = nil;
} else {
#ifdef __VMS__
- /*
- * check to see if this is positionable ...
- */
- __INST(canPosition) = false;
+ /*
+ * check to see if this is positionable ...
+ */
+ __INST(canPosition) = false;
# ifndef _POSIX_C_SOURCE
- {
- struct stat statBuffer;
+ {
+ struct stat statBuffer;
- if (fstat(fileno(f), &statBuffer) >= 0) {
- switch (statBuffer.st_fab_rfm) {
- case FAB$C_UDF: /* undefined (also stream binary) */
- case FAB$C_VAR: /* variable length records */
- case FAB$C_VFC: /* variable fixed control */
- case FAB$C_STM: /* RMS-11 stream (valid only for sequen) */
- default:
- __INST(canPosition) = false;
- break;
+ if (fstat(fileno(f), &statBuffer) >= 0) {
+ switch (statBuffer.st_fab_rfm) {
+ case FAB$C_UDF: /* undefined (also stream binary) */
+ case FAB$C_VAR: /* variable length records */
+ case FAB$C_VFC: /* variable fixed control */
+ case FAB$C_STM: /* RMS-11 stream (valid only for sequen) */
+ default:
+ __INST(canPosition) = false;
+ break;
- case FAB$C_FIX: /* fixed length records */
- case FAB$C_STMLF: /* LF stream (valid only for sequential) */
- case FAB$C_STMCR: /* CR stream (valid only for sequential) */
- __INST(canPosition) = true;
- break;
- }
- }
- }
+ case FAB$C_FIX: /* fixed length records */
+ case FAB$C_STMLF: /* LF stream (valid only for sequential) */
+ case FAB$C_STMCR: /* CR stream (valid only for sequential) */
+ __INST(canPosition) = true;
+ break;
+ }
+ }
+ }
# endif
#else /* not VMS */
- __INST(canPosition) = true;
+ __INST(canPosition) = true;
#endif /* not VMS */
- if (@global(FileOpenTrace) == true) {
- console_fprintf(stderr, "fopen %s [FileStream] -> %"_lx_"\n", __stringVal(pathName), (INT)f);
- }
- if (f != NULL) {
- OBJ fp;
+ if (@global(FileOpenTrace) == true) {
+ console_fprintf(stderr, "fopen %s [FileStream] -> %"_lx_"\n", __stringVal(pathName), (INT)f);
+ }
+ if (f != NULL) {
+ OBJ fp;
- wasBlocked = __BLOCKINTERRUPTS();
+ wasBlocked = __BLOCKINTERRUPTS();
#if 0
- // The original code was:
- __INST(handle) = fp = __MKEXTERNALADDRESS(f); __STORE(self, fp);
- // but for that, gcc generates wrong code, which loads self (volatile) into
- // a register (bp), then calls __MKEXTERNALADDRESS, then stores indirect bp.
- // That is wrong if a scavenge occurs in __MKEXTERNALADDRESS, as bp is now still pointing to the old
- // object.
+ // The original code was:
+ __INST(handle) = fp = __MKEXTERNALADDRESS(f); __STORE(self, fp);
+ // but for that, gcc generates wrong code, which loads self (volatile) into
+ // a register (bp), then calls __MKEXTERNALADDRESS, then stores indirect bp.
+ // That is wrong if a scavenge occurs in __MKEXTERNALADDRESS, as bp is now still pointing to the old
+ // object.
#else
- fp = __MKEXTERNALADDRESS(f);
- __INST(handle) = fp;
- __STORE(self, fp);
+ fp = __MKEXTERNALADDRESS(f);
+ __INST(handle) = fp;
+ __STORE(self, fp);
#endif
- }
+ }
}
%}.
error notNil ifTrue:[
- lastErrorNumber := error.
- ^ self openError:error.
+ lastErrorNumber := error.
+ ^ self openError:error.
].
handle isNil ifTrue:[
- ^ self openError:0.
+ ^ self openError:0.
].
+ buffered := true. "default is buffered"
position := 0.
handleType := #filePointer.
self registerForFinalization.
@@ -1887,12 +1888,8 @@
handle := self openFile:pathName withMode:openmode attributes:attributeSpec.
handle isNil ifTrue:[
- "this happens, if proceeding from an OpenError raised in #openFile..."
- ^ nil.
- ].
- position := 0.
- buffered isNil ifTrue:[
- buffered := true. "default is buffered"
+ "this happens, if proceeding from an OpenError raised in #openFile..."
+ ^ nil.
].
!
--- a/GenericException.st Wed Jul 06 06:50:27 2016 +0200
+++ b/GenericException.st Sat Jul 09 21:10:24 2016 +0100
@@ -1,5 +1,3 @@
-"{ Encoding: utf8 }"
-
"
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
@@ -54,9 +52,9 @@
I.e. what used to be instances of Signal/QuerySignal is being
rewritten into subclasses of Exception/Error/Query and Warning.
Although the functionality is basically unchanged, the new
- class based exceptions are easier to instanciate (no need for
+ class based exceptions are easier to instantiate (no need for
creation in a classes initialize method), easier to use (no real
- need for SIgnal-constant accessors) and allow for easier parameter
+ need for Signal-constant accessors) and allow for easier parameter
passing (not only a single parameter, but allows for individual
exception subclasses to add additional state).
@@ -226,6 +224,7 @@
self raiseErrorString:messageText
! !
+
!GenericException class methodsFor:'accessing'!
errorString
--- a/IdentityDictionary.st Wed Jul 06 06:50:27 2016 +0200
+++ b/IdentityDictionary.st Sat Jul 09 21:10:24 2016 +0100
@@ -1,5 +1,3 @@
-"{ Encoding: utf8 }"
-
"
COPYRIGHT (c) 1992 by Claus Gittinger
All Rights Reserved
@@ -40,10 +38,10 @@
documentation
"
- same as a Dictionary but key must be identical - not just equal.
+ Same as a Dictionary, but key must be identical - not just equal.
Since compare is on identical keys (using ==), hashing is also done via
#identityHash instead of #hash.
- IdentityDictionaries are especially useful, when symbols are used as keys.
+ IdentityDictionaries are especially useful when symbols are used as keys.
[author:]
Claus Gittinger
--- a/InlineObjectPrototype.st Wed Jul 06 06:50:27 2016 +0200
+++ b/InlineObjectPrototype.st Sat Jul 09 21:10:24 2016 +0100
@@ -11,6 +11,8 @@
"
"{ Package: 'stx:libbasic' }"
+"{ NameSpace: Smalltalk }"
+
InlineObject subclass:#InlineObjectPrototype
instanceVariableNames:'i1 i2 i3 i4 i5 i6 i7 i8 i9 i10 i11 i12 i13 i14 i15 i16 i17 i18
i19 i20 i21 i22 i23 i24 i25 i26 i27 i28 i29 i30 i31 i32 i33 i34
@@ -43,7 +45,7 @@
documentation
"
All getter/setter methods of all inline objects are actually shared code,
- which is aquired from this prototypeInlineObject class.
+ which is acquired from this prototypeInlineObject class.
"
! !
@@ -852,5 +854,6 @@
!InlineObjectPrototype class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/InlineObjectPrototype.st,v 1.2 2009-09-11 13:04:28 cg Exp $'
+ ^ '$Header$'
! !
+
--- a/NonPositionableExternalStream.st Wed Jul 06 06:50:27 2016 +0200
+++ b/NonPositionableExternalStream.st Sat Jul 09 21:10:24 2016 +0100
@@ -1,3 +1,5 @@
+"{ Encoding: utf8 }"
+
"
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
@@ -238,6 +240,7 @@
"non-positionable streams do not work well when buffered"
super initialize.
+ position := nil. "I am not positionable (reading and writing simultaneously)"
buffered := false.
! !
@@ -273,24 +276,75 @@
] whileTrue.
^ count - remaining
+!
+
+nextInt16MSB:msbFlag
+ "redefined to wait for data on pipes and sockets"
+
+ |bytes nRead|
+
+ bytes := ByteArray uninitializedNew:2.
+ nRead := self nextBytes:2 into:bytes startingAt:1.
+ nRead ~~ 2 ifTrue:[
+ ^ self pastEndRead.
+ ].
+ ^ bytes signedInt16At:1 MSB:msbFlag.
+!
+
+nextInt32MSB:msbFlag
+ "redefined to wait for data on pipes and sockets"
+
+ |bytes nRead|
+
+ bytes := ByteArray uninitializedNew:4.
+ nRead := self nextBytes:4 into:bytes startingAt:1.
+ nRead ~~ 4 ifTrue:[
+ ^ self pastEndRead.
+ ].
+ ^ bytes signedInt32At:1 MSB:msbFlag.
+!
+
+nextUnsignedInt16MSB:msbFlag
+ "redefined to wait for data on pipes and sockets"
+
+ |bytes nRead|
+
+ bytes := ByteArray uninitializedNew:4.
+ nRead := self nextBytes:2 into:bytes startingAt:1.
+ nRead ~~ 2 ifTrue:[
+ ^ self pastEndRead.
+ ].
+ ^ bytes unsignedInt16At:1 MSB:msbFlag.
+!
+
+nextUnsignedInt32MSB:msbFlag
+ "redefined to wait for data on pipes and sockets"
+
+ |bytes nRead|
+
+ bytes := ByteArray uninitializedNew:4.
+ nRead := self nextBytes:4 into:bytes startingAt:1.
+ nRead ~~ 4 ifTrue:[
+ ^ self pastEndRead.
+ ].
+ ^ bytes unsignedInt32At:1 MSB:msbFlag.
! !
!NonPositionableExternalStream methodsFor:'positioning'!
position
- "{ Pragma: +optSpace }"
-
- "catch position - there is none here"
-
- ^ self positionError
+ position isNil ifTrue:[
+ ^ self positionError.
+ ].
+ ^ position
!
-position:aPosition
- "{ Pragma: +optSpace }"
-
- "catch position - there is none here"
-
- ^ self positionError
+position:newPosition
+ (position isNil or:[newPosition < position]) ifTrue:[
+ "there is no turning back"
+ ^ self positionError
+ ].
+ self skip:newPosition - position.
!
skip:numberToSkip
@@ -299,8 +353,7 @@
"don't know how to unread ..."
numberToSkip < 0 ifTrue:[
- PositionError raiseRequest.
- ^ self
+ ^ self positionError.
].
numberToSkip timesRepeat:[self next].
@@ -411,12 +464,13 @@
"setup for writing to stderr"
- mode := #readwrite.
+ mode := #writeonly. "since stderr may be redirected to a pipe, reading is forbidden"
buffered := false.
+ position := 0. "only writing - can keep track of position"
handle := self handleForStderr.
handleType := #filePointer.
OperatingSystem isMSWINDOWSlike ifTrue:[
- eolMode := #crlf
+ eolMode := #crlf
]
!
@@ -428,6 +482,7 @@
mode := #readonly.
"/ buffered := true.
buffered := false.
+ position := 0. "only reading - can keep track of position"
handleType := #filePointer.
handle := self handleForStdin.
!
@@ -437,12 +492,13 @@
"setup for writing to stdout"
- mode := #readwrite.
+ mode := #writeonly. "since stdout may be redirected to a pipe, reading is forbidden"
buffered := false.
+ position := 0. "only writing - can keep track of position"
handle := self handleForStdout.
handleType := #filePointer.
OperatingSystem isMSWINDOWSlike ifTrue:[
- eolMode := #crlf
+ eolMode := #crlf
]
!
@@ -519,11 +575,50 @@
^ super next
!
-nextLine
- "Redefined, to wait on pipes and sockets"
+nextByte
+ "redefined, to wait on pipes and sockets"
self readWaitWithTimeoutMs:nil.
- ^ super nextLine
+ ^ super nextByte
+!
+
+nextLine
+ "return the characters upTo (but excluding) the next cr (carriage return)
+ character (i.e. read a single line of text).
+ If the previous-to-last character is a cr, this is also removed,
+ so it's possible to read alien (i.e. ms-dos) text as well.
+ Redefined to not block forever if no cr is read."
+
+ |answerStream char available "{ Class:SmallInteger }" wasBinary|
+
+ answerStream := WriteStream on:(String uninitializedNew:80).
+ [
+ available := self numAvailableForRead.
+ wasBinary := binary. "temporarily set to text mode"
+ binary := false.
+ available timesRepeat:[
+ char := super next. "we know that there is data"
+ char == Character cr ifTrue:[
+ (answerStream size ~~ 0 and:[answerStream last == Character return]) ifTrue:[
+ answerStream backStep.
+ ].
+ binary := wasBinary.
+ ^ answerStream contents.
+ ].
+ answerStream nextPut:char.
+ ].
+ binary := wasBinary. "restore saved mode"
+
+ "#atEnd waits for new data or EOF"
+ self atEnd ifTrue:[
+ answerStream size == 0 ifTrue:[
+ ^ self pastEndRead.
+ ].
+ ^ answerStream contents.
+ ].
+ ] loop.
+
+ "not reached"
!
nextOrNil
@@ -555,16 +650,34 @@
^ self peek
!
-readWaitWithTimeoutMs:millisecondsOrNil
- "cannot do a readWait (which means possible suspend),
- if the processor is not yet initialized; i.e. if a read is attempted
- during early startup.
- This may happen, for example, if a MiniDebugger is entered, before
- process scheduling has been setup.
- In this case, all I/O operations here will be blocking."
+upTo:anObject into:aStream
+ "read a collection of all objects up-to anObject and append these
+ elements to aStream, but excluding anObject.
+ The next read operation will return the element after anObject.
+ (i.e. anObject is considered a separator, which is skipped)
+ Similar to #through:, but the matching object is not included in the returned collection.
+ If anObject is not encountered, all elements up to the end are read and returned.
+ Compare this with #through: which also reads up to some object
+ and also positions behind it, but DOES include it in the returned value."
+
+ |element available "{ Class:SmallInteger }"|
- Smalltalk isInitialized ifFalse:[ ^ false ].
- ^ super readWaitWithTimeoutMs:millisecondsOrNil
+ [
+ available := self numAvailableForRead.
+ available timesRepeat:[
+ element := super next. "we know that there is data"
+ element = anObject ifTrue:[
+ ^ self.
+ ].
+ aStream nextPut:element.
+ ].
+ "#atEnd waits for new data or EOF"
+ self atEnd ifTrue:[
+ ^ self.
+ ].
+ ] loop.
+
+ "not reached"
! !
!NonPositionableExternalStream methodsFor:'writing'!
--- a/Object.st Wed Jul 06 06:50:27 2016 +0200
+++ b/Object.st Sat Jul 09 21:10:24 2016 +0100
@@ -520,8 +520,6 @@
-
-
!Object methodsFor:'Compatibility-Dolphin'!
stbFixup: anSTBInFiler at: newObjectIndex
@@ -698,8 +696,6 @@
! !
-
-
!Object methodsFor:'accessing'!
_at:index
@@ -5085,7 +5081,7 @@
shallowCopyForFinalization
"OBSOLETE INTERFACE: use #executor.
- This is used to aquire a copy to be used for finalization -
+ This is used to acquire a copy to be used for finalization -
(the copy will be sent a #finalize message; see the documentation in the Registry class)
This method can be redefined for more efficient copying - especially for large objects."
--- a/PipeStream.st Wed Jul 06 06:50:27 2016 +0200
+++ b/PipeStream.st Sat Jul 09 21:10:24 2016 +0100
@@ -1,5 +1,3 @@
-"{ Encoding: utf8 }"
-
"
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
@@ -220,7 +218,7 @@
|p|
p := PipeStream bidirectionalFor:'cat -u'.
- p nextPutAll:'Wer ist der Bürgermeister von Wesel'; cr.
+ p nextPutAll:'Wer ist der Bürgermeister von Wesel'; cr.
Transcript showCR:p nextLine.
p close
"
@@ -612,17 +610,19 @@
realCmd execDirectory tmpComFile nullOutput resultPid errorNumber|
handle notNil ifTrue:[
- "the pipe was already open ...
- this should (can) not happen."
- ^ self errorAlreadyOpen
+ "the pipe was already open ...
+ this should (can) not happen."
+ ^ self errorAlreadyOpen
].
rwMode = #r ifTrue:[
- mode := #readonly. didWrite := false.
+ mode := #readonly. didWrite := false.
+ position := 0. "only reading - can keep track of position"
] ifFalse:[rwMode = #'r+' ifTrue:[
- mode := #readwrite. didWrite := true.
+ mode := #readwrite. didWrite := true.
] ifFalse:[
- mode := #writeonly. didWrite := true.
+ mode := #writeonly. didWrite := true.
+ position := 0. "only writing - can keep track of position"
]].
lastErrorNumber := nil.
@@ -634,79 +634,79 @@
execFdArray := #(0 1 2) copy.
OperatingSystem isVMSlike ifTrue:[
- "/
- "/ the generated COM-file includes a 'set default'
- "/
- tmpComFile := OperatingSystem createCOMFileForVMSCommand:aCommandString in:aDirectory.
- realCmd := '@' , tmpComFile osName.
- execDirectory := nil.
+ "/
+ "/ the generated COM-file includes a 'set default'
+ "/
+ tmpComFile := OperatingSystem createCOMFileForVMSCommand:aCommandString in:aDirectory.
+ realCmd := '@' , tmpComFile osName.
+ execDirectory := nil.
- mbx := OperatingSystem createMailBox.
- mbx isNil ifTrue:[
- lastErrorNumber := errorNumber := OperatingSystem currentErrorNumber.
- tmpComFile delete.
- ^ self openError:errorNumber.
- ].
- mbxName := OperatingSystem mailBoxNameOf:mbx.
+ mbx := OperatingSystem createMailBox.
+ mbx isNil ifTrue:[
+ lastErrorNumber := errorNumber := OperatingSystem currentErrorNumber.
+ tmpComFile delete.
+ ^ self openError:errorNumber.
+ ].
+ mbxName := OperatingSystem mailBoxNameOf:mbx.
- "/ 'mailBox is ' print. mbx print. ' name is ' print. mbxName printCR.
- shellPath := ''.
- shellArgs := realCmd.
+ "/ 'mailBox is ' print. mbx print. ' name is ' print. mbxName printCR.
+ shellPath := ''.
+ shellArgs := realCmd.
- rwMode = #r ifTrue:[
- "redirect stdout of subprocess to write to mailbox"
- execFdArray at:2 put:mbx.
- ] ifFalse:[
- "redirect stdin of subprocess to read from mailbox"
- execFdArray at:1 put:mbx.
- ].
+ rwMode = #r ifTrue:[
+ "redirect stdout of subprocess to write to mailbox"
+ execFdArray at:2 put:mbx.
+ ] ifFalse:[
+ "redirect stdin of subprocess to read from mailbox"
+ execFdArray at:1 put:mbx.
+ ].
] ifFalse:[
- shellAndArgs := OperatingSystem commandAndArgsForOSCommand:realCmd.
- shellPath := shellAndArgs at:1.
- shellArgs := shellAndArgs at:2.
+ shellAndArgs := OperatingSystem commandAndArgsForOSCommand:realCmd.
+ shellPath := shellAndArgs at:1.
+ shellArgs := shellAndArgs at:2.
- mode == #readwrite ifTrue:[
- pipeFdArray := OperatingSystem makeBidirectionalPipe.
- pipeFdArray isNil ifTrue:[
- lastErrorNumber := errorNumber := OperatingSystem currentErrorNumber.
- ^ self openError:errorNumber.
- ].
- myFd := pipeFdArray at:1.
- execFd := pipeFdArray at:2.
- execFdArray at:1 put:execFd.
- execFdArray at:2 put:execFd.
- ] ifFalse:[
- pipeFdArray := OperatingSystem makePipe.
- pipeFdArray isNil ifTrue:[
- lastErrorNumber := errorNumber := OperatingSystem currentErrorNumber.
- ^ self openError:errorNumber.
- ].
+ mode == #readwrite ifTrue:[
+ pipeFdArray := OperatingSystem makeBidirectionalPipe.
+ pipeFdArray isNil ifTrue:[
+ lastErrorNumber := errorNumber := OperatingSystem currentErrorNumber.
+ ^ self openError:errorNumber.
+ ].
+ myFd := pipeFdArray at:1.
+ execFd := pipeFdArray at:2.
+ execFdArray at:1 put:execFd.
+ execFdArray at:2 put:execFd.
+ ] ifFalse:[
+ pipeFdArray := OperatingSystem makePipe.
+ pipeFdArray isNil ifTrue:[
+ lastErrorNumber := errorNumber := OperatingSystem currentErrorNumber.
+ ^ self openError:errorNumber.
+ ].
- mode == #readonly ifTrue:[
- "redirect stdout of subprocess to write to pipe"
- myFd := pipeFdArray at:1.
- execFd := pipeFdArray at:2.
- execFdArray at:2 put:execFd.
- ] ifFalse:[
- "redirect stdin of subprocess to read from pipe"
- myFd := pipeFdArray at:2.
- execFd := pipeFdArray at:1.
- execFdArray at:1 put:execFd.
- ].
- ].
+ mode == #readonly ifTrue:[
+ "redirect stdout of subprocess to write to pipe"
+ myFd := pipeFdArray at:1.
+ execFd := pipeFdArray at:2.
+ execFdArray at:2 put:execFd.
+ ] ifFalse:[
+ "redirect stdin of subprocess to read from pipe"
+ myFd := pipeFdArray at:2.
+ execFd := pipeFdArray at:1.
+ execFdArray at:1 put:execFd.
+ ].
+ ].
].
errorDisposition == #discard ifTrue:[
- nullOutput := Filename nullDevice writeStream.
- execFdArray at:3 put:nullOutput fileDescriptor
+ nullOutput := Filename nullDevice writeStream.
+ execFdArray at:3 put:nullOutput fileDescriptor
] ifFalse:[
- (errorDisposition == #inline or:[errorDisposition == #stdout]) ifTrue:[
- execFdArray at:3 put:1
- ] ifFalse:[
+ (errorDisposition == #inline or:[errorDisposition == #stdout]) ifTrue:[
+ execFdArray at:3 put:1
+ ] ifFalse:[
"/ errorDisposition isStream ifTrue:[
"/self halt.
"/ ].
- ].
+ ].
].
"/ must block here, to avoid races due to early finishing
@@ -716,84 +716,84 @@
"beware: pid may change if subprocess is fast"
pid := resultPid := Processor
- monitor:[
- OperatingSystem
- exec:shellPath
- withArguments:shellArgs
- environment:nil
- fileDescriptors:execFdArray
- fork:true
- newPgrp:true
- inDirectory:execDirectory.
- ]
- action:[:status |
- status stillAlive ifFalse:[
- exitStatus := status.
+ monitor:[
+ OperatingSystem
+ exec:shellPath
+ withArguments:shellArgs
+ environment:nil
+ fileDescriptors:execFdArray
+ fork:true
+ newPgrp:true
+ inDirectory:execDirectory.
+ ]
+ action:[:status |
+ status stillAlive ifFalse:[
+ exitStatus := status.
- "writing doesn't make sense - there is no reader any longer"
- mode == #readwrite ifTrue:[
- "... but allow to read the rest of the command's output"
- self shutDownOutput.
- ] ifFalse:[mode == #writeonly ifTrue:[
- self closeFileDescriptor.
- ]].
+ "writing doesn't make sense - there is no reader any longer"
+ mode == #readwrite ifTrue:[
+ "... but allow to read the rest of the command's output"
+ self shutDownOutput.
+ ] ifFalse:[mode == #writeonly ifTrue:[
+ self closeFileDescriptor.
+ ]].
- OperatingSystem closePid:pid.
- pid := nil.
- exitSema signal.
- ].
- ].
+ OperatingSystem closePid:pid.
+ pid := nil.
+ exitSema signal.
+ ].
+ ].
"subprocess has been created.
close unused filedescriptors"
execFd notNil ifTrue:[
- OperatingSystem closeFd:execFd.
+ OperatingSystem closeFd:execFd.
].
nullOutput notNil ifTrue:[
- nullOutput close
+ nullOutput close
].
resultPid notNil ifTrue:[
- "successfull creation of subprocesss"
- OperatingSystem isVMSlike ifTrue:[
- "/
- "/ reopen the mailbox as a file ...
- "/
- mbxName := OperatingSystem mailBoxNameOf:mbx.
- mbxName notNil ifTrue:[
- super open:mbxName withMode:rwMode.
- exitAction := [tmpComFile delete].
- ].
- ] ifFalse:[
- self setFileDescriptor:myFd mode:rwMode.
- handleType := #pipeFilePointer.
- ]
+ "successfull creation of subprocesss"
+ OperatingSystem isVMSlike ifTrue:[
+ "/
+ "/ reopen the mailbox as a file ...
+ "/
+ mbxName := OperatingSystem mailBoxNameOf:mbx.
+ mbxName notNil ifTrue:[
+ super open:mbxName withMode:rwMode.
+ exitAction := [tmpComFile delete].
+ ].
+ ] ifFalse:[
+ self setFileHandle:myFd mode:rwMode.
+ handleType := #pipeFilePointer.
+ ]
] ifFalse:[
- "creation of subprocesss failed"
- lastErrorNumber := OperatingSystem currentErrorNumber.
- OperatingSystem isVMSlike ifTrue:[
- OperatingSystem destroyMailBox:mbx.
- tmpComFile delete.
- ] ifFalse:[
- OperatingSystem closeFd:myFd.
- ].
+ "creation of subprocesss failed"
+ lastErrorNumber := OperatingSystem currentErrorNumber.
+ OperatingSystem isVMSlike ifTrue:[
+ OperatingSystem destroyMailBox:mbx.
+ tmpComFile delete.
+ ] ifFalse:[
+ OperatingSystem closeFd:myFd.
+ ].
].
blocked ifFalse:[
- OperatingSystem unblockInterrupts
+ OperatingSystem unblockInterrupts
].
(resultPid isNil or:[lastErrorNumber notNil]) ifTrue:[
- "
- the pipe open failed for some reason ...
- ... this may be either due to an invalid command string,
- or due to the system running out of memory (when forking
- the unix process)
- "
- exitAction value.
- ^ self openError:lastErrorNumber.
+ "
+ the pipe open failed for some reason ...
+ ... this may be either due to an invalid command string,
+ or due to the system running out of memory (when forking
+ the unix process)
+ "
+ exitAction value.
+ ^ self openError:lastErrorNumber.
].
commandString := realCmd.
--- a/PolymorphicInlineCache.st Wed Jul 06 06:50:27 2016 +0200
+++ b/PolymorphicInlineCache.st Sat Jul 09 21:10:24 2016 +0100
@@ -25,6 +25,8 @@
"
"{ Package: 'stx:libbasic' }"
+"{ NameSpace: Smalltalk }"
+
Object subclass:#PolymorphicInlineCache
instanceVariableNames:'address numArgs'
classVariableNames:''
@@ -69,14 +71,14 @@
used by the virtual machine.
[author:]
- Jan Vrany <jan.vrany@fit.cvut.cz>
- Janb Kurs <kursjan@fit.cvut.cz>
+ Jan Vrany <jan.vrany@fit.cvut.cz>
+ Janb Kurs <kursjan@fit.cvut.cz>
[instance variables:]
- address <ExternalAddress> a pointer to the VM inline cache structure.
- if the adress is NULL, then PolymorphicInlineCache
- is invalid.
- numArgs <SmallInteger> a number of arguments
+ address <ExternalAddress> a pointer to the VM inline cache structure.
+ if the address is NULL, then PolymorphicInlineCache
+ is invalid.
+ numArgs <SmallInteger> a number of arguments
[class variables:]
[see also:]
@@ -102,9 +104,10 @@
!PolymorphicInlineCache class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/PolymorphicInlineCache.st,v 1.2 2015-05-17 23:57:27 cg Exp $'
+ ^ '$Header$'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/PolymorphicInlineCache.st,v 1.2 2015-05-17 23:57:27 cg Exp $'
+ ^ '$Header$'
! !
+
--- a/PositionableStream.st Wed Jul 06 06:50:27 2016 +0200
+++ b/PositionableStream.st Sat Jul 09 21:10:24 2016 +0100
@@ -949,6 +949,22 @@
"Modified: / 12.1.1998 / 22:06:42 / cg"
"Created: / 12.1.1998 / 22:07:01 / cg"
+!
+
+upToEnd
+ collection notNil ifTrue:[
+ |result|
+
+ result := collection copyFrom:position+1 to:readLimit.
+ position := readLimit.
+ ^ result.
+ ].
+
+ ^ super upToEnd.
+
+ "
+ 'abc' readStream upToEnd.
+ "
! !
!PositionableStream methodsFor:'testing'!
--- a/ReadWriteStream.st Wed Jul 06 06:50:27 2016 +0200
+++ b/ReadWriteStream.st Sat Jul 09 21:10:24 2016 +0100
@@ -102,13 +102,6 @@
^ super next:count
!
-nextByte
- "return the next element; advance read pointer.
- return nil, if there is no next element"
-
- ^ self next asInteger
-!
-
peek
"return the element to be read next without advancing read position.
If there are no more elements, nil is returned."
@@ -132,8 +125,8 @@
"return the contents as written so far;
redefined to prevent confusion resulting due to
my superclasses optimization. (see WriteStream contents).
- ST80 users if RWStream expect the contents array to remain
- unchanged."
+ ST80 users of ReadWriteStream may expect the contents array to remain
+ unchanged, which we do not guarantee."
readLimit := (readLimit ? 0) max:position.
^ collection copyFrom:1 to:readLimit
--- a/RecursionLock.st Wed Jul 06 06:50:27 2016 +0200
+++ b/RecursionLock.st Sat Jul 09 21:10:24 2016 +0100
@@ -1,5 +1,3 @@
-"{ Encoding: utf8 }"
-
"
COPYRIGHT (c) 1995 by Claus Gittinger
All Rights Reserved
@@ -250,14 +248,14 @@
!
critical:aBlock ifBlocking:blockingBlock
- "like critical:, but do not block if the lock cannot be aquired.
+ "like critical:, but do not block if the lock cannot be acquired.
Instead, return the value of the second argument, blockingBlock."
^ self critical:aBlock timeoutMs:0 ifBlocking:blockingBlock.
!
critical:aBlock timeoutMs:timeoutMs ifBlocking:blockingBlock
- "like critical:, but do not block if the lock cannot be aquired
+ "like critical:, but do not block if the lock cannot be acquired
within timeoutMs milliseconds.
Instead, return the value of blockingBlock."
--- a/Registry.st Wed Jul 06 06:50:27 2016 +0200
+++ b/Registry.st Sat Jul 09 21:10:24 2016 +0100
@@ -1,5 +1,3 @@
-"{ Encoding: utf8 }"
-
"
COPYRIGHT (c) 1993,2015 by Claus Gittinger
All Rights Reserved
@@ -55,7 +53,7 @@
Of course, you too can use it to do whatever you need to do in case of the
death of an object.
- Registries use #executor to aquire the copy of the original,
+ Registries use #executor to acquire the copy of the original,
this can be redefined in individual classes for faster copying
(typically, not all internal state, but only some device handles are needed for
finalization). If the to-be-registered object is large, this method may also
--- a/Semaphore.st Wed Jul 06 06:50:27 2016 +0200
+++ b/Semaphore.st Sat Jul 09 21:10:24 2016 +0100
@@ -1,5 +1,3 @@
-"{ Encoding: utf8 }"
-
"
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
@@ -112,179 +110,179 @@
examples
"
two processes synchronizing on a sema:
- [exBegin]
- |sema thread1 thread2|
+ [exBegin]
+ |sema thread1 thread2|
- sema := Semaphore new.
+ sema := Semaphore new.
- thread1 := [
- Transcript showCR:'here is thread 1; now waiting ...'.
- sema wait.
- Transcript showCR:'here is thread 1 again.'.
- ] newProcess.
+ thread1 := [
+ Transcript showCR:'here is thread 1; now waiting ...'.
+ sema wait.
+ Transcript showCR:'here is thread 1 again.'.
+ ] newProcess.
- thread2 := [
- Transcript showCR:'here is thread 2; delaying a bit ...'.
- Delay waitForSeconds:5.
- Transcript showCR:'here is thread 2 again; now signalling the sema'.
- sema signal.
- Transcript showCR:'here is thread 2 after the signalling.'.
- ] newProcess.
+ thread2 := [
+ Transcript showCR:'here is thread 2; delaying a bit ...'.
+ Delay waitForSeconds:5.
+ Transcript showCR:'here is thread 2 again; now signalling the sema'.
+ sema signal.
+ Transcript showCR:'here is thread 2 after the signalling.'.
+ ] newProcess.
- thread1 priority:7.
- thread2 priority:6.
+ thread1 priority:7.
+ thread2 priority:6.
- thread1 resume.
- thread2 resume.
- [exEnd]
+ thread1 resume.
+ thread2 resume.
+ [exEnd]
semaphore for critical regions:
- [exBegin]
- |accessLock|
+ [exBegin]
+ |accessLock|
- accessLock := Semaphore forMutualExclusion.
+ accessLock := Semaphore forMutualExclusion.
- [
- 5 timesRepeat:[
- Delay waitForSeconds:2.
- accessLock critical:[
- Transcript showCR:'thread1 in critical region'.
- Delay waitForSeconds:1.
- Transcript showCR:'thread1 leaving critical region'.
- ].
- ]
- ] forkAt:5.
+ [
+ 5 timesRepeat:[
+ Delay waitForSeconds:2.
+ accessLock critical:[
+ Transcript showCR:'thread1 in critical region'.
+ Delay waitForSeconds:1.
+ Transcript showCR:'thread1 leaving critical region'.
+ ].
+ ]
+ ] forkAt:5.
- [
- 5 timesRepeat:[
- Delay waitForSeconds:1.
- accessLock critical:[
- Transcript showCR:'thread2 in critical region'.
- Delay waitForSeconds:2.
- Transcript showCR:'thread2 leaving critical region'.
- ].
- ]
- ] forkAt:4.
- [exEnd]
+ [
+ 5 timesRepeat:[
+ Delay waitForSeconds:1.
+ accessLock critical:[
+ Transcript showCR:'thread2 in critical region'.
+ Delay waitForSeconds:2.
+ Transcript showCR:'thread2 leaving critical region'.
+ ].
+ ]
+ ] forkAt:4.
+ [exEnd]
a deadlock due to recursive enter of a critical region:
- [exBegin]
- |accessLock block|
+ [exBegin]
+ |accessLock block|
- accessLock := Semaphore forMutualExclusion.
+ accessLock := Semaphore forMutualExclusion.
- block := [:arg |
- Transcript showCR:'about to enter'.
- accessLock critical:[
- Transcript showCR:'entered - doing action'.
- arg value
- ].
- Transcript showCR:'left region'.
- ].
+ block := [:arg |
+ Transcript showCR:'about to enter'.
+ accessLock critical:[
+ Transcript showCR:'entered - doing action'.
+ arg value
+ ].
+ Transcript showCR:'left region'.
+ ].
- block value:[]. 'this works'.
- block value:[block value:[] ]. 'this deadlocks'.
- [exEnd]
+ block value:[]. 'this works'.
+ block value:[block value:[] ]. 'this deadlocks'.
+ [exEnd]
Avoid the deadlock by using a RecursionLock instead:
- [exBegin]
- |accessLock block|
+ [exBegin]
+ |accessLock block|
- accessLock := RecursionLock new.
+ accessLock := RecursionLock new.
- block := [:arg |
- Transcript showCR:'about to enter'.
- accessLock critical:[
- Transcript showCR:'entered - doing action'.
- arg value
- ].
- Transcript showCR:'left region'.
- ].
+ block := [:arg |
+ Transcript showCR:'about to enter'.
+ accessLock critical:[
+ Transcript showCR:'entered - doing action'.
+ arg value
+ ].
+ Transcript showCR:'left region'.
+ ].
- block value:[]. 'this works'.
- block value:[block value:[] ]. 'this deadlocks'.
- [exEnd]
+ block value:[]. 'this works'.
+ block value:[block value:[] ]. 'this deadlocks'.
+ [exEnd]
Wait for multiple processes to arrive at a sync-point:
- [exBegin]
- |syncSema proceedSema thread1 thread2 thread3|
+ [exBegin]
+ |syncSema proceedSema thread1 thread2 thread3|
- syncSema := Semaphore new.
- syncSema setCount:(1-3).
- proceedSema := Semaphore new.
+ syncSema := Semaphore new.
+ syncSema setCount:(1-3).
+ proceedSema := Semaphore new.
- thread1 := [
- Transcript showCR:'here is thread 1; now busy ...'.
- Delay waitForSeconds:(2 + (Random nextIntegerBetween:2 and:4)).
- Transcript showCR:'here is thread 1 again - now syncing.'.
- syncSema signal.
- Transcript showCR:'thread 1 is waiting for all others...'.
- proceedSema wait.
- Transcript showCR:'thread 1 done.'.
- ] newProcess.
+ thread1 := [
+ Transcript showCR:'here is thread 1; now busy ...'.
+ Delay waitForSeconds:(2 + (Random nextIntegerBetween:2 and:4)).
+ Transcript showCR:'here is thread 1 again - now syncing.'.
+ syncSema signal.
+ Transcript showCR:'thread 1 is waiting for all others...'.
+ proceedSema wait.
+ Transcript showCR:'thread 1 done.'.
+ ] newProcess.
- thread2 := [
- Transcript showCR:'here is thread 2; now busy ...'.
- Delay waitForSeconds:(3 + (Random nextIntegerBetween:2 and:4)).
- Transcript showCR:'here is thread 2 again - now syncing.'.
- syncSema signal.
- Transcript showCR:'thread 2 is waiting for all others...'.
- proceedSema wait.
- Transcript showCR:'thread 2 done.'.
- ] newProcess.
+ thread2 := [
+ Transcript showCR:'here is thread 2; now busy ...'.
+ Delay waitForSeconds:(3 + (Random nextIntegerBetween:2 and:4)).
+ Transcript showCR:'here is thread 2 again - now syncing.'.
+ syncSema signal.
+ Transcript showCR:'thread 2 is waiting for all others...'.
+ proceedSema wait.
+ Transcript showCR:'thread 2 done.'.
+ ] newProcess.
- thread3 := [
- Transcript showCR:'here is thread 3; now busy ...'.
- Delay waitForSeconds:(4 + (Random nextIntegerBetween:2 and:4)).
- Transcript showCR:'here is thread 3 again - now syncing.'.
- syncSema signal.
- Transcript showCR:'thread 3 is waiting for all others...'.
- proceedSema wait.
- Transcript showCR:'thread 3 done.'.
- ] newProcess.
+ thread3 := [
+ Transcript showCR:'here is thread 3; now busy ...'.
+ Delay waitForSeconds:(4 + (Random nextIntegerBetween:2 and:4)).
+ Transcript showCR:'here is thread 3 again - now syncing.'.
+ syncSema signal.
+ Transcript showCR:'thread 3 is waiting for all others...'.
+ proceedSema wait.
+ Transcript showCR:'thread 3 done.'.
+ ] newProcess.
- thread1 priority:7.
- thread2 priority:6.
- thread3 priority:9.
+ thread1 priority:7.
+ thread2 priority:6.
+ thread3 priority:9.
- thread1 resume.
- thread2 resume.
- thread3 resume.
+ thread1 resume.
+ thread2 resume.
+ thread3 resume.
- Transcript showCR:'main thread: now waiting for other threads...'.
- syncSema wait.
- Transcript showCR:'main thread: all other threads at syncPoint.'.
- Delay waitForSeconds:2.
- Transcript showCR:'main thread: now let them proceed...'.
- proceedSema signalForAll.
- Transcript showCR:'main thread: done.'.
- [exEnd]
+ Transcript showCR:'main thread: now waiting for other threads...'.
+ syncSema wait.
+ Transcript showCR:'main thread: all other threads at syncPoint.'.
+ Delay waitForSeconds:2.
+ Transcript showCR:'main thread: now let them proceed...'.
+ proceedSema signalForAll.
+ Transcript showCR:'main thread: done.'.
+ [exEnd]
- waitWithTimeout:0 can also be used to conditionally aquire the semaphore
- i.e. only aquire it if its available.
+ waitWithTimeout:0 can also be used to conditionally acquire the semaphore
+ i.e. only acquire it if it is available.
|s|
s := Semaphore new.
[
- (s waitWithTimeout:0) notNil ifTrue:[
- Transcript showCR:'process1 got the sema'.
- Delay waitForSeconds:1.
- Transcript showCR:'process1 signals sema'.
- s signal.
- ] ifFalse:[
- Transcript showCR:'process1 has NOT got the sema'.
- ].
+ (s waitWithTimeout:0) notNil ifTrue:[
+ Transcript showCR:'process1 got the sema'.
+ Delay waitForSeconds:1.
+ Transcript showCR:'process1 signals sema'.
+ s signal.
+ ] ifFalse:[
+ Transcript showCR:'process1 has NOT got the sema'.
+ ].
] fork.
[
- (s waitWithTimeout:0) notNil ifTrue:[
- Transcript showCR:'process2 got the sema'.
- Delay waitForSeconds:1.
- Transcript showCR:'process2 signals sema'.
- s signal.
- ] ifFalse:[
- Transcript showCR:'process2 has NOT got the sema'.
- ]
+ (s waitWithTimeout:0) notNil ifTrue:[
+ Transcript showCR:'process2 got the sema'.
+ Delay waitForSeconds:1.
+ Transcript showCR:'process2 signals sema'.
+ s signal.
+ ] ifFalse:[
+ Transcript showCR:'process2 has NOT got the sema'.
+ ]
] fork.
s signal.
Delay waitForSeconds:0.5.
--- a/SequenceableCollection.st Wed Jul 06 06:50:27 2016 +0200
+++ b/SequenceableCollection.st Sat Jul 09 21:10:24 2016 +0100
@@ -451,6 +451,8 @@
^ self == SequenceableCollection
! !
+
+
!SequenceableCollection methodsFor:'Compatibility-Squeak'!
allButFirst
@@ -7876,6 +7878,7 @@
"Created: 14.2.1997 / 16:13:03 / cg"
! !
+
!SequenceableCollection methodsFor:'searching'!
detect:aBlock startingAt:startIndex
@@ -8104,6 +8107,55 @@
^ self indexOfSubCollection:aCollection startingAt:startIndex ifAbsent:[0]
!
+indexOfSubCollection:aCollection startingAt:startIndex endingAt:endIndex ifAbsent:exceptionBlock
+ "find a subcollection, starting at index. If found, return the index;
+ if not found, return the result of evaluating exceptionBlock.
+ This is a q&d hack - not very efficient"
+
+ |same first lastIndex checkIndex "{Class: SmallInteger }"
+ cmpIndex "{Class: SmallInteger }"
+ sz "{Class: SmallInteger }"|
+
+ sz := aCollection size.
+ sz == 0 ifTrue:[^ exceptionBlock value].
+ first := aCollection at:1.
+
+ lastIndex := self size.
+ (endIndex notNil and:[endIndex < lastIndex]) ifTrue:[
+ lastIndex := endIndex.
+ ].
+
+ checkIndex := startIndex - 1.
+ [
+ checkIndex := self indexOf:first startingAt:checkIndex+1 endingAt:lastIndex.
+ checkIndex == 0 ifTrue:[^ exceptionBlock value].
+
+ (checkIndex + sz - 1) > lastIndex ifTrue:[
+ ^ 0
+ ].
+ same := true.
+ cmpIndex := 1.
+ [same and:[cmpIndex <= sz]] whileTrue:[
+ (self at:checkIndex + cmpIndex - 1) = (aCollection at:cmpIndex) ifFalse:[
+ same := false
+ ] ifTrue:[
+ cmpIndex := cmpIndex + 1
+ ]
+ ].
+ same ifTrue:[^ checkIndex].
+ ] loop.
+
+ "
+ #(1 2 3 4 5 6 7) indexOfSubCollection:#() startingAt:2 endingAt:nil ifAbsent:0
+ #(1 2 3 4 5 6 7) indexOfSubCollection:#(1) startingAt:2 endingAt:nil ifAbsent:0
+ #(1 2 1 2 1 2 3) indexOfSubCollection:#(1 2 3) startingAt:2 endingAt:nil ifAbsent:0
+ #(1 2 1 2 1 2 3) indexOfSubCollection:#(1 2 3) startingAt:2 endingAt:6 ifAbsent:0
+ #(1 2 1 2 1 2 3) indexOfSubCollection:#(1 2) startingAt:2 endingAt:nil ifAbsent:0
+ #(1 2 1 2 1 2 3) indexOfSubCollection:#(1 2) startingAt:3 endingAt:nil ifAbsent:0
+ #(1 2 1 2 1 2 3) indexOfSubCollection:#(1 2) startingAt:4 endingAt:nil ifAbsent:0
+ "
+!
+
indexOfSubCollection:aCollection startingAt:startIndex ifAbsent:exceptionBlock
"find a subcollection, starting at index. If found, return the index;
if not found, return the result of evaluating exceptionBlock.
--- a/Signal.st Wed Jul 06 06:50:27 2016 +0200
+++ b/Signal.st Sat Jul 09 21:10:24 2016 +0100
@@ -1,5 +1,3 @@
-"{ Encoding: utf8 }"
-
"
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
@@ -41,20 +39,20 @@
documentation
"
Note:
- The instance based Signal framework is being replaced by class based exceptions.
- I.e. what used to be instances of Signal/QuerySignal is beeing
- rewritten into subclasses of Exception/Error/Query and Warning.
+ The instance based Signal framework is being replaced by class based exceptions.
+ I.e. what used to be instances of Signal/QuerySignal is beeing
+ rewritten into subclasses of Exception/Error/Query and Warning.
- Although the functionality is basically unchanged, the new
- class based exceptions are easier to instanciate (no need for
- creation in a classes initialize method), easier to use (no real
- need for Signal-constant accessors) and allow for easier parameter
- passing (not only a single parameter, but allows for individual
- exception subclasses to add additional state).
+ Although the functionality is basically unchanged, the new
+ class based exceptions are easier to instantiate (no need for
+ creation in a classes initialize method), easier to use (no real
+ need for Signal-constant accessors) and allow for easier parameter
+ passing (not only a single parameter, but allows for individual
+ exception subclasses to add additional state).
- However, the old Signal hierarchy will remain in existance, since it allows
- funny instance-specific and anonymous exception handling schemes to be
- implemented, which are hard to built using class-based exceptions.
+ However, the old Signal hierarchy will remain in existance, since it allows
+ funny instance-specific and anonymous exception handling schemes to be
+ implemented, which are hard to built using class-based exceptions.
Signal and Exception provide a framework for exception handling.
@@ -107,34 +105,34 @@
[Instance variables:]
- mayProceed <Boolean> hint for the debugger - program may
- proceed (currently not honored by the
- debugger)
+ mayProceed <Boolean> hint for the debugger - program may
+ proceed (currently not honored by the
+ debugger)
- notifierString <String> error message to be output
+ notifierString <String> error message to be output
- nameClass <Class> for the printOn-implementation; nameClass
- is the class, to which message (below)
- should be sent to create the receiver.
+ nameClass <Class> for the printOn-implementation; nameClass
+ is the class, to which message (below)
+ should be sent to create the receiver.
- message <Symbol> for the printOn-implementation; message
- is the selector, which should be sent to
- nameClass (above) to create the receiver.
+ message <Symbol> for the printOn-implementation; message
+ is the selector, which should be sent to
+ nameClass (above) to create the receiver.
- handlerBlock <Block> if nonNil, a 1-arg block to be
- evaluated when no handler context is
- found. The block gets the exception
- object as argument. This will play the role
- of an on-stack handler.
+ handlerBlock <Block> if nonNil, a 1-arg block to be
+ evaluated when no handler context is
+ found. The block gets the exception
+ object as argument. This will play the role
+ of an on-stack handler.
[author:]
- Claus Gittinger
+ Claus Gittinger
[see also:]
- GenericException
- SignalSet QuerySignal
- Object
- (``Exception handling and signals'': programming/exceptions.html)
+ GenericException
+ SignalSet QuerySignal
+ Object
+ (``Exception handling and signals'': programming/exceptions.html)
"
! !
--- a/Smalltalk.st Wed Jul 06 06:50:27 2016 +0200
+++ b/Smalltalk.st Sat Jul 09 21:10:24 2016 +0100
@@ -2879,7 +2879,7 @@
allClasses
"return an unordered collection of all classes in the system.
Only globally anchored classes are returned
- (i.e. anonymous ones have to be aquired by Behavior allSubInstances)"
+ (i.e. anonymous ones have to be acquired by Behavior allSubInstances)"
|classes|
@@ -2891,27 +2891,27 @@
"/ If that happens, we restart the set-building here
"/
[(classes := CachedClasses) isNil] whileTrue:[
- CachedClasses := classes := IdentitySet new:NumberOfClassesHint.
- self keysAndValuesDo:[:eachName :eachGlobal |
- (eachGlobal notNil and:[eachGlobal isBehavior]) ifTrue:[
- "/ sigh - would like to skip over aliases
- "/ but this cannot be done simply by comparing
- "/ the classes name against the store-key
- "/ i.e. cannot do:
- "/ anObject name == sym ifTrue:[
- "/ classes add:anObject
- "/ ]
- "/ because that would lead to ignore all java
- "/ classes, which are stored under a different
- "/ key.
-
- (eachGlobal name == eachName
- or:[eachGlobal isJavaClass]) ifTrue:[
- classes add:eachGlobal
- ].
- ]
- ].
- NumberOfClassesHint := classes size.
+ CachedClasses := classes := IdentitySet new:NumberOfClassesHint.
+ self keysAndValuesDo:[:eachName :eachGlobal |
+ (eachGlobal notNil and:[eachGlobal isBehavior]) ifTrue:[
+ "/ sigh - would like to skip over aliases
+ "/ but this cannot be done simply by comparing
+ "/ the classes name against the store-key
+ "/ i.e. cannot do:
+ "/ anObject name == sym ifTrue:[
+ "/ classes add:anObject
+ "/ ]
+ "/ because that would lead to ignore all java
+ "/ classes, which are stored under a different
+ "/ key.
+
+ (eachGlobal name == eachName
+ or:[eachGlobal isJavaClass]) ifTrue:[
+ classes add:eachGlobal
+ ].
+ ]
+ ].
+ NumberOfClassesHint := classes size.
].
^ classes
@@ -2943,16 +2943,16 @@
allClassesWithAllPrivateClasses
"return an unordered collection of all classes in the Smalltalk namespace.
Only globally anchored classes are returned; Namespaces are not included.
- (i.e. anonymous ones have to be aquired by Behavior allSubInstances)"
+ (i.e. anonymous ones have to be acquired by Behavior allSubInstances)"
^ self allClasses select:[:aClass |
- |owner|
-
- (aClass isRealNameSpace not)
- and:[
- owner := aClass topOwningClass.
- (owner ? aClass) nameSpace == Smalltalk
- ]
+ |owner|
+
+ (aClass isRealNameSpace not)
+ and:[
+ owner := aClass topOwningClass.
+ (owner ? aClass) nameSpace == Smalltalk
+ ]
]
"
--- a/Stream.st Wed Jul 06 06:50:27 2016 +0200
+++ b/Stream.st Sat Jul 09 21:10:24 2016 +0100
@@ -214,6 +214,7 @@
^ ChunkSeparator
! !
+
!Stream methodsFor:'Compatibility-Dolphin'!
display:someObject
@@ -223,57 +224,6 @@
self nextPutAll: someObject asString.
! !
-!Stream methodsFor:'Compatibility-ST80'!
-
-nextLongPut:aNumber
- <resource: #obsolete>
-
- "for ST-80 compatibility:
- Write the argument, aNumber as a long (four bytes).
- The most significant byte is sent first."
-
- ^ self nextPutInt32:aNumber MSB:true
-
- "Modified: 10.1.1996 / 19:38:54 / cg"
-!
-
-nextPutWord:aNumber
- <resource: #obsolete>
-
- "write the argument, aNumber as a signed short (two bytes);
- write msb-first for compatibility with other smalltalks.
- The receiver must support writing of binary bytes.
- I dont know if it should be named nextPutWord: or nextWordPut:;
- one of them will vanish ..."
-
- ^ self nextPutInt16:aNumber MSB:true
-!
-
-nextTwoBytesPut: anInteger
- <resource: #obsolete>
- "Write anInteger as the next two bytes of the
- receiver stream."
-
- self obsoleteMethodWarning:'use #nextPutShort:MSB:'.
-
- self
- nextPutByte: (anInteger bitAnd: 255);
- nextPutByte: ((anInteger bitShift: -8) bitAnd: 255)
-
- "Created: / 21-06-2006 / 19:42:10 / fm"
-!
-
-nextWordPut:aNumber
- <resource: #obsolete>
-
- "for ST-80 compatibility:
- Write the argument, aNumber as a short (two bytes).
- The most significant byte is sent first."
-
- ^ self nextPutInt16:aNumber MSB:true
-
- "Modified: 10.1.1996 / 19:39:19 / cg"
-! !
@@ -1059,20 +1009,6 @@
^ ShortFloat readBinaryIEEESingleFrom:self MSB:msbFirst
!
-nextInt16LSB
- "return a signed short (2 bytes) in LSB-first order from the stream.
- The receiver must support reading of binary bytes."
-
- ^ self nextInt16MSB:false
-!
-
-nextInt16MSB
- "return a signed short (2 bytes) in MSB-first order from the stream.
- The receiver must support reading of binary bytes."
-
- ^ self nextInt16MSB:true
-!
-
nextInt16MSB:msbFlag
"return a signed short (2 bytes) from the stream.
The receiver must support reading of binary bytes.
@@ -1108,16 +1044,6 @@
"Modified: 11.7.1996 / 10:07:04 / cg"
!
-nextInt16Net
- "return a signed short (2 bytes) in network byte order from the stream.
- The receiver must support reading of binary bytes.
- Network byte order is MSB-first per definition"
-
- ^ self nextInt16MSB:true
-
- "Created: 10.1.1996 / 19:49:41 / cg"
-!
-
nextInt24MSB:msbFlag
"return a signed 3 byte integer from the stream.
The receiver must support reading of binary bytes.
@@ -1148,20 +1074,6 @@
"
!
-nextInt32LSB
- "return a signed long (4 bytes) in LSB-first order from the stream.
- The receiver must support reading of binary bytes."
-
- ^ self nextInt32MSB:false
-!
-
-nextInt32MSB
- "return a signed long (4 bytes) in MSB-first order from the stream.
- The receiver must support reading of binary bytes."
-
- ^ self nextInt32MSB:true
-!
-
nextInt32MSB:msbFlag
"return a signed long (4 bytes) from the stream.
The receiver must support reading of binary bytes.
@@ -1224,30 +1136,6 @@
"Modified: / 14.1.1998 / 15:40:41 / cg"
!
-nextInt32Net
- "return a signed long (4 bytes) in network byte order from the stream.
- The receiver must support reading of binary bytes.
- Network byte order is MSB-first per definition"
-
- ^ self nextInt32MSB:true
-
- "Created: 10.1.1996 / 19:49:28 / cg"
-!
-
-nextInt64LSB
- "return a signed longlong (also called hyper) (8 bytes) in LSB-first order from the stream.
- The receiver must support reading of binary bytes."
-
- ^ self nextInt64MSB:false
-!
-
-nextInt64MSB
- "return a signed longlong (also called hyper) (8 bytes) in MSB-first order from the stream.
- The receiver must support reading of binary bytes."
-
- ^ self nextInt64MSB:true
-!
-
nextInt64MSB:msbFlag
"return a signed longlong (also called hyper) (8 bytes) from the stream.
The receiver must support reading of binary bytes.
@@ -1301,21 +1189,6 @@
"Modified: / 14.1.1998 / 15:40:41 / cg"
!
-nextInt64Net
- "return a signed longlong (also called hyper) (8 bytes) in network byte order from the stream.
- The receiver must support reading of binary bytes.
- Network byte order is MSB-first per definition"
-
- ^ self nextInt64MSB:true
-!
-
-nextNumber:numBytes
- "Return the next n bytes as a positive Integer;
- bytes are taken msb-first."
-
- ^ self nextUnsigned:numBytes MSB:true
-!
-
nextSignedByte
"return a signed byte (-128..127) from the stream.
The receiver must support reading of binary bytes."
@@ -1418,65 +1291,6 @@
"
!
-nextUnsignedHyperMSB:msbFlag
- "return an unsigned hyper (8 bytes) from the stream.
- The receiver must support reading of binary bytes.
-
- The msbFlag argument controls if the integer is to be read with
- most-significant-byte-first (true) or least-first (false).
- This interface is provided to allow talking to external programs,
- where it's known that the byte order is some definite one.
- If you don't care (i.e. talk to other smalltalks) or you can control the
- order, please use the corresponding xxxNet methods, which use a standard
- network byte order."
-
- ^ self nextUnsignedInt64MSB:msbFlag
-
- "
- |bytes s|
-
- bytes := #[16rFF 16rFF 16rFF 16rFF 16rFF 16rFF 16rFF 16rFF].
- s := bytes readStream.
- Transcript showCR:(s nextUnsignedHyperMSB:true) hexPrintString.
- s reset.
- Transcript showCR:(s nextUnsignedHyperMSB:false) hexPrintString.
-
- bytes := #[16r10 16r00 16r00 16r00 16r00 16r00 16r00 16r00].
- s := bytes readStream.
- Transcript showCR:(s nextUnsignedHyperMSB:true) hexPrintString.
- s reset.
- Transcript showCR:(s nextUnsignedHyperMSB:false) hexPrintString.
-
- bytes := #[16r12 16r34 16r56 16r78 16r9a 16rbc 16rde 16rf0].
- s := bytes readStream.
- Transcript showCR:(s nextUnsignedHyperMSB:true) hexPrintString.
- s reset.
- Transcript showCR:(s nextUnsignedHyperMSB:false) hexPrintString.
-
- bytes := #[16rFe 16rdc 16rba 16r98 16r76 16r54 16r32 16r10].
- s := bytes readStream.
- Transcript showCR:(s nextUnsignedHyperMSB:true) hexPrintString.
- s reset.
- Transcript showCR:(s nextUnsignedHyperMSB:false) hexPrintString.
- "
-
- "Modified: / 14.1.1998 / 15:40:41 / cg"
-!
-
-nextUnsignedInt16LSB
- "return an unsigned short (2 bytes) in LSB-first order from the stream.
- The receiver must support reading of binary bytes."
-
- ^ self nextUnsignedInt16MSB:false
-!
-
-nextUnsignedInt16MSB
- "return an unsigned short (2 bytes) in MSB-first order from the stream.
- The receiver must support reading of binary bytes."
-
- ^ self nextUnsignedInt16MSB:true
-!
-
nextUnsignedInt16MSB:msbFlag
"return an unsigned short (2 bytes) from the stream.
The receiver must support reading of binary bytes.
@@ -1489,19 +1303,22 @@
order, please use the corresponding xxxNet methods, which use a standard
network byte order."
- |b1 b2 bH bL|
+ |b1 b2 uval "{ Class: SmallInteger }"|
b1 := self nextByte.
b2 := self nextByte.
msbFlag ifTrue:[
- bH := b1.
- bL := b2.
+ "most significant first"
+ uval := b1 bitShift:8.
+ uval := uval bitOr:b2.
] ifFalse:[
- bL := b1.
- bH := b2.
- ].
- ^ (bH bitShift:8) bitOr:bL
+ "least significant first"
+ uval := b2 bitShift:8.
+ uval := uval bitOr:b1.
+ ].
+
+ ^ uval
"
((ReadStream on:#[16r10 16r20 16r30]) nextUnsignedInt16MSB:true) hexPrintString
@@ -1511,16 +1328,6 @@
"Modified: 11.7.1996 / 10:07:20 / cg"
!
-nextUnsignedInt16Net
- "return an unsigned short (2 bytes) in network byte order from the stream.
- The receiver must support reading of binary bytes.
- Network byte order is MSB-first per definition"
-
- ^ self nextUnsignedInt16MSB:true
-
- "Created: 10.1.1996 / 19:50:02 / cg"
-!
-
nextUnsignedInt24MSB:msbFlag
"return an unsigned 3 byte integer from the stream.
The receiver must support reading of binary bytes.
@@ -1556,20 +1363,6 @@
"
!
-nextUnsignedInt32LSB
- "return an unsigned long (4 bytes) in LSB-first order from the stream.
- The receiver must support reading of binary bytes."
-
- ^ self nextUnsignedInt32MSB:false
-!
-
-nextUnsignedInt32MSB
- "return an unsigned long (4 bytes) in MSB-first order from the stream.
- The receiver must support reading of binary bytes."
-
- ^ self nextUnsignedInt32MSB:true
-!
-
nextUnsignedInt32MSB:msbFlag
"return an unsigned long (4 bytes) from the stream.
The receiver must support reading of binary bytes.
@@ -1582,7 +1375,7 @@
order, please use the corresponding xxxNet methods, which use a standard
network byte order."
- |b1 b2 b3 b4 val|
+ |b1 b2 b3 b4 uval "{ Class: SmallInteger }" val|
b1 := self nextByte.
b2 := self nextByte.
@@ -1590,44 +1383,18 @@
b4 := self nextByte.
msbFlag ifTrue:[
- val := b1.
- val := (val bitShift:8) bitOr:b2.
- val := (val bitShift:8) bitOr:b3.
- val := (val * 256) + b4.
- ^ val
+ "most significant first"
+ uval := (b1 bitShift:8) bitOr:b2.
+ uval := (uval bitShift:8) bitOr:b3.
+ val := (uval bitShift:8) bitOr:b4.
+ ] ifFalse:[
+ "least significant first"
+ uval := (b4 bitShift:8) bitOr:b3.
+ uval := (uval bitShift:8) bitOr:b2.
+ val := (uval bitShift:8) bitOr:b1.
].
- val := b4.
- val := (val bitShift:8) bitOr:b3.
- val := (val bitShift:8) bitOr:b2.
- val := (val * 256) + b1.
+
^ val
-
- "Modified: 11.7.1996 / 10:07:13 / cg"
-!
-
-nextUnsignedInt32Net
- "return an unsigned long (4 bytes) in network byte order from the stream.
- The receiver must support reading of binary bytes.
- Network byte order is MSB-first per definition"
-
- ^ self nextUnsignedInt32MSB:true
-
- "Created: 10.1.1996 / 19:49:02 / cg"
- "Modified: 10.1.1996 / 19:49:50 / cg"
-!
-
-nextUnsignedInt64LSB
- "return an unsigned longlong (also called hyper) (8 bytes) in LSB-first order from the stream.
- The receiver must support reading of binary bytes."
-
- ^ self nextUnsignedInt64MSB:false
-!
-
-nextUnsignedInt64MSB
- "return an unsigned longlong (also called hyper) (8 bytes) in MSB-first order from the stream.
- The receiver must support reading of binary bytes."
-
- ^ self nextUnsignedInt64MSB:true
!
nextUnsignedInt64MSB:msbFlag
@@ -1691,6 +1458,148 @@
"
"Modified: / 14.1.1998 / 15:40:41 / cg"
+! !
+
+!Stream methodsFor:'non homogenous reading - aliases'!
+
+nextInt16LSB
+ "return a signed short (2 bytes) in LSB-first order from the stream.
+ The receiver must support reading of binary bytes."
+
+ ^ self nextInt16MSB:false
+!
+
+nextInt16MSB
+ "return a signed short (2 bytes) in MSB-first order from the stream.
+ The receiver must support reading of binary bytes."
+
+ ^ self nextInt16MSB:true
+!
+
+nextInt16Net
+ "return a signed short (2 bytes) in network byte order from the stream.
+ The receiver must support reading of binary bytes.
+ Network byte order is MSB-first per definition"
+
+ ^ self nextInt16MSB:true
+
+ "Created: 10.1.1996 / 19:49:41 / cg"
+!
+
+nextInt32LSB
+ "return a signed long (4 bytes) in LSB-first order from the stream.
+ The receiver must support reading of binary bytes."
+
+ ^ self nextInt32MSB:false
+!
+
+nextInt32MSB
+ "return a signed long (4 bytes) in MSB-first order from the stream.
+ The receiver must support reading of binary bytes."
+
+ ^ self nextInt32MSB:true
+!
+
+nextInt32Net
+ "return a signed long (4 bytes) in network byte order from the stream.
+ The receiver must support reading of binary bytes.
+ Network byte order is MSB-first per definition"
+
+ ^ self nextInt32MSB:true
+
+ "Created: 10.1.1996 / 19:49:28 / cg"
+!
+
+nextInt64LSB
+ "return a signed longlong (also called hyper) (8 bytes) in LSB-first order from the stream.
+ The receiver must support reading of binary bytes."
+
+ ^ self nextInt64MSB:false
+!
+
+nextInt64MSB
+ "return a signed longlong (also called hyper) (8 bytes) in MSB-first order from the stream.
+ The receiver must support reading of binary bytes."
+
+ ^ self nextInt64MSB:true
+!
+
+nextInt64Net
+ "return a signed longlong (also called hyper) (8 bytes) in network byte order from the stream.
+ The receiver must support reading of binary bytes.
+ Network byte order is MSB-first per definition"
+
+ ^ self nextInt64MSB:true
+!
+
+nextNumber:numBytes
+ "Return the next n bytes as a positive Integer;
+ bytes are taken msb-first."
+
+ ^ self nextUnsigned:numBytes MSB:true
+!
+
+nextUnsignedInt16LSB
+ "return an unsigned short (2 bytes) in LSB-first order from the stream.
+ The receiver must support reading of binary bytes."
+
+ ^ self nextUnsignedInt16MSB:false
+!
+
+nextUnsignedInt16MSB
+ "return an unsigned short (2 bytes) in MSB-first order from the stream.
+ The receiver must support reading of binary bytes."
+
+ ^ self nextUnsignedInt16MSB:true
+!
+
+nextUnsignedInt16Net
+ "return an unsigned short (2 bytes) in network byte order from the stream.
+ The receiver must support reading of binary bytes.
+ Network byte order is MSB-first per definition"
+
+ ^ self nextUnsignedInt16MSB:true
+
+ "Created: 10.1.1996 / 19:50:02 / cg"
+!
+
+nextUnsignedInt32LSB
+ "return an unsigned long (4 bytes) in LSB-first order from the stream.
+ The receiver must support reading of binary bytes."
+
+ ^ self nextUnsignedInt32MSB:false
+!
+
+nextUnsignedInt32MSB
+ "return an unsigned long (4 bytes) in MSB-first order from the stream.
+ The receiver must support reading of binary bytes."
+
+ ^ self nextUnsignedInt32MSB:true
+!
+
+nextUnsignedInt32Net
+ "return an unsigned long (4 bytes) in network byte order from the stream.
+ The receiver must support reading of binary bytes.
+ Network byte order is MSB-first per definition"
+
+ ^ self nextUnsignedInt32MSB:true
+
+ "Created: 10.1.1996 / 19:49:02 / cg"
+ "Modified: 10.1.1996 / 19:49:50 / cg"
+!
+
+nextUnsignedInt64LSB
+ "return an unsigned longlong (also called hyper) (8 bytes) in LSB-first order from the stream.
+ The receiver must support reading of binary bytes."
+
+ ^ self nextUnsignedInt64MSB:false
+!
+
+nextUnsignedInt64MSB
+ "return an unsigned longlong (also called hyper) (8 bytes) in MSB-first order from the stream.
+ The receiver must support reading of binary bytes."
+
+ ^ self nextUnsignedInt64MSB:true
!
nextUnsignedInt64Net
@@ -1837,6 +1746,52 @@
"Created: 10.1.1996 / 19:49:41 / cg"
!
+nextUnsignedHyperMSB:msbFlag
+ <resource: #obsolete>
+ "return an unsigned hyper (8 bytes) from the stream.
+ The receiver must support reading of binary bytes.
+
+ The msbFlag argument controls if the integer is to be read with
+ most-significant-byte-first (true) or least-first (false).
+ This interface is provided to allow talking to external programs,
+ where it's known that the byte order is some definite one.
+ If you don't care (i.e. talk to other smalltalks) or you can control the
+ order, please use the corresponding xxxNet methods, which use a standard
+ network byte order."
+
+ ^ self nextUnsignedInt64MSB:msbFlag
+
+ "
+ |bytes s|
+
+ bytes := #[16rFF 16rFF 16rFF 16rFF 16rFF 16rFF 16rFF 16rFF].
+ s := bytes readStream.
+ Transcript showCR:(s nextUnsignedHyperMSB:true) hexPrintString.
+ s reset.
+ Transcript showCR:(s nextUnsignedHyperMSB:false) hexPrintString.
+
+ bytes := #[16r10 16r00 16r00 16r00 16r00 16r00 16r00 16r00].
+ s := bytes readStream.
+ Transcript showCR:(s nextUnsignedHyperMSB:true) hexPrintString.
+ s reset.
+ Transcript showCR:(s nextUnsignedHyperMSB:false) hexPrintString.
+
+ bytes := #[16r12 16r34 16r56 16r78 16r9a 16rbc 16rde 16rf0].
+ s := bytes readStream.
+ Transcript showCR:(s nextUnsignedHyperMSB:true) hexPrintString.
+ s reset.
+ Transcript showCR:(s nextUnsignedHyperMSB:false) hexPrintString.
+
+ bytes := #[16rFe 16rdc 16rba 16r98 16r76 16r54 16r32 16r10].
+ s := bytes readStream.
+ Transcript showCR:(s nextUnsignedHyperMSB:true) hexPrintString.
+ s reset.
+ Transcript showCR:(s nextUnsignedHyperMSB:false) hexPrintString.
+ "
+
+ "Modified: / 14.1.1998 / 15:40:41 / cg"
+!
+
nextUnsignedLongMSB:msbFlag
<resource: #obsolete>
"return an unsigned long (4 bytes) from the stream.
@@ -2058,8 +2013,15 @@
sz := aString size.
1 to:sz do:[:idx|
- self nextPutInt16:(aString at:idx) codePoint MSB:msb.
+ self nextPutUtf16Bytes:(aString at:idx) MSB:msb.
].
+
+ "
+ (#[] writeStream
+ nextPutAllUtf16Bytes:'BÄxxx' MSB:true;
+ nextPutUtf16:(Character codePoint:16r10CCCC) MSB:true;
+ contents)
+ "
!
nextPutAllUtf8:aString
@@ -2451,7 +2413,7 @@
Notice: this writes characters - not bytes.
The underlying stream must be a stream which can deal with characters,
eg. OrderedCollectionStream, TwoByteCharacterStream, etc.
- Also notice, that characters above 16rFFFF are escaped according UTF16 sepcifications."
+ Also notice, that characters above 16rFFFF are escaped according UTF16 specifications."
|codePoint "{Class: SmallInteger}"|
@@ -2480,6 +2442,48 @@
"
!
+nextPutUtf16Bytes:aCharacter MSB:msb
+ "append my UTF-16 representation to the argument, aStream.
+ UTF-16 can encode only characters with code points between 0 to 16r10FFFF.
+ The underlying stream must support writing of bytes."
+
+ |codePoint|
+
+ codePoint := aCharacter codePoint.
+ (codePoint <= 16rD7FF
+ or:[ codePoint >= 16rE000 and:[ codePoint <= 16rFFFF ] ])
+ ifTrue:[ self nextPutInt16:codePoint MSB:msb. ]
+ ifFalse:[
+ codePoint <= 16r10FFFF ifTrue:[
+ |highBits lowBits|
+
+ codePoint := codePoint - 16r100000.
+ highBits := codePoint bitShift:-10.
+ lowBits := codePoint bitAnd:16r3FF.
+ self nextPutInt16:highBits + 16rD800 MSB:msb.
+ self nextPutInt16:lowBits + 16rDC00 MSB:msb.
+ ] ifFalse:[
+ EncodingError raiseWith:aCharacter
+ errorString:'Character cannot be encoded as UTF-16'.
+ ]
+ ].
+
+ "
+ (#[] writeStream
+ nextPutUtf16:$B MSB:true;
+ nextPutUtf16:$Ä MSB:true;
+ nextPutUtf16:(Character codePoint:16r10CCCC) MSB:true;
+ contents)
+
+ (FileStream newTemporary
+ nextPutUtf16:$B MSB:false;
+ nextPutUtf16:$Ä MSB:false;
+ nextPutUtf16:(Character codePoint:16r10CCCC) MSB:false;
+ reset;
+ binary;
+ contents)"
+!
+
nextPutUtf8:aCharacter
"append my UTF-8 representation to the argument, aStream.
The underlying stream must be a stream which can deal with characters.
@@ -2843,6 +2847,12 @@
^ nil
!
+numAvailableForRead
+ "answer the nuber of bytes available for reading"
+
+ ^ self size
+!
+
numberOfTerminalCols
^ self lineLength
!
@@ -3777,9 +3787,9 @@
self atEnd ifTrue:[
^ self pastEndRead
].
- answerStream := WriteStream on:(self contentsSpecies new).
+ answerStream := WriteStream on:(self contentsSpecies uninitializedNew:80).
self upTo:Character cr into:answerStream.
- (answerStream size > 0 and:[answerStream last = Character return]) ifTrue:[
+ (answerStream size ~~ 0 and:[answerStream last = Character return]) ifTrue:[
answerStream backStep.
].
^ answerStream contents
--- a/String.st Wed Jul 06 06:50:27 2016 +0200
+++ b/String.st Sat Jul 09 21:10:24 2016 +0100
@@ -542,6 +542,8 @@
+
+
!String methodsFor:'accessing'!
at:index
@@ -2467,80 +2469,75 @@
!
asLowercase
- "a tuned version. Some apps call this very heavily"
+ "a tuned version for Strings with size < 255. Some apps call this very heavily.
+ We can do this for 8-bit strings, since the mapping is well known and lowercase chars
+ fit in one byte also."
%{ /* NOCONTEXT */
-#if 0
#ifndef __SCHTEAM__
REGISTER OBJ slf = self;
- if (__qClass(slf) == String) {
- char quickBuffer[256];
- int sz = __stringSize(slf);
-
- if (sz < (sizeof(quickBuffer)-1)) {
- REGISTER int i = 0;
- int anyChange = 0;
- REGISTER unsigned char *cp = __stringVal(slf);
-
- // fast advance
- // all uppercase chars are in the ranges 0x41 .. 0x5A (A..Z)
- // or 0xC0 .. 0xDF.
- // I.e. they have the 0x20 bit clear.
- // Thus, we can fast skip over lowercase, spaces and some puctuation,
- // if all bytes of a word have the x20 bit set.
- //
+ if (__isStringLike(slf)) {
+ char quickBuffer[256];
+ int sz = __stringSize(slf);
+
+ if (sz < (sizeof(quickBuffer)-1)) {
+ REGISTER int i = 0;
+ int anyChange = 0;
+ REGISTER unsigned char *cp = __stringVal(slf);
+
+ // fast advance
+ // all uppercase chars are in the ranges 0x41 .. 0x5A (A..Z)
+ // or 0xC0 .. 0xDF.
+ // I.e. they have the 0x20 bit clear.
+ // Thus, we can fast skip over lowercase, spaces and some punctuation,
+ // if all bytes of a word have the x20 bit set.
+
#if __POINTER_SIZE__ == 8
- for (; i<(sz-8); i+=8) {
- unsigned INT eightChars;
-
- eightChars = *((unsigned INT *)(cp));
- if ((eightChars & 0x2020202020202020ULL) != 0x2020202020202020ULL) break;
- *((unsigned INT *)(&quickBuffer[i])) = eightChars;
- }
+ for (; i < (sz-8); i += 8) {
+ unsigned INT eightChars = *(unsigned INT *)(cp+i);
+ if ((eightChars & 0x2020202020202020ULL) != 0x2020202020202020ULL) goto convert;
+ *(unsigned INT *)(quickBuffer+i) = eightChars;
+ }
#endif
- for (; i<(sz-4); i+=4) {
- unsigned int fourChars;
-
- fourChars = *((unsigned int *)(cp));
- if ((fourChars & 0x20202020U) != 0x20202020U) break;
- *((unsigned int *)(&quickBuffer[i])) = fourChars;
- }
-
- for (; i<sz; i++) {
- unsigned char ch = cp[i];
-
- quickBuffer[i] = ch;
- if ((ch & 0x60) == 0x40) {
- if (ch >= 'A') {
- if (ch <= 'Z') {
- quickBuffer[i] = ch - 'A' + 'a';
- anyChange = 1;
- } else {
- // deal with national latin1 characters
- if (ch >= 0xC0) {
- if (ch <= 0xDE) {
- if (ch != 0xD7) {
- quickBuffer[i] = ch + 0x20;
- anyChange = 1;
- }
- }
- }
- }
- }
- }
- }
- quickBuffer[i] = '\0';
- if (! anyChange) {
- RETURN(slf);
- }
- RETURN (__MKSTRING_L(quickBuffer, i));
- }
+ for (; i < (sz-4); i += 4) {
+ unsigned int fourChars = *(unsigned int *)(cp+i);
+ if ((fourChars & 0x20202020U) != 0x20202020U) break;
+ *(unsigned int *)(quickBuffer+i) = fourChars;
+ }
+convert:
+ for (; i<sz; i++) {
+ unsigned char ch = cp[i];
+
+ quickBuffer[i] = ch;
+ if ((ch & 0x60) == 0x40) {
+ if (ch >= 'A' && ch <= 'Z') {
+ quickBuffer[i] = ch - 'A' + 'a';
+ anyChange = 1;
+ } else {
+ // deal with national latin1 characters
+ if (ch >= 0xC0 && ch <= 0xDE && ch != 0xD7) {
+ quickBuffer[i] = ch + 0x20;
+ anyChange = 1;
+ }
+ }
+ }
+ }
+ if (! anyChange) {
+ RETURN(slf);
+ }
+ quickBuffer[i] = '\0';
+ RETURN (__MKSTRING_L(quickBuffer, i));
+ }
}
#endif /* ! __SCHTEAM__ */
-#endif
%}.
^ super asLowercase
+
+ "
+ 'Hello WORLD' asLowercase
+ (String new:300) asLowercase
+ "
!
asPackageId
@@ -2787,7 +2784,7 @@
char *cp1 = (char *) __stringVal(self);
int l1 = __stringSize(self);
int l2;
- char *cp2;
+ char *cp2 = 0;
int sz;
OBJ newString;
char character;
@@ -2801,12 +2798,16 @@
cp2 = &character;
} else if (__isStringLike(aStringOrCharacter)) {
l2 = __stringSize(aStringOrCharacter);
- cp2 = (char *) __stringVal(aStringOrCharacter);
} else
goto out;
sz = OHDR_SIZE + l1 + l2 + 1;
__qNew(newString, sz); /* OBJECT ALLOCATION */
+
+ cp1 = (char *) __stringVal(self);
+ if (cp2 == 0)
+ cp2 = (char *) __stringVal(aStringOrCharacter);
+
if (newString != nil) {
REGISTER unsigned char *dstp;
@@ -2814,7 +2815,7 @@
__qSTORE(newString, String);
dstp = __stringVal(newString);
-# ifdef bcopy4
+# if defined(bcopy4)
/* knowing that allocation is 4-byte aligned and
* size rounded up to next 4-byte, the first copy
* can be done word-wise.
@@ -2828,18 +2829,16 @@
bcopy4(cp1, dstp, nw);
dstp += l1;
}
-# else
-# ifdef FAST_MEMCPY
+# elif defined(FAST_MEMCPY)
memcpy(dstp, cp1, l1);
dstp += l1;
-# else
+# else
while (l1 >= 4) {
*(int *)dstp = *(int *)cp1;
dstp += 4; cp1 += 4;
l1 -= 4;
}
while (l1--) *dstp++ = *cp1++;
-# endif
# endif
# ifdef bcopy4
--- a/UnixOperatingSystem.st Wed Jul 06 06:50:27 2016 +0200
+++ b/UnixOperatingSystem.st Sat Jul 09 21:10:24 2016 +0100
@@ -4519,7 +4519,7 @@
are to be allowed - if false, they are not.
On some systems, all locks are non-exclusive locks.
- Returns true, if the lock was aquired, false otherwise.
+ Returns true, if the lock was acquired, false otherwise.
Notice, that not all OS's support these locks;
on some, this may simply be a no-op.
@@ -4674,7 +4674,7 @@
unlockFD:aFileDescriptor
"clear a file lock on the file represented by aFileDescriptor,
- which was previously aquired by #lockFD:.
+ which was previously acquired by #lockFD:.
Return false, if the unlock failed
(which may happens when a wrong fd is passed,
no lock was set previously, or the systsem does not support locks).
@@ -7787,7 +7787,7 @@
getNetworkAddresses
"return a dictionary filled with
key -> name of interface
- value -> the socket adress of the interface
+ value -> the socket address of the interface
for each interface"
|addressArray nameArray noOfIf retDictionary error|
@@ -7932,7 +7932,7 @@
getNetworkMACAddresses
"return a dictionary filled with
key -> name of interface
- value -> the MAC adress (as ByteArray)
+ value -> the MAC address (as ByteArray)
for each interface"
|addressArray nameArray noOfIf retDictionary error|
@@ -10007,7 +10007,7 @@
}
/* NOTREACHED */
#else
- unsigned long t = 0;
+ unsigned INT t = 0;
# if defined(_POSIX_MONOTONIC_CLOCK) && defined(CLOCK_MONOTONIC) && !defined(NO_CLOCK_GETTIME)
static has_clock_gettime = 1;
@@ -10069,7 +10069,7 @@
# endif
out:
- RETURN ( __mkSmallInteger(t & 0x1FFFFFFF) );
+ RETURN ( __mkSmallInteger(t & (_MAX_INT >> 1)) );
err:;
#endif /* not SCHTEAM */
@@ -10988,12 +10988,9 @@
"return the number of bytes available for reading, without blocking."
%{
- /*
- * if available, try FIONREAD first, which is usually done faster.
- */
-# if 0 && defined(FIONREAD)
+#if defined(FIONREAD)
{
- int n;
+ int n = 0;
if (__isSmallInteger(fd)) {
if (ioctl(__intVal(fd), FIONREAD, &n) >= 0) {
@@ -11001,7 +10998,7 @@
}
}
}
-# endif /* FIONREAD */
+#endif /* FIONREAD */
%}.
^ (self readCheck:fd) ifTrue:[1] ifFalse:[0]
!
--- a/UserPreferences.st Wed Jul 06 06:50:27 2016 +0200
+++ b/UserPreferences.st Sat Jul 09 21:10:24 2016 +0100
@@ -2546,7 +2546,7 @@
"experimental:
return the flag which controls if ONLY Xft fonts should be used.
If changed, this should be done very early during startup, before any other fonts
- are already aquired (i.e. before any views are opened)"
+ are already acquired (i.e. before any views are opened)"
^ self at:#useXftFontsOnly ifAbsent:[ false ]
@@ -2559,7 +2559,7 @@
"experimental:
set/clear the flag which controls if ONLY Xft fonts should be used.
If changed, this should be done very early during startup, before any other fonts
- are already aquired (i.e. before any views are opened)"
+ are already acquired (i.e. before any views are opened)"
^ self at:#useXftFontsOnly put:aBooleanOrNil