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

Chris Cunningham cunningham.cb at gmail.com
Fri Aug 29 14:27:22 UTC 2014


Thank you, the new VM did fix it.
-cbc


On Thu, Aug 28, 2014 at 8:17 PM, David T. Lewis <lewis at mail.msen.com> wrote:

> 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
> > >
> > >
> > >
> > >
>
> >
>
>
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://lists.squeakfoundation.org/pipermail/squeak-dev/attachments/20140829/71647191/attachment.htm


More information about the Squeak-dev mailing list