threadvr.inc 3.5 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124
  1. {
  2. This file is part of the Free Pascal run time library.
  3. Copyright (c) 1999-2000 by Michael Van Canneyt
  4. member of the Free Pascal development team
  5. Threadvar support, platform independent part
  6. See the file COPYING.FPC, included in this distribution,
  7. for details about the copyright.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  11. **********************************************************************}
  12. {*****************************************************************************
  13. Threadvar support
  14. *****************************************************************************}
  15. type
  16. pltvInitEntry = ^ltvInitEntry;
  17. ppltvInitEntry = ^pltvInitEntry;
  18. ltvInitEntry = packed record
  19. varaddr : {$ifdef cpu16}pword{$else}pdword{$endif};
  20. size : longint;
  21. end;
  22. TltvInitTablesTable = packed record
  23. count : dword;
  24. tables : packed array [1..{$ifdef cpu16}16{$else}32767{$endif}] of {$ifdef ver3_0}pltvInitEntry{$else}ppltvInitEntry{$endif};
  25. end;
  26. PltvInitTablesTable = ^TltvInitTablesTable;
  27. {$ifndef FPC_HAS_INDIRECT_ENTRY_INFORMATION}
  28. var
  29. ThreadvarTablesTable : TltvInitTablesTable; external name 'FPC_THREADVARTABLES';
  30. {$endif FPC_HAS_INDIRECT_ENTRY_INFORMATION}
  31. procedure init_unit_threadvars (tableEntry : pltvInitEntry);
  32. begin
  33. while tableEntry^.varaddr <> nil do
  34. begin
  35. CurrentTM.InitThreadvar (tableEntry^.varaddr^, tableEntry^.size);
  36. inc (pchar (tableEntry), sizeof (tableEntry^));
  37. end;
  38. end;
  39. procedure init_all_unit_threadvars;
  40. var
  41. i : longint;
  42. begin
  43. {$ifdef FPC_HAS_INDIRECT_ENTRY_INFORMATION}
  44. with PltvInitTablesTable(EntryInformation.ThreadvarTablesTable)^ do
  45. {$else FPC_HAS_INDIRECT_ENTRY_INFORMATION}
  46. with ThreadvarTablesTable do
  47. {$endif FPC_HAS_INDIRECT_ENTRY_INFORMATION}
  48. begin
  49. {$ifdef DEBUG_MT}
  50. WriteLn ('init_all_unit_threadvars (',count,') units');
  51. {$endif}
  52. for i := 1 to count do
  53. init_unit_threadvars (tables[i]{$ifndef ver3_0}^{$endif});
  54. end;
  55. end;
  56. procedure copy_unit_threadvars (tableEntry : pltvInitEntry);
  57. var
  58. oldp,
  59. newp : pointer;
  60. begin
  61. while tableEntry^.varaddr <> nil do
  62. begin
  63. newp:=CurrentTM.RelocateThreadVar(tableEntry^.varaddr^);
  64. oldp:=pointer(pchar(tableEntry^.varaddr)+sizeof(pointer));
  65. move(oldp^,newp^,tableEntry^.size);
  66. inc (pchar (tableEntry), sizeof (tableEntry^));
  67. end;
  68. end;
  69. procedure copy_all_unit_threadvars;
  70. var
  71. i: longint;
  72. begin
  73. {$ifdef FPC_HAS_INDIRECT_ENTRY_INFORMATION}
  74. with PltvInitTablesTable(EntryInformation.ThreadvarTablesTable)^ do
  75. {$else FPC_HAS_INDIRECT_ENTRY_INFORMATION}
  76. with ThreadvarTablesTable do
  77. {$endif FPC_HAS_INDIRECT_ENTRY_INFORMATION}
  78. begin
  79. {$ifdef DEBUG_MT}
  80. WriteLn ('copy_all_unit_threadvars (',count,') units');
  81. {$endif}
  82. for i := 1 to count do
  83. copy_unit_threadvars (tables[i]{$ifndef ver3_0}^{$endif});
  84. end;
  85. end;
  86. procedure InitThreadVars(RelocProc : TRelocateThreadVarHandler);
  87. begin
  88. { initialize threadvars }
  89. init_all_unit_threadvars;
  90. { allocate mem for main thread threadvars }
  91. CurrentTM.AllocateThreadVars;
  92. { copy main thread threadvars }
  93. copy_all_unit_threadvars;
  94. { install threadvar handler }
  95. fpc_threadvar_relocate_proc:=RelocProc;
  96. {$ifdef FPC_HAS_FEATURE_HEAP}
  97. {$ifndef HAS_MEMORYMANAGER}
  98. {$ifndef FPC_NO_DEFAULT_HEAP}
  99. RelocateHeap;
  100. {$endif ndef FPC_NO_DEFAULT_HEAP}
  101. {$endif HAS_MEMORYMANAGER}
  102. {$endif}
  103. end;