dl.pp 2.9 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107
  1. {
  2. This file is part of the Free Pascal run time library.
  3. Copyright (c) 1999-2008 by the Free Pascal development team
  4. This file implements dyn. lib calls calls for Unix
  5. See the file COPYING.FPC, included in this distribution,
  6. for details about the copyright.
  7. This program is distributed in the hope that it will be useful,
  8. but WITHOUT ANY WARRANTY; without even the implied warranty of
  9. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  10. **********************************************************************}
  11. unit dl;
  12. interface
  13. const
  14. {$ifdef BSD} // dlopen is in libc on FreeBSD.
  15. LibDL = 'c';
  16. {$else}
  17. {$ifdef HAIKU}
  18. LibDL = 'root';
  19. {$else}
  20. LibDL = 'dl';
  21. {$endif}
  22. {$endif}
  23. {$if defined(linux) or defined(freebsd) or defined(openbsd)}
  24. {$define ELF} // ELF symbol versioning.
  25. {$endif}
  26. {$if defined(linux) and defined(cpuarm)}
  27. { arm-linux seems to require this }
  28. {$linklib c}
  29. {$endif}
  30. RTLD_LAZY = $001;
  31. RTLD_NOW = $002;
  32. RTLD_BINDING_MASK = $003;
  33. RTLD_GLOBAL = $100;
  34. RTLD_NEXT = pointer(-1);
  35. {$ifdef LINUX}
  36. RTLD_DEFAULT = nil;
  37. {$endif}
  38. {$ifdef BSD}
  39. RTLD_DEFAULT = pointer(-2);
  40. RTLD_MODEMASK = RTLD_BINDING_MASK;
  41. {$endif}
  42. type
  43. Pdl_info = ^dl_info;
  44. dl_info = record
  45. dli_fname : Pchar;
  46. dli_fbase : pointer;
  47. dli_sname : Pchar;
  48. dli_saddr : pointer;
  49. end;
  50. function dlopen(Name : PChar; Flags : longint) : Pointer; cdecl; external libdl;
  51. function dlsym(Lib : Pointer; Name : Pchar) : Pointer; cdecl; external Libdl;
  52. {$ifdef ELF}
  53. function dlvsym(Lib : Pointer; Name : Pchar; Version: Pchar) : Pointer; cdecl; external Libdl;
  54. {$endif}
  55. function dlclose(Lib : Pointer) : Longint; cdecl; external libdl;
  56. function dlerror() : Pchar; cdecl; external libdl;
  57. { overloaded for compatibility with hmodule }
  58. function dlsym(Lib : PtrInt; Name : Pchar) : Pointer; cdecl; external Libdl;
  59. function dlclose(Lib : PtrInt) : Longint; cdecl; external libdl;
  60. function dladdr(Lib: pointer; info: Pdl_info): Longint; cdecl; external;
  61. implementation
  62. function PosLastSlash(const s : string) : longint;
  63. var
  64. i : longint;
  65. begin
  66. PosLastSlash:=0;
  67. for i:=1 to length(s) do
  68. if s[i]='/' then
  69. PosLastSlash:=i;
  70. end;
  71. function SimpleExtractFilename(const s : string) : string;
  72. begin
  73. SimpleExtractFilename:=Copy(s,PosLastSlash(s)+1,Length(s)-PosLastSlash(s));
  74. end;
  75. procedure UnixGetModuleByAddr(addr: pointer; var baseaddr: pointer; var filename: openstring);
  76. var
  77. dlinfo: dl_info;
  78. begin
  79. baseaddr:=nil;
  80. FillChar(dlinfo, sizeof(dlinfo), 0);
  81. dladdr(addr, @dlinfo);
  82. baseaddr:=dlinfo.dli_fbase;
  83. filename:=String(dlinfo.dli_fname);
  84. if SimpleExtractFilename(filename)=SimpleExtractFilename(ParamStr(0)) then
  85. baseaddr:=nil;
  86. end;
  87. begin
  88. UnixGetModuleByAddrHook:=@UnixGetModuleByAddr;
  89. end.