[Vm-dev] Re: [squeak-dev] Re: [Pharo-project] Cog VM -- Thanks and
Performance / Optimization Questions
Igor Stasenko
siguctua at gmail.com
Fri Feb 18 21:41:43 UTC 2011
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 <juan at jvuletich.org> wrote:
> Hi Eliot,
>
> Eliot Miranda wrote:
>>
>> Hi John,
>>
>> good questions.
>>
>> On Thu, Feb 17, 2011 at 6:21 AM, John B Thiel <jbthiel at gmail.com
>> <mailto:jbthiel at gmail.com>> 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 at 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 at 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 at 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 at 20 extent: 300 at 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.
More information about the Vm-dev
mailing list