"Fossies" - the Fresh Open Source Software Archive

Member "FreeBASIC-1.07.1-source/tests/cpp/fbcall-fbc.bas" (27 Sep 2019, 4643 Bytes) of package /linux/privat/FreeBASIC-1.07.1-source.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Visual Basic source code syntax highlighting (style: standard) with prefixed line numbers. Alternatively you can here view or download the uninterpreted source code file.

    1 ' TEST_MODE : MULTI_MODULE_TEST
    2 
    3 '' test mapping of mangling and calling convention 
    4 '' between fbc extern "rtlib" and c
    5 
    6 '' helper macro to track progress
    7 #define DLOG( msg ) '' print #msg
    8 
    9 extern "c++"
   10     '' getters to retrieve call information
   11     '' from the c/c++ side
   12     declare sub resetChecks()
   13     declare function getPtr1() as any ptr
   14     declare function getPtr2() as any ptr
   15     declare function getPtr3() as any ptr
   16     declare function getMsg1() as zstring ptr
   17 end extern
   18 
   19 type UDT
   20     value as long
   21 end type
   22 
   23 #macro DECL_PROCS()
   24 
   25 extern "rtlib"
   26     declare sub sub1_rtlib_default( byref a as const UDT )
   27     declare sub sub1_rtlib_cdecl cdecl( byref a as const UDT )
   28     declare sub sub1_rtlib_stdcall stdcall( byref a as const UDT )
   29     declare function func1_rtlib_default( byref a as const UDT ) as UDT
   30     declare function func1_rtlib_cdecl cdecl( byref a as const UDT ) as UDT
   31     declare function func1_rtlib_stdcall stdcall( byref a as const UDT ) as UDT
   32 
   33     declare sub sub2_rtlib_default( byref a as const UDT, byref b as const UDT )
   34     declare sub sub2_rtlib_cdecl cdecl( byref a as const UDT, byref b as const UDT )
   35     declare sub sub2_rtlib_stdcall stdcall( byref a as const UDT, byref b as const UDT )
   36     declare function func2_rtlib_default( byref a as const UDT, byref b as const UDT ) as UDT
   37     declare function func2_rtlib_cdecl cdecl( byref a as const UDT, byref b as const UDT ) as UDT
   38     declare function func2_rtlib_stdcall stdcall( byref a as const UDT, byref b as const UDT ) as UDT
   39 
   40     declare sub sub3_rtlib_default( byref a as const UDT, byref b as const UDT, byref c as const UDT )
   41     declare sub sub3_rtlib_cdecl cdecl( byref a as const UDT, byref b as const UDT, byref c as const UDT )
   42     declare sub sub3_rtlib_stdcall stdcall( byref a as const UDT, byref b as const UDT, byref c as const UDT )
   43     declare function func3_rtlib_default( byref a as const UDT, byref b as const UDT, byref c as const UDT ) as UDT
   44     declare function func3_rtlib_cdecl cdecl( byref a as const UDT, byref b as const UDT, byref c as const UDT ) as UDT
   45     declare function func3_rtlib_stdcall stdcall( byref a as const UDT, byref b as const UDT, byref c as const UDT ) as UDT
   46 end extern
   47 
   48 #endmacro
   49 
   50 '' fbc declarations in global namespace
   51 DECL_PROCS()
   52 
   53 '' fbc declarations in a namespace
   54 namespace NS
   55     DECL_PROCS()
   56 end namespace
   57 
   58 #macro chksub( count, n, ns )
   59     DLOG( n )
   60     resetChecks()
   61     scope
   62     #if count = 1
   63         dim a as UDT
   64         ns##n( a )
   65         assert( @a = getPtr1() )
   66     #elseif count = 2
   67         dim a as UDT, b as UDT
   68         ns##n( a, b )
   69         assert( @a = getPtr1() )
   70         assert( @b = getPtr2() )
   71     #else
   72         dim a as UDT, b as UDT, c as UDT
   73         ns##n( a, b, c )
   74         assert( @a = getPtr1() )
   75         assert( @b = getPtr2() )
   76         assert( @c = getPtr3() )
   77     #endif
   78         assert( #n = *getMsg1() )
   79     end scope
   80 #endmacro
   81 
   82 #macro chkfunc( count, n, ns )
   83     DLOG( n )
   84     resetChecks()
   85     scope
   86     #if count = 1
   87         dim a as UDT, r as UDT
   88         r = ns##n( a )
   89         assert( @a = getPtr1() )
   90     #elseif count = 2
   91         dim a as UDT, b as UDT, r as UDT
   92         r = ns##n( a, b )
   93         assert( @a = getPtr1() )
   94         assert( @b = getPtr2() )
   95     #else
   96         dim a as UDT, b as UDT, c as UDT, r as UDT
   97         r = ns##n( a, b, c )
   98         assert( @a = getPtr1() )
   99         assert( @b = getPtr2() )
  100         assert( @c = getPtr3() )
  101     #endif
  102         assert( #n = *getMsg1() )
  103     end scope
  104 #endmacro
  105 
  106 '' top level declaration inside extern "rtlib"
  107 '' to link to c functions
  108 
  109 chksub( 1, sub1_rtlib_default, )
  110 chksub( 1, sub1_rtlib_cdecl, )
  111 chksub( 1, sub1_rtlib_stdcall, )
  112 chkfunc( 1, func1_rtlib_default, )
  113 chkfunc( 1, func1_rtlib_cdecl, )
  114 chkfunc( 1, func1_rtlib_stdcall, )
  115 
  116 chksub( 2, sub2_rtlib_default, )
  117 chksub( 2, sub2_rtlib_cdecl, )
  118 chksub( 2, sub2_rtlib_stdcall, )
  119 chkfunc( 2, func2_rtlib_default, )
  120 chkfunc( 2, func2_rtlib_cdecl, )
  121 chkfunc( 2, func2_rtlib_stdcall, )
  122 
  123 chksub( 3, sub3_rtlib_default, )
  124 chksub( 3, sub3_rtlib_cdecl, )
  125 chksub( 3, sub3_rtlib_stdcall, )
  126 chkfunc( 3, func3_rtlib_default, )
  127 chkfunc( 3, func3_rtlib_cdecl, )
  128 chkfunc( 3, func3_rtlib_stdcall, )
  129 
  130 '' fbc declarations in a namespace
  131 '' however, c functions are not
  132 
  133 chksub( 1, sub1_rtlib_default, ns. )
  134 chksub( 1, sub1_rtlib_cdecl, ns. )
  135 chksub( 1, sub1_rtlib_stdcall, ns. )
  136 chkfunc( 1, func1_rtlib_default, ns. )
  137 chkfunc( 1, func1_rtlib_cdecl, ns. )
  138 chkfunc( 1, func1_rtlib_stdcall, ns. )
  139 
  140 chksub( 2, sub2_rtlib_default, ns. )
  141 chksub( 2, sub2_rtlib_cdecl, ns. )
  142 chksub( 2, sub2_rtlib_stdcall, ns. )
  143 chkfunc( 2, func2_rtlib_default, ns. )
  144 chkfunc( 2, func2_rtlib_cdecl, ns. )
  145 chkfunc( 2, func2_rtlib_stdcall, ns. )
  146 
  147 chksub( 3, sub3_rtlib_default, ns. )
  148 chksub( 3, sub3_rtlib_cdecl, ns. )
  149 chksub( 3, sub3_rtlib_stdcall, ns. )
  150 chkfunc( 3, func3_rtlib_default, ns. )
  151 chkfunc( 3, func3_rtlib_cdecl, ns. )
  152 chkfunc( 3, func3_rtlib_stdcall, ns. )