[squeak-dev] Re: [Vm-dev] Bug in writing compressed stream when saving an mcz (was: New Cog VMs available...)

David T. Lewis lewis at mail.msen.com
Fri Aug 29 03:17:25 UTC 2014


On Thu, Aug 28, 2014 at 03:17:24PM -0700, Chris Cunningham wrote:
> Hi.
> What is the status of this bug?  Have you tried this fix?

Good question. There were a number of interdependent issues, but the short
answer is that you probably have an up to date trunk image, and a not so
up to date VM. 

There was a legitimate fix to an obscure bug, and that fix that was introduced
into trunk (Collections-eem.567). This fix ended up requiring VM changes to
accomodate the fix. If you are using a VM that was not built recently, then
it may not have the required support.

The VM support was added in the July 2014 time frame to VMMaker.oscog-eem.826
(for Cog) and VMMaker-dtl.348 (for interpreter VM). If your image is updated
with Collections-eem.567 or later, then you will need a recently compiled VM
in order to avoid the bug.

Dave


> 
> I have recently been running into a related symptom - I can't write out big
> PNG files (it tries to write beyond the buffer as well).  I suspect it is
> the same issue.
> 
> Here is a sample script that will produce the same error.  Not all PNG
> generated file have it - but a number that I'm trying to produce manage to
> run into this bug.
> 
> | canvas stream dx |
> canvas := FormCanvas extent: ((31 * 40)@(101 * 40)) depth: 32.
> canvas
> fillRectangle: ((0 at 0) corner: canvas extent) color: Color white;
> frameRectangle: ((0 at 0) corner: canvas extent) color: Color black.
> dx := 38.
> 1 to: 100 do: [:y|
> 1 to: 30 do: [:x|
> canvas fillRectangle: (((x * dx) @ (y * dx)) corner: (((x * dx) + 2) @ ((y
> * dx) + 2))) color: Color green.
> ].
> ].
> stream := ByteArray new writeStream.
> PNGReadWriter putForm: canvas form onStream: stream.
> 
> Thanks.
> -cbc
> 
> 
> On Fri, Jul 18, 2014 at 12:46 PM, Eliot Miranda <eliot.miranda at gmail.com>
> wrote:
> 
> >
> >
> >
> > On Fri, Jul 18, 2014 at 12:38 PM, Eliot Miranda <eliot.miranda at gmail.com>
> > wrote:
> >
> >> Stupid me.  It's got to be the DeflateStream, and its subclasses
> >> ZipWriteStream, GZipWriteStream and ZLibWriteStream.  So my change screws
> >> all uses of these in plugins.  So what to do about fixing this?  I would
> >> like to have a go at fixing the plugins.  But cheaper might be to fix
> >> WriteStream with some property hack, storing the initialPosition somewhere
> >> else (a class side weak dictionary of stream -> initialPosition ?? (yuck)).
> >>
> >>
> >> On Fri, Jul 18, 2014 at 12:31 PM, Eliot Miranda <eliot.miranda at gmail.com>
> >> wrote:
> >>
> >>>
> >>>
> >>>
> >>> On Thu, Jul 17, 2014 at 4:02 PM, David T. Lewis <lewis at mail.msen.com>
> >>> wrote:
> >>>
> >>>> On Fri, Jul 18, 2014 at 12:24:29AM +0200, Nicolas Cellier wrote:
> >>>> > 2014-07-13 16:22 GMT+02:00 David T. Lewis <lewis at mail.msen.com>:
> >>>> >
> >>>> > > On Sun, Jul 13, 2014 at 09:55:41AM -0400, David T. Lewis wrote:
> >>>> > > > On Sun, Jul 06, 2014 at 12:47:25PM -0400, David T. Lewis wrote:
> >>>> > > > > On Sun, Jul 06, 2014 at 12:23:11PM -0400, David T. Lewis wrote:
> >>>> > > > > > On Sun, Jul 06, 2014 at 10:34:15AM +0200, Nicolas Cellier
> >>>> wrote:
> >>>> > > > > > > 2014-07-04 0:47 GMT+02:00 Nicolas Cellier <
> >>>> > > > > > > nicolas.cellier.aka.nice at gmail.com>:
> >>>> > > > > > >
> >>>> > > > > > > >
> >>>> > > > > > > >
> >>>> > > > > > > >
> >>>> > > > > > > > 2014-07-04 0:09 GMT+02:00 Eliot Miranda <
> >>>> eliot.miranda at gmail.com
> >>>> > > >:
> >>>> > > > > > > >
> >>>> > > > > > > >
> >>>> > > > > > > >>
> >>>> > > > > > > >>
> >>>> > > > > > > >> On Thu, Jul 3, 2014 at 12:33 PM, Nicolas Cellier <
> >>>> > > > > > > >> nicolas.cellier.aka.nice at gmail.com> wrote:
> >>>> > > > > > > >>
> >>>> > > > > > > >>> The bug is repeatable, i simply have to execute this
> >>>> snippet
> >>>> > > with my
> >>>> > > > > > > >>> test file:
> >>>> > > > > > > >>>
> >>>> > > > > > > >>> (FileStream fileNamed: 'snapshot.bin') binary
> >>>> > > contentsOfEntireFile
> >>>> > > > > > > >>> asString zipped.
> >>>> > > > > > > >>>
> >>>> > > > > > > >>> The file is too big for an attachment here - 7.3 Mbytes
> >>>> - or
> >>>> > > 1.7 Mbytes
> >>>> > > > > > > >>> gzipped by external tool.
> >>>> > > > > > > >>> If someone can suggest an upload site, or want it by
> >>>> mail,
> >>>> > > just ask.
> >>>> > > > > > > >>>
> >>>> > > > > > > >>
> >>>> > > > > > > >> You're welcome to put it on ftp.mirandanamda.org,
> >>>> cogftpuser,
> >>>> > > pw cogging
> >>>> > > > > > > >> with 0's & 1's.
> >>>> > > > > > > >>
> >>>> > > > > > > >>
> >>>> > > > > > > > done, pollution of your site engaged...
> >>>> > > > > > > > Thanks Eliot!
> >>>> > > > > > > >
> >>>> > > > > > > >
> >>>> > > > > > > >>
> >>>> > > > > > > I inquired a bit more about this bug.
> >>>> > > > > > > An important clue is that it does not happen in Pharo3.0!
> >>>> > > > > > >
> >>>> > > > > > > But Pharo3.0 did not fundamentally change compression
> >>>> > > > > > > (except some FileSystem related changes, separation of CRC
> >>>> stuff
> >>>> > > in another
> >>>> > > > > > > package, some other cosmetic changes like replacing some
> >>>> self
> >>>> > > assert: ...
> >>>> > > > > > > by [...] assert and a potential bug in
> >>>> > > > > > > DeflateStream>>nextPutAll:startingAt: introduced by
> >>>> CamilleTeruel).
> >>>> > > > > > > Squeak behavior is presumably not due to a Compression
> >>>> change.
> >>>> > > > > > >
> >>>> > > > > > > Neither is it a VM problem, the bugs still shows up when
> >>>> running
> >>>> > > the Squeak
> >>>> > > > > > > image with Pharo VM.
> >>>> > > > > > >
> >>>> > > > > >
> >>>> > > > > > Yes, it is definite a problem in the Squeak trunk image.
> >>>> > > > > >
> >>>> > > > > >
> >>>> > > > > > > So the difference lies somewhere else: in our beloved
> >>>> Stream.
> >>>> > > > > > > I remembered a recent change of Eliot related to handling of
> >>>> > > Stream created
> >>>> > > > > > > with on:from:to: (Collections-eem.567).
> >>>> > > > > > > Reverting those changes just make the snippet pass!
> >>>> > > > > > >
> >>>> > > > > > > Ah ah! At the time, i found the change of Eliot quite
> >>>> minimal and
> >>>> > > nice.
> >>>> > > > > > > But I wish I had time to analyze this small innocent change
> >>>> deeper.
> >>>> > > > > > > Indeed, I remembered I previously broke my teeth on this
> >>>> one 2
> >>>> > > years or so
> >>>> > > > > > > ago, and preferred to adopt another strategy: avoid using
> >>>> > > on:from:to: and
> >>>> > > > > > > ReadWriteStream as much as possible.
> >>>> > > > > > > Why? because when analyzing the usage of inst.var. in Stream
> >>>> > > hierarchy, it
> >>>> > > > > > > gave me headaches, some subclass are just ignoring
> >>>> superclass
> >>>> > > variables, or
> >>>> > > > > > > worse are bending the semantics of superclass variables.
> >>>> > > > > > > I came to the conclusion that I could not decently master a
> >>>> change
> >>>> > > of
> >>>> > > > > > > on:from:to:
> >>>> > > > > >
> >>>> > > > > > I can not confirm this. I have an image in which I can
> >>>> reliably
> >>>> > > reproduce the
> >>>> > > > > > failure in writing the MCZ to a file. I tried reverting the
> >>>> methods
> >>>> > > that were
> >>>> > > > > > introduced in Collections-eem.567 and I am still getting the
> >>>> same
> >>>> > > failure.
> >>>> > > > > >
> >>>> > > > > > Dave
> >>>> > > > >
> >>>> > > > > Oops, I spoke too soon. Indeed the problem appears as of
> >>>> > > Collections-eem.567,
> >>>> > > > > and does not appear in Collections-nice.566.
> >>>> > > > >
> >>>> > > > > So I am confirming Nicolas' observations ... now to find the
> >>>> bug :)
> >>>> > > > >
> >>>> > > > > Dave
> >>>> > > > >
> >>>> > > >
> >>>> > > > This seems to be a rather tricky bug, and I don't think any of us
> >>>> knows
> >>>> > > the
> >>>> > > > cause right now. In case anyone else wants to have a look at it,
> >>>> here is
> >>>> > > a
> >>>> > > > recipe for reproducing the bug in a clean 4.5 image:
> >>>> > > >
> >>>> > > > - Start with a clean Squeak 4.5 image in and empty working
> >>>> directory.
> >>>> > > >       ftp://ftp.squeak.org/4.5/Squeak4.5-13680.zip
> >>>> > > >
> >>>> > > > - Open the image, do not update it.
> >>>> > > >
> >>>> > > > - Open an MC browser and add the http://source.squeak.org/trunk
> >>>> > > repository for the Help-Squeak-Project package and Collections
> >>>> package.
> >>>> > > >
> >>>> > > > - Load Help-Squeak-Project-kfr.18 from trunk.
> >>>> > > >
> >>>> > > > - Load Collections-eem.567 from trunk.
> >>>> > > >
> >>>> > > > - Open a browser on class SqueakToolsDebuggerHelp, and delete the
> >>>> class
> >>>> > > side method #showDebuggerMenuForm.
> >>>> > > >
> >>>> > > > - Remove the http://source.squeak.org/trunk repository form the
> >>>> > > Help-Squeak-Project package in the MC browser.
> >>>> > > >
> >>>> > > > - Highlight your package-cache repository and try to save
> >>>> > > Help-Squeak-project to the package-cache repository.
> >>>> > > >
> >>>> > > > - Enter author initials 'dtl'.
> >>>> > > >
> >>>> > > > - For the package comment, enter 'Remove unreferenced method'.
> >>>> > > >
> >>>> > > > - Package save will fail part way through saving the MCZ.
> >>>> > > >
> >>>> > > > - To reproduce the failure in this image, do the following in a
> >>>> > > workspace:
> >>>> > > >
> >>>> > > >       mcv := MCVersion allInstances detect: [:e | e name = 'a
> >>>> > > MCVersion(Help-Squeak-Project-dtl.19)'].
> >>>> > > >       [f := FileStream fileNamed: 'junk.mcz'.
> >>>> > > >       mcv fileOutOn: f]
> >>>> > > >               ensure: [f close].
> >>>> > > >
> >>>> > >
> >>>> > > In addition to the above recipe, here are some other observations:
> >>>> > >
> >>>> > > - Reverting from Collections-eem.567 to Collections-nice.566 makes
> >>>> the
> >>>> > >   problem go away, but ONLY if the DeflatePlugin is active.
> >>>> > >
> >>>> > > - The failure appears while executing the fallback code for
> >>>> > > #primitiveDeflateBlock
> >>>> > >   in ZipWriteStream>>deflateBlock:chainLength:goodMatch:
> >>>> > >
> >>>> > > - If this primitive is deactivate by commenting out the
> >>>> > >   <primitive: 'primitiveDeflateBlock' module: 'ZipPlugin'> in
> >>>> > >   ZipWriteStream>>deflateBlock:chainLength:goodMatch: then the
> >>>> problem will
> >>>> > >   occur regardless of which version of Collections is loaded.
> >>>> > >
> >>>> > > - When Collections-eem.567 is loaded, the primitive will fail on
> >>>> the 22nd
> >>>> > >   call to #deflateBlock:chainLength:goodMatch: and a debugger
> >>>> appears
> >>>> > > during
> >>>> > >   execution of the fallback code.
> >>>> > >
> >>>> > > - When Collections-nice.566 is loaded, the primitive does not fail
> >>>> on the
> >>>> > > 22nd
> >>>> > >   call to #deflateBlock:chainLength:goodMatch:, the fallback code
> >>>> is never
> >>>> > > run,
> >>>> > >   and no error appears.
> >>>> > >
> >>>> > > - When Collections-nice.566 is loaded and the primitive is disabled
> >>>> to
> >>>> > > force
> >>>> > >   use of the fallback code, the error appears on on the 22nd call to
> >>>> > >   #deflateBlock:chainLength:goodMatch: in exactlly the same place
> >>>> as when
> >>>> > >   Collections-eem.567 is loaded.
> >>>> > >
> >>>> > > - If I inspect the ZipWriteStream at the failure point (when the
> >>>> debugger
> >>>> > > pops
> >>>> > >   up after the problem), I see no obvious difference in the state
> >>>> of the
> >>>> > > stream
> >>>> > >   between the Collections-eem.567 case versus the
> >>>> Collections-nice.566 with
> >>>> > >   primitive disabled case.
> >>>> > >
> >>>> > > Dave
> >>>> > >
> >>>> > >
> >>>> > Very good mining work!
> >>>> > When I hear  Stream, I think fluid...
> >>>> > But these snags make it so viscous, it's like our Stream is going to
> >>>> freeze
> >>>> > soon.
> >>>> > Or is it more than frozen? The vein you're after sounds as hard as
> >>>> diamond,
> >>>> > we gonna need a sharp peak pickaxe.
> >>>> >
> >>>>
> >>>> I keep hoping that your stream fixes will somehow make this problem go
> >>>> away, but
> >>>> maybe we are not so lucky.
> >>>>
> >>>> Whenever I get more time to play with this, I think I will try to catch
> >>>> it with
> >>>> gdb in the primitive. There is something strange happening that seems
> >>>> to first
> >>>> be detectable in the primitive failure, but only if Eliot's image fix
> >>>> is present.
> >>>>
> >>>> This kind of problem is a nice way to spend the morning with a good cup
> >>>> of coffee,
> >>>> as some people do with the NY Times crossword puzzle ;)
> >>>>
> >>>>    http://en.wikipedia.org/wiki/The_New_York_Times_crossword_puzzle
> >>>>
> >>>> Another "morning coffee" project is to figure out which version of the
> >>>> LargeIntegersPlugin
> >>>> should be used, which of course was the original topic that started
> >>>> this thread.
> >>>>
> >>>
> >>> So given that the change adds an instance variable to WriteStream could
> >>> that affect some plugin that somehow accesses a stream?  What plugin could
> >>> that be?  I don't see any obvious inst vars in the DeflatePlugin or
> >>> InflatePlugin.  To remind ourselves, the three changes are
> >>>
> >>> add inst var to WriteStream:
> >>>
> >>> PositionableStream subclass: #WriteStream
> >>> instanceVariableNames: 'writeLimit initialPositionOrNil'
> >>>  classVariableNames: ''
> >>> poolDictionaries: ''
> >>> category: 'Collections-Streams'
> >>>
> >>> use it in two places:
> >>> contents
> >>> "Answer with a copy of my collection from the start to the current
> >>> position."
> >>>
> >>> readLimit := readLimit max: position.
> >>> ^collection copyFrom: (initialPositionOrNil ifNil: [1]) to: position
> >>>
> >>> on: aCollection from: firstIndex to: lastIndex
> >>>
> >>> | len |
> >>> collection := aCollection.
> >>>  readLimit :=
> >>> writeLimit := lastIndex > (len := collection size)
> >>> ifTrue: [len]
> >>>  ifFalse: [lastIndex].
> >>> position := firstIndex <= 1
> >>> ifTrue: [0]
> >>>  ifFalse: [firstIndex - 1].
> >>> initialPositionOrNil := position + 1
> >>>
> >>> What I've just found is that if I revert all three changes to
> >>> WriteStream the bug goes away, but if I only revert the two method changes
> >>> the bug remains.  So I think the problem is merely the adding of the inst
> >>> var.  This could break some plugin which was expecting inst vars in
> >>> subclasses of WriteStream to be at particular offsets determined by
> >>> WriteStream instSize = 4 now being 5.  The question is which plugin(s)?
> >>>
> >>
> > Doh!
> >
> > DeflatePlugin>>loadDeflateStreamFrom: rcvr
> > | oop |
> >  <inline: false>
> > ((interpreterProxy isPointers: rcvr)
> >  and: [(interpreterProxy slotSizeOf: rcvr) >= 15]) ifFalse:
> >  [^false].
> > oop := interpreterProxy fetchPointer: 0 ofObject: rcvr.
> > (interpreterProxy isBytes: oop) ifFalse:
> >  [^false].
> > zipCollection := interpreterProxy firstIndexableField: oop.
> > zipCollectionSize := interpreterProxy byteSizeOf: oop.
> >
> > zipPosition := interpreterProxy fetchInteger: 1 ofObject: rcvr.
> > zipReadLimit := interpreterProxy fetchInteger: 2 ofObject: rcvr.
> >  "zipWriteLimit := interpreterProxy fetchInteger: 3 ofObject: rcvr."
> >
> > oop := interpreterProxy fetchPointer: 4 ofObject: rcvr.
> >  ((interpreterProxy isWords: oop)
> >  and: [(interpreterProxy slotSizeOf: oop) = DeflateHashTableSize]) ifFalse:
> >  [^false].
> > zipHashHead := interpreterProxy firstIndexableField: oop.
> > oop := interpreterProxy fetchPointer: 5 ofObject: rcvr.
> >  ((interpreterProxy isWords: oop)
> >  and: [(interpreterProxy slotSizeOf: oop) = DeflateWindowSize]) ifFalse:
> >  [^false].
> > zipHashTail := interpreterProxy firstIndexableField: oop.
> > zipHashValue := interpreterProxy fetchInteger: 6 ofObject: rcvr.
> >  zipBlockPos := interpreterProxy fetchInteger: 7 ofObject: rcvr.
> > "zipBlockStart := interpreterProxy fetchInteger: 8 ofObject: rcvr."
> >  oop := interpreterProxy fetchPointer: 9 ofObject: rcvr.
> > (interpreterProxy isBytes: oop) ifFalse:
> > [^false].
> >  zipLiteralSize := interpreterProxy slotSizeOf: oop.
> > zipLiterals := interpreterProxy firstIndexableField: oop.
> >
> > oop := interpreterProxy fetchPointer: 10 ofObject: rcvr.
> > ((interpreterProxy isWords: oop)
> >  and: [(interpreterProxy slotSizeOf: oop) >= zipLiteralSize]) ifFalse:
> > [^false].
> > zipDistances := interpreterProxy firstIndexableField: oop.
> >
> > oop := interpreterProxy fetchPointer: 11 ofObject: rcvr.
> > ((interpreterProxy isWords: oop)
> >  and: [(interpreterProxy slotSizeOf: oop) = DeflateMaxLiteralCodes])
> > ifFalse:
> > [^false].
> > zipLiteralFreq := interpreterProxy firstIndexableField: oop.
> >
> > oop := interpreterProxy fetchPointer: 12 ofObject: rcvr.
> > ((interpreterProxy isWords: oop)
> >  and: [(interpreterProxy slotSizeOf: oop) = DeflateMaxDistanceCodes])
> > ifFalse:
> > [^false].
> > zipDistanceFreq := interpreterProxy firstIndexableField: oop.
> >
> > zipLiteralCount := interpreterProxy fetchInteger: 13 ofObject: rcvr.
> > zipMatchCount := interpreterProxy fetchInteger: 14 ofObject: rcvr.
> >
> > ^interpreterProxy failed not
> >
> > I propose to add a variable that holds the inst size of the superclass of
> > InflateStream, and to use this to correct the offsets.  Objections?
> > --
> > best,
> > Eliot
> >
> >
> >
> >

> 



More information about the Squeak-dev mailing list