system.pp 5.3 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218
  1. {
  2. This file is part of the Free Pascal run time library.
  3. Copyright (c) 2009 by Sven Barth
  4. FPC Pascal system unit for the WinNT API.
  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 System;
  12. interface
  13. {$ifdef SYSTEMDEBUG}
  14. {$define SYSTEMEXCEPTIONDEBUG}
  15. {$endif SYSTEMDEBUG}
  16. {.$define FPC_HAS_INDIRECT_MAIN_INFORMATION}
  17. {$ifdef cpui386}
  18. {$define Set_i386_Exception_handler}
  19. {$endif cpui386}
  20. {.$define DISABLE_NO_THREAD_MANAGER}
  21. {$ifdef KMODE}
  22. {$define HAS_MEMORYMANAGER}
  23. {$endif KMODE}
  24. { include system-independent routine headers }
  25. {$I systemh.inc}
  26. var
  27. CurrentPeb: Pointer;
  28. IsDeviceDriver: Boolean = False;
  29. const
  30. LineEnding = #13#10;
  31. LFNSupport = true;
  32. DirectorySeparator = '\';
  33. DriveSeparator = '\';
  34. ExtensionSeparator = '.';
  35. PathSeparator = ';';
  36. AllowDirectorySeparators : set of char = ['\'];
  37. AllowDriveSeparators : set of char = [];
  38. { FileNameCaseSensitive is defined separately below!!! }
  39. maxExitCode = High(LongInt);
  40. MaxPathLen = High(Word);
  41. AllFilesMask = '*';
  42. type
  43. PEXCEPTION_FRAME = ^TEXCEPTION_FRAME;
  44. TEXCEPTION_FRAME = record
  45. next : PEXCEPTION_FRAME;
  46. handler : pointer;
  47. end;
  48. {$ifndef kmode}
  49. type
  50. TDLL_Entry_Hook = procedure (dllparam : longint);
  51. const
  52. Dll_Process_Detach_Hook : TDLL_Entry_Hook = nil;
  53. Dll_Thread_Attach_Hook : TDLL_Entry_Hook = nil;
  54. Dll_Thread_Detach_Hook : TDLL_Entry_Hook = nil;
  55. {$endif}
  56. const
  57. // NT is case sensitive
  58. FileNameCaseSensitive : boolean = true;
  59. // todo: check whether this is really the case on NT
  60. CtrlZMarksEOF: boolean = true; (* #26 is considered as end of file *)
  61. sLineBreak = LineEnding;
  62. { Thread count for DLL }
  63. Thread_count : longint = 0;
  64. System_exception_frame : PEXCEPTION_FRAME =nil;
  65. implementation
  66. { include system independent routines }
  67. {$I system.inc}
  68. procedure KeQueryTickCount(TickCount: PLargeInteger); stdcall; external ntdll name 'KeQueryTickCount';
  69. procedure randomize;
  70. var
  71. tc: PLargeInteger;
  72. begin
  73. FillChar(tc, SizeOf(TLargeInteger), 0);
  74. KeQueryTickCount(@tc);
  75. // the lower part should differ most on system startup
  76. randseed := tc^.LowPart;
  77. end;
  78. {*****************************************************************************
  79. System Dependent Exit code
  80. *****************************************************************************}
  81. procedure PascalMain;stdcall;external name 'PASCALMAIN';
  82. {$ifndef KMODE}
  83. function NtTerminateProcess(aProcess: THandle; aStatus: NTSTATUS): NTSTATUS; stdcall; external ntdll name 'NtTerminateProcess';
  84. {$endif KMODE}
  85. Procedure system_exit;
  86. begin
  87. if IsLibrary or IsDeviceDriver then
  88. Exit;
  89. {$ifndef KMODE}
  90. NtTerminateProcess(THandle(-1), ExitCode);
  91. {$endif KMODE}
  92. end;
  93. {$ifdef kmode}
  94. function FPCDriverStartup(aDriverObject: Pointer; aRegistryPath: Pointer): NTSTATUS; [public, alias: 'FPC_DriverStartup'];
  95. begin
  96. IsDeviceDriver := True;
  97. IsConsole := True;
  98. IsLibrary := True;
  99. SysDriverObject := aDriverObject;
  100. SysRegistryPath := aRegistryPath;
  101. PASCALMAIN;
  102. SysDriverObject := Nil;
  103. SysRegistryPath := Nil;
  104. Result := ExitCode;
  105. end;
  106. {$else}
  107. const
  108. DLL_PROCESS_ATTACH = 1;
  109. DLL_THREAD_ATTACH = 2;
  110. DLL_PROCESS_DETACH = 0;
  111. DLL_THREAD_DETACH = 3;
  112. function FPCDLLEntry(aHInstance: Pointer; aDLLReason: LongInt; aDLLParam: LongInt): LongBool; [public, alias: 'FPC_DLLEntry'];
  113. begin
  114. IsLibrary := True;
  115. FPCDLLEntry := True;
  116. case aDLLReason of
  117. DLL_PROCESS_ATTACH: begin
  118. PascalMain;
  119. FPCDLLEntry := ExitCode = 0;
  120. end;
  121. DLL_THREAD_ATTACH: begin
  122. if Dll_Thread_Attach_Hook <> Nil then
  123. Dll_Thread_Attach_Hook(aDllParam);
  124. end;
  125. DLL_THREAD_DETACH: begin
  126. if Dll_Thread_Detach_Hook <> Nil then
  127. Dll_Thread_Detach_Hook(aDllParam);
  128. end;
  129. DLL_PROCESS_DETACH: begin
  130. if Dll_Process_Detach_Hook <> Nil then
  131. Dll_Process_Detach_Hook(aDllParam);
  132. // finalize units
  133. do_exit;
  134. end;
  135. end;
  136. end;
  137. procedure FPCProcessStartup(aArgument: Pointer);[public, alias: 'FPC_ProcessStartup'];
  138. begin
  139. IsConsole := True;
  140. IsLibrary := False;
  141. CurrentPeb := aArgument;
  142. PASCALMAIN;
  143. system_exit;
  144. end;
  145. {$endif}
  146. {$ifdef kmode}
  147. // Kernel Mode Entry Point
  148. function NtDriverEntry( aDriverObject: Pointer; aRegistryPath: Pointer ): LongInt; stdcall; [public, alias: '_NtDriverEntry'];
  149. begin
  150. NtDriverEntry := FPCDriverStartup(aDriverObject, aRegistryPath);
  151. end;
  152. {$else}
  153. // User Mode Entry Points
  154. procedure NtProcessStartup( aArgument: Pointer ); stdcall; [public, alias: '_NtProcessStartup'];
  155. begin
  156. FPCProcessStartup(aArgument);
  157. end;
  158. function DLLMainStartup( aHInstance: Pointer; aDLLReason, aDLLParam: LongInt ): LongBool; stdcall; [public, alias: '_DLLMainStartup'];
  159. begin
  160. DLLMainStartup := FPCDLLEntry(aHInstance, aDLLReason, aDLLParam);
  161. end;
  162. {$endif}
  163. begin
  164. {$if not defined(KMODE) and not defined(HAS_MEMORYMANAGER)}
  165. { Setup heap }
  166. InitHeap;
  167. {$endif ndef KMODE and ndef HAS_MEMORYMANAGER}
  168. SysInitExceptions;
  169. initvariantmanager;
  170. { we do not use winlike widestrings and also the RTL can't be compiled with
  171. 2.2, so we can savely use the UnicodeString manager only. }
  172. initunicodestringmanager;
  173. end.