ExternalLibraryFunction.st
author ca
Fri, 11 Aug 2006 13:20:24 +0200
changeset 9525 120234adc94e
parent 9524 2af286bbcac3
child 9603 eec1a8d56cc5
permissions -rw-r--r--
const specifier (is this a good name ?)
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
8728
d70396dc4e96 copyright
Claus Gittinger <cg@exept.de>
parents: 8550
diff changeset
     1
"
d70396dc4e96 copyright
Claus Gittinger <cg@exept.de>
parents: 8550
diff changeset
     2
 COPYRIGHT (c) 2004 by eXept Software AG
9464
157fe6ca53e6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9463
diff changeset
     3
	      All Rights Reserved
8728
d70396dc4e96 copyright
Claus Gittinger <cg@exept.de>
parents: 8550
diff changeset
     4
d70396dc4e96 copyright
Claus Gittinger <cg@exept.de>
parents: 8550
diff changeset
     5
 This software is furnished under a license and may be used
d70396dc4e96 copyright
Claus Gittinger <cg@exept.de>
parents: 8550
diff changeset
     6
 only in accordance with the terms of that license and with the
d70396dc4e96 copyright
Claus Gittinger <cg@exept.de>
parents: 8550
diff changeset
     7
 inclusion of the above copyright notice.   This software may not
d70396dc4e96 copyright
Claus Gittinger <cg@exept.de>
parents: 8550
diff changeset
     8
 be provided or otherwise made available to, or used by, any
d70396dc4e96 copyright
Claus Gittinger <cg@exept.de>
parents: 8550
diff changeset
     9
 other person.  No title to or ownership of the software is
d70396dc4e96 copyright
Claus Gittinger <cg@exept.de>
parents: 8550
diff changeset
    10
 hereby transferred.
d70396dc4e96 copyright
Claus Gittinger <cg@exept.de>
parents: 8550
diff changeset
    11
"
d70396dc4e96 copyright
Claus Gittinger <cg@exept.de>
parents: 8550
diff changeset
    12
8533
9065c547ea75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    13
"{ Package: 'stx:libbasic' }"
9065c547ea75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    14
9065c547ea75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    15
ExternalFunction subclass:#ExternalLibraryFunction
9465
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
    16
	instanceVariableNames:'flags moduleName returnType argumentTypes owningClass'
9464
157fe6ca53e6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9463
diff changeset
    17
	classVariableNames:'FLAG_VIRTUAL FLAG_NONVIRTUAL FLAG_ASYNC FLAG_UNLIMITEDSTACK
9525
120234adc94e const specifier (is this a good name ?)
ca
parents: 9524
diff changeset
    18
		FLAG_RETVAL_IS_CONST CALLTYPE_MASK CALLTYPE_API CALLTYPE_C
120234adc94e const specifier (is this a good name ?)
ca
parents: 9524
diff changeset
    19
		CALLTYPE_OLE CALLTYPE_V8 CALLTYPE_V9 CALLTYPE_UNIX64'
9464
157fe6ca53e6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9463
diff changeset
    20
	poolDictionaries:''
157fe6ca53e6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9463
diff changeset
    21
	category:'System-Support'
8533
9065c547ea75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    22
!
9065c547ea75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    23
9322
41c391bfbf03 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9321
diff changeset
    24
!ExternalLibraryFunction primitiveDefinitions!
41c391bfbf03 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9321
diff changeset
    25
%{
41c391bfbf03 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9321
diff changeset
    26
9337
ab6bbf58bf0a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9336
diff changeset
    27
/*
ab6bbf58bf0a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9336
diff changeset
    28
 * does this architecture support FFI ?
9365
9003f8432516 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9347
diff changeset
    29
 * NOTICE: this is now defined in the architecture-specific configuration file.
9337
ab6bbf58bf0a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9336
diff changeset
    30
 */
9365
9003f8432516 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9347
diff changeset
    31
#if defined(WIN32) || defined(LINUX)
9003f8432516 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9347
diff changeset
    32
# ifndef HAVE_FFI
9003f8432516 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9347
diff changeset
    33
#  define HAVE_FFI
9003f8432516 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9347
diff changeset
    34
# endif
9337
ab6bbf58bf0a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9336
diff changeset
    35
#endif
ab6bbf58bf0a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9336
diff changeset
    36
ab6bbf58bf0a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9336
diff changeset
    37
ab6bbf58bf0a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9336
diff changeset
    38
#ifdef HAVE_FFI
ab6bbf58bf0a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9336
diff changeset
    39
# include <ffi.h>
9322
41c391bfbf03 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9321
diff changeset
    40
# define MAX_ARGS    128
9365
9003f8432516 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9347
diff changeset
    41
9003f8432516 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9347
diff changeset
    42
extern ffi_type *__get_ffi_type_sint();
9003f8432516 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9347
diff changeset
    43
extern ffi_type *__get_ffi_type_sint8();
9003f8432516 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9347
diff changeset
    44
extern ffi_type *__get_ffi_type_sint16();
9003f8432516 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9347
diff changeset
    45
extern ffi_type *__get_ffi_type_sint32();
9003f8432516 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9347
diff changeset
    46
extern ffi_type *__get_ffi_type_sint64();
9003f8432516 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9347
diff changeset
    47
extern ffi_type *__get_ffi_type_uint();
9003f8432516 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9347
diff changeset
    48
extern ffi_type *__get_ffi_type_uint8();
9003f8432516 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9347
diff changeset
    49
extern ffi_type *__get_ffi_type_uint16();
9003f8432516 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9347
diff changeset
    50
extern ffi_type *__get_ffi_type_uint32();
9003f8432516 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9347
diff changeset
    51
extern ffi_type *__get_ffi_type_uint64();
9003f8432516 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9347
diff changeset
    52
extern ffi_type *__get_ffi_type_float();
9003f8432516 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9347
diff changeset
    53
extern ffi_type *__get_ffi_type_double();
9003f8432516 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9347
diff changeset
    54
extern ffi_type *__get_ffi_type_void();
9003f8432516 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9347
diff changeset
    55
extern ffi_type *__get_ffi_type_pointer();
9003f8432516 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9347
diff changeset
    56
9337
ab6bbf58bf0a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9336
diff changeset
    57
#endif
9322
41c391bfbf03 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9321
diff changeset
    58
41c391bfbf03 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9321
diff changeset
    59
%}
41c391bfbf03 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9321
diff changeset
    60
! !
41c391bfbf03 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9321
diff changeset
    61
8728
d70396dc4e96 copyright
Claus Gittinger <cg@exept.de>
parents: 8550
diff changeset
    62
!ExternalLibraryFunction class methodsFor:'documentation'!
d70396dc4e96 copyright
Claus Gittinger <cg@exept.de>
parents: 8550
diff changeset
    63
d70396dc4e96 copyright
Claus Gittinger <cg@exept.de>
parents: 8550
diff changeset
    64
copyright
d70396dc4e96 copyright
Claus Gittinger <cg@exept.de>
parents: 8550
diff changeset
    65
"
d70396dc4e96 copyright
Claus Gittinger <cg@exept.de>
parents: 8550
diff changeset
    66
 COPYRIGHT (c) 2004 by eXept Software AG
9464
157fe6ca53e6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9463
diff changeset
    67
	      All Rights Reserved
8728
d70396dc4e96 copyright
Claus Gittinger <cg@exept.de>
parents: 8550
diff changeset
    68
d70396dc4e96 copyright
Claus Gittinger <cg@exept.de>
parents: 8550
diff changeset
    69
 This software is furnished under a license and may be used
d70396dc4e96 copyright
Claus Gittinger <cg@exept.de>
parents: 8550
diff changeset
    70
 only in accordance with the terms of that license and with the
d70396dc4e96 copyright
Claus Gittinger <cg@exept.de>
parents: 8550
diff changeset
    71
 inclusion of the above copyright notice.   This software may not
d70396dc4e96 copyright
Claus Gittinger <cg@exept.de>
parents: 8550
diff changeset
    72
 be provided or otherwise made available to, or used by, any
d70396dc4e96 copyright
Claus Gittinger <cg@exept.de>
parents: 8550
diff changeset
    73
 other person.  No title to or ownership of the software is
d70396dc4e96 copyright
Claus Gittinger <cg@exept.de>
parents: 8550
diff changeset
    74
 hereby transferred.
d70396dc4e96 copyright
Claus Gittinger <cg@exept.de>
parents: 8550
diff changeset
    75
"
9322
41c391bfbf03 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9321
diff changeset
    76
!
41c391bfbf03 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9321
diff changeset
    77
9331
c26a7de1468c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9330
diff changeset
    78
documentation
c26a7de1468c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9330
diff changeset
    79
"
c26a7de1468c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9330
diff changeset
    80
    instances of me are used to interface to external library functions (as found in a dll/shared object).
c26a7de1468c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9330
diff changeset
    81
    When a special external-call pragma such as:
9464
157fe6ca53e6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9463
diff changeset
    82
	<api: bool MessageBeep(uint)>
9331
c26a7de1468c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9330
diff changeset
    83
c26a7de1468c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9330
diff changeset
    84
    is encountered by the parser in a method, the compiler generates a call via
9464
157fe6ca53e6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9463
diff changeset
    85
	<correspondingExternalLibraryFunctionObject> invokeWithArguments: argumentArray.
9331
c26a7de1468c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9330
diff changeset
    86
c26a7de1468c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9330
diff changeset
    87
    In the invoke method, the library is checked to be loaded (and loaded if not already),
9336
f604a89f17f5 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9331
diff changeset
    88
    the arguments are converted to C and pushed onto the C-stack, the function is called,
9331
c26a7de1468c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9330
diff changeset
    89
    and finally, the return value is converted back from C to a smalltalk object.
c26a7de1468c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9330
diff changeset
    90
"
c26a7de1468c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9330
diff changeset
    91
!
c26a7de1468c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9330
diff changeset
    92
9322
41c391bfbf03 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9321
diff changeset
    93
example
41c391bfbf03 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9321
diff changeset
    94
"
9464
157fe6ca53e6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9463
diff changeset
    95
								[exBegin]
157fe6ca53e6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9463
diff changeset
    96
	|f|
9322
41c391bfbf03 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9321
diff changeset
    97
9464
157fe6ca53e6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9463
diff changeset
    98
	f := ExternalLibraryFunction new.
157fe6ca53e6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9463
diff changeset
    99
	f name:'MessageBeep'
157fe6ca53e6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9463
diff changeset
   100
	  module:'user32.dll'
157fe6ca53e6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9463
diff changeset
   101
	  callType:#WINAPI
157fe6ca53e6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9463
diff changeset
   102
	  returnType:#boolean
157fe6ca53e6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9463
diff changeset
   103
	  argumentTypes:#(uint).
9322
41c391bfbf03 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9321
diff changeset
   104
9464
157fe6ca53e6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9463
diff changeset
   105
	f invokeWith:1.
157fe6ca53e6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9463
diff changeset
   106
								[exEnd]
9322
41c391bfbf03 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9321
diff changeset
   107
"
8728
d70396dc4e96 copyright
Claus Gittinger <cg@exept.de>
parents: 8550
diff changeset
   108
! !
8533
9065c547ea75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   109
8550
72982f85bd41 *** empty log message ***
ca
parents: 8533
diff changeset
   110
!ExternalLibraryFunction class methodsFor:'instance creation'!
72982f85bd41 *** empty log message ***
ca
parents: 8533
diff changeset
   111
9465
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   112
name:functionName module:moduleName returnType:returnType argumentTypes:argTypes
8550
72982f85bd41 *** empty log message ***
ca
parents: 8533
diff changeset
   113
    ^ self new
9465
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   114
        name:functionName module:moduleName 
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   115
        returnType:returnType argumentTypes:argTypes
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   116
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   117
    "Created: / 01-08-2006 / 15:19:08 / cg"
9463
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   118
! !
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   119
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   120
!ExternalLibraryFunction class methodsFor:'class initialization'!
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   121
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   122
initialize
9465
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   123
    FLAG_VIRTUAL := 16r100.          "/ a virtual c++ call
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   124
    FLAG_NONVIRTUAL := 16r200.       "/ a non-virtual c++ call
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   125
    FLAG_UNLIMITEDSTACK := 16r400.   "/ unlimitedstack under unix
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   126
    FLAG_ASYNC := 16r800.            "/ async under win32
9525
120234adc94e const specifier (is this a good name ?)
ca
parents: 9524
diff changeset
   127
    FLAG_RETVAL_IS_CONST := 16r1000. "/ return value is not to be registered for finalization
9463
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   128
9465
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   129
    CALLTYPE_API := 1.               "/ WINAPI-call (win32 only)
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   130
    CALLTYPE_C := 2.                 "/ regular C-call (the default)
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   131
    CALLTYPE_V8 := 3.                "/ v8 call (sparc only)
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   132
    CALLTYPE_V9 := 4.                "/ v9 call (sparc only)
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   133
    CALLTYPE_UNIX64 := 5.            "/ unix64 call (alpha only)
9463
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   134
9465
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   135
    CALLTYPE_MASK := 16rFF.
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   136
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   137
    "Modified: / 01-08-2006 / 15:09:36 / cg"
8550
72982f85bd41 *** empty log message ***
ca
parents: 8533
diff changeset
   138
! !
72982f85bd41 *** empty log message ***
ca
parents: 8533
diff changeset
   139
9321
734c7c432461 not yet finished
Claus Gittinger <cg@exept.de>
parents: 8891
diff changeset
   140
!ExternalLibraryFunction class methodsFor:'constants'!
734c7c432461 not yet finished
Claus Gittinger <cg@exept.de>
parents: 8891
diff changeset
   141
734c7c432461 not yet finished
Claus Gittinger <cg@exept.de>
parents: 8891
diff changeset
   142
callTypeAPI
9463
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   143
    ^ CALLTYPE_API
9321
734c7c432461 not yet finished
Claus Gittinger <cg@exept.de>
parents: 8891
diff changeset
   144
9463
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   145
    "Modified: / 01-08-2006 / 13:44:41 / cg"
9435
68f7e39efad7 support of asynchronous calls
ca
parents: 9418
diff changeset
   146
!
68f7e39efad7 support of asynchronous calls
ca
parents: 9418
diff changeset
   147
9321
734c7c432461 not yet finished
Claus Gittinger <cg@exept.de>
parents: 8891
diff changeset
   148
callTypeC
9463
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   149
    ^ CALLTYPE_C
9321
734c7c432461 not yet finished
Claus Gittinger <cg@exept.de>
parents: 8891
diff changeset
   150
9463
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   151
    "Modified: / 01-08-2006 / 13:44:49 / cg"
9435
68f7e39efad7 support of asynchronous calls
ca
parents: 9418
diff changeset
   152
!
68f7e39efad7 support of asynchronous calls
ca
parents: 9418
diff changeset
   153
9321
734c7c432461 not yet finished
Claus Gittinger <cg@exept.de>
parents: 8891
diff changeset
   154
callTypeCDecl
9463
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   155
    ^ CALLTYPE_C
9321
734c7c432461 not yet finished
Claus Gittinger <cg@exept.de>
parents: 8891
diff changeset
   156
9463
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   157
    "Modified: / 01-08-2006 / 13:44:52 / cg"
9435
68f7e39efad7 support of asynchronous calls
ca
parents: 9418
diff changeset
   158
!
68f7e39efad7 support of asynchronous calls
ca
parents: 9418
diff changeset
   159
9321
734c7c432461 not yet finished
Claus Gittinger <cg@exept.de>
parents: 8891
diff changeset
   160
callTypeOLE
9463
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   161
    ^ CALLTYPE_OLE
9435
68f7e39efad7 support of asynchronous calls
ca
parents: 9418
diff changeset
   162
9463
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   163
    "Modified: / 01-08-2006 / 13:44:57 / cg"
9321
734c7c432461 not yet finished
Claus Gittinger <cg@exept.de>
parents: 8891
diff changeset
   164
! !
734c7c432461 not yet finished
Claus Gittinger <cg@exept.de>
parents: 8891
diff changeset
   165
734c7c432461 not yet finished
Claus Gittinger <cg@exept.de>
parents: 8891
diff changeset
   166
!ExternalLibraryFunction methodsFor:'accessing'!
734c7c432461 not yet finished
Claus Gittinger <cg@exept.de>
parents: 8891
diff changeset
   167
734c7c432461 not yet finished
Claus Gittinger <cg@exept.de>
parents: 8891
diff changeset
   168
argumentTypes
734c7c432461 not yet finished
Claus Gittinger <cg@exept.de>
parents: 8891
diff changeset
   169
    ^ argumentTypes
9463
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   170
!
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   171
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   172
beAsync
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   173
    "let this execute in a separate thread, in par with the other execution thread(s).
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   174
     Ignored under unix/linux (until those support multiple threads too)."
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   175
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   176
    flags := (flags ? 0) bitOr: FLAG_ASYNC.
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   177
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   178
    "Created: / 01-08-2006 / 13:42:38 / cg"
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   179
!
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   180
9465
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   181
beCallTypeAPI
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   182
    flags := (flags ? 0) bitOr: CALLTYPE_API.
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   183
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   184
    "Created: / 01-08-2006 / 15:12:40 / cg"
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   185
!
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   186
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   187
beCallTypeC
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   188
    flags := (flags ? 0) bitOr: CALLTYPE_C.
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   189
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   190
    "Created: / 01-08-2006 / 15:12:40 / cg"
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   191
!
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   192
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   193
beCallTypeUNIX64
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   194
    flags := (flags ? 0) bitOr: CALLTYPE_UNIX64.
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   195
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   196
    "Created: / 01-08-2006 / 15:13:38 / cg"
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   197
!
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   198
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   199
beCallTypeV8
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   200
    flags := (flags ? 0) bitOr: CALLTYPE_V8.
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   201
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   202
    "Created: / 01-08-2006 / 15:13:28 / cg"
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   203
!
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   204
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   205
beCallTypeV9
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   206
    flags := (flags ? 0) bitOr: CALLTYPE_V9.
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   207
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   208
    "Created: / 01-08-2006 / 15:13:31 / cg"
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   209
!
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   210
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   211
beCallTypeWINAPI
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   212
    self beCallTypeAPI
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   213
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   214
    "Modified: / 01-08-2006 / 15:14:02 / cg"
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   215
!
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   216
9525
120234adc94e const specifier (is this a good name ?)
ca
parents: 9524
diff changeset
   217
beConstReturnValue
120234adc94e const specifier (is this a good name ?)
ca
parents: 9524
diff changeset
   218
    "specify that a pointer return value is not to be finalized 
120234adc94e const specifier (is this a good name ?)
ca
parents: 9524
diff changeset
   219
     (i.e. points to static data or data which is freed by c)"
120234adc94e const specifier (is this a good name ?)
ca
parents: 9524
diff changeset
   220
120234adc94e const specifier (is this a good name ?)
ca
parents: 9524
diff changeset
   221
    flags := (flags ? 0) bitOr: FLAG_RETVAL_IS_CONST.
120234adc94e const specifier (is this a good name ?)
ca
parents: 9524
diff changeset
   222
120234adc94e const specifier (is this a good name ?)
ca
parents: 9524
diff changeset
   223
    "Created: / 01-08-2006 / 13:56:48 / cg"
120234adc94e const specifier (is this a good name ?)
ca
parents: 9524
diff changeset
   224
!
120234adc94e const specifier (is this a good name ?)
ca
parents: 9524
diff changeset
   225
9463
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   226
beNonVirtualCPP
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   227
    "specify this as a non-virtual c++-function"
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   228
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   229
    flags := (flags ? 0) bitOr: FLAG_NONVIRTUAL.
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   230
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   231
    "Created: / 01-08-2006 / 13:56:44 / cg"
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   232
!
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   233
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   234
beUnlimitedStack
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   235
    "let this execute on the c-stack (as opposed to the thread-stack)
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   236
     for unlimited auto-sized-stack under unix/linux.
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   237
     Ignored under windows."
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   238
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   239
    flags := (flags ? 0) bitOr: FLAG_UNLIMITEDSTACK.
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   240
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   241
    "Created: / 01-08-2006 / 13:41:54 / cg"
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   242
!
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   243
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   244
beVirtualCPP
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   245
    "specify this as a virtual c++-function"
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   246
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   247
    flags := (flags ? 0) bitOr: FLAG_VIRTUAL.
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   248
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   249
    "Created: / 01-08-2006 / 13:56:48 / cg"
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   250
!
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   251
9465
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   252
callTypeNumber
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   253
    ^ (flags ? 0) bitAnd: CALLTYPE_MASK.
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   254
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   255
    "Created: / 01-08-2006 / 15:12:10 / cg"
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   256
!
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   257
9463
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   258
isAsync
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   259
    "is this executed in a separate thread, in par with the other execution thread(s) ?"
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   260
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   261
    ^ (flags ? 0) bitTest: FLAG_ASYNC.
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   262
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   263
    "Created: / 01-08-2006 / 13:46:53 / cg"
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   264
!
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   265
9519
ad18bf96758d *** empty log message ***
ca
parents: 9483
diff changeset
   266
isCPPFunction
ad18bf96758d *** empty log message ***
ca
parents: 9483
diff changeset
   267
    "is this a virtual or non-virtual c++-function ?"
ad18bf96758d *** empty log message ***
ca
parents: 9483
diff changeset
   268
ad18bf96758d *** empty log message ***
ca
parents: 9483
diff changeset
   269
    ^ (flags ? 0) bitTest: (FLAG_VIRTUAL bitOr: FLAG_NONVIRTUAL).
ad18bf96758d *** empty log message ***
ca
parents: 9483
diff changeset
   270
ad18bf96758d *** empty log message ***
ca
parents: 9483
diff changeset
   271
    "Created: / 01-08-2006 / 13:56:54 / cg"
ad18bf96758d *** empty log message ***
ca
parents: 9483
diff changeset
   272
!
ad18bf96758d *** empty log message ***
ca
parents: 9483
diff changeset
   273
9465
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   274
isCallTypeAPI
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   275
    ^ ((flags ? 0) bitAnd: CALLTYPE_MASK) == CALLTYPE_API.
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   276
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   277
    "Created: / 01-08-2006 / 15:21:16 / cg"
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   278
!
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   279
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   280
isCallTypeC
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   281
    ^ ((flags ? 0) bitAnd: CALLTYPE_MASK) == CALLTYPE_C.
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   282
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   283
    "Created: / 01-08-2006 / 15:21:23 / cg"
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   284
!
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   285
9525
120234adc94e const specifier (is this a good name ?)
ca
parents: 9524
diff changeset
   286
isConstReturnValue
120234adc94e const specifier (is this a good name ?)
ca
parents: 9524
diff changeset
   287
    "is the pointer return value not to be finalized 
120234adc94e const specifier (is this a good name ?)
ca
parents: 9524
diff changeset
   288
     (i.e. points to static data or data which is freed by c)"
120234adc94e const specifier (is this a good name ?)
ca
parents: 9524
diff changeset
   289
120234adc94e const specifier (is this a good name ?)
ca
parents: 9524
diff changeset
   290
    ^ (flags ? 0) bitTest: FLAG_RETVAL_IS_CONST.
120234adc94e const specifier (is this a good name ?)
ca
parents: 9524
diff changeset
   291
120234adc94e const specifier (is this a good name ?)
ca
parents: 9524
diff changeset
   292
    "Created: / 01-08-2006 / 13:56:48 / cg"
120234adc94e const specifier (is this a good name ?)
ca
parents: 9524
diff changeset
   293
!
120234adc94e const specifier (is this a good name ?)
ca
parents: 9524
diff changeset
   294
9463
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   295
isNonVirtualCPP
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   296
    "is this a non-virtual c++-function ?"
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   297
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   298
    ^ (flags ? 0) bitTest: FLAG_NONVIRTUAL.
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   299
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   300
    "Created: / 01-08-2006 / 13:56:51 / cg"
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   301
!
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   302
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   303
isUnlimitedStack
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   304
    "will this execute on the c-stack (as opposed to the thread-stack)
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   305
     for unlimited auto-sized-stack under unix/linux.
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   306
     Ignored under windows."
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   307
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   308
    ^ (flags ? 0) bitTest: FLAG_UNLIMITEDSTACK.
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   309
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   310
    "Created: / 01-08-2006 / 14:17:07 / cg"
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   311
!
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   312
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   313
isVirtualCPP
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   314
    "is this a virtual c++-function ?"
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   315
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   316
    ^ (flags ? 0) bitTest: FLAG_VIRTUAL.
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   317
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   318
    "Created: / 01-08-2006 / 13:56:54 / cg"
9321
734c7c432461 not yet finished
Claus Gittinger <cg@exept.de>
parents: 8891
diff changeset
   319
! !
734c7c432461 not yet finished
Claus Gittinger <cg@exept.de>
parents: 8891
diff changeset
   320
8891
c30a030ff5ec more FFI (foreign function interface) support - still incomplete
Stefan Vogel <sv@exept.de>
parents: 8728
diff changeset
   321
!ExternalLibraryFunction methodsFor:'invoking'!
c30a030ff5ec more FFI (foreign function interface) support - still incomplete
Stefan Vogel <sv@exept.de>
parents: 8728
diff changeset
   322
c30a030ff5ec more FFI (foreign function interface) support - still incomplete
Stefan Vogel <sv@exept.de>
parents: 8728
diff changeset
   323
invoke
9321
734c7c432461 not yet finished
Claus Gittinger <cg@exept.de>
parents: 8891
diff changeset
   324
    self hasCode ifFalse:[
9464
157fe6ca53e6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9463
diff changeset
   325
	self prepareInvoke.
8891
c30a030ff5ec more FFI (foreign function interface) support - still incomplete
Stefan Vogel <sv@exept.de>
parents: 8728
diff changeset
   326
    ].
9321
734c7c432461 not yet finished
Claus Gittinger <cg@exept.de>
parents: 8891
diff changeset
   327
    ^ self invokeFFIWithArguments:#()
8891
c30a030ff5ec more FFI (foreign function interface) support - still incomplete
Stefan Vogel <sv@exept.de>
parents: 8728
diff changeset
   328
!
c30a030ff5ec more FFI (foreign function interface) support - still incomplete
Stefan Vogel <sv@exept.de>
parents: 8728
diff changeset
   329
9347
31adc57e6954 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9346
diff changeset
   330
invokeCPPVirtualOn:anInstance
9341
719fcf48695b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9340
diff changeset
   331
    self hasCode ifFalse:[
719fcf48695b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9340
diff changeset
   332
        self prepareInvoke.
719fcf48695b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9340
diff changeset
   333
    ].
9347
31adc57e6954 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9346
diff changeset
   334
    ^ self invokeCPPVirtualFFIOn:anInstance withArguments:#()
9341
719fcf48695b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9340
diff changeset
   335
!
719fcf48695b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9340
diff changeset
   336
9347
31adc57e6954 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9346
diff changeset
   337
invokeCPPVirtualOn:instance with:arg
9341
719fcf48695b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9340
diff changeset
   338
    self hasCode ifFalse:[
719fcf48695b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9340
diff changeset
   339
        self prepareInvoke.
719fcf48695b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9340
diff changeset
   340
    ].
9347
31adc57e6954 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9346
diff changeset
   341
    ^ self invokeCPPVirtualFFIOn:instance withArguments:(Array with:arg)
9341
719fcf48695b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9340
diff changeset
   342
!
719fcf48695b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9340
diff changeset
   343
9347
31adc57e6954 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9346
diff changeset
   344
invokeCPPVirtualOn:instance with:arg1 with:arg2
9341
719fcf48695b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9340
diff changeset
   345
    self hasCode ifFalse:[
719fcf48695b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9340
diff changeset
   346
        self prepareInvoke.
719fcf48695b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9340
diff changeset
   347
    ].
9347
31adc57e6954 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9346
diff changeset
   348
    ^ self invokeCPPVirtualFFIOn:instance withArguments:(Array with:arg1 with:arg2)
9341
719fcf48695b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9340
diff changeset
   349
!
719fcf48695b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9340
diff changeset
   350
9347
31adc57e6954 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9346
diff changeset
   351
invokeCPPVirtualOn:instance with:arg1 with:arg2 with:arg3
9341
719fcf48695b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9340
diff changeset
   352
    self hasCode ifFalse:[
719fcf48695b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9340
diff changeset
   353
        self prepareInvoke.
719fcf48695b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9340
diff changeset
   354
    ].
9347
31adc57e6954 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9346
diff changeset
   355
    ^ self invokeCPPVirtualFFIOn:instance withArguments:(Array with:arg1 with:arg2 with:arg3)
9341
719fcf48695b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9340
diff changeset
   356
!
719fcf48695b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9340
diff changeset
   357
9347
31adc57e6954 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9346
diff changeset
   358
invokeCPPVirtualOn:instance with:arg1 with:arg2 with:arg3 with:arg4
9341
719fcf48695b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9340
diff changeset
   359
    self hasCode ifFalse:[
719fcf48695b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9340
diff changeset
   360
        self prepareInvoke.
719fcf48695b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9340
diff changeset
   361
    ].
9347
31adc57e6954 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9346
diff changeset
   362
    ^ self invokeCPPVirtualFFIOn:instance withArguments:(Array with:arg1 with:arg2 with:arg3 with:arg4)
9341
719fcf48695b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9340
diff changeset
   363
!
719fcf48695b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9340
diff changeset
   364
8891
c30a030ff5ec more FFI (foreign function interface) support - still incomplete
Stefan Vogel <sv@exept.de>
parents: 8728
diff changeset
   365
invokeWith:arg
9321
734c7c432461 not yet finished
Claus Gittinger <cg@exept.de>
parents: 8891
diff changeset
   366
    self hasCode ifFalse:[
9464
157fe6ca53e6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9463
diff changeset
   367
	self prepareInvoke.
9321
734c7c432461 not yet finished
Claus Gittinger <cg@exept.de>
parents: 8891
diff changeset
   368
    ].
734c7c432461 not yet finished
Claus Gittinger <cg@exept.de>
parents: 8891
diff changeset
   369
    ^ self invokeFFIWithArguments:(Array with:arg)
734c7c432461 not yet finished
Claus Gittinger <cg@exept.de>
parents: 8891
diff changeset
   370
!
8891
c30a030ff5ec more FFI (foreign function interface) support - still incomplete
Stefan Vogel <sv@exept.de>
parents: 8728
diff changeset
   371
9321
734c7c432461 not yet finished
Claus Gittinger <cg@exept.de>
parents: 8891
diff changeset
   372
invokeWith:arg1 with:arg2
734c7c432461 not yet finished
Claus Gittinger <cg@exept.de>
parents: 8891
diff changeset
   373
    self hasCode ifFalse:[
9464
157fe6ca53e6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9463
diff changeset
   374
	self prepareInvoke.
8891
c30a030ff5ec more FFI (foreign function interface) support - still incomplete
Stefan Vogel <sv@exept.de>
parents: 8728
diff changeset
   375
    ].
9321
734c7c432461 not yet finished
Claus Gittinger <cg@exept.de>
parents: 8891
diff changeset
   376
    ^ self invokeFFIWithArguments:(Array with:arg1 with:arg2)
734c7c432461 not yet finished
Claus Gittinger <cg@exept.de>
parents: 8891
diff changeset
   377
!
734c7c432461 not yet finished
Claus Gittinger <cg@exept.de>
parents: 8891
diff changeset
   378
734c7c432461 not yet finished
Claus Gittinger <cg@exept.de>
parents: 8891
diff changeset
   379
invokeWith:arg1 with:arg2 with:arg3
734c7c432461 not yet finished
Claus Gittinger <cg@exept.de>
parents: 8891
diff changeset
   380
    self hasCode ifFalse:[
9464
157fe6ca53e6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9463
diff changeset
   381
	self prepareInvoke.
9321
734c7c432461 not yet finished
Claus Gittinger <cg@exept.de>
parents: 8891
diff changeset
   382
    ].
734c7c432461 not yet finished
Claus Gittinger <cg@exept.de>
parents: 8891
diff changeset
   383
    ^ self invokeFFIWithArguments:(Array with:arg1 with:arg2 with:arg3)
734c7c432461 not yet finished
Claus Gittinger <cg@exept.de>
parents: 8891
diff changeset
   384
!
8891
c30a030ff5ec more FFI (foreign function interface) support - still incomplete
Stefan Vogel <sv@exept.de>
parents: 8728
diff changeset
   385
9321
734c7c432461 not yet finished
Claus Gittinger <cg@exept.de>
parents: 8891
diff changeset
   386
invokeWith:arg1 with:arg2 with:arg3 with:arg4
734c7c432461 not yet finished
Claus Gittinger <cg@exept.de>
parents: 8891
diff changeset
   387
    self hasCode ifFalse:[
9464
157fe6ca53e6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9463
diff changeset
   388
	self prepareInvoke.
9321
734c7c432461 not yet finished
Claus Gittinger <cg@exept.de>
parents: 8891
diff changeset
   389
    ].
734c7c432461 not yet finished
Claus Gittinger <cg@exept.de>
parents: 8891
diff changeset
   390
    ^ self invokeFFIWithArguments:(Array with:arg1 with:arg2 with:arg3 with:arg4)
734c7c432461 not yet finished
Claus Gittinger <cg@exept.de>
parents: 8891
diff changeset
   391
!
8891
c30a030ff5ec more FFI (foreign function interface) support - still incomplete
Stefan Vogel <sv@exept.de>
parents: 8728
diff changeset
   392
9321
734c7c432461 not yet finished
Claus Gittinger <cg@exept.de>
parents: 8891
diff changeset
   393
invokeWithArguments:argArray
734c7c432461 not yet finished
Claus Gittinger <cg@exept.de>
parents: 8891
diff changeset
   394
    self hasCode ifFalse:[
9465
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   395
        self prepareInvoke.
9321
734c7c432461 not yet finished
Claus Gittinger <cg@exept.de>
parents: 8891
diff changeset
   396
    ].
9465
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   397
    ^ self invokeFFIwithArguments:argArray forCPPInstance:nil
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   398
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   399
    "Modified: / 01-08-2006 / 16:04:08 / cg"
9321
734c7c432461 not yet finished
Claus Gittinger <cg@exept.de>
parents: 8891
diff changeset
   400
! !
734c7c432461 not yet finished
Claus Gittinger <cg@exept.de>
parents: 8891
diff changeset
   401
734c7c432461 not yet finished
Claus Gittinger <cg@exept.de>
parents: 8891
diff changeset
   402
!ExternalLibraryFunction methodsFor:'printing'!
734c7c432461 not yet finished
Claus Gittinger <cg@exept.de>
parents: 8891
diff changeset
   403
734c7c432461 not yet finished
Claus Gittinger <cg@exept.de>
parents: 8891
diff changeset
   404
printOn:aStream
734c7c432461 not yet finished
Claus Gittinger <cg@exept.de>
parents: 8891
diff changeset
   405
    aStream nextPutAll:'<'.
9465
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   406
    self isCallTypeAPI ifTrue:[
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   407
        'API:' printOn:aStream.
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   408
    ] ifFalse:[
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   409
        'C:' printOn:aStream.
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   410
    ].
9321
734c7c432461 not yet finished
Claus Gittinger <cg@exept.de>
parents: 8891
diff changeset
   411
    aStream nextPutAll:' '.
734c7c432461 not yet finished
Claus Gittinger <cg@exept.de>
parents: 8891
diff changeset
   412
    name printOn:aStream.
9465
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   413
    moduleName notNil ifTrue:[
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   414
        aStream nextPutAll:' module:'.
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   415
        moduleName printOn:aStream.
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   416
    ].
9321
734c7c432461 not yet finished
Claus Gittinger <cg@exept.de>
parents: 8891
diff changeset
   417
    aStream nextPutAll:'>'.
9465
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   418
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   419
    "Modified: / 01-08-2006 / 15:21:42 / cg"
8891
c30a030ff5ec more FFI (foreign function interface) support - still incomplete
Stefan Vogel <sv@exept.de>
parents: 8728
diff changeset
   420
! !
c30a030ff5ec more FFI (foreign function interface) support - still incomplete
Stefan Vogel <sv@exept.de>
parents: 8728
diff changeset
   421
c30a030ff5ec more FFI (foreign function interface) support - still incomplete
Stefan Vogel <sv@exept.de>
parents: 8728
diff changeset
   422
!ExternalLibraryFunction methodsFor:'private'!
c30a030ff5ec more FFI (foreign function interface) support - still incomplete
Stefan Vogel <sv@exept.de>
parents: 8728
diff changeset
   423
c30a030ff5ec more FFI (foreign function interface) support - still incomplete
Stefan Vogel <sv@exept.de>
parents: 8728
diff changeset
   424
linkToModule
c30a030ff5ec more FFI (foreign function interface) support - still incomplete
Stefan Vogel <sv@exept.de>
parents: 8728
diff changeset
   425
    "link this function to the external module.
c30a030ff5ec more FFI (foreign function interface) support - still incomplete
Stefan Vogel <sv@exept.de>
parents: 8728
diff changeset
   426
     I.e. retrieve the module handle and the code pointer."
c30a030ff5ec more FFI (foreign function interface) support - still incomplete
Stefan Vogel <sv@exept.de>
parents: 8728
diff changeset
   427
9465
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   428
    |handle moduleNameUsed functionName|
8891
c30a030ff5ec more FFI (foreign function interface) support - still incomplete
Stefan Vogel <sv@exept.de>
parents: 8728
diff changeset
   429
9465
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   430
    (moduleNameUsed := moduleName) isNil ifTrue:[
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   431
        owningClass isNil ifTrue:[
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   432
            self error:'Missing moduleName'.
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   433
        ].
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   434
        moduleNameUsed := owningClass theNonMetaclass libraryName asSymbol.
9321
734c7c432461 not yet finished
Claus Gittinger <cg@exept.de>
parents: 8891
diff changeset
   435
    ].
9336
f604a89f17f5 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9331
diff changeset
   436
    moduleHandle isNil ifTrue:[
9465
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   437
        handle := ObjectFileLoader loadDynamicObject:(moduleNameUsed asString).
9340
df61c7e20801 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9339
diff changeset
   438
        handle isNil ifTrue:[
df61c7e20801 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9339
diff changeset
   439
            handle := ObjectFileLoader 
9465
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   440
                        loadDynamicObject:(Filename currentDirectory construct:moduleNameUsed) pathName.
9340
df61c7e20801 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9339
diff changeset
   441
            handle isNil ifTrue:[
9465
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   442
                self error:'Cannot load module: ', moduleNameUsed.
9340
df61c7e20801 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9339
diff changeset
   443
            ].
df61c7e20801 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9339
diff changeset
   444
        ].
df61c7e20801 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9339
diff changeset
   445
        moduleHandle := handle.
8891
c30a030ff5ec more FFI (foreign function interface) support - still incomplete
Stefan Vogel <sv@exept.de>
parents: 8728
diff changeset
   446
    ].
9341
719fcf48695b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9340
diff changeset
   447
    name isNumber ifFalse:[
9393
6764de553db1 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9392
diff changeset
   448
        functionName := name.
6764de553db1 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9392
diff changeset
   449
        (moduleHandle getFunctionAddress:functionName into:self) isNil ifTrue:[
9418
df5d2576402d resolve function - if function with name not exists add an underscore in front and retry
ca
parents: 9399
diff changeset
   450
            functionName := ('_', functionName) asSymbol.
df5d2576402d resolve function - if function with name not exists add an underscore in front and retry
ca
parents: 9399
diff changeset
   451
df5d2576402d resolve function - if function with name not exists add an underscore in front and retry
ca
parents: 9399
diff changeset
   452
            (moduleHandle getFunctionAddress:functionName into:self) isNil ifTrue:[
df5d2576402d resolve function - if function with name not exists add an underscore in front and retry
ca
parents: 9399
diff changeset
   453
                moduleHandle := nil.    
9465
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   454
                self error:'Missing function: ', name, ' in module: ', moduleNameUsed.
9418
df5d2576402d resolve function - if function with name not exists add an underscore in front and retry
ca
parents: 9399
diff changeset
   455
            ].
df5d2576402d resolve function - if function with name not exists add an underscore in front and retry
ca
parents: 9399
diff changeset
   456
        ].
9321
734c7c432461 not yet finished
Claus Gittinger <cg@exept.de>
parents: 8891
diff changeset
   457
    ].
9392
11914531960a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9386
diff changeset
   458
9465
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   459
    "Modified: / 01-08-2006 / 16:24:14 / cg"
9321
734c7c432461 not yet finished
Claus Gittinger <cg@exept.de>
parents: 8891
diff changeset
   460
!
734c7c432461 not yet finished
Claus Gittinger <cg@exept.de>
parents: 8891
diff changeset
   461
734c7c432461 not yet finished
Claus Gittinger <cg@exept.de>
parents: 8891
diff changeset
   462
prepareInvoke
734c7c432461 not yet finished
Claus Gittinger <cg@exept.de>
parents: 8891
diff changeset
   463
    self hasCode ifFalse:[
9392
11914531960a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9386
diff changeset
   464
        moduleHandle isNil ifTrue:[
11914531960a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9386
diff changeset
   465
            self linkToModule.
11914531960a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9386
diff changeset
   466
        ].
8891
c30a030ff5ec more FFI (foreign function interface) support - still incomplete
Stefan Vogel <sv@exept.de>
parents: 8728
diff changeset
   467
    ].
c30a030ff5ec more FFI (foreign function interface) support - still incomplete
Stefan Vogel <sv@exept.de>
parents: 8728
diff changeset
   468
! !
c30a030ff5ec more FFI (foreign function interface) support - still incomplete
Stefan Vogel <sv@exept.de>
parents: 8728
diff changeset
   469
8550
72982f85bd41 *** empty log message ***
ca
parents: 8533
diff changeset
   470
!ExternalLibraryFunction methodsFor:'private-accessing'!
72982f85bd41 *** empty log message ***
ca
parents: 8533
diff changeset
   471
9327
9c15276d61e3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9324
diff changeset
   472
ffiTypeSymbolForType:aType
9340
df61c7e20801 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9339
diff changeset
   473
    |t|
9322
41c391bfbf03 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9321
diff changeset
   474
41c391bfbf03 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9321
diff changeset
   475
    "/ kludge for those who do not have the CType package...
9340
df61c7e20801 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9339
diff changeset
   476
    t := aType.
9483
3bea515ce81e *** empty log message ***
fm
parents: 9479
diff changeset
   477
    t isSymbol ifTrue:[
3bea515ce81e *** empty log message ***
fm
parents: 9479
diff changeset
   478
        t == #int8 ifTrue:[^ #sint8 ].
3bea515ce81e *** empty log message ***
fm
parents: 9479
diff changeset
   479
        t == #int16 ifTrue:[^ #sint16 ].
3bea515ce81e *** empty log message ***
fm
parents: 9479
diff changeset
   480
        t == #int32 ifTrue:[^ #sint32 ].
3bea515ce81e *** empty log message ***
fm
parents: 9479
diff changeset
   481
        t == #int64 ifTrue:[^ #sint64 ].
3bea515ce81e *** empty log message ***
fm
parents: 9479
diff changeset
   482
        t == #bool ifTrue:[^ #boolean ].
3bea515ce81e *** empty log message ***
fm
parents: 9479
diff changeset
   483
        t == #voidPointer ifTrue:[^ #handle ].
3bea515ce81e *** empty log message ***
fm
parents: 9479
diff changeset
   484
        ^ t.
3bea515ce81e *** empty log message ***
fm
parents: 9479
diff changeset
   485
    ].
3bea515ce81e *** empty log message ***
fm
parents: 9479
diff changeset
   486
3bea515ce81e *** empty log message ***
fm
parents: 9479
diff changeset
   487
    aType isString ifFalse:[ 
3bea515ce81e *** empty log message ***
fm
parents: 9479
diff changeset
   488
        CType isNil ifTrue:[
9340
df61c7e20801 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9339
diff changeset
   489
            self error:'unknown type'.
df61c7e20801 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9339
diff changeset
   490
        ].
9483
3bea515ce81e *** empty log message ***
fm
parents: 9479
diff changeset
   491
        t := aType typeSymbol.
3bea515ce81e *** empty log message ***
fm
parents: 9479
diff changeset
   492
    ].
3bea515ce81e *** empty log message ***
fm
parents: 9479
diff changeset
   493
    aType isString ifTrue:[ 
3bea515ce81e *** empty log message ***
fm
parents: 9479
diff changeset
   494
        self halt
3bea515ce81e *** empty log message ***
fm
parents: 9479
diff changeset
   495
    ].
3bea515ce81e *** empty log message ***
fm
parents: 9479
diff changeset
   496
    t isSymbol ifFalse:[
3bea515ce81e *** empty log message ***
fm
parents: 9479
diff changeset
   497
        self error:'unknown type'.
9340
df61c7e20801 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9339
diff changeset
   498
    ].
9327
9c15276d61e3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9324
diff changeset
   499
9340
df61c7e20801 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9339
diff changeset
   500
    ^ t
9322
41c391bfbf03 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9321
diff changeset
   501
!
41c391bfbf03 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9321
diff changeset
   502
9466
73333f358696 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9465
diff changeset
   503
name:functionNameOrVirtualIndex module:aModuleName returnType:aReturnType argumentTypes:argTypes
73333f358696 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9465
diff changeset
   504
    name := functionNameOrVirtualIndex.
73333f358696 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9465
diff changeset
   505
    functionNameOrVirtualIndex isNumber ifTrue:[
73333f358696 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9465
diff changeset
   506
        self beVirtualCPP.
73333f358696 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9465
diff changeset
   507
    ].
8891
c30a030ff5ec more FFI (foreign function interface) support - still incomplete
Stefan Vogel <sv@exept.de>
parents: 8728
diff changeset
   508
    moduleName := aModuleName.
c30a030ff5ec more FFI (foreign function interface) support - still incomplete
Stefan Vogel <sv@exept.de>
parents: 8728
diff changeset
   509
    returnType := aReturnType.
c30a030ff5ec more FFI (foreign function interface) support - still incomplete
Stefan Vogel <sv@exept.de>
parents: 8728
diff changeset
   510
    argumentTypes := argTypes.
9465
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   511
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   512
    "Created: / 01-08-2006 / 15:19:52 / cg"
9466
73333f358696 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9465
diff changeset
   513
    "Modified: / 02-08-2006 / 17:20:13 / cg"
9465
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   514
!
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   515
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   516
owningClass:aClass
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   517
    owningClass := aClass.
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   518
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   519
    "Created: / 01-08-2006 / 15:22:50 / cg"
8550
72982f85bd41 *** empty log message ***
ca
parents: 8533
diff changeset
   520
! !
72982f85bd41 *** empty log message ***
ca
parents: 8533
diff changeset
   521
9342
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   522
!ExternalLibraryFunction methodsFor:'private-invoking'!
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   523
9347
31adc57e6954 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9346
diff changeset
   524
invokeCPPVirtualFFIOn:instance withArguments:arguments
9463
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   525
    ^ self invokeFFIwithArguments:arguments forCPPInstance:instance
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   526
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   527
    "Modified: / 01-08-2006 / 13:55:30 / cg"
9342
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   528
!
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   529
9347
31adc57e6954 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9346
diff changeset
   530
invokeFFIWithArguments:arguments
9463
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   531
    ^ self invokeFFIwithArguments:arguments forCPPInstance:nil
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   532
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   533
    "Modified: / 01-08-2006 / 13:55:35 / cg"
9347
31adc57e6954 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9346
diff changeset
   534
!
31adc57e6954 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9346
diff changeset
   535
9463
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   536
invokeFFIwithArguments:arguments forCPPInstance:aCPlusPlusObjectOrNil 
9465
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   537
    |argTypeSymbols returnTypeSymbol failureCode failureInfo returnValue stClass vtOffset 
9524
2af286bbcac3 *** empty log message ***
ca
parents: 9519
diff changeset
   538
     virtual async unlimitedStack callTypeNumber returnValueClass argValueClass|
9342
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   539
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   540
    argumentTypes notNil ifTrue:[
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   541
        argTypeSymbols := argumentTypes collect:[:argType | self ffiTypeSymbolForType:argType].
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   542
    ].
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   543
    returnTypeSymbol := self ffiTypeSymbolForType:returnType.
9346
a95e2cf0e56f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9344
diff changeset
   544
9463
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   545
    virtual := self isVirtualCPP.    
9524
2af286bbcac3 *** empty log message ***
ca
parents: 9519
diff changeset
   546
    (virtual "or:[self isNonVirtualCPP]") ifTrue:[
9463
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   547
        aCPlusPlusObjectOrNil isNil ifTrue:[
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   548
            "/ must have a c++ object instance
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   549
            self primitiveFailed.
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   550
        ].
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   551
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   552
        "/ and it must be a kind of ExternalStructure !!
9342
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   553
        (aCPlusPlusObjectOrNil isKindOf:ExternalStructure) ifFalse:[
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   554
            self primitiveFailed.
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   555
        ].
9347
31adc57e6954 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9346
diff changeset
   556
        virtual ifTrue:[
31adc57e6954 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9346
diff changeset
   557
            vtOffset := name.
31adc57e6954 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9346
diff changeset
   558
            (vtOffset between:0 and:10000) ifFalse:[
31adc57e6954 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9346
diff changeset
   559
                self primitiveFailed.
31adc57e6954 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9346
diff changeset
   560
            ]
9342
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   561
        ].
9463
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   562
    ] ifFalse:[
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   563
        aCPlusPlusObjectOrNil notNil ifTrue:[
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   564
            "/ must NOT have a c++ object instance
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   565
            self primitiveFailed.
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   566
        ].
9342
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   567
    ].
9463
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   568
    async := self isAsync.
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   569
    unlimitedStack := self isUnlimitedStack.
9465
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   570
    callTypeNumber := self callTypeNumber.
9342
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   571
9459
6cd520c582b3 change from unlimited to big stack, to allow for interrupts to be handled
ca
parents: 9436
diff changeset
   572
%{  /* STACK: 100000 */
9342
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   573
#ifdef HAVE_FFI   
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   574
    ffi_cif __cif;
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   575
    ffi_type *__argTypesIncludingThis[MAX_ARGS+1];
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   576
    ffi_type **__argTypes = __argTypesIncludingThis;
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   577
    ffi_type *__returnType = NULL;
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   578
    union u {
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   579
        int iVal;
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   580
        float fVal;
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   581
        double dVal;
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   582
        void *pointerVal;
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   583
    };
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   584
    union u __argValuesIncludingThis[MAX_ARGS+1];
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   585
    union u *__argValues = __argValuesIncludingThis;
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   586
    union u __returnValue;
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   587
    void *__argValuePointersIncludingThis[MAX_ARGS+1];
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   588
    void **__argValuePointers = __argValuePointersIncludingThis;
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   589
    void *__returnValuePointer;
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   590
    int __numArgs, __numArgsIncludingThis;
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   591
    static int null = 0;
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   592
    int i;
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   593
    ffi_abi __callType = FFI_DEFAULT_ABI;
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   594
    VOIDFUNC codeAddress = (VOIDFUNC)__INST(code_);
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   595
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   596
    if (arguments == nil) {
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   597
        __numArgs = 0;
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   598
        if (argTypeSymbols != nil) {
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   599
            if (! __isArray(argTypeSymbols)
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   600
             || (__arraySize(argTypeSymbols) != __numArgs)) {
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   601
                failureCode = @symbol(ArgumentCountMismatch);
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   602
                goto getOutOfHere;
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   603
            }
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   604
        }
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   605
    } else {
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   606
        if (! __isArray(arguments)
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   607
         || ! __isArray(argTypeSymbols)
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   608
         || (__arraySize(argTypeSymbols) != (__numArgs = __arraySize(arguments)))) {
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   609
            failureCode = @symbol(ArgumentCountMismatch);
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   610
            goto getOutOfHere;
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   611
        }
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   612
    }
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   613
    if (__numArgs > MAX_ARGS) {
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   614
        failureCode = @symbol(TooManyArguments);
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   615
        goto getOutOfHere;
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   616
    }
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   617
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   618
    /*
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   619
     * validate the return type
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   620
     */
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   621
    __returnValuePointer = &__returnValue;
9479
68d12a181d4a handle types; sint32 types.
ca
parents: 9466
diff changeset
   622
9483
3bea515ce81e *** empty log message ***
fm
parents: 9479
diff changeset
   623
    if (returnTypeSymbol == @symbol(voidPointer)) {
9479
68d12a181d4a handle types; sint32 types.
ca
parents: 9466
diff changeset
   624
        returnTypeSymbol = @symbol(handle);
9483
3bea515ce81e *** empty log message ***
fm
parents: 9479
diff changeset
   625
    }
9479
68d12a181d4a handle types; sint32 types.
ca
parents: 9466
diff changeset
   626
9342
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   627
    if (returnTypeSymbol == @symbol(int)) {
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   628
        __returnType = __get_ffi_type_sint();
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   629
    } else if (returnTypeSymbol == @symbol(uint)) {
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   630
        __returnType = __get_ffi_type_uint();
9479
68d12a181d4a handle types; sint32 types.
ca
parents: 9466
diff changeset
   631
    } else if (returnTypeSymbol == @symbol(uint8)) {
68d12a181d4a handle types; sint32 types.
ca
parents: 9466
diff changeset
   632
        __returnType = __get_ffi_type_uint8();
68d12a181d4a handle types; sint32 types.
ca
parents: 9466
diff changeset
   633
    } else if (returnTypeSymbol == @symbol(uint16)) {
68d12a181d4a handle types; sint32 types.
ca
parents: 9466
diff changeset
   634
        __returnType = __get_ffi_type_uint16();
68d12a181d4a handle types; sint32 types.
ca
parents: 9466
diff changeset
   635
    } else if (returnTypeSymbol == @symbol(uint32)) {
68d12a181d4a handle types; sint32 types.
ca
parents: 9466
diff changeset
   636
        __returnType = __get_ffi_type_uint32();
68d12a181d4a handle types; sint32 types.
ca
parents: 9466
diff changeset
   637
    } else if (returnTypeSymbol == @symbol(uint64)) {
68d12a181d4a handle types; sint32 types.
ca
parents: 9466
diff changeset
   638
        __returnType = __get_ffi_type_uint64();
68d12a181d4a handle types; sint32 types.
ca
parents: 9466
diff changeset
   639
68d12a181d4a handle types; sint32 types.
ca
parents: 9466
diff changeset
   640
    } else if (returnTypeSymbol == @symbol(sint)) {
68d12a181d4a handle types; sint32 types.
ca
parents: 9466
diff changeset
   641
        __returnType = __get_ffi_type_sint();
68d12a181d4a handle types; sint32 types.
ca
parents: 9466
diff changeset
   642
    } else if (returnTypeSymbol == @symbol(sint8)) {
68d12a181d4a handle types; sint32 types.
ca
parents: 9466
diff changeset
   643
        __returnType = __get_ffi_type_sint8();
68d12a181d4a handle types; sint32 types.
ca
parents: 9466
diff changeset
   644
    } else if (returnTypeSymbol == @symbol(sint16)) {
68d12a181d4a handle types; sint32 types.
ca
parents: 9466
diff changeset
   645
        __returnType = __get_ffi_type_sint16();
68d12a181d4a handle types; sint32 types.
ca
parents: 9466
diff changeset
   646
    } else if (returnTypeSymbol == @symbol(sint32)) {
68d12a181d4a handle types; sint32 types.
ca
parents: 9466
diff changeset
   647
        __returnType = __get_ffi_type_sint32();
68d12a181d4a handle types; sint32 types.
ca
parents: 9466
diff changeset
   648
    } else if (returnTypeSymbol == @symbol(sint64)) {
68d12a181d4a handle types; sint32 types.
ca
parents: 9466
diff changeset
   649
        __returnType = __get_ffi_type_sint64();
68d12a181d4a handle types; sint32 types.
ca
parents: 9466
diff changeset
   650
9342
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   651
    } else if (returnTypeSymbol == @symbol(long)) {
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   652
        if (sizeof(long) == 4) {
9479
68d12a181d4a handle types; sint32 types.
ca
parents: 9466
diff changeset
   653
           returnTypeSymbol = @symbol(sint32);     
9342
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   654
           __returnType = __get_ffi_type_sint32();
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   655
        } else if (sizeof(long) == 8) {
9479
68d12a181d4a handle types; sint32 types.
ca
parents: 9466
diff changeset
   656
           returnTypeSymbol = @symbol(sint64);     
9342
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   657
           __returnType = __get_ffi_type_sint64();
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   658
        } else {
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   659
            failureCode = @symbol(UnknownReturnType);
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   660
            goto getOutOfHere;
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   661
        }
9479
68d12a181d4a handle types; sint32 types.
ca
parents: 9466
diff changeset
   662
9342
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   663
    } else if (returnTypeSymbol == @symbol(ulong)) {
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   664
        if (sizeof(long) == 4) {
9479
68d12a181d4a handle types; sint32 types.
ca
parents: 9466
diff changeset
   665
           returnTypeSymbol = @symbol(uint32);     
9342
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   666
           __returnType = __get_ffi_type_uint32();
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   667
        }else if (sizeof(long) == 8) {
9479
68d12a181d4a handle types; sint32 types.
ca
parents: 9466
diff changeset
   668
           returnTypeSymbol = @symbol(uint64);     
9342
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   669
           __returnType = __get_ffi_type_uint64();
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   670
        } else {
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   671
            failureCode = @symbol(UnknownReturnType);
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   672
            goto getOutOfHere;
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   673
        }
9479
68d12a181d4a handle types; sint32 types.
ca
parents: 9466
diff changeset
   674
9342
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   675
    } else if (returnTypeSymbol == @symbol(boolean)) {
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   676
        __returnType = __get_ffi_type_uint();
9479
68d12a181d4a handle types; sint32 types.
ca
parents: 9466
diff changeset
   677
9342
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   678
    } else if (returnTypeSymbol == @symbol(float)) {
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   679
        __returnType = __get_ffi_type_float();
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   680
    } else if (returnTypeSymbol == @symbol(double)) {
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   681
        __returnType = __get_ffi_type_double();
9479
68d12a181d4a handle types; sint32 types.
ca
parents: 9466
diff changeset
   682
9342
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   683
    } else if (returnTypeSymbol == @symbol(void)) {
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   684
        __returnType = __get_ffi_type_void();
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   685
        __returnValuePointer = NULL;
9479
68d12a181d4a handle types; sint32 types.
ca
parents: 9466
diff changeset
   686
    } else if ((returnTypeSymbol == @symbol(pointer)) || (returnTypeSymbol == @symbol(handle))) {
9346
a95e2cf0e56f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9344
diff changeset
   687
        __returnType = __get_ffi_type_pointer();
9463
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   688
    } else if (returnTypeSymbol == @symbol(charPointer)) {
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   689
        __returnType = __get_ffi_type_pointer();
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   690
    } else if (returnTypeSymbol == @symbol(wcharPointer)) {
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   691
        __returnType = __get_ffi_type_pointer();
9342
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   692
    } else {
9524
2af286bbcac3 *** empty log message ***
ca
parents: 9519
diff changeset
   693
        if (__isSymbol(returnTypeSymbol)
2af286bbcac3 *** empty log message ***
ca
parents: 9519
diff changeset
   694
         && ((returnValueClass = __GLOBAL_GET(returnTypeSymbol)) != nil)) {
2af286bbcac3 *** empty log message ***
ca
parents: 9519
diff changeset
   695
            if (! __isBehaviorLike(returnValueClass)) {
2af286bbcac3 *** empty log message ***
ca
parents: 9519
diff changeset
   696
                failureCode = @symbol(NonBehaviorReturnType);
2af286bbcac3 *** empty log message ***
ca
parents: 9519
diff changeset
   697
                goto getOutOfHere;
2af286bbcac3 *** empty log message ***
ca
parents: 9519
diff changeset
   698
            }
2af286bbcac3 *** empty log message ***
ca
parents: 9519
diff changeset
   699
            if (! __qIsSubclassOfExternalAddress(returnValueClass)) {
2af286bbcac3 *** empty log message ***
ca
parents: 9519
diff changeset
   700
                failureCode = @symbol(NonExternalAddressReturnType);
2af286bbcac3 *** empty log message ***
ca
parents: 9519
diff changeset
   701
                goto getOutOfHere;
2af286bbcac3 *** empty log message ***
ca
parents: 9519
diff changeset
   702
            }
2af286bbcac3 *** empty log message ***
ca
parents: 9519
diff changeset
   703
            __returnType = __get_ffi_type_pointer();
2af286bbcac3 *** empty log message ***
ca
parents: 9519
diff changeset
   704
            returnTypeSymbol = @symbol(pointer);
2af286bbcac3 *** empty log message ***
ca
parents: 9519
diff changeset
   705
        } else {
2af286bbcac3 *** empty log message ***
ca
parents: 9519
diff changeset
   706
            failureCode = @symbol(UnknownReturnType);
2af286bbcac3 *** empty log message ***
ca
parents: 9519
diff changeset
   707
            goto getOutOfHere;
2af286bbcac3 *** empty log message ***
ca
parents: 9519
diff changeset
   708
        }
9342
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   709
    }
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   710
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   711
    /*
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   712
     * validate the c++ object
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   713
     */
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   714
    if (aCPlusPlusObjectOrNil != nil) {
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   715
        struct cPlusPlusInstance {
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   716
            void **vTable;
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   717
        };
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   718
        struct cPlusPlusInstance *inst;
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   719
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   720
        if (__isExternalAddressLike(aCPlusPlusObjectOrNil)) {
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   721
            inst = (void *)(__externalAddressVal(aCPlusPlusObjectOrNil));
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   722
        } else if (__isExternalBytesLike(aCPlusPlusObjectOrNil)) {
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   723
            inst = (void *)(__externalBytesVal(aCPlusPlusObjectOrNil));
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   724
        } else {
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   725
            failureCode = @symbol(InvalidInstance);
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   726
            goto getOutOfHere;
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   727
        }
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   728
        __argValues[0].pointerVal = inst;
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   729
        __argValuePointersIncludingThis[0] = &(__argValues[0]);
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   730
        __argTypes[0] = __get_ffi_type_pointer();
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   731
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   732
        __argValuePointers = &__argValuePointersIncludingThis[1];
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   733
        __argTypes = &__argTypesIncludingThis[1];
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   734
        __argValues = &__argValuesIncludingThis[1];
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   735
        __numArgsIncludingThis = __numArgs + 1;
9347
31adc57e6954 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9346
diff changeset
   736
31adc57e6954 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9346
diff changeset
   737
        if (virtual == true) {
31adc57e6954 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9346
diff changeset
   738
            if (! __isSmallInteger(vtOffset)) {
31adc57e6954 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9346
diff changeset
   739
                failureCode = @symbol(InvalidVTableIndex);
31adc57e6954 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9346
diff changeset
   740
                goto getOutOfHere;
31adc57e6954 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9346
diff changeset
   741
            }
31adc57e6954 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9346
diff changeset
   742
            codeAddress = inst->vTable[__intVal(vtOffset)];
9464
157fe6ca53e6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9463
diff changeset
   743
#ifdef VERBOSE
157fe6ca53e6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9463
diff changeset
   744
            printf("virtual codeAddress: %x\n", codeAddress);
157fe6ca53e6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9463
diff changeset
   745
#endif
9347
31adc57e6954 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9346
diff changeset
   746
        }
9342
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   747
    } else {
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   748
        __numArgsIncludingThis = __numArgs;
9524
2af286bbcac3 *** empty log message ***
ca
parents: 9519
diff changeset
   749
#ifdef VERBOSE
2af286bbcac3 *** empty log message ***
ca
parents: 9519
diff changeset
   750
        printf("codeAddress: %x\n", codeAddress);
2af286bbcac3 *** empty log message ***
ca
parents: 9519
diff changeset
   751
#endif
9342
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   752
    }
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   753
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   754
    /*
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   755
     * validate all arg types and setup arg-buffers
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   756
     */
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   757
    for (i=0; i<__numArgs; i++) {
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   758
        ffi_type *thisType;
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   759
        void *argValuePtr;
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   760
        OBJ typeSymbol;
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   761
        OBJ arg;
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   762
9465
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   763
        failureInfo = __mkSmallInteger(i+1);   /* in case there is one */
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   764
9342
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   765
        typeSymbol = __ArrayInstPtr(argTypeSymbols)->a_element[i];
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   766
        arg = __ArrayInstPtr(arguments)->a_element[i];
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   767
9483
3bea515ce81e *** empty log message ***
fm
parents: 9479
diff changeset
   768
        if (typeSymbol == @symbol(handle)) {
9479
68d12a181d4a handle types; sint32 types.
ca
parents: 9466
diff changeset
   769
            typeSymbol = @symbol(pointer);
68d12a181d4a handle types; sint32 types.
ca
parents: 9466
diff changeset
   770
        } else if (typeSymbol == @symbol(voidPointer)) {
68d12a181d4a handle types; sint32 types.
ca
parents: 9466
diff changeset
   771
            typeSymbol = @symbol(pointer);
68d12a181d4a handle types; sint32 types.
ca
parents: 9466
diff changeset
   772
        }
68d12a181d4a handle types; sint32 types.
ca
parents: 9466
diff changeset
   773
9342
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   774
        if (typeSymbol == @symbol(long)) {
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   775
            if (sizeof(long) == sizeof(int)) {
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   776
                typeSymbol = @symbol(sint);
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   777
            } else {
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   778
                if (sizeof(long) == 4) {
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   779
                    typeSymbol = @symbol(sint32);
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   780
                } else if (sizeof(long) == 8) {
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   781
                    typeSymbol = @symbol(sint64);
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   782
                }
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   783
            }
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   784
        }
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   785
        if (typeSymbol == @symbol(ulong)) {
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   786
            if (sizeof(unsigned long) == sizeof(unsigned int)) {
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   787
                typeSymbol = @symbol(uint);
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   788
            } else {
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   789
                if (sizeof(long) == 4) {
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   790
                    typeSymbol = @symbol(uint32);
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   791
                } else if (sizeof(long) == 8) {
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   792
                    typeSymbol = @symbol(uint64);
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   793
                }
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   794
            }
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   795
        }
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   796
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   797
        if (typeSymbol == @symbol(int)) {
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   798
            thisType = __get_ffi_type_sint();
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   799
            if (__isSmallInteger(arg)) {
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   800
                __argValues[i].iVal = __intVal(arg);
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   801
            } else {
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   802
                __argValues[i].iVal = __signedLongIntVal(arg);
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   803
                if (__argValues[i].iVal == 0) {
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   804
                    failureCode = @symbol(InvalidArgument);
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   805
                    goto getOutOfHere;
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   806
                }
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   807
            }
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   808
            argValuePtr = &(__argValues[i].iVal);
9479
68d12a181d4a handle types; sint32 types.
ca
parents: 9466
diff changeset
   809
9342
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   810
        } else if (typeSymbol == @symbol(uint)) {
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   811
            thisType = __get_ffi_type_uint();
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   812
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   813
            if (__isSmallInteger(arg)) {
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   814
                __argValues[i].iVal = __intVal(arg);
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   815
            } else {
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   816
                __argValues[i].iVal = __unsignedLongIntVal(arg);
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   817
                if (__argValues[i].iVal == 0) {
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   818
                    failureCode = @symbol(InvalidArgument);
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   819
                    goto getOutOfHere;
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   820
                }
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   821
            }
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   822
            argValuePtr = &(__argValues[i].iVal);
9479
68d12a181d4a handle types; sint32 types.
ca
parents: 9466
diff changeset
   823
9342
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   824
        } else if (typeSymbol == @symbol(uint8)) {
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   825
            thisType = __get_ffi_type_uint8();
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   826
            if (! __isSmallInteger(arg)) {
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   827
                failureCode = @symbol(InvalidArgument);
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   828
                goto getOutOfHere;
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   829
            }
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   830
            __argValues[i].iVal = __intVal(arg);
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   831
            if (((unsigned)(__argValues[i].iVal)) > 0xFF) {
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   832
                failureCode = @symbol(InvalidArgument);
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   833
                goto getOutOfHere;
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   834
            }
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   835
            argValuePtr = &(__argValues[i].iVal);
9479
68d12a181d4a handle types; sint32 types.
ca
parents: 9466
diff changeset
   836
9342
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   837
        } else if (typeSymbol == @symbol(sint8)) {
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   838
            thisType = __get_ffi_type_sint8();
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   839
            if (! __isSmallInteger(arg)) {
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   840
                failureCode = @symbol(InvalidArgument);
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   841
                goto getOutOfHere;
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   842
            }
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   843
            __argValues[i].iVal = __intVal(arg);
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   844
            if (((__argValues[i].iVal) < -0x80) || ((__argValues[i].iVal) > 0x7F))  {
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   845
                failureCode = @symbol(InvalidArgument);
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   846
                goto getOutOfHere;
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   847
            }
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   848
            argValuePtr = &(__argValues[i].iVal);
9479
68d12a181d4a handle types; sint32 types.
ca
parents: 9466
diff changeset
   849
9342
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   850
        } else if (typeSymbol == @symbol(uint16)) {
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   851
            thisType = __get_ffi_type_uint16();
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   852
            if (! __isSmallInteger(arg)) {
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   853
                failureCode = @symbol(InvalidArgument);
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   854
                goto getOutOfHere;
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   855
            }
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   856
            __argValues[i].iVal = __intVal(arg);
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   857
            if (((unsigned)(__argValues[i].iVal)) > 0xFFFF) {
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   858
                failureCode = @symbol(InvalidArgument);
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   859
                goto getOutOfHere;
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   860
            }
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   861
            argValuePtr = &(__argValues[i].iVal);
9479
68d12a181d4a handle types; sint32 types.
ca
parents: 9466
diff changeset
   862
9342
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   863
        } else if (typeSymbol == @symbol(sint16)) {
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   864
            thisType = __get_ffi_type_sint16();
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   865
            if (! __isSmallInteger(arg)) {
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   866
                failureCode = @symbol(InvalidArgument);
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   867
                goto getOutOfHere;
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   868
            }
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   869
            __argValues[i].iVal = __intVal(arg);
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   870
            if (((__argValues[i].iVal) < -0x8000) || ((__argValues[i].iVal) > 0x7FFF))  {
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   871
                failureCode = @symbol(InvalidArgument);
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   872
                goto getOutOfHere;
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   873
            }
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   874
            argValuePtr = &(__argValues[i].iVal);
9479
68d12a181d4a handle types; sint32 types.
ca
parents: 9466
diff changeset
   875
68d12a181d4a handle types; sint32 types.
ca
parents: 9466
diff changeset
   876
        } else if ((typeSymbol == @symbol(uint32)) || (typeSymbol == @symbol(sint32))) {
68d12a181d4a handle types; sint32 types.
ca
parents: 9466
diff changeset
   877
            thisType = __get_ffi_type_uint32();
68d12a181d4a handle types; sint32 types.
ca
parents: 9466
diff changeset
   878
            if (__isSmallInteger(arg)) {
68d12a181d4a handle types; sint32 types.
ca
parents: 9466
diff changeset
   879
                __argValues[i].iVal = __intVal(arg);
68d12a181d4a handle types; sint32 types.
ca
parents: 9466
diff changeset
   880
            } else {
68d12a181d4a handle types; sint32 types.
ca
parents: 9466
diff changeset
   881
                __argValues[i].iVal = __unsignedLongIntVal(arg);
68d12a181d4a handle types; sint32 types.
ca
parents: 9466
diff changeset
   882
                if (__argValues[i].iVal == 0) {
68d12a181d4a handle types; sint32 types.
ca
parents: 9466
diff changeset
   883
                    failureCode = @symbol(InvalidArgument);
68d12a181d4a handle types; sint32 types.
ca
parents: 9466
diff changeset
   884
                    goto getOutOfHere;
68d12a181d4a handle types; sint32 types.
ca
parents: 9466
diff changeset
   885
                }
68d12a181d4a handle types; sint32 types.
ca
parents: 9466
diff changeset
   886
            }
68d12a181d4a handle types; sint32 types.
ca
parents: 9466
diff changeset
   887
            argValuePtr = &(__argValues[i].iVal);
68d12a181d4a handle types; sint32 types.
ca
parents: 9466
diff changeset
   888
9342
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   889
        } else if (typeSymbol == @symbol(float)) {
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   890
            thisType = __get_ffi_type_float();
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   891
            if (__isSmallInteger(arg)) {
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   892
                __argValues[i].fVal = (float)(__intVal(arg));
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   893
            } else if (__isFloat(arg)) {
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   894
                __argValues[i].fVal = (float)(__floatVal(arg));
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   895
            } else if (__isShortFloat(arg)) {
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   896
                __argValues[i].fVal = (float)(__shortFloatVal(arg));
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   897
            } else {
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   898
                failureCode = @symbol(InvalidArgument);
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   899
                goto getOutOfHere;
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   900
            }
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   901
            argValuePtr = &(__argValues[i].fVal);
9479
68d12a181d4a handle types; sint32 types.
ca
parents: 9466
diff changeset
   902
9342
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   903
        } else if (typeSymbol == @symbol(double)) {
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   904
            thisType = __get_ffi_type_double();
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   905
            if (__isSmallInteger(arg)) {
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   906
                __argValues[i].dVal = (double)(__intVal(arg));
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   907
            } else if (__isFloat(arg)) {
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   908
                __argValues[i].dVal = (double)(__floatVal(arg));
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   909
            } else if (__isShortFloat(arg)) {
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   910
                __argValues[i].dVal = (double)(__shortFloatVal(arg));
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   911
            } else {
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   912
                failureCode = @symbol(InvalidArgument);
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   913
                goto getOutOfHere;
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   914
            }
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   915
            argValuePtr = &(__argValues[i].dVal);
9479
68d12a181d4a handle types; sint32 types.
ca
parents: 9466
diff changeset
   916
9342
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   917
        } else if (typeSymbol == @symbol(void)) {
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   918
            thisType = __get_ffi_type_void();
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   919
            argValuePtr = &null;
9479
68d12a181d4a handle types; sint32 types.
ca
parents: 9466
diff changeset
   920
9465
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   921
        } else if (typeSymbol == @symbol(charPointer)) {
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   922
            thisType = __get_ffi_type_pointer();
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   923
            if (__isString(arg) || __isSymbol(arg)) {
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   924
                if (async == true) goto badArgForAsyncCall;
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   925
                __argValues[i].pointerVal = (void *)(__stringVal(arg));
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   926
            } else {
9483
3bea515ce81e *** empty log message ***
fm
parents: 9479
diff changeset
   927
                if (__isBytes(arg)) {
3bea515ce81e *** empty log message ***
fm
parents: 9479
diff changeset
   928
                    if (async == true) goto badArgForAsyncCall;
3bea515ce81e *** empty log message ***
fm
parents: 9479
diff changeset
   929
                    __argValues[i].pointerVal = (void *)(__byteArrayVal(arg));
3bea515ce81e *** empty log message ***
fm
parents: 9479
diff changeset
   930
                } else {
3bea515ce81e *** empty log message ***
fm
parents: 9479
diff changeset
   931
                    if (arg == nil) {
3bea515ce81e *** empty log message ***
fm
parents: 9479
diff changeset
   932
                        __argValues[i].pointerVal = (void *)0;
3bea515ce81e *** empty log message ***
fm
parents: 9479
diff changeset
   933
                    } else {
3bea515ce81e *** empty log message ***
fm
parents: 9479
diff changeset
   934
                        failureCode = @symbol(InvalidArgument);
3bea515ce81e *** empty log message ***
fm
parents: 9479
diff changeset
   935
                        goto getOutOfHere;
3bea515ce81e *** empty log message ***
fm
parents: 9479
diff changeset
   936
                    }
3bea515ce81e *** empty log message ***
fm
parents: 9479
diff changeset
   937
                }
9465
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   938
            }
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
   939
            argValuePtr = &(__argValues[i].pointerVal);;
9479
68d12a181d4a handle types; sint32 types.
ca
parents: 9466
diff changeset
   940
9342
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   941
        } else if (typeSymbol == @symbol(pointer)) {
9524
2af286bbcac3 *** empty log message ***
ca
parents: 9519
diff changeset
   942
commonPointerTypeArg: ;
9342
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   943
            thisType = __get_ffi_type_pointer();
9483
3bea515ce81e *** empty log message ***
fm
parents: 9479
diff changeset
   944
            if (arg == nil) {
3bea515ce81e *** empty log message ***
fm
parents: 9479
diff changeset
   945
                __argValues[i].pointerVal = NULL;
3bea515ce81e *** empty log message ***
fm
parents: 9479
diff changeset
   946
            } else if (__isExternalAddressLike(arg)) {
9342
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   947
                __argValues[i].pointerVal = (void *)(__externalAddressVal(arg));
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   948
            } else if (__isExternalBytesLike(arg)) {
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   949
                __argValues[i].pointerVal = (void *)(__externalBytesVal(arg));
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   950
            } else if (__isByteArray(arg)) {
9463
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   951
                if (async == true) goto badArgForAsyncCall;
9342
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   952
                __argValues[i].pointerVal = (void *)(__byteArrayVal(arg));
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   953
            } else if (__isFloatArray(arg)) {
9463
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   954
                if (async == true) goto badArgForAsyncCall;
9342
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   955
                __argValues[i].pointerVal = (void *)(__FloatArrayInstPtr(arg)->f_element);
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   956
            } else if (__isDoubleArray(arg)) {
9463
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   957
                if (async == true) goto badArgForAsyncCall;
9342
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   958
                __argValues[i].pointerVal = (void *)(__DoubleArrayInstPtr(arg)->d_element);
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   959
            } else if (__isString(arg) || __isSymbol(arg)) {
9463
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
   960
                if (async == true) {
9435
68f7e39efad7 support of asynchronous calls
ca
parents: 9418
diff changeset
   961
badArgForAsyncCall: ;
68f7e39efad7 support of asynchronous calls
ca
parents: 9418
diff changeset
   962
                    failureCode = @symbol(BadArgForAsyncCall);
68f7e39efad7 support of asynchronous calls
ca
parents: 9418
diff changeset
   963
                    goto getOutOfHere;
68f7e39efad7 support of asynchronous calls
ca
parents: 9418
diff changeset
   964
                }
9342
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   965
                __argValues[i].pointerVal = (void *)(__stringVal(arg));
9483
3bea515ce81e *** empty log message ***
fm
parents: 9479
diff changeset
   966
            } else if (__isBytes(arg)) {
3bea515ce81e *** empty log message ***
fm
parents: 9479
diff changeset
   967
                char *p = (char *)(__byteArrayVal(arg));
3bea515ce81e *** empty log message ***
fm
parents: 9479
diff changeset
   968
                int nInstBytes;
3bea515ce81e *** empty log message ***
fm
parents: 9479
diff changeset
   969
                OBJ cls;
3bea515ce81e *** empty log message ***
fm
parents: 9479
diff changeset
   970
3bea515ce81e *** empty log message ***
fm
parents: 9479
diff changeset
   971
                cls = __qClass(arg);
3bea515ce81e *** empty log message ***
fm
parents: 9479
diff changeset
   972
                nInstBytes = __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
3bea515ce81e *** empty log message ***
fm
parents: 9479
diff changeset
   973
                __argValues[i].pointerVal = p + nInstBytes;
9342
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   974
            } else {
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   975
                failureCode = @symbol(InvalidArgument);
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   976
                goto getOutOfHere;
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   977
            }
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   978
            argValuePtr = &(__argValues[i].pointerVal);;
9479
68d12a181d4a handle types; sint32 types.
ca
parents: 9466
diff changeset
   979
9342
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   980
        } else if (typeSymbol == @symbol(boolean)) {
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   981
            thisType = __get_ffi_type_uint();
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   982
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   983
            if (arg == true) {
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   984
                __argValues[i].iVal = 1;
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   985
            } else if (arg == false) {
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   986
                __argValues[i].iVal = 0;
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   987
            } else if (__isSmallInteger(arg)) {
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   988
                __argValues[i].iVal = __intVal(arg);
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   989
            } else {
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   990
                __argValues[i].iVal = __unsignedLongIntVal(arg);
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   991
                if (__argValues[i].iVal == 0) {
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   992
                    failureCode = @symbol(InvalidArgument);
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   993
                    goto getOutOfHere;
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   994
                }
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   995
            }
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   996
            argValuePtr = &(__argValues[i].iVal);
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
   997
        } else {
9524
2af286bbcac3 *** empty log message ***
ca
parents: 9519
diff changeset
   998
            if (__isSymbol(typeSymbol)
2af286bbcac3 *** empty log message ***
ca
parents: 9519
diff changeset
   999
             && ((argValueClass = __GLOBAL_GET(typeSymbol)) != nil)) {
2af286bbcac3 *** empty log message ***
ca
parents: 9519
diff changeset
  1000
                if (! __isBehaviorLike(argValueClass)) {
2af286bbcac3 *** empty log message ***
ca
parents: 9519
diff changeset
  1001
                    failureCode = @symbol(NonBehaviorArgumentType);
2af286bbcac3 *** empty log message ***
ca
parents: 9519
diff changeset
  1002
                    goto getOutOfHere;
2af286bbcac3 *** empty log message ***
ca
parents: 9519
diff changeset
  1003
                }
2af286bbcac3 *** empty log message ***
ca
parents: 9519
diff changeset
  1004
                if (! __qIsSubclassOfExternalAddress(argValueClass)) {
2af286bbcac3 *** empty log message ***
ca
parents: 9519
diff changeset
  1005
                    failureCode = @symbol(NonExternalAddressArgumentType);
2af286bbcac3 *** empty log message ***
ca
parents: 9519
diff changeset
  1006
                    goto getOutOfHere;
2af286bbcac3 *** empty log message ***
ca
parents: 9519
diff changeset
  1007
                }
2af286bbcac3 *** empty log message ***
ca
parents: 9519
diff changeset
  1008
                goto commonPointerTypeArg; /* sorry */
2af286bbcac3 *** empty log message ***
ca
parents: 9519
diff changeset
  1009
            } else {
2af286bbcac3 *** empty log message ***
ca
parents: 9519
diff changeset
  1010
                failureCode = @symbol(UnknownArgumentType);
2af286bbcac3 *** empty log message ***
ca
parents: 9519
diff changeset
  1011
                goto getOutOfHere;
2af286bbcac3 *** empty log message ***
ca
parents: 9519
diff changeset
  1012
            }
9342
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
  1013
        }
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
  1014
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
  1015
        __argTypes[i] = thisType;
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
  1016
        __argValuePointers[i] = argValuePtr;
9483
3bea515ce81e *** empty log message ***
fm
parents: 9479
diff changeset
  1017
9524
2af286bbcac3 *** empty log message ***
ca
parents: 9519
diff changeset
  1018
#ifdef VERBOSE
9483
3bea515ce81e *** empty log message ***
fm
parents: 9479
diff changeset
  1019
        printf("arg%d: %x\n", i, __argValues[i].iVal);
9524
2af286bbcac3 *** empty log message ***
ca
parents: 9519
diff changeset
  1020
#endif
9342
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
  1021
    }
9465
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
  1022
    failureInfo = nil;
9342
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
  1023
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
  1024
    __callType = FFI_DEFAULT_ABI;
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
  1025
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
  1026
#ifdef CALLTYPE_FFI_STDCALL
9465
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
  1027
    if (callTypeNumber == @global(CALLTYPE_API)) {
9342
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
  1028
        __callType = CALLTYPE_FFI_STDCALL;
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
  1029
    }
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
  1030
#endif
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
  1031
#ifdef CALLTYPE_FFI_V8
9465
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
  1032
    if (callTypeNumber == @global(CALLTYPE_V8)) {
9342
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
  1033
        __callType = CALLTYPE_FFI_V8;
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
  1034
    }
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
  1035
#endif
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
  1036
#ifdef CALLTYPE_FFI_V9
9465
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
  1037
    if (callTypeNumber == @global(CALLTYPE_V9)) {
9342
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
  1038
        __callType = CALLTYPE_FFI_V9;
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
  1039
    }
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
  1040
#endif
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
  1041
#ifdef CALLTYPE_FFI_UNIX64
9465
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
  1042
    if (callTypeNumber == @global(CALLTYPE_UNIX64)) {
9342
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
  1043
        __callType = CALLTYPE_FFI_UNIX64;
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
  1044
    }
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
  1045
#endif
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
  1046
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
  1047
    if (ffi_prep_cif(&__cif, __callType, __numArgsIncludingThis, __returnType, __argTypesIncludingThis) != FFI_OK) {
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
  1048
        failureCode = @symbol(FFIPrepareFailed);
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
  1049
        goto getOutOfHere;
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
  1050
    }
9463
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
  1051
    if (async == true) {
9524
2af286bbcac3 *** empty log message ***
ca
parents: 9519
diff changeset
  1052
#ifdef VERBOSE
2af286bbcac3 *** empty log message ***
ca
parents: 9519
diff changeset
  1053
        printf("async call 0x%x\n", codeAddress);
2af286bbcac3 *** empty log message ***
ca
parents: 9519
diff changeset
  1054
#endif
9436
388724e908e3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9435
diff changeset
  1055
#ifdef WIN32
9435
68f7e39efad7 support of asynchronous calls
ca
parents: 9418
diff changeset
  1056
        __STX_C_CALL4( "ffi_call", ffi_call, &__cif, codeAddress, __returnValuePointer, __argValuePointersIncludingThis);
9436
388724e908e3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9435
diff changeset
  1057
#else
9459
6cd520c582b3 change from unlimited to big stack, to allow for interrupts to be handled
ca
parents: 9436
diff changeset
  1058
        __BEGIN_INTERRUPTABLE__
9436
388724e908e3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9435
diff changeset
  1059
        ffi_call(&__cif, codeAddress, __returnValuePointer, __argValuePointersIncludingThis);
9459
6cd520c582b3 change from unlimited to big stack, to allow for interrupts to be handled
ca
parents: 9436
diff changeset
  1060
        __END_INTERRUPTABLE__
9436
388724e908e3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9435
diff changeset
  1061
#endif
9435
68f7e39efad7 support of asynchronous calls
ca
parents: 9418
diff changeset
  1062
    } else {
9483
3bea515ce81e *** empty log message ***
fm
parents: 9479
diff changeset
  1063
        if (unlimitedStack == true) {
9524
2af286bbcac3 *** empty log message ***
ca
parents: 9519
diff changeset
  1064
#ifdef VERBOSE
2af286bbcac3 *** empty log message ***
ca
parents: 9519
diff changeset
  1065
            printf("UNLIMITEDSTACKCALL call 0x%x\n", codeAddress);
2af286bbcac3 *** empty log message ***
ca
parents: 9519
diff changeset
  1066
#endif
9463
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
  1067
#if 0
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
  1068
            __UNLIMITEDSTACKCALL__(ffi_call, &__cif, codeAddress, __returnValuePointer, __argValuePointersIncludingThis);
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
  1069
#endif
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
  1070
        } else {
9524
2af286bbcac3 *** empty log message ***
ca
parents: 9519
diff changeset
  1071
#ifdef VERBOSE
2af286bbcac3 *** empty log message ***
ca
parents: 9519
diff changeset
  1072
            printf("call 0x%x\n", codeAddress);
2af286bbcac3 *** empty log message ***
ca
parents: 9519
diff changeset
  1073
#endif
9463
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
  1074
            ffi_call(&__cif, codeAddress, __returnValuePointer, __argValuePointersIncludingThis);
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
  1075
        }
9435
68f7e39efad7 support of asynchronous calls
ca
parents: 9418
diff changeset
  1076
    }
9524
2af286bbcac3 *** empty log message ***
ca
parents: 9519
diff changeset
  1077
#ifdef VERBOSE
2af286bbcac3 *** empty log message ***
ca
parents: 9519
diff changeset
  1078
    printf("retval is %d (0x%x)\n", __returnValue.iVal, __returnValue.iVal);
2af286bbcac3 *** empty log message ***
ca
parents: 9519
diff changeset
  1079
#endif
9479
68d12a181d4a handle types; sint32 types.
ca
parents: 9466
diff changeset
  1080
    if ((returnTypeSymbol == @symbol(sint))
68d12a181d4a handle types; sint32 types.
ca
parents: 9466
diff changeset
  1081
     || (returnTypeSymbol == @symbol(sint8))
68d12a181d4a handle types; sint32 types.
ca
parents: 9466
diff changeset
  1082
     || (returnTypeSymbol == @symbol(sint16))
68d12a181d4a handle types; sint32 types.
ca
parents: 9466
diff changeset
  1083
     || (returnTypeSymbol == @symbol(sint32))) {
9342
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
  1084
        RETURN ( __MKINT(__returnValue.iVal) );
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
  1085
    }
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
  1086
    if ((returnTypeSymbol == @symbol(uint))
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
  1087
     || (returnTypeSymbol == @symbol(uint8))
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
  1088
     || (returnTypeSymbol == @symbol(uint16))
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
  1089
     || (returnTypeSymbol == @symbol(uint32))) {
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
  1090
        RETURN ( __MKUINT(__returnValue.iVal) );
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
  1091
    }
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
  1092
    if (returnTypeSymbol == @symbol(boolean)) {
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
  1093
        RETURN ( __returnValue.iVal ? true : false );
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
  1094
    }
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
  1095
    if (returnTypeSymbol == @symbol(float)) {
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
  1096
        RETURN ( __MKFLOAT(__returnValue.fVal ));
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
  1097
    }
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
  1098
    if (returnTypeSymbol == @symbol(double)) {
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
  1099
        RETURN ( __MKFLOAT(__returnValue.dVal ));
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
  1100
    }
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
  1101
    if (returnTypeSymbol == @symbol(void)) {
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
  1102
        RETURN ( nil );
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
  1103
    }
9463
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
  1104
    if (returnTypeSymbol == @symbol(char)) {
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
  1105
        RETURN ( __MKCHARACTER(__returnValue.iVal & 0xFF) );
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
  1106
    }
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
  1107
    if (returnTypeSymbol == @symbol(wchar)) {
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
  1108
        RETURN ( __MKUCHARACTER(__returnValue.iVal & 0xFFFF) );
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
  1109
    }
9346
a95e2cf0e56f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9344
diff changeset
  1110
    if (returnTypeSymbol == @symbol(handle)) {
9342
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
  1111
        returnValue = __MKEXTERNALADDRESS(__returnValue.pointerVal);
9346
a95e2cf0e56f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9344
diff changeset
  1112
    } else if (returnTypeSymbol == @symbol(pointer)) {
a95e2cf0e56f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9344
diff changeset
  1113
        returnValue = __MKEXTERNALBYTES(__returnValue.pointerVal);
9463
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
  1114
    } else if (returnTypeSymbol == @symbol(charPointer)) {
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
  1115
        returnValue = __MKSTRING(__returnValue.pointerVal);
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
  1116
    } else if (returnTypeSymbol == @symbol(wcharPointer)) {
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
  1117
        returnValue = __MKU16STRING(__returnValue.pointerVal);
9342
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
  1118
    } else {
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
  1119
        failureCode = @symbol(UnknownReturnType2);
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
  1120
    }
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
  1121
getOutOfHere: ;
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
  1122
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
  1123
#else /* no FFI support */
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
  1124
    failureCode = @symbol(FFINotSupported);
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
  1125
#endif /* HAVE_FFI */
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
  1126
%}.
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
  1127
    failureCode notNil ifTrue:[
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
  1128
        self primitiveFailed.
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
  1129
        ^ nil
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
  1130
    ].
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
  1131
9483
3bea515ce81e *** empty log message ***
fm
parents: 9479
diff changeset
  1132
    returnType isSymbol ifTrue:[
9524
2af286bbcac3 *** empty log message ***
ca
parents: 9519
diff changeset
  1133
        returnValueClass notNil ifTrue:[
9525
120234adc94e const specifier (is this a good name ?)
ca
parents: 9524
diff changeset
  1134
            self isConstReturnValue ifTrue:[
120234adc94e const specifier (is this a good name ?)
ca
parents: 9524
diff changeset
  1135
                returnValue changeClassTo:returnValueClass.
120234adc94e const specifier (is this a good name ?)
ca
parents: 9524
diff changeset
  1136
                ^ returnValue
120234adc94e const specifier (is this a good name ?)
ca
parents: 9524
diff changeset
  1137
            ].
120234adc94e const specifier (is this a good name ?)
ca
parents: 9524
diff changeset
  1138
            ^ returnValueClass fromExternalAddress:returnValue.
9524
2af286bbcac3 *** empty log message ***
ca
parents: 9519
diff changeset
  1139
        ].
9483
3bea515ce81e *** empty log message ***
fm
parents: 9479
diff changeset
  1140
    ] ifFalse:[
3bea515ce81e *** empty log message ***
fm
parents: 9479
diff changeset
  1141
        returnType isCPointer ifTrue:[
3bea515ce81e *** empty log message ***
fm
parents: 9479
diff changeset
  1142
            returnType baseType isCStruct ifTrue:[
3bea515ce81e *** empty log message ***
fm
parents: 9479
diff changeset
  1143
                stClass := Smalltalk classNamed:returnType baseType name.
3bea515ce81e *** empty log message ***
fm
parents: 9479
diff changeset
  1144
                stClass notNil ifTrue:[
9525
120234adc94e const specifier (is this a good name ?)
ca
parents: 9524
diff changeset
  1145
                    self isConstReturnValue ifTrue:[
120234adc94e const specifier (is this a good name ?)
ca
parents: 9524
diff changeset
  1146
                        returnValue changeClassTo:returnValueClass.
120234adc94e const specifier (is this a good name ?)
ca
parents: 9524
diff changeset
  1147
                        ^ returnValue
120234adc94e const specifier (is this a good name ?)
ca
parents: 9524
diff changeset
  1148
                    ].
9483
3bea515ce81e *** empty log message ***
fm
parents: 9479
diff changeset
  1149
                    ^ stClass fromExternalAddress:returnValue.
3bea515ce81e *** empty log message ***
fm
parents: 9479
diff changeset
  1150
                ].
9342
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
  1151
            ].
9483
3bea515ce81e *** empty log message ***
fm
parents: 9479
diff changeset
  1152
            returnType baseType isCChar ifTrue:[
3bea515ce81e *** empty log message ***
fm
parents: 9479
diff changeset
  1153
                ^ returnValue stringAt:1
3bea515ce81e *** empty log message ***
fm
parents: 9479
diff changeset
  1154
            ].
9346
a95e2cf0e56f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9344
diff changeset
  1155
        ].
9342
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
  1156
    ].
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
  1157
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
  1158
    ^ returnValue
9463
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
  1159
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
  1160
    "Created: / 01-08-2006 / 13:56:23 / cg"
9465
d11885052713 rewrite & cleanup
Claus Gittinger <cg@exept.de>
parents: 9464
diff changeset
  1161
    "Modified: / 01-08-2006 / 15:59:44 / cg"
9342
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
  1162
! !
e548ce80ab02 virtual calls
Claus Gittinger <cg@exept.de>
parents: 9341
diff changeset
  1163
8533
9065c547ea75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1164
!ExternalLibraryFunction class methodsFor:'documentation'!
9065c547ea75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1165
9065c547ea75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1166
version
9525
120234adc94e const specifier (is this a good name ?)
ca
parents: 9524
diff changeset
  1167
    ^ '$Header: /cvs/stx/stx/libbasic/ExternalLibraryFunction.st,v 1.42 2006-08-11 11:20:24 ca Exp $'
8533
9065c547ea75 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1168
! !
9463
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
  1169
864880338d7e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9460
diff changeset
  1170
ExternalLibraryFunction initialize!