Subversion Repositories Kolibri OS

Rev

Rev 790 | 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 
 
7625 siemargl 22 
  InitialStkLen = 20480; /// siemargl
23 
 
24 
 
25 
 
616 bw 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
790 bw 63 
      {Пропустить лидирующие пробелы}
616 bw 64 
      while Args^ in [#1..#32] do Inc(Args);
65 
      if Args^ = #0 then Break;
66 
 
790 bw 67 
      {Запомнить указатель на параметр}
616 bw 68 
      SetLength(Ptrs, Argc);
69 
      Ptrs[Argc - 1] := Args;
70 
      Inc(Argc);
71 
 
790 bw 72 
      {Пропустить текущий параметр}
616 bw 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 
 
790 bw 80 
      {Установить окончание параметра}
616 bw 81 
      if Args^ in [#1..#32] then
82 
      begin
83 
        Args^ := #0;
84 
        Inc(Args);
85 
      end;
86 
    end;
87 
  end;
790 bw 88 
  Argv := GetMem(Argc * SizeOf(PChar));  {XXX: память не освобождается}
616 bw 89 
  Argv[0] :=  PKosHeader(0)^.path;
90 
  for I := 1 to Argc - 1 do
91 
  begin
92 
    Argv[I] := Ptrs[I - 1];
790 bw 93 
    {Исключить кавычки из строки}
616 bw 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
790 bw 125 
  randseed := kos_timecounter();
616 bw 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
790 bw 164 
      {XXX: обязательное условие на однопоточный Konsole}
616 bw 165 
      Write(StdErr, '[Error #', ExitCode,', press any key]');
790 bw 166 
      {ожидать нажатия клавиши}
616 bw 167 
      Konsole.KeyPressed;
168 
      while Konsole.KeyPressed = 0 do kos_delay(2);
790 bw 169 
      {TODO: исправить косяк при перерисовке Konsole}
170 
      {это невозможно, так как куча освобождается еще до вызова этой процедуры}
171 
      {можно написать свой диспетчер памяти, но это сложно}
172 
      {а если в Konsole использовать выделение памяти напрямую через KosAPI?!}
616 bw 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);
666 bw 193 
  kos_initheap();
616 bw 194 
  InitHeap;
195 
  SysInitExceptions;
196 
  FPC_CpuCodeInit();
197 
  InOutRes := 0;
198 
  InitSystemThreads;
666 bw 199 
  if IsConsole then
200 
    Konsole.Init();
616 bw 201 
  SysInitStdIO;
202 
  SetupCmdLine;
203 
  InitVariantManager;
204 
  {InitWideStringManager;}
205 
  DispCallByIDProc := @DoDispCallByIDError;
206 
end.