From 160d4066367ec595e20554b72029ea6fe48fd8ea Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andrei=20Chi=C8=99?= Date: Tue, 6 Aug 2024 14:51:09 +0200 Subject: [PATCH] Add a way to start an async computation [feenkcom/gtoolkit#3942] --- .../GtGemStoneEvaluationContext.class.st | 130 ++++++++++-------- .../GtRsrEvaluatorServiceServer.class.st | 38 +++-- ...roxyOnlySerializationStrategy.extension.st | 6 + src/GToolkit-GemStone/GtGsRelease.class.st | 19 +-- ...RsrProxyOnlySerializationStrategy.class.st | 13 +- 5 files changed, 126 insertions(+), 80 deletions(-) create mode 100644 src/GToolkit-GemStone-GemStone/GtRsrProxyOnlySerializationStrategy.extension.st diff --git a/src/GToolkit-GemStone-GemStone/GtGemStoneEvaluationContext.class.st b/src/GToolkit-GemStone-GemStone/GtGemStoneEvaluationContext.class.st index 93fa8918..6bef7de1 100644 --- a/src/GToolkit-GemStone-GemStone/GtGemStoneEvaluationContext.class.st +++ b/src/GToolkit-GemStone-GemStone/GtGemStoneEvaluationContext.class.st @@ -1,10 +1,11 @@ Class { - #name : #GtGemStoneEvaluationContext, - #superclass : #Object, + #name : 'GtGemStoneEvaluationContext', + #superclass : 'Object', #instVars : [ 'exception', 'process', 'semaphore', + 'serializationStrategy', 'result', 'completed', 'devMessage', @@ -15,31 +16,31 @@ Class { #category : 'GToolkit-GemStone-GemStone' } -{ #category : #private } +{ #category : 'private' } GtGemStoneEvaluationContext >> assertNotSignalled [ semaphore isLocked ifFalse: [ self error: 'Process semaphore already signalled' ] ] -{ #category : #accessing } +{ #category : 'accessing' } GtGemStoneEvaluationContext >> buildMessageText [ ^ exception buildMessageText ] -{ #category : #private } +{ #category : 'private' } GtGemStoneEvaluationContext >> callStack [ ^ callStack ifNil: [ callStack := self createNewCallStack ] ] -{ #category : #private } +{ #category : 'private' } GtGemStoneEvaluationContext >> createNewCallStack [ ^ GtGemStoneLocalCallStack forProcess: process ] -{ #category : #'actions - debug' } +{ #category : 'actions - debug' } GtGemStoneEvaluationContext >> debuggerState [ callStack := self createNewCallStack. @@ -49,33 +50,33 @@ GtGemStoneEvaluationContext >> debuggerState [ callStack: callStack ] -{ #category : #'actions - debug' } +{ #category : 'actions - debug' } GtGemStoneEvaluationContext >> debuggerStateJsonForExport [ ^ self debuggerState asJsonForExport ] -{ #category : #accessing } +{ #category : 'accessing' } GtGemStoneEvaluationContext >> devMessage [ ^devMessage ] -{ #category : #accessing } +{ #category : 'accessing' } GtGemStoneEvaluationContext >> devMessage: object [ devMessage := object ] -{ #category : #accessing } +{ #category : 'accessing' } GtGemStoneEvaluationContext >> evalServer [ ^evalServer ] -{ #category : #accessing } +{ #category : 'accessing' } GtGemStoneEvaluationContext >> evalServer: object [ evalServer := object ] -{ #category : #'actions - api' } +{ #category : 'actions - api' } GtGemStoneEvaluationContext >> evaluateAndWaitBlock: aBlock from: anEvaluationServer [ "Evaluate the supplied block. If it completes successfully, answer the result. @@ -85,7 +86,7 @@ GtGemStoneEvaluationContext >> evaluateAndWaitBlock: aBlock from: anEvaluationSe ^ self wait. ] -{ #category : #'actions - api' } +{ #category : 'actions - api' } GtGemStoneEvaluationContext >> evaluateBlock: aBlock from: anEvaluationServer [ "Start evaluation of the supplied block. If it completes successfully, result is the return value of aBlock. @@ -97,7 +98,12 @@ GtGemStoneEvaluationContext >> evaluateBlock: aBlock from: anEvaluationServer [ evalServer := anEvaluationServer. process := [ - [ result := block value. + [ | computationResult | + computationResult := block value. + result := self serializationStrategy + ifNil: [ computationResult ] + ifNotNil: [ :aSerializationStrategy | + (Globals at: aSerializationStrategy) new serialize: computationResult ]. completed := true. semaphore signal ] on: Exception @@ -114,49 +120,49 @@ GtGemStoneEvaluationContext >> evaluateBlock: aBlock from: anEvaluationServer [ ^ self ] -{ #category : #accessing } +{ #category : 'accessing' } GtGemStoneEvaluationContext >> exception [ ^ exception ] -{ #category : #accessing } +{ #category : 'accessing' } GtGemStoneEvaluationContext >> exception: anException [ exception := anException ] -{ #category : #accessing } +{ #category : 'accessing' } GtGemStoneEvaluationContext >> frameContentsAtLevel: anInteger [ ^ process _frameContentsAt: anInteger ] -{ #category : #private } +{ #category : 'private' } GtGemStoneEvaluationContext >> frameForIdentifier: aFrameIdentifier [ callStack ifNil: [ Error signal: 'Call stack not initialized!' ]. ^ callStack frameForIdentifier: aFrameIdentifier ] -{ #category : #private } +{ #category : 'private' } GtGemStoneEvaluationContext >> frameForIdentifierIndex: aFrameIdentifierIndex [ ^ self frameForIdentifier: (GtGemStoneCallFrameIdentifier forIndex: aFrameIdentifierIndex) ] -{ #category : #private } +{ #category : 'private' } GtGemStoneEvaluationContext >> frameLevelForIdentifier: aFrameIdentifier [ callStack ifNil: [ Error signal: 'Call stack not initialized!' ]. ^ callStack frameLevelForIdentifier: aFrameIdentifier ] -{ #category : #private } +{ #category : 'private' } GtGemStoneEvaluationContext >> frameLevelForIdentifierIndex: aFrameIdentifierIndex [ ^ self frameLevelForIdentifier: (GtGemStoneCallFrameIdentifier forIndex: aFrameIdentifierIndex) ] -{ #category : #private } +{ #category : 'private' } GtGemStoneEvaluationContext >> handlerBlock: anObject [ "Answer the block that will be evaluated if an exception occurs. In this case, suspend the evaluation process and answer the receiver. @@ -171,38 +177,38 @@ GtGemStoneEvaluationContext >> handlerBlock: anObject [ ex resume ] ] -{ #category : #testing } +{ #category : 'testing' } GtGemStoneEvaluationContext >> isCompleted [ "Answer a boolean indicating whether the receiver's process has completed and successfully answered a result" ^ completed ] -{ #category : #testing } +{ #category : 'testing' } GtGemStoneEvaluationContext >> isResumable [ ^ exception isResumable ] -{ #category : #testing } +{ #category : 'testing' } GtGemStoneEvaluationContext >> isSuspended [ ^ process _isSuspended ] -{ #category : #testing } +{ #category : 'testing' } GtGemStoneEvaluationContext >> isTerminated [ ^ process _isTerminated ] -{ #category : #'actions - debug (level)' } +{ #category : 'actions - debug (level)' } GtGemStoneEvaluationContext >> methodAtFrameLevel: anInteger [ ^ (process _frameContentsAt: anInteger) first ] -{ #category : #'actions - debug' } +{ #category : 'actions - debug' } GtGemStoneEvaluationContext >> newDebuggerState [ callStack := self createNewCallStack. @@ -212,42 +218,42 @@ GtGemStoneEvaluationContext >> newDebuggerState [ callStack: callStack ] -{ #category : #'actions - debug' } +{ #category : 'actions - debug' } GtGemStoneEvaluationContext >> newDebuggerStateJsonForExport [ ^ self newDebuggerState asJsonForExport ] -{ #category : #accessing } +{ #category : 'accessing' } GtGemStoneEvaluationContext >> process [ ^ process ] -{ #category : #accessing } +{ #category : 'accessing' } GtGemStoneEvaluationContext >> process: aGsProcess [ process := aGsProcess ] -{ #category : #'actions - debug (identifier)' } +{ #category : 'actions - debug (identifier)' } GtGemStoneEvaluationContext >> programCounterMarkersAtFrameIdentifierIndex: aFrameIdentifierIndex [ ^ (self frameForIdentifierIndex: aFrameIdentifierIndex) programCounterMarkers ] -{ #category : #'actions - debug (identifier)' } +{ #category : 'actions - debug (identifier)' } GtGemStoneEvaluationContext >> restartFrameIdentifierIndex: aFrameIdentifierIndex [ ^ self restartFrameLevel: (self frameLevelForIdentifierIndex: aFrameIdentifierIndex) ] -{ #category : #'actions - debug (level)' } +{ #category : 'actions - debug (level)' } GtGemStoneEvaluationContext >> restartFrameLevel: anInteger [ process _trimStackToLevel: anInteger. ^ #restart ] -{ #category : #'actions - debug' } +{ #category : 'actions - debug' } GtGemStoneEvaluationContext >> resume [ self assertNotSignalled. @@ -256,18 +262,28 @@ GtGemStoneEvaluationContext >> resume [ ^ result ] -{ #category : #'actions - debug (level)' } +{ #category : 'accessing' } +GtGemStoneEvaluationContext >> serializationStrategy [ + ^serializationStrategy +] + +{ #category : 'accessing' } +GtGemStoneEvaluationContext >> serializationStrategy: object [ + serializationStrategy := object +] + +{ #category : 'actions - debug (level)' } GtGemStoneEvaluationContext >> sourceCodeAtFrameLevel: anInteger [ ^ (self stackFrames at: anInteger) first sourceString ] -{ #category : #'actions - debug (identifier)' } +{ #category : 'actions - debug (identifier)' } GtGemStoneEvaluationContext >> sourceInfoAtFrameIdentifierIndex: aFrameIdentifierIndex [ ^ self sourceInfoAtFrameLevel: (self frameLevelForIdentifierIndex: aFrameIdentifierIndex) ] -{ #category : #'actions - debug (level)' } +{ #category : 'actions - debug (level)' } GtGemStoneEvaluationContext >> sourceInfoAtFrameLevel: anInteger [ | frameContents source ipOffset markers startIndex endIndex i | @@ -288,24 +304,24 @@ GtGemStoneEvaluationContext >> sourceInfoAtFrameLevel: anInteger [ ^ { startIndex. endIndex. source. } ] -{ #category : #accessing } +{ #category : 'accessing' } GtGemStoneEvaluationContext >> stackFrames [ ^ process gtAllFrames ] -{ #category : #'actions - debug' } +{ #category : 'actions - debug' } GtGemStoneEvaluationContext >> stdout [ ^ System gemLogFileName asFileReference contents ] -{ #category : #'actions - debug (identifier)' } +{ #category : 'actions - debug (identifier)' } GtGemStoneEvaluationContext >> stepIntoFrameIdentifierIndex: aFrameIdentifierIndex [ ^ self stepIntoFrameLevel: (self frameLevelForIdentifierIndex: aFrameIdentifierIndex) ] -{ #category : #'actions - debug (level)' } +{ #category : 'actions - debug (level)' } GtGemStoneEvaluationContext >> stepIntoFrameLevel: anInteger [ process setStepIntoBreaksAtLevel: anInteger. @@ -313,12 +329,12 @@ GtGemStoneEvaluationContext >> stepIntoFrameLevel: anInteger [ ^ #stepInto ] -{ #category : #'actions - debug (identifier)' } +{ #category : 'actions - debug (identifier)' } GtGemStoneEvaluationContext >> stepOverFrameIdentifierIndex: aFrameIdentifierIndex [ ^ self stepOverFrameLevel: (self frameLevelForIdentifierIndex: aFrameIdentifierIndex) ] -{ #category : #'actions - debug (level)' } +{ #category : 'actions - debug (level)' } GtGemStoneEvaluationContext >> stepOverFrameLevel: anInteger [ process setStepOverBreaksAtLevel: anInteger. @@ -326,12 +342,12 @@ GtGemStoneEvaluationContext >> stepOverFrameLevel: anInteger [ ^ #stepOver ] -{ #category : #'actions - debug (identifier)' } +{ #category : 'actions - debug (identifier)' } GtGemStoneEvaluationContext >> stepThroughFrameIdentifierIndex: aFrameIdentifierIndex [ ^ self stepThroughFrameLevel: (self frameLevelForIdentifierIndex: aFrameIdentifierIndex) ] -{ #category : #'actions - debug (level)' } +{ #category : 'actions - debug (level)' } GtGemStoneEvaluationContext >> stepThroughFrameLevel: anInteger [ process setStepThroughBreaksAtLevel: anInteger. @@ -339,7 +355,7 @@ GtGemStoneEvaluationContext >> stepThroughFrameLevel: anInteger [ ^ #stepThrough ] -{ #category : #'actions - debug' } +{ #category : 'actions - debug' } GtGemStoneEvaluationContext >> synchronizeCallStack [ | currentCallStack stackUpdater | currentCallStack := self callStack. @@ -353,13 +369,13 @@ GtGemStoneEvaluationContext >> synchronizeCallStack [ callStack: currentCallStack) asJsonForExport ] -{ #category : #'actions - debug' } +{ #category : 'actions - debug' } GtGemStoneEvaluationContext >> terminateProcess [ process terminate ] -{ #category : #'actions - debug (level)' } +{ #category : 'actions - debug (level)' } GtGemStoneEvaluationContext >> variable: aSymbol atFrameLevel: anInteger [ "Answer the variables from the specified frame. @@ -372,7 +388,7 @@ GtGemStoneEvaluationContext >> variable: aSymbol atFrameLevel: anInteger [ ^ frameContents at: index + 10. ] -{ #category : #'actions - debug (level)' } +{ #category : 'actions - debug (level)' } GtGemStoneEvaluationContext >> variableArrayAtFrameLevel: anInteger [ "Answer an Array of Associations of the items to be displayed in the Variable pane of the specified frame." | frameContents associations varNames selfObject | @@ -398,24 +414,24 @@ GtGemStoneEvaluationContext >> variableArrayAtFrameLevel: anInteger [ ^ associations asArray. ] -{ #category : #'actions - debug (identifier)' } +{ #category : 'actions - debug (identifier)' } GtGemStoneEvaluationContext >> variableIndex: index atFrameIdentifierIndex: aFrameIdentifierIndex [ ^ self variableIndex: index atFrameLevel: (self frameLevelForIdentifierIndex: aFrameIdentifierIndex) ] -{ #category : #'actions - debug (level)' } +{ #category : 'actions - debug (level)' } GtGemStoneEvaluationContext >> variableIndex: index atFrameLevel: anInteger [ "Answer the variable from the specified frame" ^ ((self variableArrayAtFrameLevel: anInteger) at: index) second ] -{ #category : #'actions - debug (identifier)' } +{ #category : 'actions - debug (identifier)' } GtGemStoneEvaluationContext >> variableInfoAtFrameIdentifierIndex: aFrameIdentifierIndex [ ^ self variableInfoAtFrameLevel: (self frameLevelForIdentifierIndex: aFrameIdentifierIndex) ] -{ #category : #'actions - debug (level)' } +{ #category : 'actions - debug (level)' } GtGemStoneEvaluationContext >> variableInfoAtFrameLevel: anInteger [ "Answer the variables from the specified frame, including self's instance variables" @@ -425,14 +441,14 @@ GtGemStoneEvaluationContext >> variableInfoAtFrameLevel: anInteger [ displayData ] ] -{ #category : #'actions - api' } +{ #category : 'actions - api' } GtGemStoneEvaluationContext >> wait [ semaphore wait. ^ result ] -{ #category : #private } +{ #category : 'private' } GtGemStoneEvaluationContext >> waitMS: milliseconds [ (Delay forMilliseconds: milliseconds) wait ] diff --git a/src/GToolkit-GemStone-GemStone/GtRsrEvaluatorServiceServer.class.st b/src/GToolkit-GemStone-GemStone/GtRsrEvaluatorServiceServer.class.st index cc911b3f..540e0dc5 100644 --- a/src/GToolkit-GemStone-GemStone/GtRsrEvaluatorServiceServer.class.st +++ b/src/GToolkit-GemStone-GemStone/GtRsrEvaluatorServiceServer.class.st @@ -1,10 +1,10 @@ Class { - #name : #GtRsrEvaluatorServiceServer, - #superclass : #GtRsrEvaluatorService, + #name : 'GtRsrEvaluatorServiceServer', + #superclass : 'GtRsrEvaluatorService', #category : 'GToolkit-GemStone-GemStone' } -{ #category : #actions } +{ #category : 'actions' } GtRsrEvaluatorServiceServer >> evaluate: aString for: anObject bindings: aDictionary [ "Evaluate the receiver's script, answering the result. On the server this is a synchronous operation." @@ -13,17 +13,15 @@ GtRsrEvaluatorServiceServer >> evaluate: aString for: anObject bindings: aDictio asGtRsrProxyObjectForConnection: _connection ] -{ #category : #actions } +{ #category : 'actions' } GtRsrEvaluatorServiceServer >> evaluate: aString for: anObject bindings: aDictionary serializationStrategy: aSymbol [ "Evaluate the receiver's script, answering the result as a proxy. On the server this is a synchronous operation." - | result | - - result := self gsEvaluate: aString for: anObject bindings: aDictionary. - ^ (Globals at: aSymbol) new serialize: result. + + ^ self gsEvaluate: aString for: anObject bindings: aDictionary serializationStrategy: aSymbol. ] -{ #category : #actions } +{ #category : 'actions' } GtRsrEvaluatorServiceServer >> evaluateReturnProxy: aString for: anObject bindings: aDictionary [ "Evaluate the receiver's script, answering the result as a proxy. On the server this is a synchronous operation." @@ -34,8 +32,13 @@ GtRsrEvaluatorServiceServer >> evaluateReturnProxy: aString for: anObject bindin ^ GtRsrProxyServiceServer object: result. ] -{ #category : #'private - GemStone' } +{ #category : 'private - GemStone' } GtRsrEvaluatorServiceServer >> gsEvaluate: aString for: anObject bindings: aDictionary [ + ^ self evaluate: aString for: anObject bindings: aDictionary serializationStrategy: nil +] + +{ #category : 'private - GemStone' } +GtRsrEvaluatorServiceServer >> gsEvaluate: aString for: anObject bindings: aDictionary serializationStrategy: aSymbol [ "Evaluate the receiver's script, answering the result" | receiver symbolDictionary bindings | @@ -46,6 +49,7 @@ GtRsrEvaluatorServiceServer >> gsEvaluate: aString for: anObject bindings: aDict bindings := GsCurrentSession currentSession symbolList, (Array with: symbolDictionary). ^ GtGemStoneEvaluationContext new + serializationStrategy: aSymbol; evaluateAndWaitBlock: [ | method | method := aString _compileInContext: receiver symbolList: bindings. @@ -53,8 +57,8 @@ GtRsrEvaluatorServiceServer >> gsEvaluate: aString for: anObject bindings: aDict from: self. ] -{ #category : #'private - GemStone' } -GtRsrEvaluatorServiceServer >> gsStartEvaluate: aString for: anObject bindings: aDictionary [ +{ #category : 'private - GemStone' } +GtRsrEvaluatorServiceServer >> gsStartEvaluate: aString for: anObject bindings: aDictionary serializationStrategy: aSymbol [ "Evaluate the receiver's script, answering the result" | receiver symbolDictionary bindings | @@ -65,9 +69,19 @@ GtRsrEvaluatorServiceServer >> gsStartEvaluate: aString for: anObject bindings: bindings := GsCurrentSession currentSession symbolList, (Array with: symbolDictionary). ^ GtGemStoneEvaluationContext new + serializationStrategy: aSymbol; evaluateBlock: [ | method | method := aString _compileInContext: receiver symbolList: bindings. method _executeInContext: receiver ] from: self. ] + +{ #category : 'actions' } +GtRsrEvaluatorServiceServer >> startEvaluate: aString for: anObject bindings: aDictionary serializationStrategy: aSymbol [ + "Start the receiver's script, answering the evaluation context as a proxy." + | evaluationContext | + + evaluationContext := self gsStartEvaluate: aString for: anObject bindings: aDictionary serializationStrategy: aSymbol. + ^ GtRsrProxyServiceServer object: evaluationContext +] diff --git a/src/GToolkit-GemStone-GemStone/GtRsrProxyOnlySerializationStrategy.extension.st b/src/GToolkit-GemStone-GemStone/GtRsrProxyOnlySerializationStrategy.extension.st new file mode 100644 index 00000000..610be7af --- /dev/null +++ b/src/GToolkit-GemStone-GemStone/GtRsrProxyOnlySerializationStrategy.extension.st @@ -0,0 +1,6 @@ +Extension { #name : 'GtRsrProxyOnlySerializationStrategy' } + +{ #category : '*GToolkit-GemStone-GemStone' } +GtRsrProxyOnlySerializationStrategy >> serialize: anObject [ + ^ GtRsrProxyServiceServer object: anObject +] diff --git a/src/GToolkit-GemStone/GtGsRelease.class.st b/src/GToolkit-GemStone/GtGsRelease.class.st index 768e82fe..6bbcd4c6 100644 --- a/src/GToolkit-GemStone/GtGsRelease.class.st +++ b/src/GToolkit-GemStone/GtGsRelease.class.st @@ -1,6 +1,6 @@ Class { - #name : #GtGsRelease, - #superclass : #Object, + #name : 'GtGsRelease', + #superclass : 'Object', #instVars : [ 'versionString' ], @@ -10,29 +10,32 @@ Class { #category : 'GToolkit-GemStone' } -{ #category : #accessing } +{ #category : 'accessing' } GtGsRelease class >> default [ ^ default ifNil: [ default := self new ] ] -{ #category : #accessing } +{ #category : 'accessing' } GtGsRelease class >> versionString [ - ^ self default versionString + ^ default + ifNil: [ '' ] + ifNotNil: [ + self default versionString ] ] -{ #category : #accessing } +{ #category : 'accessing' } GtGsRelease class >> versionString: aString [ self default versionString: aString ] -{ #category : #accessing } +{ #category : 'accessing' } GtGsRelease >> versionString [ ^ versionString ] -{ #category : #accessing } +{ #category : 'accessing' } GtGsRelease >> versionString: aString [ versionString := aString diff --git a/src/GToolkit-GemStone/GtRsrProxyOnlySerializationStrategy.class.st b/src/GToolkit-GemStone/GtRsrProxyOnlySerializationStrategy.class.st index fea031bb..7f753cca 100644 --- a/src/GToolkit-GemStone/GtRsrProxyOnlySerializationStrategy.class.st +++ b/src/GToolkit-GemStone/GtRsrProxyOnlySerializationStrategy.class.st @@ -1,5 +1,12 @@ Class { - #name : #GtRsrProxyOnlySerializationStrategy, - #superclass : #GtRsrSerializationStrategy, - #category : #'GToolkit-GemStone' + #name : 'GtRsrProxyOnlySerializationStrategy', + #superclass : 'GtRsrSerializationStrategy', + #category : 'GToolkit-GemStone' } + +{ #category : 'converting' } +GtRsrProxyOnlySerializationStrategy >> deserialize: anObject [ + "Deserialize the supplied object" + + ^ anObject +]