[squeak-dev] FFI: FFI-Pools-monty.6.mczcommits at source.squeak.org commits at source.squeak.orgWed May 27 14:48:18 UTC 2020
Marcel Taeumel uploaded a new version of FFI-Pools to project FFI: http://source.squeak.org/FFI/FFI-Pools-monty.6.mcz ==================== Summary ==================== Name: FFI-Pools-monty.6 Author: monty Time: 29 March 2018, 4:08:57.771498 am UUID: 30ba575f-ea24-0d00-8ca3-7a300bae9894 Ancestors: FFI-Pools-monty.5 use #compilerClass for Squeak compatibility =============== Diff against FFI-Pools-TorstenBergmann.4 =============== Item was added: + ----- Method: Boolean class>>ffiSharedPoolGenerateOutputCodeFor:with: (in category '*FFI-Pools') ----- + ffiSharedPoolGenerateOutputCodeFor: aPoolVariableName with: aProgramGenerator + aProgramGenerator emitBooleanOutputCodeFor: aPoolVariableName! Item was added: + ----- Method: Character class>>ffiSharedPoolGenerateOutputCodeFor:with: (in category '*FFI-Pools') ----- + ffiSharedPoolGenerateOutputCodeFor: aPoolVariableName with: aProgramGenerator + aProgramGenerator emitCharacterOutputCodeFor: aPoolVariableName! Item was added: + ----- Method: Class>>asFFISharedPoolType (in category '*FFI-Pools') ----- + asFFISharedPoolType + ^ self! Item was added: + SharedPool subclass: #FFISharedPool + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI-Pools'! + FFISharedPool class + instanceVariableNames: 'lastPlatform'! + + !FFISharedPool commentStamp: 'monty 3/25/2018 03:57' prior: 0! + This is a base class for FFI SharedPools that use the output of automatically generated C programs to initialize their pool variables.! + FFISharedPool class + instanceVariableNames: 'lastPlatform'! Item was added: + ----- Method: FFISharedPool class>>compileGeneratedSourceFile:to:forDefinition: (in category 'private') ----- + compileGeneratedSourceFile: aSourcePathString to: aProgramPathString forDefinition: aDefinition + self + executeExternalCommand: '{1} {2} {3} {4}' + format: + {aDefinition cCompiler. + aDefinition cFlags. + aProgramPathString. + aSourcePathString} + description: 'compile generated source code'! Item was added: + ----- Method: FFISharedPool class>>definitions (in category 'accessing') ----- + definitions + | definitions | + + definitions := + OrderedCollection with: + (FFISharedPoolDefinition fromClass: self). + + self class methodsDo: [:each | + (each pragmaAt: #ffiSharedPool) + ifNotNil: [ + definitions addLast: + (FFISharedPoolDefinition fromMethod: each)]]. + + ^ definitions asArray.! Item was added: + ----- Method: FFISharedPool class>>ensureDirectoryExists: (in category 'private') ----- + ensureDirectoryExists: aDirectoryPath + ^ self environment + at: #FileDirectory + ifPresent: [:fileDirectory | + "use Squeak's FileDirectory" + fileDirectory default assureExistenceOfPath: aDirectoryPath] + ifAbsent: [ + "use Pharo's FileSystem" + aDirectoryPath asFileReference ensureCreateDirectory]! Item was added: + ----- Method: FFISharedPool class>>errorFailedCommandTo: (in category 'private') ----- + errorFailedCommandTo: aDescription + self error: 'Command executed to ', aDescription, ' failed'! Item was added: + ----- Method: FFISharedPool class>>errorOSProcessRequiredTo: (in category 'private') ----- + errorOSProcessRequiredTo: aDescription + self error: + 'The OSProcess library is needed to execute command to ', aDescription! Item was added: + ----- Method: FFISharedPool class>>errorSavedPlatform:isNotCompatibleWith: (in category 'private') ----- + errorSavedPlatform: aSavedPlatform isNotCompatibleWith: aCurrentPlatform + self error: + ('The saved platform is incompatible with the current platform: {1} ~= {2}' + format: {aSavedPlatform. aCurrentPlatform})! Item was added: + ----- Method: FFISharedPool class>>executeExternalCommand:description: (in category 'private') ----- + executeExternalCommand: aCommandString description: aDescription + | commandProcess | + + commandProcess := + (self environment + at: #OSProcess + ifAbsent: [self errorOSProcessRequiredTo: aDescription]) + waitForCommand: aCommandString. + commandProcess succeeded + ifFalse: [self errorFailedCommandTo: aDescription].! Item was added: + ----- Method: FFISharedPool class>>executeExternalCommand:format:description: (in category 'private') ----- + executeExternalCommand: aString format: aCollection description: aDescription + ^ self + executeExternalCommand: (aString format: aCollection) + description: aDescription! Item was added: + ----- Method: FFISharedPool class>>generateAllPrograms (in category 'generating') ----- + generateAllPrograms + "self generateAllPrograms" + + self allSubclassesDo: [:each | + each generateProgram]! Item was added: + ----- Method: FFISharedPool class>>generateProgram (in category 'generating') ----- + generateProgram + "self generateProgram" + + | currentPlatform preferredDefinition sourceFilePath | + + currentPlatform := FFISharedPoolPlatform current. + preferredDefinition := + self preferredResolvedDefinitionForPlatform: currentPlatform. + sourceFilePath := self generatedSourceFilePath. + + self ensureDirectoryExists: self generatedProgramDirectory. + self + generateSourceFile: sourceFilePath + forDefinition: preferredDefinition. + self + compileGeneratedSourceFile: sourceFilePath + to: self generatedProgramPath + forDefinition: preferredDefinition.! Item was added: + ----- Method: FFISharedPool class>>generateSourceFile:forDefinition: (in category 'private') ----- + generateSourceFile: aSourceFilePath forDefinition: aDefinition + self + writeStreamOnNewFileAt: aSourceFilePath + do: [:writeStream | + aDefinition generateProgramOn: writeStream]! Item was added: + ----- Method: FFISharedPool class>>generatedProgramDirectory (in category 'defaults') ----- + generatedProgramDirectory + ^ self vmPath, 'FFISharedPools/'! Item was added: + ----- Method: FFISharedPool class>>generatedProgramExtension (in category 'defaults') ----- + generatedProgramExtension + ^ FFISharedPoolPlatform isCurrentlyWindows + ifTrue: ['.exe'] + ifFalse: ['']! Item was added: + ----- Method: FFISharedPool class>>generatedProgramName (in category 'defaults') ----- + generatedProgramName + ^ self name asString, self generatedProgramExtension! Item was added: + ----- Method: FFISharedPool class>>generatedProgramPath (in category 'defaults') ----- + generatedProgramPath + ^ self generatedProgramDirectory, self generatedProgramName! Item was added: + ----- Method: FFISharedPool class>>generatedSourceFileExtension (in category 'defaults') ----- + generatedSourceFileExtension + ^ '.c'! Item was added: + ----- Method: FFISharedPool class>>generatedSourceFileName (in category 'defaults') ----- + generatedSourceFileName + ^ self name asString, self generatedSourceFileExtension! Item was added: + ----- Method: FFISharedPool class>>generatedSourceFilePath (in category 'defaults') ----- + generatedSourceFilePath + ^ self generatedProgramDirectory, self generatedSourceFileName! Item was added: + ----- Method: FFISharedPool class>>initialize (in category 'class initialization') ----- + initialize + "self initialize" + + self reinitializeAllSubclassesFromGeneratedProgramOutput! Item was added: + ----- Method: FFISharedPool class>>lastPlatform (in category 'accessing') ----- + lastPlatform + ^ lastPlatform! Item was added: + ----- Method: FFISharedPool class>>lastPlatform: (in category 'accessing') ----- + lastPlatform: aPlatform + lastPlatform := aPlatform! Item was added: + ----- Method: FFISharedPool class>>outputFileExtension (in category 'defaults') ----- + outputFileExtension + ^ '.st'! Item was added: + ----- Method: FFISharedPool class>>outputFileName (in category 'defaults') ----- + outputFileName + ^ self name asString, self outputFileExtension! Item was added: + ----- Method: FFISharedPool class>>outputFilePath (in category 'defaults') ----- + outputFilePath + ^ self generatedProgramDirectory, self outputFileName! Item was added: + ----- Method: FFISharedPool class>>preferredResolvedDefinitionForPlatform: (in category 'accessing') ----- + preferredResolvedDefinitionForPlatform: aPlatform + | compatibleResolvedDefinitions | + + compatibleResolvedDefinitions := + self resolvedDefinitions select: [:each | + each platform isCompatibleWith: aPlatform]. + + compatibleResolvedDefinitions sort: [:a :b | + a isMorePlatformSpecificThan: b]. + + ^ compatibleResolvedDefinitions first.! Item was added: + ----- Method: FFISharedPool class>>readAndEvaluatedGeneratedProgramOutput (in category 'reading') ----- + readAndEvaluatedGeneratedProgramOutput + | generatedProgramOutput | + + generatedProgramOutput := + [self readGeneratedProgramOutput] + on: FileDoesNotExistException + do: [:error | nil]. + "try again, this time running the program first to create the output file" + generatedProgramOutput + ifNil: [ + generatedProgramOutput := + self + runGeneratedProgram; + readGeneratedProgramOutput]. + + ^ self compilerClass evaluate: generatedProgramOutput.! Item was added: + ----- Method: FFISharedPool class>>readGeneratedProgramOutput (in category 'private') ----- + readGeneratedProgramOutput + ^ self + readStreamOnExistingFileAt: self outputFilePath + do: [:readStream | + readStream upToEnd]! Item was added: + ----- Method: FFISharedPool class>>readStreamOnExistingFileAt:do: (in category 'private') ----- + readStreamOnExistingFileAt: aPathString do: aBlock + | readStream | + + readStream := StandardFileStream readOnlyFileNamed: aPathString. + ^ [ + readStream ascii. + aBlock value: readStream] + ensure: [readStream close].! Item was added: + ----- Method: FFISharedPool class>>reinitializeAllSubclassesFromGeneratedProgramOutput (in category 'class initialization') ----- + reinitializeAllSubclassesFromGeneratedProgramOutput + | currentPlatform | + + currentPlatform := FFISharedPoolPlatform current. + self allSubclassesDo: [:each | + each reinitializeFromGeneratedProgramOutputForPlatform: + currentPlatform].! Item was added: + ----- Method: FFISharedPool class>>reinitializeFromGeneratedProgramOutput (in category 'class initialization') ----- + reinitializeFromGeneratedProgramOutput + "self reinitializeFromGeneratedProgramOutput" + + self reinitializeFromGeneratedProgramOutputForPlatform: + FFISharedPoolPlatform current! Item was added: + ----- Method: FFISharedPool class>>reinitializeFromGeneratedProgramOutputForPlatform: (in category 'class initialization') ----- + reinitializeFromGeneratedProgramOutputForPlatform: aPlatform + | outputArray outputPlatform outputVariableDictionary | + + outputArray := + self readAndEvaluatedGeneratedProgramOutput. + outputPlatform := outputArray first. + outputVariableDictionary := outputArray second. + + (outputPlatform isCompatibleWith: aPlatform) + ifFalse: [ + self + errorSavedPlatform: outputPlatform + isNotCompatibleWith: aPlatform]. + + outputVariableDictionary keysAndValuesDo: [:key :value | + self classPool + at: key + put: value]. + + self lastPlatform: aPlatform.! Item was added: + ----- Method: FFISharedPool class>>resolvedDefinitions (in category 'accessing') ----- + resolvedDefinitions + ^ (FFISharedPoolDefinitionResolver + class: self + definitions: self definitions) resolvedDefinitions! Item was added: + ----- Method: FFISharedPool class>>runGeneratedProgram (in category 'running') ----- + runGeneratedProgram + "self runGeneratedProgram" + + self + executeExternalCommand: 'cd {1}; ./{2} {3}' + format: + {self generatedProgramDirectory. + self generatedProgramName. + self outputFilePath} + description: 'run generated program'! Item was added: + ----- Method: FFISharedPool class>>startUp: (in category 'system startup') ----- + startUp: isResuming + isResuming + ifTrue: [| currentPlatform | + currentPlatform := FFISharedPoolPlatform current. + self allSubclassesDo: [:each | + each lastPlatform = currentPlatform + ifFalse: [ + each reinitializeFromGeneratedProgramOutputForPlatform: + currentPlatform]]] + ifFalse: [self reinitializeAllSubclassesFromGeneratedProgramOutput]! Item was added: + ----- Method: FFISharedPool class>>vmPath (in category 'defaults') ----- + vmPath + ^ (Smalltalk respondsTo: #vmPath) + ifTrue: [ + "for Squeak" + Smalltalk vmPath] + ifFalse: [ + "for Pharo" + Smalltalk vm path]! Item was added: + ----- Method: FFISharedPool class>>writeStreamOnNewFileAt:do: (in category 'private') ----- + writeStreamOnNewFileAt: aPathString do: aBlock + | writeStream | + + "use #forceNewFileNamed: to ensure truncation of existing files before writing" + writeStream := StandardFileStream forceNewFileNamed: aPathString. + ^ [ + writeStream ascii. + aBlock value: writeStream] + ensure: [writeStream close].! Item was added: + Object subclass: #FFISharedPoolDefinition + instanceVariableNames: 'name inheritsFrom variablesAndTypes platform cFlags cCompiler cHeaders programGeneratorClass' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI-Pools'! + + !FFISharedPoolDefinition commentStamp: 'monty 3/29/2018 03:36' prior: 0! + This class stores parsed FFISharedPool definitions. It can inherit from another definition with #inheritFrom:, and generate a program with #generateProgramOn:. + + The supported pragmas for methods defining FFISharedPools are in the "pragmas" category.! Item was added: + ----- Method: FFISharedPoolDefinition class>>defaultCCompiler (in category 'defaults') ----- + defaultCCompiler + ^ 'cc'! Item was added: + ----- Method: FFISharedPoolDefinition class>>defaultCFlags (in category 'defaults') ----- + defaultCFlags + ^ '-o'! Item was added: + ----- Method: FFISharedPoolDefinition class>>defaultCHeaders (in category 'defaults') ----- + defaultCHeaders + ^ #()! Item was added: + ----- Method: FFISharedPoolDefinition class>>defaultPlatform (in category 'defaults') ----- + defaultPlatform + ^ FFISharedPoolPlatform empty! Item was added: + ----- Method: FFISharedPoolDefinition class>>defaultProgramGeneratorClass (in category 'defaults') ----- + defaultProgramGeneratorClass + ^ FFISharedPoolProgramGenerator! Item was added: + ----- Method: FFISharedPoolDefinition class>>defaultVariableType (in category 'defaults') ----- + defaultVariableType + ^ Integer! Item was added: + ----- Method: FFISharedPoolDefinition class>>fromClass: (in category 'instance creation') ----- + fromClass: aClass + | definition | + + (definition := self new) + cCompiler: self defaultCCompiler; + cFlags: self defaultCFlags; + cHeaders: self defaultCHeaders; + platform: self defaultPlatform; + programGeneratorClass: self defaultProgramGeneratorClass. + + aClass classPool keysDo: [:each | + definition + variablesAndTypesAt: each + put: self defaultVariableType]. + + ^ definition.! Item was added: + ----- Method: FFISharedPoolDefinition class>>fromMethod: (in category 'instance creation') ----- + fromMethod: aCompiledMethod + | definition | + + definition := self name: aCompiledMethod selector. + + "Squeak does not have #pragmasDo:" + aCompiledMethod pragmas do: [:each | + (self whichCategoryIncludesSelector: each keyword) == #'pragmas' + ifTrue: [ + definition + perform: each keyword + withArguments: each arguments]]. + + ^ definition.! Item was added: + ----- Method: FFISharedPoolDefinition class>>name: (in category 'instance creation') ----- + name: aSelector + ^ self new name: aSelector! Item was added: + ----- Method: FFISharedPoolDefinition>>cCompiler (in category 'accessing') ----- + cCompiler + ^ cCompiler ifNil: [cCompiler := '']! Item was added: + ----- Method: FFISharedPoolDefinition>>cCompiler: (in category 'accessing') ----- + cCompiler: aString + cCompiler := aString! Item was added: + ----- Method: FFISharedPoolDefinition>>cFlags (in category 'accessing') ----- + cFlags + ^ cFlags ifNil: [cFlags := '']! Item was added: + ----- Method: FFISharedPoolDefinition>>cFlags: (in category 'accessing') ----- + cFlags: aString + cFlags := aString! Item was added: + ----- Method: FFISharedPoolDefinition>>cHeaders (in category 'accessing') ----- + cHeaders + ^ cHeaders ifNil: [cHeaders := #()]! Item was added: + ----- Method: FFISharedPoolDefinition>>cHeaders: (in category 'accessing') ----- + cHeaders: aHeaderPathCollection + cHeaders := + aHeaderPathCollection asArray + select: [:each | each notEmpty] + thenCollect: [:each | + (each first == $" + or: [each first == $<]) + ifTrue: [each] + ifFalse: ['<', each, '>']]! Item was added: + ----- Method: FFISharedPoolDefinition>>cHeadersDo: (in category 'enumerating') ----- + cHeadersDo: aBlock + self cHeaders do: aBlock! Item was added: + ----- Method: FFISharedPoolDefinition>>ffiCCompiler: (in category 'pragmas') ----- + ffiCCompiler: aString + self cCompiler: aString! Item was added: + ----- Method: FFISharedPoolDefinition>>ffiCFlags: (in category 'pragmas') ----- + ffiCFlags: aString + self cFlags: aString! Item was added: + ----- Method: FFISharedPoolDefinition>>ffiCHeaders: (in category 'pragmas') ----- + ffiCHeaders: aHeaderPathCollection + self cHeaders: aHeaderPathCollection! Item was added: + ----- Method: FFISharedPoolDefinition>>ffiInheritsFrom: (in category 'pragmas') ----- + ffiInheritsFrom: aSelector + self inheritsFrom: aSelector! Item was added: + ----- Method: FFISharedPoolDefinition>>ffiPlatformName: (in category 'pragmas') ----- + ffiPlatformName: aName + self platform: + (FFISharedPoolPlatform name: aName)! Item was added: + ----- Method: FFISharedPoolDefinition>>ffiPlatformName:osVersion: (in category 'pragmas') ----- + ffiPlatformName: aName osVersion: anOSVersionString + self platform: + (FFISharedPoolPlatform + name: aName + osVersion: anOSVersionString)! Item was added: + ----- Method: FFISharedPoolDefinition>>ffiPlatformName:osVersion:subtype: (in category 'pragmas') ----- + ffiPlatformName: aName osVersion: anOSVersionString subtype: aSubtypeString + self platform: + (FFISharedPoolPlatform + name: aName + osVersion: anOSVersionString + subtype: aSubtypeString)! Item was added: + ----- Method: FFISharedPoolDefinition>>ffiPlatformName:osVersion:subtype:wordSize: (in category 'pragmas') ----- + ffiPlatformName: aName osVersion: anOSVersionString subtype: aSubtypeString wordSize: aWordSize + self platform: + (FFISharedPoolPlatform + name: aName + osVersion: anOSVersionString + subtype: aSubtypeString + wordSize: aWordSize)! Item was added: + ----- Method: FFISharedPoolDefinition>>ffiPlatformName:wordSize: (in category 'pragmas') ----- + ffiPlatformName: aName wordSize: aWordSize + self platform: + (FFISharedPoolPlatform + name: aName + wordSize: aWordSize)! Item was added: + ----- Method: FFISharedPoolDefinition>>ffiProgramGeneratorClass: (in category 'pragmas') ----- + ffiProgramGeneratorClass: aClass + self programGeneratorClass: aClass! Item was added: + ----- Method: FFISharedPoolDefinition>>ffiSharedPool (in category 'pragmas') ----- + ffiSharedPool! Item was added: + ----- Method: FFISharedPoolDefinition>>ffiVariable:type: (in category 'pragmas') ----- + ffiVariable: aVariableName type: aType + self + variablesAndTypesAt: aVariableName + put: aType! Item was added: + ----- Method: FFISharedPoolDefinition>>generateProgramOn: (in category 'generating') ----- + generateProgramOn: aStream + (self programGeneratorClass + on: aStream + definition: self) generate! Item was added: + ----- Method: FFISharedPoolDefinition>>inheritFrom: (in category 'inheriting') ----- + inheritFrom: aDefinition + self cCompiler + ifEmpty: [self cCompiler: aDefinition cCompiler]. + self cFlags + ifEmpty: [self cFlags: aDefinition cFlags]. + self cHeaders + ifEmpty: [self cHeaders: aDefinition cHeaders]. + self platform + ifNil: [self platform: aDefinition platform]. + self programGeneratorClass + ifNil: [self programGeneratorClass: aDefinition programGeneratorClass]. + + aDefinition variablesAndTypesDo: [:key :value | + self + variablesAndTypesAt: key + ifAbsentPut: value].! Item was added: + ----- Method: FFISharedPoolDefinition>>inheritsFrom (in category 'accessing') ----- + inheritsFrom + ^ inheritsFrom! Item was added: + ----- Method: FFISharedPoolDefinition>>inheritsFrom: (in category 'accessing') ----- + inheritsFrom: aSelector + inheritsFrom := aSelector! Item was added: + ----- Method: FFISharedPoolDefinition>>isDefault (in category 'testing') ----- + isDefault + ^ self name isNil! Item was added: + ----- Method: FFISharedPoolDefinition>>isMorePlatformSpecificThan: (in category 'testing') ----- + isMorePlatformSpecificThan: aDefinition + ^ aDefinition isDefault + or: [self platform isMoreSpecificThan: aDefinition platform]! Item was added: + ----- Method: FFISharedPoolDefinition>>name (in category 'accessing') ----- + name + ^ name! Item was added: + ----- Method: FFISharedPoolDefinition>>name: (in category 'accessing') ----- + name: aSelector + name := aSelector! Item was added: + ----- Method: FFISharedPoolDefinition>>platform (in category 'accessing') ----- + platform + ^ platform! Item was added: + ----- Method: FFISharedPoolDefinition>>platform: (in category 'accessing') ----- + platform: aPlatform + platform := aPlatform! Item was added: + ----- Method: FFISharedPoolDefinition>>printOn: (in category 'printing') ----- + printOn: aStream + super printOn: aStream. + + aStream nextPut: $(. + self isDefault + ifTrue: [aStream nextPutAll: 'default'] + ifFalse: [aStream print: self name]. + aStream nextPut: $).! Item was added: + ----- Method: FFISharedPoolDefinition>>programGeneratorClass (in category 'accessing') ----- + programGeneratorClass + ^ programGeneratorClass! Item was added: + ----- Method: FFISharedPoolDefinition>>programGeneratorClass: (in category 'accessing') ----- + programGeneratorClass: aClass + programGeneratorClass := aClass! Item was added: + ----- Method: FFISharedPoolDefinition>>variablesAndTypes (in category 'accessing') ----- + variablesAndTypes + ^ variablesAndTypes ifNil: [variablesAndTypes := Dictionary new]! Item was added: + ----- Method: FFISharedPoolDefinition>>variablesAndTypes: (in category 'accessing') ----- + variablesAndTypes: anAssociationCollection + variablesAndTypes := Dictionary new. + anAssociationCollection associationsDo: [:each | + self + variablesAndTypesAt: each key + put: each value].! Item was added: + ----- Method: FFISharedPoolDefinition>>variablesAndTypesAt: (in category 'accessing') ----- + variablesAndTypesAt: aVaraibleName + ^ self + variablesAndTypesAt: aVaraibleName + ifAbsent: [nil]! Item was added: + ----- Method: FFISharedPoolDefinition>>variablesAndTypesAt:ifAbsent: (in category 'accessing') ----- + variablesAndTypesAt: aVaraibleName ifAbsent: aBlock + ^ self variablesAndTypes + at: aVaraibleName asSymbol + ifAbsent: aBlock! Item was added: + ----- Method: FFISharedPoolDefinition>>variablesAndTypesAt:ifAbsentPut: (in category 'accessing') ----- + variablesAndTypesAt: aVaraibleName ifAbsentPut: aBlock + ^ self + variablesAndTypesAt: aVaraibleName + ifAbsent: [ + self + variablesAndTypesAt: aVaraibleName + put: aBlock value]! Item was added: + ----- Method: FFISharedPoolDefinition>>variablesAndTypesAt:put: (in category 'accessing') ----- + variablesAndTypesAt: aVaraibleName put: aClassOrNil + ^ self variablesAndTypes + at: aVaraibleName asSymbol + put: aClassOrNil asFFISharedPoolType! Item was added: + ----- Method: FFISharedPoolDefinition>>variablesAndTypesDo: (in category 'enumerating') ----- + variablesAndTypesDo: aTwoArgumentBlock + self variablesAndTypes keysAndValuesDo: aTwoArgumentBlock! Item was added: + Object subclass: #FFISharedPoolDefinitionResolver + instanceVariableNames: 'class definitions definitionsByName defaultDefinition unresolvedDefinitions visitedDefintions' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI-Pools'! + + !FFISharedPoolDefinitionResolver commentStamp: 'monty 3/29/2018 03:37' prior: 0! + This class resolves FFISharedPoolDefinition inheritance dependencies.! Item was added: + ----- Method: FFISharedPoolDefinitionResolver class>>class:definitions: (in category 'instance creation') ----- + class: aClass definitions: aDefinitionCollection + ^ self new + setClass: aClass + definitions: aDefinitionCollection! Item was added: + ----- Method: FFISharedPoolDefinitionResolver>>errorLoopInDefinitions (in category 'private') ----- + errorLoopInDefinitions + self error: 'Class ', class name asString, ' has a loop in its definitions'! Item was added: + ----- Method: FFISharedPoolDefinitionResolver>>errorUnknownReferenceInDefinition: (in category 'private') ----- + errorUnknownReferenceInDefinition: aDefinition + self error: + ('Unknown reference to definition #{1} in definition #{2} from class {3}' + format: {aDefinition inheritsFrom. aDefinition name. class name})! Item was added: + ----- Method: FFISharedPoolDefinitionResolver>>resolveDefinition: (in category 'private') ----- + resolveDefinition: aDefinition + aDefinition inheritsFrom + ifNil: [aDefinition inheritFrom: defaultDefinition] + ifNotNil: [:inheritsFrom | | inheritedDefinition | + inheritedDefinition := + definitionsByName + at: inheritsFrom + ifAbsent: [self errorUnknownReferenceInDefinition: aDefinition]. + + (visitedDefintions includes: inheritedDefinition) + ifTrue: [self errorLoopInDefinitions]. + visitedDefintions add: inheritedDefinition. + + (unresolvedDefinitions includes: inheritedDefinition) + ifTrue: [self resolveDefinition: inheritedDefinition]. + + aDefinition inheritFrom: inheritedDefinition]. + + unresolvedDefinitions remove: aDefinition.! Item was added: + ----- Method: FFISharedPoolDefinitionResolver>>resolvedDefinitions (in category 'accessing') ----- + resolvedDefinitions + [unresolvedDefinitions isEmpty] + whileFalse: [| definition | + definition := unresolvedDefinitions anyOne. + visitedDefintions := Set with: definition. + self resolveDefinition: definition]. + + ^ definitions.! Item was added: + ----- Method: FFISharedPoolDefinitionResolver>>setClass:definitions: (in category 'initialization') ----- + setClass: aClass definitions: aDefinitionCollection + class := aClass. + definitions := aDefinitionCollection. + definitionsByName := Dictionary new. + unresolvedDefinitions := Set new. + definitions do: [:each | + each isDefault + ifTrue: [defaultDefinition := each] + ifFalse: [ + definitionsByName + at: each name + put: each. + unresolvedDefinitions add: each]].! Item was added: + Object subclass: #FFISharedPoolPlatform + instanceVariableNames: 'name osVersion subtype wordSize' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI-Pools'! + + !FFISharedPoolPlatform commentStamp: 'monty 3/25/2018 04:31' prior: 0! + A class for storing the platform information for an FFISharedPool! Item was added: + ----- Method: FFISharedPoolPlatform class>>current (in category 'instance creation') ----- + current + ^ self + name: self currentName + osVersion: self currentOSVersion + subtype: self currentSubtype + wordSize: self currentWordSize! Item was added: + ----- Method: FFISharedPoolPlatform class>>currentName (in category 'accessing') ----- + currentName + "self currentName" + + ^ Smalltalk os platformName! Item was added: + ----- Method: FFISharedPoolPlatform class>>currentOSVersion (in category 'accessing') ----- + currentOSVersion + "self currentOSVersion" + + "'Smalltalk os version' and 'Smalltalk osVersion' are not portable to Pharo. + On Squeak: + Smalltalk osVersion = (Smalltalk getSystemAttribute: 1002) asString" + ^ (Smalltalk getSystemAttribute: 1002) asString! Item was added: + ----- Method: FFISharedPoolPlatform class>>currentSubtype (in category 'accessing') ----- + currentSubtype + "self currentSubtype" + + "'Smalltalk platformSubtype' is not portable to Pharo. + On Squeak: + Smalltalk platformSubtype = (Smalltalk getSystemAttribute: 1003) asString" + ^ (Smalltalk getSystemAttribute: 1003) asString! Item was added: + ----- Method: FFISharedPoolPlatform class>>currentWordSize (in category 'accessing') ----- + currentWordSize + "self currentWordSize" + + ^ Smalltalk wordSize! Item was added: + ----- Method: FFISharedPoolPlatform class>>empty (in category 'instance creation') ----- + empty + ^ self new! Item was added: + ----- Method: FFISharedPoolPlatform class>>isCurrentlyWindows (in category 'testing') ----- + isCurrentlyWindows + ^ self currentName asLowercase beginsWith: 'win'! Item was added: + ----- Method: FFISharedPoolPlatform class>>name: (in category 'instance creation') ----- + name: aName + ^ self new name: aName! Item was added: + ----- Method: FFISharedPoolPlatform class>>name:osVersion: (in category 'instance creation') ----- + name: aName osVersion: anOSVersionString + ^ self new + name: aName; + osVersion: anOSVersionString! Item was added: + ----- Method: FFISharedPoolPlatform class>>name:osVersion:subtype: (in category 'instance creation') ----- + name: aName osVersion: anOSVersionString subtype: aSubtypeString + ^ self new + name: aName; + osVersion: anOSVersionString; + subtype: aSubtypeString! Item was added: + ----- Method: FFISharedPoolPlatform class>>name:osVersion:subtype:wordSize: (in category 'instance creation') ----- + name: aName osVersion: anOSVersionString subtype: aSubtypeString wordSize: aWordSize + ^ self new + name: aName; + osVersion: anOSVersionString; + subtype: aSubtypeString; + wordSize: aWordSize! Item was added: + ----- Method: FFISharedPoolPlatform class>>name:wordSize: (in category 'instance creation') ----- + name: aName wordSize: aWordSize + ^ self new + name: aName; + wordSize: aWordSize! Item was added: + ----- Method: FFISharedPoolPlatform>>= (in category 'comparing') ----- + = anObject + self == anObject + ifTrue: [^ true]. + + self species == anObject species + ifFalse: [^ false]. + + ^ self name = anObject name + and: [self osVersion = anObject osVersion + and: [self subtype = anObject subtype + and: [self wordSize = anObject wordSize]]].! Item was added: + ----- Method: FFISharedPoolPlatform>>hasName (in category 'testing') ----- + hasName + ^ self name notEmpty! Item was added: + ----- Method: FFISharedPoolPlatform>>hasOSVersion (in category 'testing') ----- + hasOSVersion + ^ self osVersion notEmpty! Item was added: + ----- Method: FFISharedPoolPlatform>>hasSubtype (in category 'testing') ----- + hasSubtype + ^ self subtype notEmpty! Item was added: + ----- Method: FFISharedPoolPlatform>>hasWordSize (in category 'testing') ----- + hasWordSize + ^ self wordSize notNil! Item was added: + ----- Method: FFISharedPoolPlatform>>hash (in category 'comparing') ----- + hash + ^ (((self species hash bitXor: + self name hash) bitXor: + self osVersion hash) bitXor: + self subtype hash) bitXor: + self wordSize hash! Item was added: + ----- Method: FFISharedPoolPlatform>>isCompatibleWith: (in category 'testing') ----- + isCompatibleWith: aPlatform + self == aPlatform + ifTrue: [^ true]. + + (self name = aPlatform name + or: [self hasName not + or: [aPlatform hasName not]]) + ifFalse: [^ false]. + + (self osVersion = aPlatform osVersion + or: [self hasOSVersion not + or: [aPlatform hasOSVersion not]]) + ifFalse: [^ false]. + + (self subtype = aPlatform subtype + or: [self hasSubtype not + or: [aPlatform hasSubtype not]]) + ifFalse: [^ false]. + + (self wordSize = aPlatform wordSize + or: [self hasWordSize not + or: [aPlatform hasWordSize not]]) + ifFalse: [^ false]. + + ^ true.! Item was added: + ----- Method: FFISharedPoolPlatform>>isMoreSpecificThan: (in category 'testing') ----- + isMoreSpecificThan: aPlatform + self == aPlatform + ifTrue: [^ false]. + + (self hasName + and: [aPlatform hasName not]) + ifTrue: [^ true]. + + (self hasOSVersion + and: [aPlatform hasOSVersion not]) + ifTrue: [^ true]. + + (self hasSubtype + and: [aPlatform hasSubtype not]) + ifTrue: [^ true]. + + (self hasWordSize + and: [aPlatform hasWordSize not]) + ifTrue: [^ true]. + + ^ false.! Item was added: + ----- Method: FFISharedPoolPlatform>>name (in category 'accessing') ----- + name + ^ name ifNil: [name := '']! Item was added: + ----- Method: FFISharedPoolPlatform>>name: (in category 'accessing') ----- + name: aName + name := aName! Item was added: + ----- Method: FFISharedPoolPlatform>>osVersion (in category 'accessing') ----- + osVersion + ^ osVersion ifNil: [osVersion := '']! Item was added: + ----- Method: FFISharedPoolPlatform>>osVersion: (in category 'accessing') ----- + osVersion: anOSVersionString + osVersion := anOSVersionString! Item was added: + ----- Method: FFISharedPoolPlatform>>printOn: (in category 'printing') ----- + printOn: aStream + self storeOn: aStream! Item was added: + ----- Method: FFISharedPoolPlatform>>storeOn: (in category 'printing') ----- + storeOn: aStream + aStream + nextPut: $(; + nextPutAll: self class name asString; + nextPutAll: ' name: '; + print: self name; + nextPutAll: ' osVersion: '; + print: self osVersion; + nextPutAll: ' subtype: '; + print: self subtype; + nextPutAll: ' wordSize: '; + print: self wordSize; + nextPut: $).! Item was added: + ----- Method: FFISharedPoolPlatform>>subtype (in category 'accessing') ----- + subtype + ^ subtype ifNil: [subtype := '']! Item was added: + ----- Method: FFISharedPoolPlatform>>subtype: (in category 'accessing') ----- + subtype: aSubtypeString + subtype := aSubtypeString! Item was added: + ----- Method: FFISharedPoolPlatform>>wordSize (in category 'accessing') ----- + wordSize + ^ wordSize! Item was added: + ----- Method: FFISharedPoolPlatform>>wordSize: (in category 'accessing') ----- + wordSize: aWordSize + wordSize := aWordSize! Item was added: + Object subclass: #FFISharedPoolProgramGenerator + instanceVariableNames: 'stream definition' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI-Pools'! + + !FFISharedPoolProgramGenerator commentStamp: 'monty 3/28/2018 03:11' prior: 0! + This class generates a program to output an evaluable Smalltalk representation of an FFISharedPoolDefinition.! Item was added: + ----- Method: FFISharedPoolProgramGenerator class>>new (in category 'instance creation') ----- + new + self shouldNotImplement! Item was added: + ----- Method: FFISharedPoolProgramGenerator class>>on:definition: (in category 'instance creation') ----- + on: aStream definition: aDefinition + ^ self basicNew initialize + setStream: aStream + definition: aDefinition ! Item was added: + ----- Method: FFISharedPoolProgramGenerator>>contents (in category 'accessing') ----- + contents + ^ self stream contents! Item was added: + ----- Method: FFISharedPoolProgramGenerator>>defaultHeaders (in category 'defaults') ----- + defaultHeaders + ^ #('<errno.h>' '<stdarg.h>' '<stddef.h>' '<stdio.h>' '<stdlib.h>' '<string.h>')! Item was added: + ----- Method: FFISharedPoolProgramGenerator>>definition (in category 'accessing') ----- + definition + ^ definition! Item was added: + ----- Method: FFISharedPoolProgramGenerator>>emit: (in category 'emitting') ----- + emit: aCharacter + self stream nextPut: aCharacter! Item was added: + ----- Method: FFISharedPoolProgramGenerator>>emitAll: (in category 'emitting') ----- + emitAll: aString + self stream nextPutAll: aString asString! Item was added: + ----- Method: FFISharedPoolProgramGenerator>>emitAll:format: (in category 'emitting') ----- + emitAll: aTemplateString format: aSequenceableCollectionOrDictionary + "works similar to String>>#format:, except it uses '${xxx}' syntax + for macro expansion, which is more convenient for C" + + | templateReadStream | + + templateReadStream := aTemplateString asString readStream. + [templateReadStream atEnd] + whileFalse: [| nextChar | + ((nextChar := templateReadStream next) == $$ + and: [templateReadStream peekFor: ${]) + ifTrue: [| key | + key := templateReadStream upTo: $}. + self emitAll: + (aSequenceableCollectionOrDictionary at: + (aSequenceableCollectionOrDictionary isDictionary + ifTrue: [key] + ifFalse: [key asUnsignedInteger])) asString] + ifFalse: [self emit: nextChar]].! Item was added: + ----- Method: FFISharedPoolProgramGenerator>>emitBooleanOutputCodeFor: (in category 'emitting - output code') ----- + emitBooleanOutputCodeFor: anIdentifier + self + emitAll: '${1}(file, "(%s)", (${2} ? "true" : "false"))' + format: {self printfFunctionName. anIdentifier}! Item was added: + ----- Method: FFISharedPoolProgramGenerator>>emitCharacterOutputCodeFor: (in category 'emitting - output code') ----- + emitCharacterOutputCodeFor: anIdentifier + self + emitAll: '${1}(file, "(%ul asCharacter)", (unsigned long) ((${2} < 0) ? 0 : ${2}))' + format: {self printfFunctionName. anIdentifier}! Item was added: + ----- Method: FFISharedPoolProgramGenerator>>emitEndMainFunctionDefinition (in category 'emitting - function definitions') ----- + emitEndMainFunctionDefinition + self + emitAll: + ' + if (file !!= stdout) { + if (fclose(file) !!= 0) { + ${1}("Can''t close file", errno); + return EXIT_FAILURE; + } + } + + return EXIT_SUCCESS; + } + ' format: {self errorFunctionName}! Item was added: + ----- Method: FFISharedPoolProgramGenerator>>emitEndOutputCode (in category 'emitting - output code') ----- + emitEndOutputCode + self + emitAll: + ' ${1}(file, "}\n"); + ' + format: {self printfFunctionName} + ! Item was added: + ----- Method: FFISharedPoolProgramGenerator>>emitEpilog (in category 'emitting') ----- + emitEpilog + self emitEndMainFunctionDefinition! Item was added: + ----- Method: FFISharedPoolProgramGenerator>>emitErrorFunctionDefinition (in category 'emitting - function definitions') ----- + emitErrorFunctionDefinition + self + emitAll: ' + static void ${1}(const char *message, int error) + { + fprintf(stderr, "%s: %s\n", message, strerror(error)); + ${2} + } + ' + format: { + self errorFunctionName. + self generatedProgramExitsOnError + ifTrue: ['exit(EXIT_FAILURE);'] + ifFalse: ['/* no exit on error */']}! Item was added: + ----- Method: FFISharedPoolProgramGenerator>>emitFileComment (in category 'emitting') ----- + emitFileComment + self + emitAll: '/* + * This file was automatically generated by ${1}. + * ''${2}'' + * ''${3}'' + */ + + ' + format: {self class name. DateAndTime now. Smalltalk version}! Item was added: + ----- Method: FFISharedPoolProgramGenerator>>emitFloatOutputCodeFor: (in category 'emitting - output code') ----- + emitFloatOutputCodeFor: anIdentifier + self + emitAll: '${1}(file, "(Float ffiSharedPoolReadFrom: ''%Lg'')", (long double) ${2})' + format: {self printfFunctionName. anIdentifier}! Item was added: + ----- Method: FFISharedPoolProgramGenerator>>emitFunctionDefinitions (in category 'emitting - function definitions') ----- + emitFunctionDefinitions + self + emitErrorFunctionDefinition; + emitPrintfFunctionDefinition; + emitPutcFunctionDefinition; + emitStringOutputFunctionDefinition! Item was added: + ----- Method: FFISharedPoolProgramGenerator>>emitHeader: (in category 'emitting - headers') ----- + emitHeader: aHeaderPath + self + emitAll: '#include ${1} + ' + format: {aHeaderPath}! Item was added: + ----- Method: FFISharedPoolProgramGenerator>>emitHeaders (in category 'emitting - headers') ----- + emitHeaders + self defaultHeaders do: [:each | + self emitHeader: each]. + self definition cHeadersDo: [:each | + self emitHeader: each].! Item was added: + ----- Method: FFISharedPoolProgramGenerator>>emitIntegerOutputCodeFor: (in category 'emitting - output code') ----- + emitIntegerOutputCodeFor: anIdentifier + self + emitAll: '${1}(file, "(%ld)", (long) ${2})' + format: {self printfFunctionName. anIdentifier}! Item was added: + ----- Method: FFISharedPoolProgramGenerator>>emitOutputCode (in category 'emitting - output code') ----- + emitOutputCode + self + emitStartOutputCode; + emitPlatformOutputCode; + emitVariableOutputCode; + emitEndOutputCode! Item was added: + ----- Method: FFISharedPoolProgramGenerator>>emitPlatformOutputCode (in category 'emitting - output code') ----- + emitPlatformOutputCode + self + emitAll: + ' ${1}(file, "\t%s.\n", + ' + format: {self printfFunctionName}. + "serialize the store string as a C string literal with proper escaping" + self + emitStringLiteral: self definition platform storeString; + emitAll: '); + '. + ! Item was added: + ----- Method: FFISharedPoolProgramGenerator>>emitPrintfFunctionDefinition (in category 'emitting - function definitions') ----- + emitPrintfFunctionDefinition + self + emitAll: ' + static int ${1}(FILE *file, const char *format, ...) + { + va_list ap; + int rv; + + va_start(ap, format); + if ((rv = vfprintf(file, format, ap)) >= 0) { + va_end(ap); + } else { + int err = errno; /* save errno */ + va_end(ap); + ${2}("Can''t print to file", err); + } + + return rv; + } + ' + format: {self printfFunctionName. self errorFunctionName}! Item was added: + ----- Method: FFISharedPoolProgramGenerator>>emitProlog (in category 'emitting') ----- + emitProlog + self + emitFileComment; + emitHeaders; + emitFunctionDefinitions; + emitStartMainFunctionDefinition! Item was added: + ----- Method: FFISharedPoolProgramGenerator>>emitPutcFunctionDefinition (in category 'emitting - function definitions') ----- + emitPutcFunctionDefinition + self + emitAll: ' + static int ${1}(int c, FILE *file) + { + int rv; + + if ((rv = fputc(c, file)) == EOF) + ${2}("Can''t print to file", errno); + + return rv; + } + ' + format: {self putcFunctionName. self errorFunctionName}! Item was added: + ----- Method: FFISharedPoolProgramGenerator>>emitStartMainFunctionDefinition (in category 'emitting - function definitions') ----- + emitStartMainFunctionDefinition + self + emitAll: ' + int main(int argc, char *argv[]) + { + FILE *file; + + if (argc > 1) { + if ((file = fopen(argv[1], "wb")) == NULL) { + ${1}("Can''t open file", errno); + return EXIT_FAILURE; + } + } else { + file = stdout; + } + + ' + format: {self errorFunctionName}! Item was added: + ----- Method: FFISharedPoolProgramGenerator>>emitStartOutputCode (in category 'emitting - output code') ----- + emitStartOutputCode + self + emitAll: + ' ${1}(file, "{\n"); + ' + format: {self printfFunctionName}! Item was added: + ----- Method: FFISharedPoolProgramGenerator>>emitStringLiteral: (in category 'emitting') ----- + emitStringLiteral: aString + self emit: $". + aString do: [:each | + (each == $" + or: [each == $\]) + ifTrue: [self emit: $\]. + self emit: each]. + self emit: $".! Item was added: + ----- Method: FFISharedPoolProgramGenerator>>emitStringOutputCodeFor: (in category 'emitting - output code') ----- + emitStringOutputCodeFor: anIdentifier + self + emitAll: '${1}(file, ${2})' + format: {self stringOutputFunctionName. anIdentifier}! Item was added: + ----- Method: FFISharedPoolProgramGenerator>>emitStringOutputFunctionDefinition (in category 'emitting - function definitions') ----- + emitStringOutputFunctionDefinition + self + emitAll: ' + static void ${1}(FILE *file, const char *s) + { + ${2}(file, "(''"); + while (*s !!= ''\0'') { + if (*s == ''\'''') + ${3}(''\'''', file); /* escape the subquote */ + ${3}(*s++, file); + } + ${2}(file, "'')"); + } + ' + format: + {self stringOutputFunctionName. + self printfFunctionName. + self putcFunctionName}! Item was added: + ----- Method: FFISharedPoolProgramGenerator>>emitUnsignedIntegerOutputCodeFor: (in category 'emitting - output code') ----- + emitUnsignedIntegerOutputCodeFor: anIdentifier + self + emitAll: '${1}(file, "(%lu)", (unsigned long) ${2})' + format: {self printfFunctionName. anIdentifier}! Item was added: + ----- Method: FFISharedPoolProgramGenerator>>emitVariableOutputCode (in category 'emitting - output code') ----- + emitVariableOutputCode + | emittedVariableOutputCode | + + self + emitAll: + ' ${1}(file, "\tDictionary new\n"); + ' + format: {self printfFunctionName}. + + emittedVariableOutputCode := false. + self definition variablesAndTypesDo: [:key :value | + value + ifNotNil: [ + self + emitVariableOutputCodeFor: key + type: value. + emittedVariableOutputCode := true]]. + + emittedVariableOutputCode + ifTrue: [ + self + emitAll: + ' ${1}(file, "\t\tyourself\n"); + ' + format: {self printfFunctionName}].! Item was added: + ----- Method: FFISharedPoolProgramGenerator>>emitVariableOutputCodeFor:type: (in category 'emitting - output code') ----- + emitVariableOutputCodeFor: aVariableName type: aType + self + emitAll: + ' ${1}(file, "\t\tat: #%s put: ", "${2}"); + ' + format: {self printfFunctionName. aVariableName}. + + aType + ffiSharedPoolGenerateOutputCodeFor: aVariableName + with: self. + + self + emitAll: + '; + ${1}(file, ";\n"); + ' + format: {self printfFunctionName}.! Item was added: + ----- Method: FFISharedPoolProgramGenerator>>errorFunctionName (in category 'defaults') ----- + errorFunctionName + ^ self functionNamed: 'Error'! Item was added: + ----- Method: FFISharedPoolProgramGenerator>>functionNamed: (in category 'defaults') ----- + functionNamed: aPartialFunctionName + ^ self functionNamespace, aPartialFunctionName! Item was added: + ----- Method: FFISharedPoolProgramGenerator>>functionNamespace (in category 'defaults') ----- + functionNamespace + ^ 'ffiSharedPool'! Item was added: + ----- Method: FFISharedPoolProgramGenerator>>generate (in category 'generating') ----- + generate + self + emitProlog; + emitOutputCode; + emitEpilog! Item was added: + ----- Method: FFISharedPoolProgramGenerator>>generatedProgramExitsOnError (in category 'testing') ----- + generatedProgramExitsOnError + ^ true! Item was added: + ----- Method: FFISharedPoolProgramGenerator>>printfFunctionName (in category 'defaults') ----- + printfFunctionName + ^ self functionNamed: 'Printf'! Item was added: + ----- Method: FFISharedPoolProgramGenerator>>putcFunctionName (in category 'defaults') ----- + putcFunctionName + ^ self functionNamed: 'Putc'! Item was added: + ----- Method: FFISharedPoolProgramGenerator>>setStream:definition: (in category 'initialization') ----- + setStream: aStream definition: aDefinition + stream := aStream. + definition := aDefinition.! Item was added: + ----- Method: FFISharedPoolProgramGenerator>>stream (in category 'accessing') ----- + stream + ^ stream! Item was added: + ----- Method: FFISharedPoolProgramGenerator>>stringOutputFunctionName (in category 'defaults') ----- + stringOutputFunctionName + ^ self functionNamed: 'OutputString'! Item was added: + ----- Method: Float class>>ffiSharedPoolGenerateOutputCodeFor:with: (in category '*FFI-Pools') ----- + ffiSharedPoolGenerateOutputCodeFor: aPoolVariableName with: aProgramGenerator + aProgramGenerator emitFloatOutputCodeFor: aPoolVariableName! Item was added: + ----- Method: Float class>>ffiSharedPoolReadFrom: (in category '*FFI-Pools') ----- + ffiSharedPoolReadFrom: aStreamOrString + ^ self + ffiSharedPoolReadFrom: aStreamOrString + ifFail: [nil]! Item was added: + ----- Method: Float class>>ffiSharedPoolReadFrom:ifFail: (in category '*FFI-Pools') ----- + ffiSharedPoolReadFrom: aStreamOrString ifFail: aBlock + | readStream startPosition isNegative | + + readStream := + aStreamOrString isStream + ifTrue: [aStreamOrString] + ifFalse: [aStreamOrString readStream]. + startPosition := readStream position. + + (isNegative := readStream peekFor: $-) + ifFalse: [readStream peekFor: $+]. + + ((readStream nextMatchAll: 'infinity') + or: [(readStream nextMatchAll: 'INFINITY') + or: [(readStream nextMatchAll: 'inf') + or: [(readStream nextMatchAll: 'INF')]]]) + ifTrue: [ + ^ isNegative + ifTrue: [self negativeInfinity] + ifFalse: [self infinity]]. + + ((readStream nextMatchAll: 'nan') + or: [readStream nextMatchAll: 'NAN']) + ifTrue: [^ self nan]. + + readStream position: startPosition. + ^ self + readFrom: readStream + ifFail: aBlock.! Item was added: + ----- Method: Integer class>>ffiSharedPoolGenerateOutputCodeFor:with: (in category '*FFI-Pools') ----- + ffiSharedPoolGenerateOutputCodeFor: aPoolVariableName with: aProgramGenerator + aProgramGenerator emitIntegerOutputCodeFor: aPoolVariableName! Item was added: + ----- Method: LargePositiveInteger class>>ffiSharedPoolGenerateOutputCodeFor:with: (in category '*FFI-Pools') ----- + ffiSharedPoolGenerateOutputCodeFor: aPoolVariableName with: aProgramGenerator + aProgramGenerator emitUnsignedIntegerOutputCodeFor: aPoolVariableName! Item was added: + ----- Method: Object>>asFFISharedPoolType (in category '*FFI-Pools') ----- + asFFISharedPoolType + self error: 'Cannot convert object to type'! Item was added: + ----- Method: Object>>ffiSharedPoolGenerateOutputCodeFor:with: (in category '*FFI-Pools') ----- + ffiSharedPoolGenerateOutputCodeFor: aPoolVariableName with: aProgramGenerator + self error: 'Cannot generate output code for ', self class name asString! Item was added: + ----- Method: String class>>ffiSharedPoolGenerateOutputCodeFor:with: (in category '*FFI-Pools') ----- + ffiSharedPoolGenerateOutputCodeFor: aPoolVariableName with: aProgramGenerator + aProgramGenerator emitStringOutputCodeFor: aPoolVariableName! Item was added: + ----- Method: String>>asFFISharedPoolType (in category '*FFI-Pools') ----- + asFFISharedPoolType + ^ self class environment + at: self asSymbol + ifAbsent: [self error: 'Cannot convert object to type']! Item was added: + ----- Method: UndefinedObject>>asFFISharedPoolType (in category '*FFI-Pools') ----- + asFFISharedPoolType + ^ self!
More information about the Squeak-dev mailing list |