From d81ff7122d0968e02bfc7351353bb0a64bbcb414 Mon Sep 17 00:00:00 2001 From: James Foster Date: Tue, 18 Aug 2020 03:07:09 -0700 Subject: [PATCH] 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. --- sources/GciSession.cls | 27 ++++++++++++++++++-------- sources/GemStone Session.pax | 2 +- sources/GsMethod.cls | 5 ++++- sources/Jade Login.pax | 2 +- sources/JadeLoginShell.cls | 37 ++++++++++++++++++++++++------------ 5 files changed, 50 insertions(+), 23 deletions(-) diff --git a/sources/GciSession.cls b/sources/GciSession.cls index f833f8b2..cba737f2 100644 --- 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 index 0643f726..5dde25b7 100644 --- 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 index f978907c..0bf601ab 100644 --- 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 index 4c0fbcf2..6c8824bc 100644 --- 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 index 21f8662c..c1c187c5 100644 --- 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