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

Juan Vuletich juan at jvuletich.org
Fri Feb 18 18:33:59 UTC 2011


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
-------------- next part --------------
'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!


More information about the Squeak-dev mailing list