help-smalltalk
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Re: [Help-smalltalk] ZLib Z_SYNC_FLUSH/Z_FULL_FLUSH


From: Paolo Bonzini
Subject: Re: [Help-smalltalk] ZLib Z_SYNC_FLUSH/Z_FULL_FLUSH
Date: Wed, 22 Aug 2007 10:54:11 +0200
User-agent: Thunderbird 2.0.0.6 (Macintosh/20070728)

Paolo Bonzini wrote:
   defl flush: Z_FULL_FLUSH.

Seems like a good idea. One would have a #flush and a #flushDictionary method for Z_SYNC_FLUSH and Z_FULL_FLUSH respectively, if I understand correctly.

It turned out to be a little complicated because I was lazy and I didn't implement the ZLibWriteStream, so to speak, directly. Instead I used an adaptor class that took the ReadStream decorator (the one used for DeflateStream on: 'aaa') and transformed it into a WriteStream decorator.

This was perfectly fine with the existing set of functionality but now the problem, of course, is that the ReadStream decorator cannot know the boundary at which flushing will occur. The solution is to write a real WriteStream decorator for zlib -- luckily, quite a lot of common code can be factored into an abstract superclass used by both the ReadStream decorator and WriteStream decorator.

The boring buffering code is already there FileStream. It should be copied over to the TCP buffering code as well, as it would speed up #nextPutAll: on a socket consistently; and maybe the ZLib bindings themselves could use the ReadBuffer and WriteBuffer classes that sockets use. Something for another day, though.

The C interface was almost ready; the only thing missing was the ability to deflate/inflate an incomplete buffer.

Thanks for this request, it is indeed a useful one!

Paolo
2007-08-22  Paolo Bonzini  <address@hidden>

        * examples/PipeStream.st: New.

        * packages/zlib/zlib.st: Split into...
        * packages/zlib/ZLibStream.st: ... this new file containing the
        abstract class...
        * packages/zlib/ZLibReadStream.st: ... and this one.  Don't use
        PipeStream.  Pass flush parameter and input buffer size to zlib.c.
        * packages/zlib/ZLibWriteStream.st: New file.
        * packages/zlib/PipeStream.st: Removed.
        * packages/zlib/zlib.c: Accept flush parameter directly, and get input
        buffer size from Smalltalk.  Reorder the fields of ZlibStream.

* looking for address@hidden/smalltalk--devo--2.2--patch-531 to compare with
* comparing to address@hidden/smalltalk--devo--2.2--patch-531
A  packages/zlib/ChangeLog
A  packages/zlib/ZLibWriteStream.st
M  examples/PipeStream.st
M  packages/zlib/zlib.c
M  packages/zlib/ZLibReadStream.st
M  packages/zlib/package.xml
M  ChangeLog
M  NEWS
M  packages.xml
M  packages/zlib/zlibtests.st
=> packages/zlib/PipeStream.st  examples/PipeStream.st
=> packages/zlib/zlib.st        packages/zlib/ZLibReadStream.st

* modified files

--- orig/NEWS
+++ mod/NEWS
@@ -161,6 +161,10 @@ o   When declaring a C function, the #re
     Conversion from Array to CType is generally available using the
     CType class>>#from: method.
 
+o   The zlib bindings' WriteStream decorator supports partial flushing.
+    Class PipeStream is distributed independently as it is not used anymore
+    by the zlib bindings.
+
 -----------------------------------------------------------------------------
 
 NEWS FROM 2.3.5 TO 2.3.6


--- orig/packages/zlib/PipeStream.st
+++ mod/examples/PipeStream.st
@@ -1,6 +1,6 @@
 "======================================================================
 |
-|   PipeStream class (part of the ZLib bindings)
+|   PipeStream class
 |
 |
  ======================================================================"
@@ -38,26 +38,26 @@ PositionableStream subclass: #PipeStream
        category: 'Examples-Processes'!
 
 PipeStream comment:
-'Used internally by the zlib bindings, the PipeStream provides two
-pieces of functionality.  The first is to provide a dual-ended FIFO
-stream, which can be read and written by independent processes.  The
-second is to provide a WriteStream-to-ReadStream adaptor, where the
-data is written to the PipeStream (the writing side), fueled to
-an object expecting a ReadStream (possibly as a decorator), and taken
-from there into the destination stream.  The effect is to turn a
-ReadStream decorator into a WriteStream decorator.'!
+'The PipeStream provides two pieces of functionality.  The first
+is to provide a dual-ended FIFO stream, which can be read and
+written by independent processes.  The second is to provide a
+WriteStream-to-ReadStream adaptor, where the data is written to
+the PipeStream (the writing side), fueled to an object expecting a
+ReadStream (possibly as a decorator), and taken from there into the
+destination stream.  The effect is to turn a ReadStream decorator into
+a WriteStream decorator.'!
 
 !PipeStream class methodsFor: 'accessing'!
 
 bufferSize
-    "Answer the size of the output buffers that are passed to zlib.  Each
-     zlib stream uses a buffer of this size."
-    BufferSize isNil ifTrue: [ BufferSize := 512 ].
+    "Answer the size of the internal buffer.  Each PipeStream uses a
+     buffer of this size."
+    BufferSize isNil ifTrue: [ BufferSize := 1024 ].
     ^BufferSize!
 
 bufferSize: anInteger
-    "Set the size of the output buffers that are passed to zlib.  Each
-     zlib stream uses a buffer of this size."
+    "Set the size of the internal buffer. Each PipeStream uses a
+     uses a buffer of this size."
     BufferSize := anInteger!
 
 !PipeStream class methodsFor: 'instance creation'!


--- orig/packages.xml
+++ mod/packages.xml
@@ -77,6 +77,7 @@
   <file>Dinner.st</file>
   <file>Prolog.st</file>
   <file>EditStream.st</file>
+  <file>PipeStream.st</file>
   <file>PrtHier.st</file>
   <file>Case.st</file>
   <file>RegExp.st</file>


--- orig/packages/zlib/zlib.st
+++ mod/packages/zlib/ZLibReadStream.st
@@ -30,27 +30,18 @@
 |
  ======================================================================"
 
-Error subclass: #ZlibError
-       instanceVariableNames: 'stream'
+ZlibStream subclass: #ZlibReadStream
+       instanceVariableNames: 'delta ptr endPtr'
        classVariableNames: ''
        poolDictionaries: ''
        category: 'Examples-Useful'!
 
-ZlibError comment: 'This exception is raised whenever there is an error
-in a compressed stream.'!
-
-Stream subclass: #ZlibStream
-       instanceVariableNames: 'ptr endPtr inBytes outBytes delta source 
zlibObject'
-       classVariableNames: 'BufferSize'
-       poolDictionaries: ''
-       category: 'Examples-Useful'!
-
-ZlibStream comment: 'This abstract class implements the basic buffering that is
+ZlibReadStream comment: 'This abstract class implements the basic buffering 
that is
 used for communication with zlib.'!
 
-ZlibStream subclass: #RawDeflateStream
+ZlibReadStream subclass: #RawDeflateStream
        instanceVariableNames: ''
-       classVariableNames: 'DefaultCompressionLevel'
+       classVariableNames: ''
        poolDictionaries: ''
        category: 'Examples-Useful'!
 
@@ -75,7 +66,7 @@ RawDeflateStream subclass: #GZipDeflateS
 GZipDeflateStream comment: 'Instances of this class produce GZip (RFC1952)
 deflated data.'!
 
-ZlibStream subclass: #RawInflateStream
+ZlibReadStream subclass: #RawInflateStream
        instanceVariableNames: ''
        classVariableNames: ''
        poolDictionaries: ''
@@ -103,43 +94,7 @@ GZipInflateStream comment: 'Instances of
 deflated data.'!
 
 
-!ZlibError methodsFor: 'accessing'!
-
-stream
-    "Answer the ZlibStream that caused the error."
-    ^stream!
-
-stream: anObject
-    "Set the ZlibStream that caused the error."
-    stream := anObject! !
-
-
-!ZlibStream class methodsFor: 'accessing'!
-
-bufferSize
-    "Answer the size of the output buffers that are passed to zlib.  Each
-     zlib stream uses a buffer of this size."
-    BufferSize isNil ifTrue: [ BufferSize := 16384 ].
-    ^BufferSize!
-
-bufferSize: anInteger
-    "Set the size of the output buffers that are passed to zlib.  Each
-     zlib stream uses a buffer of this size."
-    BufferSize := anInteger!
-
-
-!ZlibStream class methodsFor: 'instance creation'!
-
-new
-    self shouldNotImplement!
-
-on: aStream
-    "Answer an instance of the receiver that decorates aStream."
-    ^self basicNew initialize: aStream!
-
-
-
-!ZlibStream methodsFor: 'streaming'!
+!ZlibReadStream methodsFor: 'streaming'!
 
 atEnd
     "Answer whether the stream has got to an end"
@@ -148,10 +103,6 @@ atEnd
         self fillBuffer.
         zlibObject isNil ]!
 
-isExternalStream
-    "Answer whether the receiver streams on a file or socket."
-    ^source isExternalStream!
-
 next
     "Return the next object (character or byte) in the receiver."
     self atEnd ifTrue: [ ^self pastEnd ].
@@ -187,20 +138,11 @@ peek
 position
     "Answer the current value of the stream pointer.  Note that only inflating
      streams support random access to the stream data."
-    ^delta + ptr!
-
-name
-    "Return the name of the underlying stream."
-    ^source name
-!
-
-species
-    "Return the type of the collections returned by #upTo: etc."
-    ^source species! !
+    ^delta + ptr! !
 
 
 
-!ZlibStream methodsFor: 'private'!
+!ZlibReadStream methodsFor: 'private'!
 
 resetBuffer
     delta := 0.
@@ -208,89 +150,54 @@ resetBuffer
     self fillBuffer!
 
 initialize: aStream
-    source := aStream.
+    super initialize: aStream.
     outBytes := self species new: self class bufferSize.
-    self addToBeFinalized.
     self resetBuffer!
 
 fillBuffer
     "Fill the output buffer, supplying data to zlib until it can actually
      produce something."
+    | flush |
     delta := delta + endPtr.
     ptr := 0.
     [
         inBytes isNil ifTrue: [
-           inBytes := source atEnd
+           inBytes := self stream atEnd
                ifTrue: [ #[] ]
-               ifFalse: [ source nextHunk ] ].
+               ifFalse: [ self stream nextHunk ] ].
 
-        endPtr := self processInput: source atEnd.
+       flush := self stream atEnd ifTrue: [ 4 ] ifFalse: [ 0 ].
+        endPtr := self processInput: flush size: inBytes size.
        endPtr = 0 ] whileTrue.
 
     "End of data, or zlib error encountered."
-    endPtr = -1 ifTrue: [ self checkError ]!
-
-finalize
-    self destroyZlibObject! !
-
-!ZlibStream methodsFor: 'private zlib interface'!
-
-checkError
-    | error |
-    error := self getError.
-    self finalize; removeToBeFinalized.
-    error isNil ifFalse: [
-       ZlibError new messageText: error; stream: self; signal ]!
-
-getError
-    <cCall: 'gst_zlibError' returning: #string args: #(#self)>!
-
-destroyZlibObject
-    self subclassResponsibility!
-
-processInput: atEnd
-    self subclassResponsibility! !
+    endPtr = -1 ifTrue: [ self checkError ]! !
 
 
 
-!RawDeflateStream class methodsFor: 'accessing'!
-
-defaultCompressionLevel
-    "Return the default compression level used by deflating streams."
-    DefaultCompressionLevel isNil ifTrue: [ DefaultCompressionLevel := 6 ].
-    ^DefaultCompressionLevel!
-
-defaultCompressionLevel: anInteger
-    "Set the default compression level used by deflating streams.  It
-     should be a number between 1 and 9."
-    DefaultCompressionLevel := anInteger!
-
-
 !RawDeflateStream class methodsFor: 'instance creation'!
 
 compressingTo: aStream
     "Answer a stream that receives data via #nextPut: and compresses it onto
      aStream."
-    ^PipeStream connectedTo: aStream via: [ :r | self on: r ]!
+    ^RawDeflateWriteStream on: aStream!
 
 compressingTo: aStream level: level
     "Answer a stream that receives data via #nextPut: and compresses it onto
      aStream with the given compression level."
-    ^PipeStream connectedTo: aStream via: [ :r | self on: r level: level ]!
+    ^RawDeflateWriteStream on: aStream level: level!
 
 on: aStream
     "Answer a stream that compresses the data in aStream with the default
      compression level."
-    ^self basicNew
-       initializeZlibObject: self defaultCompressionLevel;
-       initialize: aStream!
+    ^(super on: aStream)
+       initializeZlibObject: self defaultCompressionLevel!
 
 on: aStream level: compressionLevel
     "Answer a stream that compresses the data in aStream with the given
      compression level."
-    ^self basicNew
-       initializeZlibObject: compressionLevel;
-       initialize: aStream!
+    ^(super on: aStream)
+       initializeZlibObject: compressionLevel!
 
 
 !RawDeflateStream methodsFor: 'private zlib interface'!
@@ -304,17 +211,41 @@ initializeZlibObject: level
 destroyZlibObject
     <cCall: 'gst_deflateEnd' returning: #void args: #(#self)>!
 
-processInput: atEnd
-    <cCall: 'gst_deflate' returning: #int args: #(#self #boolean)>! !
+processInput: atEnd size: bytes
+    <cCall: 'gst_deflate' returning: #int args: #(#self #int #int)>! !
 
 
 
+!DeflateStream class methodsFor: 'instance creation'!
+
+compressingTo: aStream
+    "Answer a stream that receives data via #nextPut: and compresses it onto
+     aStream."
+    ^DeflateWriteStream on: aStream!
+
+compressingTo: aStream level: level
+    "Answer a stream that receives data via #nextPut: and compresses it onto
+     aStream with the given compression level."
+    ^DeflateWriteStream on: aStream level: level!
+
 !DeflateStream methodsFor: 'private zlib interface'!
 
 initializeZlibObject: level
     self initializeZlibObject: level windowSize: 15! !
 
 
+!GZipDeflateStream class methodsFor: 'instance creation'!
+
+compressingTo: aStream
+    "Answer a stream that receives data via #nextPut: and compresses it onto
+     aStream."
+    ^GZipDeflateWriteStream on: aStream!
+
+compressingTo: aStream level: level
+    "Answer a stream that receives data via #nextPut: and compresses it onto
+     aStream with the given compression level."
+    ^GZipDeflateWriteStream on: aStream level: level!
+
 !GZipDeflateStream methodsFor: 'private zlib interface'!
 
 initializeZlibObject: level
@@ -334,7 +265,7 @@ position: anInteger
 
 reset
     "Reset the stream to the beginning of the compressed data."
-    source reset.
+    self stream reset.
     self destroyZlibObject; initializeZlibObject.
     self resetBuffer!
 
@@ -374,8 +305,8 @@ initializeZlibObject
 destroyZlibObject
     <cCall: 'gst_inflateEnd' returning: #void args: #(#self)>!
 
-processInput: atEnd
-    <cCall: 'gst_inflate' returning: #int args: #(#self #boolean)>! !
+processInput: atEnd size: bytes
+    <cCall: 'gst_inflate' returning: #int args: #(#self #int #int)>! !
 
 
 


--- orig/packages/zlib/package.xml
+++ mod/packages/zlib/package.xml
@@ -1,7 +1,8 @@
 <package>
   <name>ZLib</name>
-  <filein>PipeStream.st</filein>
-  <filein>zlib.st</filein>
+  <filein>ZLibStream.st</filein>
+  <filein>ZLibReadStream.st</filein>
+  <filein>ZLibWriteStream.st</filein>
   <module>zlib</module>
 
   <test>
@@ -9,7 +10,8 @@
    <filein>zlibtests.st</filein>
   </test>
 
-  <file>PipeStream.st</file>
-  <file>zlib.st</file>
+  <file>ZLibStream.st</file>
+  <file>ZLibReadStream.st</file>
+  <file>ZLibWriteStream.st</file>
   <file>zlibtests.st</file>
 </package>


--- orig/packages/zlib/zlib.c
+++ mod/packages/zlib/zlib.c
@@ -65,13 +65,10 @@ static VMProxy *vmProxy;
 
 typedef struct zlib_stream {
   OBJ_HEADER;
-  OOP ptr;
-  OOP endPtr;
   OOP inBytes;
   OOP outBytes;
-  OOP delta;
-  OOP source;
   OOP zlibObject;
+  OOP stream;
 } *zlib_stream;
 
 
@@ -131,7 +128,7 @@ gst_inflateEnd (OOP oop)
    zlib buffers so that they point into the Smalltalk buffers.  */
 
 static int
-zlib_wrapper (OOP oop, int finish, int (*func) (z_stream *, int))
+zlib_wrapper (OOP oop, int flush, int inSize, int (*func) (z_stream *, int))
 {
   zlib_stream zs = (zlib_stream) OOP_TO_OBJ (oop);
   z_stream *zlib_obj = vmProxy->OOPToCObject (zs->zlibObject);
@@ -139,7 +136,6 @@ zlib_wrapper (OOP oop, int finish, int (
   OOP outBytesOOP = zs->outBytes;
   char *inBytes = &STRING_OOP_AT (OOP_TO_OBJ (inBytesOOP), 1);
   char *outBytes = &STRING_OOP_AT (OOP_TO_OBJ (outBytesOOP), 1);
-  size_t inSize = vmProxy->OOPSize (inBytesOOP);
   size_t outSize = vmProxy->OOPSize (outBytesOOP);
   int ret;
 
@@ -159,7 +155,7 @@ zlib_wrapper (OOP oop, int finish, int (
   /* Call the function we are wrapping.  */
   zlib_obj->next_out = outBytes;
   zlib_obj->avail_out = outSize;
-  ret = func (zlib_obj, finish ? Z_FINISH : Z_NO_FLUSH);
+  ret = func (zlib_obj, flush);
   if (ret == Z_BUF_ERROR)
     {
       zlib_obj->msg = NULL;
@@ -180,7 +176,7 @@ zlib_wrapper (OOP oop, int finish, int (
      output is finished.  */
   if (ret < 0)
     return -1;
-  else if (finish && inSize == 0 && outSize == zlib_obj->avail_out)
+  else if (flush == Z_FINISH && inSize == 0 && outSize == zlib_obj->avail_out)
     return -1;
   else
     return outSize - zlib_obj->avail_out;
@@ -188,17 +184,17 @@ zlib_wrapper (OOP oop, int finish, int (
 
 
 int
-gst_deflate (OOP oop, int finish)
+gst_deflate (OOP oop, int flush, int inSize)
 {
-  return zlib_wrapper (oop, finish, deflate);
+  return zlib_wrapper (oop, flush, inSize, deflate);
 }
 
 
 
 int
-gst_inflate (OOP oop, int finish)
+gst_inflate (OOP oop, int flush, int inSize)
 {
-  return zlib_wrapper (oop, finish, inflate);
+  return zlib_wrapper (oop, flush, inSize, inflate);
 }
 
 


--- orig/packages/zlib/zlibtests.st
+++ mod/packages/zlib/zlibtests.st
@@ -74,6 +74,16 @@ testError
     self should: [ (InflateStream on: #[12 34 56] readStream) contents ]
         raise: ZlibError!
 
+testSyncFlush
+    "Test flushing the WriteStream version of DeflateStream."
+    | dest stream contents |
+    stream := String new writeStream.
+    dest := DeflateStream compressingTo: stream.
+    dest nextPutAll: self fooVector; syncFlush.
+    contents := stream contents.
+    self assert: (contents asByteArray last: 4) = #[0 0 255 255].
+    self assert: (InflateStream on: contents readStream) contents = self 
fooVector!
+
 testWrite
     "Test the WriteStream version of DeflateStream."
     | dest |



* added files

--- /dev/null
+++ 
/Volumes/disk0s8/devel/gst/,,address@hidden/new-files-archive/./packages/zlib/ZLibWriteStream.st
@@ -0,0 +1,276 @@
+"======================================================================
+|
+|   ZLib module declarations
+|
+|
+ ======================================================================"
+
+
+"======================================================================
+|
+| Copyright 2007 Free Software Foundation, Inc.
+| Written by Paolo Bonzini
+|
+| This file is part of the GNU Smalltalk class library.
+|
+| The GNU Smalltalk class library is free software; you can redistribute it
+| and/or modify it under the terms of the GNU Lesser General Public License
+| as published by the Free Software Foundation; either version 2.1, or (at
+| your option) any later version.
+|
+| The GNU Smalltalk class library is distributed in the hope that it will be
+| useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
+| MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser
+| General Public License for more details.
+|
+| You should have received a copy of the GNU Lesser General Public License
+| along with the GNU Smalltalk class library; see the file COPYING.LIB.
+| If not, write to the Free Software Foundation, 59 Temple Place - Suite
+| 330, Boston, MA 02110-1301, USA.
+|
+ ======================================================================"
+
+DLD addModule: 'zlib'!
+
+ZlibStream subclass: #ZlibWriteStream
+       instanceVariableNames: 'delta ptr'
+       classVariableNames: ''
+       poolDictionaries: ''
+       category: 'Examples-Useful'!
+
+ZlibWriteStream comment: 'This abstract class implements the basic buffering
+that is used for communication with zlib in a WriteStream decorator.'!
+
+ZlibWriteStream subclass: #RawDeflateWriteStream
+       instanceVariableNames: ''
+       classVariableNames: 'DefaultCompressionLevel'
+       poolDictionaries: ''
+       category: 'Examples-Useful'!
+
+RawDeflateWriteStream comment: 'Instances of this class produce "raw" (PKZIP)
+deflated data.'!
+
+RawDeflateWriteStream subclass: #DeflateWriteStream
+       instanceVariableNames: ''
+       classVariableNames: ''
+       poolDictionaries: ''
+       category: 'Examples-Useful'!
+
+DeflateWriteStream comment: 'Instances of this class produce "standard"
+(zlib, RFC1950) deflated data.'!
+
+RawDeflateWriteStream subclass: #GZipDeflateWriteStream
+       instanceVariableNames: ''
+       classVariableNames: ''
+       poolDictionaries: ''
+       category: 'Examples-Useful'!
+
+GZipDeflateWriteStream comment: 'Instances of this class produce GZip (RFC1952)
+deflated data.'!
+
+
+!ZlibWriteStream methodsFor: 'streaming'!
+
+flushBuffer
+    "Flush the deflated output to the destination stream."
+    self flushBuffer: 0.
+!
+
+flush
+    "Flush the deflated output to the destination stream, and flush the
+     destination stream."
+    self flushBuffer: 0.
+    self stream flush
+!
+
+partialFlush
+    "Flush the deflated output to the destination stream using Z_PARTIAL_FLUSH,
+     and flush the destination stream."
+    self flushBuffer: 1.
+    self stream flush
+!
+
+syncFlush
+    "Flush the deflated output to the destination stream using Z_SYNC_FLUSH,
+     and flush the destination stream.  Note that this includes the four
+     bytes 0/0/255/255 at the end of the flush."
+    self flushBuffer: 2.
+    self stream flush
+!
+
+flushDictionary
+    "Flush the deflated output to the destination stream using Z_FULL_FLUSH,
+     and flush the destination stream."
+    self flushBuffer: 3.
+    self stream flush
+!
+
+finish
+    "Finish the deflated output to the destination stream using Z_FINISH.
+     The destination stream is not flushed."
+    self flushBuffer: 4.
+    self stream flush
+!
+
+close
+    "Finish the deflated output to the destination stream using Z_FINISH.
+     The destination stream is closed, which implies flushing."
+    self finish.
+    self stream close.
+!
+
+readStream
+    "Finish the deflated output to the destination stream using Z_FINISH and
+     return a ReadStream on the deflated data (requires the destination
+     stream to support #readStream)."
+    | result |
+    self finish.
+    result := self stream readStream.
+    self stream close.
+    ^result
+!
+
+contents
+    "Finish the deflated output to the destination stream using Z_FINISH and
+     return the deflated data (requires the destination stream to support
+     #contents)."
+    | result |
+    self finish.
+    result := self stream contents.
+    self stream close.
+    ^result!
+
+nextPut: aByte
+    "Append a character or byte (depending on whether the destination
+     stream works on a ByteArray or String) to the deflation buffer."
+    ptr = inBytes size ifTrue: [ self flushBuffer ].
+    inBytes at: ptr put: aByte.
+    ptr := ptr + 1!
+
+nextPutAll: aCollection
+    "Put all the characters or bytes in aCollection in the deflation buffer."
+
+    | n coll written |
+    "Just do 'coll := aCollection asString', but avoid expensive operations
+     in the common case where aCollection is already a String."
+    ptr = inBytes size ifTrue: [ self flushBuffer ].
+
+    coll := aCollection isSequenceable
+        ifTrue: [ aCollection ]
+        ifFalse: [
+            [ aCollection asString ]
+                on: MessageNotUnderstood
+                do: [ :ex |
+                    "If we are in a stream, try to facilitate buffering."
+                    [ aCollection atEnd ] whileFalse: [
+                        coll := aCollection nextHunk.
+                        self next: coll size putAll: coll startingAt: 1 ].
+                    ^self ] ].
+
+    self next: coll size putAll: coll startingAt: 1!
+
+next: n putAll: aCollection startingAt: pos
+    "Put n characters or bytes of aCollection, starting at the pos-th,
+     in the deflation buffer."
+
+    | written amount |
+    ptr = inBytes size ifTrue: [ self flushBuffer ].
+    written := 0.
+    [
+        amount := inBytes size - ptr + 1 min: n - written.
+        self next: amount bufferAll: aCollection startingAt: pos + written.
+        written := written + amount.
+        written < n
+    ] whileTrue: [ self flushBuffer ]!
+
+position
+    "Answer the number of compressed bytes written."
+    self flushBuffer.
+    ^delta! !
+
+
+
+!ZlibWriteStream methodsFor: 'private'!
+
+next: n bufferAll: aCollection startingAt: pos
+    "Private - Assuming that the buffer has space for n characters, store
+     n characters of aCollection in the buffer, starting from the pos-th."
+    n = 0 ifTrue: [ ^self ].
+    inBytes
+        replaceFrom: ptr
+        to: ptr + n - 1
+        with: aCollection
+        startingAt: pos.
+
+    ptr := ptr + n.
+!
+
+initialize: aWriteStream
+    super initialize: aWriteStream.
+    inBytes := self species new: self class bufferSize.
+    outBytes := self species new: self class bufferSize.
+    ptr := 1.
+    delta := 0!
+
+flushBuffer: flag
+    "Fill the output buffer, supplying data to zlib until it exhausts
+     the input buffer, and putting the output into the destination stream."
+    | endPtr buffer |
+    [
+       "The module uses the convention of nil-ing out inBytes when its data
+        is completely consumed; this is useless for this class, so undo it."
+        buffer := inBytes.
+        endPtr := self processInput: flag size: ptr - 1.
+        inBytes := buffer.
+       ptr := 1.
+        endPtr = -1 ifTrue: [ self checkError ].
+       endPtr > 0
+    ] whileTrue: [
+        delta := delta + endPtr.
+       self stream next: endPtr putAll: outBytes startingAt: 1
+    ]! !
+
+
+!RawDeflateWriteStream class methodsFor: 'instance creation'!
+
+on: aWriteStream
+    "Answer a stream that compresses the data in aStream with the default
+     compression level."
+    ^self basicNew
+       initializeZlibObject: self defaultCompressionLevel;
+       initialize: aWriteStream!
+
+on: aWriteStream level: compressionLevel
+    "Answer a stream that compresses the data in aStream with the given
+     compression level."
+    ^self basicNew
+       initializeZlibObject: compressionLevel;
+       initialize: aWriteStream!
+
+
+!RawDeflateWriteStream methodsFor: 'private zlib interface'!
+
+initializeZlibObject: level windowSize: winSize
+    <cCall: 'gst_deflateInit' returning: #void args: #(#self #int #int)>!
+
+initializeZlibObject: level
+    self initializeZlibObject: level windowSize: -15!
+
+destroyZlibObject
+    <cCall: 'gst_deflateEnd' returning: #void args: #(#self)>!
+
+processInput: atEnd size: bytes
+    <cCall: 'gst_deflate' returning: #int args: #(#self #int #int)>! !
+
+
+!DeflateWriteStream methodsFor: 'private zlib interface'!
+
+initializeZlibObject: level
+    self initializeZlibObject: level windowSize: 15! !
+
+
+!GZipDeflateWriteStream methodsFor: 'private zlib interface'!
+
+initializeZlibObject: level
+    self initializeZlibObject: level windowSize: 31! !
+

--- /dev/null
+++ 
/Volumes/disk0s8/devel/gst/,,address@hidden/new-files-archive/./packages/zlib/ZLibWriteStream.st
@@ -0,0 +1,144 @@
+"======================================================================
+|
+|   ZLib module declarations
+|
+|
+ ======================================================================"
+
+
+"======================================================================
+|
+| Copyright 2007 Free Software Foundation, Inc.
+| Written by Paolo Bonzini
+|
+| This file is part of the GNU Smalltalk class library.
+|
+| The GNU Smalltalk class library is free software; you can redistribute it
+| and/or modify it under the terms of the GNU Lesser General Public License
+| as published by the Free Software Foundation; either version 2.1, or (at
+| your option) any later version.
+|
+| The GNU Smalltalk class library is distributed in the hope that it will be
+| useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
+| MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser
+| General Public License for more details.
+|
+| You should have received a copy of the GNU Lesser General Public License
+| along with the GNU Smalltalk class library; see the file COPYING.LIB.
+| If not, write to the Free Software Foundation, 59 Temple Place - Suite
+| 330, Boston, MA 02110-1301, USA.
+|
+ ======================================================================"
+
+Error subclass: #ZlibError
+       instanceVariableNames: 'stream'
+       classVariableNames: ''
+       poolDictionaries: ''
+       category: 'Examples-Useful'!
+
+ZlibError comment: 'This exception is raised whenever there is an error
+in a compressed stream.'!
+
+Stream subclass: #ZlibStream
+       instanceVariableNames: 'inBytes outBytes zlibObject stream'
+       classVariableNames: 'BufferSize DefaultCompressionLevel'
+       poolDictionaries: ''
+       category: 'Examples-Useful'!
+
+ZlibStream comment: 'This abstract class implements the basic interface to
+the zlib module.  Its layout matches what is expected by the C code.'!
+
+
+!ZlibError methodsFor: 'accessing'!
+
+stream
+    "Answer the ZlibStream that caused the error."
+    ^stream!
+
+stream: anObject
+    "Set the ZlibStream that caused the error."
+    stream := anObject! !
+
+
+!ZlibStream class methodsFor: 'accessing'!
+
+bufferSize
+    "Answer the size of the output buffers that are passed to zlib.  Each
+     zlib stream uses a buffer of this size."
+    BufferSize isNil ifTrue: [ BufferSize := 16384 ].
+    ^BufferSize!
+
+bufferSize: anInteger
+    "Set the size of the output buffers that are passed to zlib.  Each
+     zlib stream uses a buffer of this size."
+    BufferSize := anInteger!
+
+defaultCompressionLevel
+    "Return the default compression level used by deflating streams."
+    DefaultCompressionLevel isNil ifTrue: [ DefaultCompressionLevel := 6 ].
+    ^DefaultCompressionLevel!
+
+defaultCompressionLevel: anInteger
+    "Set the default compression level used by deflating streams.  It
+     should be a number between 1 and 9."
+    DefaultCompressionLevel := anInteger!
+
+
+!ZlibStream class methodsFor: 'instance creation'!
+
+new
+    self shouldNotImplement!
+
+on: aStream
+    "Answer an instance of the receiver that decorates aStream."
+    ^self basicNew initialize: aStream!
+
+
+
+!ZlibStream methodsFor: 'streaming'!
+
+stream
+    "Answer the wrapped stream."
+    ^stream!
+
+isExternalStream
+    "Answer whether the receiver streams on a file or socket."
+    ^stream isExternalStream!
+
+name
+    "Return the name of the underlying stream."
+    ^stream name
+!
+
+species
+    "Return the type of the collections returned by #upTo: etc."
+    ^stream species! !
+
+
+
+!ZlibStream methodsFor: 'private'!
+
+initialize: aStream
+    stream := aStream.
+    self addToBeFinalized!
+
+finalize
+    self destroyZlibObject! !
+
+!ZlibStream methodsFor: 'private zlib interface'!
+
+checkError
+    | error |
+    error := self getError.
+    self finalize; removeToBeFinalized.
+    error isNil ifFalse: [
+       ZlibError new messageText: error; stream: self; signal ]!
+
+getError
+    <cCall: 'gst_zlibError' returning: #string args: #(#self)>!
+
+destroyZlibObject
+    self subclassResponsibility!
+
+processInput: atEnd size: bytes
+    self subclassResponsibility! !

reply via email to

[Prev in Thread] Current Thread [Next in Thread]