Send heartbeat every 60 seconds instead of every 5 seconds.

Cache oops to release for five seconds and release them in the background. Don't create an oopType for 0. Update activity list presenter in login shell in the background.
jgfoster · Aug 18, 2020 · d81ff71 · d81ff71
1 parent b5b6205
commit d81ff71
Show file tree

Hide file tree

Showing 5 changed files with 50 additions and 23 deletions.
diff --git a/sources/GciSession.cls b/sources/GciSession.cls
@@ -1,7 +1,7 @@
 "Filed out from Dolphin Smalltalk 7"!
 
 Object subclass: #GciSession
-	instanceVariableNames: 'briefDescription clientForwarders eventCount gciSessionId gemHost gemNRS heartbeatProcess isAutoCommit isAutoMigrate isHandlingClientForwarderSend isNativeCode isPackagePolicyEnabled isShowUnimplementedMessages library netPort netTask server serverClass stoneHost stoneName stoneNRS stoneSerial stoneSessionID userID'
+	instanceVariableNames: 'briefDescription clientForwarders eventCount gciSessionId gemHost gemNRS heartbeatProcess isAutoCommit isAutoMigrate isHandlingClientForwarderSend isNativeCode isPackagePolicyEnabled isShowUnimplementedMessages library netPort netTask oopsToRelease server serverClass stoneHost stoneName stoneNRS stoneSerial stoneSessionID userID'
 	classVariableNames: ''
 	poolDictionaries: ''
 	classInstanceVariableNames: ''!
@@ -315,7 +315,7 @@ hasServer
 heartbeat: receiver arguments: arguments
 
 	| result |
-	(Delay forSeconds: 5) wait.
+	(Delay forSeconds: 60) wait.
 	self isValidSession ifFalse: [^self].
 	result := self returningResultOrErrorDo: [
 		library 
@@ -432,6 +432,7 @@ debugPath: debugPath
 		netTask := ((list at: 3) subStrings: $!!) at: 2.
 		gemHost := ((list at: 1) subStrings: $@) at: 2.
 	].
+	oopsToRelease := IdentitySet new.
 	self 
 		loadLibrary: libraryClass 
 		debugPath: debugPath.
@@ -599,7 +600,7 @@ logout
 		library logoutSession: gciSessionId.
 		library := nil.
 	].
-	self trigger: #'logout'.
+	[self trigger: #'logout'] on: Error do: [:ex | ex return].
 	gciSessionId := nil.
 !
 
@@ -708,15 +709,24 @@ prompt: promptString caption: captionString
 
 releaseOop: anOopType
 
-	self releaseOops: (Array with: anOopType).
-!
+	oopsToRelease add: anOopType.
+	self releaseOopsInBackground.!
 
 releaseOops: anArray
 
-	library ifNil: [^self].
-	anArray isEmpty ifTrue: [^self].
-	library session: gciSessionId releaseOops: anArray.
+	oopsToRelease addAll: anArray.
+	self releaseOopsInBackground.!
+
+releaseOopsInBackground
 
+	[
+		| array |
+		(Delay forSeconds: 5) wait.
+		(library notNil and: [(array := oopsToRelease asArray) notEmpty]) ifTrue: [
+			oopsToRelease removeAll.
+			library session: gciSessionId releaseOops: array.
+		].
+	] forkAt: Processor userBackgroundPriority.
 !
 
 returningResultOrErrorDo: aBlock
@@ -1168,6 +1178,7 @@ valueOfOop: anOopType
 !GciSession categoriesFor: #prompt:caption:!OmniBrowser!public! !
 !GciSession categoriesFor: #releaseOop:!Jade convenience!public! !
 !GciSession categoriesFor: #releaseOops:!Jade!library-server!public! !
+!GciSession categoriesFor: #releaseOopsInBackground!Jade!library-server!public! !
 !GciSession categoriesFor: #returningResultOrErrorDo:!long running!private! !
 !GciSession categoriesFor: #send:to:!Jade convenience!public! !
 !GciSession categoriesFor: #send:to:withAll:!Jade convenience!long running!public! !

diff --git a/sources/GemStone Session.pax b/sources/GemStone Session.pax
@@ -81,7 +81,7 @@ package!
 "Class Definitions"!
 
 Object subclass: #GciSession
-	instanceVariableNames: 'briefDescription clientForwarders eventCount gciSessionId gemHost gemNRS heartbeatProcess isAutoCommit isAutoMigrate isHandlingClientForwarderSend isNativeCode isPackagePolicyEnabled isShowUnimplementedMessages library netPort netTask server serverClass stoneHost stoneName stoneNRS stoneSerial stoneSessionID userID'
+	instanceVariableNames: 'briefDescription clientForwarders eventCount gciSessionId gemHost gemNRS heartbeatProcess isAutoCommit isAutoMigrate isHandlingClientForwarderSend isNativeCode isPackagePolicyEnabled isShowUnimplementedMessages library netPort netTask oopsToRelease server serverClass stoneHost stoneName stoneNRS stoneSerial stoneSessionID userID'
 	classVariableNames: ''
 	poolDictionaries: ''
 	classInstanceVariableNames: ''!

diff --git a/sources/GsMethod.cls b/sources/GsMethod.cls
@@ -47,10 +47,13 @@ hash
 
 initialize: readStream session: aGciSession
 
+	| oop |
 	gciSession := aGciSession.
 	behavior := gciSession oopTypeWithOop: readStream upToTab asNumber.
 	behaviorName := readStream upToTab.
-	oopType := gciSession oopTypeWithOop: readStream upToTab asNumber.
+	(oop := readStream upToTab asNumber) ~~ 0 ifTrue: [
+		oopType := gciSession oopTypeWithOop: oop.
+	].
 	name := readStream upToTab.
 	category := readStream upToTab.
 	isReadOnly := readStream upToTab = 'false'.	"current user has write permission for the class"

diff --git a/sources/Jade Login.pax b/sources/Jade Login.pax
@@ -52,7 +52,7 @@ Model subclass: #JadeLogin
 	poolDictionaries: ''
 	classInstanceVariableNames: ''!
 Shell subclass: #JadeLoginShell
-	instanceVariableNames: 'activeLibraryPresenter activityListPresenter debugPathPresenter gemHostPresenter gemServicePresenter gemTaskPresenter gemTypePresenter hostPasswordPresenter hostUserIDPresenter initialsPresenter inUpdateView loginListPresenter loginTypePresenter passwordPresenter resetButtonPresenter stoneHostPresenter stoneNamePresenter userIDPresenter versionListPresenter'
+	instanceVariableNames: 'activeLibraryPresenter activityListMutex activityListPresenter debugPathPresenter gemHostPresenter gemServicePresenter gemTaskPresenter gemTypePresenter hostPasswordPresenter hostUserIDPresenter initialsPresenter inUpdateView loginListPresenter loginTypePresenter passwordPresenter recentActivity resetButtonPresenter stoneHostPresenter stoneNamePresenter userIDPresenter versionListPresenter'
 	classVariableNames: ''
 	poolDictionaries: ''
 	classInstanceVariableNames: ''!

diff --git a/sources/JadeLoginShell.cls b/sources/JadeLoginShell.cls
@@ -1,7 +1,7 @@
 "Filed out from Dolphin Smalltalk 7"!
 
 Shell subclass: #JadeLoginShell
-	instanceVariableNames: 'activeLibraryPresenter activityListPresenter debugPathPresenter gemHostPresenter gemServicePresenter gemTaskPresenter gemTypePresenter hostPasswordPresenter hostUserIDPresenter initialsPresenter inUpdateView loginListPresenter loginTypePresenter passwordPresenter resetButtonPresenter stoneHostPresenter stoneNamePresenter userIDPresenter versionListPresenter'
+	instanceVariableNames: 'activeLibraryPresenter activityListMutex activityListPresenter debugPathPresenter gemHostPresenter gemServicePresenter gemTaskPresenter gemTypePresenter hostPasswordPresenter hostUserIDPresenter initialsPresenter inUpdateView loginListPresenter loginTypePresenter passwordPresenter recentActivity resetButtonPresenter stoneHostPresenter stoneNamePresenter userIDPresenter versionListPresenter'
 	classVariableNames: ''
 	poolDictionaries: ''
 	classInstanceVariableNames: ''!
@@ -274,7 +274,7 @@ initialize
 
 	super initialize.
 	inUpdateView := false.
-!
+	activityListMutex := Mutex new.!
 
 isVersion: a lessThanOrEqualTo: b
 
@@ -576,17 +576,30 @@ tempDataPath
 !
 
 updateActivity
+	"If we update in real time it seems to slow down other processing (like changing tabs in the System Browser.
+	The mutex is to ensure that only one process manipulates the UI at a time (otherwise we can hang)."
 
-	| list |
-	activeLibraryPresenter value: GciLibrary activeLibrary class name asString.
-	list := GciActivity activity.
-	[list size > 99] whileTrue: [list removeFirst].
-	list := list copy.
-	activityListPresenter  list: list.
-	list notEmpty ifTrue: [
-		activityListPresenter selection: list last.
-	].
-!
+	[
+		[
+			(Delay forMilliseconds: 100) wait.
+			activityListMutex critical: [
+				| list |
+				list := GciActivity activity.
+				((list isEmpty and: [recentActivity notNil]) or: [recentActivity ~~ list last]) ifTrue: [
+					activeLibraryPresenter value: GciLibrary activeLibrary class name asString.
+					[list size > 99] whileTrue: [list removeFirst].
+					list := list copy.
+					activityListPresenter list: list.
+					list isEmpty ifTrue: [
+						recentActivity := nil.
+					] ifFalse: [
+						recentActivity := list last.
+						activityListPresenter selection: recentActivity.
+					].
+				].
+			].
+		] on: Error do: [:ex | ex halt return].
+	] forkAt: Processor userBackgroundPriority.!
 
 updateModel