> 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!
>
>
>
>