Subversion Repositories Kolibri OS

Rev

Rev 790 | Blame | Compare with Previous | Last modification | View Log | Download | RSS feed

  1. {utf8}
  2. unit System;
  3.  
  4. {$i _defines.inc}
  5. {$define HAS_CMDLINE}
  6.  
  7. interface
  8.  
  9. {$i systemh.inc}
  10. {$i kos_def.inc}
  11. {$i kosh.inc}
  12.  
  13. const
  14.   LineEnding = #13#10;
  15.   LFNSupport = True;
  16.   DirectorySeparator = '/';
  17.   DriveSeparator = '/';
  18.   PathSeparator = ';';
  19.   MaxExitCode = 65535;
  20.   MaxPathLen = 512;
  21.  
  22.   InitialStkLen = 20480; /// siemargl
  23.  
  24.  
  25.  
  26.   UnusedHandle   : THandle = -1;
  27.   StdInputHandle : THandle = 0;
  28.   StdOutputHandle: THandle = 0;
  29.   StdErrorHandle : THandle = 0;
  30.   FileNameCaseSensitive: Boolean = True;
  31.   CtrlZMarksEOF: Boolean = True;
  32.   sLineBreak = LineEnding;
  33.   DefaultTextLineBreakStyle: TTextLineBreakStyle = tlbsCRLF;
  34.  
  35. var
  36.   Argc: Longint = 0;
  37.   Argv: PPChar = nil;
  38.  
  39.   Konsole: TKonsole;
  40.  
  41.  
  42. implementation
  43.  
  44. var
  45.   SysInstance: Longint; public name '_FPC_SysInstance';
  46.  
  47. {$i system.inc}
  48.  
  49.  
  50. procedure SetupCmdLine;
  51. var
  52.   Ptrs: array of PChar;
  53.   Args: PChar;
  54.   InQuotes: Boolean;
  55.   I, L: Longint;
  56. begin
  57.   Argc := 1;
  58.   Args := PKosHeader(0)^.args;
  59.   if Assigned(Args) then
  60.   begin
  61.     while Args^ <> #0 do
  62.     begin
  63.       {Пропустить лидирующие пробелы}
  64.       while Args^ in [#1..#32] do Inc(Args);
  65.       if Args^ = #0 then Break;
  66.  
  67.       {Запомнить указатель на параметр}
  68.       SetLength(Ptrs, Argc);
  69.       Ptrs[Argc - 1] := Args;
  70.       Inc(Argc);
  71.  
  72.       {Пропустить текущий параметр}
  73.       InQuotes := False;
  74.       while (Args^ <> #0) and (not (Args^ in [#1..#32]) or InQuotes) do
  75.       begin
  76.         if Args^ = '"' then InQuotes := not InQuotes;
  77.         Inc(Args);
  78.       end;
  79.  
  80.       {Установить окончание параметра}
  81.       if Args^ in [#1..#32] then
  82.       begin
  83.         Args^ := #0;
  84.         Inc(Args);
  85.       end;
  86.     end;
  87.   end;
  88.   Argv := GetMem(Argc * SizeOf(PChar));  {XXX: память не освобождается}
  89.   Argv[0] :=  PKosHeader(0)^.path;
  90.   for I := 1 to Argc - 1 do
  91.   begin
  92.     Argv[I] := Ptrs[I - 1];
  93.     {Исключить кавычки из строки}
  94.     Args := Argv[I];
  95.     L := 0;
  96.     while Args^ <> #0 do begin Inc(Args); Inc(L); end;
  97.     Args := Argv[I];
  98.     while Args^ <> #0 do
  99.     begin
  100.       if Args^ = '"' then
  101.       begin
  102.         Move(PChar(Args + 1)^, Args^, L);
  103.         Dec(L);
  104.       end;
  105.       Inc(Args);
  106.       Dec(L);
  107.     end;
  108.   end;
  109. end;
  110.  
  111. function ParamCount: Longint;
  112. begin
  113.   Result := Argc - 1;
  114. end;
  115.  
  116. function ParamStr(L: Longint): String;
  117. begin
  118.   if (L >= 0) and (L < Argc) then
  119.     Result := StrPas(Argv[L]) else
  120.     Result := '';
  121. end;
  122.  
  123. procedure Randomize;
  124. begin
  125.   randseed := kos_timecounter();
  126. end;
  127.  
  128. const
  129.   ProcessID: SizeUInt = 0;
  130.  
  131. function GetProcessID: SizeUInt;
  132. begin
  133.   GetProcessID := ProcessID;
  134. end;
  135.  
  136. function CheckInitialStkLen(stklen: SizeUInt): SizeUInt;
  137. begin
  138.   {TODO}
  139.   Result := stklen;
  140. end;
  141.  
  142. {$i kos_stdio.inc}
  143.  
  144. procedure SysInitStdIO;
  145. begin
  146.   if IsConsole then
  147.   begin
  148.     AssignStdin(Input);
  149.     AssignStdout(Output);
  150.     AssignStdout(ErrOutput);
  151.     AssignStdout(StdOut);
  152.     AssignStdout(StdErr);
  153.   end;
  154. end;
  155.  
  156. procedure System_Exit; [public, alias: 'SystemExit'];
  157. var
  158.   event, count: DWord;
  159. begin
  160.   if IsConsole then
  161.   begin
  162.     if ExitCode <> 0 then
  163.     begin
  164.       {XXX: обязательное условие на однопоточный Konsole}
  165.       Write(StdErr, '[Error #', ExitCode,', press any key]');
  166.       {ожидать нажатия клавиши}
  167.       Konsole.KeyPressed;
  168.       while Konsole.KeyPressed = 0 do kos_delay(2);
  169.       {TODO: исправить косяк при перерисовке Konsole}
  170.       {это невозможно, так как куча освобождается еще до вызова этой процедуры}
  171.       {можно написать свой диспетчер памяти, но это сложно}
  172.       {а если в Konsole использовать выделение памяти напрямую через KosAPI?!}
  173.     end;
  174.     Close(StdErr);
  175.     Close(StdOut);
  176.     Close(ErrOutput);
  177.     Close(Input);
  178.     Close(Output);
  179.     Konsole.Done();
  180.   end;
  181.   asm
  182.     movl $-1, %eax
  183.     int $0x40
  184.   end;
  185. end;
  186.  
  187. {$i kos.inc}
  188.  
  189. begin
  190.   SysResetFPU;
  191.   StackLength := CheckInitialStkLen(InitialStkLen);
  192.   StackBottom := Pointer(StackTop - StackLength);
  193.   kos_initheap();
  194.   InitHeap;
  195.   SysInitExceptions;
  196.   FPC_CpuCodeInit();
  197.   InOutRes := 0;
  198.   InitSystemThreads;
  199.   if IsConsole then
  200.     Konsole.Init();
  201.   SysInitStdIO;
  202.   SetupCmdLine;
  203.   InitVariantManager;
  204.   {InitWideStringManager;}
  205.   DispCallByIDProc := @DoDispCallByIDError;
  206. end.
  207.