pgwdll32.gml

开放源码的编译器open watcom 1.6.0版的源代码

*$pragma aux (dll32_call) indirect_1 \
*            parm( value*4, value*4, value*4 )
*$pragma aux (dll32_call) indirect_2 \
*            parm( value*4, value*4 )

.code break
      integer*2 function FWinMain( hInstance,
     &                             hPrevInstance,
     &                             lpszCmdLine,
     &                             nCmdShow )
      integer*2 hInstance
      integer*2 hPrevInstance
      integer*4 lpszCmdLine
      integer*2 nCmdShow

      include 'windows.fi'

      integer*2 hlib
      integer*4 indirect_1, indirect_2
      integer*4 dll_1, dll_2, cb
      character*128 str

.code break
      hlib = LoadLibrary( 'windllv.dll'c )
      if( hlib .lt. 32 ) then
          call MessageBox( NULL, 'Can''t load WINDLLV'c,
     &                     'Gen16V'c, MB_OK )
          stop
      endif

.code break
      dll_1 = GetProcAddress( hlib, 'DLL1'c )
      dll_2 = GetProcAddress( hlib, 'DLL2'c )

.code break
      cb = indirect_1( 111, 22222, 3333, dll_1 )
      write( str, '(15hDLL 1 returned , i10, a)' ) cb, char(0)
      call MessageBox( NULL, str, 'Gen16V Test 1'c, MB_OK )

.code break
      cb = indirect_2( 4444, 55, dll_2 )
      write( str, '(15hDLL 2 returned , i10, a)' ) cb, char(0)
      call MessageBox( NULL, str, 'Gen16V Test 2'c, MB_OK )

      FWinMain = 0

      end
.code end
.np
The addresses of the routines
.id DLL1
and
.id DLL2
in the 32-bit DLL are obtained and stored in the variables
.id dll_1
and
.id dll_2.
Since the FORTRAN 77 language does not support indirect function
calls, we need a mechanism to call these functions indirectly.
We do this using the two indirect functions called
.id indirect_1
and
.id indirect_2.
These two functions are given the
.id dll32_call
attribute using an auxiliary pragma which is defined in the file
.fi WINAPI.FI.
Note that the last argument of the calls to
.id indirect_1
or
.id indirect_2
is the actual address of the DLL routine.
.np
What you should realize is that the
.id indirect_1
and
.id indirect_2
functions do not really exist.
The code that is generated for statements like the following is really
an indirect call to the function whose address is represented in the
last argument.
.millust begin
cb = indirect_1( 111, 22222, 3333, dll_1 )
cb = indirect_2( 4444, 55, dll_2 )
.millust end
.pc
This is a result of using the
.id dll32_call
auxiliary pragma attribute to describe both
.id indirect_1
and
.id indirect_2.
You can verify this by disassembling the object file that is generated
when this code is compiled.
.*
.section Calling Functions in a 32-bit DLL from a 32-bit Application
.*
.np
.ix 'DLL' '32-bit calls into 32-bit DLLs'
The following is a 32-bit Windows program that demonstrates how to
call the two routines defined in our 32-bit DLL example.
Since this is a 32-bit Windows program, we will use the
.id _Call16
function to call functions in our 32-bit DLL.
Note that we get to the 32-bit DLL functions by going indirectly
through the 16-bit supervisor that forms the "front end" for our
32-bit DLL.
.code begin
*$include winapi.fi

* GEN32V.FOR

* Setup:            set finclude=\WATCOM\src\fortran\win
* Compile and Link: wfl386 gen32v -explicit -d2 -l=win386
* Bind:             wbind gen32v -n -D "32-bit DLL Test"


.code break
      integer*2 function FWinMain( hInstance,
     &                               hPrevInstance,
     &                               lpszCmdLine,
     &                               nCmdShow )
      integer*2 hInstance
      integer*2 hPrevInstance
      integer*4 lpszCmdLine
      integer*2 nCmdShow

      include 'windows.fi'

      integer*2 hlib
      integer*4 dll_1, dll_2, cb
      character*128 str

.code break
      hlib = LoadLibrary( 'windllv.dll'c )
      if( hlib .lt. 32 ) then
          call MessageBox( NULL, 'Can''t load WINDLLV'c,
     &                     'Gen32V'c, MB_OK )
          stop
      endif

.code break
      dll_1 = GetProcAddress( hlib, 'DLL1'c )
      dll_2 = GetProcAddress( hlib, 'DLL2'c )

.code break
      cb = _Call16( dll_1, 'ddd'c, 111, 22222, 3333 )
      write( str, '(15hDLL 1 returned , i10, a)' ) cb, char(0)
      call MessageBox( NULL, str, 'Gen32V Test 1'c, MB_OK )

.code break
      cb = _Call16( dll_2, 'dd'c, 4444, 55 )
      write( str, '(15hDLL 2 returned , i10, a)' ) cb, char(0)
      call MessageBox( NULL, str, 'Gen32V Test 2'c, MB_OK )

      FWinMain = 0

      end
.code end
.np
Note that the first argument of a call to
.id _Call16
is the DLL function address returned by
.id GetProcAddress
and must be a 32-bit argument.
The second argument of a call to
.id _Call16
is a string describing the types of arguments that will be passed to
the DLL function.
.*
.section A Sample 32-bit DLL Using a Structure
.*
.np
.ix 'DLL' 'passing information in a structure'
As previously mentioned, passing pointers from a 16 or 32-bit Windows
application to a 32-bit DLL poses a problem since all pointers are
passed as 16-bit far pointers.
The pointer must be converted from a 16-bit far pointer to a 32-bit
far pointer.
This is achieved by mapping a dynamically allocatable array to each
argument that is passed by reference using the
.kwm LOCATION
specifier of the
.kwm ALLOCATE
statement.
Furthermore, you must specify the
.kwm far
attribute for each such array using the
.id array
pragma.
Since this is cumbersome if you wish to pass many arguments, it is
recommended that a single argument be passed that is actually a
pointer to a structure that contains the actual arguments.
Furthermore, since each call to a DLL routine is made indirectly
through one of
.id Win386LibEntry
or
.id DLL1
through
.id DLL128,
you should also return any values in the same structure since the
return value from any of these functions is only 32-bits wide.
.np
The following example is a 32-bit DLL that receives its arguments
and returns values using a structure.
The source code for these examples is provided in the
.fi &srcdir.
directory.
We describe how to compile and link the examples in the section
entitled :HDREF refid='dlcreat'..
.code begin
*$include winapi.fi

* WINDLL.FOR

* Setup:            set finclude=\WATCOM\src\fortran\win
* Compile and Link: wfl386 windll -explicit -d2 -bd -l=win386
* Bind:             wbind windll -d -n

.code break
*$pragma aux (dll_function) Add3

      subroutine Add3( arg_list )
      integer*4 arg_list
      structure /argtypes/
          integer     w1
          integer     w2
          integer     w3
          integer     sum
      end structure
      record /argtypes/ args(:)
*$pragma array args far

      include 'windows.fi'

      character*128 str

.code break
      allocate( args(1), location=arg_list )
      write( str, '(16hDLL 1 arguments:, 3i10, a)' ) args(1).w1,
     &                                               args(1).w2,
     &                                               args(1).w3,
     &                                               char(0)
      call MessageBox( NULL, str, 'DLL Function 1'c, MB_OK )
      args(1).sum = args(1).w1 + args(1).w2 + args(1).w3
      deallocate( args )

      end

.code break
*$pragma aux (dll_function) Add2

      subroutine Add2( arg_list )
      integer*4 arg_list
      structure /argtypes/
          real        w1
          real        w2
          real        sum
      end structure
      record /argtypes/ args(:)
*$pragma array args far

      include 'windows.fi'

      character*128 str

.code break
      allocate( args(1), location=arg_list )
      write( str, '(16hDLL 2 arguments:, 2f10.2, a)' ) args(1).w1,
     &                                                 args(1).w2,
     &                                                 char(0)
      call MessageBox( NULL, str, 'DLL Function 2'c, MB_OK )
      args(1).sum = args(1).w1 + args(1).w2
      deallocate( args )

      end

.code break
      integer*2 function FWinMain( hInstance,
     &                             hPrevInstance,
     &                             lpszCmdLine,
     &                             nCmdShow )
      integer*2 hInstance
      integer*2 hPrevInstance
      integer*4 lpszCmdLine
      integer*2 nCmdShow

      include 'windows.fi'

      external Add3, Add2
      integer rc

.code break
      call BreakPoint
      rc = DefineDLLEntry( 1, Add3, DLL_PTR, DLL_ENDLIST )
      if( rc .ne. 0 )then
          FWinMain = 0
          return
      end if
.code break
      rc = DefineDLLEntry( 2, Add2, DLL_PTR, DLL_ENDLIST )
      if( rc .ne. 0 )then
          FWinMain = 0
          return
      end if
      call MessageBox( NULL, '32-bit DLL started'c,
     &                 'WINDLL'c, MB_OK )
      FWinMain = 1

      end
.code end
.np
The following example is a 16-bit Windows application that passes
arguments to a 32-bit DLL using a structure.
.code begin
*$include winapi.fi

* GEN16.FOR

* Setup:            set finclude=\WATCOM\src\fortran\win
* Compile and Link: wfl gen16 -explicit -d2 -windows -l=windows
*                             -"op desc '16-bit DLL Test'"

*$pragma aux (dll32_call) indirect_1 parm( reference, value*4 )
*$pragma aux (dll32_call) indirect_2 parm( reference, value*4 )

.code break
      integer*2 function FWinMain( hInstance,
     &                             hPrevInstance,
     &                             lpszCmdLine,
     &                             nCmdShow )
      integer*2 hInstance
      integer*2 hPrevInstance
      integer*4 lpszCmdLine
      integer*2 nCmdShow

      include 'windows.fi'

      integer*2 hlib
      integer*4 dll_1, dll_2
      character*128 str

.code break
      structure /args_1/
          integer     w1
          integer     w2
          integer     w3
          integer     sum
      end structure

      structure /args_2/
          real        w1
          real        w2
          real        sum
      end structure

.code break
      record /args_1/ args_1/111, 22222, 3333, 0/
      record /args_2/ args_2/714.3, 35.7, 0.0/

      hlib = LoadLibrary( 'windll.dll'c )
      if( hlib .lt. 32 ) then
          call MessageBox( NULL, 'Can''t load WINDLL'c,
     &                     'Gen16'c, MB_OK )
          stop
      endif

.code break
      dll_1 = GetProcAddress( hlib, 'DLL1'c )
      dll_2 = GetProcAddress( hlib, 'DLL2'c )

.code break
      call indirect_1( args_1, dll_1 )
      write( str, '(15hDLL 1 returned , i10, a)' ) args_1.sum,
     &                                             char(0)
      call MessageBox( NULL, str, 'Gen16 Test 1'c, MB_OK )

.code break
      call indirect_2( args_2, dll_2 )
      write( str, '(15hDLL 2 returned , f10.2, a)' ) args_2.sum,
     &                                               char(0)
      call MessageBox( NULL, str, 'Gen16 Test 2'c, MB_OK )

      FWinMain = 0

      end
.code end
.np
The following example is a 32-bit Windows application that passes
arguments to a 32-bit DLL using a structure.
.code begin
*$include winapi.fi

* GEN32.FOR

* Setup:            set finclude=\WATCOM\src\fortran\win
* Compile and Link: wfl386 gen32 -explicit -d2 -l=win386
* Bind:             wbind gen32 -n -D "32-bit DLL Test"

.code break
      integer*2 function FWinMain( hInstance,
     &                             hPrevInstance,
     &                             lpszCmdLine,
     &                             nCmdShow )
      integer*2 hInstance
      integer*2 hPrevInstance
      integer*4 lpszCmdLine
      integer*2 nCmdShow

      include 'windows.fi'

      integer*2 hlib
      integer*4 dll_1, dll_2, cb
      character*128 str

.code break
      structure /args_1/
          integer     w1
          integer     w2
          integer     w3
          integer     sum
      end structure

      structure /args_2/
          real        w1
          real        w2
          real        sum
      end structure

.code break
      record /args_1/ args_1/111, 22222, 3333, 0/
      record /args_2/ args_2/714.3, 35.7, 0.0/

      hlib = LoadLibrary( 'windll.dll'c )
      if( hlib .lt. 32 ) then
          call MessageBox( NULL, 'Can''t load WINDLL'c,
     &                     'Gen32'c, MB_OK )
          stop
      endif