← Back to branch summary

~ubuntu-branches/ubuntu/feisty/fpc/feisty

« back to all changes in this revision

Viewing changes to packages/extra/winunits/jwawownt16.pas

  • Committer: Bazaar Package Importer
  • Author(s): Torsten Werner
  • Date: 2007-01-27 20:08:50 UTC
  • mfrom: (1.2.3 upstream)
  • Revision ID: james.westby@ubuntu.com-20070127200850-9mrptaqqjsx9nwa7
Tags: 2.0.4-5
* Fixed Build-Depends.
* Add myself to Uploaders in debian/control.
* Make sure that the sources are really patched before building them.
* Build unit 'libc' on powerpc too.

Show diffs side-by-side

added added

removed removed

Lines of Context:
packages/extra/winunits/jwawownt16.pas
1
 
{******************************************************************************}
2
 
{                                                                              }
3
 
{ 16 bit Generic Thunks API interface Unit for Object Pascal                   }
4
 
{                                                                              }
5
 
{ Portions created by Microsoft are Copyright (C) 1995-2001 Microsoft          }
6
 
{ Corporation. All Rights Reserved.                                            }
7
 
{                                                                              }
8
 
{ The original file is: wownt16.h, released June 2000. The original Pascal     }
9
 
{ code is: WowNT16.pas, released December 2000. The initial developer of the   }
10
 
{ Pascal code is Marcel van Brakel (brakelm att chello dott nl).               }
11
 
{                                                                              }
12
 
{ Portions created by Marcel van Brakel are Copyright (C) 1999-2001            }
13
 
{ Marcel van Brakel. All Rights Reserved.                                      }
14
 
{                                                                              }
15
 
{ Obtained through: Joint Endeavour of Delphi Innovators (Project JEDI)        }
16
 
{                                                                              }
17
 
{ You may retrieve the latest version of this file at the Project JEDI         }
18
 
{ APILIB home page, located at http://jedi-apilib.sourceforge.net              }
19
 
{                                                                              }
20
 
{ The contents of this file are used with permission, subject to the Mozilla   }
21
 
{ Public License Version 1.1 (the "License"); you may not use this file except }
22
 
{ in compliance with the License. You may obtain a copy of the License at      }
23
 
{ http://www.mozilla.org/MPL/MPL-1.1.html                                      }
24
 
{                                                                              }
25
 
{ Software distributed under the License is distributed on an "AS IS" basis,   }
26
 
{ WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for }
27
 
{ the specific language governing rights and limitations under the License.    }
28
 
{                                                                              }
29
 
{ Alternatively, the contents of this file may be used under the terms of the  }
30
 
{ GNU Lesser General Public License (the  "LGPL License"), in which case the   }
31
 
{ provisions of the LGPL License are applicable instead of those above.        }
32
 
{ If you wish to allow use of your version of this file only under the terms   }
33
 
{ of the LGPL License and not to allow others to use your version of this file }
34
 
{ under the MPL, indicate your decision by deleting  the provisions above and  }
35
 
{ replace  them with the notice and other provisions required by the LGPL      }
36
 
{ License.  If you do not delete the provisions above, a recipient may use     }
37
 
{ your version of this file under either the MPL or the LGPL License.          }
38
 
{                                                                              }
39
 
{ For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html }
40
 
{                                                                              }
41
 
{******************************************************************************}
42
 
 
43
 
// $Id: jwawownt16.pas,v 1.1 2005/04/04 07:56:11 marco Exp $
44
 
 
45
 
unit JwaWowNT16;
46
 
 
47
 
{$WEAKPACKAGEUNIT}
48
 
 
49
 
{$HPPEMIT ''}
50
 
{$HPPEMIT '#include "wownt16.h"'}
51
 
{$HPPEMIT ''}
52
 
 
53
 
{$I jediapilib.inc}
54
 
 
55
 
// (rom) get rid of warnings about "index" directive
56
 
{$WARN SYMBOL_PLATFORM OFF}
57
 
 
58
 
interface
59
 
 
60
 
uses
61
 
  JwaWinType;
62
 
 
63
 
//
64
 
// 16:16 -> 0:32 Pointer translation.
65
 
//
66
 
// GetVDMPointer32W will convert the passed in 16-bit address
67
 
// to the equivalent 32-bit flat pointer. The upper 16 bits
68
 
// of the address are treated according to the value passed in
69
 
// fMode: if fMode = 1, then the hiword of vp is used as a
70
 
// protected mode selector. Otherwise it is used as a real mode
71
 
// segment value.
72
 
// The lower 16 bits are treated as the offset.
73
 
//
74
 
// The return value is 0 if the selector is invalid.
75
 
//
76
 
// NOTE:  Limit checking is not performed in the retail build
77
 
// of Windows NT.  It is performed in the checked (debug) build
78
 
// of WOW32.DLL, which will cause 0 to be returned when the
79
 
// limit is exceeded by the supplied offset.
80
 
//
81
 
 
82
 
function GetVDMPointer32W(vp: LPVOID; fMode: UINT): DWORD; stdcall;
83
 
{$EXTERNALSYM GetVDMPointer32W}
84
 
 
85
 
//
86
 
// Win32 module management.
87
 
//
88
 
// The following routines accept parameters that correspond directly
89
 
// to the respective Win32 API function calls that they invoke. Refer
90
 
// to the Win32 reference documentation for more detail.
91
 
 
92
 
function LoadLibraryEx32W(lpszLibFile: LPCSTR; hFile, dwFlags: DWORD): DWORD; stdcall;
93
 
{$EXTERNALSYM LoadLibraryEx32W}
94
 
function GetProcAddress32W(hModule: DWORD; lpszProc: LPCSTR): DWORD; stdcall;
95
 
{$EXTERNALSYM GetProcAddress32W}
96
 
function FreeLibrary32W(hLibModule: DWORD): DWORD; stdcall;
97
 
{$EXTERNALSYM FreeLibrary32W}
98
 
 
99
 
//
100
 
// Generic Thunk Routine:
101
 
//
102
 
//   CallProc32W
103
 
//
104
 
// Transitions to 32 bits and calls specified routine
105
 
//
106
 
// This routine can pass a variable number of arguments, up to 32, to the
107
 
// target 32-bit routine. These arguments are given to CallProc32W following
108
 
// the 3 required parameters.
109
 
//
110
 
//   DWORD cParams          - Number of optional DWORD parameters (0-32)
111
 
//
112
 
//   LPVOID fAddressConvert - Bit Field, for 16:16 address Convertion. The
113
 
//                            optional parameters can be automatically converted
114
 
//                            from a 16:16 address format to flat by specifying
115
 
//                            a 1 bit in the corresponding position in this mask.
116
 
//                            eg (bit 1 means convert parameter 1 from 16:16
117
 
//                              to flat address before calling routine)
118
 
//
119
 
//   DWORD lpProcAddress   -  32 bit native address to call (use LoadLibraryEx32W
120
 
//                            and GetProcAddress32W to get this address).
121
 
//
122
 
// Returns:
123
 
//   What ever the API returned on 32 bit side in AX:DX
124
 
//
125
 
// Error Returns:
126
 
//   AX = 0, more than 32 parameters.
127
 
//
128
 
//
129
 
// The function prototype must be declared by the application source code
130
 
// in the following format:
131
 
//
132
 
// DWORD FAR PASCAL CallProc32W( DWORD p1, ... , DWORD lpProcAddress,
133
 
//                                        DWORD fAddressConvert, DWORD cParams);
134
 
//
135
 
// where the value in cParams must match the actual number of optional
136
 
// parameters (p1-pn) given AND the "DWORD p1, ..." must be replaced by
137
 
// the correct number of parameters being passed.  For example, passing 3
138
 
// parameter would simply require the removal of the ... and it insertion of
139
 
// "DWORD p2, DWORD p3" instead.  The fAddressConvert parameter uses bit 1
140
 
// for the last parameter (p3 in our example), with bit 2 for the next to last,
141
 
// etc.
142
 
//
143
 
// Generic Thunk Routine:
144
 
//
145
 
//   CallProcEx32W
146
 
//
147
 
// Transitions to 32 bits and calls specified routine
148
 
//
149
 
// Similar to the CallProc32W function, the CallProcEx32W is an equivalent
150
 
// function that is C calling convention and allows easier and more flexible
151
 
// prototyping.  See the prototype below.  The fAddressConvert parameter uses
152
 
// bit 1 for the 1st parameter, bit 2 for the 2nd parameter, etc.
153
 
//
154
 
// Both CallProc32W and CallProcEx32W accept a flag OR'd with the parameter
155
 
// count to indicate the calling convention of the function in 32 bits.
156
 
// For example, to call a cdecl function in 32-bits with 1 parameter, it would
157
 
// look like this:
158
 
//
159
 
// dwResult = CallProcEx32W( CPEX_DEST_CDECL | 1, 0, dwfn32, p1 );
160
 
//
161
 
 
162
 
// TODO Variable argument list wrapper!
163
 
 
164
 
(*
165
 
function CallProcEx32W(nParams, fAddressConvert, lpProcAddress: DWORD): DWORD; cdecl;
166
 
{$EXTERNALSYM CallProcEx32W}
167
 
*)
168
 
 
169
 
const
170
 
  CPEX_DEST_STDCALL  = DWORD($00000000);
171
 
  {$EXTERNALSYM CPEX_DEST_STDCALL}
172
 
  CPEX_DEST_CDECL    = DWORD($80000000);
173
 
  {$EXTERNALSYM CPEX_DEST_CDECL}
174
 
 
175
 
implementation
176
 
 
177
 
const
178
 
  wow16lib = 'kernel32.dll';
179
 
 
180
 
//function CallProcEx32W; external wow16lib index 517;
181
 
 
182
 
{$IFDEF DYNAMIC_LINK}
183
 
 
184
 
var
185
 
  _GetVDMPointer32W: Pointer;
186
 
 
187
 
function GetVDMPointer32W;
188
 
begin
189
 
  GetProcedureAddress(_GetVDMPointer32W, wow16lib, '516');
190
 
  asm
191
 
        MOV     ESP, EBP
192
 
        POP     EBP
193
 
        JMP     [_GetVDMPointer32W]
194
 
  end;
195
 
end;
196
 
 
197
 
var
198
 
  _LoadLibraryEx32W: Pointer;
199
 
 
200
 
function LoadLibraryEx32W;
201
 
begin
202
 
  GetProcedureAddress(_LoadLibraryEx32W, wow16lib, '513');
203
 
  asm
204
 
        MOV     ESP, EBP
205
 
        POP     EBP
206
 
        JMP     [_LoadLibraryEx32W]
207
 
  end;
208
 
end;
209
 
 
210
 
var
211
 
  _GetProcAddress32W: Pointer;
212
 
 
213
 
function GetProcAddress32W;
214
 
begin
215
 
  GetProcedureAddress(_GetProcAddress32W, wow16lib, '515');
216
 
  asm
217
 
        MOV     ESP, EBP
218
 
        POP     EBP
219
 
        JMP     [_GetProcAddress32W]
220
 
  end;
221
 
end;
222
 
 
223
 
var
224
 
  _FreeLibrary32W: Pointer;
225
 
 
226
 
function FreeLibrary32W;
227
 
begin
228
 
  GetProcedureAddress(_FreeLibrary32W, wow16lib, '514');
229
 
  asm
230
 
        MOV     ESP, EBP
231
 
        POP     EBP
232
 
        JMP     [_FreeLibrary32W]
233
 
  end;
234
 
end;
235
 
 
236
 
{$ELSE}
237
 
 
238
 
function GetVDMPointer32W; external wow16lib index 516;
239
 
function LoadLibraryEx32W; external wow16lib index 513;
240
 
function GetProcAddress32W; external wow16lib index 515;
241
 
function FreeLibrary32W; external wow16lib index 514;
242
 
 
243
 
{$ENDIF DYNAMIC_LINK}
244
 
 
245
 
end.
 
1
{******************************************************************************}
 
2
{                                                                              }
 
3
{ 16 bit Generic Thunks API interface Unit for Object Pascal                   }
 
4
{                                                                              }
 
5
{ Portions created by Microsoft are Copyright (C) 1995-2001 Microsoft          }
 
6
{ Corporation. All Rights Reserved.                                            }
 
7
{                                                                              }
 
8
{ The original file is: wownt16.h, released June 2000. The original Pascal     }
 
9
{ code is: WowNT16.pas, released December 2000. The initial developer of the   }
 
10
{ Pascal code is Marcel van Brakel (brakelm att chello dott nl).               }
 
11
{                                                                              }
 
12
{ Portions created by Marcel van Brakel are Copyright (C) 1999-2001            }
 
13
{ Marcel van Brakel. All Rights Reserved.                                      }
 
14
{                                                                              }
 
15
{ Obtained through: Joint Endeavour of Delphi Innovators (Project JEDI)        }
 
16
{                                                                              }
 
17
{ You may retrieve the latest version of this file at the Project JEDI         }
 
18
{ APILIB home page, located at http://jedi-apilib.sourceforge.net              }
 
19
{                                                                              }
 
20
{ The contents of this file are used with permission, subject to the Mozilla   }
 
21
{ Public License Version 1.1 (the "License"); you may not use this file except }
 
22
{ in compliance with the License. You may obtain a copy of the License at      }
 
23
{ http://www.mozilla.org/MPL/MPL-1.1.html                                      }
 
24
{                                                                              }
 
25
{ Software distributed under the License is distributed on an "AS IS" basis,   }
 
26
{ WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for }
 
27
{ the specific language governing rights and limitations under the License.    }
 
28
{                                                                              }
 
29
{ Alternatively, the contents of this file may be used under the terms of the  }
 
30
{ GNU Lesser General Public License (the  "LGPL License"), in which case the   }
 
31
{ provisions of the LGPL License are applicable instead of those above.        }
 
32
{ If you wish to allow use of your version of this file only under the terms   }
 
33
{ of the LGPL License and not to allow others to use your version of this file }
 
34
{ under the MPL, indicate your decision by deleting  the provisions above and  }
 
35
{ replace  them with the notice and other provisions required by the LGPL      }
 
36
{ License.  If you do not delete the provisions above, a recipient may use     }
 
37
{ your version of this file under either the MPL or the LGPL License.          }
 
38
{                                                                              }
 
39
{ For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html }
 
40
{                                                                              }
 
41
{******************************************************************************}
 
42
 
 
43
 
 
44
unit JwaWowNT16;
 
45
 
 
46
{$WEAKPACKAGEUNIT}
 
47
 
 
48
{$HPPEMIT ''}
 
49
{$HPPEMIT '#include "wownt16.h"'}
 
50
{$HPPEMIT ''}
 
51
 
 
52
{$I jediapilib.inc}
 
53
 
 
54
// (rom) get rid of warnings about "index" directive
 
55
{ $WARN SYMBOL_PLATFORM OFF}
 
56
 
 
57
interface
 
58
 
 
59
uses
 
60
  JwaWinType;
 
61
 
 
62
//
 
63
// 16:16 -> 0:32 Pointer translation.
 
64
//
 
65
// GetVDMPointer32W will convert the passed in 16-bit address
 
66
// to the equivalent 32-bit flat pointer. The upper 16 bits
 
67
// of the address are treated according to the value passed in
 
68
// fMode: if fMode = 1, then the hiword of vp is used as a
 
69
// protected mode selector. Otherwise it is used as a real mode
 
70
// segment value.
 
71
// The lower 16 bits are treated as the offset.
 
72
//
 
73
// The return value is 0 if the selector is invalid.
 
74
//
 
75
// NOTE:  Limit checking is not performed in the retail build
 
76
// of Windows NT.  It is performed in the checked (debug) build
 
77
// of WOW32.DLL, which will cause 0 to be returned when the
 
78
// limit is exceeded by the supplied offset.
 
79
//
 
80
 
 
81
function GetVDMPointer32W(vp: LPVOID; fMode: UINT): DWORD; stdcall;
 
82
{$EXTERNALSYM GetVDMPointer32W}
 
83
 
 
84
//
 
85
// Win32 module management.
 
86
//
 
87
// The following routines accept parameters that correspond directly
 
88
// to the respective Win32 API function calls that they invoke. Refer
 
89
// to the Win32 reference documentation for more detail.
 
90
 
 
91
function LoadLibraryEx32W(lpszLibFile: LPCSTR; hFile, dwFlags: DWORD): DWORD; stdcall;
 
92
{$EXTERNALSYM LoadLibraryEx32W}
 
93
function GetProcAddress32W(hModule: DWORD; lpszProc: LPCSTR): DWORD; stdcall;
 
94
{$EXTERNALSYM GetProcAddress32W}
 
95
function FreeLibrary32W(hLibModule: DWORD): DWORD; stdcall;
 
96
{$EXTERNALSYM FreeLibrary32W}
 
97
 
 
98
//
 
99
// Generic Thunk Routine:
 
100
//
 
101
//   CallProc32W
 
102
//
 
103
// Transitions to 32 bits and calls specified routine
 
104
//
 
105
// This routine can pass a variable number of arguments, up to 32, to the
 
106
// target 32-bit routine. These arguments are given to CallProc32W following
 
107
// the 3 required parameters.
 
108
//
 
109
//   DWORD cParams          - Number of optional DWORD parameters (0-32)
 
110
//
 
111
//   LPVOID fAddressConvert - Bit Field, for 16:16 address Convertion. The
 
112
//                            optional parameters can be automatically converted
 
113
//                            from a 16:16 address format to flat by specifying
 
114
//                            a 1 bit in the corresponding position in this mask.
 
115
//                            eg (bit 1 means convert parameter 1 from 16:16
 
116
//                              to flat address before calling routine)
 
117
//
 
118
//   DWORD lpProcAddress   -  32 bit native address to call (use LoadLibraryEx32W
 
119
//                            and GetProcAddress32W to get this address).
 
120
//
 
121
// Returns:
 
122
//   What ever the API returned on 32 bit side in AX:DX
 
123
//
 
124
// Error Returns:
 
125
//   AX = 0, more than 32 parameters.
 
126
//
 
127
//
 
128
// The function prototype must be declared by the application source code
 
129
// in the following format:
 
130
//
 
131
// DWORD FAR PASCAL CallProc32W( DWORD p1, ... , DWORD lpProcAddress,
 
132
//                                        DWORD fAddressConvert, DWORD cParams);
 
133
//
 
134
// where the value in cParams must match the actual number of optional
 
135
// parameters (p1-pn) given AND the "DWORD p1, ..." must be replaced by
 
136
// the correct number of parameters being passed.  For example, passing 3
 
137
// parameter would simply require the removal of the ... and it insertion of
 
138
// "DWORD p2, DWORD p3" instead.  The fAddressConvert parameter uses bit 1
 
139
// for the last parameter (p3 in our example), with bit 2 for the next to last,
 
140
// etc.
 
141
//
 
142
// Generic Thunk Routine:
 
143
//
 
144
//   CallProcEx32W
 
145
//
 
146
// Transitions to 32 bits and calls specified routine
 
147
//
 
148
// Similar to the CallProc32W function, the CallProcEx32W is an equivalent
 
149
// function that is C calling convention and allows easier and more flexible
 
150
// prototyping.  See the prototype below.  The fAddressConvert parameter uses
 
151
// bit 1 for the 1st parameter, bit 2 for the 2nd parameter, etc.
 
152
//
 
153
// Both CallProc32W and CallProcEx32W accept a flag OR'd with the parameter
 
154
// count to indicate the calling convention of the function in 32 bits.
 
155
// For example, to call a cdecl function in 32-bits with 1 parameter, it would
 
156
// look like this:
 
157
//
 
158
// dwResult = CallProcEx32W( CPEX_DEST_CDECL | 1, 0, dwfn32, p1 );
 
159
//
 
160
 
 
161
// TODO Variable argument list wrapper!
 
162
 
 
163
(*
 
164
function CallProcEx32W(nParams, fAddressConvert, lpProcAddress: DWORD): DWORD; cdecl;
 
165
{$EXTERNALSYM CallProcEx32W}
 
166
*)
 
167
 
 
168
const
 
169
  CPEX_DEST_STDCALL  = DWORD($00000000);
 
170
  {$EXTERNALSYM CPEX_DEST_STDCALL}
 
171
  CPEX_DEST_CDECL    = DWORD($80000000);
 
172
  {$EXTERNALSYM CPEX_DEST_CDECL}
 
173
 
 
174
implementation
 
175
 
 
176
const
 
177
  wow16lib = 'kernel32.dll';
 
178
 
 
179
//function CallProcEx32W; external wow16lib index 517;
 
180
 
 
181
{$IFDEF DYNAMIC_LINK}
 
182
 
 
183
var
 
184
  _GetVDMPointer32W: Pointer;
 
185
 
 
186
function GetVDMPointer32W;
 
187
begin
 
188
  GetProcedureAddress(_GetVDMPointer32W, wow16lib, '516');
 
189
  asm
 
190
        MOV     ESP, EBP
 
191
        POP     EBP
 
192
        JMP     [_GetVDMPointer32W]
 
193
  end;
 
194
end;
 
195
 
 
196
var
 
197
  _LoadLibraryEx32W: Pointer;
 
198
 
 
199
function LoadLibraryEx32W;
 
200
begin
 
201
  GetProcedureAddress(_LoadLibraryEx32W, wow16lib, '513');
 
202
  asm
 
203
        MOV     ESP, EBP
 
204
        POP     EBP
 
205
        JMP     [_LoadLibraryEx32W]
 
206
  end;
 
207
end;
 
208
 
 
209
var
 
210
  _GetProcAddress32W: Pointer;
 
211
 
 
212
function GetProcAddress32W;
 
213
begin
 
214
  GetProcedureAddress(_GetProcAddress32W, wow16lib, '515');
 
215
  asm
 
216
        MOV     ESP, EBP
 
217
        POP     EBP
 
218
        JMP     [_GetProcAddress32W]
 
219
  end;
 
220
end;
 
221
 
 
222
var
 
223
  _FreeLibrary32W: Pointer;
 
224
 
 
225
function FreeLibrary32W;
 
226
begin
 
227
  GetProcedureAddress(_FreeLibrary32W, wow16lib, '514');
 
228
  asm
 
229
        MOV     ESP, EBP
 
230
        POP     EBP
 
231
        JMP     [_FreeLibrary32W]
 
232
  end;
 
233
end;
 
234
 
 
235
{$ELSE}
 
236
 
 
237
function GetVDMPointer32W; external wow16lib index 516;
 
238
function LoadLibraryEx32W; external wow16lib index 513;
 
239
function GetProcAddress32W; external wow16lib index 515;
 
240
function FreeLibrary32W; external wow16lib index 514;
 
241
 
 
242
{$ENDIF DYNAMIC_LINK}
 
243
 
 
244
end.