'From TeaSqueak3.2 of 19 September 2002 [latest update: #401] on 18 May 2003 at 6:55:56 pm'! "Change Set: FFIConstantsPool Date: 18 May 2003 Author: Andreas Raab Rewrite FFIConstants as declarative pool." Smalltalk at: #FFIConstantsOBSOLETEPOOL put: FFIConstants. Smalltalk removeKey: #FFIConstants.! SharedPool subclass: #FFIConstants instanceVariableNames: '' classVariableNames: 'FFIAtomicTypeMask FFIAtomicTypeShift FFICallTypeApi FFICallTypeCDecl FFIErrorAddressNotFound FFIErrorAttemptToPassVoid FFIErrorBadAddress FFIErrorBadArg FFIErrorBadArgs FFIErrorBadAtomicType FFIErrorBadExternalFunction FFIErrorBadExternalLibrary FFIErrorBadReturn FFIErrorCallType FFIErrorCoercionFailed FFIErrorGenericError FFIErrorIntAsPointer FFIErrorInvalidPointer FFIErrorModuleNotFound FFIErrorNoModule FFIErrorNotFunction FFIErrorStructSize FFIErrorWrongType FFIFlagAtomic FFIFlagPointer FFIFlagStructure FFINoCalloutAvailable FFIStructSizeMask FFITypeBool FFITypeDoubleFloat FFITypeSignedByte FFITypeSignedChar FFITypeSignedInt FFITypeSignedLongLong FFITypeSignedShort FFITypeSingleFloat FFITypeUnsignedByte FFITypeUnsignedChar FFITypeUnsignedInt FFITypeUnsignedLongLong FFITypeUnsignedShort FFITypeVoid ' poolDictionaries: '' category: 'FFI-Kernel'! !ExternalFunction class methodsFor: 'class initialization' stamp: 'ar 5/18/2003 18:50'! initialize "ExternalFunction initialize" self initializeErrorMessages.! ! !ExternalFunction class methodsFor: 'class initialization' stamp: 'ar 5/18/2003 18:53'! initializeErrorMessages "ExternalFunction initializeErrorConstants" FFIErrorMessages _ Dictionary new. FFIErrorMessages at: FFINoCalloutAvailable put: 'Callout mechanism not available'; at: FFIErrorGenericError put: 'A call to an external function failed'; at: FFIErrorNotFunction put: 'Only ExternalFunctions can be called'; at: FFIErrorBadArgs put: 'Bad arguments in primitive invokation'; at: FFIErrorBadArg put: 'Bad argument for external function'; at: FFIErrorIntAsPointer put: 'Cannot use integer as pointer'; at: FFIErrorBadAtomicType put: 'Unknown atomic type in external call'; at: FFIErrorCoercionFailed put: 'Could not coerce arguments'; at: FFIErrorWrongType put: 'Wrong type in external call'; at: FFIErrorStructSize put: 'Bad structure size in external call'; at: FFIErrorCallType put: 'Unsupported calling convention'; at: FFIErrorBadReturn put: 'Cannot return the given type'; at: FFIErrorBadAddress put: 'Bad function address'; at: FFIErrorNoModule put: 'No module to load address from'; at: FFIErrorAddressNotFound put: 'Unable to find function address'; at: FFIErrorAttemptToPassVoid put: 'Cannot pass ''void'' parameter'; at: FFIErrorModuleNotFound put: 'External module not found'; at: FFIErrorBadExternalLibrary put: 'External library is invalid'; at: FFIErrorBadExternalFunction put: 'External function is invalid'; at: FFIErrorInvalidPointer put: 'Attempt to pass invalid pointer'; yourself! ! !ExternalType class methodsFor: 'class initialization' stamp: 'ar 5/18/2003 18:45'! initializeFFIConstants "ExternalType initialize" AtomicTypeNames _ IdentityDictionary new. AtomicSelectors _ IdentityDictionary new. AtomicTypeNames at: FFITypeVoid put: 'void'; at: FFITypeBool put: 'bool'; at: FFITypeUnsignedByte put: 'byte'; at: FFITypeSignedByte put: 'sbyte'; at: FFITypeUnsignedShort put: 'ushort'; at: FFITypeSignedShort put: 'short'; at: FFITypeUnsignedInt put: 'ulong'; at: FFITypeSignedInt put: 'ulong'; at: FFITypeUnsignedLongLong put: 'ulonglong'; at: FFITypeSignedLongLong put: 'longlong'; at: FFITypeUnsignedChar put: 'char'; at: FFITypeSignedChar put: 'schar'; at: FFITypeSingleFloat put: 'float'; at: FFITypeDoubleFloat put: 'double'; yourself. AtomicSelectors at: FFITypeVoid put: #voidAt:; at: FFITypeBool put: #booleanAt:; at: FFITypeUnsignedByte put: #unsignedByteAt:; at: FFITypeSignedByte put: #signedByteAt:; at: FFITypeUnsignedShort put: #unsignedShortAt:; at: FFITypeSignedShort put: #signedShortAt:; at: FFITypeUnsignedInt put: #unsignedLongAt:; at: FFITypeSignedInt put: #signedLongAt:; at: FFITypeUnsignedLongLong put: #unsignedLongLongAt:; at: FFITypeSignedLongLong put: #signedLongLongAt:; at: FFITypeUnsignedChar put: #unsignedCharAt:; at: FFITypeSignedChar put: #signedCharAt:; at: FFITypeSingleFloat put: #floatAt:; at: FFITypeDoubleFloat put: #doubleAt:; yourself! ! !FFIConstants class methodsFor: 'pool initialization' stamp: 'ar 5/18/2003 18:54'! initialize "FFIConstants initialize" self initializeTypeConstants. self initializeErrorConstants. self initializeCallingConventions.! ! !FFIConstants class methodsFor: 'pool initialization' stamp: 'ar 5/18/2003 18:50'! initializeCallingConventions FFICallTypeCDecl := 0. FFICallTypeApi := 1. ! ! !FFIConstants class methodsFor: 'pool initialization' stamp: 'ar 5/18/2003 18:49'! initializeErrorConstants "ExternalFunction initializeErrorConstants" "No callout mechanism available" FFINoCalloutAvailable := -1. "generic error" FFIErrorGenericError := 0. "primitive invoked without ExternalFunction" FFIErrorNotFunction := 1. "bad arguments to primitive call" FFIErrorBadArgs := 2. "generic bad argument" FFIErrorBadArg := 3. "int passed as pointer" FFIErrorIntAsPointer := 4. "bad atomic type (e.g., unknown)" FFIErrorBadAtomicType := 5. "argument coercion failed" FFIErrorCoercionFailed := 6. "Type check for non-atomic types failed" FFIErrorWrongType := 7. "struct size wrong or too large" FFIErrorStructSize := 8. "unsupported calling convention" FFIErrorCallType := 9. "cannot return the given type" FFIErrorBadReturn := 10. "bad function address" FFIErrorBadAddress := 11. "no module given but required for finding address" FFIErrorNoModule := 12. "function address not found" FFIErrorAddressNotFound := 13. "attempt to pass 'void' parameter" FFIErrorAttemptToPassVoid := 14. "module not found" FFIErrorModuleNotFound := 15. "external library invalid" FFIErrorBadExternalLibrary := 16. "external function invalid" FFIErrorBadExternalFunction := 17. "ExternalAddress points to ST memory (don't you dare to do this!!)" FFIErrorInvalidPointer := 18.! ! !FFIConstants class methodsFor: 'pool initialization' stamp: 'ar 5/18/2003 18:34'! initializeTypeConstants "type void" FFITypeVoid := 0. "type bool" FFITypeBool := 1. "basic integer types. note: (integerType anyMask: 1) = integerType isSigned" FFITypeUnsignedByte := 2. FFITypeSignedByte := 3. FFITypeUnsignedShort := 4. FFITypeSignedShort := 5. FFITypeUnsignedInt := 6. FFITypeSignedInt := 7. "64bit types" FFITypeUnsignedLongLong := 8. FFITypeSignedLongLong := 9. "special integer types" FFITypeUnsignedChar := 10. FFITypeSignedChar := 11. "float types" FFITypeSingleFloat := 12. FFITypeDoubleFloat := 13. "type flags" FFIFlagAtomic := 16r40000. "type is atomic" FFIFlagPointer := 16r20000. "type is pointer to base type" FFIFlagStructure := 16r10000. "baseType is structure of 64k length" FFIStructSizeMask := 16rFFFF. "mask for max size of structure" FFIAtomicTypeMask := 16r0F000000. "mask for atomic type spec" FFIAtomicTypeShift := 24. "shift for atomic type" ! ! FFIConstants initialize! !FFIConstants class reorganize! ('pool initialization' initialize initializeCallingConventions initializeErrorConstants initializeTypeConstants) ! ExternalType class removeSelector: #obsolete! ExternalFunction initialize! ExternalFunction class removeSelector: #initializeCallingConventions! ExternalFunction class removeSelector: #initializeErrorConstants! "Postscript: Rebind users of FFIConstants" Smalltalk allClassesDo:[:aClass| (aClass sharedPools includes: FFIConstantsOBSOLETEPOOL) ifTrue:[ Compiler evaluate: (aClass definition copyReplaceAll: 'OBSOLETEPOOL' with: ''). ]. ]. Smalltalk removeKey: #FFIConstantsOBSOLETEPOOL.!