[squeak-dev] FFI: FFI-Pools-monty.9.mczcommits at source.squeak.org commits at source.squeak.orgWed May 27 14:52:24 UTC 2020
Marcel Taeumel uploaded a new version of FFI-Pools to project FFI: http://source.squeak.org/FFI/FFI-Pools-monty.9.mcz ==================== Summary ==================== Name: FFI-Pools-monty.9 Author: monty Time: 30 March 2018, 2:25:00.511178 am UUID: 22106a09-fd24-0d00-abe7-71ab0f24d7b0 Ancestors: FFI-Pools-monty.8 renamed every FFISharedPool* class to FFIExternalSharedPool to be more descriptive and avoid conflicting with OSSubProcess. Class comments, generated code prefixes, and the program directory name were also modified for consistency =============== Diff against FFI-Pools-monty.6 =============== Item was added: + ----- Method: Boolean class>>ffiExternalSharedPoolGenerateOutputCodeFor:with: (in category '*FFI-Pools') ----- + ffiExternalSharedPoolGenerateOutputCodeFor: aVariableName with: aProgramGenerator + aProgramGenerator emitBooleanOutputCodeFor: aVariableName! Item was removed: - ----- Method: Boolean class>>ffiSharedPoolGenerateOutputCodeFor:with: (in category '*FFI-Pools') ----- - ffiSharedPoolGenerateOutputCodeFor: aPoolVariableName with: aProgramGenerator - aProgramGenerator emitBooleanOutputCodeFor: aPoolVariableName! Item was added: + ----- Method: Character class>>ffiExternalSharedPoolGenerateOutputCodeFor:with: (in category '*FFI-Pools') ----- + ffiExternalSharedPoolGenerateOutputCodeFor: aVariableName with: aProgramGenerator + aProgramGenerator emitCharacterOutputCodeFor: aVariableName! Item was removed: - ----- Method: Character class>>ffiSharedPoolGenerateOutputCodeFor:with: (in category '*FFI-Pools') ----- - ffiSharedPoolGenerateOutputCodeFor: aPoolVariableName with: aProgramGenerator - aProgramGenerator emitCharacterOutputCodeFor: aPoolVariableName! Item was added: + ----- Method: Class>>asFFIExternalSharedPoolType (in category '*FFI-Pools') ----- + asFFIExternalSharedPoolType + ^ self! Item was removed: - ----- Method: Class>>asFFISharedPoolType (in category '*FFI-Pools') ----- - asFFISharedPoolType - ^ self! Item was added: + SharedPool subclass: #FFIExternalSharedPool + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI-Pools'! + FFIExternalSharedPool class + instanceVariableNames: 'lastPlatform'! + + !FFIExternalSharedPool commentStamp: 'monty 3/30/2018 02:00' prior: 0! + This is a base class for external FFI SharedPools that use the output of automatically generated C programs to initialize their pool variables.! + FFIExternalSharedPool class + instanceVariableNames: 'lastPlatform'! Item was added: + ----- Method: FFIExternalSharedPool 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: FFIExternalSharedPool class>>declareUndeclaredClassVariableNamed: (in category 'private') ----- + declareUndeclaredClassVariableNamed: aVariableName + (self respondsTo: #addClassVarNamed:) + ifTrue: [ + "for Pharo" + self addClassVarNamed: aVariableName] + ifFalse: [ + "for Squeak" + self addClassVarName: aVariableName]! Item was added: + ----- Method: FFIExternalSharedPool class>>definitionClass (in category 'defaults') ----- + definitionClass + ^ FFIExternalSharedPoolDefinition! Item was added: + ----- Method: FFIExternalSharedPool class>>definitionResolverClass (in category 'defaults') ----- + definitionResolverClass + ^ FFIExternalSharedPoolDefinitionResolver! Item was added: + ----- Method: FFIExternalSharedPool class>>definitions (in category 'accessing') ----- + definitions + | definitions | + + definitions := + OrderedCollection with: + (self definitionClass fromClass: self). + + self class methodsDo: [:each | + (each pragmaAt: #ffiExternalSharedPool) + ifNotNil: [ + definitions addLast: + (self definitionClass fromMethod: each)]]. + + ^ definitions asArray.! Item was added: + ----- Method: FFIExternalSharedPool 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: FFIExternalSharedPool class>>errorFailedCommandTo: (in category 'private') ----- + errorFailedCommandTo: aDescription + self error: 'Command executed to ', aDescription, ' failed'! Item was added: + ----- Method: FFIExternalSharedPool class>>errorOSProcessRequiredTo: (in category 'private') ----- + errorOSProcessRequiredTo: aDescription + self error: + 'The OSProcess library is needed to execute command to ', aDescription! Item was added: + ----- Method: FFIExternalSharedPool 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: FFIExternalSharedPool 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: FFIExternalSharedPool class>>executeExternalCommand:format:description: (in category 'private') ----- + executeExternalCommand: aString format: aCollection description: aDescription + ^ self + executeExternalCommand: (aString format: aCollection) + description: aDescription! Item was added: + ----- Method: FFIExternalSharedPool class>>generateAllPrograms (in category 'generating') ----- + generateAllPrograms + "self generateAllPrograms" + + self allSubclassesDo: [:each | + each generateProgram]! Item was added: + ----- Method: FFIExternalSharedPool class>>generateProgram (in category 'generating') ----- + generateProgram + "self generateProgram" + + | currentPlatform preferredDefinition sourceFilePath | + + currentPlatform := self platformClass 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: FFIExternalSharedPool class>>generateSourceFile:forDefinition: (in category 'private') ----- + generateSourceFile: aSourceFilePath forDefinition: aDefinition + self + writeStreamOnNewFileAt: aSourceFilePath + do: [:writeStream | + aDefinition generateProgramOn: writeStream]! Item was added: + ----- Method: FFIExternalSharedPool class>>generatedProgramDirectory (in category 'defaults') ----- + generatedProgramDirectory + ^ self vmPath, 'FFIExternalSharedPools/'! Item was added: + ----- Method: FFIExternalSharedPool class>>generatedProgramExtension (in category 'defaults') ----- + generatedProgramExtension + ^ self platformClass isCurrentlyWindows + ifTrue: ['.exe'] + ifFalse: ['']! Item was added: + ----- Method: FFIExternalSharedPool class>>generatedProgramName (in category 'defaults') ----- + generatedProgramName + ^ self name asString, self generatedProgramExtension! Item was added: + ----- Method: FFIExternalSharedPool class>>generatedProgramPath (in category 'defaults') ----- + generatedProgramPath + ^ self generatedProgramDirectory, self generatedProgramName! Item was added: + ----- Method: FFIExternalSharedPool class>>generatedSourceFileExtension (in category 'defaults') ----- + generatedSourceFileExtension + ^ '.c'! Item was added: + ----- Method: FFIExternalSharedPool class>>generatedSourceFileName (in category 'defaults') ----- + generatedSourceFileName + ^ self name asString, self generatedSourceFileExtension! Item was added: + ----- Method: FFIExternalSharedPool class>>generatedSourceFilePath (in category 'defaults') ----- + generatedSourceFilePath + ^ self generatedProgramDirectory, self generatedSourceFileName! Item was added: + ----- Method: FFIExternalSharedPool class>>initialize (in category 'class initialization') ----- + initialize + "self initialize" + + self reinitializeAllSubclassesFromGeneratedProgramOutput! Item was added: + ----- Method: FFIExternalSharedPool class>>lastPlatform (in category 'accessing') ----- + lastPlatform + ^ lastPlatform! Item was added: + ----- Method: FFIExternalSharedPool class>>lastPlatform: (in category 'accessing') ----- + lastPlatform: aPlatform + lastPlatform := aPlatform! Item was added: + ----- Method: FFIExternalSharedPool class>>outputFileExtension (in category 'defaults') ----- + outputFileExtension + ^ '.st'! Item was added: + ----- Method: FFIExternalSharedPool class>>outputFileName (in category 'defaults') ----- + outputFileName + ^ self name asString, self outputFileExtension! Item was added: + ----- Method: FFIExternalSharedPool class>>outputFilePath (in category 'defaults') ----- + outputFilePath + ^ self generatedProgramDirectory, self outputFileName! Item was added: + ----- Method: FFIExternalSharedPool class>>platformClass (in category 'defaults') ----- + platformClass + ^ FFIExternalSharedPoolPlatform! Item was added: + ----- Method: FFIExternalSharedPool 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: FFIExternalSharedPool 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: FFIExternalSharedPool class>>readGeneratedProgramOutput (in category 'private') ----- + readGeneratedProgramOutput + ^ self + readStreamOnExistingFileAt: self outputFilePath + do: [:readStream | + readStream upToEnd]! Item was added: + ----- Method: FFIExternalSharedPool 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: FFIExternalSharedPool class>>reinitializeAllSubclassesFromGeneratedProgramOutput (in category 'class initialization') ----- + reinitializeAllSubclassesFromGeneratedProgramOutput + | currentPlatform | + + currentPlatform := self platformClass current. + self allSubclassesDo: [:each | + each reinitializeFromGeneratedProgramOutputForPlatform: + currentPlatform].! Item was added: + ----- Method: FFIExternalSharedPool class>>reinitializeFromGeneratedProgramOutput (in category 'class initialization') ----- + reinitializeFromGeneratedProgramOutput + "self reinitializeFromGeneratedProgramOutput" + + self reinitializeFromGeneratedProgramOutputForPlatform: + self platformClass current! Item was added: + ----- Method: FFIExternalSharedPool class>>reinitializeFromGeneratedProgramOutputForPlatform: (in category 'class initialization') ----- + reinitializeFromGeneratedProgramOutputForPlatform: aPlatform + | outputArray outputPlatform outputVariableDictionary classVariableDictionary | + + outputArray := + self readAndEvaluatedGeneratedProgramOutput. + outputPlatform := outputArray first. + outputVariableDictionary := outputArray second. + + (outputPlatform isCompatibleWith: aPlatform) + ifFalse: [ + self + errorSavedPlatform: outputPlatform + isNotCompatibleWith: aPlatform]. + + classVariableDictionary := self classPool. + outputVariableDictionary keysAndValuesDo: [:key :value | + classVariableDictionary + at: key + ifAbsent: [self declareUndeclaredClassVariableNamed: key]. + classVariableDictionary + at: key + put: value]. + + self lastPlatform: aPlatform.! Item was added: + ----- Method: FFIExternalSharedPool class>>resolvedDefinitions (in category 'accessing') ----- + resolvedDefinitions + ^ (self definitionResolverClass + class: self + definitions: self definitions) resolvedDefinitions! Item was added: + ----- Method: FFIExternalSharedPool 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: FFIExternalSharedPool class>>startUp: (in category 'system startup') ----- + startUp: isResuming + isResuming + ifTrue: [| currentPlatform | + currentPlatform := self platformClass current. + self allSubclassesDo: [:each | + each lastPlatform = currentPlatform + ifFalse: [ + each reinitializeFromGeneratedProgramOutputForPlatform: + currentPlatform]]] + ifFalse: [self reinitializeAllSubclassesFromGeneratedProgramOutput]! Item was added: + ----- Method: FFIExternalSharedPool class>>vmPath (in category 'defaults') ----- + vmPath + ^ (Smalltalk respondsTo: #vmPath) + ifTrue: [ + "for Squeak" + Smalltalk vmPath] + ifFalse: [ + "for Pharo" + Smalltalk vm path]! Item was added: + ----- Method: FFIExternalSharedPool 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: #FFIExternalSharedPoolDefinition + instanceVariableNames: 'name inheritsFrom variablesAndTypes platform cFlags cCompiler cHeaders programGeneratorClass' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI-Pools'! + + !FFIExternalSharedPoolDefinition commentStamp: 'monty 3/30/2018 02:01' prior: 0! + This class stores parsed FFIExternalSharedPool definitions. It can inherit from another definition with #inheritFrom:, and generate a program with #generateProgramOn:. + + The supported pragmas for methods defining FFIExternalSharedPools are in the "pragmas" category.! Item was added: + ----- Method: FFIExternalSharedPoolDefinition class>>defaultCCompiler (in category 'defaults') ----- + defaultCCompiler + ^ 'cc'! Item was added: + ----- Method: FFIExternalSharedPoolDefinition class>>defaultCFlags (in category 'defaults') ----- + defaultCFlags + ^ '-o'! Item was added: + ----- Method: FFIExternalSharedPoolDefinition class>>defaultCHeaders (in category 'defaults') ----- + defaultCHeaders + ^ #()! Item was added: + ----- Method: FFIExternalSharedPoolDefinition class>>defaultPlatform (in category 'defaults') ----- + defaultPlatform + ^ self platformClass empty! Item was added: + ----- Method: FFIExternalSharedPoolDefinition class>>defaultProgramGeneratorClass (in category 'defaults') ----- + defaultProgramGeneratorClass + ^ FFIExternalSharedPoolProgramGenerator! Item was added: + ----- Method: FFIExternalSharedPoolDefinition class>>defaultVariableType (in category 'defaults') ----- + defaultVariableType + ^ Integer! Item was added: + ----- Method: FFIExternalSharedPoolDefinition 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: FFIExternalSharedPoolDefinition 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: FFIExternalSharedPoolDefinition class>>name: (in category 'instance creation') ----- + name: aSelector + ^ self new name: aSelector! Item was added: + ----- Method: FFIExternalSharedPoolDefinition class>>platformClass (in category 'defaults') ----- + platformClass + ^ FFIExternalSharedPoolPlatform! Item was added: + ----- Method: FFIExternalSharedPoolDefinition>>cCompiler (in category 'accessing') ----- + cCompiler + ^ cCompiler ifNil: [cCompiler := '']! Item was added: + ----- Method: FFIExternalSharedPoolDefinition>>cCompiler: (in category 'accessing') ----- + cCompiler: aString + cCompiler := aString! Item was added: + ----- Method: FFIExternalSharedPoolDefinition>>cFlags (in category 'accessing') ----- + cFlags + ^ cFlags ifNil: [cFlags := '']! Item was added: + ----- Method: FFIExternalSharedPoolDefinition>>cFlags: (in category 'accessing') ----- + cFlags: aString + cFlags := aString! Item was added: + ----- Method: FFIExternalSharedPoolDefinition>>cHeaders (in category 'accessing') ----- + cHeaders + ^ cHeaders ifNil: [cHeaders := #()]! Item was added: + ----- Method: FFIExternalSharedPoolDefinition>>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: FFIExternalSharedPoolDefinition>>cHeadersDo: (in category 'enumerating') ----- + cHeadersDo: aBlock + self cHeaders do: aBlock! Item was added: + ----- Method: FFIExternalSharedPoolDefinition>>ffiCCompiler: (in category 'pragmas') ----- + ffiCCompiler: aString + self cCompiler: aString! Item was added: + ----- Method: FFIExternalSharedPoolDefinition>>ffiCFlags: (in category 'pragmas') ----- + ffiCFlags: aString + self cFlags: aString! Item was added: + ----- Method: FFIExternalSharedPoolDefinition>>ffiCHeaders: (in category 'pragmas') ----- + ffiCHeaders: aHeaderPathCollection + self cHeaders: aHeaderPathCollection! Item was added: + ----- Method: FFIExternalSharedPoolDefinition>>ffiExternalSharedPool (in category 'pragmas') ----- + ffiExternalSharedPool + "this pragma identifies a method defining an external shared pool"! Item was added: + ----- Method: FFIExternalSharedPoolDefinition>>ffiInheritsFrom: (in category 'pragmas') ----- + ffiInheritsFrom: aSelector + self inheritsFrom: aSelector! Item was added: + ----- Method: FFIExternalSharedPoolDefinition>>ffiPlatformName: (in category 'pragmas') ----- + ffiPlatformName: aName + self platform: + (self platformClass name: aName)! Item was added: + ----- Method: FFIExternalSharedPoolDefinition>>ffiPlatformName:osVersion: (in category 'pragmas') ----- + ffiPlatformName: aName osVersion: anOSVersionString + self platform: + (self platformClass + name: aName + osVersion: anOSVersionString)! Item was added: + ----- Method: FFIExternalSharedPoolDefinition>>ffiPlatformName:osVersion:subtype: (in category 'pragmas') ----- + ffiPlatformName: aName osVersion: anOSVersionString subtype: aSubtypeString + self platform: + (self platformClass + name: aName + osVersion: anOSVersionString + subtype: aSubtypeString)! Item was added: + ----- Method: FFIExternalSharedPoolDefinition>>ffiPlatformName:osVersion:subtype:wordSize: (in category 'pragmas') ----- + ffiPlatformName: aName osVersion: anOSVersionString subtype: aSubtypeString wordSize: aWordSize + self platform: + (self platformClass + name: aName + osVersion: anOSVersionString + subtype: aSubtypeString + wordSize: aWordSize)! Item was added: + ----- Method: FFIExternalSharedPoolDefinition>>ffiPlatformName:wordSize: (in category 'pragmas') ----- + ffiPlatformName: aName wordSize: aWordSize + self platform: + (self platformClass + name: aName + wordSize: aWordSize)! Item was added: + ----- Method: FFIExternalSharedPoolDefinition>>ffiProgramGenerator: (in category 'pragmas') ----- + ffiProgramGenerator: aClassName + self programGeneratorClass: + (self class environment at: aClassName asSymbol)! Item was added: + ----- Method: FFIExternalSharedPoolDefinition>>ffiVariable:type: (in category 'pragmas') ----- + ffiVariable: aVariableName type: aType + self + variablesAndTypesAt: aVariableName + put: aType! Item was added: + ----- Method: FFIExternalSharedPoolDefinition>>generateProgramOn: (in category 'generating') ----- + generateProgramOn: aStream + (self programGeneratorClass + on: aStream + definition: self) generate! Item was added: + ----- Method: FFIExternalSharedPoolDefinition>>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: FFIExternalSharedPoolDefinition>>inheritsFrom (in category 'accessing') ----- + inheritsFrom + ^ inheritsFrom! Item was added: + ----- Method: FFIExternalSharedPoolDefinition>>inheritsFrom: (in category 'accessing') ----- + inheritsFrom: aSelector + inheritsFrom := aSelector! Item was added: + ----- Method: FFIExternalSharedPoolDefinition>>isDefault (in category 'testing') ----- + isDefault + ^ self name isNil! Item was added: + ----- Method: FFIExternalSharedPoolDefinition>>isMorePlatformSpecificThan: (in category 'testing') ----- + isMorePlatformSpecificThan: aDefinition + ^ aDefinition isDefault + or: [self platform isMoreSpecificThan: aDefinition platform]! Item was added: + ----- Method: FFIExternalSharedPoolDefinition>>name (in category 'accessing') ----- + name + ^ name! Item was added: + ----- Method: FFIExternalSharedPoolDefinition>>name: (in category 'accessing') ----- + name: aSelector + name := aSelector! Item was added: + ----- Method: FFIExternalSharedPoolDefinition>>platform (in category 'accessing') ----- + platform + ^ platform! Item was added: + ----- Method: FFIExternalSharedPoolDefinition>>platform: (in category 'accessing') ----- + platform: aPlatform + platform := aPlatform! Item was added: + ----- Method: FFIExternalSharedPoolDefinition>>platformClass (in category 'defaults') ----- + platformClass + ^ self class platformClass! Item was added: + ----- Method: FFIExternalSharedPoolDefinition>>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: FFIExternalSharedPoolDefinition>>programGeneratorClass (in category 'accessing') ----- + programGeneratorClass + ^ programGeneratorClass! Item was added: + ----- Method: FFIExternalSharedPoolDefinition>>programGeneratorClass: (in category 'accessing') ----- + programGeneratorClass: aClass + programGeneratorClass := aClass! Item was added: + ----- Method: FFIExternalSharedPoolDefinition>>variablesAndTypes (in category 'accessing') ----- + variablesAndTypes + ^ variablesAndTypes ifNil: [variablesAndTypes := Dictionary new]! Item was added: + ----- Method: FFIExternalSharedPoolDefinition>>variablesAndTypes: (in category 'accessing') ----- + variablesAndTypes: anAssociationCollection + variablesAndTypes := Dictionary new. + anAssociationCollection associationsDo: [:each | + self + variablesAndTypesAt: each key + put: each value].! Item was added: + ----- Method: FFIExternalSharedPoolDefinition>>variablesAndTypesAt: (in category 'accessing') ----- + variablesAndTypesAt: aVaraibleName + ^ self + variablesAndTypesAt: aVaraibleName + ifAbsent: [nil]! Item was added: + ----- Method: FFIExternalSharedPoolDefinition>>variablesAndTypesAt:ifAbsent: (in category 'accessing') ----- + variablesAndTypesAt: aVaraibleName ifAbsent: aBlock + ^ self variablesAndTypes + at: aVaraibleName asSymbol + ifAbsent: aBlock! Item was added: + ----- Method: FFIExternalSharedPoolDefinition>>variablesAndTypesAt:ifAbsentPut: (in category 'accessing') ----- + variablesAndTypesAt: aVaraibleName ifAbsentPut: aBlock + ^ self + variablesAndTypesAt: aVaraibleName + ifAbsent: [ + self + variablesAndTypesAt: aVaraibleName + put: aBlock value]! Item was added: + ----- Method: FFIExternalSharedPoolDefinition>>variablesAndTypesAt:put: (in category 'accessing') ----- + variablesAndTypesAt: aVaraibleName put: aClassOrNil + ^ self variablesAndTypes + at: aVaraibleName asSymbol + put: aClassOrNil asFFIExternalSharedPoolType! Item was added: + ----- Method: FFIExternalSharedPoolDefinition>>variablesAndTypesDo: (in category 'enumerating') ----- + variablesAndTypesDo: aTwoArgumentBlock + self variablesAndTypes keysAndValuesDo: aTwoArgumentBlock! Item was added: + Object subclass: #FFIExternalSharedPoolDefinitionResolver + instanceVariableNames: 'class definitions definitionsByName defaultDefinition unresolvedDefinitions visitedDefintions' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI-Pools'! + + !FFIExternalSharedPoolDefinitionResolver commentStamp: 'monty 3/30/2018 02:01' prior: 0! + This class resolves FFIExternalSharedPoolDefinition inheritance dependencies.! Item was added: + ----- Method: FFIExternalSharedPoolDefinitionResolver class>>class:definitions: (in category 'instance creation') ----- + class: aClass definitions: aDefinitionCollection + ^ self new + setClass: aClass + definitions: aDefinitionCollection! Item was added: + ----- Method: FFIExternalSharedPoolDefinitionResolver>>errorLoopInDefinitions (in category 'private') ----- + errorLoopInDefinitions + self error: 'Class ', class name asString, ' has a loop in its definitions'! Item was added: + ----- Method: FFIExternalSharedPoolDefinitionResolver>>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: FFIExternalSharedPoolDefinitionResolver>>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: FFIExternalSharedPoolDefinitionResolver>>resolvedDefinitions (in category 'accessing') ----- + resolvedDefinitions + [unresolvedDefinitions isEmpty] + whileFalse: [| definition | + definition := unresolvedDefinitions anyOne. + visitedDefintions := Set with: definition. + self resolveDefinition: definition]. + + ^ definitions.! Item was added: + ----- Method: FFIExternalSharedPoolDefinitionResolver>>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: #FFIExternalSharedPoolPlatform + instanceVariableNames: 'name osVersion subtype wordSize' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI-Pools'! + + !FFIExternalSharedPoolPlatform commentStamp: 'monty 3/30/2018 02:00' prior: 0! + A class for storing the platform information for an FFIExternalSharedPool! Item was added: + ----- Method: FFIExternalSharedPoolPlatform class>>current (in category 'instance creation') ----- + current + ^ self + name: self currentName + osVersion: self currentOSVersion + subtype: self currentSubtype + wordSize: self currentWordSize! Item was added: + ----- Method: FFIExternalSharedPoolPlatform class>>currentName (in category 'accessing') ----- + currentName + "self currentName" + + ^ Smalltalk os platformName! Item was added: + ----- Method: FFIExternalSharedPoolPlatform 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: FFIExternalSharedPoolPlatform 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: FFIExternalSharedPoolPlatform class>>currentWordSize (in category 'accessing') ----- + currentWordSize + "self currentWordSize" + + ^ Smalltalk wordSize! Item was added: + ----- Method: FFIExternalSharedPoolPlatform class>>empty (in category 'instance creation') ----- + empty + ^ self new! Item was added: + ----- Method: FFIExternalSharedPoolPlatform class>>isCurrentlyWindows (in category 'testing') ----- + isCurrentlyWindows + ^ self currentName asLowercase beginsWith: 'win'! Item was added: + ----- Method: FFIExternalSharedPoolPlatform class>>name: (in category 'instance creation') ----- + name: aName + ^ self new name: aName! Item was added: + ----- Method: FFIExternalSharedPoolPlatform class>>name:osVersion: (in category 'instance creation') ----- + name: aName osVersion: anOSVersionString + ^ self new + name: aName; + osVersion: anOSVersionString! Item was added: + ----- Method: FFIExternalSharedPoolPlatform 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: FFIExternalSharedPoolPlatform 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: FFIExternalSharedPoolPlatform class>>name:wordSize: (in category 'instance creation') ----- + name: aName wordSize: aWordSize + ^ self new + name: aName; + wordSize: aWordSize! Item was added: + ----- Method: FFIExternalSharedPoolPlatform>>= (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: FFIExternalSharedPoolPlatform>>hasName (in category 'testing') ----- + hasName + ^ self name notEmpty! Item was added: + ----- Method: FFIExternalSharedPoolPlatform>>hasOSVersion (in category 'testing') ----- + hasOSVersion + ^ self osVersion notEmpty! Item was added: + ----- Method: FFIExternalSharedPoolPlatform>>hasSubtype (in category 'testing') ----- + hasSubtype + ^ self subtype notEmpty! Item was added: + ----- Method: FFIExternalSharedPoolPlatform>>hasWordSize (in category 'testing') ----- + hasWordSize + ^ self wordSize notNil! Item was added: + ----- Method: FFIExternalSharedPoolPlatform>>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: FFIExternalSharedPoolPlatform>>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: FFIExternalSharedPoolPlatform>>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: FFIExternalSharedPoolPlatform>>name (in category 'accessing') ----- + name + ^ name ifNil: [name := '']! Item was added: + ----- Method: FFIExternalSharedPoolPlatform>>name: (in category 'accessing') ----- + name: aName + name := aName! Item was added: + ----- Method: FFIExternalSharedPoolPlatform>>osVersion (in category 'accessing') ----- + osVersion + ^ osVersion ifNil: [osVersion := '']! Item was added: + ----- Method: FFIExternalSharedPoolPlatform>>osVersion: (in category 'accessing') ----- + osVersion: anOSVersionString + osVersion := anOSVersionString! Item was added: + ----- Method: FFIExternalSharedPoolPlatform>>printOn: (in category 'printing') ----- + printOn: aStream + self storeOn: aStream! Item was added: + ----- Method: FFIExternalSharedPoolPlatform>>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: FFIExternalSharedPoolPlatform>>subtype (in category 'accessing') ----- + subtype + ^ subtype ifNil: [subtype := '']! Item was added: + ----- Method: FFIExternalSharedPoolPlatform>>subtype: (in category 'accessing') ----- + subtype: aSubtypeString + subtype := aSubtypeString! Item was added: + ----- Method: FFIExternalSharedPoolPlatform>>wordSize (in category 'accessing') ----- + wordSize + ^ wordSize! Item was added: + ----- Method: FFIExternalSharedPoolPlatform>>wordSize: (in category 'accessing') ----- + wordSize: aWordSize + wordSize := aWordSize! Item was added: + Object subclass: #FFIExternalSharedPoolProgramGenerator + instanceVariableNames: 'stream definition' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI-Pools'! + + !FFIExternalSharedPoolProgramGenerator commentStamp: 'monty 3/30/2018 02:00' prior: 0! + This class generates a program to output an evaluable Smalltalk representation of an FFIExternalSharedPoolDefinition.! Item was added: + ----- Method: FFIExternalSharedPoolProgramGenerator class>>new (in category 'instance creation') ----- + new + self shouldNotImplement! Item was added: + ----- Method: FFIExternalSharedPoolProgramGenerator class>>on:definition: (in category 'instance creation') ----- + on: aStream definition: aDefinition + ^ self basicNew initialize + setStream: aStream + definition: aDefinition ! Item was added: + ----- Method: FFIExternalSharedPoolProgramGenerator>>contents (in category 'accessing') ----- + contents + ^ self stream contents! Item was added: + ----- Method: FFIExternalSharedPoolProgramGenerator>>defaultHeaders (in category 'defaults') ----- + defaultHeaders + ^ #('<errno.h>' '<stdarg.h>' '<stddef.h>' '<stdio.h>' '<stdlib.h>' '<string.h>')! Item was added: + ----- Method: FFIExternalSharedPoolProgramGenerator>>definition (in category 'accessing') ----- + definition + ^ definition! Item was added: + ----- Method: FFIExternalSharedPoolProgramGenerator>>emit: (in category 'emitting') ----- + emit: aCharacter + self stream nextPut: aCharacter! Item was added: + ----- Method: FFIExternalSharedPoolProgramGenerator>>emitAll: (in category 'emitting') ----- + emitAll: aString + self stream nextPutAll: aString asString! Item was added: + ----- Method: FFIExternalSharedPoolProgramGenerator>>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: FFIExternalSharedPoolProgramGenerator>>emitBooleanOutputCodeFor: (in category 'emitting - output code') ----- + emitBooleanOutputCodeFor: anIdentifier + self + emitAll: '${1}(file, "(%s)", (${2} ? "true" : "false"))' + format: {self printfFunctionName. anIdentifier}! Item was added: + ----- Method: FFIExternalSharedPoolProgramGenerator>>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: FFIExternalSharedPoolProgramGenerator>>emitEndMainFunctionDefinition (in category 'emitting - function definitions') ----- + emitEndMainFunctionDefinition + self + emitAll: + ' + if (fflush(file) !!= 0) { + ${1}("Can''t flush file", errno); + return EXIT_FAILURE; + } + 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: FFIExternalSharedPoolProgramGenerator>>emitEndOutputCode (in category 'emitting - output code') ----- + emitEndOutputCode + self + emitAll: + ' ${1}(file, "}\n"); + ' + format: {self printfFunctionName} + ! Item was added: + ----- Method: FFIExternalSharedPoolProgramGenerator>>emitEpilog (in category 'emitting') ----- + emitEpilog + self emitEndMainFunctionDefinition! Item was added: + ----- Method: FFIExternalSharedPoolProgramGenerator>>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: FFIExternalSharedPoolProgramGenerator>>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: FFIExternalSharedPoolProgramGenerator>>emitFloatOutputCodeFor: (in category 'emitting - output code') ----- + emitFloatOutputCodeFor: anIdentifier + self + emitAll: '${1}(file, "(Float ffiExternalSharedPoolReadFrom: ''%Lg'')", (long double) ${2})' + format: {self printfFunctionName. anIdentifier}! Item was added: + ----- Method: FFIExternalSharedPoolProgramGenerator>>emitFunctionDefinitions (in category 'emitting - function definitions') ----- + emitFunctionDefinitions + self + emitErrorFunctionDefinition; + emitPrintfFunctionDefinition; + emitPutcFunctionDefinition; + emitStringOutputFunctionDefinition! Item was added: + ----- Method: FFIExternalSharedPoolProgramGenerator>>emitHeader: (in category 'emitting - headers') ----- + emitHeader: aHeaderPath + self + emitAll: '#include ${1} + ' + format: {aHeaderPath}! Item was added: + ----- Method: FFIExternalSharedPoolProgramGenerator>>emitHeaders (in category 'emitting - headers') ----- + emitHeaders + self defaultHeaders do: [:each | + self emitHeader: each]. + self definition cHeadersDo: [:each | + self emitHeader: each].! Item was added: + ----- Method: FFIExternalSharedPoolProgramGenerator>>emitIntegerOutputCodeFor: (in category 'emitting - output code') ----- + emitIntegerOutputCodeFor: anIdentifier + self + emitAll: '${1}(file, "(%ld)", (long) ${2})' + format: {self printfFunctionName. anIdentifier}! Item was added: + ----- Method: FFIExternalSharedPoolProgramGenerator>>emitOutputCode (in category 'emitting - output code') ----- + emitOutputCode + self + emitStartOutputCode; + emitPlatformOutputCode; + emitVariableOutputCode; + emitEndOutputCode! Item was added: + ----- Method: FFIExternalSharedPoolProgramGenerator>>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: FFIExternalSharedPoolProgramGenerator>>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: FFIExternalSharedPoolProgramGenerator>>emitProlog (in category 'emitting') ----- + emitProlog + self + emitFileComment; + emitHeaders; + emitFunctionDefinitions; + emitStartMainFunctionDefinition! Item was added: + ----- Method: FFIExternalSharedPoolProgramGenerator>>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: FFIExternalSharedPoolProgramGenerator>>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: FFIExternalSharedPoolProgramGenerator>>emitStartOutputCode (in category 'emitting - output code') ----- + emitStartOutputCode + self + emitAll: + ' ${1}(file, "{\n"); + ' + format: {self printfFunctionName}! Item was added: + ----- Method: FFIExternalSharedPoolProgramGenerator>>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: FFIExternalSharedPoolProgramGenerator>>emitStringOutputCodeFor: (in category 'emitting - output code') ----- + emitStringOutputCodeFor: anIdentifier + self + emitAll: '${1}(file, ${2})' + format: {self stringOutputFunctionName. anIdentifier}! Item was added: + ----- Method: FFIExternalSharedPoolProgramGenerator>>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: FFIExternalSharedPoolProgramGenerator>>emitUnsignedIntegerOutputCodeFor: (in category 'emitting - output code') ----- + emitUnsignedIntegerOutputCodeFor: anIdentifier + self + emitAll: '${1}(file, "(%lu)", (unsigned long) ${2})' + format: {self printfFunctionName. anIdentifier}! Item was added: + ----- Method: FFIExternalSharedPoolProgramGenerator>>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: FFIExternalSharedPoolProgramGenerator>>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 + ffiExternalSharedPoolGenerateOutputCodeFor: aVariableName + with: self. + + self + emitAll: + '; + ${1}(file, ";\n"); + ' + format: {self printfFunctionName}.! Item was added: + ----- Method: FFIExternalSharedPoolProgramGenerator>>errorFunctionName (in category 'defaults') ----- + errorFunctionName + ^ self functionNamed: 'Error'! Item was added: + ----- Method: FFIExternalSharedPoolProgramGenerator>>functionNamed: (in category 'defaults') ----- + functionNamed: aPartialFunctionName + ^ self functionNamespace, aPartialFunctionName! Item was added: + ----- Method: FFIExternalSharedPoolProgramGenerator>>functionNamespace (in category 'defaults') ----- + functionNamespace + ^ 'ffiExternalSharedPool'! Item was added: + ----- Method: FFIExternalSharedPoolProgramGenerator>>generate (in category 'generating') ----- + generate + self + emitProlog; + emitOutputCode; + emitEpilog! Item was added: + ----- Method: FFIExternalSharedPoolProgramGenerator>>generatedProgramExitsOnError (in category 'testing') ----- + generatedProgramExitsOnError + ^ true! Item was added: + ----- Method: FFIExternalSharedPoolProgramGenerator>>printfFunctionName (in category 'defaults') ----- + printfFunctionName + ^ self functionNamed: 'Printf'! Item was added: + ----- Method: FFIExternalSharedPoolProgramGenerator>>putcFunctionName (in category 'defaults') ----- + putcFunctionName + ^ self functionNamed: 'Putc'! Item was added: + ----- Method: FFIExternalSharedPoolProgramGenerator>>setStream:definition: (in category 'initialization') ----- + setStream: aStream definition: aDefinition + stream := aStream. + definition := aDefinition.! Item was added: + ----- Method: FFIExternalSharedPoolProgramGenerator>>stream (in category 'accessing') ----- + stream + ^ stream! Item was added: + ----- Method: FFIExternalSharedPoolProgramGenerator>>stringOutputFunctionName (in category 'defaults') ----- + stringOutputFunctionName + ^ self functionNamed: 'OutputString'! Item was removed: - 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 removed: - ----- 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 removed: - ----- 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 removed: - ----- 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 removed: - ----- Method: FFISharedPool class>>errorFailedCommandTo: (in category 'private') ----- - errorFailedCommandTo: aDescription - self error: 'Command executed to ', aDescription, ' failed'! Item was removed: - ----- Method: FFISharedPool class>>errorOSProcessRequiredTo: (in category 'private') ----- - errorOSProcessRequiredTo: aDescription - self error: - 'The OSProcess library is needed to execute command to ', aDescription! Item was removed: - ----- 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 removed: - ----- 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 removed: - ----- Method: FFISharedPool class>>executeExternalCommand:format:description: (in category 'private') ----- - executeExternalCommand: aString format: aCollection description: aDescription - ^ self - executeExternalCommand: (aString format: aCollection) - description: aDescription! Item was removed: - ----- Method: FFISharedPool class>>generateAllPrograms (in category 'generating') ----- - generateAllPrograms - "self generateAllPrograms" - - self allSubclassesDo: [:each | - each generateProgram]! Item was removed: - ----- 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 removed: - ----- Method: FFISharedPool class>>generateSourceFile:forDefinition: (in category 'private') ----- - generateSourceFile: aSourceFilePath forDefinition: aDefinition - self - writeStreamOnNewFileAt: aSourceFilePath - do: [:writeStream | - aDefinition generateProgramOn: writeStream]! Item was removed: - ----- Method: FFISharedPool class>>generatedProgramDirectory (in category 'defaults') ----- - generatedProgramDirectory - ^ self vmPath, 'FFISharedPools/'! Item was removed: - ----- Method: FFISharedPool class>>generatedProgramExtension (in category 'defaults') ----- - generatedProgramExtension - ^ FFISharedPoolPlatform isCurrentlyWindows - ifTrue: ['.exe'] - ifFalse: ['']! Item was removed: - ----- Method: FFISharedPool class>>generatedProgramName (in category 'defaults') ----- - generatedProgramName - ^ self name asString, self generatedProgramExtension! Item was removed: - ----- Method: FFISharedPool class>>generatedProgramPath (in category 'defaults') ----- - generatedProgramPath - ^ self generatedProgramDirectory, self generatedProgramName! Item was removed: - ----- Method: FFISharedPool class>>generatedSourceFileExtension (in category 'defaults') ----- - generatedSourceFileExtension - ^ '.c'! Item was removed: - ----- Method: FFISharedPool class>>generatedSourceFileName (in category 'defaults') ----- - generatedSourceFileName - ^ self name asString, self generatedSourceFileExtension! Item was removed: - ----- Method: FFISharedPool class>>generatedSourceFilePath (in category 'defaults') ----- - generatedSourceFilePath - ^ self generatedProgramDirectory, self generatedSourceFileName! Item was removed: - ----- Method: FFISharedPool class>>initialize (in category 'class initialization') ----- - initialize - "self initialize" - - self reinitializeAllSubclassesFromGeneratedProgramOutput! Item was removed: - ----- Method: FFISharedPool class>>lastPlatform (in category 'accessing') ----- - lastPlatform - ^ lastPlatform! Item was removed: - ----- Method: FFISharedPool class>>lastPlatform: (in category 'accessing') ----- - lastPlatform: aPlatform - lastPlatform := aPlatform! Item was removed: - ----- Method: FFISharedPool class>>outputFileExtension (in category 'defaults') ----- - outputFileExtension - ^ '.st'! Item was removed: - ----- Method: FFISharedPool class>>outputFileName (in category 'defaults') ----- - outputFileName - ^ self name asString, self outputFileExtension! Item was removed: - ----- Method: FFISharedPool class>>outputFilePath (in category 'defaults') ----- - outputFilePath - ^ self generatedProgramDirectory, self outputFileName! Item was removed: - ----- 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 removed: - ----- 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 removed: - ----- Method: FFISharedPool class>>readGeneratedProgramOutput (in category 'private') ----- - readGeneratedProgramOutput - ^ self - readStreamOnExistingFileAt: self outputFilePath - do: [:readStream | - readStream upToEnd]! Item was removed: - ----- 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 removed: - ----- Method: FFISharedPool class>>reinitializeAllSubclassesFromGeneratedProgramOutput (in category 'class initialization') ----- - reinitializeAllSubclassesFromGeneratedProgramOutput - | currentPlatform | - - currentPlatform := FFISharedPoolPlatform current. - self allSubclassesDo: [:each | - each reinitializeFromGeneratedProgramOutputForPlatform: - currentPlatform].! Item was removed: - ----- Method: FFISharedPool class>>reinitializeFromGeneratedProgramOutput (in category 'class initialization') ----- - reinitializeFromGeneratedProgramOutput - "self reinitializeFromGeneratedProgramOutput" - - self reinitializeFromGeneratedProgramOutputForPlatform: - FFISharedPoolPlatform current! Item was removed: - ----- 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 removed: - ----- Method: FFISharedPool class>>resolvedDefinitions (in category 'accessing') ----- - resolvedDefinitions - ^ (FFISharedPoolDefinitionResolver - class: self - definitions: self definitions) resolvedDefinitions! Item was removed: - ----- 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 removed: - ----- 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 removed: - ----- Method: FFISharedPool class>>vmPath (in category 'defaults') ----- - vmPath - ^ (Smalltalk respondsTo: #vmPath) - ifTrue: [ - "for Squeak" - Smalltalk vmPath] - ifFalse: [ - "for Pharo" - Smalltalk vm path]! Item was removed: - ----- 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 removed: - 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 removed: - ----- Method: FFISharedPoolDefinition class>>defaultCCompiler (in category 'defaults') ----- - defaultCCompiler - ^ 'cc'! Item was removed: - ----- Method: FFISharedPoolDefinition class>>defaultCFlags (in category 'defaults') ----- - defaultCFlags - ^ '-o'! Item was removed: - ----- Method: FFISharedPoolDefinition class>>defaultCHeaders (in category 'defaults') ----- - defaultCHeaders - ^ #()! Item was removed: - ----- Method: FFISharedPoolDefinition class>>defaultPlatform (in category 'defaults') ----- - defaultPlatform - ^ FFISharedPoolPlatform empty! Item was removed: - ----- Method: FFISharedPoolDefinition class>>defaultProgramGeneratorClass (in category 'defaults') ----- - defaultProgramGeneratorClass - ^ FFISharedPoolProgramGenerator! Item was removed: - ----- Method: FFISharedPoolDefinition class>>defaultVariableType (in category 'defaults') ----- - defaultVariableType - ^ Integer! Item was removed: - ----- 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 removed: - ----- 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 removed: - ----- Method: FFISharedPoolDefinition class>>name: (in category 'instance creation') ----- - name: aSelector - ^ self new name: aSelector! Item was removed: - ----- Method: FFISharedPoolDefinition>>cCompiler (in category 'accessing') ----- - cCompiler - ^ cCompiler ifNil: [cCompiler := '']! Item was removed: - ----- Method: FFISharedPoolDefinition>>cCompiler: (in category 'accessing') ----- - cCompiler: aString - cCompiler := aString! Item was removed: - ----- Method: FFISharedPoolDefinition>>cFlags (in category 'accessing') ----- - cFlags - ^ cFlags ifNil: [cFlags := '']! Item was removed: - ----- Method: FFISharedPoolDefinition>>cFlags: (in category 'accessing') ----- - cFlags: aString - cFlags := aString! Item was removed: - ----- Method: FFISharedPoolDefinition>>cHeaders (in category 'accessing') ----- - cHeaders - ^ cHeaders ifNil: [cHeaders := #()]! Item was removed: - ----- 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 removed: - ----- Method: FFISharedPoolDefinition>>cHeadersDo: (in category 'enumerating') ----- - cHeadersDo: aBlock - self cHeaders do: aBlock! Item was removed: - ----- Method: FFISharedPoolDefinition>>ffiCCompiler: (in category 'pragmas') ----- - ffiCCompiler: aString - self cCompiler: aString! Item was removed: - ----- Method: FFISharedPoolDefinition>>ffiCFlags: (in category 'pragmas') ----- - ffiCFlags: aString - self cFlags: aString! Item was removed: - ----- Method: FFISharedPoolDefinition>>ffiCHeaders: (in category 'pragmas') ----- - ffiCHeaders: aHeaderPathCollection - self cHeaders: aHeaderPathCollection! Item was removed: - ----- Method: FFISharedPoolDefinition>>ffiInheritsFrom: (in category 'pragmas') ----- - ffiInheritsFrom: aSelector - self inheritsFrom: aSelector! Item was removed: - ----- Method: FFISharedPoolDefinition>>ffiPlatformName: (in category 'pragmas') ----- - ffiPlatformName: aName - self platform: - (FFISharedPoolPlatform name: aName)! Item was removed: - ----- Method: FFISharedPoolDefinition>>ffiPlatformName:osVersion: (in category 'pragmas') ----- - ffiPlatformName: aName osVersion: anOSVersionString - self platform: - (FFISharedPoolPlatform - name: aName - osVersion: anOSVersionString)! Item was removed: - ----- 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 removed: - ----- 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 removed: - ----- Method: FFISharedPoolDefinition>>ffiPlatformName:wordSize: (in category 'pragmas') ----- - ffiPlatformName: aName wordSize: aWordSize - self platform: - (FFISharedPoolPlatform - name: aName - wordSize: aWordSize)! Item was removed: - ----- Method: FFISharedPoolDefinition>>ffiProgramGeneratorClass: (in category 'pragmas') ----- - ffiProgramGeneratorClass: aClass - self programGeneratorClass: aClass! Item was removed: - ----- Method: FFISharedPoolDefinition>>ffiSharedPool (in category 'pragmas') ----- - ffiSharedPool! Item was removed: - ----- Method: FFISharedPoolDefinition>>ffiVariable:type: (in category 'pragmas') ----- - ffiVariable: aVariableName type: aType - self - variablesAndTypesAt: aVariableName - put: aType! Item was removed: - ----- Method: FFISharedPoolDefinition>>generateProgramOn: (in category 'generating') ----- - generateProgramOn: aStream - (self programGeneratorClass - on: aStream - definition: self) generate! Item was removed: - ----- 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 removed: - ----- Method: FFISharedPoolDefinition>>inheritsFrom (in category 'accessing') ----- - inheritsFrom - ^ inheritsFrom! Item was removed: - ----- Method: FFISharedPoolDefinition>>inheritsFrom: (in category 'accessing') ----- - inheritsFrom: aSelector - inheritsFrom := aSelector! Item was removed: - ----- Method: FFISharedPoolDefinition>>isDefault (in category 'testing') ----- - isDefault - ^ self name isNil! Item was removed: - ----- Method: FFISharedPoolDefinition>>isMorePlatformSpecificThan: (in category 'testing') ----- - isMorePlatformSpecificThan: aDefinition - ^ aDefinition isDefault - or: [self platform isMoreSpecificThan: aDefinition platform]! Item was removed: - ----- Method: FFISharedPoolDefinition>>name (in category 'accessing') ----- - name - ^ name! Item was removed: - ----- Method: FFISharedPoolDefinition>>name: (in category 'accessing') ----- - name: aSelector - name := aSelector! Item was removed: - ----- Method: FFISharedPoolDefinition>>platform (in category 'accessing') ----- - platform - ^ platform! Item was removed: - ----- Method: FFISharedPoolDefinition>>platform: (in category 'accessing') ----- - platform: aPlatform - platform := aPlatform! Item was removed: - ----- 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 removed: - ----- Method: FFISharedPoolDefinition>>programGeneratorClass (in category 'accessing') ----- - programGeneratorClass - ^ programGeneratorClass! Item was removed: - ----- Method: FFISharedPoolDefinition>>programGeneratorClass: (in category 'accessing') ----- - programGeneratorClass: aClass - programGeneratorClass := aClass! Item was removed: - ----- Method: FFISharedPoolDefinition>>variablesAndTypes (in category 'accessing') ----- - variablesAndTypes - ^ variablesAndTypes ifNil: [variablesAndTypes := Dictionary new]! Item was removed: - ----- Method: FFISharedPoolDefinition>>variablesAndTypes: (in category 'accessing') ----- - variablesAndTypes: anAssociationCollection - variablesAndTypes := Dictionary new. - anAssociationCollection associationsDo: [:each | - self - variablesAndTypesAt: each key - put: each value].! Item was removed: - ----- Method: FFISharedPoolDefinition>>variablesAndTypesAt: (in category 'accessing') ----- - variablesAndTypesAt: aVaraibleName - ^ self - variablesAndTypesAt: aVaraibleName - ifAbsent: [nil]! Item was removed: - ----- Method: FFISharedPoolDefinition>>variablesAndTypesAt:ifAbsent: (in category 'accessing') ----- - variablesAndTypesAt: aVaraibleName ifAbsent: aBlock - ^ self variablesAndTypes - at: aVaraibleName asSymbol - ifAbsent: aBlock! Item was removed: - ----- Method: FFISharedPoolDefinition>>variablesAndTypesAt:ifAbsentPut: (in category 'accessing') ----- - variablesAndTypesAt: aVaraibleName ifAbsentPut: aBlock - ^ self - variablesAndTypesAt: aVaraibleName - ifAbsent: [ - self - variablesAndTypesAt: aVaraibleName - put: aBlock value]! Item was removed: - ----- Method: FFISharedPoolDefinition>>variablesAndTypesAt:put: (in category 'accessing') ----- - variablesAndTypesAt: aVaraibleName put: aClassOrNil - ^ self variablesAndTypes - at: aVaraibleName asSymbol - put: aClassOrNil asFFISharedPoolType! Item was removed: - ----- Method: FFISharedPoolDefinition>>variablesAndTypesDo: (in category 'enumerating') ----- - variablesAndTypesDo: aTwoArgumentBlock - self variablesAndTypes keysAndValuesDo: aTwoArgumentBlock! Item was removed: - 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 removed: - ----- Method: FFISharedPoolDefinitionResolver class>>class:definitions: (in category 'instance creation') ----- - class: aClass definitions: aDefinitionCollection - ^ self new - setClass: aClass - definitions: aDefinitionCollection! Item was removed: - ----- Method: FFISharedPoolDefinitionResolver>>errorLoopInDefinitions (in category 'private') ----- - errorLoopInDefinitions - self error: 'Class ', class name asString, ' has a loop in its definitions'! Item was removed: - ----- 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 removed: - ----- 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 removed: - ----- Method: FFISharedPoolDefinitionResolver>>resolvedDefinitions (in category 'accessing') ----- - resolvedDefinitions - [unresolvedDefinitions isEmpty] - whileFalse: [| definition | - definition := unresolvedDefinitions anyOne. - visitedDefintions := Set with: definition. - self resolveDefinition: definition]. - - ^ definitions.! Item was removed: - ----- 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 removed: - 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 removed: - ----- Method: FFISharedPoolPlatform class>>current (in category 'instance creation') ----- - current - ^ self - name: self currentName - osVersion: self currentOSVersion - subtype: self currentSubtype - wordSize: self currentWordSize! Item was removed: - ----- Method: FFISharedPoolPlatform class>>currentName (in category 'accessing') ----- - currentName - "self currentName" - - ^ Smalltalk os platformName! Item was removed: - ----- 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 removed: - ----- 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 removed: - ----- Method: FFISharedPoolPlatform class>>currentWordSize (in category 'accessing') ----- - currentWordSize - "self currentWordSize" - - ^ Smalltalk wordSize! Item was removed: - ----- Method: FFISharedPoolPlatform class>>empty (in category 'instance creation') ----- - empty - ^ self new! Item was removed: - ----- Method: FFISharedPoolPlatform class>>isCurrentlyWindows (in category 'testing') ----- - isCurrentlyWindows - ^ self currentName asLowercase beginsWith: 'win'! Item was removed: - ----- Method: FFISharedPoolPlatform class>>name: (in category 'instance creation') ----- - name: aName - ^ self new name: aName! Item was removed: - ----- Method: FFISharedPoolPlatform class>>name:osVersion: (in category 'instance creation') ----- - name: aName osVersion: anOSVersionString - ^ self new - name: aName; - osVersion: anOSVersionString! Item was removed: - ----- 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 removed: - ----- 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 removed: - ----- Method: FFISharedPoolPlatform class>>name:wordSize: (in category 'instance creation') ----- - name: aName wordSize: aWordSize - ^ self new - name: aName; - wordSize: aWordSize! Item was removed: - ----- 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 removed: - ----- Method: FFISharedPoolPlatform>>hasName (in category 'testing') ----- - hasName - ^ self name notEmpty! Item was removed: - ----- Method: FFISharedPoolPlatform>>hasOSVersion (in category 'testing') ----- - hasOSVersion - ^ self osVersion notEmpty! Item was removed: - ----- Method: FFISharedPoolPlatform>>hasSubtype (in category 'testing') ----- - hasSubtype - ^ self subtype notEmpty! Item was removed: - ----- Method: FFISharedPoolPlatform>>hasWordSize (in category 'testing') ----- - hasWordSize - ^ self wordSize notNil! Item was removed: - ----- 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 removed: - ----- 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 removed: - ----- 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 removed: - ----- Method: FFISharedPoolPlatform>>name (in category 'accessing') ----- - name - ^ name ifNil: [name := '']! Item was removed: - ----- Method: FFISharedPoolPlatform>>name: (in category 'accessing') ----- - name: aName - name := aName! Item was removed: - ----- Method: FFISharedPoolPlatform>>osVersion (in category 'accessing') ----- - osVersion - ^ osVersion ifNil: [osVersion := '']! Item was removed: - ----- Method: FFISharedPoolPlatform>>osVersion: (in category 'accessing') ----- - osVersion: anOSVersionString - osVersion := anOSVersionString! Item was removed: - ----- Method: FFISharedPoolPlatform>>printOn: (in category 'printing') ----- - printOn: aStream - self storeOn: aStream! Item was removed: - ----- 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 removed: - ----- Method: FFISharedPoolPlatform>>subtype (in category 'accessing') ----- - subtype - ^ subtype ifNil: [subtype := '']! Item was removed: - ----- Method: FFISharedPoolPlatform>>subtype: (in category 'accessing') ----- - subtype: aSubtypeString - subtype := aSubtypeString! Item was removed: - ----- Method: FFISharedPoolPlatform>>wordSize (in category 'accessing') ----- - wordSize - ^ wordSize! Item was removed: - ----- Method: FFISharedPoolPlatform>>wordSize: (in category 'accessing') ----- - wordSize: aWordSize - wordSize := aWordSize! Item was removed: - 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 removed: - ----- Method: FFISharedPoolProgramGenerator class>>new (in category 'instance creation') ----- - new - self shouldNotImplement! Item was removed: - ----- Method: FFISharedPoolProgramGenerator class>>on:definition: (in category 'instance creation') ----- - on: aStream definition: aDefinition - ^ self basicNew initialize - setStream: aStream - definition: aDefinition ! Item was removed: - ----- Method: FFISharedPoolProgramGenerator>>contents (in category 'accessing') ----- - contents - ^ self stream contents! Item was removed: - ----- Method: FFISharedPoolProgramGenerator>>defaultHeaders (in category 'defaults') ----- - defaultHeaders - ^ #('<errno.h>' '<stdarg.h>' '<stddef.h>' '<stdio.h>' '<stdlib.h>' '<string.h>')! Item was removed: - ----- Method: FFISharedPoolProgramGenerator>>definition (in category 'accessing') ----- - definition - ^ definition! Item was removed: - ----- Method: FFISharedPoolProgramGenerator>>emit: (in category 'emitting') ----- - emit: aCharacter - self stream nextPut: aCharacter! Item was removed: - ----- Method: FFISharedPoolProgramGenerator>>emitAll: (in category 'emitting') ----- - emitAll: aString - self stream nextPutAll: aString asString! Item was removed: - ----- 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 removed: - ----- Method: FFISharedPoolProgramGenerator>>emitBooleanOutputCodeFor: (in category 'emitting - output code') ----- - emitBooleanOutputCodeFor: anIdentifier - self - emitAll: '${1}(file, "(%s)", (${2} ? "true" : "false"))' - format: {self printfFunctionName. anIdentifier}! Item was removed: - ----- 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 removed: - ----- 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 removed: - ----- Method: FFISharedPoolProgramGenerator>>emitEndOutputCode (in category 'emitting - output code') ----- - emitEndOutputCode - self - emitAll: - ' ${1}(file, "}\n"); - ' - format: {self printfFunctionName} - ! Item was removed: - ----- Method: FFISharedPoolProgramGenerator>>emitEpilog (in category 'emitting') ----- - emitEpilog - self emitEndMainFunctionDefinition! Item was removed: - ----- 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 removed: - ----- 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 removed: - ----- 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 removed: - ----- Method: FFISharedPoolProgramGenerator>>emitFunctionDefinitions (in category 'emitting - function definitions') ----- - emitFunctionDefinitions - self - emitErrorFunctionDefinition; - emitPrintfFunctionDefinition; - emitPutcFunctionDefinition; - emitStringOutputFunctionDefinition! Item was removed: - ----- Method: FFISharedPoolProgramGenerator>>emitHeader: (in category 'emitting - headers') ----- - emitHeader: aHeaderPath - self - emitAll: '#include ${1} - ' - format: {aHeaderPath}! Item was removed: - ----- Method: FFISharedPoolProgramGenerator>>emitHeaders (in category 'emitting - headers') ----- - emitHeaders - self defaultHeaders do: [:each | - self emitHeader: each]. - self definition cHeadersDo: [:each | - self emitHeader: each].! Item was removed: - ----- Method: FFISharedPoolProgramGenerator>>emitIntegerOutputCodeFor: (in category 'emitting - output code') ----- - emitIntegerOutputCodeFor: anIdentifier - self - emitAll: '${1}(file, "(%ld)", (long) ${2})' - format: {self printfFunctionName. anIdentifier}! Item was removed: - ----- Method: FFISharedPoolProgramGenerator>>emitOutputCode (in category 'emitting - output code') ----- - emitOutputCode - self - emitStartOutputCode; - emitPlatformOutputCode; - emitVariableOutputCode; - emitEndOutputCode! Item was removed: - ----- 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 removed: - ----- 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 removed: - ----- Method: FFISharedPoolProgramGenerator>>emitProlog (in category 'emitting') ----- - emitProlog - self - emitFileComment; - emitHeaders; - emitFunctionDefinitions; - emitStartMainFunctionDefinition! Item was removed: - ----- 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 removed: - ----- 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 removed: - ----- Method: FFISharedPoolProgramGenerator>>emitStartOutputCode (in category 'emitting - output code') ----- - emitStartOutputCode - self - emitAll: - ' ${1}(file, "{\n"); - ' - format: {self printfFunctionName}! Item was removed: - ----- 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 removed: - ----- Method: FFISharedPoolProgramGenerator>>emitStringOutputCodeFor: (in category 'emitting - output code') ----- - emitStringOutputCodeFor: anIdentifier - self - emitAll: '${1}(file, ${2})' - format: {self stringOutputFunctionName. anIdentifier}! Item was removed: - ----- 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 removed: - ----- Method: FFISharedPoolProgramGenerator>>emitUnsignedIntegerOutputCodeFor: (in category 'emitting - output code') ----- - emitUnsignedIntegerOutputCodeFor: anIdentifier - self - emitAll: '${1}(file, "(%lu)", (unsigned long) ${2})' - format: {self printfFunctionName. anIdentifier}! Item was removed: - ----- 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 removed: - ----- 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 removed: - ----- Method: FFISharedPoolProgramGenerator>>errorFunctionName (in category 'defaults') ----- - errorFunctionName - ^ self functionNamed: 'Error'! Item was removed: - ----- Method: FFISharedPoolProgramGenerator>>functionNamed: (in category 'defaults') ----- - functionNamed: aPartialFunctionName - ^ self functionNamespace, aPartialFunctionName! Item was removed: - ----- Method: FFISharedPoolProgramGenerator>>functionNamespace (in category 'defaults') ----- - functionNamespace - ^ 'ffiSharedPool'! Item was removed: - ----- Method: FFISharedPoolProgramGenerator>>generate (in category 'generating') ----- - generate - self - emitProlog; - emitOutputCode; - emitEpilog! Item was removed: - ----- Method: FFISharedPoolProgramGenerator>>generatedProgramExitsOnError (in category 'testing') ----- - generatedProgramExitsOnError - ^ true! Item was removed: - ----- Method: FFISharedPoolProgramGenerator>>printfFunctionName (in category 'defaults') ----- - printfFunctionName - ^ self functionNamed: 'Printf'! Item was removed: - ----- Method: FFISharedPoolProgramGenerator>>putcFunctionName (in category 'defaults') ----- - putcFunctionName - ^ self functionNamed: 'Putc'! Item was removed: - ----- Method: FFISharedPoolProgramGenerator>>setStream:definition: (in category 'initialization') ----- - setStream: aStream definition: aDefinition - stream := aStream. - definition := aDefinition.! Item was removed: - ----- Method: FFISharedPoolProgramGenerator>>stream (in category 'accessing') ----- - stream - ^ stream! Item was removed: - ----- Method: FFISharedPoolProgramGenerator>>stringOutputFunctionName (in category 'defaults') ----- - stringOutputFunctionName - ^ self functionNamed: 'OutputString'! Item was added: + ----- Method: Float class>>ffiExternalSharedPoolGenerateOutputCodeFor:with: (in category '*FFI-Pools') ----- + ffiExternalSharedPoolGenerateOutputCodeFor: aVariableName with: aProgramGenerator + aProgramGenerator emitFloatOutputCodeFor: aVariableName! Item was added: + ----- Method: Float class>>ffiExternalSharedPoolReadFrom: (in category '*FFI-Pools') ----- + ffiExternalSharedPoolReadFrom: aStreamOrString + ^ self + ffiExternalSharedPoolReadFrom: aStreamOrString + ifFail: [nil]! Item was added: + ----- Method: Float class>>ffiExternalSharedPoolReadFrom:ifFail: (in category '*FFI-Pools') ----- + ffiExternalSharedPoolReadFrom: aStreamOrString ifFail: aBlock + "This method is a wrapper around #readFrom:ifFail: that adds support + for C's printf() printed float representations of nan and +/- infinity" + + | 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 removed: - ----- Method: Float class>>ffiSharedPoolGenerateOutputCodeFor:with: (in category '*FFI-Pools') ----- - ffiSharedPoolGenerateOutputCodeFor: aPoolVariableName with: aProgramGenerator - aProgramGenerator emitFloatOutputCodeFor: aPoolVariableName! Item was removed: - ----- Method: Float class>>ffiSharedPoolReadFrom: (in category '*FFI-Pools') ----- - ffiSharedPoolReadFrom: aStreamOrString - ^ self - ffiSharedPoolReadFrom: aStreamOrString - ifFail: [nil]! Item was removed: - ----- 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>>ffiExternalSharedPoolGenerateOutputCodeFor:with: (in category '*FFI-Pools') ----- + ffiExternalSharedPoolGenerateOutputCodeFor: aVariableName with: aProgramGenerator + aProgramGenerator emitIntegerOutputCodeFor: aVariableName! Item was removed: - ----- Method: Integer class>>ffiSharedPoolGenerateOutputCodeFor:with: (in category '*FFI-Pools') ----- - ffiSharedPoolGenerateOutputCodeFor: aPoolVariableName with: aProgramGenerator - aProgramGenerator emitIntegerOutputCodeFor: aPoolVariableName! Item was added: + ----- Method: LargePositiveInteger class>>ffiExternalSharedPoolGenerateOutputCodeFor:with: (in category '*FFI-Pools') ----- + ffiExternalSharedPoolGenerateOutputCodeFor: aVariableName with: aProgramGenerator + aProgramGenerator emitUnsignedIntegerOutputCodeFor: aVariableName! Item was removed: - ----- Method: LargePositiveInteger class>>ffiSharedPoolGenerateOutputCodeFor:with: (in category '*FFI-Pools') ----- - ffiSharedPoolGenerateOutputCodeFor: aPoolVariableName with: aProgramGenerator - aProgramGenerator emitUnsignedIntegerOutputCodeFor: aPoolVariableName! Item was added: + ----- Method: Object>>asFFIExternalSharedPoolType (in category '*FFI-Pools') ----- + asFFIExternalSharedPoolType + self error: 'Cannot convert object to type'! Item was removed: - ----- Method: Object>>asFFISharedPoolType (in category '*FFI-Pools') ----- - asFFISharedPoolType - self error: 'Cannot convert object to type'! Item was added: + ----- Method: Object>>ffiExternalSharedPoolGenerateOutputCodeFor:with: (in category '*FFI-Pools') ----- + ffiExternalSharedPoolGenerateOutputCodeFor: aVariableName with: aProgramGenerator + self error: 'Cannot generate output code for ', self class name asString! Item was removed: - ----- 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>>ffiExternalSharedPoolGenerateOutputCodeFor:with: (in category '*FFI-Pools') ----- + ffiExternalSharedPoolGenerateOutputCodeFor: aVariableName with: aProgramGenerator + aProgramGenerator emitStringOutputCodeFor: aVariableName! Item was removed: - ----- Method: String class>>ffiSharedPoolGenerateOutputCodeFor:with: (in category '*FFI-Pools') ----- - ffiSharedPoolGenerateOutputCodeFor: aPoolVariableName with: aProgramGenerator - aProgramGenerator emitStringOutputCodeFor: aPoolVariableName! Item was added: + ----- Method: String>>asFFIExternalSharedPoolType (in category '*FFI-Pools') ----- + asFFIExternalSharedPoolType + ^ self class environment + at: self asSymbol + ifAbsent: [self error: 'Cannot convert object to type']! Item was removed: - ----- 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>>asFFIExternalSharedPoolType (in category '*FFI-Pools') ----- + asFFIExternalSharedPoolType + ^ self! Item was removed: - ----- Method: UndefinedObject>>asFFISharedPoolType (in category '*FFI-Pools') ----- - asFFISharedPoolType - ^ self!
More information about the Squeak-dev mailing list |