Re: [Pharo-project] Cog VM -- Thanks and Performance / Optimization Questions

Previous Topic Next Topic
 
classic Classic list List threaded Threaded
7 messages Options
Reply | Threaded
Open this post in threaded view
|

Re: [Pharo-project] Cog VM -- Thanks and Performance / Optimization Questions

Eliot Miranda-2
 
Hi John,

    good questions.

On Thu, Feb 17, 2011 at 6:21 AM, John B Thiel <[hidden email]> wrote:
Cog VM -- Thanks and Performance / Optimization Questions


To Everyone, thanks for your great work on Pharo and Squeak,  and to
Eliot Miranda, Ian Piumarta, and all VM/JIT gurus, especially thanks
for the Squeak VM Cog and its precursors, which I was keenly
anticipating for a decade or so, and is really going into stride with
the latest builds.

I like to code with awareness of performance issues.  Can you tell or
point me to some performance and efficiency tips for Cog and the
Squeak compiler -- detail on which methods are inlined, best among
alternatives, etc.  For example, I understand #to:do: is inlined --
what about #to:do:by: and #timesRepeat and #repeat  ?  Basically, I
would like to read a full overview of which core methods are specially
optimized (or planned).

The bytecode compiler inlines a set of selectors if the arguments are suitable (typically literal blocks).  The standard compiler's list is MessageNode classPool at: #MacroSelectors, e.g.

#ifTrue: #ifFalse: #ifTrue:ifFalse: #ifFalse:ifTrue: #and: #or: #whileFalse: #whileTrue: #whileFalse #whileTrue #to:do: #to:by:do: #caseOf: #caseOf:otherwise: #ifNil: #ifNotNil: #ifNil:ifNotNil: #ifNotNil:ifNil:

Note that Nicolas Cellier has just added support for inlining repeat and timesRepeat in Squeak trunk. 


I know about the list of NoLookup primitives, as per Object
class>>howToModifyPrimitives,  supposing that is still valid?

Not for Cog.  While #== and #class are inlined all other primitives are looked up.
 
What do you think is a reasonable speed factor for number-crunching
Squeak code vs C ?   I am seeing about 20x slower in the semi-large
scale, which surprised me a bit because I got about 10x on smaller
tests, and a simple fib: with beautiful Cog is now about 3x (wow!).
That range, 3x tiny tight loop, to 20x for general multi-class
computation, seems a bit wide -- is it about expected?

Are you saying that you have a macro benchmark that is 20 times faster in C than in Cog?  Cog, while faster than the interpreter, is still a non-inlining, non-globally-optimizing system and so performance is certainly to be expected to be worse than C.  But 20x sounds a little high so your benchmark could be useful.  If you can post this please do.

The current state of Cog is that the new code generator gives a significant speed-up but that the object model and garbage collector remain substantially the same as the Squeak interpreter.  The GC is slow and badly needs replacing.  The object model is both slow, especially for class access, which slows down all sends a little, and over-complex, which means that several performance-critical primitives have yet to be implemented in machine-code, especially at:put:, basicNew, basicNew:, and closure creation, all of which currently require expensive calls into C instead of using inline machine code.  I would expect that improving all these could add at least another factor of 33%. I'm trying to find funding to work on these two issues ASAP.


My profiling does not reveal any hotspots, as such -- it's basically
2, 3, 5% scattered around, so I envision this is just the general
vm/jit overhead as you scale up -- referencing distant objects, slots,
dispatch lookups, more cache misses, etc.  But maybe I am generally
using some backwater loop/control methods, techniques, etc. that could
be tuned up.  e.g. I seem to recall a trace at some point showing
#timesRepeat taking 10% of the time (?!).   Also, I recall reading
about an anomaly with BlockClosures -- something like being rebuilt
every time thru the loop - has that been fixed?  Any other gotchas to
watch for currently?

BlockClosures for non-inlined blocks are still created when mentioned.  So if you do have a loop which contains a block creation, consider pulling the block out into a temp variable.


(Also, any notoriously slow subsystems?  For example, Transcript
writing is glacial.)

Someone should replace the Transcript's reliance on (I think) some kind of FormMorph which moved huge numbers of bits on each write.  But this is not a VM issue.  It's a Smalltalk issue.  Whoever did this would instantly become a hero.
 
The Squeak bytecode compiler looks fairly straightforward and
non-optimizing - just statement by statement translation.  So it
misses e.g. chances to store and reuse, instead of pop, etc.  I see
lots of redundant sequences emitted.  Are those kind of things now
optimized out by Cog, or would tighter bytecode be another potential
optimization path.  (Is that what the Opal project is targetting?)

There is some limited constant folding in the StackToRegisterMapingCogit.  For example the pushTrue jumpFalse sequences generated in inlined and: and or: statements is eliminated.   Also constant SmallInteger arithmetic is folded iff the receiver is a literal.  The JIT doesn't have any type information so it can't fold var + 1 + 2, but it can and does fold 1 + 2 + var into 3 + var.

Marcus Denker and I are working as I write on the infrastructure for an adaptive-optimizer/speculative-inliner that will initially operate at the bytecode level, deriving type information from the JIT's inline caches and using this to direct bytecode-to-bytecode optimization that will inline blocks, inline methods, etc.  We hope eventually to target floating-point and other performance-critical code.  Marcus posted <a href=" Smalltalk Books Video Tutorials Smalltalk in Latam About Us! Contact Us Actually, I&#39;m trying to make Ruby natural, not simple. -- Yukihiro &quot;Matz&quot; Matsumoto Home Talks &amp; Presentations Eliot Miranda - Bytecode-to-bytecode adaptive optimization for Smalltalk Eliot Miranda - Bytecode-to-bytecode adaptive optimization for Smalltalk Last Updated (Sunday, 14 February 2010 20:21) | Written by Administrator | Monday, 18 August 2008 19:28 Multimedia Gallery - Talks &amp; Presentations More ... Comments from the google video: This talk summarises two decades of work on Smalltalk and Self compilation and virtual machine technology and describes a novel attempt at an adaptive optimizer for Smalltalk that is written in Smalltalk and to a meaningful extent, portable across implementations. Smalltalk-80 and Self are fully object-oriented implicitly typed dynamic programming languages and interactive programming environments hosted above virtual machines that appear to execute stack-oriented bytecode for a pure stack machine. These systems&#39; code and execution state are all represented by objects programmed in Smalltalk, such that the compiler, debugger, exception system and more are all implemented entirely in Smalltalk and available to the programmer for immediate incremental and interactive modification LikeDislike Community Disqus Add New Comment Optional: Login below. Post as … Showing 0 comments Sort by Subscribe by email Subscribe by RSS blog comments powered by DISQUS back to top &lt; Prev Next &gt; Main Menu Home ClubSmalltalk Merchandise About Us! Contact Us Articles Frontpage news Interviews Community ClubSmalltalk | Mailing List [In Spanish] ClubSmalltalk | LinkedIn Group ClubSmalltalk | Facebook ClubSmalltalk | Community Blogs Smalltalkers Blogs &amp; Personal pages Smalltalkers - Social Network Environments Commercial Smalltalk Environments Free Smalltalk Environments Abbandon Smalltalk Environments Frameworks, Platforms &amp; Tools FAQ Smalltalk Frequently Asked Questions GemStone Frequently Asked Questions ENVY/Manager Frequently Asked Questions Resources Smalltalk Jobs! Smalltalk Web Links Smalltalk News Feeds Smalltalk Books Smalltalk Podcasts Multimedia Gallery Back to the future - Photo Gallery Smalltalk History Channel Talks &amp; Presentations Smalltalk Documentaries Login If you don&#39;t want to register in this site, you can use your Gmail or OpenId authentication. Username Password Remember Me Forgot your password? Forgot your username? Create an account Login with an OpenID What is OpenId? Smalltalk on Twitter J_WICKS_CTE (J.Wicks) : I hate 2 word sentences #smalltalk 11th_echo (Yvonne) : Da fand er unseren Smalltalk wohl so einlullend, dass er erstmal seine Schlüssel liegen ließ :DDDDDDDDDDDD höhö Dennis_Klinger (Dennis Klinger) : benachrichtigung bei antwort: hi leute ich hab mal ne frage. wie kann man sich benachrichtigen lassen wenn in ... http://bit.ly/gTytl0 onizee (Oneal Madumo) : Those who understnd #smalltalk ,guy walks in on me in th gym showers,and he says,&quot;eish o tshwara shawara&quot;,how do i respond to this? JusCardo (Ricardo Cherry) : #SMALLtalk RT @_SweetTeee @JusCardo lol I hate you Paypal Donation Please, make a Paypal donation at least of 1 dollar! Thanks! Copyright © 2011 ClubSmalltalk. All Rights Reserved. Contact Us! Please, if you like the site visit our sponsors. Thanks. ">a presentation I did a while back that covers the essential ideas.  This project could completely close the gap to C if augmented by a good quality code generator.  At least, that's a goal.


-- jbthiel


Reply | Threaded
Open this post in threaded view
|

Re: [squeak-dev] Re: [Pharo-project] Cog VM -- Thanks and Performance / Optimization Questions

Juan Vuletich-4
 
Hi Eliot,

Eliot Miranda wrote:

> Hi John,
>
>     good questions.
>
> On Thu, Feb 17, 2011 at 6:21 AM, John B Thiel <[hidden email]
> <mailto:[hidden email]>> wrote:
>
>     Cog VM -- Thanks and Performance / Optimization Questions
>
>     ...
>     (Also, any notoriously slow subsystems?  For example, Transcript
>     writing is glacial.)
>
>
> Someone should replace the Transcript's reliance on (I think) some
> kind of FormMorph which moved huge numbers of bits on each write.  But
> this is not a VM issue.  It's a Smalltalk issue.  Whoever did this
> would instantly become a hero.
There are other problems with Transcript besides performance. It is easy
to break the UI if called at the wrong times. In those cases, it is
usually needed to kill Squeak from the OS. Besides, it is not thread safe.

Instantly becoming a hero sounds cool, so this is my attempt at it :) I
only tried this in Cuis, but I believe it should work on Squeak and
Pharo without much trouble. After loading this code, you can evaluate
'Smalltalk at: #Transcript put: NewTranscript'.

Some good properties of this are:
- Very fast.
- Thread safe!
- Doesn't use Morphic at all. Can be used to debug Morphic itself.
- Doesn't do delayed execution (no events, no forked processes).
Immediate visual feedback.
- Can show itself on Display, log to File, both, or none.
- Can be used for headless or remote images (for example, web servers).

Some possible downsides are:
- Output only. Not a text editor. We have the Workspace and the
Transcripter for that.
- No seamless Morphic integration. I'll do one for Cuis, though.

If no serious problems are found, I'll remove TranscriptStream from
Cuis, and rename this class as Transcript.

Cheers,
Juan Vuletich

'From Cuis 3.0 of 31 January 2011 [latest update: #790] on 18 February 2011 at 2:36:31 pm'!
!classDefinition: #NewTranscript category: #'System-Support'!
Object subclass: #NewTranscript
        instanceVariableNames: ''
        classVariableNames: ''
        poolDictionaries: ''
        category: 'System-Support'!

!NewTranscript commentStamp: '<historical>' prior: 0!
A new implementation of Transcript.
- Thread safe.
- Very fast.
- Independent of Morphic or any other UI framework.
- Inmediate feedback.
- Can log to file.
- Not an editor. Only used for output.
- All protocol is on the Class side!

!classDefinition: 'NewTranscript class' category: nil!
NewTranscript class
        instanceVariableNames: 'entries firstIndex lastIndex accessSemaphore unfinishedEntry logToFile showOnDisplay innerRectangle lastDisplayTime'!

!DateAndTime methodsFor: 'squeak protocol' stamp: 'jmv 2/18/2011 12:57'!
printWithMsOn: aStream
        "Print with millisecond resolution, no leading space, no offset."

        | ps |
        self printYMDOn: aStream withLeadingSpace: false.
        aStream nextPut: $T.
        self printHMSOn: aStream.
        ps _ (self nanoSecond // 1000000) printString padded: #left to: 3 with: $0.
        aStream nextPut: $..
        aStream nextPutAll: ps! !


!NewTranscript class methodsFor: 'preferred protocol' stamp: 'jmv 2/18/2011 14:16'!
clear
        | stream |
        accessSemaphore critical: [
                "Having at least one entry simplifies handling of the entries circular collection"
                firstIndex _ 1.
                lastIndex _ 1.
                entries at: 1 put: 'Transcript'.
                unfinishedEntry reset.
               
                logToFile ifTrue: [
                        stream _ StandardFileStream forceNewFileNamed: self filename.
                        [
                                stream nextPutAll: 'Transcript log started: '.
                                DateAndTime now printOn: stream.
                                stream
                                        lf;
                                        nextPutAll: '------------------------------------------------------------------------';
                                        lf
                        ] ensure: [ stream close ]]].
        self display! !

!NewTranscript class methodsFor: 'preferred protocol' stamp: 'jmv 2/18/2011 14:16'!
log: aString
        self addEntry: aString.
        self display! !

!NewTranscript class methodsFor: 'preferred protocol' stamp: 'jmv 2/18/2011 11:49'!
logToFile
        "
        self logToFile
        "
        logToFile _ true! !

!NewTranscript class methodsFor: 'old Transcript compatibility' stamp: 'jmv 2/18/2011 11:20'!
cr
        "WriteStream protocol.
        In the older TranscriptStream, it added a CR character.
        Now, finish the current incomplete entry."

        self finishEntry! !

!NewTranscript class methodsFor: 'old Transcript compatibility' stamp: 'jmv 2/18/2011 11:20'!
crtab
        "WriteStream protocol.
        End the current entry, and start a new one starting with a single tab character."

        self cr; tab! !

!NewTranscript class methodsFor: 'old Transcript compatibility' stamp: 'jmv 2/18/2011 11:21'!
endEntry
        "For compatibility with old TranscriptStream. nop here"! !

!NewTranscript class methodsFor: 'old Transcript compatibility' stamp: 'jmv 2/18/2011 11:21'!
flush
        "For compatibility with old TranscriptStream. nop here"! !

!NewTranscript class methodsFor: 'old Transcript compatibility' stamp: 'jmv 2/18/2011 14:17'!
nextPut: aCharacter
        "WriteStream protocol.
        Append aCharacter to the unfinishedEntry.
        cr characters sent with this message do NOT finish the current unfinishedEntry."

        unfinishedEntry nextPut: aCharacter.
        self displayUnfinishedEntry! !

!NewTranscript class methodsFor: 'old Transcript compatibility' stamp: 'jmv 2/18/2011 14:17'!
nextPutAll: aString
        "WriteStream protocol.
        Append aString to the unfinishedEntry.
        cr characters sent with this message do NOT finish the current unfinishedEntry."

        unfinishedEntry nextPutAll: aString.
        self displayUnfinishedEntry! !

!NewTranscript class methodsFor: 'old Transcript compatibility' stamp: 'jmv 2/18/2011 11:20'!
print: anObject
        "Stream protocol"
        anObject printOn: self! !

!NewTranscript class methodsFor: 'old Transcript compatibility' stamp: 'jmv 2/18/2011 11:22'!
show: anObject
        "Old TranscriptStream protocol."
        self nextPutAll: anObject asString! !

!NewTranscript class methodsFor: 'old Transcript compatibility' stamp: 'jmv 2/18/2011 11:22'!
space
        "WriteStream protocol.
        Append a space character to the receiver."

        self nextPut: Character space! !

!NewTranscript class methodsFor: 'old Transcript compatibility' stamp: 'jmv 2/18/2011 11:22'!
tab
        "WriteStream protocol.
        Append a tab character to the receiver."

        self nextPut: Character tab! !

!NewTranscript class methodsFor: 'private' stamp: 'jmv 2/18/2011 12:59'!
addEntry: aString
        "Add a new entrie to the entries circular list. If full, a new entry will replace the oldest one."
        | msg now |
        logToFile ifTrue: [
                now _ DateAndTime now.
                msg _ String streamContents: [ :strm |
                        now printWithMsOn: strm.
                        strm
                                nextPutAll: ' process:';
                                nextPutAll: Processor activeProcess priority printString;
                                nextPut: $ ;
                                nextPutAll: Processor activeProcess hash printString;
                                nextPut: $ ;
                                nextPutAll: aString;
                                lf ]].

        self addEntry: aString logToFile: msg! !

!NewTranscript class methodsFor: 'private' stamp: 'jmv 2/18/2011 12:34'!
addEntry: aString logToFile: otherString
        "Add a new entrie to the entries circular list. If full, a new entry will replace the oldest one."
        | stream |
        accessSemaphore critical: [
               
                "Internal circular collection"
                lastIndex _ lastIndex \\ self maxEntries + 1.
                firstIndex = lastIndex ifTrue: [
                        firstIndex _ firstIndex \\ self maxEntries + 1 ].
                entries at: lastIndex put: aString.
               
                "external file"
                otherString ifNotNil: [
                        [
                                stream _ StandardFileStream fileNamed: self filename.
                                stream
                                        setToEnd;
                                        nextPutAll: otherString;
                                        flush]
                        ensure: [ stream close ]
                ]
        ]! !

!NewTranscript class methodsFor: 'private' stamp: 'jmv 2/18/2011 14:16'!
finishEntry
        | newEntry |
        newEntry _ unfinishedEntry contents.
        unfinishedEntry reset.
        self addEntry: newEntry.
        self display! !

!NewTranscript class methodsFor: 'displaying' stamp: 'jmv 2/18/2011 14:20'!
display
        showOnDisplay ifTrue: [
                self displayOn: Display.
                lastDisplayTime _ DateAndTime now ]! !

!NewTranscript class methodsFor: 'displaying' stamp: 'jmv 2/18/2011 14:09'!
displayOn: aForm
        "
        experimentos
        NewTranscript displayOn: Display
        "
        | font port count i string x y fh f |
        aForm border: (innerRectangle outsetBy: 3) width: 3.
        aForm fill: innerRectangle fillColor: Color white.
        port _ BitBlt toForm: aForm.
        port clipWidth: innerRectangle right.
        font _ StrikeFont default.
        font installOn: port foregroundColor: Color black.
       
        fh _ font height.
        count _ innerRectangle height // fh-1.
        x _ innerRectangle left.
        y _ innerRectangle top.
        f _ firstIndex-1.
        firstIndex > lastIndex ifTrue: [ f _ f - self maxEntries ].
        i _ (lastIndex - count max: f) \\ self maxEntries + 1.
        [
                string _ entries at: i.
                port displayString: string from: 1 to: string size at: x@y strikeFont: font kern: font baseKern negated.
                y _ y + fh.
                i = lastIndex
        ] whileFalse: [ i _ i \\ self maxEntries + 1 ].

        string _ unfinishedEntry contents.
        port displayString: string from: 1 to: string size at: x@y strikeFont: font kern: font baseKern negated.! !

!NewTranscript class methodsFor: 'displaying' stamp: 'jmv 2/18/2011 14:23'!
displayUnfinishedEntry
        showOnDisplay ifTrue: [
                (lastDisplayTime isNil or: [ (DateAndTime now - lastDisplayTime) totalSeconds > 1 ])
                        ifTrue: [ ^self display ].
                self displayUnfinishedEntryOn: Display ]! !

!NewTranscript class methodsFor: 'displaying' stamp: 'jmv 2/18/2011 14:14'!
displayUnfinishedEntryOn: aForm

        | font port count string x y fh |
        port _ BitBlt toForm: aForm.
        port clipWidth: innerRectangle right.
        font _ StrikeFont default.
        font installOn: port foregroundColor: Color black.
       
        fh _ font height.
        count _ innerRectangle height // fh-1.
        x _ innerRectangle left.

        string _ unfinishedEntry contents.
        y _ ((lastIndex - firstIndex \\ self maxEntries) min: count-1) + 1 * font height + innerRectangle top.
        port displayString: string from: 1 to: string size at: x@y strikeFont: font kern: font baseKern negated.! !

!NewTranscript class methodsFor: 'class initialization' stamp: 'jmv 2/18/2011 13:13'!
initialize
        "
        self initialize
        "
        showOnDisplay _ true.
        innerRectangle _ 20@20 extent: 300@500.
        logToFile _ false.
        entries _ Array new: self maxEntries.
        unfinishedEntry _ '' writeStream.
        accessSemaphore _ Semaphore forMutualExclusion.
        self clear! !

!NewTranscript class methodsFor: 'constants' stamp: 'jmv 2/18/2011 12:33'!
filename
        ^'transcript.txt'! !

!NewTranscript class methodsFor: 'constants' stamp: 'jmv 2/18/2011 12:59'!
maxEntries
        ^1000! !

NewTranscript initialize!
Reply | Threaded
Open this post in threaded view
|

Re: [squeak-dev] Re: [Pharo-project] Cog VM -- Thanks and Performance / Optimization Questions

Igor Stasenko

It seems that you guys (Stephane & Juan) both making same mistake. :)

You trying to assign multiple different roles to Transcript at once:
 - be a stream
 - be a GUI element (can draw/update itself on a screen)..

Hey.. Transcript is not a swiss knife!
It is just a stream (kind of special one), but other than that.. it is
just a stream.
And what you see on a screen - it is just a view of it.

So, Juan it is cool that you have better Transcript... still it having
same deficiencies which i shown to Stephane not long ago,
and tried to convince him that Transcript is a stream, not a window. A
Transcript window is just a view of real transcript.

And i think this is quite easy to make this separation and have sound model.


On 18 February 2011 19:33, Juan Vuletich <[hidden email]> wrote:

> Hi Eliot,
>
> Eliot Miranda wrote:
>>
>> Hi John,
>>
>>    good questions.
>>
>> On Thu, Feb 17, 2011 at 6:21 AM, John B Thiel <[hidden email]
>> <mailto:[hidden email]>> wrote:
>>
>>    Cog VM -- Thanks and Performance / Optimization Questions
>>
>>    ...
>>    (Also, any notoriously slow subsystems?  For example, Transcript
>>    writing is glacial.)
>>
>>
>> Someone should replace the Transcript's reliance on (I think) some kind of
>> FormMorph which moved huge numbers of bits on each write.  But this is not a
>> VM issue.  It's a Smalltalk issue.  Whoever did this would instantly become
>> a hero.
>
> There are other problems with Transcript besides performance. It is easy to
> break the UI if called at the wrong times. In those cases, it is usually
> needed to kill Squeak from the OS. Besides, it is not thread safe.
>
> Instantly becoming a hero sounds cool, so this is my attempt at it :) I only
> tried this in Cuis, but I believe it should work on Squeak and Pharo without
> much trouble. After loading this code, you can evaluate 'Smalltalk at:
> #Transcript put: NewTranscript'.
>
> Some good properties of this are:
> - Very fast.
> - Thread safe!
> - Doesn't use Morphic at all. Can be used to debug Morphic itself.
> - Doesn't do delayed execution (no events, no forked processes). Immediate
> visual feedback.
> - Can show itself on Display, log to File, both, or none.
> - Can be used for headless or remote images (for example, web servers).
>
> Some possible downsides are:
> - Output only. Not a text editor. We have the Workspace and the Transcripter
> for that.
> - No seamless Morphic integration. I'll do one for Cuis, though.
>
> If no serious problems are found, I'll remove TranscriptStream from Cuis,
> and rename this class as Transcript.
>
> Cheers,
> Juan Vuletich
>
> 'From Cuis 3.0 of 31 January 2011 [latest update: #790] on 18 February 2011
> at 2:36:31 pm'!
> !classDefinition: #NewTranscript category: #'System-Support'!
> Object subclass: #NewTranscript
>        instanceVariableNames: ''
>        classVariableNames: ''
>        poolDictionaries: ''
>        category: 'System-Support'!
>
> !NewTranscript commentStamp: '<historical>' prior: 0!
> A new implementation of Transcript.
> - Thread safe.
> - Very fast.
> - Independent of Morphic or any other UI framework.
> - Inmediate feedback.
> - Can log to file.
> - Not an editor. Only used for output.
> - All protocol is on the Class side!
>
> !classDefinition: 'NewTranscript class' category: nil!
> NewTranscript class
>        instanceVariableNames: 'entries firstIndex lastIndex accessSemaphore
> unfinishedEntry logToFile showOnDisplay innerRectangle lastDisplayTime'!
>
> !DateAndTime methodsFor: 'squeak protocol' stamp: 'jmv 2/18/2011 12:57'!
> printWithMsOn: aStream
>        "Print with millisecond resolution, no leading space, no offset."
>
>        | ps |
>        self printYMDOn: aStream withLeadingSpace: false.
>        aStream nextPut: $T.
>        self printHMSOn: aStream.
>        ps _ (self nanoSecond // 1000000) printString padded: #left to: 3
> with: $0.
>        aStream nextPut: $..
>        aStream nextPutAll: ps! !
>
>
> !NewTranscript class methodsFor: 'preferred protocol' stamp: 'jmv 2/18/2011
> 14:16'!
> clear
>        | stream |
>        accessSemaphore critical: [
>                "Having at least one entry simplifies handling of the entries
> circular collection"
>                firstIndex _ 1.
>                lastIndex _ 1.
>                entries at: 1 put: 'Transcript'.
>                unfinishedEntry reset.
>
>                logToFile ifTrue: [
>                        stream _ StandardFileStream forceNewFileNamed: self
> filename.
>                        [
>                                stream nextPutAll: 'Transcript log started:
> '.
>                                DateAndTime now printOn: stream.
>                                stream
>                                        lf;
>                                        nextPutAll:
> '------------------------------------------------------------------------';
>                                        lf
>                        ] ensure: [ stream close ]]].
>        self display! !
>
> !NewTranscript class methodsFor: 'preferred protocol' stamp: 'jmv 2/18/2011
> 14:16'!
> log: aString
>        self addEntry: aString.
>        self display! !
>
> !NewTranscript class methodsFor: 'preferred protocol' stamp: 'jmv 2/18/2011
> 11:49'!
> logToFile
>        "
>        self logToFile
>        "
>        logToFile _ true! !
>
> !NewTranscript class methodsFor: 'old Transcript compatibility' stamp: 'jmv
> 2/18/2011 11:20'!
> cr
>        "WriteStream protocol.
>        In the older TranscriptStream, it added a CR character.
>        Now, finish the current incomplete entry."
>
>        self finishEntry! !
>
> !NewTranscript class methodsFor: 'old Transcript compatibility' stamp: 'jmv
> 2/18/2011 11:20'!
> crtab
>        "WriteStream protocol.
>        End the current entry, and start a new one starting with a single tab
> character."
>
>        self cr; tab! !
>
> !NewTranscript class methodsFor: 'old Transcript compatibility' stamp: 'jmv
> 2/18/2011 11:21'!
> endEntry
>        "For compatibility with old TranscriptStream. nop here"! !
>
> !NewTranscript class methodsFor: 'old Transcript compatibility' stamp: 'jmv
> 2/18/2011 11:21'!
> flush
>        "For compatibility with old TranscriptStream. nop here"! !
>
> !NewTranscript class methodsFor: 'old Transcript compatibility' stamp: 'jmv
> 2/18/2011 14:17'!
> nextPut: aCharacter
>        "WriteStream protocol.
>        Append aCharacter to the unfinishedEntry.
>        cr characters sent with this message do NOT finish the current
> unfinishedEntry."
>
>        unfinishedEntry nextPut: aCharacter.
>        self displayUnfinishedEntry! !
>
> !NewTranscript class methodsFor: 'old Transcript compatibility' stamp: 'jmv
> 2/18/2011 14:17'!
> nextPutAll: aString
>        "WriteStream protocol.
>        Append aString to the unfinishedEntry.
>        cr characters sent with this message do NOT finish the current
> unfinishedEntry."
>
>        unfinishedEntry nextPutAll: aString.
>        self displayUnfinishedEntry! !
>
> !NewTranscript class methodsFor: 'old Transcript compatibility' stamp: 'jmv
> 2/18/2011 11:20'!
> print: anObject
>        "Stream protocol"
>        anObject printOn: self! !
>
> !NewTranscript class methodsFor: 'old Transcript compatibility' stamp: 'jmv
> 2/18/2011 11:22'!
> show: anObject
>        "Old TranscriptStream protocol."
>        self nextPutAll: anObject asString! !
>
> !NewTranscript class methodsFor: 'old Transcript compatibility' stamp: 'jmv
> 2/18/2011 11:22'!
> space
>        "WriteStream protocol.
>        Append a space character to the receiver."
>
>        self nextPut: Character space! !
>
> !NewTranscript class methodsFor: 'old Transcript compatibility' stamp: 'jmv
> 2/18/2011 11:22'!
> tab
>        "WriteStream protocol.
>        Append a tab character to the receiver."
>
>        self nextPut: Character tab! !
>
> !NewTranscript class methodsFor: 'private' stamp: 'jmv 2/18/2011 12:59'!
> addEntry: aString
>        "Add a new entrie to the entries circular list. If full, a new entry
> will replace the oldest one."
>        | msg now |
>        logToFile ifTrue: [
>                now _ DateAndTime now.
>                msg _ String streamContents: [ :strm |
>                        now printWithMsOn: strm.
>                        strm
>                                nextPutAll: ' process:';
>                                nextPutAll: Processor activeProcess priority
> printString;
>                                nextPut: $ ;
>                                nextPutAll: Processor activeProcess hash
> printString;
>                                nextPut: $ ;
>                                nextPutAll: aString;
>                                lf ]].
>
>        self addEntry: aString logToFile: msg! !
>
> !NewTranscript class methodsFor: 'private' stamp: 'jmv 2/18/2011 12:34'!
> addEntry: aString logToFile: otherString
>        "Add a new entrie to the entries circular list. If full, a new entry
> will replace the oldest one."
>        | stream |
>        accessSemaphore critical: [
>
>                "Internal circular collection"
>                lastIndex _ lastIndex \\ self maxEntries + 1.
>                firstIndex = lastIndex ifTrue: [
>                        firstIndex _ firstIndex \\ self maxEntries + 1 ].
>                entries at: lastIndex put: aString.
>
>                "external file"
>                otherString ifNotNil: [
>                        [
>                                stream _ StandardFileStream fileNamed: self
> filename.
>                                stream
>                                        setToEnd;
>                                        nextPutAll: otherString;
>                                        flush]
>                        ensure: [ stream close ]
>                ]
>        ]! !
>
> !NewTranscript class methodsFor: 'private' stamp: 'jmv 2/18/2011 14:16'!
> finishEntry
>        | newEntry |
>        newEntry _ unfinishedEntry contents.
>        unfinishedEntry reset.
>        self addEntry: newEntry.
>        self display! !
>
> !NewTranscript class methodsFor: 'displaying' stamp: 'jmv 2/18/2011 14:20'!
> display
>        showOnDisplay ifTrue: [
>                self displayOn: Display.
>                lastDisplayTime _ DateAndTime now ]! !
>
> !NewTranscript class methodsFor: 'displaying' stamp: 'jmv 2/18/2011 14:09'!
> displayOn: aForm
>        "
>        experimentos
>        NewTranscript displayOn: Display
>        "
>        | font port count i string x y fh f |
>        aForm border: (innerRectangle outsetBy: 3) width: 3.
>        aForm fill: innerRectangle fillColor: Color white.
>        port _ BitBlt toForm: aForm.
>        port clipWidth: innerRectangle right.
>        font _ StrikeFont default.
>        font installOn: port foregroundColor: Color black.
>
>        fh _ font height.
>        count _ innerRectangle height // fh-1.
>        x _ innerRectangle left.
>        y _ innerRectangle top.
>        f _ firstIndex-1.
>        firstIndex > lastIndex ifTrue: [ f _ f - self maxEntries ].
>        i _ (lastIndex - count max: f) \\ self maxEntries + 1.
>        [
>                string _ entries at: i.
>                port displayString: string from: 1 to: string size at: x@y
> strikeFont: font kern: font baseKern negated.
>                y _ y + fh.
>                i = lastIndex
>        ] whileFalse: [ i _ i \\ self maxEntries + 1 ].
>
>        string _ unfinishedEntry contents.
>        port displayString: string from: 1 to: string size at: x@y
> strikeFont: font kern: font baseKern negated.! !
>
> !NewTranscript class methodsFor: 'displaying' stamp: 'jmv 2/18/2011 14:23'!
> displayUnfinishedEntry
>        showOnDisplay ifTrue: [
>                (lastDisplayTime isNil or: [ (DateAndTime now -
> lastDisplayTime) totalSeconds > 1 ])
>                        ifTrue: [ ^self display ].
>                self displayUnfinishedEntryOn: Display ]! !
>
> !NewTranscript class methodsFor: 'displaying' stamp: 'jmv 2/18/2011 14:14'!
> displayUnfinishedEntryOn: aForm
>
>        | font port count string x y fh |
>        port _ BitBlt toForm: aForm.
>        port clipWidth: innerRectangle right.
>        font _ StrikeFont default.
>        font installOn: port foregroundColor: Color black.
>
>        fh _ font height.
>        count _ innerRectangle height // fh-1.
>        x _ innerRectangle left.
>
>        string _ unfinishedEntry contents.
>        y _ ((lastIndex - firstIndex \\ self maxEntries) min: count-1) + 1 *
> font height + innerRectangle top.
>        port displayString: string from: 1 to: string size at: x@y
> strikeFont: font kern: font baseKern negated.! !
>
> !NewTranscript class methodsFor: 'class initialization' stamp: 'jmv
> 2/18/2011 13:13'!
> initialize
>        "
>        self initialize
>        "
>        showOnDisplay _ true.
>        innerRectangle _ 20@20 extent: 300@500.
>        logToFile _ false.
>        entries _ Array new: self maxEntries.
>        unfinishedEntry _ '' writeStream.
>        accessSemaphore _ Semaphore forMutualExclusion.
>        self clear! !
>
> !NewTranscript class methodsFor: 'constants' stamp: 'jmv 2/18/2011 12:33'!
> filename
>        ^'transcript.txt'! !
>
> !NewTranscript class methodsFor: 'constants' stamp: 'jmv 2/18/2011 12:59'!
> maxEntries
>        ^1000! !
>
> NewTranscript initialize!
>
>
>
>



--
Best regards,
Igor Stasenko AKA sig.
Reply | Threaded
Open this post in threaded view
|

Re: [squeak-dev] Re: [Pharo-project] Cog VM -- Thanks and Performance / Optimization Questions

Eliot Miranda-2
 


On Fri, Feb 18, 2011 at 1:41 PM, Igor Stasenko <[hidden email]> wrote:

It seems that you guys (Stephane & Juan) both making same mistake. :)

You trying to assign multiple different roles to Transcript at once:
 - be a stream
 - be a GUI element (can draw/update itself on a screen)..

Hey.. Transcript is not a swiss knife!
It is just a stream (kind of special one), but other than that.. it is
just a stream.
And what you see on a screen - it is just a view of it.

+1
 

So, Juan it is cool that you have better Transcript... still it having
same deficiencies which i shown to Stephane not long ago,
and tried to convince him that Transcript is a stream, not a window. A
Transcript window is just a view of real transcript.

And i think this is quite easy to make this separation and have sound model.


On 18 February 2011 19:33, Juan Vuletich <[hidden email]> wrote:
> Hi Eliot,
>
> Eliot Miranda wrote:
>>
>> Hi John,
>>
>>    good questions.
>>
>> On Thu, Feb 17, 2011 at 6:21 AM, John B Thiel <[hidden email]
>> <mailto:[hidden email]>> wrote:
>>
>>    Cog VM -- Thanks and Performance / Optimization Questions
>>
>>    ...
>>    (Also, any notoriously slow subsystems?  For example, Transcript
>>    writing is glacial.)
>>
>>
>> Someone should replace the Transcript's reliance on (I think) some kind of
>> FormMorph which moved huge numbers of bits on each write.  But this is not a
>> VM issue.  It's a Smalltalk issue.  Whoever did this would instantly become
>> a hero.
>
> There are other problems with Transcript besides performance. It is easy to
> break the UI if called at the wrong times. In those cases, it is usually
> needed to kill Squeak from the OS. Besides, it is not thread safe.
>
> Instantly becoming a hero sounds cool, so this is my attempt at it :) I only
> tried this in Cuis, but I believe it should work on Squeak and Pharo without
> much trouble. After loading this code, you can evaluate 'Smalltalk at:
> #Transcript put: NewTranscript'.
>
> Some good properties of this are:
> - Very fast.
> - Thread safe!
> - Doesn't use Morphic at all. Can be used to debug Morphic itself.
> - Doesn't do delayed execution (no events, no forked processes). Immediate
> visual feedback.
> - Can show itself on Display, log to File, both, or none.
> - Can be used for headless or remote images (for example, web servers).
>
> Some possible downsides are:
> - Output only. Not a text editor. We have the Workspace and the Transcripter
> for that.
> - No seamless Morphic integration. I'll do one for Cuis, though.
>
> If no serious problems are found, I'll remove TranscriptStream from Cuis,
> and rename this class as Transcript.
>
> Cheers,
> Juan Vuletich
>
> 'From Cuis 3.0 of 31 January 2011 [latest update: #790] on 18 February 2011
> at 2:36:31 pm'!
> !classDefinition: #NewTranscript category: #'System-Support'!
> Object subclass: #NewTranscript
>        instanceVariableNames: ''
>        classVariableNames: ''
>        poolDictionaries: ''
>        category: 'System-Support'!
>
> !NewTranscript commentStamp: '<historical>' prior: 0!
> A new implementation of Transcript.
> - Thread safe.
> - Very fast.
> - Independent of Morphic or any other UI framework.
> - Inmediate feedback.
> - Can log to file.
> - Not an editor. Only used for output.
> - All protocol is on the Class side!
>
> !classDefinition: 'NewTranscript class' category: nil!
> NewTranscript class
>        instanceVariableNames: 'entries firstIndex lastIndex accessSemaphore
> unfinishedEntry logToFile showOnDisplay innerRectangle lastDisplayTime'!
>
> !DateAndTime methodsFor: 'squeak protocol' stamp: 'jmv 2/18/2011 12:57'!
> printWithMsOn: aStream
>        "Print with millisecond resolution, no leading space, no offset."
>
>        | ps |
>        self printYMDOn: aStream withLeadingSpace: false.
>        aStream nextPut: $T.
>        self printHMSOn: aStream.
>        ps _ (self nanoSecond // 1000000) printString padded: #left to: 3
> with: $0.
>        aStream nextPut: $..
>        aStream nextPutAll: ps! !
>
>
> !NewTranscript class methodsFor: 'preferred protocol' stamp: 'jmv 2/18/2011
> 14:16'!
> clear
>        | stream |
>        accessSemaphore critical: [
>                "Having at least one entry simplifies handling of the entries
> circular collection"
>                firstIndex _ 1.
>                lastIndex _ 1.
>                entries at: 1 put: 'Transcript'.
>                unfinishedEntry reset.
>
>                logToFile ifTrue: [
>                        stream _ StandardFileStream forceNewFileNamed: self
> filename.
>                        [
>                                stream nextPutAll: 'Transcript log started:
> '.
>                                DateAndTime now printOn: stream.
>                                stream
>                                        lf;
>                                        nextPutAll:
> '------------------------------------------------------------------------';
>                                        lf
>                        ] ensure: [ stream close ]]].
>        self display! !
>
> !NewTranscript class methodsFor: 'preferred protocol' stamp: 'jmv 2/18/2011
> 14:16'!
> log: aString
>        self addEntry: aString.
>        self display! !
>
> !NewTranscript class methodsFor: 'preferred protocol' stamp: 'jmv 2/18/2011
> 11:49'!
> logToFile
>        "
>        self logToFile
>        "
>        logToFile _ true! !
>
> !NewTranscript class methodsFor: 'old Transcript compatibility' stamp: 'jmv
> 2/18/2011 11:20'!
> cr
>        "WriteStream protocol.
>        In the older TranscriptStream, it added a CR character.
>        Now, finish the current incomplete entry."
>
>        self finishEntry! !
>
> !NewTranscript class methodsFor: 'old Transcript compatibility' stamp: 'jmv
> 2/18/2011 11:20'!
> crtab
>        "WriteStream protocol.
>        End the current entry, and start a new one starting with a single tab
> character."
>
>        self cr; tab! !
>
> !NewTranscript class methodsFor: 'old Transcript compatibility' stamp: 'jmv
> 2/18/2011 11:21'!
> endEntry
>        "For compatibility with old TranscriptStream. nop here"! !
>
> !NewTranscript class methodsFor: 'old Transcript compatibility' stamp: 'jmv
> 2/18/2011 11:21'!
> flush
>        "For compatibility with old TranscriptStream. nop here"! !
>
> !NewTranscript class methodsFor: 'old Transcript compatibility' stamp: 'jmv
> 2/18/2011 14:17'!
> nextPut: aCharacter
>        "WriteStream protocol.
>        Append aCharacter to the unfinishedEntry.
>        cr characters sent with this message do NOT finish the current
> unfinishedEntry."
>
>        unfinishedEntry nextPut: aCharacter.
>        self displayUnfinishedEntry! !
>
> !NewTranscript class methodsFor: 'old Transcript compatibility' stamp: 'jmv
> 2/18/2011 14:17'!
> nextPutAll: aString
>        "WriteStream protocol.
>        Append aString to the unfinishedEntry.
>        cr characters sent with this message do NOT finish the current
> unfinishedEntry."
>
>        unfinishedEntry nextPutAll: aString.
>        self displayUnfinishedEntry! !
>
> !NewTranscript class methodsFor: 'old Transcript compatibility' stamp: 'jmv
> 2/18/2011 11:20'!
> print: anObject
>        "Stream protocol"
>        anObject printOn: self! !
>
> !NewTranscript class methodsFor: 'old Transcript compatibility' stamp: 'jmv
> 2/18/2011 11:22'!
> show: anObject
>        "Old TranscriptStream protocol."
>        self nextPutAll: anObject asString! !
>
> !NewTranscript class methodsFor: 'old Transcript compatibility' stamp: 'jmv
> 2/18/2011 11:22'!
> space
>        "WriteStream protocol.
>        Append a space character to the receiver."
>
>        self nextPut: Character space! !
>
> !NewTranscript class methodsFor: 'old Transcript compatibility' stamp: 'jmv
> 2/18/2011 11:22'!
> tab
>        "WriteStream protocol.
>        Append a tab character to the receiver."
>
>        self nextPut: Character tab! !
>
> !NewTranscript class methodsFor: 'private' stamp: 'jmv 2/18/2011 12:59'!
> addEntry: aString
>        "Add a new entrie to the entries circular list. If full, a new entry
> will replace the oldest one."
>        | msg now |
>        logToFile ifTrue: [
>                now _ DateAndTime now.
>                msg _ String streamContents: [ :strm |
>                        now printWithMsOn: strm.
>                        strm
>                                nextPutAll: ' process:';
>                                nextPutAll: Processor activeProcess priority
> printString;
>                                nextPut: $ ;
>                                nextPutAll: Processor activeProcess hash
> printString;
>                                nextPut: $ ;
>                                nextPutAll: aString;
>                                lf ]].
>
>        self addEntry: aString logToFile: msg! !
>
> !NewTranscript class methodsFor: 'private' stamp: 'jmv 2/18/2011 12:34'!
> addEntry: aString logToFile: otherString
>        "Add a new entrie to the entries circular list. If full, a new entry
> will replace the oldest one."
>        | stream |
>        accessSemaphore critical: [
>
>                "Internal circular collection"
>                lastIndex _ lastIndex \\ self maxEntries + 1.
>                firstIndex = lastIndex ifTrue: [
>                        firstIndex _ firstIndex \\ self maxEntries + 1 ].
>                entries at: lastIndex put: aString.
>
>                "external file"
>                otherString ifNotNil: [
>                        [
>                                stream _ StandardFileStream fileNamed: self
> filename.
>                                stream
>                                        setToEnd;
>                                        nextPutAll: otherString;
>                                        flush]
>                        ensure: [ stream close ]
>                ]
>        ]! !
>
> !NewTranscript class methodsFor: 'private' stamp: 'jmv 2/18/2011 14:16'!
> finishEntry
>        | newEntry |
>        newEntry _ unfinishedEntry contents.
>        unfinishedEntry reset.
>        self addEntry: newEntry.
>        self display! !
>
> !NewTranscript class methodsFor: 'displaying' stamp: 'jmv 2/18/2011 14:20'!
> display
>        showOnDisplay ifTrue: [
>                self displayOn: Display.
>                lastDisplayTime _ DateAndTime now ]! !
>
> !NewTranscript class methodsFor: 'displaying' stamp: 'jmv 2/18/2011 14:09'!
> displayOn: aForm
>        "
>        experimentos
>        NewTranscript displayOn: Display
>        "
>        | font port count i string x y fh f |
>        aForm border: (innerRectangle outsetBy: 3) width: 3.
>        aForm fill: innerRectangle fillColor: Color white.
>        port _ BitBlt toForm: aForm.
>        port clipWidth: innerRectangle right.
>        font _ StrikeFont default.
>        font installOn: port foregroundColor: Color black.
>
>        fh _ font height.
>        count _ innerRectangle height // fh-1.
>        x _ innerRectangle left.
>        y _ innerRectangle top.
>        f _ firstIndex-1.
>        firstIndex > lastIndex ifTrue: [ f _ f - self maxEntries ].
>        i _ (lastIndex - count max: f) \\ self maxEntries + 1.
>        [
>                string _ entries at: i.
>                port displayString: string from: 1 to: string size at: x@y
> strikeFont: font kern: font baseKern negated.
>                y _ y + fh.
>                i = lastIndex
>        ] whileFalse: [ i _ i \\ self maxEntries + 1 ].
>
>        string _ unfinishedEntry contents.
>        port displayString: string from: 1 to: string size at: x@y
> strikeFont: font kern: font baseKern negated.! !
>
> !NewTranscript class methodsFor: 'displaying' stamp: 'jmv 2/18/2011 14:23'!
> displayUnfinishedEntry
>        showOnDisplay ifTrue: [
>                (lastDisplayTime isNil or: [ (DateAndTime now -
> lastDisplayTime) totalSeconds > 1 ])
>                        ifTrue: [ ^self display ].
>                self displayUnfinishedEntryOn: Display ]! !
>
> !NewTranscript class methodsFor: 'displaying' stamp: 'jmv 2/18/2011 14:14'!
> displayUnfinishedEntryOn: aForm
>
>        | font port count string x y fh |
>        port _ BitBlt toForm: aForm.
>        port clipWidth: innerRectangle right.
>        font _ StrikeFont default.
>        font installOn: port foregroundColor: Color black.
>
>        fh _ font height.
>        count _ innerRectangle height // fh-1.
>        x _ innerRectangle left.
>
>        string _ unfinishedEntry contents.
>        y _ ((lastIndex - firstIndex \\ self maxEntries) min: count-1) + 1 *
> font height + innerRectangle top.
>        port displayString: string from: 1 to: string size at: x@y
> strikeFont: font kern: font baseKern negated.! !
>
> !NewTranscript class methodsFor: 'class initialization' stamp: 'jmv
> 2/18/2011 13:13'!
> initialize
>        "
>        self initialize
>        "
>        showOnDisplay _ true.
>        innerRectangle _ 20@20 extent: 300@500.
>        logToFile _ false.
>        entries _ Array new: self maxEntries.
>        unfinishedEntry _ '' writeStream.
>        accessSemaphore _ Semaphore forMutualExclusion.
>        self clear! !
>
> !NewTranscript class methodsFor: 'constants' stamp: 'jmv 2/18/2011 12:33'!
> filename
>        ^'transcript.txt'! !
>
> !NewTranscript class methodsFor: 'constants' stamp: 'jmv 2/18/2011 12:59'!
> maxEntries
>        ^1000! !
>
> NewTranscript initialize!
>
>
>
>



--
Best regards,
Igor Stasenko AKA sig.

Reply | Threaded
Open this post in threaded view
|

New Transcript (was: [squeak-dev] Re: [Pharo-project] Cog VM -- Thanks and Performance / Optimization Questions)

Juan Vuletich-4
In reply to this post by Juan Vuletich-4
 
Hi Folks,

This new version includes full Morphic integration. It was done for
Cuis, but it shouldn't be too hard to adapt for Squeak / Pharo.

Cheers,
Juan Vuletich

Juan Vuletich wrote:

> Hi Eliot,
>
> There are other problems with Transcript besides performance. It is
> easy to break the UI if called at the wrong times. In those cases, it
> is usually needed to kill Squeak from the OS. Besides, it is not
> thread safe.
>
> Instantly becoming a hero sounds cool, so this is my attempt at it :)
> I only tried this in Cuis, but I believe it should work on Squeak and
> Pharo without much trouble. After loading this code, you can evaluate
> 'Smalltalk at: #Transcript put: NewTranscript'.
>
> Some good properties of this are:
> - Very fast.
> - Thread safe!
> - Doesn't use Morphic at all. Can be used to debug Morphic itself.
> - Doesn't do delayed execution (no events, no forked processes).
> Immediate visual feedback.
> - Can show itself on Display, log to File, both, or none.
> - Can be used for headless or remote images (for example, web servers).
>
> Some possible downsides are:
> - Output only. Not a text editor. We have the Workspace and the
> Transcripter for that.
> - No seamless Morphic integration. I'll do one for Cuis, though.
>
> If no serious problems are found, I'll remove TranscriptStream from
> Cuis, and rename this class as Transcript.
>
> Cheers,
> Juan Vuletich

'From Cuis 3.0 of 31 January 2011 [latest update: #790] on 18 February 2011 at 5:34:24 pm'!
!classDefinition: #Transcript category: #'System-Support'!
Object subclass: #Transcript
        instanceVariableNames: ''
        classVariableNames: ''
        poolDictionaries: ''
        category: 'System-Support'!

!Transcript commentStamp: '<historical>' prior: 0!
A new implementation of Transcript.
- Thread safe.
- Very fast.
- Independent of Morphic or any other UI framework.
- Immediate feedback.
- Can log to file.
- Not an editor. Only used for output.
- All protocol is on the Class side!

!classDefinition: 'Transcript class' category: nil!
Transcript class
        instanceVariableNames: 'entries firstIndex lastIndex accessSemaphore unfinishedEntry logToFile showOnDisplay innerRectangle lastDisplayTime'!
!classDefinition: #TranscriptMorph category: #'Morphic-Widgets'!
BorderedMorph subclass: #TranscriptMorph
        instanceVariableNames: 'form'
        classVariableNames: ''
        poolDictionaries: ''
        category: 'Morphic-Widgets'!

!DateAndTime methodsFor: 'squeak protocol' stamp: 'jmv 2/18/2011 12:57'!
printWithMsOn: aStream
        "Print with millisecond resolution, no leading space, no offset."

        | ps |
        self printYMDOn: aStream withLeadingSpace: false.
        aStream nextPut: $T.
        self printHMSOn: aStream.
        ps _ (self nanoSecond // 1000000) printString padded: #left to: 3 with: $0.
        aStream nextPut: $..
        aStream nextPutAll: ps! !


!PasteUpMorph methodsFor: 'world menu' stamp: 'jmv 2/18/2011 17:30'!
findATranscript: evt
        "Locate a transcript, open it, and bring it to the front.  Create one if necessary"

        self
                findAWindowSatisfying: [ :aWindow | aWindow model == Transcript]
                orMakeOneUsing: [ TranscriptMorph openWindow ]! !


!TextModelMorph methodsFor: 'updating' stamp: 'jmv 2/18/2011 11:12'!
update: aSymbol
        aSymbol ifNil: [^self].
        aSymbol == #flash ifTrue: [^self flash].
        aSymbol == #actualContents
                ifTrue: [
                        "Some day, it would be nice to keep objects and update them
                        instead of throwing them away all the time for no good reason..."
                        textMorph releaseParagraph.
                        self formatAndStyleIfNeeded.
                        ^self].
        aSymbol == #acceptedContents ifTrue: [
                model refetch.
                ^self].
        aSymbol == #refetched ifTrue: [
                self setSelection: model getSelection.
                self hasUnacceptedEdits: false.
                ^self].
        aSymbol == #initialSelection
                ifTrue: [^self setSelection: model getSelection].
        aSymbol == #autoSelect
                ifTrue: [
                        self handleEdit: [
                                        TextEditor abandonChangeText. "no replacement!!"
                                        self editor
                                                setSearch: model autoSelectString;
                                                againOrSame: true ]].
        aSymbol == #clearUserEdits ifTrue: [^self hasUnacceptedEdits: false].
        aSymbol == #wantToChange
                ifTrue: [
                        self canDiscardEdits ifFalse: [^self promptForCancel].
                        ^self].
        aSymbol == #codeChangedElsewhere
                ifTrue: [
                        self hasEditingConflicts: true.
                        ^self changed ].
        aSymbol == #shoutStyle
                ifTrue: [
                        self stylerStyled.
                        ^self changed ].! !


!TheWorldMenu methodsFor: 'commands' stamp: 'jmv 2/18/2011 17:29'!
openTranscript

        TranscriptMorph openWindow! !


!Transcript class methodsFor: 'preferred protocol' stamp: 'jmv 2/18/2011 16:49'!
bounds: aRectangle
        innerRectangle _ aRectangle insetBy: self borderWidth! !

!Transcript class methodsFor: 'preferred protocol' stamp: 'jmv 2/18/2011 14:16'!
clear
        | stream |
        accessSemaphore critical: [
                "Having at least one entry simplifies handling of the entries circular collection"
                firstIndex _ 1.
                lastIndex _ 1.
                entries at: 1 put: 'Transcript'.
                unfinishedEntry reset.
               
                logToFile ifTrue: [
                        stream _ StandardFileStream forceNewFileNamed: self filename.
                        [
                                stream nextPutAll: 'Transcript log started: '.
                                DateAndTime now printOn: stream.
                                stream
                                        lf;
                                        nextPutAll: '------------------------------------------------------------------------';
                                        lf
                        ] ensure: [ stream close ]]].
        self display! !

!Transcript class methodsFor: 'preferred protocol' stamp: 'jmv 2/18/2011 14:16'!
log: aString
        self addEntry: aString.
        self display! !

!Transcript class methodsFor: 'preferred protocol' stamp: 'jmv 2/18/2011 16:46'!
logToFile: aBoolean
        "
        self logToFile
        "
        logToFile _ aBoolean! !

!Transcript class methodsFor: 'preferred protocol' stamp: 'jmv 2/18/2011 16:46'!
showOnDisplay: aBoolean
        "
        self logToFile
        "
        showOnDisplay _ aBoolean! !

!Transcript class methodsFor: 'preferred protocol' stamp: 'jmv 2/18/2011 17:06'!
windowIsClosing
        self showOnDisplay: false! !

!Transcript class methodsFor: 'old Transcript compatibility' stamp: 'jmv 2/18/2011 11:20'!
cr
        "WriteStream protocol.
        In the older TranscriptStream, it added a CR character.
        Now, finish the current incomplete entry."

        self finishEntry! !

!Transcript class methodsFor: 'old Transcript compatibility' stamp: 'jmv 2/18/2011 11:20'!
crtab
        "WriteStream protocol.
        End the current entry, and start a new one starting with a single tab character."

        self cr; tab! !

!Transcript class methodsFor: 'old Transcript compatibility' stamp: 'jmv 2/18/2011 11:21'!
endEntry
        "For compatibility with old TranscriptStream. nop here"! !

!Transcript class methodsFor: 'old Transcript compatibility' stamp: 'jmv 2/18/2011 11:21'!
flush
        "For compatibility with old TranscriptStream. nop here"! !

!Transcript class methodsFor: 'old Transcript compatibility' stamp: 'jmv 2/18/2011 14:17'!
nextPut: aCharacter
        "WriteStream protocol.
        Append aCharacter to the unfinishedEntry.
        cr characters sent with this message do NOT finish the current unfinishedEntry."

        unfinishedEntry nextPut: aCharacter.
        self displayUnfinishedEntry! !

!Transcript class methodsFor: 'old Transcript compatibility' stamp: 'jmv 2/18/2011 14:17'!
nextPutAll: aString
        "WriteStream protocol.
        Append aString to the unfinishedEntry.
        cr characters sent with this message do NOT finish the current unfinishedEntry."

        unfinishedEntry nextPutAll: aString.
        self displayUnfinishedEntry! !

!Transcript class methodsFor: 'old Transcript compatibility' stamp: 'jmv 2/18/2011 11:20'!
print: anObject
        "Stream protocol"
        anObject printOn: self! !

!Transcript class methodsFor: 'old Transcript compatibility' stamp: 'jmv 2/18/2011 11:22'!
show: anObject
        "Old TranscriptStream protocol."
        self nextPutAll: anObject asString! !

!Transcript class methodsFor: 'old Transcript compatibility' stamp: 'jmv 2/18/2011 11:22'!
space
        "WriteStream protocol.
        Append a space character to the receiver."

        self nextPut: Character space! !

!Transcript class methodsFor: 'old Transcript compatibility' stamp: 'jmv 2/18/2011 11:22'!
tab
        "WriteStream protocol.
        Append a tab character to the receiver."

        self nextPut: Character tab! !

!Transcript class methodsFor: 'private' stamp: 'jmv 2/18/2011 12:59'!
addEntry: aString
        "Add a new entrie to the entries circular list. If full, a new entry will replace the oldest one."
        | msg now |
        logToFile ifTrue: [
                now _ DateAndTime now.
                msg _ String streamContents: [ :strm |
                        now printWithMsOn: strm.
                        strm
                                nextPutAll: ' process:';
                                nextPutAll: Processor activeProcess priority printString;
                                nextPut: $ ;
                                nextPutAll: Processor activeProcess hash printString;
                                nextPut: $ ;
                                nextPutAll: aString;
                                lf ]].

        self addEntry: aString logToFile: msg! !

!Transcript class methodsFor: 'private' stamp: 'jmv 2/18/2011 12:34'!
addEntry: aString logToFile: otherString
        "Add a new entrie to the entries circular list. If full, a new entry will replace the oldest one."
        | stream |
        accessSemaphore critical: [
               
                "Internal circular collection"
                lastIndex _ lastIndex \\ self maxEntries + 1.
                firstIndex = lastIndex ifTrue: [
                        firstIndex _ firstIndex \\ self maxEntries + 1 ].
                entries at: lastIndex put: aString.
               
                "external file"
                otherString ifNotNil: [
                        [
                                stream _ StandardFileStream fileNamed: self filename.
                                stream
                                        setToEnd;
                                        nextPutAll: otherString;
                                        flush]
                        ensure: [ stream close ]
                ]
        ]! !

!Transcript class methodsFor: 'private' stamp: 'jmv 2/18/2011 14:16'!
finishEntry
        | newEntry |
        newEntry _ unfinishedEntry contents.
        unfinishedEntry reset.
        self addEntry: newEntry.
        self display! !

!Transcript class methodsFor: 'displaying' stamp: 'jmv 2/18/2011 14:20'!
display
        showOnDisplay ifTrue: [
                self displayOn: Display.
                lastDisplayTime _ DateAndTime now ]! !

!Transcript class methodsFor: 'displaying' stamp: 'jmv 2/18/2011 16:49'!
displayOn: aForm
        "
        experimentos
        Transcript displayOn: Display
        "
        | font port count i string x y fh f bw |
        bw _ self borderWidth.
        aForm border: (innerRectangle outsetBy: bw) width: bw.
        aForm fill: innerRectangle fillColor: Color white.
        port _ BitBlt toForm: aForm.
        port clipWidth: innerRectangle right.
        font _ StrikeFont default.
        font installOn: port foregroundColor: Color black.
       
        fh _ font height.
        count _ innerRectangle height // fh-1.
        x _ innerRectangle left.
        y _ innerRectangle top.
        f _ firstIndex-1.
        firstIndex > lastIndex ifTrue: [ f _ f - self maxEntries ].
        i _ (lastIndex - count max: f) \\ self maxEntries + 1.
        [
                string _ entries at: i.
                port displayString: string from: 1 to: string size at: x@y strikeFont: font kern: font baseKern negated.
                y _ y + fh.
                i = lastIndex
        ] whileFalse: [ i _ i \\ self maxEntries + 1 ].

        string _ unfinishedEntry contents.
        port displayString: string from: 1 to: string size at: x@y strikeFont: font kern: font baseKern negated.! !

!Transcript class methodsFor: 'displaying' stamp: 'jmv 2/18/2011 14:23'!
displayUnfinishedEntry
        showOnDisplay ifTrue: [
                (lastDisplayTime isNil or: [ (DateAndTime now - lastDisplayTime) totalSeconds > 1 ])
                        ifTrue: [ ^self display ].
                self displayUnfinishedEntryOn: Display ]! !

!Transcript class methodsFor: 'displaying' stamp: 'jmv 2/18/2011 14:14'!
displayUnfinishedEntryOn: aForm

        | font port count string x y fh |
        port _ BitBlt toForm: aForm.
        port clipWidth: innerRectangle right.
        font _ StrikeFont default.
        font installOn: port foregroundColor: Color black.
       
        fh _ font height.
        count _ innerRectangle height // fh-1.
        x _ innerRectangle left.

        string _ unfinishedEntry contents.
        y _ ((lastIndex - firstIndex \\ self maxEntries) min: count-1) + 1 * font height + innerRectangle top.
        port displayString: string from: 1 to: string size at: x@y strikeFont: font kern: font baseKern negated.! !

!Transcript class methodsFor: 'class initialization' stamp: 'jmv 2/18/2011 13:13'!
initialize
        "
        self initialize
        "
        showOnDisplay _ true.
        innerRectangle _ 20@20 extent: 300@500.
        logToFile _ false.
        entries _ Array new: self maxEntries.
        unfinishedEntry _ '' writeStream.
        accessSemaphore _ Semaphore forMutualExclusion.
        self clear! !

!Transcript class methodsFor: 'constants' stamp: 'jmv 2/18/2011 16:49'!
borderWidth
        ^1! !

!Transcript class methodsFor: 'constants' stamp: 'jmv 2/18/2011 12:33'!
filename
        ^'transcript.txt'! !

!Transcript class methodsFor: 'constants' stamp: 'jmv 2/18/2011 12:59'!
maxEntries
        ^1000! !


!TranscriptMorph methodsFor: 'drawing' stamp: 'jmv 2/18/2011 17:18'!
drawOn: aCanvas
        "
        Transcript
                showOnDisplay: true;
                bounds: bounds;
                displayOn: aCanvas form.
        "
        Transcript
                showOnDisplay: true;
                bounds: (0@0 extent: bounds extent);
                displayOn: form;
                bounds: bounds.
        aCanvas drawImage: form at: bounds origin! !

!TranscriptMorph methodsFor: 'geometry' stamp: 'jmv 2/18/2011 17:17'!
extent: aPoint
        super extent: aPoint.
        (form isNil or: [ form extent ~= aPoint ]) ifTrue: [
                form _ Form extent: aPoint depth: Display depth ]! !


!TranscriptMorph class methodsFor: 'instance creation' stamp: 'jmv 2/18/2011 17:08'!
openWindow
        "
        TranscriptMorph openWindow
        "
        SystemWindow new
                setLabel: 'Transcript';
                model: Transcript;
                widgetsColor: Theme current transcript;
                addMorph: TranscriptMorph new frame: (0@0 extent: 1@1);
                openInWorld! !

Transcript initialize!
Transcript class removeSelector: #logToFile!
TextModelMorph removeSelector: #appendEntry!
Smalltalk removeClassNamed: #TranscriptStream!
Reply | Threaded
Open this post in threaded view
|

Re: [squeak-dev] Re: [Pharo-project] Cog VM -- Thanks and Performance / Optimization Questions

Juan Vuletich-4
In reply to this post by Igor Stasenko
 
Igor Stasenko wrote:
> It seems that you guys (Stephane & Juan) both making same mistake. :)
>
> You trying to assign multiple different roles to Transcript at once:
>  - be a stream
>  - be a GUI element (can draw/update itself on a screen)..
>  

I don't agree. This new Transcript is not a Stream. It is a logger, that
can log both to screen and to file. The stream like protocol is just for
compatibility. Besides, the usual mechanisms for separating view and
model are not used on pourpuse, this doesn't rely on a particular GUI.
It is more like Transcripter (i.e. the emergency evaluator).

Cheers,
Juan Vuletich
Reply | Threaded
Open this post in threaded view
|

Re: [squeak-dev] Re: [Pharo-project] Cog VM -- Thanks and Performance / Optimization Questions

stephane ducasse-2
In reply to this post by Igor Stasenko

HI igor

and I agreed with you :).
I wanted it to be trheadsafe so that I could play with concurrency for an upcoming chapter.
Stef

>
> It seems that you guys (Stephane & Juan) both making same mistake. :)
>
> You trying to assign multiple different roles to Transcript at once:
> - be a stream
> - be a GUI element (can draw/update itself on a screen)..
>
> Hey.. Transcript is not a swiss knife!
> It is just a stream (kind of special one), but other than that.. it is
> just a stream.
> And what you see on a screen - it is just a view of it.
>
> So, Juan it is cool that you have better Transcript... still it having
> same deficiencies which i shown to Stephane not long ago,
> and tried to convince him that Transcript is a stream, not a window. A
> Transcript window is just a view of real transcript.
>
> And i think this is quite easy to make this separation and have sound model.
>
>
> On 18 February 2011 19:33, Juan Vuletich <[hidden email]> wrote:
>> Hi Eliot,
>>
>> Eliot Miranda wrote:
>>>
>>> Hi John,
>>>
>>>    good questions.
>>>
>>> On Thu, Feb 17, 2011 at 6:21 AM, John B Thiel <[hidden email]
>>> <mailto:[hidden email]>> wrote:
>>>
>>>    Cog VM -- Thanks and Performance / Optimization Questions
>>>
>>>    ...
>>>    (Also, any notoriously slow subsystems?  For example, Transcript
>>>    writing is glacial.)
>>>
>>>
>>> Someone should replace the Transcript's reliance on (I think) some kind of
>>> FormMorph which moved huge numbers of bits on each write.  But this is not a
>>> VM issue.  It's a Smalltalk issue.  Whoever did this would instantly become
>>> a hero.
>>
>> There are other problems with Transcript besides performance. It is easy to
>> break the UI if called at the wrong times. In those cases, it is usually
>> needed to kill Squeak from the OS. Besides, it is not thread safe.
>>
>> Instantly becoming a hero sounds cool, so this is my attempt at it :) I only
>> tried this in Cuis, but I believe it should work on Squeak and Pharo without
>> much trouble. After loading this code, you can evaluate 'Smalltalk at:
>> #Transcript put: NewTranscript'.
>>
>> Some good properties of this are:
>> - Very fast.
>> - Thread safe!
>> - Doesn't use Morphic at all. Can be used to debug Morphic itself.
>> - Doesn't do delayed execution (no events, no forked processes). Immediate
>> visual feedback.
>> - Can show itself on Display, log to File, both, or none.
>> - Can be used for headless or remote images (for example, web servers).
>>
>> Some possible downsides are:
>> - Output only. Not a text editor. We have the Workspace and the Transcripter
>> for that.
>> - No seamless Morphic integration. I'll do one for Cuis, though.
>>
>> If no serious problems are found, I'll remove TranscriptStream from Cuis,
>> and rename this class as Transcript.
>>
>> Cheers,
>> Juan Vuletich
>>
>> 'From Cuis 3.0 of 31 January 2011 [latest update: #790] on 18 February 2011
>> at 2:36:31 pm'!
>> !classDefinition: #NewTranscript category: #'System-Support'!
>> Object subclass: #NewTranscript
>>        instanceVariableNames: ''
>>        classVariableNames: ''
>>        poolDictionaries: ''
>>        category: 'System-Support'!
>>
>> !NewTranscript commentStamp: '<historical>' prior: 0!
>> A new implementation of Transcript.
>> - Thread safe.
>> - Very fast.
>> - Independent of Morphic or any other UI framework.
>> - Inmediate feedback.
>> - Can log to file.
>> - Not an editor. Only used for output.
>> - All protocol is on the Class side!
>>
>> !classDefinition: 'NewTranscript class' category: nil!
>> NewTranscript class
>>        instanceVariableNames: 'entries firstIndex lastIndex accessSemaphore
>> unfinishedEntry logToFile showOnDisplay innerRectangle lastDisplayTime'!
>>
>> !DateAndTime methodsFor: 'squeak protocol' stamp: 'jmv 2/18/2011 12:57'!
>> printWithMsOn: aStream
>>        "Print with millisecond resolution, no leading space, no offset."
>>
>>        | ps |
>>        self printYMDOn: aStream withLeadingSpace: false.
>>        aStream nextPut: $T.
>>        self printHMSOn: aStream.
>>        ps _ (self nanoSecond // 1000000) printString padded: #left to: 3
>> with: $0.
>>        aStream nextPut: $..
>>        aStream nextPutAll: ps! !
>>
>>
>> !NewTranscript class methodsFor: 'preferred protocol' stamp: 'jmv 2/18/2011
>> 14:16'!
>> clear
>>        | stream |
>>        accessSemaphore critical: [
>>                "Having at least one entry simplifies handling of the entries
>> circular collection"
>>                firstIndex _ 1.
>>                lastIndex _ 1.
>>                entries at: 1 put: 'Transcript'.
>>                unfinishedEntry reset.
>>
>>                logToFile ifTrue: [
>>                        stream _ StandardFileStream forceNewFileNamed: self
>> filename.
>>                        [
>>                                stream nextPutAll: 'Transcript log started:
>> '.
>>                                DateAndTime now printOn: stream.
>>                                stream
>>                                        lf;
>>                                        nextPutAll:
>> '------------------------------------------------------------------------';
>>                                        lf
>>                        ] ensure: [ stream close ]]].
>>        self display! !
>>
>> !NewTranscript class methodsFor: 'preferred protocol' stamp: 'jmv 2/18/2011
>> 14:16'!
>> log: aString
>>        self addEntry: aString.
>>        self display! !
>>
>> !NewTranscript class methodsFor: 'preferred protocol' stamp: 'jmv 2/18/2011
>> 11:49'!
>> logToFile
>>        "
>>        self logToFile
>>        "
>>        logToFile _ true! !
>>
>> !NewTranscript class methodsFor: 'old Transcript compatibility' stamp: 'jmv
>> 2/18/2011 11:20'!
>> cr
>>        "WriteStream protocol.
>>        In the older TranscriptStream, it added a CR character.
>>        Now, finish the current incomplete entry."
>>
>>        self finishEntry! !
>>
>> !NewTranscript class methodsFor: 'old Transcript compatibility' stamp: 'jmv
>> 2/18/2011 11:20'!
>> crtab
>>        "WriteStream protocol.
>>        End the current entry, and start a new one starting with a single tab
>> character."
>>
>>        self cr; tab! !
>>
>> !NewTranscript class methodsFor: 'old Transcript compatibility' stamp: 'jmv
>> 2/18/2011 11:21'!
>> endEntry
>>        "For compatibility with old TranscriptStream. nop here"! !
>>
>> !NewTranscript class methodsFor: 'old Transcript compatibility' stamp: 'jmv
>> 2/18/2011 11:21'!
>> flush
>>        "For compatibility with old TranscriptStream. nop here"! !
>>
>> !NewTranscript class methodsFor: 'old Transcript compatibility' stamp: 'jmv
>> 2/18/2011 14:17'!
>> nextPut: aCharacter
>>        "WriteStream protocol.
>>        Append aCharacter to the unfinishedEntry.
>>        cr characters sent with this message do NOT finish the current
>> unfinishedEntry."
>>
>>        unfinishedEntry nextPut: aCharacter.
>>        self displayUnfinishedEntry! !
>>
>> !NewTranscript class methodsFor: 'old Transcript compatibility' stamp: 'jmv
>> 2/18/2011 14:17'!
>> nextPutAll: aString
>>        "WriteStream protocol.
>>        Append aString to the unfinishedEntry.
>>        cr characters sent with this message do NOT finish the current
>> unfinishedEntry."
>>
>>        unfinishedEntry nextPutAll: aString.
>>        self displayUnfinishedEntry! !
>>
>> !NewTranscript class methodsFor: 'old Transcript compatibility' stamp: 'jmv
>> 2/18/2011 11:20'!
>> print: anObject
>>        "Stream protocol"
>>        anObject printOn: self! !
>>
>> !NewTranscript class methodsFor: 'old Transcript compatibility' stamp: 'jmv
>> 2/18/2011 11:22'!
>> show: anObject
>>        "Old TranscriptStream protocol."
>>        self nextPutAll: anObject asString! !
>>
>> !NewTranscript class methodsFor: 'old Transcript compatibility' stamp: 'jmv
>> 2/18/2011 11:22'!
>> space
>>        "WriteStream protocol.
>>        Append a space character to the receiver."
>>
>>        self nextPut: Character space! !
>>
>> !NewTranscript class methodsFor: 'old Transcript compatibility' stamp: 'jmv
>> 2/18/2011 11:22'!
>> tab
>>        "WriteStream protocol.
>>        Append a tab character to the receiver."
>>
>>        self nextPut: Character tab! !
>>
>> !NewTranscript class methodsFor: 'private' stamp: 'jmv 2/18/2011 12:59'!
>> addEntry: aString
>>        "Add a new entrie to the entries circular list. If full, a new entry
>> will replace the oldest one."
>>        | msg now |
>>        logToFile ifTrue: [
>>                now _ DateAndTime now.
>>                msg _ String streamContents: [ :strm |
>>                        now printWithMsOn: strm.
>>                        strm
>>                                nextPutAll: ' process:';
>>                                nextPutAll: Processor activeProcess priority
>> printString;
>>                                nextPut: $ ;
>>                                nextPutAll: Processor activeProcess hash
>> printString;
>>                                nextPut: $ ;
>>                                nextPutAll: aString;
>>                                lf ]].
>>
>>        self addEntry: aString logToFile: msg! !
>>
>> !NewTranscript class methodsFor: 'private' stamp: 'jmv 2/18/2011 12:34'!
>> addEntry: aString logToFile: otherString
>>        "Add a new entrie to the entries circular list. If full, a new entry
>> will replace the oldest one."
>>        | stream |
>>        accessSemaphore critical: [
>>
>>                "Internal circular collection"
>>                lastIndex _ lastIndex \\ self maxEntries + 1.
>>                firstIndex = lastIndex ifTrue: [
>>                        firstIndex _ firstIndex \\ self maxEntries + 1 ].
>>                entries at: lastIndex put: aString.
>>
>>                "external file"
>>                otherString ifNotNil: [
>>                        [
>>                                stream _ StandardFileStream fileNamed: self
>> filename.
>>                                stream
>>                                        setToEnd;
>>                                        nextPutAll: otherString;
>>                                        flush]
>>                        ensure: [ stream close ]
>>                ]
>>        ]! !
>>
>> !NewTranscript class methodsFor: 'private' stamp: 'jmv 2/18/2011 14:16'!
>> finishEntry
>>        | newEntry |
>>        newEntry _ unfinishedEntry contents.
>>        unfinishedEntry reset.
>>        self addEntry: newEntry.
>>        self display! !
>>
>> !NewTranscript class methodsFor: 'displaying' stamp: 'jmv 2/18/2011 14:20'!
>> display
>>        showOnDisplay ifTrue: [
>>                self displayOn: Display.
>>                lastDisplayTime _ DateAndTime now ]! !
>>
>> !NewTranscript class methodsFor: 'displaying' stamp: 'jmv 2/18/2011 14:09'!
>> displayOn: aForm
>>        "
>>        experimentos
>>        NewTranscript displayOn: Display
>>        "
>>        | font port count i string x y fh f |
>>        aForm border: (innerRectangle outsetBy: 3) width: 3.
>>        aForm fill: innerRectangle fillColor: Color white.
>>        port _ BitBlt toForm: aForm.
>>        port clipWidth: innerRectangle right.
>>        font _ StrikeFont default.
>>        font installOn: port foregroundColor: Color black.
>>
>>        fh _ font height.
>>        count _ innerRectangle height // fh-1.
>>        x _ innerRectangle left.
>>        y _ innerRectangle top.
>>        f _ firstIndex-1.
>>        firstIndex > lastIndex ifTrue: [ f _ f - self maxEntries ].
>>        i _ (lastIndex - count max: f) \\ self maxEntries + 1.
>>        [
>>                string _ entries at: i.
>>                port displayString: string from: 1 to: string size at: x@y
>> strikeFont: font kern: font baseKern negated.
>>                y _ y + fh.
>>                i = lastIndex
>>        ] whileFalse: [ i _ i \\ self maxEntries + 1 ].
>>
>>        string _ unfinishedEntry contents.
>>        port displayString: string from: 1 to: string size at: x@y
>> strikeFont: font kern: font baseKern negated.! !
>>
>> !NewTranscript class methodsFor: 'displaying' stamp: 'jmv 2/18/2011 14:23'!
>> displayUnfinishedEntry
>>        showOnDisplay ifTrue: [
>>                (lastDisplayTime isNil or: [ (DateAndTime now -
>> lastDisplayTime) totalSeconds > 1 ])
>>                        ifTrue: [ ^self display ].
>>                self displayUnfinishedEntryOn: Display ]! !
>>
>> !NewTranscript class methodsFor: 'displaying' stamp: 'jmv 2/18/2011 14:14'!
>> displayUnfinishedEntryOn: aForm
>>
>>        | font port count string x y fh |
>>        port _ BitBlt toForm: aForm.
>>        port clipWidth: innerRectangle right.
>>        font _ StrikeFont default.
>>        font installOn: port foregroundColor: Color black.
>>
>>        fh _ font height.
>>        count _ innerRectangle height // fh-1.
>>        x _ innerRectangle left.
>>
>>        string _ unfinishedEntry contents.
>>        y _ ((lastIndex - firstIndex \\ self maxEntries) min: count-1) + 1 *
>> font height + innerRectangle top.
>>        port displayString: string from: 1 to: string size at: x@y
>> strikeFont: font kern: font baseKern negated.! !
>>
>> !NewTranscript class methodsFor: 'class initialization' stamp: 'jmv
>> 2/18/2011 13:13'!
>> initialize
>>        "
>>        self initialize
>>        "
>>        showOnDisplay _ true.
>>        innerRectangle _ 20@20 extent: 300@500.
>>        logToFile _ false.
>>        entries _ Array new: self maxEntries.
>>        unfinishedEntry _ '' writeStream.
>>        accessSemaphore _ Semaphore forMutualExclusion.
>>        self clear! !
>>
>> !NewTranscript class methodsFor: 'constants' stamp: 'jmv 2/18/2011 12:33'!
>> filename
>>        ^'transcript.txt'! !
>>
>> !NewTranscript class methodsFor: 'constants' stamp: 'jmv 2/18/2011 12:59'!
>> maxEntries
>>        ^1000! !
>>
>> NewTranscript initialize!
>>
>>
>>
>>
>
>
>
> --
> Best regards,
> Igor Stasenko AKA sig.