Subversion Repositories Kolibri OS

Rev

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

Rev Author Line No. Line
790 bw 1 
{utf8}
616 bw 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
790 bw 59 
      {Пропустить лидирующие пробелы}
616 bw 60 
      while Args^ in [#1..#32] do Inc(Args);
61 
      if Args^ = #0 then Break;
62 
 
790 bw 63 
      {Запомнить указатель на параметр}
616 bw 64 
      SetLength(Ptrs, Argc);
65 
      Ptrs[Argc - 1] := Args;
66 
      Inc(Argc);
67 
 
790 bw 68 
      {Пропустить текущий параметр}
616 bw 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 
 
790 bw 76 
      {Установить окончание параметра}
616 bw 77 
      if Args^ in [#1..#32] then
78 
      begin
79 
        Args^ := #0;
80 
        Inc(Args);
81 
      end;
82 
    end;
83 
  end;
790 bw 84 
  Argv := GetMem(Argc * SizeOf(PChar));  {XXX: память не освобождается}
616 bw 85 
  Argv[0] :=  PKosHeader(0)^.path;
86 
  for I := 1 to Argc - 1 do
87 
  begin
88 
    Argv[I] := Ptrs[I - 1];
790 bw 89 
    {Исключить кавычки из строки}
616 bw 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
790 bw 121 
  randseed := kos_timecounter();
616 bw 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
790 bw 160 
      {XXX: обязательное условие на однопоточный Konsole}
616 bw 161 
      Write(StdErr, '[Error #', ExitCode,', press any key]');
790 bw 162 
      {ожидать нажатия клавиши}
616 bw 163 
      Konsole.KeyPressed;
164 
      while Konsole.KeyPressed = 0 do kos_delay(2);
790 bw 165 
      {TODO: исправить косяк при перерисовке Konsole}
166 
      {это невозможно, так как куча освобождается еще до вызова этой процедуры}
167 
      {можно написать свой диспетчер памяти, но это сложно}
168 
      {а если в Konsole использовать выделение памяти напрямую через KosAPI?!}
616 bw 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);
666 bw 189 
  kos_initheap();
616 bw 190 
  InitHeap;
191 
  SysInitExceptions;
192 
  FPC_CpuCodeInit();
193 
  InOutRes := 0;
194 
  InitSystemThreads;
666 bw 195 
  if IsConsole then
196 
    Konsole.Init();
616 bw 197 
  SysInitStdIO;
198 
  SetupCmdLine;
199 
  InitVariantManager;
200 
  {InitWideStringManager;}
201 
  DispCallByIDProc := @DoDispCallByIDError;
202 
end.