system.pp 19 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790
  1. {
  2. This file is part of the Free Pascal run time library.
  3. Copyright (c) 1999-2000 by the Free Pascal development team.
  4. Watcom
  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. {$ifndef NO_EXCEPTIONS_IN_SYSTEM}
  14. {$define EXCEPTIONS_IN_SYSTEM}
  15. {$endif NO_EXCEPTIONS_IN_SYSTEM}
  16. { include system-independent routine headers }
  17. {$include systemh.inc}
  18. const
  19. LineEnding = #13#10;
  20. { LFNSupport is a variable here, defined below!!! }
  21. DirectorySeparator = '\';
  22. DriveSeparator = ':';
  23. ExtensionSeparator = '.';
  24. PathSeparator = ';';
  25. AllowDirectorySeparators : set of char = ['\','/'];
  26. AllowDriveSeparators : set of char = [':'];
  27. { FileNameCaseSensitive and FileNameCasePreserving are defined separately below!!! }
  28. maxExitCode = 255;
  29. MaxPathLen = 256;
  30. const
  31. { Default filehandles }
  32. UnusedHandle = -1;
  33. StdInputHandle = 0;
  34. StdOutputHandle = 1;
  35. StdErrorHandle = 2;
  36. FileNameCaseSensitive : boolean = false;
  37. FileNameCasePreserving: boolean = false;
  38. CtrlZMarksEOF: boolean = true; (* #26 is considered as end of file *)
  39. sLineBreak = LineEnding;
  40. DefaultTextLineBreakStyle : TTextLineBreakStyle = tlbsCRLF;
  41. { Default memory segments (Tp7 compatibility) }
  42. seg0040 = $0040;
  43. segA000 = $A000;
  44. segB000 = $B000;
  45. segB800 = $B800;
  46. var
  47. { Mem[] support }
  48. mem : array[0..$7fffffff-1] of byte absolute $0:$0;
  49. memw : array[0..($7fffffff div sizeof(word)) -1] of word absolute $0:$0;
  50. meml : array[0..($7fffffff div sizeof(longint)) -1] of longint absolute $0:$0;
  51. { C-compatible arguments and environment }
  52. argc : longint;
  53. argv : ppchar;
  54. envp : ppchar;
  55. dos_argv0 : pchar;
  56. AllFilesMask: string [3];
  57. {$ifndef RTLLITE}
  58. { System info }
  59. LFNSupport : boolean;
  60. {$ELSE RTLLITE}
  61. Const
  62. LFNSupport = false;
  63. {$endif RTLLITE}
  64. {
  65. necessary for objects.pas, should be removed (at least from the interface
  66. to the implementation)
  67. }
  68. type
  69. trealregs=record
  70. realedi,realesi,realebp,realres,
  71. realebx,realedx,realecx,realeax : longint;
  72. realflags,
  73. reales,realds,realfs,realgs,
  74. realip,realcs,realsp,realss : word;
  75. end;
  76. function do_write(h:longint;addr:pointer;len : longint) : longint;
  77. function do_read(h:longint;addr:pointer;len : longint) : longint;
  78. procedure syscopyfromdos(addr : sizeuint; len : longint);
  79. procedure syscopytodos(addr : sizeuint; len : longint);
  80. procedure sysrealintr(intnr : word;var regs : trealregs);
  81. var tb:longint;
  82. tb_segment:word;
  83. const tb_offset=0;
  84. tb_size=8192;
  85. IMPLEMENTATION
  86. { include system independent routines }
  87. {$include system.inc}
  88. {$asmmode ATT}
  89. var psp_selector:word; external name 'PSP_SELECTOR';
  90. procedure setup_arguments;
  91. type
  92. arrayword = array [0..255] of word;
  93. var
  94. proxy_s : string[50];
  95. proxy_argc,proxy_seg,proxy_ofs,lin : longint;
  96. rm_argv : ^arrayword;
  97. argv0len : longint;
  98. useproxy : boolean;
  99. hp : ppchar;
  100. doscmd : string[129]; { Dos commandline copied from PSP, max is 128 chars +1 for terminating zero }
  101. arglen,
  102. count : longint;
  103. argstart,
  104. pc,arg : pchar;
  105. quote : char;
  106. argvlen : longint;
  107. function atohex(s : pchar) : longint;
  108. var
  109. rv : longint;
  110. v : byte;
  111. begin
  112. rv:=0;
  113. while (s^<>#0) do
  114. begin
  115. v:=byte(s^)-byte('0');
  116. if (v > 9) then
  117. dec(v,7);
  118. v:=v and 15; { in case it's lower case }
  119. rv:=(rv shl 4) or v;
  120. inc(longint(s));
  121. end;
  122. atohex:=rv;
  123. end;
  124. procedure allocarg(idx,len:longint);
  125. var oldargvlen:longint;
  126. begin
  127. if idx>=argvlen then
  128. begin
  129. oldargvlen:=argvlen;
  130. argvlen:=(idx+8) and (not 7);
  131. sysreallocmem(argv,argvlen*sizeof(pointer));
  132. fillchar(argv[oldargvlen],(argvlen-oldargvlen)*sizeof(pointer),0);
  133. argv[idx]:=nil;
  134. end;
  135. ArgV [Idx] := SysAllocMem (Succ (Len));
  136. end;
  137. begin
  138. count:=0;
  139. argc:=1;
  140. argv:=nil;
  141. argvlen:=0;
  142. { load commandline from psp }
  143. sysseg_move(psp_selector, 128, get_ds, longint(@doscmd), 128);
  144. doscmd[length(doscmd)+1]:=#0;
  145. {$IfDef SYSTEM_DEBUG_STARTUP}
  146. Writeln(stderr,'Dos command line is #',doscmd,'# size = ',length(doscmd));
  147. {$EndIf }
  148. { create argv[0] }
  149. argv0len:=strlen(dos_argv0);
  150. allocarg(count,argv0len);
  151. move(dos_argv0^,argv[count]^,argv0len);
  152. inc(count);
  153. { setup cmdline variable }
  154. cmdline:=Getmem(argv0len+length(doscmd)+2);
  155. move(dos_argv0^,cmdline^,argv0len);
  156. cmdline[argv0len]:=' ';
  157. inc(argv0len);
  158. move(doscmd[1],cmdline[argv0len],length(doscmd));
  159. cmdline[argv0len+length(doscmd)+1]:=#0;
  160. { parse dos commandline }
  161. pc:=@doscmd[1];
  162. while pc^<>#0 do
  163. begin
  164. { skip leading spaces }
  165. while pc^ in [#1..#32] do
  166. inc(pc);
  167. if pc^=#0 then
  168. break;
  169. { calc argument length }
  170. quote:=' ';
  171. argstart:=pc;
  172. arglen:=0;
  173. while (pc^<>#0) do
  174. begin
  175. case pc^ of
  176. #1..#32 :
  177. begin
  178. if quote<>' ' then
  179. inc(arglen)
  180. else
  181. break;
  182. end;
  183. '"' :
  184. begin
  185. if quote<>'''' then
  186. begin
  187. if pchar(pc+1)^<>'"' then
  188. begin
  189. if quote='"' then
  190. quote:=' '
  191. else
  192. quote:='"';
  193. end
  194. else
  195. inc(pc);
  196. end
  197. else
  198. inc(arglen);
  199. end;
  200. '''' :
  201. begin
  202. if quote<>'"' then
  203. begin
  204. if pchar(pc+1)^<>'''' then
  205. begin
  206. if quote='''' then
  207. quote:=' '
  208. else
  209. quote:='''';
  210. end
  211. else
  212. inc(pc);
  213. end
  214. else
  215. inc(arglen);
  216. end;
  217. else
  218. inc(arglen);
  219. end;
  220. inc(pc);
  221. end;
  222. { copy argument }
  223. allocarg(count,arglen);
  224. quote:=' ';
  225. pc:=argstart;
  226. arg:=argv[count];
  227. while (pc^<>#0) do
  228. begin
  229. case pc^ of
  230. #1..#32 :
  231. begin
  232. if quote<>' ' then
  233. begin
  234. arg^:=pc^;
  235. inc(arg);
  236. end
  237. else
  238. break;
  239. end;
  240. '"' :
  241. begin
  242. if quote<>'''' then
  243. begin
  244. if pchar(pc+1)^<>'"' then
  245. begin
  246. if quote='"' then
  247. quote:=' '
  248. else
  249. quote:='"';
  250. end
  251. else
  252. inc(pc);
  253. end
  254. else
  255. begin
  256. arg^:=pc^;
  257. inc(arg);
  258. end;
  259. end;
  260. '''' :
  261. begin
  262. if quote<>'"' then
  263. begin
  264. if pchar(pc+1)^<>'''' then
  265. begin
  266. if quote='''' then
  267. quote:=' '
  268. else
  269. quote:='''';
  270. end
  271. else
  272. inc(pc);
  273. end
  274. else
  275. begin
  276. arg^:=pc^;
  277. inc(arg);
  278. end;
  279. end;
  280. else
  281. begin
  282. arg^:=pc^;
  283. inc(arg);
  284. end;
  285. end;
  286. inc(pc);
  287. end;
  288. arg^:=#0;
  289. {$IfDef SYSTEM_DEBUG_STARTUP}
  290. Writeln(stderr,'dos arg ',count,' #',arglen,'#',argv[count],'#');
  291. {$EndIf SYSTEM_DEBUG_STARTUP}
  292. inc(count);
  293. end;
  294. argc:=count;
  295. { check for !proxy for long commandlines passed using environment }
  296. hp:=envp;
  297. useproxy:=false;
  298. while assigned(hp^) do
  299. begin
  300. if (hp^[0]=' ') then
  301. begin
  302. proxy_s:=strpas(hp^);
  303. if Copy(proxy_s,1,7)=' !proxy' then
  304. begin
  305. proxy_s[13]:=#0;
  306. proxy_s[18]:=#0;
  307. proxy_s[23]:=#0;
  308. argv[2]:=@proxy_s[9];
  309. argv[3]:=@proxy_s[14];
  310. argv[4]:=@proxy_s[19];
  311. useproxy:=true;
  312. break;
  313. end;
  314. end;
  315. inc(hp);
  316. end;
  317. { check for !proxy for long commandlines passed using commandline }
  318. if (not useproxy) and
  319. (argc > 1) and (far_strlen(get_ds,longint(argv[1])) = 6) then
  320. begin
  321. move(argv[1]^,proxy_s[1],6);
  322. proxy_s[0] := #6;
  323. if (proxy_s = '!proxy') then
  324. useproxy:=true;
  325. end;
  326. { use proxy when found }
  327. if useproxy then
  328. begin
  329. proxy_argc:=atohex(argv[2]);
  330. proxy_seg:=atohex(argv[3]);
  331. proxy_ofs:=atohex(argv[4]);
  332. {$IfDef SYSTEM_DEBUG_STARTUP}
  333. Writeln(stderr,'proxy command line found');
  334. writeln(stderr,'argc: ',proxy_argc,' seg: ',proxy_seg,' ofs: ',proxy_ofs);
  335. {$EndIf SYSTEM_DEBUG_STARTUP}
  336. rm_argv:=SysGetmem(proxy_argc*sizeof(word));
  337. sysseg_move(dos_selector,proxy_seg*16+proxy_ofs, get_ds,longint(rm_argv),proxy_argc*sizeof(word));
  338. for count:=0 to proxy_argc - 1 do
  339. begin
  340. lin:=proxy_seg*16+rm_argv^[count];
  341. arglen:=far_strlen(dos_selector,lin);
  342. allocarg(count,arglen);
  343. sysseg_move(dos_selector,lin,get_ds,longint(argv[count]),arglen+1);
  344. {$IfDef SYSTEM_DEBUG_STARTUP}
  345. Writeln(stderr,'arg ',count,' #',rm_argv^[count],'#',arglen,'#',argv[count],'#');
  346. {$EndIf SYSTEM_DEBUG_STARTUP}
  347. end;
  348. SysFreemem(rm_argv);
  349. argc:=proxy_argc;
  350. end;
  351. { create an nil entry }
  352. allocarg(argc,0);
  353. { free unused memory }
  354. sysreallocmem(argv,(argc+1)*sizeof(pointer));
  355. end;
  356. function strcopy(dest,source : pchar) : pchar;assembler;
  357. var
  358. saveeax,saveesi,saveedi : longint;
  359. asm
  360. movl %edi,saveedi
  361. movl %esi,saveesi
  362. {$ifdef REGCALL}
  363. movl %eax,saveeax
  364. movl %edx,%edi
  365. {$else}
  366. movl source,%edi
  367. {$endif}
  368. testl %edi,%edi
  369. jz .LStrCopyDone
  370. leal 3(%edi),%ecx
  371. andl $-4,%ecx
  372. movl %edi,%esi
  373. subl %edi,%ecx
  374. {$ifdef REGCALL}
  375. movl %eax,%edi
  376. {$else}
  377. movl dest,%edi
  378. {$endif}
  379. jz .LStrCopyAligned
  380. .LStrCopyAlignLoop:
  381. movb (%esi),%al
  382. incl %edi
  383. incl %esi
  384. testb %al,%al
  385. movb %al,-1(%edi)
  386. jz .LStrCopyDone
  387. decl %ecx
  388. jnz .LStrCopyAlignLoop
  389. .balign 16
  390. .LStrCopyAligned:
  391. movl (%esi),%eax
  392. movl %eax,%edx
  393. leal 0x0fefefeff(%eax),%ecx
  394. notl %edx
  395. addl $4,%esi
  396. andl %edx,%ecx
  397. andl $0x080808080,%ecx
  398. jnz .LStrCopyEndFound
  399. movl %eax,(%edi)
  400. addl $4,%edi
  401. jmp .LStrCopyAligned
  402. .LStrCopyEndFound:
  403. testl $0x0ff,%eax
  404. jz .LStrCopyByte
  405. testl $0x0ff00,%eax
  406. jz .LStrCopyWord
  407. testl $0x0ff0000,%eax
  408. jz .LStrCopy3Bytes
  409. movl %eax,(%edi)
  410. jmp .LStrCopyDone
  411. .LStrCopy3Bytes:
  412. xorb %dl,%dl
  413. movw %ax,(%edi)
  414. movb %dl,2(%edi)
  415. jmp .LStrCopyDone
  416. .LStrCopyWord:
  417. movw %ax,(%edi)
  418. jmp .LStrCopyDone
  419. .LStrCopyByte:
  420. movb %al,(%edi)
  421. .LStrCopyDone:
  422. {$ifdef REGCALL}
  423. movl saveeax,%eax
  424. {$else}
  425. movl dest,%eax
  426. {$endif}
  427. movl saveedi,%edi
  428. movl saveesi,%esi
  429. end;
  430. var
  431. env_selector:word; external name 'ENV_SELECTOR';
  432. env_size:longint; external name 'ENV_SIZE';
  433. procedure setup_environment;
  434. var env_count : longint;
  435. dos_env,cp : pchar;
  436. begin
  437. env_count:=0;
  438. dos_env:=getmem(env_size);
  439. sysseg_move(env_selector,$0, get_ds, longint(dos_env), env_size);
  440. cp:=dos_env;
  441. while cp ^ <> #0 do
  442. begin
  443. inc(env_count);
  444. while (cp^ <> #0) do inc(longint(cp)); { skip to NUL }
  445. inc(longint(cp)); { skip to next character }
  446. end;
  447. envp := sysgetmem((env_count+1) * sizeof(pchar));
  448. if (envp = nil) then exit;
  449. cp:=dos_env;
  450. env_count:=0;
  451. while cp^ <> #0 do
  452. begin
  453. envp[env_count] := sysgetmem(strlen(cp)+1);
  454. strcopy(envp[env_count], cp);
  455. {$IfDef SYSTEM_DEBUG_STARTUP}
  456. Writeln(stderr,'env ',env_count,' = "',envp[env_count],'"');
  457. {$EndIf SYSTEM_DEBUG_STARTUP}
  458. inc(env_count);
  459. while (cp^ <> #0) do
  460. inc(longint(cp)); { skip to NUL }
  461. inc(longint(cp)); { skip to next character }
  462. end;
  463. envp[env_count]:=nil;
  464. longint(cp):=longint(cp)+3;
  465. dos_argv0 := sysgetmem(strlen(cp)+1);
  466. if (dos_argv0 = nil) then halt;
  467. strcopy(dos_argv0, cp);
  468. end;
  469. procedure syscopytodos(addr : sizeuint; len : longint);
  470. begin
  471. if len > tb_size then
  472. HandleError(217);
  473. sysseg_move(get_ds,addr,dos_selector,tb,len);
  474. end;
  475. procedure syscopyfromdos(addr : sizeuint; len : longint);
  476. begin
  477. if len > tb_size then
  478. HandleError(217);
  479. sysseg_move(dos_selector,tb,get_ds,addr,len);
  480. end;
  481. procedure sysrealintr(intnr : word;var regs : trealregs);
  482. begin
  483. regs.realsp:=0;
  484. regs.realss:=0;
  485. asm
  486. pushl %edi
  487. pushl %ebx
  488. pushw %fs
  489. movw intnr,%bx
  490. xorl %ecx,%ecx
  491. movl regs,%edi
  492. movw $0x300,%ax
  493. int $0x31
  494. popw %fs
  495. popl %ebx
  496. popl %edi
  497. end;
  498. end;
  499. procedure set_pm_interrupt(vector : byte;const intaddr : tseginfo);
  500. begin
  501. asm
  502. pushl %ebx
  503. movl intaddr,%eax
  504. movl (%eax),%edx
  505. movw 4(%eax),%cx
  506. movl $0x205,%eax
  507. movb vector,%bl
  508. int $0x31
  509. popl %ebx
  510. end;
  511. end;
  512. procedure get_pm_interrupt(vector : byte;var intaddr : tseginfo);
  513. begin
  514. asm
  515. pushl %ebx
  516. movb vector,%bl
  517. movl $0x204,%eax
  518. int $0x31
  519. movl intaddr,%eax
  520. movl %edx,(%eax)
  521. movw %cx,4(%eax)
  522. popl %ebx
  523. end;
  524. end;
  525. {*****************************************************************************
  526. System Dependent Exit code
  527. *****************************************************************************}
  528. procedure ___exit(exitcode:longint);cdecl;external name '___exit';
  529. Procedure system_exit;
  530. var
  531. h : byte;
  532. begin
  533. for h:=0 to max_files-1 do
  534. if openfiles[h] then
  535. begin
  536. {$ifdef SYSTEMDEBUG}
  537. writeln(stderr,'file ',opennames[h],' not closed at exit');
  538. {$endif SYSTEMDEBUG}
  539. if h>=5 then
  540. do_close(h);
  541. end;
  542. { halt is not allways called !! }
  543. { not on normal exit !! PM }
  544. set_pm_interrupt($00,old_int00);
  545. {$ifndef EXCEPTIONS_IN_SYSTEM}
  546. set_pm_interrupt($75,old_int75);
  547. {$endif EXCEPTIONS_IN_SYSTEM}
  548. ___exit(exitcode);
  549. end;
  550. procedure new_int00;
  551. begin
  552. HandleError(200);
  553. end;
  554. {$ifndef EXCEPTIONS_IN_SYSTEM}
  555. procedure new_int75;
  556. begin
  557. asm
  558. xorl %eax,%eax
  559. outb %al,$0x0f0
  560. movb $0x20,%al
  561. outb %al,$0x0a0
  562. outb %al,$0x020
  563. end;
  564. HandleError(200);
  565. end;
  566. {$endif EXCEPTIONS_IN_SYSTEM}
  567. var
  568. __stkbottom : pointer;//###########external name '__stkbottom';
  569. {*****************************************************************************
  570. ParamStr/Randomize
  571. *****************************************************************************}
  572. function paramcount : longint;
  573. begin
  574. paramcount := argc - 1;
  575. end;
  576. function paramstr(l : longint) : string;
  577. begin
  578. if (l>=0) and (l+1<=argc) then
  579. paramstr:=strpas(argv[l])
  580. else
  581. paramstr:='';
  582. end;
  583. procedure randomize;
  584. var
  585. hl : longint;
  586. regs : trealregs;
  587. begin
  588. regs.realeax:=$2c00;
  589. sysrealintr($21,regs);
  590. hl:=lo(regs.realedx);
  591. randseed:=hl*$10000+ lo(regs.realecx);
  592. end;
  593. { include standard heap management }
  594. { include heap.inc}
  595. (*
  596. {*****************************************************************************
  597. UnTyped File Handling
  598. *****************************************************************************}
  599. {$i file.inc}
  600. {*****************************************************************************
  601. Typed File Handling
  602. *****************************************************************************}
  603. {$i typefile.inc}
  604. {*****************************************************************************
  605. Text File Handling
  606. *****************************************************************************}
  607. {$i text.inc}
  608. {*****************************************************************************
  609. Generic Handling
  610. *****************************************************************************}
  611. {$ifdef TEST_GENERIC}
  612. {$i generic.inc}
  613. {$endif TEST_GENERIC}
  614. *)
  615. {*****************************************************************************
  616. SystemUnit Initialization
  617. *****************************************************************************}
  618. function CheckLFN:boolean;
  619. var
  620. regs : TRealRegs;
  621. RootName : pchar;
  622. begin
  623. { Check LFN API on drive c:\ }
  624. RootName:='C:\';
  625. syscopytodos(longint(RootName),strlen(RootName)+1);
  626. { Call 'Get Volume Information' ($71A0) }
  627. regs.realeax:=$71a0;
  628. regs.reales:=tb_segment;
  629. regs.realedi:=tb_offset;
  630. regs.realecx:=32;
  631. regs.realds:=tb_segment;
  632. regs.realedx:=tb_offset;
  633. regs.realflags:=carryflag;
  634. sysrealintr($21,regs);
  635. { If carryflag=0 and LFN API bit in ebx is set then use Long file names }
  636. CheckLFN:=(regs.realflags and carryflag=0) and (regs.realebx and $4000=$4000);
  637. end;
  638. {$ifdef EXCEPTIONS_IN_SYSTEM}
  639. {$define IN_SYSTEM}
  640. {$i dpmiexcp.pp}
  641. {$endif EXCEPTIONS_IN_SYSTEM}
  642. procedure SysInitStdIO;
  643. begin
  644. OpenStdIO(Input,fmInput,StdInputHandle);
  645. OpenStdIO(Output,fmOutput,StdOutputHandle);
  646. OpenStdIO(ErrOutput,fmOutput,StdErrorHandle);
  647. OpenStdIO(StdOut,fmOutput,StdOutputHandle);
  648. OpenStdIO(StdErr,fmOutput,StdErrorHandle);
  649. end;
  650. function GetProcessID: SizeUInt;
  651. begin
  652. GetProcessID := 1;
  653. end;
  654. function CheckInitialStkLen(stklen : SizeUInt) : SizeUInt;
  655. begin
  656. result := stklen;
  657. end;
  658. var
  659. temp_int : tseginfo;
  660. Begin
  661. alloc_tb;
  662. StackLength := InitialStkLen;
  663. StackBottom := __stkbottom;
  664. { To be set if this is a GUI or console application }
  665. IsConsole := TRUE;
  666. { To be set if this is a library and not a program }
  667. IsLibrary := FALSE;
  668. { save old int 0 and 75 }
  669. get_pm_interrupt($00,old_int00);
  670. get_pm_interrupt($75,old_int75);
  671. temp_int.segment:=get_cs;
  672. temp_int.offset:=@new_int00;
  673. set_pm_interrupt($00,temp_int);
  674. {$ifndef EXCEPTIONS_IN_SYSTEM}
  675. temp_int.offset:=@new_int75;
  676. set_pm_interrupt($75,temp_int);
  677. {$endif EXCEPTIONS_IN_SYSTEM}
  678. { Setup heap }
  679. InitHeap;
  680. SysInitExceptions;
  681. initunicodestringmanager;
  682. { Setup stdin, stdout and stderr }
  683. SysInitStdIO;
  684. { Setup environment and arguments }
  685. Setup_Environment;
  686. Setup_Arguments;
  687. { Use LFNSupport LFN }
  688. LFNSupport:=CheckLFN;
  689. if LFNSupport then
  690. begin
  691. FileNameCasePreserving:=true;
  692. AllFilesMask := '*';
  693. end
  694. else
  695. AllFilesMask := '*.*';
  696. { Reset IO Error }
  697. InOutRes:=0;
  698. ThreadID := 1;
  699. {$ifdef EXCEPTIONS_IN_SYSTEM}
  700. InitDPMIExcp;
  701. InstallDefaultHandlers;
  702. {$endif EXCEPTIONS_IN_SYSTEM}
  703. End.