Bläddra i källkod

* fixed OS/2 compilation after dynlibs manager implementation

git-svn-id: trunk@29617 -
Tomas Hajny 10 år sedan
förälder
incheckning
dbc50980d1
6 ändrade filer med 184 tillägg och 237 borttagningar
  1. 1 0
      .gitattributes
  2. 1 123
      rtl/os2/dynlibs.inc
  3. 138 0
      rtl/os2/sysdl.inc
  4. 0 114
      rtl/os2/sysdlh.inc
  5. 43 0
      rtl/os2/sysos.inc
  6. 1 0
      rtl/os2/system.pas

+ 1 - 0
.gitattributes

@@ -9042,6 +9042,7 @@ rtl/os2/prt0.as svneol=native#text/plain
 rtl/os2/rtldefs.inc svneol=native#text/plain
 rtl/os2/so32dll.pas svneol=native#text/plain
 rtl/os2/sysdir.inc svneol=native#text/plain
+rtl/os2/sysdl.inc svneol=native#text/plain
 rtl/os2/sysdlh.inc svneol=native#text/plain
 rtl/os2/sysfile.inc svneol=native#text/plain
 rtl/os2/sysheap.inc svneol=native#text/plain

+ 1 - 123
rtl/os2/dynlibs.inc

@@ -13,129 +13,7 @@
 
  **********************************************************************}
 
-
-uses
- DosCalls;
-
-threadvar
- DynLibErrNo: cardinal;
- DynLibErrPath: array [0..259] of char;
-
-function SysLoadLibraryA (const Name: RawbyteString): TLibHandle;
-var
- Handle: longint;
-begin
- DynLibErrPath [0] := #0;
- DynLibErrNo := DosLoadModule (@DynLibErrPath [0], SizeOf (DynLibErrPath),
-                                                         PAnsiChar (Name), Handle);
- if DynLibErrNo = 0 then
-  Result := Handle
- else
-  begin
-   Result := NilHandle;
-   OSErrorWatch (DynLibErrNo);
-  end;
-end;
-
-function SysLoadLibraryU (const Name: UnicodeString): TLibHandle;
-begin
-  Result := SysLoadLibraryA(ToSingleByteFileSystemEncodedFileName(Name));
-end;
-
-function SysGetProcedureAddress (Lib: TLibHandle; const ProcName: AnsiString): pointer;
-var
- P: pointer;
-begin
- DynLibErrPath [0] := #0;
- DynLibErrNo := DosQueryProcAddr (Lib, 0, PChar (ProcName), P);
- if DynLibErrNo = 0 then
-  Result := P
- else
-  begin
-   Result := nil;
-   OSErrorWatch (DynLibErrNo);
-  end;
-end;
-
-function SysGetProcedureAddressOrdinal (Lib: TLibHandle; Ordinal: TOrdinalEntry): pointer;
-var
- P: pointer;
-begin
- DynLibErrPath [0] := #0;
- DynLibErrNo := DosQueryProcAddr (Lib, Ordinal, nil, P);
- if DynLibErrNo = 0 then
-  Result := P
- else
-  begin
-   Result := nil;
-   OSErrorWatch (DynLibErrNo);
-  end;
-end;
-
-function SysUnloadLibrary (Lib: TLibHandle): boolean;
-begin
- DynLibErrPath [0] := #0;
- DynLibErrNo := DosFreeModule (Lib);
- Result := DynLibErrNo = 0;
- if DynLibErrNo <> 0 then
-  OSErrorWatch (DynLibErrNo);
-end;
-
-function GetDynLibsError: longint;
-begin
- GetDynLibsError := DynLibErrNo;
-end;
-
-function SysGetDynLibsErrorStr: string;
-const
- SysMsgFile: array [0..10] of char = 'OSO001.MSG'#0;
-var
- VarArr: array [1..9] of PChar;
- OutBuf: array [0..999] of char;
- RetMsgSize: cardinal;
- RC: cardinal;
-begin
- if DynLibErrNo = 0 then
-  SysGetDynLibsErrorStr := ''
- else
-  begin
-   Result := '';
-   VarArr [1] := @DynLibErrPath [0];
-   RC := DosGetMessage (@VarArr, 1, @OutBuf [0], SizeOf (OutBuf),
-                                     DynLibErrNo, @SysMsgFile [0], RetMsgSize);
-   if RC = 0 then
-    begin
-     SetLength (Result, RetMsgSize);
-     Move (OutBuf [0], Result [1], RetMsgSize);
-    end
-   else
-    begin
-     Str (DynLibErrNo, Result);
-     Result := 'Error ' + Result;
-     if DynLibErrPath [0] <> #0 then
-      Result := StrPas (@DynLibErrPath [0]) + ' - ' + Result;
-     OSErrorWatch (RC);
-    end;
-  end;
-end;
-
-function SysGetLoadErrorStr: string;
-begin
- GetLoadErrorStr := GetDynLibsErrorStr;
-end;
-
-const
-  SysDynLibsManager: TDynLibsManager = (
-    LoadLibraryU: @SysLoadLibraryU;
-    LoadLibraryA: @SysLoadLibraryA;
-    GetProcAddress: @SysGetProcedureAddress;
-    GetProcAddressOrdinal: @SysGetProcedureAdressOrdinal;
-    UnloadLibrary: @SysUnloadLibrary;
-    GetLoadErrorStr: @SysGetLoadErrorStr;
-  );
-
 procedure InitDynLibs;
 begin
-  SetDynLibsManager(SysDynLibsManager);
+  { nothing to do here since OS/2 DynLibs is done in System }
 end;
-

+ 138 - 0
rtl/os2/sysdl.inc

@@ -0,0 +1,138 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2000 by the Free Pascal development team
+
+    Implements OS dependent part for loading of dynamic libraries.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+
+threadvar
+ DynLibErrNo: cardinal;
+ DynLibErrPath: array [0..259] of char;
+
+function SysLoadLibraryA (const Name: RawbyteString): TLibHandle;
+var
+ Handle: longint;
+begin
+ DynLibErrPath [0] := #0;
+ DynLibErrNo := DosLoadModule (@DynLibErrPath [0], SizeOf (DynLibErrPath),
+                                                         PAnsiChar (Name), Handle);
+ if DynLibErrNo = 0 then
+  Result := Handle
+ else
+  begin
+   Result := NilHandle;
+   OSErrorWatch (DynLibErrNo);
+  end;
+end;
+
+function SysLoadLibraryU (const Name: UnicodeString): TLibHandle;
+begin
+  Result := SysLoadLibraryA(ToSingleByteFileSystemEncodedFileName(Name));
+end;
+
+function SysGetProcedureAddress (Lib: TLibHandle; const ProcName: AnsiString): pointer;
+var
+ P: pointer;
+begin
+ DynLibErrPath [0] := #0;
+ DynLibErrNo := DosQueryProcAddr (Lib, 0, PChar (ProcName), P);
+ if DynLibErrNo = 0 then
+  Result := P
+ else
+  begin
+   Result := nil;
+   OSErrorWatch (DynLibErrNo);
+  end;
+end;
+
+function SysGetProcedureAddressOrdinal (Lib: TLibHandle; Ordinal: TOrdinalEntry): pointer;
+var
+ P: pointer;
+begin
+ DynLibErrPath [0] := #0;
+ DynLibErrNo := DosQueryProcAddr (Lib, Ordinal, nil, P);
+ if DynLibErrNo = 0 then
+  Result := P
+ else
+  begin
+   Result := nil;
+   OSErrorWatch (DynLibErrNo);
+  end;
+end;
+
+function SysUnloadLibrary (Lib: TLibHandle): boolean;
+begin
+ DynLibErrPath [0] := #0;
+ DynLibErrNo := DosFreeModule (Lib);
+ Result := DynLibErrNo = 0;
+ if DynLibErrNo <> 0 then
+  OSErrorWatch (DynLibErrNo);
+end;
+
+function GetDynLibsError: longint;
+begin
+ GetDynLibsError := DynLibErrNo;
+end;
+
+function SysGetDynLibsErrorStr: string;
+const
+ SysMsgFile: array [0..10] of char = 'OSO001.MSG'#0;
+var
+ VarArr: array [1..9] of PChar;
+ OutBuf: array [0..999] of char;
+ RetMsgSize: cardinal;
+ RC: cardinal;
+begin
+ if DynLibErrNo = 0 then
+  SysGetDynLibsErrorStr := ''
+ else
+  begin
+   Result := '';
+   VarArr [1] := @DynLibErrPath [0];
+   RC := DosGetMessage (@VarArr, 1, @OutBuf [0], SizeOf (OutBuf),
+                                     DynLibErrNo, @SysMsgFile [0], RetMsgSize);
+   if RC = 0 then
+    begin
+     SetLength (Result, RetMsgSize);
+     Move (OutBuf [0], Result [1], RetMsgSize);
+    end
+   else
+    begin
+     Str (DynLibErrNo, Result);
+     Result := 'Error ' + Result;
+     if DynLibErrPath [0] <> #0 then
+      Result := StrPas (@DynLibErrPath [0]) + ' - ' + Result;
+     OSErrorWatch (RC);
+    end;
+  end;
+end;
+
+function SysGetLoadErrorStr: string;
+begin
+ SysGetLoadErrorStr := SysGetDynLibsErrorStr;
+end;
+
+const
+  SysDynLibsManager: TDynLibsManager = (
+    LoadLibraryU: @SysLoadLibraryU;
+    LoadLibraryA: @SysLoadLibraryA;
+    GetProcAddress: @SysGetProcedureAddress;
+    GetProcAddressOrdinal: @SysGetProcedureAddressOrdinal;
+    UnloadLibrary: @SysUnloadLibrary;
+    GetLoadErrorStr: @SysGetLoadErrorStr;
+  );
+
+procedure InitSystemDynLibs;
+begin
+  SetDynLibsManager(SysDynLibsManager);
+end;
+

+ 0 - 114
rtl/os2/sysdlh.inc

@@ -14,8 +14,6 @@
  **********************************************************************}
 
 
-{$ifdef readinterface}
-
 { ---------------------------------------------------------------------
     Interface declarations
   ---------------------------------------------------------------------}
@@ -30,115 +28,3 @@ const
  NilHandle = 0;
 // these are for easier crossplatform construction of dll names in dynloading libs.
  SharedSuffix  = 'dll';
-
-{$else}
-
-{ ---------------------------------------------------------------------
-    Implementation section
-  ---------------------------------------------------------------------}
-
-uses
- DosCalls;
-
-threadvar
- DynLibErrNo: cardinal;
- DynLibErrPath: array [0..259] of char;
-
-function DoLoadLibrary (const Name: RawbyteString): TLibHandle;
-var
- Handle: longint;
-begin
- DynLibErrPath [0] := #0;
- DynLibErrNo := DosLoadModule (@DynLibErrPath [0], SizeOf (DynLibErrPath),
-                                                         PAnsiChar (Name), Handle);
- if DynLibErrNo = 0 then
-  Result := Handle
- else
-  begin
-   Result := NilHandle;
-   OSErrorWatch (DynLibErrNo);
-  end;
-end;
-
-function GetProcedureAddress (Lib: TLibHandle; const ProcName: AnsiString): pointer;
-var
- P: pointer;
-begin
- DynLibErrPath [0] := #0;
- DynLibErrNo := DosQueryProcAddr (Lib, 0, PChar (ProcName), P);
- if DynLibErrNo = 0 then
-  Result := P
- else
-  begin
-   Result := nil;
-   OSErrorWatch (DynLibErrNo);
-  end;
-end;
-
-function GetProcedureAddress (Lib: TLibHandle; Ordinal: TOrdinalEntry): pointer;
-var
- P: pointer;
-begin
- DynLibErrPath [0] := #0;
- DynLibErrNo := DosQueryProcAddr (Lib, Ordinal, nil, P);
- if DynLibErrNo = 0 then
-  Result := P
- else
-  begin
-   Result := nil;
-   OSErrorWatch (DynLibErrNo);
-  end;
-end;
-
-function UnloadLibrary (Lib: TLibHandle): boolean;
-begin
- DynLibErrPath [0] := #0;
- DynLibErrNo := DosFreeModule (Lib);
- Result := DynLibErrNo = 0;
- if DynLibErrNo <> 0 then
-  OSErrorWatch (DynLibErrNo);
-end;
-
-function GetDynLibsError: longint;
-begin
- GetDynLibsError := DynLibErrNo;
-end;
-
-function GetDynLibsErrorStr: string;
-const
- SysMsgFile: array [0..10] of char = 'OSO001.MSG'#0;
-var
- VarArr: array [1..9] of PChar;
- OutBuf: array [0..999] of char;
- RetMsgSize: cardinal;
- RC: cardinal;
-begin
- if DynLibErrNo = 0 then
-  GetDynLibsErrorStr := ''
- else
-  begin
-   Result := '';
-   VarArr [1] := @DynLibErrPath [0];
-   RC := DosGetMessage (@VarArr, 1, @OutBuf [0], SizeOf (OutBuf),
-                                     DynLibErrNo, @SysMsgFile [0], RetMsgSize);
-   if RC = 0 then
-    begin
-     SetLength (Result, RetMsgSize);
-     Move (OutBuf [0], Result [1], RetMsgSize);
-    end
-   else
-    begin
-     Str (DynLibErrNo, Result);
-     Result := 'Error ' + Result;
-     if DynLibErrPath [0] <> #0 then
-      Result := StrPas (@DynLibErrPath [0]) + ' - ' + Result;
-     OSErrorWatch (RC);
-    end;
-  end;
-end;
-
-function GetLoadErrorStr: string;
-begin
- GetLoadErrorStr := GetDynLibsErrorStr;
-end;
-{$endif}

+ 43 - 0
rtl/os2/sysos.inc

@@ -81,6 +81,9 @@ function DosLoadModule (ObjName: PChar; ObjLen: cardinal; DLLName: PChar;
                                          var Handle: THandle): cardinal; cdecl;
 external 'DOSCALLS' index 318;
 
+function DosFreeModule (Handle: THandle): cardinal; cdecl;
+external 'DOSCALLS' index 322;
+
 function DosQueryModuleHandle (DLLName: PChar; var Handle: THandle): cardinal;
                                                                          cdecl;
 external 'DOSCALLS' index 319;
@@ -486,3 +489,43 @@ const
 function DosQueryCtryInfo (Size: cardinal; var Country: TCountryCode;
              var Res: TCountryInfo; var ActualSize: cardinal): cardinal; cdecl;
 external 'NLS' index 5;
+
+type
+ PInsertTable = ^TInsertTable;
+ TInsertTable = array [1..9] of PChar;
+
+function DosTrueGetMessage (MsgSeg: pointer; Table: PInsertTable;
+                            TableSize: cardinal; Buf: PChar;
+                            BufSize, MsgNumber: cardinal; FileName: PChar;
+                            var MsgSize: cardinal): cardinal; cdecl;
+external 'MSG' index 6;
+
+procedure MagicHeaderEnd; assembler; forward;
+
+{$ASMMODE INTEL}
+
+{start of _MSGSEG32 segment}
+procedure MagicHeaderStart; assembler;
+asm
+  db $0FF
+  db $4D,$53,$47,$53,$45,$47,$33,$32, 0       //'MSGSEG32'
+  dd $8001
+  dd MagicHeaderEnd
+end;
+
+function DosGetMessage (Table: PInsertTable; TableSize: cardinal; Buf: PChar;
+                        BufSize, MsgNumber: cardinal; FileName: PChar;
+                        var MsgSize: cardinal): cardinal; cdecl; assembler;
+                                                                  nostackframe;
+asm
+  pop eax
+  push offset MagicHeaderStart
+  push eax
+  jmp DosTrueGetMessage
+end;
+
+procedure MagicHeaderEnd; assembler;
+asm
+  dd $0FFFF0000
+end;
+{$ASMMODE DEFAULT}

+ 1 - 0
rtl/os2/system.pas

@@ -29,6 +29,7 @@ interface
 {$DEFINE OS2EXCEPTIONS}
 {$DEFINE OS2UNICODE}
 {$define DISABLE_NO_THREAD_MANAGER}
+{$define DISABLE_NO_DYNLIBS_MANAGER}
 {$DEFINE HAS_GETCPUCOUNT}
 {$define FPC_SYSTEM_HAS_SYSDLH}