system.pp 18 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655
  1. {
  2. This file is part of the Free Pascal run time library.
  3. Copyright (c) 1999-2005 by Florian Klaempfl and Pavel Ozerski
  4. member of the Free Pascal development team.
  5. FPC Pascal system unit for the Win32 API.
  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. unit System;
  13. interface
  14. {$define FPC_IS_SYSTEM}
  15. {$ifdef SYSTEMDEBUG}
  16. {$define SYSTEMEXCEPTIONDEBUG}
  17. {$endif SYSTEMDEBUG}
  18. {$ifdef VER3_0}
  19. { 3.1.1+ do not require this anymore }
  20. {$define FPC_HAS_INDIRECT_ENTRY_INFORMATION}
  21. {$endif VER3_0}
  22. {$ifdef cpui386}
  23. {$define Set_i386_Exception_handler}
  24. {$endif cpui386}
  25. {$define DISABLE_NO_THREAD_MANAGER}
  26. {$define HAS_WIDESTRINGMANAGER}
  27. {$define DISABLE_NO_DYNLIBS_MANAGER}
  28. {$define FPC_SYSTEM_HAS_SYSDLH}
  29. {$define FPC_HAS_SETCTRLBREAKHANDLER}
  30. {$ifdef FPC_USE_WIN32_SEH}
  31. {$define FPC_SYSTEM_HAS_RAISEEXCEPTION}
  32. {$define FPC_SYSTEM_HAS_RERAISE}
  33. {$define FPC_SYSTEM_HAS_DONEEXCEPTION}
  34. {$define FPC_SYSTEM_HAS_SAFECALLHANDLER}
  35. {$endif FPC_USE_WIN32_SEH}
  36. { include system-independent routine headers }
  37. {$I systemh.inc}
  38. { include common windows headers }
  39. {$I syswinh.inc}
  40. var
  41. MainInstance : longint;
  42. implementation
  43. var
  44. FPCSysInstance : PLongint;public name '_FPC_SysInstance';
  45. {$define FPC_SYSTEM_HAS_OSSETUPENTRYINFORMATION}
  46. procedure OsSetupEntryInformation(constref info: TEntryInformation); forward;
  47. {$ifdef FPC_USE_WIN32_SEH}
  48. function main_wrapper(arg: Pointer; proc: Pointer): ptrint; forward;
  49. procedure OutermostHandler; external name '__FPC_DEFAULT_HANDLER';
  50. {$endif FPC_USE_WIN32_SEH}
  51. {$define FPC_SYSTEM_HAS_STACKTOP}
  52. function StackTop: pointer; assembler;nostackframe;
  53. asm
  54. movl %fs:(4),%eax
  55. end;
  56. { include system independent routines }
  57. {$I system.inc}
  58. { include code common with win64 }
  59. {$I syswin.inc}
  60. procedure OsSetupEntryInformation(constref info: TEntryInformation);
  61. begin
  62. TlsKey := info.OS.TlsKeyAddr;
  63. FPCSysInstance := info.OS.SysInstance;
  64. WStrInitTablesTable := info.OS.WideInitTables;
  65. end;
  66. {*****************************************************************************
  67. System Dependent Exit code
  68. *****************************************************************************}
  69. {$ifndef FPC_USE_WIN32_SEH}
  70. procedure install_exception_handlers;forward;
  71. procedure remove_exception_handlers;forward;
  72. {$endif FPC_USE_WIN32_SEH}
  73. Procedure system_exit;
  74. begin
  75. if IsLibrary then
  76. begin
  77. { If exiting from DLL_PROCESS_ATTACH/DETACH, unwind to DllMain context. }
  78. if DllInitState in [DLL_PROCESS_ATTACH,DLL_PROCESS_DETACH] then
  79. LongJmp(DLLBuf,1)
  80. else
  81. { Abnormal termination, Halt has been called from DLL function,
  82. put down the entire process (DLL_PROCESS_DETACH will still
  83. occur). At this point RTL has been already finalized in InternalExit
  84. and shouldn't be finalized another time in DLL_PROCESS_DETACH.
  85. Indicate this by resetting MainThreadIdWin32. }
  86. MainThreadIDWin32:=0;
  87. end;
  88. if not IsConsole then
  89. begin
  90. Close(stderr);
  91. Close(stdout);
  92. Close(erroutput);
  93. Close(Input);
  94. Close(Output);
  95. { what about Input and Output ?? PM }
  96. { now handled, FPK }
  97. end;
  98. if Ole32Dll <> 0 then
  99. begin
  100. WinFreeLibrary(Ole32Dll); { Careful, FreeLibrary should not be called from DllMain. }
  101. Ole32Dll := 0;
  102. end;
  103. if OleAut32Dll <> 0 then
  104. begin
  105. WinFreeLibrary(OleAut32Dll);
  106. OleAut32Dll := 0;
  107. end;
  108. {$ifndef FPC_USE_WIN32_SEH}
  109. if not IsLibrary then
  110. remove_exception_handlers;
  111. {$endif FPC_USE_WIN32_SEH}
  112. { do cleanup required by the startup code }
  113. EntryInformation.OS.asm_exit();
  114. { call exitprocess, with cleanup as required }
  115. ExitProcess(exitcode);
  116. end;
  117. var
  118. { value of the stack segment
  119. to check if the call stack can be written on exceptions }
  120. _SS : Cardinal;
  121. procedure Exe_entry(constref info : TEntryInformation);[public,alias:'_FPC_EXE_Entry'];
  122. var
  123. xframe: TEXCEPTION_FRAME;
  124. begin
  125. SetupEntryInformation(info);
  126. IsLibrary:=false;
  127. { install the handlers for exe only ?
  128. or should we install them for DLL also ? (PM) }
  129. {$ifndef FPC_USE_WIN32_SEH}
  130. install_exception_handlers;
  131. {$endif FPC_USE_WIN32_SEH}
  132. { This strange construction is needed to solve the _SS problem
  133. with a smartlinked syswin32 (PFV) }
  134. asm
  135. { movl %esp,%fs:(0)
  136. but don't insert it as it doesn't
  137. point to anything yet
  138. this will be used in signals unit }
  139. leal xframe,%eax
  140. movl %fs:(0),%ecx
  141. movl %ecx,TException_Frame.next(%eax)
  142. movl %eax,System_exception_frame
  143. {$ifndef FPC_USE_WIN32_SEH}
  144. movl $0,TException_Frame.handler(%eax)
  145. {$else}
  146. movl $OutermostHandler,TException_Frame.handler(%eax)
  147. movl %eax,%fs:(0)
  148. {$endif FPC_USE_WIN32_SEH}
  149. pushl %ebp
  150. xorl %eax,%eax
  151. movw %ss,%ax
  152. movl %eax,_SS
  153. xorl %ebp,%ebp
  154. end;
  155. EntryInformation.PascalMain();
  156. asm
  157. popl %ebp
  158. end;
  159. { if we pass here there was no error ! }
  160. system_exit;
  161. end;
  162. function is_prefetch(p : pointer) : boolean;
  163. var
  164. a : array[0..15] of byte;
  165. doagain : boolean;
  166. instrlo,instrhi,opcode : byte;
  167. i : longint;
  168. begin
  169. result:=false;
  170. { read memory savely without causing another exeception }
  171. if not(ReadProcessMemory(GetCurrentProcess,p,@a,sizeof(a),nil)) then
  172. exit;
  173. i:=0;
  174. doagain:=true;
  175. while doagain and (i<15) do
  176. begin
  177. opcode:=a[i];
  178. instrlo:=opcode and $f;
  179. instrhi:=opcode and $f0;
  180. case instrhi of
  181. { prefix? }
  182. $20,$30:
  183. doagain:=(instrlo and 7)=6;
  184. $60:
  185. doagain:=(instrlo and $c)=4;
  186. $f0:
  187. doagain:=instrlo in [0,2,3];
  188. $0:
  189. begin
  190. result:=(instrlo=$f) and (a[i+1] in [$d,$18]);
  191. exit;
  192. end;
  193. else
  194. doagain:=false;
  195. end;
  196. inc(i);
  197. end;
  198. end;
  199. //
  200. // Hardware exception handling
  201. //
  202. {$ifdef Set_i386_Exception_handler}
  203. type
  204. PFloatingSaveArea = ^TFloatingSaveArea;
  205. TFloatingSaveArea = packed record
  206. ControlWord : Cardinal;
  207. StatusWord : Cardinal;
  208. TagWord : Cardinal;
  209. ErrorOffset : Cardinal;
  210. ErrorSelector : Cardinal;
  211. DataOffset : Cardinal;
  212. DataSelector : Cardinal;
  213. RegisterArea : array[0..79] of Byte;
  214. Cr0NpxState : Cardinal;
  215. end;
  216. PContext = ^TContext;
  217. TContext = packed record
  218. //
  219. // The flags values within this flag control the contents of
  220. // a CONTEXT record.
  221. //
  222. ContextFlags : Cardinal;
  223. //
  224. // This section is specified/returned if CONTEXT_DEBUG_REGISTERS is
  225. // set in ContextFlags. Note that CONTEXT_DEBUG_REGISTERS is NOT
  226. // included in CONTEXT_FULL.
  227. //
  228. Dr0, Dr1, Dr2,
  229. Dr3, Dr6, Dr7 : Cardinal;
  230. //
  231. // This section is specified/returned if the
  232. // ContextFlags word contains the flag CONTEXT_FLOATING_POINT.
  233. //
  234. FloatSave : TFloatingSaveArea;
  235. //
  236. // This section is specified/returned if the
  237. // ContextFlags word contains the flag CONTEXT_SEGMENTS.
  238. //
  239. SegGs, SegFs,
  240. SegEs, SegDs : Cardinal;
  241. //
  242. // This section is specified/returned if the
  243. // ContextFlags word contains the flag CONTEXT_INTEGER.
  244. //
  245. Edi, Esi, Ebx,
  246. Edx, Ecx, Eax : Cardinal;
  247. //
  248. // This section is specified/returned if the
  249. // ContextFlags word contains the flag CONTEXT_CONTROL.
  250. //
  251. Ebp : Cardinal;
  252. Eip : Cardinal;
  253. SegCs : Cardinal;
  254. EFlags, Esp, SegSs : Cardinal;
  255. //
  256. // This section is specified/returned if the ContextFlags word
  257. // contains the flag CONTEXT_EXTENDED_REGISTERS.
  258. // The format and contexts are processor specific
  259. //
  260. ExtendedRegisters : array[0..MAXIMUM_SUPPORTED_EXTENSION-1] of Byte;
  261. end;
  262. PExceptionPointers = ^TExceptionPointers;
  263. TExceptionPointers = packed record
  264. ExceptionRecord : PExceptionRecord;
  265. ContextRecord : PContext;
  266. end;
  267. { type of functions that should be used for exception handling }
  268. TTopLevelExceptionFilter = function (excep : PExceptionPointers) : Longint;stdcall;
  269. {$i seh32.inc}
  270. {$ifndef FPC_USE_WIN32_SEH}
  271. function SetUnhandledExceptionFilter(lpTopLevelExceptionFilter : TTopLevelExceptionFilter) : TTopLevelExceptionFilter;
  272. stdcall;external 'kernel32' name 'SetUnhandledExceptionFilter';
  273. const
  274. MaxExceptionLevel = 16;
  275. exceptLevel : Byte = 0;
  276. var
  277. exceptEip : array[0..MaxExceptionLevel-1] of Longint;
  278. exceptError : array[0..MaxExceptionLevel-1] of Byte;
  279. resetFPU : array[0..MaxExceptionLevel-1] of Boolean;
  280. {$ifdef SYSTEMEXCEPTIONDEBUG}
  281. procedure DebugHandleErrorAddrFrame(error : longint; addr, frame : pointer);
  282. begin
  283. if IsConsole then
  284. begin
  285. write(stderr,'HandleErrorAddrFrame(error=',error);
  286. write(stderr,',addr=',hexstr(ptruint(addr),8));
  287. writeln(stderr,',frame=',hexstr(ptruint(frame),8),')');
  288. end;
  289. HandleErrorAddrFrame(error,addr,frame);
  290. end;
  291. {$endif SYSTEMEXCEPTIONDEBUG}
  292. procedure JumpToHandleErrorFrame;
  293. var
  294. eip, ebp, error : Longint;
  295. begin
  296. // save ebp
  297. asm
  298. movl (%ebp),%eax
  299. movl %eax,ebp
  300. end;
  301. if (exceptLevel > 0) then
  302. dec(exceptLevel);
  303. eip:=exceptEip[exceptLevel];
  304. error:=exceptError[exceptLevel];
  305. {$ifdef SYSTEMEXCEPTIONDEBUG}
  306. if IsConsole then
  307. writeln(stderr,'In JumpToHandleErrorFrame error=',error);
  308. {$endif SYSTEMEXCEPTIONDEBUG}
  309. if resetFPU[exceptLevel] then
  310. SysResetFPU;
  311. { build a fake stack }
  312. asm
  313. movl ebp,%ecx
  314. movl eip,%edx
  315. movl error,%eax
  316. pushl eip
  317. movl ebp,%ebp // Change frame pointer
  318. {$ifdef SYSTEMEXCEPTIONDEBUG}
  319. jmpl DebugHandleErrorAddrFrame
  320. {$else not SYSTEMEXCEPTIONDEBUG}
  321. jmpl HandleErrorAddrFrame
  322. {$endif SYSTEMEXCEPTIONDEBUG}
  323. end;
  324. end;
  325. function syswin32_i386_exception_handler(excep : PExceptionPointers) : Longint;stdcall;
  326. var
  327. res,ssecode: longint;
  328. err: byte;
  329. must_reset_fpu: boolean;
  330. begin
  331. res := EXCEPTION_CONTINUE_SEARCH;
  332. if excep^.ContextRecord^.SegSs=_SS then begin
  333. err := 0;
  334. must_reset_fpu := true;
  335. {$ifdef SYSTEMEXCEPTIONDEBUG}
  336. if IsConsole then Writeln(stderr,'Exception ',
  337. hexstr(excep^.ExceptionRecord^.ExceptionCode, 8));
  338. {$endif SYSTEMEXCEPTIONDEBUG}
  339. case excep^.ExceptionRecord^.ExceptionCode of
  340. STATUS_INTEGER_DIVIDE_BY_ZERO :
  341. err := 200;
  342. STATUS_FLOAT_DIVIDE_BY_ZERO :
  343. err := 208;
  344. STATUS_ARRAY_BOUNDS_EXCEEDED :
  345. begin
  346. err := 201;
  347. must_reset_fpu := false;
  348. end;
  349. STATUS_STACK_OVERFLOW :
  350. begin
  351. err := 202;
  352. must_reset_fpu := false;
  353. end;
  354. STATUS_FLOAT_OVERFLOW :
  355. err := 205;
  356. STATUS_FLOAT_DENORMAL_OPERAND,
  357. STATUS_FLOAT_UNDERFLOW :
  358. err := 206;
  359. {excep^.ContextRecord^.FloatSave.StatusWord := excep^.ContextRecord^.FloatSave.StatusWord and $ffffff00;}
  360. STATUS_FLOAT_INEXACT_RESULT,
  361. STATUS_FLOAT_INVALID_OPERATION,
  362. STATUS_FLOAT_STACK_CHECK :
  363. err := 207;
  364. STATUS_INTEGER_OVERFLOW :
  365. begin
  366. err := 215;
  367. must_reset_fpu := false;
  368. end;
  369. STATUS_ILLEGAL_INSTRUCTION:
  370. { if we're testing sse support, simply set the flag and continue }
  371. if sse_check then
  372. begin
  373. os_supports_sse:=false;
  374. { skip the offending movaps %xmm7, %xmm6 instruction }
  375. inc(excep^.ContextRecord^.Eip,3);
  376. excep^.ExceptionRecord^.ExceptionCode := 0;
  377. res:=EXCEPTION_CONTINUE_EXECUTION;
  378. end
  379. else
  380. err := 216;
  381. STATUS_ACCESS_VIOLATION:
  382. { Athlon prefetch bug? }
  383. if is_prefetch(pointer(excep^.ContextRecord^.Eip)) then
  384. begin
  385. { if yes, then retry }
  386. excep^.ExceptionRecord^.ExceptionCode := 0;
  387. res:=EXCEPTION_CONTINUE_EXECUTION;
  388. end
  389. else
  390. err := 216;
  391. STATUS_CONTROL_C_EXIT:
  392. err := 217;
  393. STATUS_PRIVILEGED_INSTRUCTION:
  394. begin
  395. err := 218;
  396. must_reset_fpu := false;
  397. end;
  398. STATUS_FLOAT_MULTIPLE_FAULTS,
  399. STATUS_FLOAT_MULTIPLE_TRAPS:
  400. begin
  401. { dumping ExtendedRegisters and comparing with the actually value of mxcsr revealed 24 }
  402. TranslateMxcsr(excep^.ContextRecord^.ExtendedRegisters[24],ssecode);
  403. {$ifdef SYSTEMEXCEPTIONDEBUG}
  404. if IsConsole then
  405. Writeln(stderr,'MXSR: ',hexstr(excep^.ContextRecord^.ExtendedRegisters[24], 2),' SSECODE: ',ssecode);
  406. {$endif SYSTEMEXCEPTIONDEBUG}
  407. err:=-ssecode;
  408. end;
  409. else
  410. begin
  411. if ((excep^.ExceptionRecord^.ExceptionCode and SEVERITY_ERROR) = SEVERITY_ERROR) then
  412. err := 217
  413. else
  414. err := 255;
  415. end;
  416. end;
  417. if (err <> 0) and (exceptLevel < MaxExceptionLevel) then begin
  418. exceptEip[exceptLevel] := excep^.ContextRecord^.Eip;
  419. exceptError[exceptLevel] := err;
  420. resetFPU[exceptLevel] := must_reset_fpu;
  421. inc(exceptLevel);
  422. excep^.ContextRecord^.Eip := Longint(@JumpToHandleErrorFrame);
  423. excep^.ExceptionRecord^.ExceptionCode := 0;
  424. res := EXCEPTION_CONTINUE_EXECUTION;
  425. {$ifdef SYSTEMEXCEPTIONDEBUG}
  426. if IsConsole then begin
  427. writeln(stderr,'Exception Continue Exception set at ',
  428. hexstr(exceptEip[exceptLevel],8));
  429. writeln(stderr,'Eip changed to ',
  430. hexstr(longint(@JumpToHandleErrorFrame),8), ' error=', err);
  431. end;
  432. {$endif SYSTEMEXCEPTIONDEBUG}
  433. end;
  434. end;
  435. syswin32_i386_exception_handler := res;
  436. end;
  437. procedure install_exception_handlers;
  438. begin
  439. SetUnhandledExceptionFilter(@syswin32_i386_exception_handler);
  440. end;
  441. procedure remove_exception_handlers;
  442. begin
  443. SetUnhandledExceptionFilter(nil);
  444. end;
  445. {$endif not FPC_USE_WIN32_SEH}
  446. {$else not cpui386 (Processor specific !!)}
  447. procedure install_exception_handlers;
  448. begin
  449. end;
  450. procedure remove_exception_handlers;
  451. begin
  452. end;
  453. {$endif Set_i386_Exception_handler}
  454. {$ifdef FPC_SECTION_THREADVARS}
  455. function fpc_tls_add(addr: pointer): pointer; assembler; nostackframe;
  456. [public,alias: 'FPC_TLS_ADD']; compilerproc;
  457. asm
  458. sub $tls_data_start,%eax
  459. cmpb $0,IsLibrary
  460. mov _tls_index,%ecx
  461. jnz .L1
  462. mov %fs:(0x2c),%edx
  463. add (%edx,%ecx,4),%eax
  464. ret
  465. .L1:
  466. push %ebx
  467. mov %eax,%ebx
  468. call GetLastError
  469. push %eax { save LastError }
  470. push _tls_index
  471. call TlsGetValue
  472. test %eax,%eax
  473. jnz .L2
  474. { This can happen when a thread existed before DLL was loaded,
  475. or if DisableThreadLibraryCalls was called. }
  476. call SysAllocateThreadVars
  477. mov $0x1000000,%eax
  478. call InitThread
  479. push _tls_index
  480. call TlsGetValue
  481. .L2:
  482. add %eax,%ebx
  483. call SetLastError { restore (value is on stack) }
  484. mov %ebx,%eax
  485. pop %ebx
  486. end;
  487. {$endif FPC_SECTION_THREADVARS}
  488. function CheckInitialStkLen(stklen : SizeUInt) : SizeUInt;
  489. type
  490. tdosheader = packed record
  491. e_magic : word;
  492. e_cblp : word;
  493. e_cp : word;
  494. e_crlc : word;
  495. e_cparhdr : word;
  496. e_minalloc : word;
  497. e_maxalloc : word;
  498. e_ss : word;
  499. e_sp : word;
  500. e_csum : word;
  501. e_ip : word;
  502. e_cs : word;
  503. e_lfarlc : word;
  504. e_ovno : word;
  505. e_res : array[0..3] of word;
  506. e_oemid : word;
  507. e_oeminfo : word;
  508. e_res2 : array[0..9] of word;
  509. e_lfanew : longint;
  510. end;
  511. tpeheader = packed record
  512. PEMagic : longint;
  513. Machine : word;
  514. NumberOfSections : word;
  515. TimeDateStamp : longint;
  516. PointerToSymbolTable : longint;
  517. NumberOfSymbols : longint;
  518. SizeOfOptionalHeader : word;
  519. Characteristics : word;
  520. Magic : word;
  521. MajorLinkerVersion : byte;
  522. MinorLinkerVersion : byte;
  523. SizeOfCode : longint;
  524. SizeOfInitializedData : longint;
  525. SizeOfUninitializedData : longint;
  526. AddressOfEntryPoint : longint;
  527. BaseOfCode : longint;
  528. BaseOfData : longint;
  529. ImageBase : longint;
  530. SectionAlignment : longint;
  531. FileAlignment : longint;
  532. MajorOperatingSystemVersion : word;
  533. MinorOperatingSystemVersion : word;
  534. MajorImageVersion : word;
  535. MinorImageVersion : word;
  536. MajorSubsystemVersion : word;
  537. MinorSubsystemVersion : word;
  538. Reserved1 : longint;
  539. SizeOfImage : longint;
  540. SizeOfHeaders : longint;
  541. CheckSum : longint;
  542. Subsystem : word;
  543. DllCharacteristics : word;
  544. SizeOfStackReserve : longint;
  545. SizeOfStackCommit : longint;
  546. SizeOfHeapReserve : longint;
  547. SizeOfHeapCommit : longint;
  548. LoaderFlags : longint;
  549. NumberOfRvaAndSizes : longint;
  550. DataDirectory : array[1..$80] of byte;
  551. end;
  552. begin
  553. result:=tpeheader((pointer(getmodulehandle(nil))+(tdosheader(pointer(getmodulehandle(nil))^).e_lfanew))^).SizeOfStackReserve;
  554. end;
  555. initialization
  556. { get some helpful informations }
  557. GetStartupInfo(@startupinfo);
  558. { some misc Win32 stuff }
  559. if not IsLibrary then
  560. FPCSysInstance^:=getmodulehandle(nil);
  561. MainInstance:=FPCSysInstance^;
  562. { pass dummy value }
  563. StackLength := CheckInitialStkLen($1000000);
  564. StackBottom := StackTop - StackLength;
  565. CodePointer(SetThreadStackGuarantee) := WinGetProcAddress(WinGetModuleHandleW(KernelDLL), 'SetThreadStackGuarantee');
  566. if Assigned(SetThreadStackGuarantee) then
  567. SetThreadStackGuarantee(@StackMargin);
  568. cmdshow:=startupinfo.wshowwindow;
  569. { Setup heap and threading, these may be already initialized from TLS callback }
  570. if not Assigned(CurrentTM.BeginThread) then
  571. begin
  572. InitHeap;
  573. InitSystemThreads;
  574. end;
  575. SysInitExceptions;
  576. { setup fastmove stuff }
  577. fpc_cpucodeinit;
  578. initunicodestringmanager;
  579. InitWin32Widestrings;
  580. SysInitStdIO;
  581. { Arguments }
  582. setup_arguments;
  583. InitSystemDynLibs;
  584. { Reset IO Error }
  585. InOutRes:=0;
  586. ProcessID := GetCurrentProcessID;
  587. DispCallByIDProc:=@DoDispCallByIDError;
  588. finalization
  589. WinFinalizeSystem;
  590. end.