Subversion Repositories Kolibri OS

Rev

Rev 666 | Go to most recent revision | Blame | Compare with Previous | Last modification | View Log | Download | RSS feed

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