added interface to truncate & ftruncate (req. by Mr. Olberding)
authorClaus Gittinger <cg@exept.de>
Sun, 04 Feb 1996 20:06:39 +0100
changeset 932 f57ec42ceb44
parent 931 213c4d75fa98
child 933 2eebae059045
added interface to truncate & ftruncate (req. by Mr. Olberding)
ExtStream.st
ExternalStream.st
Filename.st
Unix.st
--- a/ExtStream.st	Fri Feb 02 20:21:40 1996 +0100
+++ b/ExtStream.st	Sun Feb 04 20:06:39 1996 +0100
@@ -17,7 +17,7 @@
 		lastErrorNumber'
 	 classVariableNames:'Lobby LastErrorNumber 
 		InvalidReadSignal InvalidWriteSignal InvalidModeSignal
-		OpenErrorSignal StreamNotOpenSignal'
+		OpenErrorSignal StreamNotOpenSignal InvalidOperationSignal'
 	 poolDictionaries:''
 	 category:'Streams-External'
 !
@@ -196,6 +196,10 @@
 	InvalidModeSignal nameClass:self message:#invalidModeSignal.
 	InvalidModeSignal notifierString:'binary/text mode mismatch'.
 
+	InvalidOperationSignal :=  StreamErrorSignal newSignalMayProceed:false.
+	InvalidOperationSignal nameClass:self message:#invalidOperationSignal.
+	InvalidOperationSignal notifierString:'unsupported file operation'.
+
 	StreamNotOpenSignal := StreamErrorSignal newSignalMayProceed:false.
 	StreamNotOpenSignal nameClass:self message:#streamNotOpenSignal.
 	StreamNotOpenSignal notifierString:'stream is not open'.
@@ -244,6 +248,13 @@
     ^ InvalidModeSignal
 !
 
+invalidOperationSignal
+    "return the signal raised when an unsupported or invalid
+     I/O operation is attempted"
+
+    ^ InvalidOperationSignal
+!
+
 invalidReadSignal
     "return the signal raised when reading from writeonly streams"
 
@@ -526,6 +537,15 @@
 		      in:thisContext sender
 !
 
+errorUnsupportedOperation
+    "report an error, that some unsupported operation was attempted"
+
+    ^ InvalidOperationSignal
+	raiseRequestWith:self
+	errorString:'unsupported operation'
+		 in:thisContext sender
+!
+
 errorWriteOnly
     "report an error, that the stream is a writeOnly stream"
 
@@ -1185,6 +1205,41 @@
     self position:"0" 1
 !
 
+truncateTo:newSize
+    "truncate the underlying OS file to newSize.
+     Warning: this may not be implemented on all platforms."
+%{  /* NOCONTEXT */
+#ifdef HAS_FTRUNCATE
+    FILE *f;
+    OBJ fp;
+
+    if (((fp = _INST(filePointer)) != nil)
+     && (_INST(mode) != @symbol(readonly))) {
+        if (__isSmallInteger(newSize)) {
+	    f = __FILEVal(fp);
+
+	    ftruncate(fileno(f), __intVal(newSize));
+	    RETURN (self);
+	}
+    }
+#endif
+%}.
+    filePointer isNil ifTrue:[^ self errorNotOpen].
+    (mode == #readonly) ifTrue:[^ self errorReadOnly].
+    ^ self errorUnsupportedOperation
+
+    "
+     |s|
+
+     s := 'test' asFilename writeStream.
+     s next:1000 put:$a.
+     s truncateTo:100.
+     s close.
+
+     ('test' asFilename fileSize) printNL
+    "
+!
+
 setToEnd
     "redefined since it must be implemented differently"
 
@@ -3474,6 +3529,6 @@
 !ExternalStream class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic/Attic/ExtStream.st,v 1.84 1996-01-16 19:11:19 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic/Attic/ExtStream.st,v 1.85 1996-02-04 19:06:39 cg Exp $'
 ! !
 ExternalStream initialize!
--- a/ExternalStream.st	Fri Feb 02 20:21:40 1996 +0100
+++ b/ExternalStream.st	Sun Feb 04 20:06:39 1996 +0100
@@ -17,7 +17,7 @@
 		lastErrorNumber'
 	 classVariableNames:'Lobby LastErrorNumber 
 		InvalidReadSignal InvalidWriteSignal InvalidModeSignal
-		OpenErrorSignal StreamNotOpenSignal'
+		OpenErrorSignal StreamNotOpenSignal InvalidOperationSignal'
 	 poolDictionaries:''
 	 category:'Streams-External'
 !
@@ -196,6 +196,10 @@
 	InvalidModeSignal nameClass:self message:#invalidModeSignal.
 	InvalidModeSignal notifierString:'binary/text mode mismatch'.
 
+	InvalidOperationSignal :=  StreamErrorSignal newSignalMayProceed:false.
+	InvalidOperationSignal nameClass:self message:#invalidOperationSignal.
+	InvalidOperationSignal notifierString:'unsupported file operation'.
+
 	StreamNotOpenSignal := StreamErrorSignal newSignalMayProceed:false.
 	StreamNotOpenSignal nameClass:self message:#streamNotOpenSignal.
 	StreamNotOpenSignal notifierString:'stream is not open'.
@@ -244,6 +248,13 @@
     ^ InvalidModeSignal
 !
 
+invalidOperationSignal
+    "return the signal raised when an unsupported or invalid
+     I/O operation is attempted"
+
+    ^ InvalidOperationSignal
+!
+
 invalidReadSignal
     "return the signal raised when reading from writeonly streams"
 
@@ -526,6 +537,15 @@
 		      in:thisContext sender
 !
 
+errorUnsupportedOperation
+    "report an error, that some unsupported operation was attempted"
+
+    ^ InvalidOperationSignal
+	raiseRequestWith:self
+	errorString:'unsupported operation'
+		 in:thisContext sender
+!
+
 errorWriteOnly
     "report an error, that the stream is a writeOnly stream"
 
@@ -1185,6 +1205,41 @@
     self position:"0" 1
 !
 
+truncateTo:newSize
+    "truncate the underlying OS file to newSize.
+     Warning: this may not be implemented on all platforms."
+%{  /* NOCONTEXT */
+#ifdef HAS_FTRUNCATE
+    FILE *f;
+    OBJ fp;
+
+    if (((fp = _INST(filePointer)) != nil)
+     && (_INST(mode) != @symbol(readonly))) {
+        if (__isSmallInteger(newSize)) {
+	    f = __FILEVal(fp);
+
+	    ftruncate(fileno(f), __intVal(newSize));
+	    RETURN (self);
+	}
+    }
+#endif
+%}.
+    filePointer isNil ifTrue:[^ self errorNotOpen].
+    (mode == #readonly) ifTrue:[^ self errorReadOnly].
+    ^ self errorUnsupportedOperation
+
+    "
+     |s|
+
+     s := 'test' asFilename writeStream.
+     s next:1000 put:$a.
+     s truncateTo:100.
+     s close.
+
+     ('test' asFilename fileSize) printNL
+    "
+!
+
 setToEnd
     "redefined since it must be implemented differently"
 
@@ -3474,6 +3529,6 @@
 !ExternalStream class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic/ExternalStream.st,v 1.84 1996-01-16 19:11:19 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic/ExternalStream.st,v 1.85 1996-02-04 19:06:39 cg Exp $'
 ! !
 ExternalStream initialize!
--- a/Filename.st	Fri Feb 02 20:21:40 1996 +0100
+++ b/Filename.st	Sun Feb 04 20:06:39 1996 +0100
@@ -881,6 +881,26 @@
     "
      '/tmp/foo' asFilename renameTo:'/tmp/bar'
     "
+!
+
+truncateTo:newSize
+    "change the files size.
+     This may not be supported on all operating systems"
+
+    (OperatingSystem truncateFile:nameString to:newSize) ifFalse:[
+        ^ self reportError:'unsupported operation' with:self
+    ]
+
+    "
+     |s|
+
+     s := 'test' asFilename writeStream.
+     s next:1000 put:$1.
+     s close.
+     ('test' asFilename fileSize) printNL.
+     'test' asFilename truncateTo:100.
+     ('test' asFilename fileSize) printNL.
+    "
 ! !
 
 !Filename methodsFor:'file queries'!
@@ -1617,5 +1637,5 @@
 !Filename class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic/Filename.st,v 1.49 1996-01-18 21:34:08 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic/Filename.st,v 1.50 1996-02-04 19:06:34 cg Exp $'
 ! !
--- a/Unix.st	Fri Feb 02 20:21:40 1996 +0100
+++ b/Unix.st	Sun Feb 04 20:06:39 1996 +0100
@@ -257,17 +257,17 @@
 #  include <wingdi.h> /* */
 #  include <winuser.h> /* */
 
-#   ifdef DEF_Array
-#    define Array DEF_Array
+#   ifdef __VM_Array
+#    define Array __VM_Array
 #   endif
-#   ifdef DEF_Number
-#    define Number DEF_Number
+#   ifdef __VM_Number
+#    define Number __VM_Number
 #   endif
-#   ifdef DEF_Method
-#    define Method DEF_Method
+#   ifdef __VM_Method
+#    define Method __VM_Method
 #   endif
-#   ifdef DEF_Point
-#    define Point DEF_Point
+#   ifdef __VM_Point
+#    define Point __VM_Point
 #   endif
 # endif
 
@@ -3260,6 +3260,32 @@
     "
 !
 
+truncateFile:aPathName to:newSize
+    "change a files size return true on success, false on failure.
+     This may not be supported on all architectures."
+
+%{  /* NOCONTEXT */
+#ifdef HAS_FTRUNCATE
+    int ret;
+
+    if (__isString(aPathName)
+     && __isSmallInteger(newSize)) {
+	__BEGIN_INTERRUPTABLE__
+	do {
+	    ret = truncate((char *) _stringVal(aPathName), __intVal(newSize));
+	} while (ret < 0 && errno == EINTR);
+	__END_INTERRUPTABLE__
+	if (ret < 0) {
+	    OperatingSystem_LastErrorNumber = _MKSMALLINT(errno);
+	    RETURN ( false );
+	}
+	RETURN (true);
+    }
+#endif
+%}.
+    ^ self primitiveFailed
+!
+
 typeOf:aPathName
     "return the type of a file as a symbol"
 
@@ -6379,6 +6405,6 @@
 !OperatingSystem class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic/Attic/Unix.st,v 1.119 1996-01-28 13:12:25 stefan Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic/Attic/Unix.st,v 1.120 1996-02-04 19:06:28 cg Exp $'
 ! !
 OperatingSystem initialize!