ExternalLibraryFunction.st
changeset 12450 c6d60bdca435
parent 12449 ca958524b42f
child 12459 9b5ca7e59883
equal deleted inserted replaced
12449:ca958524b42f 12450:c6d60bdca435
   512      I.e. retrieve the module handle and the code pointer."
   512      I.e. retrieve the module handle and the code pointer."
   513 
   513 
   514     |handle moduleNameUsed functionName|
   514     |handle moduleNameUsed functionName|
   515 
   515 
   516     name isNumber ifTrue:[
   516     name isNumber ifTrue:[
   517         self isCPPFunction ifTrue:[
   517 	self isCPPFunction ifTrue:[
   518             "/ no need to load a dll.
   518 	    "/ no need to load a dll.
   519             ^ self
   519 	    ^ self
   520         ]
   520 	]
   521     ].
   521     ].
   522 
   522 
   523     (moduleNameUsed := moduleName) isNil ifTrue:[
   523     (moduleNameUsed := moduleName) isNil ifTrue:[
   524         owningClass isNil ifTrue:[
   524 	owningClass isNil ifTrue:[
   525             self error:'Missing moduleName'.
   525 	    self error:'Missing moduleName'.
   526         ].
   526 	].
   527         moduleNameUsed := owningClass theNonMetaclass libraryName asSymbol.
   527 	moduleNameUsed := owningClass theNonMetaclass libraryName asSymbol.
   528     ].
   528     ].
   529     moduleHandle isNil ifTrue:[
   529     moduleHandle isNil ifTrue:[
   530         handle := self loadLibrary:moduleNameUsed.
   530 	handle := self loadLibrary:moduleNameUsed.
   531         handle isNil ifTrue:[
   531 	handle isNil ifTrue:[
   532             self error:('Cannot load module: "%1"' bindWith: moduleNameUsed).
   532 	    self error:('Cannot load module: "%1"' bindWith: moduleNameUsed).
   533         ].
   533 	].
   534         moduleHandle := handle.
   534 	moduleHandle := handle.
   535     ].
   535     ].
   536     name isNumber ifFalse:[
   536     name isNumber ifFalse:[
   537         functionName := name.
   537 	functionName := name.
   538         (moduleHandle getFunctionAddress:functionName into:self) isNil ifTrue:[
   538 	(moduleHandle getFunctionAddress:functionName into:self) isNil ifTrue:[
   539             functionName := ('_', functionName) asSymbol.
   539 	    functionName := ('_', functionName) asSymbol.
   540 
   540 
   541             (moduleHandle getFunctionAddress:functionName into:self) isNil ifTrue:[
   541 	    (moduleHandle getFunctionAddress:functionName into:self) isNil ifTrue:[
   542                 moduleHandle := nil.
   542 		moduleHandle := nil.
   543                 self error:'Missing function: ', name, ' in module: ', moduleNameUsed.
   543 		self error:'Missing function: ', name, ' in module: ', moduleNameUsed.
   544             ].
   544 	    ].
   545         ].
   545 	].
   546     ].
   546     ].
   547 
   547 
   548     "Modified: / 01-08-2006 / 16:24:14 / cg"
   548     "Modified: / 01-08-2006 / 16:24:14 / cg"
   549 !
   549 !
   550 
   550 
   553 
   553 
   554     filename := dllName asFilename.
   554     filename := dllName asFilename.
   555     nameString := filename name.
   555     nameString := filename name.
   556 
   556 
   557     filename exists ifTrue:[
   557     filename exists ifTrue:[
   558         handle := ObjectFileLoader loadDynamicObject:(filename pathName).
   558 	handle := ObjectFileLoader loadDynamicObject:(filename pathName).
   559         handle notNil ifTrue:[^ handle ].
   559 	handle notNil ifTrue:[^ handle ].
   560     ].
   560     ].
   561     filename isAbsolute ifFalse:[
   561     filename isAbsolute ifFalse:[
   562         self class dllPath do:[:eachDirectory |
   562 	self class dllPath do:[:eachDirectory |
   563             handle := ObjectFileLoader
   563 	    handle := ObjectFileLoader
   564                         loadDynamicObject:(eachDirectory asFilename construct:nameString) pathName.
   564 			loadDynamicObject:(eachDirectory asFilename construct:nameString) pathName.
   565             handle notNil ifTrue:[^ handle ].
   565 	    handle notNil ifTrue:[^ handle ].
   566         ].
   566 	].
   567     ].
   567     ].
   568 
   568 
   569     filename suffix isEmpty ifTrue:[
   569     filename suffix isEmpty ifTrue:[
   570         "/ try again with the OS-specific dll-extension
   570 	"/ try again with the OS-specific dll-extension
   571         ^ self loadLibrary:(filename withSuffix:ObjectFileLoader sharedLibrarySuffix)
   571 	^ self loadLibrary:(filename withSuffix:ObjectFileLoader sharedLibrarySuffix)
   572     ].
   572     ].
   573 
   573 
   574     ^ nil
   574     ^ nil
   575 !
   575 !
   576 
   576 
   577 prepareInvoke
   577 prepareInvoke
   578     (moduleHandle isNil or:[self hasCode not]) ifTrue:[
   578     (moduleHandle isNil or:[self hasCode not]) ifTrue:[
   579         self linkToModule.
   579 	self linkToModule.
   580         self adjustTypes.
   580 	self adjustTypes.
   581     ].
   581     ].
   582 ! !
   582 ! !
   583 
   583 
   584 !ExternalLibraryFunction methodsFor:'private-accessing'!
   584 !ExternalLibraryFunction methodsFor:'private-accessing'!
   585 
   585 
   586 ffiTypeSymbolForType:aType
   586 ffiTypeSymbolForType:aType
   587     "map type to one of the ffi-supported ones:
   587     "map type to one of the ffi-supported ones:
   588         sint8, sint16, sint32, sint64
   588 	sint8, sint16, sint32, sint64
   589         uint8, uint16, uint32, uint64
   589 	uint8, uint16, uint32, uint64
   590         bool void handle
   590 	bool void pointer handle
   591     "
   591     "
   592 
   592 
   593     aType == #sint8           ifTrue:[^ aType ].
   593     aType == #sint8           ifTrue:[^ aType ].
   594     aType == #sint16          ifTrue:[^ aType ].
   594     aType == #sint16          ifTrue:[^ aType ].
   595     aType == #sint32          ifTrue:[^ aType ].
   595     aType == #sint32          ifTrue:[^ aType ].
   607 
   607 
   608     aType == #int8            ifTrue:[^ #sint8 ].
   608     aType == #int8            ifTrue:[^ #sint8 ].
   609     aType == #int16           ifTrue:[^ #sint16 ].
   609     aType == #int16           ifTrue:[^ #sint16 ].
   610     aType == #int32           ifTrue:[^ #sint32 ].
   610     aType == #int32           ifTrue:[^ #sint32 ].
   611     aType == #int64           ifTrue:[^ #sint64 ].
   611     aType == #int64           ifTrue:[^ #sint64 ].
   612     aType == #voidPointer     ifTrue:[^ #pointer ].
   612 
   613     aType == #uint8Pointer    ifTrue:[^ #pointer ].
   613     aType == #voidPointer         ifTrue:[^ #pointer ].
       
   614     aType == #uint8Pointer        ifTrue:[^ #pointer ].
   614     aType == #voidPointerPointer  ifTrue:[^ #pointer ].
   615     aType == #voidPointerPointer  ifTrue:[^ #pointer ].
   615 
   616 
   616     aType == #short           ifTrue:[^ #sint16 ].
   617     aType == #short           ifTrue:[^ #sint16 ].
   617     aType == #long            ifTrue:[^ #long ].
   618     aType == #long            ifTrue:[^ #long ].
   618     aType == #int             ifTrue:[^ #int ].
   619     aType == #int             ifTrue:[^ #int ].
   626     aType == #byte            ifTrue:[^ #uint8 ].
   627     aType == #byte            ifTrue:[^ #uint8 ].
   627     aType == #dword           ifTrue:[^ #uint32 ].
   628     aType == #dword           ifTrue:[^ #uint32 ].
   628     aType == #sdword          ifTrue:[^ #sint32 ].
   629     aType == #sdword          ifTrue:[^ #sint32 ].
   629     aType == #word            ifTrue:[^ #uint16 ].
   630     aType == #word            ifTrue:[^ #uint16 ].
   630     aType == #sword           ifTrue:[^ #sint16 ].
   631     aType == #sword           ifTrue:[^ #sint16 ].
       
   632     aType == #longLong        ifTrue:[^ #sint64 ].
       
   633     aType == #ulongLong       ifTrue:[^ #uint64 ].
   631     aType == #handle          ifTrue:[^ #pointer ].
   634     aType == #handle          ifTrue:[^ #pointer ].
   632     aType == #lpstr           ifTrue:[^ #charPointer ].
   635     aType == #lpstr           ifTrue:[^ #charPointer ].
   633     aType == #hresult         ifTrue:[^ #uint32 ].
   636     aType == #hresult         ifTrue:[^ #uint32 ].
   634     aType == #boolean         ifTrue:[^ #bool ].
   637     aType == #boolean         ifTrue:[^ #bool ].
   635     aType == #ulongReturn     ifTrue:[^ #uint32 ].    "/ TODO - care for 64bit machines
   638     aType == #ulongReturn     ifTrue:[^ #uint32 ].    "/ TODO - care for 64bit machines
   638     aType == #structIn        ifTrue:[^ #pointer ].
   641     aType == #structIn        ifTrue:[^ #pointer ].
   639     aType == #structOut       ifTrue:[^ #pointer ].
   642     aType == #structOut       ifTrue:[^ #pointer ].
   640     aType == #unsigned        ifTrue:[^ #uint ].
   643     aType == #unsigned        ifTrue:[^ #uint ].
   641 
   644 
   642     (aType isString or:[aType isSymbol]) ifFalse:[
   645     (aType isString or:[aType isSymbol]) ifFalse:[
   643         CType isNil ifTrue:[
   646 	CType isNil ifTrue:[
   644             self error:'unknown type'.
   647 	    self error:'unknown type'.
   645         ].
   648 	].
   646         ^ aType typeSymbol.
   649 	^ aType typeSymbol.
   647     ].
   650     ].
   648 
   651 
   649     (aType endsWith:'Pointer') ifTrue:[
   652     (aType endsWith:'Pointer') ifTrue:[
   650         ^ #pointer.
   653 	^ #pointer.
   651     ].
   654     ].
   652     ^ aType
   655     ^ aType
   653 
   656 
   654     "Modified: / 14-06-2007 / 17:21:42 / cg"
   657     "Modified: / 14-06-2007 / 17:21:42 / cg"
   655 !
   658 !
  1393 ! !
  1396 ! !
  1394 
  1397 
  1395 !ExternalLibraryFunction class methodsFor:'documentation'!
  1398 !ExternalLibraryFunction class methodsFor:'documentation'!
  1396 
  1399 
  1397 version
  1400 version
  1398     ^ '$Header: /cvs/stx/stx/libbasic/ExternalLibraryFunction.st,v 1.68 2009-11-04 16:44:06 cg Exp $'
  1401     ^ '$Header: /cvs/stx/stx/libbasic/ExternalLibraryFunction.st,v 1.69 2009-11-05 10:37:15 cg Exp $'
  1399 !
  1402 !
  1400 
  1403 
  1401 version_CVS
  1404 version_CVS
  1402     ^ '$Header: /cvs/stx/stx/libbasic/ExternalLibraryFunction.st,v 1.68 2009-11-04 16:44:06 cg Exp $'
  1405     ^ '$Header: /cvs/stx/stx/libbasic/ExternalLibraryFunction.st,v 1.69 2009-11-05 10:37:15 cg Exp $'
  1403 ! !
  1406 ! !
  1404 
  1407 
  1405 ExternalLibraryFunction initialize!
  1408 ExternalLibraryFunction initialize!