[Vm-dev] Re: [squeak-dev] Re: [Pharo-project] Cog VM -- Thanks
and Performance / Optimization Questions
stephane ducasse
stephane.ducasse at gmail.com
Sat Feb 19 21:58:40 UTC 2011
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 <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