From 6cf6f969a403e37d02796b5927d196311ed3ca7f Mon Sep 17 00:00:00 2001 From: Norm Green Date: Thu, 19 Dec 2024 16:01:11 -0800 Subject: [PATCH 1/8] Start issue 17 --- src/GemStoneFFI/GciInterface.class.st | 30 +++++++++++ .../GciThreadSafeInterface.class.st | 54 +++++++++++++++++++ src/GemStoneFFI/GsSession.class.st | 20 +++++++ 3 files changed, 104 insertions(+) diff --git a/src/GemStoneFFI/GciInterface.class.st b/src/GemStoneFFI/GciInterface.class.st index f72bb6b..3d7d328 100644 --- a/src/GemStoneFFI/GciInterface.class.st +++ b/src/GemStoneFFI/GciInterface.class.st @@ -17,6 +17,36 @@ Class { #category : 'GemStoneFFI' } +{ #category : 'constants' } +GciInterface class >> GCI_PERFORM_DETACH [ + ^ 16r40 +] + +{ #category : 'constants' } +GciInterface class >> GCI_PERFORM_FLAG_DISABLE_ASYNC_EVENTS [ + ^ 2 +] + +{ #category : 'constants' } +GciInterface class >> GCI_PERFORM_FLAG_ENABLE_DEBUG [ + ^ 1 +] + +{ #category : 'constants' } +GciInterface class >> GCI_PERFORM_FLAG_INTERPRETED [ + ^ 16r20 +] + +{ #category : 'constants' } +GciInterface class >> GCI_PERFORM_FLAG_SINGLE_STEP [ + ^ 4 +] + +{ #category : 'constants' } +GciInterface class >> GCI_PERFORM_noClientUseraction [ + ^ 16r10 +] + { #category : 'constants' } GciInterface class >> OOP_CLASS_BYTE_ARRAY [ ^ 103425 diff --git a/src/GemStoneFFI/GciThreadSafeInterface.class.st b/src/GemStoneFFI/GciThreadSafeInterface.class.st index 9aa284e..4f34a6f 100644 --- a/src/GemStoneFFI/GciThreadSafeInterface.class.st +++ b/src/GemStoneFFI/GciThreadSafeInterface.class.st @@ -95,6 +95,34 @@ GciThreadSafeInterface >> checkSpaceForBufferSize: bufSize resultSize: resultSiz ' bytes)')] ensure:[ tracker freeAll ]. ] +{ #category : 'remote execution (nonblocking)' } +GciThreadSafeInterface >> executeStringAndDetachNb: sourceString [ + +"Starts remote execution of the string sourceString and tells the gem to stop servicing +the client and ignore disconnects. +Returns true if the execution was started and raises and exception on error. +Requires GemStone v3.7.1 or later." + +|tracker srcCstring result gsError| + +self assertLoggedIn . +tracker := GsMemoryTracker new. +srcCstring := self convertStringToExternalArgOrNull: sourceString memoryTracker: tracker. +gsError := tracker add: GciErrSType externalNew . + +result := self gciTsNbExecute: session + sourceString: srcCstring getHandle + sourceOop: self class OOP_CLASS_STRING + contextObject: self class oopNil + symbolList: self class oopNil + flags: self class GCI_PERFORM_DETACH + envId: 0 + gsError: gsError. +result ~~ 1 ifTrue:[ ^ GciError newForError: gsError tracker: tracker ]. +tracker freeAll. +^ true +] + { #category : 'remote execution' } GciThreadSafeInterface >> executeStringAndFetchResultByteArray: sourceString maxResultSize: maxSize [ @@ -296,6 +324,14 @@ GciThreadSafeInterface >> gciTsNbExecute: sess sourceString: sourceString source GciErrSType *gsError)) library: self gsLibraryPath ] +{ #category : 'ffi calls' } +GciThreadSafeInterface >> gciTsNbLogout: sess gsError: gsError [ +"Low level FFI call to logout using the Gci thread-safe library. +Does not wait for a response from the gem." + +^ self ffiCall: #( BoolType GciTsNbLogout(void *sess, GciErrSType *gsError) ) library: self gsLibraryPath +] + { #category : 'ffi calls' } GciThreadSafeInterface >> gciTsNbPoll: sess timeoutMs: timeoutMs gsError: gsError [ @@ -413,6 +449,24 @@ GciThreadSafeInterface >> logout [ ] +{ #category : 'Login' } +GciThreadSafeInterface >> logoutNbNoError [ + +"Logout the session and do not wait for a response from the gem." +| tracker gsError | +self isLoggedIn ifFalse:[ + ^ true +]. + +tracker := GsMemoryTracker new. +gsError := tracker add: GciErrSType externalNew . +self gciTsNbLogout: session gsError: gsError . +session := nil. +tracker freeAll. +^true + +] + { #category : 'Login' } GciThreadSafeInterface >> logoutNoError [ "Same as logout except that errors are ignored. Returns true." diff --git a/src/GemStoneFFI/GsSession.class.st b/src/GemStoneFFI/GsSession.class.st index 1c59384..afa0106 100644 --- a/src/GemStoneFFI/GsSession.class.st +++ b/src/GemStoneFFI/GsSession.class.st @@ -124,6 +124,26 @@ sess logout. ] +{ #category : 'examples' } +GsSession class >> example6 [ +"Log in to GemStone and fork a string to execute in the gem and detach the client from the gem. +The gem will print a timestamp to the gem log each second for 30 seconds then logout. +Requires 3.7.1 or later. + + +GsSession example6 +" + +|sess result str | +sess := GsSession newForGsVersion: '3.7.2' threadSafe: true stone: 'norm' host: 'moop' netldi: '10117'. +sess loginWithGsUser: 'DataCurator' password: 'swordfish'. +str := '30 timesRepeat:[ GsFile gciLogServer: DateTime now asString. System sleep: 1]. System logout'. +result := sess executeStringAndDetachNb: str. +sess logoutNbNoError. "Will not block" +^result + +] + { #category : 'class initialization' } GsSession class >> initialize [ From b45590420284a371cf5e07c29cd57ab9249dce23 Mon Sep 17 00:00:00 2001 From: "Norm.Green" Date: Sat, 21 Dec 2024 15:00:45 -0800 Subject: [PATCH 2/8] work on issue 17 --- .../GciInterfaceTest.class.st | 3 +- .../GemStoneFFITestCase.class.st | 9 +- .../GsExternalByteStringTest.class.st | 3 +- src/GemStoneFFI-Tests/GsSessionTest.class.st | 54 ++++- src/GemStoneFFI/GciErrSType.class.st | 3 +- src/GemStoneFFI/GciError.class.st | 5 +- src/GemStoneFFI/GciInterface.class.st | 3 +- src/GemStoneFFI/GciLegacyInterface.class.st | 3 +- .../GciThreadSafeInterface.class.st | 69 ++++++- src/GemStoneFFI/GciTsObjInfo.class.st | 3 +- src/GemStoneFFI/GciTypes.class.st | 3 +- src/GemStoneFFI/GsExternalByteString.class.st | 3 +- src/GemStoneFFI/GsMemoryTracker.class.st | 3 +- src/GemStoneFFI/GsNetworkResource.class.st | 3 +- src/GemStoneFFI/GsSession.class.st | 187 +++++++++++++++++- src/GemStoneFFI/GsSessionParameters.class.st | 3 +- src/GemStoneFFI/GsVersionError.class.st | 76 +++++++ 17 files changed, 407 insertions(+), 26 deletions(-) create mode 100644 src/GemStoneFFI/GsVersionError.class.st diff --git a/src/GemStoneFFI-Tests/GciInterfaceTest.class.st b/src/GemStoneFFI-Tests/GciInterfaceTest.class.st index e2681e6..190dcb4 100644 --- a/src/GemStoneFFI-Tests/GciInterfaceTest.class.st +++ b/src/GemStoneFFI-Tests/GciInterfaceTest.class.st @@ -1,7 +1,8 @@ Class { #name : 'GciInterfaceTest', #superclass : 'GemStoneFFITestCase', - #category : 'GemStoneFFI-Tests' + #category : 'GemStoneFFI-Tests', + #package : 'GemStoneFFI-Tests' } { #category : 'tests' } diff --git a/src/GemStoneFFI-Tests/GemStoneFFITestCase.class.st b/src/GemStoneFFI-Tests/GemStoneFFITestCase.class.st index e828429..de7dcdf 100644 --- a/src/GemStoneFFI-Tests/GemStoneFFITestCase.class.st +++ b/src/GemStoneFFI-Tests/GemStoneFFITestCase.class.st @@ -7,7 +7,8 @@ Class { 'netldi', 'stone' ], - #category : 'GemStoneFFI-Tests' + #category : 'GemStoneFFI-Tests', + #package : 'GemStoneFFI-Tests' } { #category : 'acccessing' } @@ -31,6 +32,12 @@ GemStoneFFITestCase class >> host: hostOrIp [ host := hostOrIp ] +{ #category : 'testing' } +GemStoneFFITestCase class >> isAbstract [ +^ self name = GemStoneFFITestCase + +] + { #category : 'acccessing' } GemStoneFFITestCase class >> netldi [ ^netldi diff --git a/src/GemStoneFFI-Tests/GsExternalByteStringTest.class.st b/src/GemStoneFFI-Tests/GsExternalByteStringTest.class.st index 269b9b7..83e30dc 100644 --- a/src/GemStoneFFI-Tests/GsExternalByteStringTest.class.st +++ b/src/GemStoneFFI-Tests/GsExternalByteStringTest.class.st @@ -1,7 +1,8 @@ Class { #name : 'GsExternalByteStringTest', #superclass : 'GemStoneFFITestCase', - #category : 'GemStoneFFI-Tests' + #category : 'GemStoneFFI-Tests', + #package : 'GemStoneFFI-Tests' } { #category : 'tests' } diff --git a/src/GemStoneFFI-Tests/GsSessionTest.class.st b/src/GemStoneFFI-Tests/GsSessionTest.class.st index 4cd89b0..3d13d36 100644 --- a/src/GemStoneFFI-Tests/GsSessionTest.class.st +++ b/src/GemStoneFFI-Tests/GsSessionTest.class.st @@ -1,13 +1,65 @@ Class { #name : 'GsSessionTest', #superclass : 'GemStoneFFITestCase', - #category : 'GemStoneFFI-Tests' + #category : 'GemStoneFFI-Tests', + #package : 'GemStoneFFI-Tests' } { #category : 'instance creation' } GsSessionTest class >> newSession [ ^ GsSession newForGsVersion: self gsVersion threadSafe: true stone: self stone host: self host netldi: self netldi +] + +{ #category : 'tests' } +GsSessionTest >> buildStringForSessionId: idstr [ + +| ws | +ws := WriteStream on: String new. +ws + nextPutAll: '| end delay result |' ; lf ; + nextPutAll: 'end := DateTime now addSeconds: 60.' ; lf ; + nextPutAll: 'delay := Delay forMilliseconds: 250.' ; lf ; + nextPutAll: '[System currentSessions includesIdentical: ' ; nextPutAll: idstr ; nextPutAll: ' ] whileTrue:[' ; lf ; + nextPutAll: ' DateTime now > end ifTrue:[ ^ false asString ].' ; lf ; + nextPutAll: 'delay wait.' ; lf ; + nextPutAll: '].' ; lf ; + nextPutAll: 'result := 30 == (System sharedCounter: 1).' ; lf ; + nextPutAll: 'GsFile gciLogServer: (''result was '', result asString) . ' ; lf ; + nextPutAll: '^ result asString' . +^ ws contents + + +] + +{ #category : 'tests' } +GsSessionTest >> testForkAndDetach [ +|ses1 ses1id ses2 ses1str ses2str r1 r2 | +self timeLimit: 1 minute. "this test takes awhile" +ses1 := self class newSession . +ses2 := self class newSession . +[ + ses1 loginWithGsUser: 'DataCurator' password: 'swordfish' ; keepGemLog . + ses2 loginWithGsUser: 'DataCurator' password: 'swordfish' ; keepGemLog . + ses1id := ses1 gemSessionId . + ses2str := self buildStringForSessionId: ses1id . + ses1str := '| delay | + System sharedCounter: 1 setValue: 0 . + delay := Delay forMilliseconds: 500. + 30 timesRepeat:[ + System sharedCounter: 1 incrementBy: 1 . + delay wait + ]. + System logout' . + r1 := ses1 executeStringAndDetachNb: ses1str. + ses1 logoutNbNoError . + r2 := ses2 executeStringAndFetchResultString: ses2str. +] ensure:[ ses1 logoutNbNoError. ses2 logoutNbNoError ]. +self assert: r2 equals: 'true'. +^ self + + + ] { #category : 'tests' } diff --git a/src/GemStoneFFI/GciErrSType.class.st b/src/GemStoneFFI/GciErrSType.class.st index 6e96d2e..b72ae8a 100644 --- a/src/GemStoneFFI/GciErrSType.class.st +++ b/src/GemStoneFFI/GciErrSType.class.st @@ -19,7 +19,8 @@ Class { #pools : [ 'GciTypes' ], - #category : 'GemStoneFFI' + #category : 'GemStoneFFI', + #package : 'GemStoneFFI' } { #category : 'ffi support' } diff --git a/src/GemStoneFFI/GciError.class.st b/src/GemStoneFFI/GciError.class.st index 5687140..f503f89 100644 --- a/src/GemStoneFFI/GciError.class.st +++ b/src/GemStoneFFI/GciError.class.st @@ -18,7 +18,8 @@ Class { 'message', 'reason' ], - #category : 'GemStoneFFI' + #category : 'GemStoneFFI', + #package : 'GemStoneFFI' } { #category : 'signalling' } @@ -36,7 +37,7 @@ ex fatal: aGciErrSType fatal ; { #category : 'signalling' } GciError class >> newForError: aGciErrSType tracker: aMemoryTracker [ "Build an exception for an GemStone FFI call using the error in aGciErrSType . -Then release the C heap memory before raising the excpetion." +Then release the C heap memory before raising the exception." | result | result := self newForError: aGciErrSType . "aMemoryTracker freeAll." "Now that we're done with aGciErrSType, free meemory." diff --git a/src/GemStoneFFI/GciInterface.class.st b/src/GemStoneFFI/GciInterface.class.st index 3d7d328..1acee7e 100644 --- a/src/GemStoneFFI/GciInterface.class.st +++ b/src/GemStoneFFI/GciInterface.class.st @@ -14,7 +14,8 @@ Class { #pools : [ 'GciTypes' ], - #category : 'GemStoneFFI' + #category : 'GemStoneFFI', + #package : 'GemStoneFFI' } { #category : 'constants' } diff --git a/src/GemStoneFFI/GciLegacyInterface.class.st b/src/GemStoneFFI/GciLegacyInterface.class.st index a5e7b0a..3ee71c8 100644 --- a/src/GemStoneFFI/GciLegacyInterface.class.st +++ b/src/GemStoneFFI/GciLegacyInterface.class.st @@ -5,7 +5,8 @@ Not yet implemented, contact Norm Green if you need it to work. Class { #name : 'GciLegacyInterface', #superclass : 'GciInterface', - #category : 'GemStoneFFI' + #category : 'GemStoneFFI', + #package : 'GemStoneFFI' } { #category : 'constants' } diff --git a/src/GemStoneFFI/GciThreadSafeInterface.class.st b/src/GemStoneFFI/GciThreadSafeInterface.class.st index 4f34a6f..43c7ef2 100644 --- a/src/GemStoneFFI/GciThreadSafeInterface.class.st +++ b/src/GemStoneFFI/GciThreadSafeInterface.class.st @@ -10,7 +10,8 @@ Class { #instVars : [ 'session' ], - #category : 'GemStoneFFI' + #category : 'GemStoneFFI', + #package : 'GemStoneFFI' } { #category : 'constants' } @@ -95,6 +96,39 @@ GciThreadSafeInterface >> checkSpaceForBufferSize: bufSize resultSize: resultSiz ' bytes)')] ensure:[ tracker freeAll ]. ] +{ #category : 'remote execution' } +GciThreadSafeInterface >> executeString: sourceString [ + +"Executes sourceString which is expected to return a byte object. +The result must be a Boolean, SmallInteger, String or ByteArray not larger than 1024 bytes. +Raises an error if the remote execute fails or if the result of the remote execute is larger than 1024." + + | tracker result | + self assertLoggedIn. + tracker := GsMemoryTracker new. + [ | gciResult gsError srcCstring | + srcCstring := self + convertStringToExternalArgOrNull: sourceString + memoryTracker: tracker. + gsError := tracker add: GciErrSType externalNew. + + gciResult := self + gciTsExecute_: session + sourceString: srcCstring getHandle + sourceStringSize: srcCstring sizeNoNull + sourceOop: self class OOP_CLASS_STRING + contextObject: self class oopNil + symbolList: self class oopNil + flags: 0 + envId: 0 + gsError: gsError getHandle. + self checkGciResult: gciResult gsError: gsError tracker: tracker. + result := (self class asLocalObject: gciResult) + ifNil:[ self fetchResultByteObject: gciResult maxResultSize: 1024 ]. + ] ensure:[ tracker freeAll ]. + ^ result +] + { #category : 'remote execution (nonblocking)' } GciThreadSafeInterface >> executeStringAndDetachNb: sourceString [ @@ -228,10 +262,10 @@ GciThreadSafeInterface >> fetchResultByteObject: oop maxResultSize: maxSize [ gciTsFetchObjInfo: session object: oop addToExportSet: 0 - resultInfo: objInfo + resultInfo: objInfo getHandle resultBuffer: resultBuffer getHandle resultBufferSize: resultBuffer size - gsError: gsError. + gsError: gsError getHandle. self checkGciResult: gciResult gsError: gsError tracker: tracker. self checkSpaceForBufferSize: maxSize @@ -272,6 +306,21 @@ GciThreadSafeInterface >> gciTsExecuteFetchBytes: sess sourceString: sourceStrin GciErrSType *gsError)) library: self gsLibraryPath ] +{ #category : 'ffi calls' } +GciThreadSafeInterface >> gciTsExecute_: sess sourceString: sourceString sourceStringSize: sourceStringSize sourceOop: sourceOop contextObject: contextObject symbolList: symbolList flags: flags envId: envId gsError: gsError [ + +^self ffiCall: #( int64 GciTsExecute_( + void * sess, + const char* sourceString, + int64 sourceStringSize, + OopType sourceOop, + OopType contextObject, + OopType symbolList, + int flags, + ushort envId, + GciErrSType *gsError)) library: self gsLibraryPath +] + { #category : 'ffi calls' } GciThreadSafeInterface >> gciTsFetchObjInfo: sess object: objId addToExportSet: aBoolean resultInfo: aGciTsObjInfo resultBuffer: resultBuffer resultBufferSize: resultBufferSize gsError: gsError [ @@ -326,7 +375,7 @@ GciThreadSafeInterface >> gciTsNbExecute: sess sourceString: sourceString source { #category : 'ffi calls' } GciThreadSafeInterface >> gciTsNbLogout: sess gsError: gsError [ -"Low level FFI call to logout using the Gci thread-safe library. +"Non-blocking low level FFI call to logout using the Gci thread-safe library. Does not wait for a response from the gem." ^ self ffiCall: #( BoolType GciTsNbLogout(void *sess, GciErrSType *gsError) ) library: self gsLibraryPath @@ -356,7 +405,7 @@ GciThreadSafeInterface >> gciTsVersion: buffer bufferSize: bufSize [ ^ self ffiCall: #( uint32 GciTsVersion(char *buffer, size_t bufSize) ) library: self gsLibraryPath ] -{ #category : 'remote execution' } +{ #category : 'version strings' } GciThreadSafeInterface >> gciVersionString [ |tracker result resultBuffer bufSize| @@ -373,6 +422,14 @@ tracker freeAll. ^ result +] + +{ #category : 'version strings' } +GciThreadSafeInterface >> gciVersionStringShort [ + +"Answer the short GCI client version string, for example: '3.7.1' " +^ (ReadStream on: self gciVersionString) upTo: Character space + ] { #category : 'remote execution (nonblocking)' } @@ -432,7 +489,7 @@ result := self gciTsLoginToStone: exStnNrs getHandle loginFlags: exLoginFlags haltOnErrorNum: exHaltOnErrNum executedSessInit: exBoolPtr - err: gsError . + err: gsError getHandle . result isNull ifTrue:[ ^ GciError newForError: gsError tracker: tracker ]. session := result. tracker freeAll. diff --git a/src/GemStoneFFI/GciTsObjInfo.class.st b/src/GemStoneFFI/GciTsObjInfo.class.st index 3e71504..7df858a 100644 --- a/src/GemStoneFFI/GciTsObjInfo.class.st +++ b/src/GemStoneFFI/GciTsObjInfo.class.st @@ -17,7 +17,8 @@ Class { #pools : [ 'GciTypes' ], - #category : 'GemStoneFFI' + #category : 'GemStoneFFI', + #package : 'GemStoneFFI' } { #category : 'field definition' } diff --git a/src/GemStoneFFI/GciTypes.class.st b/src/GemStoneFFI/GciTypes.class.st index dacbfea..3e61c70 100644 --- a/src/GemStoneFFI/GciTypes.class.st +++ b/src/GemStoneFFI/GciTypes.class.st @@ -10,7 +10,8 @@ Class { 'OopType', 'OopTypeArray10' ], - #category : 'GemStoneFFI' + #category : 'GemStoneFFI', + #package : 'GemStoneFFI' } { #category : 'class initialization' } diff --git a/src/GemStoneFFI/GsExternalByteString.class.st b/src/GemStoneFFI/GsExternalByteString.class.st index 688e177..12d6ebe 100644 --- a/src/GemStoneFFI/GsExternalByteString.class.st +++ b/src/GemStoneFFI/GsExternalByteString.class.st @@ -4,7 +4,8 @@ A class used to represent a C null-terminated ASCII string. instances are alloca Class { #name : 'GsExternalByteString', #superclass : 'FFIExternalArray', - #category : 'GemStoneFFI' + #category : 'GemStoneFFI', + #package : 'GemStoneFFI' } { #category : 'instance creation' } diff --git a/src/GemStoneFFI/GsMemoryTracker.class.st b/src/GemStoneFFI/GsMemoryTracker.class.st index 52b53f1..a6157f6 100644 --- a/src/GemStoneFFI/GsMemoryTracker.class.st +++ b/src/GemStoneFFI/GsMemoryTracker.class.st @@ -6,7 +6,8 @@ The #freeAll message frees all memory in the receiver and empties the collection Class { #name : 'GsMemoryTracker', #superclass : 'OrderedCollection', - #category : 'GemStoneFFI' + #category : 'GemStoneFFI', + #package : 'GemStoneFFI' } { #category : 'releasing memory' } diff --git a/src/GemStoneFFI/GsNetworkResource.class.st b/src/GemStoneFFI/GsNetworkResource.class.st index fdbc3bc..b870d91 100644 --- a/src/GemStoneFFI/GsNetworkResource.class.st +++ b/src/GemStoneFFI/GsNetworkResource.class.st @@ -22,7 +22,8 @@ Class { 'dirPattern', 'logPattern' ], - #category : 'GemStoneFFI' + #category : 'GemStoneFFI', + #package : 'GemStoneFFI' } { #category : 'defaults' } diff --git a/src/GemStoneFFI/GsSession.class.st b/src/GemStoneFFI/GsSession.class.st index afa0106..2e0e318 100644 --- a/src/GemStoneFFI/GsSession.class.st +++ b/src/GemStoneFFI/GsSession.class.st @@ -17,7 +17,8 @@ Class { #classVars : [ 'AllSessions' ], - #category : 'GemStoneFFI' + #category : 'GemStoneFFI', + #package : 'GemStoneFFI' } { #category : 'Session Tracking' } @@ -26,7 +27,23 @@ GsSession class >> addSession: aSession [ AllSessions add: aSession ] -{ #category : 'as yet unclassified' } +{ #category : 'private' } +GsSession class >> allSessions [ + + ^ AllSessions +] + +{ #category : 'version management' } +GsSession class >> checkVersionString: verString isClient: aboolean [ + +"Validate the version string is recent enough to use the FFI. Raises a GsVersionError if not." +^ (self validateVersionString: verString) + ifTrue:[ true ] + ifFalse:[ self raiseVersionErrorFor: verString isClient: aboolean ]. + +] + +{ #category : 'private' } GsSession class >> cleanupOldSessions [ AllSessions removeAll ] @@ -144,6 +161,24 @@ sess logoutNbNoError. "Will not block" ] +{ #category : 'version management' } +GsSession class >> gsMajorVersionFromString: aString [ + +^ (aString at: 1) digitValue +] + +{ #category : 'version management' } +GsSession class >> gsMinorVersionFromString: aString [ + +^ (aString at: 3) digitValue +] + +{ #category : 'version management' } +GsSession class >> gsPatchVersionFromString: aString [ + +^ (aString at: 5) digitValue +] + { #category : 'class initialization' } GsSession class >> initialize [ @@ -157,6 +192,37 @@ AllSessions ifNil:[ AllSessions := IdentitySet new ]. ]. ] +{ #category : 'version management' } +GsSession class >> minGsMajorVersion [ + +^self gsMajorVersionFromString: self minGsVersionString +] + +{ #category : 'version management' } +GsSession class >> minGsMinorVersion [ + +^self gsMinorVersionFromString: self minGsVersionString +] + +{ #category : 'version management' } +GsSession class >> minGsPatchVersion [ + +^self gsPatchVersionFromString: self minGsVersionString +] + +{ #category : 'version management' } +GsSession class >> minGsVersionString [ + +"Answer the minimum GemStone version required for using this FFI. +Applies to both the GCI client (client libraries) and the GCI server (gem process). + +First digit it the major version number. +Second digit is the minor version number. +Third digit is the patch level." + +^ '3.7.1' +] + { #category : 'instance creation' } GsSession class >> newForGsVersion: aGsVersion threadSafe: aBoolean [ @@ -180,6 +246,15 @@ parms := GsSessionParameters newForStoneName: stoneName host: hostName netldi: n ] +{ #category : 'version management' } +GsSession class >> raiseVersionErrorFor: verString isClient: aboolean [ + +^ GsVersionError + newForRequiredVersion: self minGsVersionString + actualVersion: verString + isClient: aboolean +] + { #category : 'Session Tracking' } GsSession class >> removeSession: aSession [ @@ -205,6 +280,44 @@ coldStart ifTrue:[ self initialize ; cleanupOldSessions ]. ] +{ #category : 'version management' } +GsSession class >> validateVersionString: verString [ + +"Must be 3.x" +| major minor patch | +major := self gsMajorVersionFromString: verString . +major == self minGsMajorVersion + ifFalse:[ ^ false ]. +minor := self gsMinorVersionFromString: verString . +"Must be at least 3.7.x" +minor >= self minGsMinorVersion + ifFalse:[ ^ false ]. +"Do not check patch level if 3.8 or later" +minor > self minGsMinorVersion + ifTrue:[ ^ true ]. +"We have 3.7.x if we get here, ensure we are not using 3.7.0" +patch := self gsPatchVersionFromString: verString . +patch >= self minGsPatchVersion + ifFalse:[ ^ false ]. +"Success!" +^ true + +] + +{ #category : 'version strings' } +GsSession >> clientVersionString [ + +"Answer the long version for the GCI client (client library)" +^ self gciInterface gciVersionString +] + +{ #category : 'version strings' } +GsSession >> clientVersionStringShort [ + +"Answer the short version for the GCI client (client library)" +^ self gciInterface gciVersionStringShort +] + { #category : 'reflective operations' } GsSession >> doesNotUnderstand: aMessage [ ^ self gciInterface @@ -222,6 +335,30 @@ GsSession >> gciInterface: anObject [ gciInterface := anObject ] +{ #category : 'accessing - gem' } +GsSession >> gemLogFileName [ + +^ self executeStringAndFetchResultString: 'System gemLogFileName' +] + +{ #category : 'accessing - gem' } +GsSession >> gemProcessId [ + +^ self executeStringAndFetchResultString: 'System gemProcessId asString' +] + +{ #category : 'accessing - gem' } +GsSession >> gemSessionId [ + +^ self executeStringAndFetchResultString: 'System session asString' +] + +{ #category : 'accessing - gem' } +GsSession >> keepGemLog [ + +^ self executeStringAndFetchResultString: 'System removeGemLogOnExit: false. String new' +] + { #category : 'login' } GsSession >> loginWithGsUser: uid password: pw [ @@ -233,15 +370,31 @@ GsSession >> loginWithGsUser: uid password: pw hostUserId: hostu hostPassword: h self gciInterface loginWithHostUserId: hostu hostPassword: hostpw gsUserId: uid gsPassword: pw sessionParameters: self sessionParameters. self class addSession: self. + +"Validate the GCI client and server versions are recent enough" +[self validateVersions ] + on: GsVersionError + do:[:ex| self logoutNbNoError . ex pass ]. ^ true ] { #category : 'login' } GsSession >> logout [ - ^ [ - (self class sessionIsValid: self) ifTrue: [ gciInterface logout ] ] - ensure: [ self class removeSession: self ] +(self class sessionIsValid: self) + ifFalse:[ ^ self error: 'session is not logged in' ]. + +^ [ gciInterface logout ] ensure: [ self class removeSession: self ] +] + +{ #category : 'login' } +GsSession >> logoutNbNoError [ + +"Non blocking version of logout. Same as logoutNoError except the client does not wait for a response from the gem." + +[(self class sessionIsValid: self) ifTrue:[ gciInterface logoutNbNoError] ] ensure:[ self class removeSession: self ] + + ] { #category : 'login' } @@ -250,6 +403,21 @@ GsSession >> logoutNoError [ [(self class sessionIsValid: self) ifTrue:[ gciInterface logoutNoError] ] ensure:[ self class removeSession: self ] +] + +{ #category : 'version strings' } +GsSession >> serverVersionString [ + +"Answer the long version for the GCI server (gem process)" +^ self gciInterface executeStringAndFetchResultString: 'System _gemVersion' +] + +{ #category : 'version strings' } +GsSession >> serverVersionStringShort [ +"Answer the short version for the GCI server (gem process). Example: '3.7.1' " + +^ (ReadStream on: self serverVersionString) upTo: $, + ] { #category : 'accessing' } @@ -261,3 +429,12 @@ GsSession >> sessionParameters [ GsSession >> sessionParameters: anObject [ sessionParameters := anObject ] + +{ #category : 'version strings' } +GsSession >> validateVersions [ + +self class checkVersionString: self clientVersionStringShort isClient: true. +self class checkVersionString: self serverVersionStringShort isClient: false. +^ self + +] diff --git a/src/GemStoneFFI/GsSessionParameters.class.st b/src/GemStoneFFI/GsSessionParameters.class.st index f823eb5..83463c5 100644 --- a/src/GemStoneFFI/GsSessionParameters.class.st +++ b/src/GemStoneFFI/GsSessionParameters.class.st @@ -14,7 +14,8 @@ Class { 'stoneResource', 'gemResource' ], - #category : 'GemStoneFFI' + #category : 'GemStoneFFI', + #package : 'GemStoneFFI' } { #category : 'instance creation' } diff --git a/src/GemStoneFFI/GsVersionError.class.st b/src/GemStoneFFI/GsVersionError.class.st new file mode 100644 index 0000000..609de57 --- /dev/null +++ b/src/GemStoneFFI/GsVersionError.class.st @@ -0,0 +1,76 @@ +" +I am the error raised when the FFI detects the GCI client (client library) or GCI server (gem) version is not supported by the FFI. +" +Class { + #name : 'GsVersionError', + #superclass : 'Error', + #instVars : [ + 'isClient', + 'requiredVersion', + 'actualVersion' + ], + #category : 'GemStoneFFI', + #package : 'GemStoneFFI' +} + +{ #category : 'instance creation' } +GsVersionError class >> newForRequiredVersion: reqVer actualVersion: actVer isClient: aBoolean [ + +| inst | +inst := self new. +^ inst + actualVersion: actVer ; + requiredVersion: reqVer ; + isClient: aBoolean ; + signal: inst buildMessageText +] + +{ #category : 'accessing' } +GsVersionError >> actualVersion [ + + ^ actualVersion +] + +{ #category : 'accessing' } +GsVersionError >> actualVersion: anObject [ + + actualVersion := anObject +] + +{ #category : 'Building' } +GsVersionError >> buildMessageText [ + +|ws | +ws := WriteStream with: 'Incompatible version detected between FFI and GCI '. +isClient ifTrue:[ ws nextPutAll: 'client. '] ifFalse:[ ws nextPutAll: 'server. ']. +ws nextPutAll: 'Required version: ' ; + nextPutAll: self requiredVersion ; + nextPutAll: ', Actual version: ' ; + nextPutAll: self actualVersion. +^ ws contents. + +] + +{ #category : 'accessing' } +GsVersionError >> isClient [ + + ^ isClient +] + +{ #category : 'accessing' } +GsVersionError >> isClient: anObject [ + + isClient := anObject +] + +{ #category : 'accessing' } +GsVersionError >> requiredVersion [ + + ^ requiredVersion +] + +{ #category : 'accessing' } +GsVersionError >> requiredVersion: anObject [ + + requiredVersion := anObject +] From 93a0f3d1f58e9791c70bf2a0caec6c8b82f177c9 Mon Sep 17 00:00:00 2001 From: "Norm.Green" Date: Sat, 21 Dec 2024 15:02:21 -0800 Subject: [PATCH 3/8] Commit work --- src/GemStoneFFI-Tests/GciInterfaceTest.class.st | 0 src/GemStoneFFI-Tests/GemStoneFFITestCase.class.st | 0 src/GemStoneFFI-Tests/GsExternalByteStringTest.class.st | 0 src/GemStoneFFI-Tests/GsSessionTest.class.st | 0 src/GemStoneFFI-Tests/package.st | 0 src/GemStoneFFI/FFICalloutAPI.extension.st | 0 src/GemStoneFFI/GciErrSType.class.st | 0 src/GemStoneFFI/GciError.class.st | 0 src/GemStoneFFI/GciInterface.class.st | 0 src/GemStoneFFI/GciLegacyInterface.class.st | 0 src/GemStoneFFI/GciThreadSafeInterface.class.st | 0 src/GemStoneFFI/GciTsObjInfo.class.st | 0 src/GemStoneFFI/GciTypes.class.st | 0 src/GemStoneFFI/GsExternalByteString.class.st | 0 src/GemStoneFFI/GsMemoryTracker.class.st | 0 src/GemStoneFFI/GsNetworkResource.class.st | 0 src/GemStoneFFI/GsSession.class.st | 0 src/GemStoneFFI/GsSessionParameters.class.st | 0 src/GemStoneFFI/GsVersionError.class.st | 0 src/GemStoneFFI/SmallInteger.extension.st | 0 src/GemStoneFFI/package.st | 0 21 files changed, 0 insertions(+), 0 deletions(-) mode change 100644 => 100755 src/GemStoneFFI-Tests/GciInterfaceTest.class.st mode change 100644 => 100755 src/GemStoneFFI-Tests/GemStoneFFITestCase.class.st mode change 100644 => 100755 src/GemStoneFFI-Tests/GsExternalByteStringTest.class.st mode change 100644 => 100755 src/GemStoneFFI-Tests/GsSessionTest.class.st mode change 100644 => 100755 src/GemStoneFFI-Tests/package.st mode change 100644 => 100755 src/GemStoneFFI/FFICalloutAPI.extension.st mode change 100644 => 100755 src/GemStoneFFI/GciErrSType.class.st mode change 100644 => 100755 src/GemStoneFFI/GciError.class.st mode change 100644 => 100755 src/GemStoneFFI/GciInterface.class.st mode change 100644 => 100755 src/GemStoneFFI/GciLegacyInterface.class.st mode change 100644 => 100755 src/GemStoneFFI/GciThreadSafeInterface.class.st mode change 100644 => 100755 src/GemStoneFFI/GciTsObjInfo.class.st mode change 100644 => 100755 src/GemStoneFFI/GciTypes.class.st mode change 100644 => 100755 src/GemStoneFFI/GsExternalByteString.class.st mode change 100644 => 100755 src/GemStoneFFI/GsMemoryTracker.class.st mode change 100644 => 100755 src/GemStoneFFI/GsNetworkResource.class.st mode change 100644 => 100755 src/GemStoneFFI/GsSession.class.st mode change 100644 => 100755 src/GemStoneFFI/GsSessionParameters.class.st mode change 100644 => 100755 src/GemStoneFFI/GsVersionError.class.st mode change 100644 => 100755 src/GemStoneFFI/SmallInteger.extension.st mode change 100644 => 100755 src/GemStoneFFI/package.st diff --git a/src/GemStoneFFI-Tests/GciInterfaceTest.class.st b/src/GemStoneFFI-Tests/GciInterfaceTest.class.st old mode 100644 new mode 100755 diff --git a/src/GemStoneFFI-Tests/GemStoneFFITestCase.class.st b/src/GemStoneFFI-Tests/GemStoneFFITestCase.class.st old mode 100644 new mode 100755 diff --git a/src/GemStoneFFI-Tests/GsExternalByteStringTest.class.st b/src/GemStoneFFI-Tests/GsExternalByteStringTest.class.st old mode 100644 new mode 100755 diff --git a/src/GemStoneFFI-Tests/GsSessionTest.class.st b/src/GemStoneFFI-Tests/GsSessionTest.class.st old mode 100644 new mode 100755 diff --git a/src/GemStoneFFI-Tests/package.st b/src/GemStoneFFI-Tests/package.st old mode 100644 new mode 100755 diff --git a/src/GemStoneFFI/FFICalloutAPI.extension.st b/src/GemStoneFFI/FFICalloutAPI.extension.st old mode 100644 new mode 100755 diff --git a/src/GemStoneFFI/GciErrSType.class.st b/src/GemStoneFFI/GciErrSType.class.st old mode 100644 new mode 100755 diff --git a/src/GemStoneFFI/GciError.class.st b/src/GemStoneFFI/GciError.class.st old mode 100644 new mode 100755 diff --git a/src/GemStoneFFI/GciInterface.class.st b/src/GemStoneFFI/GciInterface.class.st old mode 100644 new mode 100755 diff --git a/src/GemStoneFFI/GciLegacyInterface.class.st b/src/GemStoneFFI/GciLegacyInterface.class.st old mode 100644 new mode 100755 diff --git a/src/GemStoneFFI/GciThreadSafeInterface.class.st b/src/GemStoneFFI/GciThreadSafeInterface.class.st old mode 100644 new mode 100755 diff --git a/src/GemStoneFFI/GciTsObjInfo.class.st b/src/GemStoneFFI/GciTsObjInfo.class.st old mode 100644 new mode 100755 diff --git a/src/GemStoneFFI/GciTypes.class.st b/src/GemStoneFFI/GciTypes.class.st old mode 100644 new mode 100755 diff --git a/src/GemStoneFFI/GsExternalByteString.class.st b/src/GemStoneFFI/GsExternalByteString.class.st old mode 100644 new mode 100755 diff --git a/src/GemStoneFFI/GsMemoryTracker.class.st b/src/GemStoneFFI/GsMemoryTracker.class.st old mode 100644 new mode 100755 diff --git a/src/GemStoneFFI/GsNetworkResource.class.st b/src/GemStoneFFI/GsNetworkResource.class.st old mode 100644 new mode 100755 diff --git a/src/GemStoneFFI/GsSession.class.st b/src/GemStoneFFI/GsSession.class.st old mode 100644 new mode 100755 diff --git a/src/GemStoneFFI/GsSessionParameters.class.st b/src/GemStoneFFI/GsSessionParameters.class.st old mode 100644 new mode 100755 diff --git a/src/GemStoneFFI/GsVersionError.class.st b/src/GemStoneFFI/GsVersionError.class.st old mode 100644 new mode 100755 diff --git a/src/GemStoneFFI/SmallInteger.extension.st b/src/GemStoneFFI/SmallInteger.extension.st old mode 100644 new mode 100755 diff --git a/src/GemStoneFFI/package.st b/src/GemStoneFFI/package.st old mode 100644 new mode 100755 From fb9ef640c532103263aae61eac15d1275ffdcd34 Mon Sep 17 00:00:00 2001 From: Norm Green Date: Sun, 22 Dec 2024 10:32:36 -0800 Subject: [PATCH 4/8] "Fix SEGV, add more FFI features and tests" --- .../GciInterfaceTest.class.st | 3 +- .../GemStoneFFITestCase.class.st | 0 .../GsExternalByteStringTest.class.st | 0 src/GemStoneFFI-Tests/GsSessionTest.class.st | 120 ++++++++++++---- src/GemStoneFFI-Tests/package.st | 0 src/GemStoneFFI/FFICalloutAPI.extension.st | 0 src/GemStoneFFI/GciErrSType.class.st | 0 src/GemStoneFFI/GciError.class.st | 0 src/GemStoneFFI/GciInterface.class.st | 3 +- src/GemStoneFFI/GciLegacyInterface.class.st | 0 .../GciThreadSafeInterface.class.st | 130 ++++++++++-------- src/GemStoneFFI/GciTsObjInfo.class.st | 0 src/GemStoneFFI/GciTypes.class.st | 0 src/GemStoneFFI/GsExternalByteString.class.st | 0 src/GemStoneFFI/GsMemoryTracker.class.st | 0 src/GemStoneFFI/GsNetworkResource.class.st | 0 src/GemStoneFFI/GsSession.class.st | 26 +++- src/GemStoneFFI/GsSessionParameters.class.st | 0 src/GemStoneFFI/GsVersionError.class.st | 0 src/GemStoneFFI/SmallInteger.extension.st | 0 src/GemStoneFFI/package.st | 0 21 files changed, 192 insertions(+), 90 deletions(-) mode change 100755 => 100644 src/GemStoneFFI-Tests/GciInterfaceTest.class.st mode change 100755 => 100644 src/GemStoneFFI-Tests/GemStoneFFITestCase.class.st mode change 100755 => 100644 src/GemStoneFFI-Tests/GsExternalByteStringTest.class.st mode change 100755 => 100644 src/GemStoneFFI-Tests/GsSessionTest.class.st mode change 100755 => 100644 src/GemStoneFFI-Tests/package.st mode change 100755 => 100644 src/GemStoneFFI/FFICalloutAPI.extension.st mode change 100755 => 100644 src/GemStoneFFI/GciErrSType.class.st mode change 100755 => 100644 src/GemStoneFFI/GciError.class.st mode change 100755 => 100644 src/GemStoneFFI/GciInterface.class.st mode change 100755 => 100644 src/GemStoneFFI/GciLegacyInterface.class.st mode change 100755 => 100644 src/GemStoneFFI/GciThreadSafeInterface.class.st mode change 100755 => 100644 src/GemStoneFFI/GciTsObjInfo.class.st mode change 100755 => 100644 src/GemStoneFFI/GciTypes.class.st mode change 100755 => 100644 src/GemStoneFFI/GsExternalByteString.class.st mode change 100755 => 100644 src/GemStoneFFI/GsMemoryTracker.class.st mode change 100755 => 100644 src/GemStoneFFI/GsNetworkResource.class.st mode change 100755 => 100644 src/GemStoneFFI/GsSession.class.st mode change 100755 => 100644 src/GemStoneFFI/GsSessionParameters.class.st mode change 100755 => 100644 src/GemStoneFFI/GsVersionError.class.st mode change 100755 => 100644 src/GemStoneFFI/SmallInteger.extension.st mode change 100755 => 100644 src/GemStoneFFI/package.st diff --git a/src/GemStoneFFI-Tests/GciInterfaceTest.class.st b/src/GemStoneFFI-Tests/GciInterfaceTest.class.st old mode 100755 new mode 100644 index 190dcb4..8021035 --- a/src/GemStoneFFI-Tests/GciInterfaceTest.class.st +++ b/src/GemStoneFFI-Tests/GciInterfaceTest.class.st @@ -11,9 +11,10 @@ GciInterfaceTest >> testAsLocalObject [ self assert: (GciInterface asLocalObject: GciInterface oopTrue) identicalTo: true ; assert: (GciInterface asLocalObject: GciInterface oopFalse) identicalTo: false ; + assert: (GciInterface asLocalObject: GciInterface oopNil) identicalTo: nil ; assert: (GciInterface oopIsSmallInt: 5330) ; deny: (GciInterface oopIsSmallInt: 5332) ; assert: (GciInterface asLocalObject: 5330) identicalTo: 666 ; - assert: (GciInterface asLocalObject: GciInterface OOP_CLASS_SYMBOL) identicalTo: nil . + assert: (GciInterface asLocalObject: GciInterface OOP_CLASS_SYMBOL) identicalTo: Object . ^ self ] diff --git a/src/GemStoneFFI-Tests/GemStoneFFITestCase.class.st b/src/GemStoneFFI-Tests/GemStoneFFITestCase.class.st old mode 100755 new mode 100644 diff --git a/src/GemStoneFFI-Tests/GsExternalByteStringTest.class.st b/src/GemStoneFFI-Tests/GsExternalByteStringTest.class.st old mode 100755 new mode 100644 diff --git a/src/GemStoneFFI-Tests/GsSessionTest.class.st b/src/GemStoneFFI-Tests/GsSessionTest.class.st old mode 100755 new mode 100644 index 3d13d36..baa2916 --- a/src/GemStoneFFI-Tests/GsSessionTest.class.st +++ b/src/GemStoneFFI-Tests/GsSessionTest.class.st @@ -5,6 +5,13 @@ Class { #package : 'GemStoneFFI-Tests' } +{ #category : 'instance creation' } +GsSessionTest class >> newLoggedInSession [ + +^ self newSession loginWithGsUser: 'DataCurator' password: 'swordfish' ; keepGemLog ; yourself + +] + { #category : 'instance creation' } GsSessionTest class >> newSession [ @@ -12,53 +19,106 @@ GsSessionTest class >> newSession [ ] { #category : 'tests' } -GsSessionTest >> buildStringForSessionId: idstr [ +GsSessionTest >> buildStringForSessionId: id [ +"Build a string to be executed by session 2. This code will wait for up to 60 seconds for the session with the given id to exit. +It will then return the value of the shared counter, which should be 30." | ws | ws := WriteStream on: String new. ws nextPutAll: '| end delay result |' ; lf ; nextPutAll: 'end := DateTime now addSeconds: 60.' ; lf ; nextPutAll: 'delay := Delay forMilliseconds: 250.' ; lf ; - nextPutAll: '[System currentSessions includesIdentical: ' ; nextPutAll: idstr ; nextPutAll: ' ] whileTrue:[' ; lf ; + nextPutAll: '[System currentSessions includesIdentical: ' ; nextPutAll: id asString ; nextPutAll: ' ] whileTrue:[' ; lf ; nextPutAll: ' DateTime now > end ifTrue:[ ^ false asString ].' ; lf ; nextPutAll: 'delay wait.' ; lf ; nextPutAll: '].' ; lf ; - nextPutAll: 'result := 30 == (System sharedCounter: 1).' ; lf ; + nextPutAll: 'result := System sharedCounter: 1.' ; lf ; nextPutAll: 'GsFile gciLogServer: (''result was '', result asString) . ' ; lf ; - nextPutAll: '^ result asString' . + nextPutAll: '^ result' . ^ ws contents +] + +{ #category : 'tests' } +GsSessionTest >> doTestForkAndDetachWith: ses1 and: ses2 [ + +"Test fork and detach. session 1 is forked and increments a shared counter in the server 30 times, sleeping 500 ms + after each increment. session 2 waits for session 1 to exit and verifies the counter value is 30. +Test takes approx 15 seconds depending on network speed and stone loading." +| ses1id ses1str ses2str r1 r2 | +ses1str := '| delay | +System sharedCounter: 1 setValue: 0 . +delay := Delay forMilliseconds: 500. +30 timesRepeat:[ + System sharedCounter: 1 incrementBy: 1 . + delay wait +]. +System logout' . +ses1id := ses1 gemSessionId . +ses2str := self buildStringForSessionId: ses1id . +r1 := ses1 executeStringAndDetachNb: ses1str. +ses1 logoutNbNoError . +r2 := ses2 executeString: ses2str. +self assert: r2 equals: 30 . +^ self + + + ] { #category : 'tests' } GsSessionTest >> testForkAndDetach [ -|ses1 ses1id ses2 ses1str ses2str r1 r2 | +|ses1 ses2 | self timeLimit: 1 minute. "this test takes awhile" -ses1 := self class newSession . -ses2 := self class newSession . -[ - ses1 loginWithGsUser: 'DataCurator' password: 'swordfish' ; keepGemLog . - ses2 loginWithGsUser: 'DataCurator' password: 'swordfish' ; keepGemLog . - ses1id := ses1 gemSessionId . - ses2str := self buildStringForSessionId: ses1id . - ses1str := '| delay | - System sharedCounter: 1 setValue: 0 . - delay := Delay forMilliseconds: 500. - 30 timesRepeat:[ - System sharedCounter: 1 incrementBy: 1 . - delay wait - ]. - System logout' . - r1 := ses1 executeStringAndDetachNb: ses1str. - ses1 logoutNbNoError . - r2 := ses2 executeStringAndFetchResultString: ses2str. -] ensure:[ ses1 logoutNbNoError. ses2 logoutNbNoError ]. -self assert: r2 equals: 'true'. +ses1 := self class newLoggedInSession . +ses2 := self class newLoggedInSession . +[ self doTestForkAndDetachWith: ses1 and: ses2 ] + ensure:[ ses1 logoutNbNoError. ses2 logoutNbNoError ] . +^ self + +] + +{ #category : 'tests' } +GsSessionTest >> testGemLogFileContents [ + +| s | +s := self class newLoggedInSession. +[ | tmp | self assert: (tmp := s gemLogFileNameContents) class identicalTo: ByteString ] + ensure:[ s logoutNbNoError ]. +^ self + +] + +{ #category : 'tests' } +GsSessionTest >> testGemLogFileName [ + +| s | +s := self class newLoggedInSession. +[ | tmp | self assert: (tmp := s gemLogFileName) class identicalTo: ByteString ] + ensure:[ s logoutNbNoError ]. +^ self + +] + +{ #category : 'tests' } +GsSessionTest >> testGemProcessId [ + +| s | +s := self class newLoggedInSession. +[ | tmp | self assert: (tmp := s gemProcessId) isInteger ] ensure:[ s logoutNbNoError ]. ^ self +] +{ #category : 'tests' } +GsSessionTest >> testGemSessionId [ + +| s | +s := self class newLoggedInSession. +[ | tmp | self assert: (tmp := s gemSessionId) isInteger ] ensure:[ s logoutNbNoError ]. +^ self ] @@ -102,6 +162,16 @@ self assert: r equals: 'Hello, World!'. ^self ] +{ #category : 'tests' } +GsSessionTest >> testKeepGemLog [ + +| s | +s := self class newLoggedInSession. +[ | tmp| self assert: (tmp := s keepGemLog) ] ensure:[ s logoutNbNoError ]. +^ self + +] + { #category : 'tests' } GsSessionTest >> testLogin [ diff --git a/src/GemStoneFFI-Tests/package.st b/src/GemStoneFFI-Tests/package.st old mode 100755 new mode 100644 diff --git a/src/GemStoneFFI/FFICalloutAPI.extension.st b/src/GemStoneFFI/FFICalloutAPI.extension.st old mode 100755 new mode 100644 diff --git a/src/GemStoneFFI/GciErrSType.class.st b/src/GemStoneFFI/GciErrSType.class.st old mode 100755 new mode 100644 diff --git a/src/GemStoneFFI/GciError.class.st b/src/GemStoneFFI/GciError.class.st old mode 100755 new mode 100644 diff --git a/src/GemStoneFFI/GciInterface.class.st b/src/GemStoneFFI/GciInterface.class.st old mode 100755 new mode 100644 index 1acee7e..25c1d32 --- a/src/GemStoneFFI/GciInterface.class.st +++ b/src/GemStoneFFI/GciInterface.class.st @@ -108,9 +108,10 @@ Note: Caller must check for oopNil!" anOopType == self oopTrue ifTrue:[ ^ true ]. anOopType == self oopFalse ifTrue:[ ^ false ]. +anOopType == self oopNil ifTrue:[ ^ nil ]. (self oopIsSmallInt: anOopType) ifTrue:[ ^ self oopToSmallInt: anOopType ]. "We could add code to check for other specials here like SmallDate, SmallTime, etc" -^nil "Easy cases exhausted. Caller needs to call GciTsFetchObjInfo to find out what is it." +^Object "Easy cases exhausted. Caller needs to call GciTsFetchObjInfo to find out what is it." ] { #category : 'library path' } diff --git a/src/GemStoneFFI/GciLegacyInterface.class.st b/src/GemStoneFFI/GciLegacyInterface.class.st old mode 100755 new mode 100644 diff --git a/src/GemStoneFFI/GciThreadSafeInterface.class.st b/src/GemStoneFFI/GciThreadSafeInterface.class.st old mode 100755 new mode 100644 index 43c7ef2..edc3ad3 --- a/src/GemStoneFFI/GciThreadSafeInterface.class.st +++ b/src/GemStoneFFI/GciThreadSafeInterface.class.st @@ -66,22 +66,24 @@ To check the nonblocking call status without blocking use the method: getNbCallS |tracker result gsError localResult | self assertLoggedIn . tracker := GsMemoryTracker new. -gsError := tracker add: GciErrSType externalNew . +gsError := GciErrSType externalNew . +tracker add: gsError. result := self gciTsNbResult: session gsError: gsError. result == self class oopIllegal ifTrue:[ ^ GciError newForError: gsError tracker: tracker ]. tracker freeAll. "No error, so done with this." gsError := nil. "Get freed C memory off the stack" result == self class oopNil ifTrue:[ ^ nil ]. -^(localResult := self class asLocalObject: result) - ifNil:[self fetchResultByteObject: result maxResultSize: maxSize] "Hope it's a String, Symbol or ByteArray" - ifNotNil:[ localResult ]. "Boolean or Integer take this path" +localResult := self class asLocalObject: result. +^ localResult == Object "Means we could not easily convert it to a Pharo immediate object" + ifTrue:[self doFetchResultByteObject: result maxResultSize: maxSize tracker: tracker] + ifFalse:[ localResult ]. "nil, Boolean or Integer take this path" ] { #category : 'error handling' } GciThreadSafeInterface >> checkGciResult: gciResult gsError: gsError tracker: tracker [ -gciResult == -1 ifFalse:[ ^ self ]. +gciResult >= 0 ifTrue:[ ^ self ]. "Call failed, return an exception" ^ GciError newForError: gsError tracker: tracker @@ -97,21 +99,17 @@ GciThreadSafeInterface >> checkSpaceForBufferSize: bufSize resultSize: resultSiz ] { #category : 'remote execution' } -GciThreadSafeInterface >> executeString: sourceString [ +GciThreadSafeInterface >> doExecuteString: sourceString tracker: tracker [ -"Executes sourceString which is expected to return a byte object. -The result must be a Boolean, SmallInteger, String or ByteArray not larger than 1024 bytes. +"Executes sourceString which is expected to return a Boolean, SmallInteger, String, Symbol or ByteArray not larger than 1024 bytes. Raises an error if the remote execute fails or if the result of the remote execute is larger than 1024." - | tracker result | - self assertLoggedIn. - tracker := GsMemoryTracker new. - [ | gciResult gsError srcCstring | + | result gciResult gsError srcCstring | srcCstring := self convertStringToExternalArgOrNull: sourceString memoryTracker: tracker. - gsError := tracker add: GciErrSType externalNew. - + gsError := GciErrSType externalNew. + tracker add: gsError. gciResult := self gciTsExecute_: session sourceString: srcCstring getHandle @@ -122,13 +120,68 @@ Raises an error if the remote execute fails or if the result of the remote execu flags: 0 envId: 0 gsError: gsError getHandle. + gciResult == self class oopIllegal + ifTrue:[ ^ GciError newForError: gsError tracker: tracker ]. + result := self class asLocalObject: gciResult. + ^ result == Object + ifTrue:[ self doFetchResultByteObject: gciResult maxResultSize: 1024 tracker: tracker ] + ifFalse:[ result ] +] + +{ #category : 'remote execution' } +GciThreadSafeInterface >> doFetchResultByteObject: oop maxResultSize: maxSize tracker: tracker [ + + | objInfo result gciResult resultBuffer gsError isSymbol classOop | + self assertLoggedIn. + resultBuffer := GsExternalByteString new: maxSize . + tracker add: resultBuffer. + gsError := GciErrSType externalNew. + tracker add: gsError. + objInfo := GciTsObjInfo externalNew. + tracker add: objInfo. + gciResult := self + gciTsFetchObjInfo: session + object: oop + addToExportSet: 0 + resultInfo: objInfo getHandle + resultBuffer: resultBuffer getHandle + resultBufferSize: resultBuffer size + gsError: gsError getHandle. self checkGciResult: gciResult gsError: gsError tracker: tracker. - result := (self class asLocalObject: gciResult) - ifNil:[ self fetchResultByteObject: gciResult maxResultSize: 1024 ]. - ] ensure:[ tracker freeAll ]. + self + checkSpaceForBufferSize: maxSize + resultSize: gciResult + tracker: tracker. + + classOop := objInfo objClass. + classOop == self class OOP_CLASS_BYTE_ARRAY ifTrue: [ + result := resultBuffer asByteArrayOfSize: gciResult. + ^ result ]. + + isSymbol := classOop == self class OOP_CLASS_SYMBOL. + (isSymbol or: [ classOop == self class OOP_CLASS_STRING ]) ifFalse: [ + | msg | + msg := 'Expected GemStone object to have class OOP_CLASS_STRING but it has class ' + , classOop asString. + ^ Error signal: msg ]. + result := resultBuffer asByteStringOfSize: gciResult. + isSymbol ifTrue: [ result := result asSymbol ]. ^ result ] +{ #category : 'remote execution' } +GciThreadSafeInterface >> executeString: sourceString [ + +"Executes sourceString which is expected to return a Boolean, SmallInteger, String, Symbol or ByteArray not larger than 1024 bytes. +Raises an error if the remote execute fails or if the result of the remote execute is larger than 1024." + + | tracker | + self assertLoggedIn. + tracker := GsMemoryTracker new. + [ ^ self doExecuteString: sourceString tracker: tracker ] ensure:[ tracker freeAll ]. + +] + { #category : 'remote execution (nonblocking)' } GciThreadSafeInterface >> executeStringAndDetachNb: sourceString [ @@ -248,49 +301,6 @@ tracker freeAll. ^ true ] -{ #category : 'remote execution' } -GciThreadSafeInterface >> fetchResultByteObject: oop maxResultSize: maxSize [ - - | tracker objInfo result gciResult resultBuffer gsError isSymbol classOop | - self assertLoggedIn. - tracker := GsMemoryTracker new. - - resultBuffer := tracker add: (GsExternalByteString new: maxSize). - gsError := tracker add: GciErrSType externalNew. - objInfo := tracker add: GciTsObjInfo externalNew. - gciResult := self - gciTsFetchObjInfo: session - object: oop - addToExportSet: 0 - resultInfo: objInfo getHandle - resultBuffer: resultBuffer getHandle - resultBufferSize: resultBuffer size - gsError: gsError getHandle. - self checkGciResult: gciResult gsError: gsError tracker: tracker. - self - checkSpaceForBufferSize: maxSize - resultSize: gciResult - tracker: tracker. - - classOop := objInfo objClass. - classOop == self class OOP_CLASS_BYTE_ARRAY ifTrue: [ - result := resultBuffer asByteArrayOfSize: gciResult. - tracker freeAll. - ^ result ]. - - isSymbol := classOop == self class OOP_CLASS_SYMBOL. - (isSymbol or: [ classOop == self class OOP_CLASS_STRING ]) ifFalse: [ - | msg | - msg := 'Expected GemStone object to have class OOP_CLASS_STRING but it has class ' - , classOop asString. - tracker freeAll. - ^ Error signal: msg ]. - result := resultBuffer asByteStringOfSize: gciResult. - isSymbol ifTrue: [ result := result asSymbol ]. - tracker freeAll. - ^ result -] - { #category : 'ffi calls' } GciThreadSafeInterface >> gciTsExecuteFetchBytes: sess sourceString: sourceString sourceStringSize: sourceStringSize sourceOop: sourceOop contextObject: contextObject symbolList: symbolList resultBuffer: resultBuffer resultBufferSize: resultBufferSize gsError: gsError [ diff --git a/src/GemStoneFFI/GciTsObjInfo.class.st b/src/GemStoneFFI/GciTsObjInfo.class.st old mode 100755 new mode 100644 diff --git a/src/GemStoneFFI/GciTypes.class.st b/src/GemStoneFFI/GciTypes.class.st old mode 100755 new mode 100644 diff --git a/src/GemStoneFFI/GsExternalByteString.class.st b/src/GemStoneFFI/GsExternalByteString.class.st old mode 100755 new mode 100644 diff --git a/src/GemStoneFFI/GsMemoryTracker.class.st b/src/GemStoneFFI/GsMemoryTracker.class.st old mode 100755 new mode 100644 diff --git a/src/GemStoneFFI/GsNetworkResource.class.st b/src/GemStoneFFI/GsNetworkResource.class.st old mode 100755 new mode 100644 diff --git a/src/GemStoneFFI/GsSession.class.st b/src/GemStoneFFI/GsSession.class.st old mode 100755 new mode 100644 index 2e0e318..29f2aa7 --- a/src/GemStoneFFI/GsSession.class.st +++ b/src/GemStoneFFI/GsSession.class.st @@ -338,25 +338,45 @@ GsSession >> gciInterface: anObject [ { #category : 'accessing - gem' } GsSession >> gemLogFileName [ +"Answer a ByteString representing the log file name of the gem. Receiver must be logged in." ^ self executeStringAndFetchResultString: 'System gemLogFileName' ] +{ #category : 'accessing - gem' } +GsSession >> gemLogFileNameContents [ + +"Answer a ByteString representing the contents of the gem log file. Receiver must be logged in." + +| str sz | +"Find out how big it is." +sz := self executeString: 'GsFile sizeOfOnServer: System gemLogFileName'. +"Allow for some growth" +sz := sz + 512. +"Fetch the file contents" +str := '|gsf r | gsf := GsFile openReadOnServer: System gemLogFileName. r := gsf contents. gsf close. ^r'. +^ self executeStringAndFetchResultString: str maxResultSize: sz. + +] + { #category : 'accessing - gem' } GsSession >> gemProcessId [ -^ self executeStringAndFetchResultString: 'System gemProcessId asString' +"Answer a SmallInteger which is the process ID of the gem process. Receiver must be logged in." +^ self executeString: 'System gemProcessId' ] { #category : 'accessing - gem' } GsSession >> gemSessionId [ -^ self executeStringAndFetchResultString: 'System session asString' +"Answer a SmallInteger which is the session ID of the gem. Receiver must be logged in." +^ self executeString: 'System session' ] { #category : 'accessing - gem' } GsSession >> keepGemLog [ -^ self executeStringAndFetchResultString: 'System removeGemLogOnExit: false. String new' +"Prevents the gem from removing the gem log upon exit. Receiver must be logged in." +^ self executeString: 'System removeGemLogOnExit: false. true' ] { #category : 'login' } diff --git a/src/GemStoneFFI/GsSessionParameters.class.st b/src/GemStoneFFI/GsSessionParameters.class.st old mode 100755 new mode 100644 diff --git a/src/GemStoneFFI/GsVersionError.class.st b/src/GemStoneFFI/GsVersionError.class.st old mode 100755 new mode 100644 diff --git a/src/GemStoneFFI/SmallInteger.extension.st b/src/GemStoneFFI/SmallInteger.extension.st old mode 100755 new mode 100644 diff --git a/src/GemStoneFFI/package.st b/src/GemStoneFFI/package.st old mode 100755 new mode 100644 From d9dc42f6adfe3bae2381ac6591ce1c809d80dafe Mon Sep 17 00:00:00 2001 From: "Norm.Green" Date: Sun, 22 Dec 2024 13:03:17 -0800 Subject: [PATCH 5/8] Address issues 5 and 12 --- src/GemStoneFFI-Tests/GsSessionTest.class.st | 36 ++++++++++++++++++++ src/GemStoneFFI/GciInterface.class.st | 2 +- src/GemStoneFFI/GsNetworkResource.class.st | 27 +++++++++------ 3 files changed, 54 insertions(+), 11 deletions(-) diff --git a/src/GemStoneFFI-Tests/GsSessionTest.class.st b/src/GemStoneFFI-Tests/GsSessionTest.class.st index baa2916..f70d19a 100644 --- a/src/GemStoneFFI-Tests/GsSessionTest.class.st +++ b/src/GemStoneFFI-Tests/GsSessionTest.class.st @@ -185,6 +185,42 @@ self ] +{ #category : 'tests' } +GsSessionTest >> testLoginWithSpaces [ + +"Test issue 5: login with leading and trailing spaces" + +| stn hst nldi sess | +stn := ' ', self class stone, ' '. +host := +hst := ' ', self class host, ' '. +nldi := ' ', self class netldi, ' '. + +sess := GsSession + newForGsVersion: self class gsVersion + threadSafe: true + stone: stn + host: hst + netldi: nldi. +[ self + assert: sess class identicalTo: GsSession ; + assert: (sess loginWithGsUser: 'DataCurator' password: 'swordfish') +] ensure:[ sess ifNotNil:[ sess logoutNbNoError ] ]. + +^ self + +] + +{ #category : 'tests' } +GsSessionTest >> testLogoutError [ +"test issue 12" +|sess| +sess := self class newSession . +self should:[ sess logout ] raise: Error. +^self + +] + { #category : 'tests' } GsSessionTest >> testLogoutWhenNotLoggedIn [ |sess| diff --git a/src/GemStoneFFI/GciInterface.class.st b/src/GemStoneFFI/GciInterface.class.st index 25c1d32..8ae77d5 100644 --- a/src/GemStoneFFI/GciInterface.class.st +++ b/src/GemStoneFFI/GciInterface.class.st @@ -160,7 +160,7 @@ GciInterface class >> convertStringToExternalArgOrNull: byteString memoryTracker Converts empty strings or nils to NULL in C. For non-empy strings, add the result to tracker so the caller can free the memory when appropriate." ^(byteString isNotNil and:[ byteString isNotEmpty ] ) - ifTrue:[tracker add: (GsExternalByteString newFromByteString: byteString) ] + ifTrue:[tracker add: (GsExternalByteString newFromByteString: byteString trimBoth) ] ifFalse:[ FFIExternalObject null] ] diff --git a/src/GemStoneFFI/GsNetworkResource.class.st b/src/GemStoneFFI/GsNetworkResource.class.st index b870d91..88e508f 100644 --- a/src/GemStoneFFI/GsNetworkResource.class.st +++ b/src/GemStoneFFI/GsNetworkResource.class.st @@ -72,11 +72,11 @@ GsNetworkResource class >> newWithName: aName host: aHost netldi: aNetldi [ GsNetworkResource class >> newWithName: aName host: aHost netldi: aNetldi dirPattern: aDirPattern logPattern: aLogPattern [ "Creates a new instance" ^ self new - name: aName ; - host: aHost ; - netldi: aNetldi ; - dirPattern: aDirPattern ; - logPattern: aLogPattern ; + name: aName ; + host: aHost ; + netldi: aNetldi ; + dirPattern: aDirPattern ; + logPattern: aLogPattern ; yourself ] @@ -104,7 +104,7 @@ GsNetworkResource >> dirPattern [ { #category : 'accessing' } GsNetworkResource >> dirPattern: anObject [ - dirPattern := anObject + dirPattern := self trimBoth: anObject ] { #category : 'accessing' } @@ -114,7 +114,7 @@ GsNetworkResource >> host [ { #category : 'accessing' } GsNetworkResource >> host: anObject [ - host := anObject + host := self trimBoth: anObject ] { #category : 'accessing' } @@ -124,7 +124,7 @@ GsNetworkResource >> logPattern [ { #category : 'accessing' } GsNetworkResource >> logPattern: anObject [ - logPattern := anObject + logPattern := self trimBoth: anObject ] { #category : 'accessing' } @@ -134,7 +134,7 @@ GsNetworkResource >> name [ { #category : 'accessing' } GsNetworkResource >> name: anObject [ - name := anObject + name := self trimBoth: anObject ] { #category : 'accessing' } @@ -144,5 +144,12 @@ GsNetworkResource >> netldi [ { #category : 'accessing' } GsNetworkResource >> netldi: anObject [ - netldi := anObject asString + netldi := self trimBoth: anObject asString +] + +{ #category : 'trimming' } +GsNetworkResource >> trimBoth: anObj [ + +"Fix issue #5" +^ anObj ifNil:[ nil ] ifNotNil:[ anObj trimBoth ] ] From d3ab4851f411b8550ac8c178ba8730af3bcf3410 Mon Sep 17 00:00:00 2001 From: "Norm.Green" Date: Sun, 22 Dec 2024 13:04:38 -0800 Subject: [PATCH 6/8] Add NEWS.md --- NEWS.md | 17 ++++++ README.md | 58 ++++++++++--------- .../GciInterfaceTest.class.st | 0 .../GemStoneFFITestCase.class.st | 0 .../GsExternalByteStringTest.class.st | 0 src/GemStoneFFI-Tests/GsSessionTest.class.st | 0 src/GemStoneFFI-Tests/package.st | 0 src/GemStoneFFI/FFICalloutAPI.extension.st | 0 src/GemStoneFFI/GciErrSType.class.st | 0 src/GemStoneFFI/GciError.class.st | 0 src/GemStoneFFI/GciInterface.class.st | 0 src/GemStoneFFI/GciLegacyInterface.class.st | 0 .../GciThreadSafeInterface.class.st | 0 src/GemStoneFFI/GciTsObjInfo.class.st | 0 src/GemStoneFFI/GciTypes.class.st | 0 src/GemStoneFFI/GsExternalByteString.class.st | 0 src/GemStoneFFI/GsMemoryTracker.class.st | 0 src/GemStoneFFI/GsNetworkResource.class.st | 0 src/GemStoneFFI/GsSession.class.st | 0 src/GemStoneFFI/GsSessionParameters.class.st | 0 src/GemStoneFFI/GsVersionError.class.st | 0 src/GemStoneFFI/SmallInteger.extension.st | 0 src/GemStoneFFI/package.st | 0 23 files changed, 49 insertions(+), 26 deletions(-) create mode 100755 NEWS.md mode change 100644 => 100755 src/GemStoneFFI-Tests/GciInterfaceTest.class.st mode change 100644 => 100755 src/GemStoneFFI-Tests/GemStoneFFITestCase.class.st mode change 100644 => 100755 src/GemStoneFFI-Tests/GsExternalByteStringTest.class.st mode change 100644 => 100755 src/GemStoneFFI-Tests/GsSessionTest.class.st mode change 100644 => 100755 src/GemStoneFFI-Tests/package.st mode change 100644 => 100755 src/GemStoneFFI/FFICalloutAPI.extension.st mode change 100644 => 100755 src/GemStoneFFI/GciErrSType.class.st mode change 100644 => 100755 src/GemStoneFFI/GciError.class.st mode change 100644 => 100755 src/GemStoneFFI/GciInterface.class.st mode change 100644 => 100755 src/GemStoneFFI/GciLegacyInterface.class.st mode change 100644 => 100755 src/GemStoneFFI/GciThreadSafeInterface.class.st mode change 100644 => 100755 src/GemStoneFFI/GciTsObjInfo.class.st mode change 100644 => 100755 src/GemStoneFFI/GciTypes.class.st mode change 100644 => 100755 src/GemStoneFFI/GsExternalByteString.class.st mode change 100644 => 100755 src/GemStoneFFI/GsMemoryTracker.class.st mode change 100644 => 100755 src/GemStoneFFI/GsNetworkResource.class.st mode change 100644 => 100755 src/GemStoneFFI/GsSession.class.st mode change 100644 => 100755 src/GemStoneFFI/GsSessionParameters.class.st mode change 100644 => 100755 src/GemStoneFFI/GsVersionError.class.st mode change 100644 => 100755 src/GemStoneFFI/SmallInteger.extension.st mode change 100644 => 100755 src/GemStoneFFI/package.st diff --git a/NEWS.md b/NEWS.md new file mode 100755 index 0000000..de202fe --- /dev/null +++ b/NEWS.md @@ -0,0 +1,17 @@ +# Version 1.1, December 22, 2024 + +## GemStone version 3.7.1 or later is now required. 3.7.0 and 3.6.x are no longer supported. + +## Issues Fixed in 1.1: + +### issue 17: Support fork and detach semantics +Add support for "execute and detach" semantics. This allows the FFI to "fork" code to run on the server and tells the gem to keep running if the client logs out and/or closes the socket. + +### issue 16: Need smalltalk logic to call thread safe library GciTsNbLogout +Add GsSession>>logoutNbNoError method to call GciTsNbLogout(). This method causes an immediate logout without waiting for a response from the gem. + +### issue 12: Should GsSession>>logout signal an error if not logged in? +This was a bug. GsSession>>logout now raises an error if the session is not logged in. To avoid the exception, use #logoutNbNoError or #logoutNoError. + +### issue 5: SparkleFFI should trim white space on strings passed to C that are used in the NRS +Remove whitespace from stone, netldi, host, logPattern, dirPattern . diff --git a/README.md b/README.md index f80e98c..c9cf772 100644 --- a/README.md +++ b/README.md @@ -2,11 +2,17 @@ GemStone GCI access via Pharo FFI ## Prerequisites + +### Version 1.1 +**GemStone version ==3.7.1== or later is now required!** + +Tested on Pharo 9, 10, 11 on Windows and Linux. Other Pharo versions/platforms will probably work but might not. + Installation instructions assume that you have registered SSH Keys with your GitHub account. See [Connecting to GitHub with SSH](https://help.github.com/articles/connecting-to-github-with-ssh/) for more information. You must have git installed: [git setup](https://help.github.com/articles/set-up-git/) -You must have access to the GemStone client libraries for 3.6.x or 3.7.0 for the client platform you're running on . +You must have access to the GemStone client libraries for 3.7.1 or later for the client platform you're running on . The build step [slow|fast]clientlibs generates a zip file containing these libraries in the correct directory structure. ## Installation @@ -14,9 +20,9 @@ The build step [slow|fast]clientlibs generates a zip file containing these libra If you are installing Sparkle, it will automatically install PharoGemStoneFFI, and there is no need to perform an manual install of PharoGemStoneFFI. See [Sparkle on github](https://github.com/GemTalk/Sparkle); the Installation Guide is under Documentation. ### Client Library Installation -Choose a location for the client library files and copy the client library zip file to that location. ClientLibs for Alpha5 are available here: -https://downloads.gemtalksystems.com/pub/GemStone64/3.7.0-Alpha5/GemStoneClientLibs3.7.0-x86.Windows_NT.zip -https://downloads.gemtalksystems.com/pub/GemStone64/3.7.0-Alpha5/GemStoneClientLibs3.7.0-x86_64.Linux.zip +Choose a location for the client library files and copy the client library zip file to that location. ClientLibs are available here: +https://downloads.gemtalksystems.com/pub/GemStone64/3.7.1/GemStoneClientLibs3.7.1-x86.Windows_NT.zip +https://downloads.gemtalksystems.com/pub/GemStone64/3.7.1/GemStoneClientLibs3.7.1-x86_64.Linux.zip unzip the zip file into a directory named clientLibs. @@ -24,27 +30,27 @@ The examples below show installing on Windows under cygwin, but the process is s ``` $ mkdir clientlibs $ cd clientlibs -$ cp installdir/GemStoneClientLibs3.7.0-x86.Windows_NT.zip . -$ unzip GemStoneClientLibs3.7.0-x86.Windows_NT.zip -Archive: GemStoneClientLibs3.7.0-x86.Windows_NT.zip - creating: 3.7.0/ - creating: 3.7.0/32bit/ - inflating: 3.7.0/32bit/libgcirpc-3.7.0-32.dll - inflating: 3.7.0/32bit/libgcirpc-3.7.0-32.pdb - inflating: 3.7.0/32bit/libgcits-3.7.0-32.dll - inflating: 3.7.0/32bit/libgcits-3.7.0-32.pdb - inflating: 3.7.0/32bit/libssl-3.7.0-32.dll - inflating: 3.7.0/32bit/libssl-3.7.0-32.pdb - inflating: 3.7.0/32bit/vcruntime140d.dll - creating: 3.7.0/64bit/ - inflating: 3.7.0/64bit/libgcirpc-3.7.0-64.dll - inflating: 3.7.0/64bit/libgcirpc-3.7.0-64.pdb - inflating: 3.7.0/64bit/libgcits-3.7.0-64.dll - inflating: 3.7.0/64bit/libgcits-3.7.0-64.pdb - inflating: 3.7.0/64bit/libssl-3.7.0-64.dll - inflating: 3.7.0/64bit/libssl-3.7.0-64.pdb - inflating: 3.7.0/64bit/vcruntime140d.dll - inflating: 3.7.0/64bit/vcruntime140_1d.dll +$ cp installdir/GemStoneClientLibs3.7.1-x86.Windows_NT.zip . +$ unzip GemStoneClientLibs3.7.1-x86.Windows_NT.zip +Archive: GemStoneClientLibs3.7.1-x86.Windows_NT.zip + creating: 3.7.1/ + creating: 3.7.1/32bit/ + inflating: 3.7.1/32bit/libgcirpc-3.7.1-32.dll + inflating: 3.7.1/32bit/libgcirpc-3.7.1-32.pdb + inflating: 3.7.1/32bit/libgcits-3.7.1-32.dll + inflating: 3.7.1/32bit/libgcits-3.7.1-32.pdb + inflating: 3.7.1/32bit/libssl-3.7.1-32.dll + inflating: 3.7.1/32bit/libssl-3.7.1-32.pdb + inflating: 3.7.1/32bit/vcruntime140d.dll + creating: 3.7.1/64bit/ + inflating: 3.7.1/64bit/libgcirpc-3.7.1-64.dll + inflating: 3.7.1/64bit/libgcirpc-3.7.1-64.pdb + inflating: 3.7.1/64bit/libgcits-3.7.1-64.dll + inflating: 3.7.1/64bit/libgcits-3.7.1-64.pdb + inflating: 3.7.1/64bit/libssl-3.7.1-64.dll + inflating: 3.7.1/64bit/libssl-3.7.1-64.pdb + inflating: 3.7.1/64bit/vcruntime140d.dll + inflating: 3.7.1/64bit/vcruntime140_1d.dll ``` The installdir/clientLibs directory is your client libs directory. Remember this location, you will need it later. @@ -61,7 +67,7 @@ cd git clone git@github.com:GemTalk/PharoGemStoneFFI.git ``` If you have already performed the clone, do a "git pull origin development" before running the install (if you will install the current developement branch). -* Start a Pharo 9 or 10 image and open Iceberg. +* Start a Pharo 11 or 12 image and open Iceberg. * In the Repositories window, click "+" and select "Import from existing clone". * Select the directory you cloned to above and add the repository. * Right click and select "Load" to load the code. diff --git a/src/GemStoneFFI-Tests/GciInterfaceTest.class.st b/src/GemStoneFFI-Tests/GciInterfaceTest.class.st old mode 100644 new mode 100755 diff --git a/src/GemStoneFFI-Tests/GemStoneFFITestCase.class.st b/src/GemStoneFFI-Tests/GemStoneFFITestCase.class.st old mode 100644 new mode 100755 diff --git a/src/GemStoneFFI-Tests/GsExternalByteStringTest.class.st b/src/GemStoneFFI-Tests/GsExternalByteStringTest.class.st old mode 100644 new mode 100755 diff --git a/src/GemStoneFFI-Tests/GsSessionTest.class.st b/src/GemStoneFFI-Tests/GsSessionTest.class.st old mode 100644 new mode 100755 diff --git a/src/GemStoneFFI-Tests/package.st b/src/GemStoneFFI-Tests/package.st old mode 100644 new mode 100755 diff --git a/src/GemStoneFFI/FFICalloutAPI.extension.st b/src/GemStoneFFI/FFICalloutAPI.extension.st old mode 100644 new mode 100755 diff --git a/src/GemStoneFFI/GciErrSType.class.st b/src/GemStoneFFI/GciErrSType.class.st old mode 100644 new mode 100755 diff --git a/src/GemStoneFFI/GciError.class.st b/src/GemStoneFFI/GciError.class.st old mode 100644 new mode 100755 diff --git a/src/GemStoneFFI/GciInterface.class.st b/src/GemStoneFFI/GciInterface.class.st old mode 100644 new mode 100755 diff --git a/src/GemStoneFFI/GciLegacyInterface.class.st b/src/GemStoneFFI/GciLegacyInterface.class.st old mode 100644 new mode 100755 diff --git a/src/GemStoneFFI/GciThreadSafeInterface.class.st b/src/GemStoneFFI/GciThreadSafeInterface.class.st old mode 100644 new mode 100755 diff --git a/src/GemStoneFFI/GciTsObjInfo.class.st b/src/GemStoneFFI/GciTsObjInfo.class.st old mode 100644 new mode 100755 diff --git a/src/GemStoneFFI/GciTypes.class.st b/src/GemStoneFFI/GciTypes.class.st old mode 100644 new mode 100755 diff --git a/src/GemStoneFFI/GsExternalByteString.class.st b/src/GemStoneFFI/GsExternalByteString.class.st old mode 100644 new mode 100755 diff --git a/src/GemStoneFFI/GsMemoryTracker.class.st b/src/GemStoneFFI/GsMemoryTracker.class.st old mode 100644 new mode 100755 diff --git a/src/GemStoneFFI/GsNetworkResource.class.st b/src/GemStoneFFI/GsNetworkResource.class.st old mode 100644 new mode 100755 diff --git a/src/GemStoneFFI/GsSession.class.st b/src/GemStoneFFI/GsSession.class.st old mode 100644 new mode 100755 diff --git a/src/GemStoneFFI/GsSessionParameters.class.st b/src/GemStoneFFI/GsSessionParameters.class.st old mode 100644 new mode 100755 diff --git a/src/GemStoneFFI/GsVersionError.class.st b/src/GemStoneFFI/GsVersionError.class.st old mode 100644 new mode 100755 diff --git a/src/GemStoneFFI/SmallInteger.extension.st b/src/GemStoneFFI/SmallInteger.extension.st old mode 100644 new mode 100755 diff --git a/src/GemStoneFFI/package.st b/src/GemStoneFFI/package.st old mode 100644 new mode 100755 From faebf5d036d0b1f470382036dc728e0132f33c76 Mon Sep 17 00:00:00 2001 From: "Norm.Green" Date: Sun, 22 Dec 2024 17:53:10 -0800 Subject: [PATCH 7/8] Merge feenk issue 13 --- src/GemStoneFFI/FFICalloutAPI.extension.st | 0 src/GemStoneFFI/GciErrSType.class.st | 0 src/GemStoneFFI/GciError.class.st | 0 src/GemStoneFFI/GciInterface.class.st | 45 ++++++++++++++++++- src/GemStoneFFI/GciLegacyInterface.class.st | 0 .../GciThreadSafeInterface.class.st | 32 ++++++------- src/GemStoneFFI/GciTsObjInfo.class.st | 0 src/GemStoneFFI/GciTypes.class.st | 0 src/GemStoneFFI/GsExternalByteString.class.st | 0 src/GemStoneFFI/GsMemoryTracker.class.st | 0 src/GemStoneFFI/GsNetworkResource.class.st | 0 src/GemStoneFFI/GsSession.class.st | 0 src/GemStoneFFI/GsSessionParameters.class.st | 0 src/GemStoneFFI/GsVersionError.class.st | 0 src/GemStoneFFI/SmallInteger.extension.st | 0 src/GemStoneFFI/package.st | 0 16 files changed, 60 insertions(+), 17 deletions(-) mode change 100755 => 100644 src/GemStoneFFI/FFICalloutAPI.extension.st mode change 100755 => 100644 src/GemStoneFFI/GciErrSType.class.st mode change 100755 => 100644 src/GemStoneFFI/GciError.class.st mode change 100755 => 100644 src/GemStoneFFI/GciInterface.class.st mode change 100755 => 100644 src/GemStoneFFI/GciLegacyInterface.class.st mode change 100755 => 100644 src/GemStoneFFI/GciThreadSafeInterface.class.st mode change 100755 => 100644 src/GemStoneFFI/GciTsObjInfo.class.st mode change 100755 => 100644 src/GemStoneFFI/GciTypes.class.st mode change 100755 => 100644 src/GemStoneFFI/GsExternalByteString.class.st mode change 100755 => 100644 src/GemStoneFFI/GsMemoryTracker.class.st mode change 100755 => 100644 src/GemStoneFFI/GsNetworkResource.class.st mode change 100755 => 100644 src/GemStoneFFI/GsSession.class.st mode change 100755 => 100644 src/GemStoneFFI/GsSessionParameters.class.st mode change 100755 => 100644 src/GemStoneFFI/GsVersionError.class.st mode change 100755 => 100644 src/GemStoneFFI/SmallInteger.extension.st mode change 100755 => 100644 src/GemStoneFFI/package.st diff --git a/src/GemStoneFFI/FFICalloutAPI.extension.st b/src/GemStoneFFI/FFICalloutAPI.extension.st old mode 100755 new mode 100644 diff --git a/src/GemStoneFFI/GciErrSType.class.st b/src/GemStoneFFI/GciErrSType.class.st old mode 100755 new mode 100644 diff --git a/src/GemStoneFFI/GciError.class.st b/src/GemStoneFFI/GciError.class.st old mode 100755 new mode 100644 diff --git a/src/GemStoneFFI/GciInterface.class.st b/src/GemStoneFFI/GciInterface.class.st old mode 100755 new mode 100644 index 8ae77d5..210e84d --- a/src/GemStoneFFI/GciInterface.class.st +++ b/src/GemStoneFFI/GciInterface.class.st @@ -9,6 +9,8 @@ Class { 'gsLibraryPath' ], #classVars : [ + 'FfiMutex', + 'GciLastVersionUsed', 'GemStoneLibraryDirectory' ], #pools : [ @@ -182,6 +184,12 @@ GciInterface class >> gemstoneLibraryPathFromEnv [ ^Smalltalk os environment at: self gemstoneLibraryEnvVarName ifAbsent:[ nil ] ] +{ #category : 'initialize' } +GciInterface class >> initialize [ + +FfiMutex := Mutex new. +] + { #category : 'subclassresponsibility' } GciInterface class >> isThreadSafe [ ^self subclassResponsibility @@ -210,7 +218,7 @@ GciInterface class >> libraryDirectory: aDirString [ Note that this is NOT the same as a $GEMSTONE product tree. aDirString should not end with a trailing directory separator, which is removed if present." GemStoneLibraryDirectory := aDirString trimRight:[ :char| char == self separator] . - +self initialize . GsSession initialize. ] @@ -269,6 +277,21 @@ GciInterface class >> oopTrue [ ^ 268 ] +{ #category : 'initialize' } +GciInterface class >> resetFfiMethods [ + "Reset the FFI methods to their non-compiled form to force them to be reinitialised with the current library version" + + Stdio stdout << 'GciInterface: resetFfiMethods'; lf. + Transcript crShow: 'GciInterface: resetFfiMethods' . + self package classes do: [ :cls | + cls methods do: [ :cm | + (cm hasProperty: #ffiNonCompiledMethod) ifTrue: + [ cm methodClass methodDict + at: cm selector + put: (cm propertyAt: #ffiNonCompiledMethod) ] ] ]. + +] + { #category : 'convenience' } GciInterface class >> separator [ @@ -291,6 +314,16 @@ GciInterface class >> vmMemoryModel [ ^Smalltalk vm is64bit ifTrue:[ 64 ] ifFalse:[ 32 ] ] +{ #category : 'private' } +GciInterface >> checkFfiLibraryVersion [ +"Check the current library version loaded. +If it is different to the receiver's, reset the ffi methods." + + (gsVersionString = GciLastVersionUsed) ifFalse: + [ self class resetFfiMethods. + GciLastVersionUsed := gsVersionString ] +] + { #category : 'converting' } GciInterface >> convertStringToExternalArgOrNull: byteString memoryTracker: tracker [ @@ -298,6 +331,16 @@ GciInterface >> convertStringToExternalArgOrNull: byteString memoryTracker: trac ^self class convertStringToExternalArgOrNull: byteString memoryTracker: tracker ] +{ #category : 'accessing' } +GciInterface >> ffiDo: aBlock [ + "Evaluate aBlock within the FFI mutex, ensuring that multiple processes don't simultaneously attempt to make calls with different versions" + + ^ FfiMutex critical: + [ self checkFfiLibraryVersion. + aBlock value ] + +] + { #category : 'accessing' } GciInterface >> gsLibraryPath [ ^ gsLibraryPath diff --git a/src/GemStoneFFI/GciLegacyInterface.class.st b/src/GemStoneFFI/GciLegacyInterface.class.st old mode 100755 new mode 100644 diff --git a/src/GemStoneFFI/GciThreadSafeInterface.class.st b/src/GemStoneFFI/GciThreadSafeInterface.class.st old mode 100755 new mode 100644 index edc3ad3..c20e312 --- a/src/GemStoneFFI/GciThreadSafeInterface.class.st +++ b/src/GemStoneFFI/GciThreadSafeInterface.class.st @@ -110,7 +110,7 @@ Raises an error if the remote execute fails or if the result of the remote execu memoryTracker: tracker. gsError := GciErrSType externalNew. tracker add: gsError. - gciResult := self + gciResult := self ffiDo:[ self gciTsExecute_: session sourceString: srcCstring getHandle sourceStringSize: srcCstring sizeNoNull @@ -119,7 +119,7 @@ Raises an error if the remote execute fails or if the result of the remote execu symbolList: self class oopNil flags: 0 envId: 0 - gsError: gsError getHandle. + gsError: gsError getHandle ]. gciResult == self class oopIllegal ifTrue:[ ^ GciError newForError: gsError tracker: tracker ]. result := self class asLocalObject: gciResult. @@ -139,14 +139,14 @@ GciThreadSafeInterface >> doFetchResultByteObject: oop maxResultSize: maxSize tr tracker add: gsError. objInfo := GciTsObjInfo externalNew. tracker add: objInfo. - gciResult := self + gciResult := self ffiDo:[ self gciTsFetchObjInfo: session object: oop addToExportSet: 0 resultInfo: objInfo getHandle resultBuffer: resultBuffer getHandle resultBufferSize: resultBuffer size - gsError: gsError getHandle. + gsError: gsError getHandle ]. self checkGciResult: gciResult gsError: gsError tracker: tracker. self checkSpaceForBufferSize: maxSize @@ -197,14 +197,14 @@ tracker := GsMemoryTracker new. srcCstring := self convertStringToExternalArgOrNull: sourceString memoryTracker: tracker. gsError := tracker add: GciErrSType externalNew . -result := self gciTsNbExecute: session +result := self ffiDo:[ self gciTsNbExecute: session sourceString: srcCstring getHandle sourceOop: self class OOP_CLASS_STRING contextObject: self class oopNil symbolList: self class oopNil flags: self class GCI_PERFORM_DETACH envId: 0 - gsError: gsError. + gsError: gsError ]. result ~~ 1 ifTrue:[ ^ GciError newForError: gsError tracker: tracker ]. tracker freeAll. ^ true @@ -238,7 +238,7 @@ maxSize." (GsExternalByteString newWithNull: maxSize). gsError := tracker add: GciErrSType externalNew. - gciResult := self + gciResult := self ffiDo:[ self gciTsExecuteFetchBytes: session sourceString: srcCstring getHandle sourceStringSize: srcCstring sizeNoNull @@ -247,7 +247,7 @@ maxSize." symbolList: self class oopNil resultBuffer: resultBuffer getHandle resultBufferSize: resultBuffer size - gsError: gsError. + gsError: gsError ]. self checkGciResult: gciResult gsError: gsError tracker: tracker. self checkSpaceForBufferSize: maxSize @@ -288,14 +288,14 @@ tracker := GsMemoryTracker new. srcCstring := self convertStringToExternalArgOrNull: sourceString memoryTracker: tracker. gsError := tracker add: GciErrSType externalNew . -result := self gciTsNbExecute: session +result := self ffiDo:[ self gciTsNbExecute: session sourceString: srcCstring getHandle sourceOop: self class OOP_CLASS_STRING contextObject: self class oopNil symbolList: self class oopNil flags: 0 envId: 0 - gsError: gsError. + gsError: gsError ]. result ~~ 1 ifTrue:[ ^ GciError newForError: gsError tracker: tracker ]. tracker freeAll. ^ true @@ -425,7 +425,7 @@ tracker := GsMemoryTracker new. resultBuffer := tracker add: (GsExternalByteString newWithNull: bufSize). "Result is the GciProduct type, which is always 3 (not interesting)." -self gciTsVersion: resultBuffer getHandle bufferSize: bufSize. +self ffiDo:[ self gciTsVersion: resultBuffer getHandle bufferSize: bufSize ]. "Save result string so we can free the buffer on the C heap" result := resultBuffer asByteString . tracker freeAll. @@ -450,7 +450,7 @@ GciThreadSafeInterface >> getNbCallStatusWithMaxDelay: delayMs [ |tracker result gsError| tracker := GsMemoryTracker new. gsError := tracker add: GciErrSType externalNew . -result := self gciTsNbPoll: session timeoutMs: delayMs gsError: gsError. +result := self ffiDo:[ self gciTsNbPoll: session timeoutMs: delayMs gsError: gsError ]. result == -1 ifTrue:[ ^ GciError newForError: gsError tracker: tracker ]. tracker freeAll. @@ -489,7 +489,7 @@ exHaltOnErrNum := 0. exBoolPtr := FFIInt32 newBuffer . gsError := tracker add: GciErrSType externalNew . "result is a GsSession (void *)" -result := self gciTsLoginToStone: exStnNrs getHandle +result := self ffiDo:[self gciTsLoginToStone: exStnNrs getHandle hostUserId: exHostId getHandle hostPassword: exHostPw getHandle hostPwIsEncrypted: exHostPwEnc @@ -499,7 +499,7 @@ result := self gciTsLoginToStone: exStnNrs getHandle loginFlags: exLoginFlags haltOnErrorNum: exHaltOnErrNum executedSessInit: exBoolPtr - err: gsError getHandle . + err: gsError getHandle ]. result isNull ifTrue:[ ^ GciError newForError: gsError tracker: tracker ]. session := result. tracker freeAll. @@ -527,7 +527,7 @@ self isLoggedIn ifFalse:[ tracker := GsMemoryTracker new. gsError := tracker add: GciErrSType externalNew . -self gciTsNbLogout: session gsError: gsError . +self ffiDo:[ self gciTsNbLogout: session gsError: gsError ]. session := nil. tracker freeAll. ^true @@ -554,7 +554,7 @@ self isLoggedIn ifFalse:[ tracker := GsMemoryTracker new. gsError := tracker add: GciErrSType externalNew . -result := self gciTsLogout: session gsError: gsError . +result := self ffiDo:[ self gciTsLogout: session gsError: gsError ]. session := nil. ((result == 1) or:[ noError]) ifTrue:[ tracker freeAll. diff --git a/src/GemStoneFFI/GciTsObjInfo.class.st b/src/GemStoneFFI/GciTsObjInfo.class.st old mode 100755 new mode 100644 diff --git a/src/GemStoneFFI/GciTypes.class.st b/src/GemStoneFFI/GciTypes.class.st old mode 100755 new mode 100644 diff --git a/src/GemStoneFFI/GsExternalByteString.class.st b/src/GemStoneFFI/GsExternalByteString.class.st old mode 100755 new mode 100644 diff --git a/src/GemStoneFFI/GsMemoryTracker.class.st b/src/GemStoneFFI/GsMemoryTracker.class.st old mode 100755 new mode 100644 diff --git a/src/GemStoneFFI/GsNetworkResource.class.st b/src/GemStoneFFI/GsNetworkResource.class.st old mode 100755 new mode 100644 diff --git a/src/GemStoneFFI/GsSession.class.st b/src/GemStoneFFI/GsSession.class.st old mode 100755 new mode 100644 diff --git a/src/GemStoneFFI/GsSessionParameters.class.st b/src/GemStoneFFI/GsSessionParameters.class.st old mode 100755 new mode 100644 diff --git a/src/GemStoneFFI/GsVersionError.class.st b/src/GemStoneFFI/GsVersionError.class.st old mode 100755 new mode 100644 diff --git a/src/GemStoneFFI/SmallInteger.extension.st b/src/GemStoneFFI/SmallInteger.extension.st old mode 100755 new mode 100644 diff --git a/src/GemStoneFFI/package.st b/src/GemStoneFFI/package.st old mode 100755 new mode 100644 From e9dd3119510c46ef91f721b0448e5d42a683afdb Mon Sep 17 00:00:00 2001 From: "Norm.Green" Date: Sun, 22 Dec 2024 17:54:26 -0800 Subject: [PATCH 8/8] Remove FFICalloutAPI.extension.st --- src/GemStoneFFI/FFICalloutAPI.extension.st | 34 ------------------- src/GemStoneFFI/GciErrSType.class.st | 0 src/GemStoneFFI/GciError.class.st | 0 src/GemStoneFFI/GciInterface.class.st | 0 src/GemStoneFFI/GciLegacyInterface.class.st | 0 .../GciThreadSafeInterface.class.st | 0 src/GemStoneFFI/GciTsObjInfo.class.st | 0 src/GemStoneFFI/GciTypes.class.st | 0 src/GemStoneFFI/GsExternalByteString.class.st | 0 src/GemStoneFFI/GsMemoryTracker.class.st | 0 src/GemStoneFFI/GsNetworkResource.class.st | 0 src/GemStoneFFI/GsSession.class.st | 0 src/GemStoneFFI/GsSessionParameters.class.st | 0 src/GemStoneFFI/GsVersionError.class.st | 0 src/GemStoneFFI/SmallInteger.extension.st | 0 src/GemStoneFFI/package.st | 0 16 files changed, 34 deletions(-) delete mode 100644 src/GemStoneFFI/FFICalloutAPI.extension.st mode change 100644 => 100755 src/GemStoneFFI/GciErrSType.class.st mode change 100644 => 100755 src/GemStoneFFI/GciError.class.st mode change 100644 => 100755 src/GemStoneFFI/GciInterface.class.st mode change 100644 => 100755 src/GemStoneFFI/GciLegacyInterface.class.st mode change 100644 => 100755 src/GemStoneFFI/GciThreadSafeInterface.class.st mode change 100644 => 100755 src/GemStoneFFI/GciTsObjInfo.class.st mode change 100644 => 100755 src/GemStoneFFI/GciTypes.class.st mode change 100644 => 100755 src/GemStoneFFI/GsExternalByteString.class.st mode change 100644 => 100755 src/GemStoneFFI/GsMemoryTracker.class.st mode change 100644 => 100755 src/GemStoneFFI/GsNetworkResource.class.st mode change 100644 => 100755 src/GemStoneFFI/GsSession.class.st mode change 100644 => 100755 src/GemStoneFFI/GsSessionParameters.class.st mode change 100644 => 100755 src/GemStoneFFI/GsVersionError.class.st mode change 100644 => 100755 src/GemStoneFFI/SmallInteger.extension.st mode change 100644 => 100755 src/GemStoneFFI/package.st diff --git a/src/GemStoneFFI/FFICalloutAPI.extension.st b/src/GemStoneFFI/FFICalloutAPI.extension.st deleted file mode 100644 index 508d90c..0000000 --- a/src/GemStoneFFI/FFICalloutAPI.extension.st +++ /dev/null @@ -1,34 +0,0 @@ -Extension { #name : 'FFICalloutAPI' } - -{ #category : '*GemStoneFFI' } -FFICalloutAPI >> function: functionSignature library: moduleNameOrLibrary [ - - | sender ffiMethod ffiMethodSelector | - sender := self senderContext. - ffiMethodSelector := self uFFIEnterMethodSelector. "Build new method" - ffiMethod := self newBuilder build: [ :builder | - builder - signature: functionSignature; - sender: sender; - library: moduleNameOrLibrary ]. - ffiMethod - selector: sender selector; - methodClass: sender methodClass. "Replace with generated ffi method, but save old one for future use" - ffiMethod - propertyAt: #ffiNonCompiledMethod - put: (sender methodClass methodDict at: sender selector). "For senders search, one need to keep the selector in the properties" - ffiMethod propertyAt: #ffiMethodSelector put: ffiMethodSelector. - "Norm Green: Disable replacing our FFI compiled method for GCI libraries, otherwise the moduleNameOrLibrary arg is ignored after the first invocation - and Pharo caches the function pointer in the new compile method. - This becomes a problem when we change GCI versions and the wrong GCI library is called! - If there's a better way to do this I'd love to know about it." - ( '*libgci*' match: moduleNameOrLibrary asFFILibrary libraryName) - ifFalse:[ - sender methodClass methodDict at: sender selector put: ffiMethod. - FFIMethodRegistry uniqueInstance registerMethod: ffiMethod . - ]. - - sender return: - (sender receiver withArgs: sender arguments executeMethod: ffiMethod). - ^ self -] diff --git a/src/GemStoneFFI/GciErrSType.class.st b/src/GemStoneFFI/GciErrSType.class.st old mode 100644 new mode 100755 diff --git a/src/GemStoneFFI/GciError.class.st b/src/GemStoneFFI/GciError.class.st old mode 100644 new mode 100755 diff --git a/src/GemStoneFFI/GciInterface.class.st b/src/GemStoneFFI/GciInterface.class.st old mode 100644 new mode 100755 diff --git a/src/GemStoneFFI/GciLegacyInterface.class.st b/src/GemStoneFFI/GciLegacyInterface.class.st old mode 100644 new mode 100755 diff --git a/src/GemStoneFFI/GciThreadSafeInterface.class.st b/src/GemStoneFFI/GciThreadSafeInterface.class.st old mode 100644 new mode 100755 diff --git a/src/GemStoneFFI/GciTsObjInfo.class.st b/src/GemStoneFFI/GciTsObjInfo.class.st old mode 100644 new mode 100755 diff --git a/src/GemStoneFFI/GciTypes.class.st b/src/GemStoneFFI/GciTypes.class.st old mode 100644 new mode 100755 diff --git a/src/GemStoneFFI/GsExternalByteString.class.st b/src/GemStoneFFI/GsExternalByteString.class.st old mode 100644 new mode 100755 diff --git a/src/GemStoneFFI/GsMemoryTracker.class.st b/src/GemStoneFFI/GsMemoryTracker.class.st old mode 100644 new mode 100755 diff --git a/src/GemStoneFFI/GsNetworkResource.class.st b/src/GemStoneFFI/GsNetworkResource.class.st old mode 100644 new mode 100755 diff --git a/src/GemStoneFFI/GsSession.class.st b/src/GemStoneFFI/GsSession.class.st old mode 100644 new mode 100755 diff --git a/src/GemStoneFFI/GsSessionParameters.class.st b/src/GemStoneFFI/GsSessionParameters.class.st old mode 100644 new mode 100755 diff --git a/src/GemStoneFFI/GsVersionError.class.st b/src/GemStoneFFI/GsVersionError.class.st old mode 100644 new mode 100755 diff --git a/src/GemStoneFFI/SmallInteger.extension.st b/src/GemStoneFFI/SmallInteger.extension.st old mode 100644 new mode 100755 diff --git a/src/GemStoneFFI/package.st b/src/GemStoneFFI/package.st old mode 100644 new mode 100755