Re: [Pharo-project] Cog VM -- Thanks and Performance / Optimization Questions
Locked
Re: [Pharo-project] Cog VM -- Thanks and Performance / Optimization Questions
 
|
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 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.
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 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.
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.
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 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'm trying to make Ruby natural, not simple. -- Yukihiro "Matz" Matsumoto Home Talks & 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 & 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' 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 < Prev Next > 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 & Personal pages Smalltalkers - Social Network Environments Commercial Smalltalk Environments Free Smalltalk Environments Abbandon Smalltalk Environments Frameworks, Platforms & 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 & Presentations Smalltalk Documentaries Login If you don'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,"eish o tshwara shawara",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.
|
Re: [squeak-dev] Re: [Pharo-project] Cog VM -- Thanks and Performance / Optimization Questions
|
|
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. 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! |
Re: [squeak-dev] Re: [Pharo-project] Cog VM -- Thanks and Performance / Optimization Questions
|
|
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. |
Re: [squeak-dev] Re: [Pharo-project] Cog VM -- Thanks and Performance / Optimization Questions
|
|
On Fri, Feb 18, 2011 at 1:41 PM, Igor Stasenko <[hidden email]> wrote:
+1
|
New Transcript (was: [squeak-dev] Re: [Pharo-project] Cog VM -- Thanks and Performance / Optimization Questions)
|
|
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! |
Re: [squeak-dev] Re: [Pharo-project] Cog VM -- Thanks and Performance / Optimization Questions
|
|
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 |
Re: [squeak-dev] Re: [Pharo-project] Cog VM -- Thanks and Performance / Optimization Questions
|
|
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. |
«
Return to Squeak VM
|
1 view|%1 views
| Free forum by Nabble | Edit this page |