312 ^ CALLTYPE_OLE |
312 ^ CALLTYPE_OLE |
313 |
313 |
314 "Modified: / 01-08-2006 / 13:44:57 / cg" |
314 "Modified: / 01-08-2006 / 13:44:57 / cg" |
315 ! ! |
315 ! ! |
316 |
316 |
317 !ExternalLibraryFunction methodsFor:'accessing'! |
317 !ExternalLibraryFunction class methodsFor:'type name mapping'! |
318 |
|
319 argumentTypes |
|
320 ^ argumentTypes |
|
321 ! |
|
322 |
|
323 argumentTypesString |
|
324 ^ String |
|
325 streamContents:[:s | |
|
326 argumentTypes do:[:eachArgType | |
|
327 eachArgType printOn:s. |
|
328 ] separatedBy:[ |
|
329 s nextPutAll:','. |
|
330 ]. |
|
331 ]. |
|
332 ! |
|
333 |
|
334 beAsync |
|
335 "let this execute in a separate thread, in par with the other execution thread(s). |
|
336 Ignored under unix/linux (until those support multiple threads too)." |
|
337 |
|
338 flags := (flags ? 0) bitOr: FLAG_ASYNC. |
|
339 |
|
340 "Created: / 01-08-2006 / 13:42:38 / cg" |
|
341 ! |
|
342 |
|
343 beCallTypeAPI |
|
344 flags := (flags ? 0) bitOr: CALLTYPE_API. |
|
345 |
|
346 "Created: / 01-08-2006 / 15:12:40 / cg" |
|
347 ! |
|
348 |
|
349 beCallTypeC |
|
350 flags := (flags ? 0) bitOr: CALLTYPE_C. |
|
351 |
|
352 "Created: / 01-08-2006 / 15:12:40 / cg" |
|
353 ! |
|
354 |
|
355 beCallTypeOLE |
|
356 flags := (flags ? 0) bitOr: FLAG_VIRTUAL. |
|
357 |
|
358 "Created: / 01-08-2006 / 15:12:40 / cg" |
|
359 ! |
|
360 |
|
361 beCallTypeUNIX64 |
|
362 flags := (flags ? 0) bitOr: CALLTYPE_UNIX64. |
|
363 |
|
364 "Created: / 01-08-2006 / 15:13:38 / cg" |
|
365 ! |
|
366 |
|
367 beCallTypeV8 |
|
368 flags := (flags ? 0) bitOr: CALLTYPE_V8. |
|
369 |
|
370 "Created: / 01-08-2006 / 15:13:28 / cg" |
|
371 ! |
|
372 |
|
373 beCallTypeV9 |
|
374 flags := (flags ? 0) bitOr: CALLTYPE_V9. |
|
375 |
|
376 "Created: / 01-08-2006 / 15:13:31 / cg" |
|
377 ! |
|
378 |
|
379 beCallTypeWINAPI |
|
380 self beCallTypeAPI |
|
381 |
|
382 "Modified: / 01-08-2006 / 15:14:02 / cg" |
|
383 ! |
|
384 |
|
385 beConstReturnValue |
|
386 "specify that a pointer return value is not to be finalized |
|
387 (i.e. points to static data or data which is freed by c)" |
|
388 |
|
389 flags := (flags ? 0) bitOr: FLAG_RETVAL_IS_CONST. |
|
390 |
|
391 "Created: / 01-08-2006 / 13:56:48 / cg" |
|
392 ! |
|
393 |
|
394 beNonVirtualCPP |
|
395 "specify this as a non-virtual c++-function" |
|
396 |
|
397 flags := (flags ? 0) bitOr: FLAG_NONVIRTUAL. |
|
398 |
|
399 "Created: / 01-08-2006 / 13:56:44 / cg" |
|
400 ! |
|
401 |
|
402 beObjectiveC |
|
403 "specify this as an objective-c message send" |
|
404 |
|
405 flags := (flags ? 0) bitOr: FLAG_OBJECTIVEC. |
|
406 |
|
407 "Created: / 01-08-2006 / 13:56:48 / cg" |
|
408 ! |
|
409 |
|
410 beUnlimitedStack |
|
411 "let this execute on the c-stack (as opposed to the thread-stack) |
|
412 for unlimited auto-sized-stack under unix/linux. |
|
413 Ignored under windows." |
|
414 |
|
415 flags := (flags ? 0) bitOr: FLAG_UNLIMITEDSTACK. |
|
416 |
|
417 "Created: / 01-08-2006 / 13:41:54 / cg" |
|
418 ! |
|
419 |
|
420 beVirtualCPP |
|
421 "specify this as a virtual c++-function" |
|
422 |
|
423 flags := (flags ? 0) bitOr: FLAG_VIRTUAL. |
|
424 |
|
425 "Created: / 01-08-2006 / 13:56:48 / cg" |
|
426 ! |
|
427 |
|
428 callTypeNumber |
|
429 ^ (flags ? 0) bitAnd: CALLTYPE_MASK. |
|
430 |
|
431 "Created: / 01-08-2006 / 15:12:10 / cg" |
|
432 ! |
|
433 |
|
434 isAsync |
|
435 "is this executed in a separate thread, in par with the other execution thread(s) ?" |
|
436 |
|
437 ^ (flags ? 0) bitTest: FLAG_ASYNC. |
|
438 |
|
439 "Created: / 01-08-2006 / 13:46:53 / cg" |
|
440 ! |
|
441 |
|
442 isCPPFunction |
|
443 "is this a virtual or non-virtual c++-function ?" |
|
444 |
|
445 ^ (flags ? 0) bitTest: (FLAG_VIRTUAL bitOr: FLAG_NONVIRTUAL). |
|
446 |
|
447 "Created: / 01-08-2006 / 13:56:54 / cg" |
|
448 ! |
|
449 |
|
450 isCallTypeAPI |
|
451 ^ ((flags ? 0) bitAnd: CALLTYPE_MASK) == CALLTYPE_API. |
|
452 |
|
453 "Created: / 01-08-2006 / 15:21:16 / cg" |
|
454 ! |
|
455 |
|
456 isCallTypeC |
|
457 ^ ((flags ? 0) bitAnd: CALLTYPE_MASK) == CALLTYPE_C. |
|
458 |
|
459 "Created: / 01-08-2006 / 15:21:23 / cg" |
|
460 ! |
|
461 |
|
462 isCallTypeOLE |
|
463 ^ ((flags ? 0) bitTest: FLAG_VIRTUAL). |
|
464 |
|
465 "Created: / 01-08-2006 / 15:21:23 / cg" |
|
466 ! |
|
467 |
|
468 isConstReturnValue |
|
469 "is the pointer return value not to be finalized |
|
470 (i.e. points to static data or data which is freed by c)" |
|
471 |
|
472 ^ (flags ? 0) bitTest: FLAG_RETVAL_IS_CONST. |
|
473 |
|
474 "Created: / 01-08-2006 / 13:56:48 / cg" |
|
475 ! |
|
476 |
|
477 isNonVirtualCPP |
|
478 "is this a non-virtual c++-function ?" |
|
479 |
|
480 ^ (flags ? 0) bitTest: FLAG_NONVIRTUAL. |
|
481 |
|
482 "Created: / 01-08-2006 / 13:56:51 / cg" |
|
483 ! |
|
484 |
|
485 isObjectiveC |
|
486 "is this an objective-C message?" |
|
487 |
|
488 ^ (flags ? 0) bitTest: FLAG_OBJECTIVEC. |
|
489 ! |
|
490 |
|
491 isUnlimitedStack |
|
492 "will this execute on the c-stack (as opposed to the thread-stack) |
|
493 for unlimited auto-sized-stack under unix/linux. |
|
494 Ignored under windows." |
|
495 |
|
496 ^ (flags ? 0) bitTest: FLAG_UNLIMITEDSTACK. |
|
497 |
|
498 "Created: / 01-08-2006 / 14:17:07 / cg" |
|
499 ! |
|
500 |
|
501 isVirtualCPP |
|
502 "is this a virtual c++-function ?" |
|
503 |
|
504 ^ (flags ? 0) bitTest: FLAG_VIRTUAL. |
|
505 |
|
506 "Created: / 01-08-2006 / 13:56:54 / cg" |
|
507 ! |
|
508 |
|
509 moduleName |
|
510 ^ moduleName |
|
511 ! |
|
512 |
|
513 returnType |
|
514 ^ returnType |
|
515 ! |
|
516 |
|
517 vtableIndex |
|
518 name isNumber ifFalse:[^ nil]. |
|
519 ^ name. |
|
520 ! ! |
|
521 |
|
522 !ExternalLibraryFunction methodsFor:'invoking'! |
|
523 |
|
524 invoke |
|
525 self hasCode ifFalse:[ |
|
526 self prepareInvoke. |
|
527 ]. |
|
528 ^ self invokeFFIwithArguments:nil forCPPInstance:nil |
|
529 ! |
|
530 |
|
531 invokeCPPVirtualOn:anInstance |
|
532 self hasCode ifFalse:[ |
|
533 self prepareInvoke. |
|
534 ]. |
|
535 ^ self invokeCPPVirtualFFIOn:anInstance withArguments:nil |
|
536 ! |
|
537 |
|
538 invokeCPPVirtualOn:instance with:arg |
|
539 self hasCode ifFalse:[ |
|
540 self prepareInvoke. |
|
541 ]. |
|
542 ^ self invokeCPPVirtualFFIOn:instance withArguments:(Array with:arg) |
|
543 ! |
|
544 |
|
545 invokeCPPVirtualOn:instance with:arg1 with:arg2 |
|
546 self hasCode ifFalse:[ |
|
547 self prepareInvoke. |
|
548 ]. |
|
549 ^ self invokeCPPVirtualFFIOn:instance withArguments:(Array with:arg1 with:arg2) |
|
550 ! |
|
551 |
|
552 invokeCPPVirtualOn:instance with:arg1 with:arg2 with:arg3 |
|
553 self hasCode ifFalse:[ |
|
554 self prepareInvoke. |
|
555 ]. |
|
556 ^ self invokeCPPVirtualFFIOn:instance withArguments:(Array with:arg1 with:arg2 with:arg3) |
|
557 ! |
|
558 |
|
559 invokeCPPVirtualOn:instance with:arg1 with:arg2 with:arg3 with:arg4 |
|
560 self hasCode ifFalse:[ |
|
561 self prepareInvoke. |
|
562 ]. |
|
563 ^ self invokeCPPVirtualFFIOn:instance withArguments:(Array with:arg1 with:arg2 with:arg3 with:arg4) |
|
564 ! |
|
565 |
|
566 invokeCPPVirtualOn:instance withArguments:args |
|
567 self hasCode ifFalse:[ |
|
568 self prepareInvoke. |
|
569 ]. |
|
570 ^ self invokeCPPVirtualFFIOn:instance withArguments:args |
|
571 ! |
|
572 |
|
573 invokeWith:arg |
|
574 self hasCode ifFalse:[ |
|
575 self prepareInvoke. |
|
576 ]. |
|
577 ^ self invokeFFIwithArguments:(Array with:arg) forCPPInstance:nil |
|
578 ! |
|
579 |
|
580 invokeWith:arg1 with:arg2 |
|
581 self hasCode ifFalse:[ |
|
582 self prepareInvoke. |
|
583 ]. |
|
584 ^ self invokeFFIwithArguments:(Array with:arg1 with:arg2) forCPPInstance:nil |
|
585 ! |
|
586 |
|
587 invokeWith:arg1 with:arg2 with:arg3 |
|
588 self hasCode ifFalse:[ |
|
589 self prepareInvoke. |
|
590 ]. |
|
591 ^ self invokeFFIwithArguments:(Array with:arg1 with:arg2 with:arg3) forCPPInstance:nil |
|
592 ! |
|
593 |
|
594 invokeWith:arg1 with:arg2 with:arg3 with:arg4 |
|
595 self hasCode ifFalse:[ |
|
596 self prepareInvoke. |
|
597 ]. |
|
598 ^ self invokeFFIwithArguments:(Array with:arg1 with:arg2 with:arg3 with:arg4) forCPPInstance:nil |
|
599 ! |
|
600 |
|
601 invokeWithArguments:argArray |
|
602 self hasCode ifFalse:[ |
|
603 self prepareInvoke. |
|
604 ]. |
|
605 ^ self invokeFFIwithArguments:argArray forCPPInstance:nil |
|
606 |
|
607 "Modified: / 01-08-2006 / 16:04:08 / cg" |
|
608 ! ! |
|
609 |
|
610 !ExternalLibraryFunction methodsFor:'printing'! |
|
611 |
|
612 printOn:aStream |
|
613 aStream nextPutAll:'<'. |
|
614 self isCallTypeAPI ifTrue:[ |
|
615 'API:' printOn:aStream. |
|
616 ] ifFalse:[ |
|
617 self isCallTypeOLE ifTrue:[ |
|
618 'OLE:' printOn:aStream. |
|
619 ] ifFalse:[ |
|
620 self isCallTypeC ifTrue:[ |
|
621 'C:' printOn:aStream. |
|
622 ] ifFalse:[ |
|
623 self error. |
|
624 ]. |
|
625 ]. |
|
626 ]. |
|
627 aStream nextPutAll:' '. |
|
628 name printOn:aStream. |
|
629 moduleName notNil ifTrue:[ |
|
630 aStream nextPutAll:' module:'. |
|
631 moduleName printOn:aStream. |
|
632 ]. |
|
633 aStream nextPutAll:'>'. |
|
634 |
|
635 "Modified: / 25-09-2012 / 12:06:14 / cg" |
|
636 ! ! |
|
637 |
|
638 !ExternalLibraryFunction methodsFor:'private'! |
|
639 |
|
640 adjustTypes |
|
641 argumentTypes notEmptyOrNil ifTrue:[ |
|
642 argumentTypes := argumentTypes collect:[:argType | self ffiTypeSymbolForType:argType]. |
|
643 ]. |
|
644 returnType := self ffiTypeSymbolForType:returnType. |
|
645 ! |
|
646 |
|
647 linkToModule |
|
648 "link this function to the external module. |
|
649 I.e. retrieve the module handle and the code pointer." |
|
650 |
|
651 |handle moduleNameUsed functionName| |
|
652 |
|
653 name isNumber ifTrue:[ |
|
654 self isCPPFunction ifTrue:[ |
|
655 "/ no need to load a dll. |
|
656 ^ self |
|
657 ] |
|
658 ]. |
|
659 |
|
660 "/ in some other smalltalks, there is no moduleName in the ffi-spec; |
|
661 "/ instead, the class provides the libraryName... |
|
662 (moduleNameUsed := moduleName) isNil ifTrue:[ |
|
663 owningClass isNil ifTrue:[ |
|
664 self error:'Missing moduleName'. |
|
665 ]. |
|
666 moduleNameUsed := owningClass theNonMetaclass libraryName asSymbol. |
|
667 ]. |
|
668 moduleHandle isNil ifTrue:[ |
|
669 "/ speedup. in 95% of all calls, the same moduleName is resolved here |
|
670 (LastModuleHandleHolder isNil |
|
671 or:[ (handle := LastModuleHandleHolder at:1) isNil |
|
672 or:[ LastModuleHandleName ~= moduleNameUsed ]]) ifTrue:[ |
|
673 |
|
674 handle := self loadLibrary:moduleNameUsed. |
|
675 handle isNil ifTrue:[ |
|
676 self error:('Cannot find or load dll/module: "%1"' bindWith: moduleNameUsed). |
|
677 ]. |
|
678 LastModuleHandleHolder := WeakArray with:handle. |
|
679 LastModuleHandleName := moduleNameUsed. |
|
680 ]. |
|
681 moduleHandle := handle. |
|
682 ]. |
|
683 name isNumber ifFalse:[ |
|
684 functionName := name. |
|
685 (moduleHandle getFunctionAddress:functionName into:self) isNil ifTrue:[ |
|
686 (moduleHandle getFunctionAddress:('_', functionName) into:self) isNil ifTrue:[ |
|
687 moduleHandle := nil. |
|
688 self error:'Missing function: ', name, ' in module: ', moduleNameUsed. |
|
689 ]. |
|
690 ]. |
|
691 ]. |
|
692 |
|
693 "Modified: / 10-04-2012 / 12:12:44 / cg" |
|
694 ! |
|
695 |
|
696 loadLibrary:dllName |
|
697 |handle nameString filename| |
|
698 |
|
699 filename := dllName. |
|
700 DllMapping notNil ifTrue:[ |
|
701 filename := DllMapping at:filename ifAbsent:[ filename ] |
|
702 ]. |
|
703 |
|
704 filename := filename asFilename. |
|
705 nameString := filename name. |
|
706 |
|
707 "try to load, maybe the system knows where to find the dll" |
|
708 handle := ObjectFileLoader loadDynamicObject:filename. |
|
709 handle notNil ifTrue:[^ handle ]. |
|
710 |
|
711 filename isAbsolute ifFalse:[ |
|
712 "First ask the class defining the ExternalFunction for the location of the dlls ..." |
|
713 owningClass notNil ifTrue:[ |
|
714 owningClass dllPath do:[:eachDirectory | |
|
715 handle := ObjectFileLoader |
|
716 loadDynamicObject:(eachDirectory asFilename construct:nameString) pathName. |
|
717 handle notNil ifTrue:[^ handle ]. |
|
718 ]. |
|
719 ]. |
|
720 ".. then ask the system" |
|
721 self class dllPath do:[:eachDirectory | |
|
722 handle := ObjectFileLoader |
|
723 loadDynamicObject:(eachDirectory asFilename construct:nameString) pathName. |
|
724 handle notNil ifTrue:[^ handle ]. |
|
725 ]. |
|
726 ]. |
|
727 |
|
728 filename suffix isEmpty ifTrue:[ |
|
729 "/ try again with the OS-specific dll-extension |
|
730 ^ self loadLibrary:(filename withSuffix:ObjectFileLoader sharedLibrarySuffix) |
|
731 ]. |
|
732 |
|
733 ^ nil |
|
734 |
|
735 "Modified: / 10-04-2012 / 12:21:06 / cg" |
|
736 ! |
|
737 |
|
738 prepareInvoke |
|
739 (moduleHandle isNil or:[self hasCode not]) ifTrue:[ |
|
740 self linkToModule. |
|
741 self adjustTypes. |
|
742 ]. |
|
743 ! ! |
|
744 |
|
745 !ExternalLibraryFunction methodsFor:'private-accessing'! |
|
746 |
318 |
747 ffiTypeSymbolForType:aType |
319 ffiTypeSymbolForType:aType |
748 "map type to one of the ffi-supported ones: |
320 "map type to one of the ffi-supported ones: |
749 sint8, sint16, sint32, sint64 |
321 sint8, sint16, sint32, sint64 |
750 uint8, uint16, uint32, uint64 |
322 uint8, uint16, uint32, uint64 |
834 ^ #pointer. |
406 ^ #pointer. |
835 ]. |
407 ]. |
836 ^ aType |
408 ^ aType |
837 |
409 |
838 "Modified: / 14-06-2007 / 17:21:42 / cg" |
410 "Modified: / 14-06-2007 / 17:21:42 / cg" |
839 ! |
411 ! ! |
|
412 |
|
413 !ExternalLibraryFunction methodsFor:'accessing'! |
|
414 |
|
415 argumentTypes |
|
416 ^ argumentTypes |
|
417 ! |
|
418 |
|
419 argumentTypesString |
|
420 ^ String |
|
421 streamContents:[:s | |
|
422 argumentTypes do:[:eachArgType | |
|
423 eachArgType printOn:s. |
|
424 ] separatedBy:[ |
|
425 s nextPutAll:','. |
|
426 ]. |
|
427 ]. |
|
428 ! |
|
429 |
|
430 beAsync |
|
431 "let this execute in a separate thread, in par with the other execution thread(s). |
|
432 Ignored under unix/linux (until those support multiple threads too)." |
|
433 |
|
434 flags := (flags ? 0) bitOr: FLAG_ASYNC. |
|
435 |
|
436 "Created: / 01-08-2006 / 13:42:38 / cg" |
|
437 ! |
|
438 |
|
439 beCallTypeAPI |
|
440 flags := (flags ? 0) bitOr: CALLTYPE_API. |
|
441 |
|
442 "Created: / 01-08-2006 / 15:12:40 / cg" |
|
443 ! |
|
444 |
|
445 beCallTypeC |
|
446 flags := (flags ? 0) bitOr: CALLTYPE_C. |
|
447 |
|
448 "Created: / 01-08-2006 / 15:12:40 / cg" |
|
449 ! |
|
450 |
|
451 beCallTypeOLE |
|
452 flags := (flags ? 0) bitOr: FLAG_VIRTUAL. |
|
453 |
|
454 "Created: / 01-08-2006 / 15:12:40 / cg" |
|
455 ! |
|
456 |
|
457 beCallTypeUNIX64 |
|
458 flags := (flags ? 0) bitOr: CALLTYPE_UNIX64. |
|
459 |
|
460 "Created: / 01-08-2006 / 15:13:38 / cg" |
|
461 ! |
|
462 |
|
463 beCallTypeV8 |
|
464 flags := (flags ? 0) bitOr: CALLTYPE_V8. |
|
465 |
|
466 "Created: / 01-08-2006 / 15:13:28 / cg" |
|
467 ! |
|
468 |
|
469 beCallTypeV9 |
|
470 flags := (flags ? 0) bitOr: CALLTYPE_V9. |
|
471 |
|
472 "Created: / 01-08-2006 / 15:13:31 / cg" |
|
473 ! |
|
474 |
|
475 beCallTypeWINAPI |
|
476 self beCallTypeAPI |
|
477 |
|
478 "Modified: / 01-08-2006 / 15:14:02 / cg" |
|
479 ! |
|
480 |
|
481 beConstReturnValue |
|
482 "specify that a pointer return value is not to be finalized |
|
483 (i.e. points to static data or data which is freed by c)" |
|
484 |
|
485 flags := (flags ? 0) bitOr: FLAG_RETVAL_IS_CONST. |
|
486 |
|
487 "Created: / 01-08-2006 / 13:56:48 / cg" |
|
488 ! |
|
489 |
|
490 beNonVirtualCPP |
|
491 "specify this as a non-virtual c++-function" |
|
492 |
|
493 flags := (flags ? 0) bitOr: FLAG_NONVIRTUAL. |
|
494 |
|
495 "Created: / 01-08-2006 / 13:56:44 / cg" |
|
496 ! |
|
497 |
|
498 beObjectiveC |
|
499 "specify this as an objective-c message send" |
|
500 |
|
501 flags := (flags ? 0) bitOr: FLAG_OBJECTIVEC. |
|
502 |
|
503 "Created: / 01-08-2006 / 13:56:48 / cg" |
|
504 ! |
|
505 |
|
506 beUnlimitedStack |
|
507 "let this execute on the c-stack (as opposed to the thread-stack) |
|
508 for unlimited auto-sized-stack under unix/linux. |
|
509 Ignored under windows." |
|
510 |
|
511 flags := (flags ? 0) bitOr: FLAG_UNLIMITEDSTACK. |
|
512 |
|
513 "Created: / 01-08-2006 / 13:41:54 / cg" |
|
514 ! |
|
515 |
|
516 beVirtualCPP |
|
517 "specify this as a virtual c++-function" |
|
518 |
|
519 flags := (flags ? 0) bitOr: FLAG_VIRTUAL. |
|
520 |
|
521 "Created: / 01-08-2006 / 13:56:48 / cg" |
|
522 ! |
|
523 |
|
524 callTypeNumber |
|
525 ^ (flags ? 0) bitAnd: CALLTYPE_MASK. |
|
526 |
|
527 "Created: / 01-08-2006 / 15:12:10 / cg" |
|
528 ! |
|
529 |
|
530 isAsync |
|
531 "is this executed in a separate thread, in par with the other execution thread(s) ?" |
|
532 |
|
533 ^ (flags ? 0) bitTest: FLAG_ASYNC. |
|
534 |
|
535 "Created: / 01-08-2006 / 13:46:53 / cg" |
|
536 ! |
|
537 |
|
538 isCPPFunction |
|
539 "is this a virtual or non-virtual c++-function ?" |
|
540 |
|
541 ^ (flags ? 0) bitTest: (FLAG_VIRTUAL bitOr: FLAG_NONVIRTUAL). |
|
542 |
|
543 "Created: / 01-08-2006 / 13:56:54 / cg" |
|
544 ! |
|
545 |
|
546 isCallTypeAPI |
|
547 "is this a windows API-call linkage call. |
|
548 Attention: this uses a different call API (callee unwinds the stack), |
|
549 and MUST be declared as such for many Kernel functions. |
|
550 The calltype API is one of the worst historic garbage kept by MS..." |
|
551 |
|
552 ^ ((flags ? 0) bitAnd: CALLTYPE_MASK) == CALLTYPE_API. |
|
553 |
|
554 "Created: / 01-08-2006 / 15:21:16 / cg" |
|
555 ! |
|
556 |
|
557 isCallTypeC |
|
558 "is this a regular C-call (attention: on windows, there are two kinds of calls)" |
|
559 |
|
560 ^ ((flags ? 0) bitAnd: CALLTYPE_MASK) == CALLTYPE_C. |
|
561 |
|
562 "Created: / 01-08-2006 / 15:21:23 / cg" |
|
563 ! |
|
564 |
|
565 isCallTypeOLE |
|
566 "is this an OLE-object call ? (eg. a virtual c++ call; same as isCallTypeCPP)" |
|
567 |
|
568 ^ ((flags ? 0) bitTest: FLAG_VIRTUAL). |
|
569 |
|
570 "Created: / 01-08-2006 / 15:21:23 / cg" |
|
571 ! |
|
572 |
|
573 isConstReturnValue |
|
574 "is the pointer return value not to be finalized |
|
575 (i.e. points to static data or data which is freed by c)" |
|
576 |
|
577 ^ (flags ? 0) bitTest: FLAG_RETVAL_IS_CONST. |
|
578 |
|
579 "Created: / 01-08-2006 / 13:56:48 / cg" |
|
580 ! |
|
581 |
|
582 isNonVirtualCPP |
|
583 "is this a non-virtual c++-function ?" |
|
584 |
|
585 ^ (flags ? 0) bitTest: FLAG_NONVIRTUAL. |
|
586 |
|
587 "Created: / 01-08-2006 / 13:56:51 / cg" |
|
588 ! |
|
589 |
|
590 isObjectiveC |
|
591 "is this an objective-C message?" |
|
592 |
|
593 ^ (flags ? 0) bitTest: FLAG_OBJECTIVEC. |
|
594 ! |
|
595 |
|
596 isUnlimitedStack |
|
597 "will this execute on the c-stack (as opposed to the thread-stack) |
|
598 for unlimited auto-sized-stack under unix/linux. |
|
599 Ignored under windows." |
|
600 |
|
601 ^ (flags ? 0) bitTest: FLAG_UNLIMITEDSTACK. |
|
602 |
|
603 "Created: / 01-08-2006 / 14:17:07 / cg" |
|
604 ! |
|
605 |
|
606 isVirtualCPP |
|
607 "is this a virtual c++-function (same as isCallTypeOLE) ?" |
|
608 |
|
609 ^ (flags ? 0) bitTest: FLAG_VIRTUAL. |
|
610 |
|
611 "Created: / 01-08-2006 / 13:56:54 / cg" |
|
612 ! |
|
613 |
|
614 moduleName |
|
615 ^ moduleName |
|
616 ! |
|
617 |
|
618 returnType |
|
619 ^ returnType |
|
620 ! |
|
621 |
|
622 vtableIndex |
|
623 name isNumber ifFalse:[^ nil]. |
|
624 ^ name. |
|
625 ! ! |
|
626 |
|
627 !ExternalLibraryFunction methodsFor:'invoking'! |
|
628 |
|
629 invoke |
|
630 self hasCode ifFalse:[ |
|
631 self prepareInvoke. |
|
632 ]. |
|
633 ^ self invokeFFIwithArguments:nil forCPPInstance:nil |
|
634 ! |
|
635 |
|
636 invokeCPPVirtualOn:anInstance |
|
637 self hasCode ifFalse:[ |
|
638 self prepareInvoke. |
|
639 ]. |
|
640 ^ self invokeCPPVirtualFFIOn:anInstance withArguments:nil |
|
641 ! |
|
642 |
|
643 invokeCPPVirtualOn:instance with:arg |
|
644 self hasCode ifFalse:[ |
|
645 self prepareInvoke. |
|
646 ]. |
|
647 ^ self invokeCPPVirtualFFIOn:instance withArguments:(Array with:arg) |
|
648 ! |
|
649 |
|
650 invokeCPPVirtualOn:instance with:arg1 with:arg2 |
|
651 self hasCode ifFalse:[ |
|
652 self prepareInvoke. |
|
653 ]. |
|
654 ^ self invokeCPPVirtualFFIOn:instance withArguments:(Array with:arg1 with:arg2) |
|
655 ! |
|
656 |
|
657 invokeCPPVirtualOn:instance with:arg1 with:arg2 with:arg3 |
|
658 self hasCode ifFalse:[ |
|
659 self prepareInvoke. |
|
660 ]. |
|
661 ^ self invokeCPPVirtualFFIOn:instance withArguments:(Array with:arg1 with:arg2 with:arg3) |
|
662 ! |
|
663 |
|
664 invokeCPPVirtualOn:instance with:arg1 with:arg2 with:arg3 with:arg4 |
|
665 self hasCode ifFalse:[ |
|
666 self prepareInvoke. |
|
667 ]. |
|
668 ^ self invokeCPPVirtualFFIOn:instance withArguments:(Array with:arg1 with:arg2 with:arg3 with:arg4) |
|
669 ! |
|
670 |
|
671 invokeCPPVirtualOn:instance withArguments:args |
|
672 self hasCode ifFalse:[ |
|
673 self prepareInvoke. |
|
674 ]. |
|
675 ^ self invokeCPPVirtualFFIOn:instance withArguments:args |
|
676 ! |
|
677 |
|
678 invokeWith:arg |
|
679 self hasCode ifFalse:[ |
|
680 self prepareInvoke. |
|
681 ]. |
|
682 ^ self invokeFFIwithArguments:(Array with:arg) forCPPInstance:nil |
|
683 ! |
|
684 |
|
685 invokeWith:arg1 with:arg2 |
|
686 self hasCode ifFalse:[ |
|
687 self prepareInvoke. |
|
688 ]. |
|
689 ^ self invokeFFIwithArguments:(Array with:arg1 with:arg2) forCPPInstance:nil |
|
690 ! |
|
691 |
|
692 invokeWith:arg1 with:arg2 with:arg3 |
|
693 self hasCode ifFalse:[ |
|
694 self prepareInvoke. |
|
695 ]. |
|
696 ^ self invokeFFIwithArguments:(Array with:arg1 with:arg2 with:arg3) forCPPInstance:nil |
|
697 ! |
|
698 |
|
699 invokeWith:arg1 with:arg2 with:arg3 with:arg4 |
|
700 self hasCode ifFalse:[ |
|
701 self prepareInvoke. |
|
702 ]. |
|
703 ^ self invokeFFIwithArguments:(Array with:arg1 with:arg2 with:arg3 with:arg4) forCPPInstance:nil |
|
704 ! |
|
705 |
|
706 invokeWithArguments:argArray |
|
707 self hasCode ifFalse:[ |
|
708 self prepareInvoke. |
|
709 ]. |
|
710 ^ self invokeFFIwithArguments:argArray forCPPInstance:nil |
|
711 |
|
712 "Modified: / 01-08-2006 / 16:04:08 / cg" |
|
713 ! ! |
|
714 |
|
715 !ExternalLibraryFunction methodsFor:'printing'! |
|
716 |
|
717 printOn:aStream |
|
718 aStream nextPutAll:'<'. |
|
719 self isCallTypeAPI ifTrue:[ |
|
720 'API:' printOn:aStream. |
|
721 ] ifFalse:[ |
|
722 self isCallTypeOLE ifTrue:[ |
|
723 'OLE:' printOn:aStream. |
|
724 ] ifFalse:[ |
|
725 self isCallTypeC ifTrue:[ |
|
726 'C:' printOn:aStream. |
|
727 ] ifFalse:[ |
|
728 self error. |
|
729 ]. |
|
730 ]. |
|
731 ]. |
|
732 aStream nextPutAll:' '. |
|
733 name printOn:aStream. |
|
734 moduleName notNil ifTrue:[ |
|
735 aStream nextPutAll:' module:'. |
|
736 moduleName printOn:aStream. |
|
737 ]. |
|
738 aStream nextPutAll:'>'. |
|
739 |
|
740 "Modified: / 25-09-2012 / 12:06:14 / cg" |
|
741 ! ! |
|
742 |
|
743 !ExternalLibraryFunction methodsFor:'private'! |
|
744 |
|
745 adjustTypes |
|
746 "map all those existing type names to a small number of definite ffi type names. |
|
747 This is needed, because there are so many different C-type names found in code imported |
|
748 from various Smalltalk dialects' library function call declarations. |
|
749 For example: all of word, WORD, unsignedShort, ushort, uShort etc. will map to uint16. |
|
750 Also, this deals with pointer size differences." |
|
751 |
|
752 argumentTypes notEmptyOrNil ifTrue:[ |
|
753 argumentTypes := argumentTypes collect:[:argType | self class ffiTypeSymbolForType:argType]. |
|
754 ]. |
|
755 returnType := self class ffiTypeSymbolForType:returnType. |
|
756 ! |
|
757 |
|
758 linkToModule |
|
759 "link this function to the external module. |
|
760 I.e. retrieve the module handle and the code pointer." |
|
761 |
|
762 |handle moduleNameUsed functionName| |
|
763 |
|
764 name isNumber ifTrue:[ |
|
765 self isCPPFunction ifTrue:[ |
|
766 "/ no need to load a dll. |
|
767 ^ self |
|
768 ] |
|
769 ]. |
|
770 |
|
771 "/ in some other smalltalks, there is no moduleName in the ffi-spec; |
|
772 "/ instead, the class provides the libraryName... |
|
773 (moduleNameUsed := moduleName) isNil ifTrue:[ |
|
774 owningClass isNil ifTrue:[ |
|
775 self error:'Missing moduleName'. |
|
776 ]. |
|
777 moduleNameUsed := owningClass theNonMetaclass libraryName asSymbol. |
|
778 ]. |
|
779 moduleHandle isNil ifTrue:[ |
|
780 "/ speedup. in 95% of all calls, the same moduleName is resolved here |
|
781 (LastModuleHandleHolder isNil |
|
782 or:[ (handle := LastModuleHandleHolder at:1) isNil |
|
783 or:[ LastModuleHandleName ~= moduleNameUsed ]]) ifTrue:[ |
|
784 |
|
785 handle := self loadLibrary:moduleNameUsed. |
|
786 handle isNil ifTrue:[ |
|
787 self error:('Cannot find or load dll/module: "%1"' bindWith: moduleNameUsed). |
|
788 ]. |
|
789 LastModuleHandleHolder := WeakArray with:handle. |
|
790 LastModuleHandleName := moduleNameUsed. |
|
791 ]. |
|
792 moduleHandle := handle. |
|
793 ]. |
|
794 name isNumber ifFalse:[ |
|
795 functionName := name. |
|
796 (moduleHandle getFunctionAddress:functionName into:self) isNil ifTrue:[ |
|
797 (moduleHandle getFunctionAddress:('_', functionName) into:self) isNil ifTrue:[ |
|
798 moduleHandle := nil. |
|
799 self error:'Missing function: ', name, ' in module: ', moduleNameUsed. |
|
800 ]. |
|
801 ]. |
|
802 ]. |
|
803 |
|
804 "Modified: / 10-04-2012 / 12:12:44 / cg" |
|
805 ! |
|
806 |
|
807 loadLibrary:dllName |
|
808 "load a dll. |
|
809 Notice the dllMapping mechanism, which can be used to silently load different dlls. |
|
810 This is useful, if some code has a hardcoded dll-name in it, which needs to be changed, |
|
811 but you do not want or cannot recompile the methods (i.e. no source avail)" |
|
812 |
|
813 |handle nameString filename| |
|
814 |
|
815 filename := dllName. |
|
816 DllMapping notNil ifTrue:[ |
|
817 filename := DllMapping at:filename ifAbsent:[ filename ] |
|
818 ]. |
|
819 |
|
820 filename := filename asFilename. |
|
821 nameString := filename name. |
|
822 |
|
823 "try to load, maybe the system knows where to find the dll" |
|
824 handle := ObjectFileLoader loadDynamicObject:filename. |
|
825 handle notNil ifTrue:[^ handle ]. |
|
826 |
|
827 filename isAbsolute ifFalse:[ |
|
828 "First ask the class defining the ExternalFunction for the location of the dlls ..." |
|
829 owningClass notNil ifTrue:[ |
|
830 owningClass dllPath do:[:eachDirectory | |
|
831 handle := ObjectFileLoader |
|
832 loadDynamicObject:(eachDirectory asFilename construct:nameString) pathName. |
|
833 handle notNil ifTrue:[^ handle ]. |
|
834 ]. |
|
835 ]. |
|
836 ".. then ask the system" |
|
837 self class dllPath do:[:eachDirectory | |
|
838 handle := ObjectFileLoader |
|
839 loadDynamicObject:(eachDirectory asFilename construct:nameString) pathName. |
|
840 handle notNil ifTrue:[^ handle ]. |
|
841 ]. |
|
842 ]. |
|
843 |
|
844 filename suffix isEmpty ifTrue:[ |
|
845 "/ try again with the OS-specific dll-extension |
|
846 ^ self loadLibrary:(filename withSuffix:ObjectFileLoader sharedLibrarySuffix) |
|
847 ]. |
|
848 |
|
849 ^ nil |
|
850 |
|
851 "Modified: / 10-04-2012 / 12:21:06 / cg" |
|
852 ! |
|
853 |
|
854 prepareInvoke |
|
855 "called before invoked. |
|
856 When called the very first time, moduleHandle is nil, |
|
857 and we ensure that the dll is loaded, the function address is extracted" |
|
858 |
|
859 (moduleHandle isNil or:[self hasCode not]) ifTrue:[ |
|
860 self linkToModule. |
|
861 self adjustTypes. |
|
862 ]. |
|
863 ! ! |
|
864 |
|
865 !ExternalLibraryFunction methodsFor:'private-accessing'! |
840 |
866 |
841 name:functionNameOrVirtualIndex module:aModuleName returnType:aReturnType argumentTypes:argTypes |
867 name:functionNameOrVirtualIndex module:aModuleName returnType:aReturnType argumentTypes:argTypes |
842 name := functionNameOrVirtualIndex. |
868 name := functionNameOrVirtualIndex. |
843 functionNameOrVirtualIndex isNumber ifTrue:[ |
869 functionNameOrVirtualIndex isNumber ifTrue:[ |
844 self beVirtualCPP. |
870 self beVirtualCPP. |