ExternalStream.st
changeset 19615 c24b55e4bc41
parent 19568 e303d98dd3a0
child 19622 c8edbe624b7c
--- a/ExternalStream.st	Tue Apr 19 23:59:28 2016 +0200
+++ b/ExternalStream.st	Wed Apr 20 11:28:01 2016 +0200
@@ -1541,39 +1541,41 @@
 
 initialize
     OpenErrorSignal isNil ifTrue:[
-	OpenErrorSignal := OpenError.
-	OpenErrorSignal notifierString:'open error'.
-
-	InvalidReadSignal := InvalidReadError.
-	InvalidReadSignal notifierString:'stream does not support reading'.
-
-	InvalidWriteSignal := InvalidWriteError.
-	InvalidWriteSignal notifierString:'stream does not support writing'.
-
-	InvalidModeSignal := InvalidModeError.
-	InvalidModeSignal notifierString:'binary/text mode mismatch'.
-
-	InvalidOperationSignal := InvalidOperationError.
-	InvalidOperationSignal notifierString:'unsupported file operation'.
-
-	StreamNotOpenSignal := StreamNotOpenError.
-	StreamNotOpenSignal notifierString:'stream is not open'.
-
-	StreamIOErrorSignal := StreamIOError.
-	StreamIOErrorSignal notifierString:'I/O error'.
+        OpenErrorSignal := OpenError.
+        OpenErrorSignal notifierString:'open error'.
+
+        InvalidReadSignal := InvalidReadError.
+        InvalidReadSignal notifierString:'stream does not support reading'.
+
+        InvalidWriteSignal := InvalidWriteError.
+        InvalidWriteSignal notifierString:'stream does not support writing'.
+
+        InvalidModeSignal := InvalidModeError.
+        InvalidModeSignal notifierString:'binary/text mode mismatch'.
+
+        InvalidOperationSignal := InvalidOperationError.
+        InvalidOperationSignal notifierString:'unsupported file operation'.
+
+        StreamNotOpenSignal := StreamNotOpenError.
+        StreamNotOpenSignal notifierString:'stream is not open'.
+
+        StreamIOErrorSignal := StreamIOError.
+        StreamIOErrorSignal notifierString:'I/O error'.
+        
+        self patchByteOrderOptimizedMethods
     ].
 
     Lobby isNil ifTrue:[
-	Lobby := Registry new.
-
-	"want to get informed when returning from snapshot"
-	ObjectMemory addDependent:self
+        Lobby := Registry new.
+
+        "want to get informed when returning from snapshot"
+        ObjectMemory addDependent:self
     ].
     DefaultEOLMode isNil ifTrue:[
-	self initDefaultEOLMode.
+        self initDefaultEOLMode.
     ].
     ReadMode isNil ifTrue:[
-	self initModeStrings.
+        self initModeStrings.
     ].
 
     "limit the amount of newspace to be used for non-tenurable executors to 5%"
@@ -1585,6 +1587,29 @@
     "Modified: / 21.5.1998 / 16:33:53 / cg"
 !
 
+patchByteOrderOptimizedMethods
+    "EXPERIMENTAL (not yet done by default):
+     change the underlying implementation of
+        nextPutInt16MSB / nextPutInt16LSB
+        nextPutInt32MSB / nextPutInt32LSB
+     to the corresponding NATIVE methods."
+
+    |native16 native32|
+    
+    ^ self. "/ for now
+    
+    native16 := self compiledMethodAt:#nextPutInt16NATIVE:.
+    native32 := self compiledMethodAt:#nextPutInt32NATIVE:.
+    
+    UninterpretedBytes isBigEndian ifTrue:[
+        (self compiledMethodAt:#nextPutInt16MSB:) code:(native16 code).
+        (self compiledMethodAt:#nextPutInt32MSB:) code:(native32 code).
+    ] ifFalse:[
+        (self compiledMethodAt:#nextPutInt16LSB:) code:(native16 code).
+        (self compiledMethodAt:#nextPutInt32LSB:) code:(native32 code).
+    ].
+!
+
 reOpenFiles
     "reopen all files (if possible) after a snapShot load.
      This is invoked via the #earlyRestart change notification."
@@ -4253,17 +4278,19 @@
 !
 
 nextPutInt16:anIntegerOrCharacter MSB:msbFlag
-    "Write the argument, anIntegerOrCharacter as a short (two bytes). If msbFlag is
-     true, data is written most-significant byte first; otherwise least
-     first.
+    "Write the argument, anIntegerOrCharacter as a short (two bytes). 
+     If msbFlag is true, data is written most-significant byte first; 
+     otherwise least first.
+     Notice that integers in the range -16r8000 to +16rFFFF can be written
+     (i.e. both signed and unsigned int32 values can be written.
      Works in both binary and text modes."
 
     |error|
 %{
     int num;
     union {
-	char bytes[2];
-	short shortVal;
+        char bytes[2];
+        short shortVal;
     } u;
     OBJ fp;
 
@@ -4273,72 +4300,151 @@
      || (__INST(handleType) == @symbol(socketFilePointer))
      || (__INST(handleType) == @symbol(socketHandle))
      || (__INST(handleType) == @symbol(pipeFilePointer))) {
-	if (((fp = __INST(handle)) != nil)
-	 && (__INST(mode) != @symbol(readonly))
-	) {
-	    FILEPOINTER f = __FILEVal(fp);
-	    int _buffered = (__INST(buffered) == true);
-	    int cnt;
-
-	    if (__isSmallInteger(anIntegerOrCharacter)) {
-		num = __intVal(anIntegerOrCharacter);
-	    } else if (__isCharacter(anIntegerOrCharacter)) {
-		num = __smallIntegerVal(__characterVal(anIntegerOrCharacter));
-	    } else
-		goto out;
-
-	    if (msbFlag == true) {
+        if (((fp = __INST(handle)) != nil)
+         && (__INST(mode) != @symbol(readonly))
+        ) {
+            FILEPOINTER f = __FILEVal(fp);
+            int _buffered = (__INST(buffered) == true);
+            int cnt;
+
+            if (__isSmallInteger(anIntegerOrCharacter)) {
+                num = __intVal(anIntegerOrCharacter);
+            } else if (__isCharacter(anIntegerOrCharacter)) {
+                num = __smallIntegerVal(__characterVal(anIntegerOrCharacter));
+            } else
+                goto out;
+
+            if (msbFlag == true) {
 #if defined(__MSBFIRST__)
-		u.shortVal = num;
+                u.shortVal = num;
 #else
-		u.bytes[0] = (num >> 8) & 0xFF;
-		u.bytes[1] = num & 0xFF;
+                u.bytes[0] = (num >> 8) & 0xFF;
+                u.bytes[1] = num & 0xFF;
 #endif
-	    } else {
+            } else {
 #if defined(__LSBFIRST__)
-		u.shortVal = num;
+                u.shortVal = num;
 #else
-		u.bytes[1] = (num >> 8) & 0xFF;
-		u.bytes[0] = num & 0xFF;
+                u.bytes[1] = (num >> 8) & 0xFF;
+                u.bytes[0] = num & 0xFF;
 #endif
-	    }
-
-	    if (_buffered) {
-		__WRITING__(f)
-	    }
-	    __WRITEBYTES__(cnt, f, u.bytes, 2, _buffered, __INST(handleType));
-
-	    if (cnt == 2) {
-		if (__isSmallInteger(__INST(position))) {
-		    INT np = __intVal(__INST(position)) + 2;
-		    OBJ t;
-
-		    t = __MKINT(np); __INST(position) = t; __STORE(self, t);
-		} else {
-		    __INST(position) = nil; /* i.e. do not know */
-		}
-		RETURN ( self );
-	    }
-	    __INST(position) = nil; /* i.e. do not know */
-	    error = __mkSmallInteger(__threadErrno);
-	}
+            }
+
+            if (_buffered) {
+                __WRITING__(f)
+            }
+            __WRITEBYTES__(cnt, f, u.bytes, 2, _buffered, __INST(handleType));
+
+            if (cnt == 2) {
+                if (__isSmallInteger(__INST(position))) {
+                    INT np = __intVal(__INST(position)) + 2;
+                    OBJ t;
+
+                    t = __MKINT(np); __INST(position) = t; __STORE(self, t);
+                } else {
+                    __INST(position) = nil; /* i.e. do not know */
+                }
+                RETURN ( self );
+            }
+            __INST(position) = nil; /* i.e. do not know */
+            error = __mkSmallInteger(__threadErrno);
+        }
     }
 out:;
 %}.
     error notNil ifTrue:[
-	lastErrorNumber := error.
-	self writeError:error.
-	^ self
+        lastErrorNumber := error.
+        self writeError:error.
+        ^ self
     ].
     handle isNil ifTrue:[self errorNotOpen. ^ self].
     (mode == #readonly) ifTrue:[self errorReadOnly. ^ self].
     self argumentMustBeInteger
 !
 
+nextPutInt16LSB:anIntegerOrCharacter
+    "do not remove.
+     See #patchByteOrderOptimizedMethods"
+     
+    self nextPutInt16:anIntegerOrCharacter MSB:false
+!
+
+nextPutInt16MSB:anIntegerOrCharacter
+    "do not remove.
+     See #patchByteOrderOptimizedMethods"
+     
+    self nextPutInt16:anIntegerOrCharacter MSB:true
+!
+
+nextPutInt16NATIVE:anIntegerOrCharacter 
+    "Write the argument, anIntegerOrCharacter as a short (two bytes) in native byte order. 
+     This is the CPU-specific byte order (LSB on x86, MSB on sparc, VAX and possibly on ARM).
+     Notice that integers in the range -16r8000 to +16rFFFF can be written
+     (i.e. both signed and unsigned int32 values can be written.
+     Works in both binary and text modes."
+
+    |error|
+%{
+    int num;
+    union {
+        char bytes[2];
+        short shortVal;
+    } u;
+    OBJ fp;
+
+    __INST(lastErrorNumber) = nil;
+    if ((__INST(handleType) == nil)
+     || (__INST(handleType) == @symbol(filePointer))
+     || (__INST(handleType) == @symbol(socketFilePointer))
+     || (__INST(handleType) == @symbol(socketHandle))
+     || (__INST(handleType) == @symbol(pipeFilePointer))) {
+        if (((fp = __INST(handle)) != nil)
+         && (__INST(mode) != @symbol(readonly))
+        ) {
+            FILEPOINTER f = __FILEVal(fp);
+            int _buffered = (__INST(buffered) == true);
+            int cnt;
+
+            if (__isSmallInteger(anIntegerOrCharacter)) {
+                num = __intVal(anIntegerOrCharacter);
+            } else if (__isCharacter(anIntegerOrCharacter)) {
+                num = __smallIntegerVal(__characterVal(anIntegerOrCharacter));
+            } else
+                goto out;
+
+            u.shortVal = num;
+
+            if (_buffered) {
+                __WRITING__(f)
+            }
+            __WRITEBYTES__(cnt, f, u.bytes, 2, _buffered, __INST(handleType));
+
+            if (cnt == 2) {
+                if (__isSmallInteger(__INST(position))) {
+                    INT np = __intVal(__INST(position)) + 2;
+                    OBJ t;
+
+                    t = __MKINT(np); __INST(position) = t; __STORE(self, t);
+                } else {
+                    __INST(position) = nil; /* i.e. do not know */
+                }
+                RETURN ( self );
+            }
+            __INST(position) = nil; /* i.e. do not know */
+            error = __mkSmallInteger(__threadErrno);
+        }
+    }
+out:;
+%}.
+    self nextPutInt16:anIntegerOrCharacter MSB:(UninterpretedBytes isBigEndian).
+!
+
 nextPutInt32:aNumber MSB:msbFlag
-    "Write the argument, aNumber as a long (four bytes). If msbFlag is
-     true, data is written most-significant byte first; otherwise least
-     first.
+    "Write the argument, aNumber as a long (four bytes). 
+     If msbFlag is true, data is written most-significant byte first; 
+     otherwise least first.
+     Notice that integers in the range -16r80000000 to +16rFFFFFFFF can be written
+     (i.e. both signed and unsigned int32 values can be written.
      Works in both binary and text modes."
 
     |error|
@@ -4438,6 +4544,99 @@
         ^ super nextPutInt32:aNumber MSB:msbFlag
     ].
     self argumentMustBeInteger
+!
+
+nextPutInt32LSB:anIntegerOrCharacter
+    "do not remove.
+     See #patchByteOrderOptimizedMethods"
+     
+    self nextPutInt32:anIntegerOrCharacter MSB:false
+!
+
+nextPutInt32MSB:anIntegerOrCharacter
+    "do not remove.
+     See #patchByteOrderOptimizedMethods"
+     
+    self nextPutInt32:anIntegerOrCharacter MSB:true
+!
+
+nextPutInt32NATIVE:anInteger
+    "Write the argument, anInteger as a long (four bytes) in native byte order. 
+     This is the CPU-specific byte order (LSB on x86, MSB on sparc, VAX and possibly on ARM).
+     Notice that integers in the range -16r80000000 to +16rFFFFFFFF can be written
+     (i.e. both signed and unsigned int32 values can be written.
+     Works in both binary and text modes.
+     Notice: this message should not be sent explicitly by ANY program.
+             the following implementation replaces the code of either nextPutInt32MSB or LSB
+             dynamically (see #initialize on the class side)"
+
+    |error|
+
+%{
+    int num;
+    union {
+        char bytes[4];
+        int intVal;
+    } u;
+    OBJ fp;
+
+    __INST(lastErrorNumber) = nil;
+    if (__isSmallInteger(anInteger)) {
+        num = __intVal(anInteger);
+    } else {
+#if __POINTER_SIZE__ == 8
+        // always more than 4-bytes
+        goto badArg;
+#else
+        num = __longIntVal(anInteger);
+        if (num == 0) {
+            num = __signedLongIntVal(anInteger);
+            if (num == 0) {
+                /* bad arg or out-of-range integer
+                 * (handled by the fallBack code)
+                 */
+                goto badArg;
+            }
+        }
+#endif
+    }
+
+    if ((__INST(handleType) == nil)
+     || (__INST(handleType) == @symbol(filePointer))
+     || (__INST(handleType) == @symbol(socketFilePointer))
+     || (__INST(handleType) == @symbol(socketHandle))
+     || (__INST(handleType) == @symbol(pipeFilePointer))) {
+        if (((fp = __INST(handle)) != nil)
+         && (__INST(mode) != @symbol(readonly))
+        ) {
+            int _buffered = (__INST(buffered) == true);
+            FILEPOINTER f = __FILEVal(fp);
+            int cnt;
+
+            u.intVal = num;
+            if (_buffered) {
+                __WRITING__(f)
+            }
+            __WRITEBYTES__(cnt, f, u.bytes, 4, _buffered, __INST(handleType));
+
+            if (cnt == 4) {
+                if (__isSmallInteger(__INST(position))) {
+                    INT np = __intVal(__INST(position)) + 4;
+                    OBJ t;
+
+                    t = __MKINT(np); __INST(position) = t; __STORE(self, t);
+                } else {
+                    __INST(position) = nil; /* i.e. do not know */
+                }
+                RETURN ( self );
+            }
+            __INST(position) = nil; /* i.e. do not know */
+            error = __mkSmallInteger(__threadErrno);
+        }
+    }
+badArg: ;
+%}.
+    self nextPutInt32:anInteger MSB:(UninterpretedBytes isBigEndian)
 ! !
 
 !ExternalStream methodsFor:'positioning'!
@@ -6505,6 +6704,23 @@
 !
 
 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."
 
@@ -6513,24 +6729,32 @@
     codePoint := aCharacter codePoint.
     (codePoint <= 16rD7FF
       or:[codePoint >= 16rE000 and:[codePoint <= 16rFFFF]]) ifTrue:[
-        self nextPutInt16:codePoint MSB:true.
+        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:true.
-        self nextPutInt16:lowBits+16rDC00 MSB:true.
+        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;
-            nextPutUtf16:$Ä;
-            nextPutUtf16:(Character codePoint:16r10CCCC);
+            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)