Subversion Repositories Kolibri OS

Rev

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

Rev Author Line No. Line
616 bw 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}
666 bw 139 
{-$i kos_term.inc}
616 bw 140 
 
141 
procedure SysInitStdIO;
142 
begin
143 
  if IsConsole then
144 
  begin
145 
    AssignStdin(Input);
146 
    AssignStdout(Output);
147 
    AssignStdout(ErrOutput);
148 
    AssignStdout(StdOut);
149 
    AssignStdout(StdErr);
150 
  end;
151 
end;
152 
 
153 
procedure System_Exit; [public, alias: 'SystemExit'];
154 
var
155 
  event, count: DWord;
156 
begin
157 
  if IsConsole then
158 
  begin
159 
    if ExitCode <> 0 then
160 
    begin
161 
      {XXX: обязательное условие на однопоточный Konsole}
162 
      Write(StdErr, '[Error #', ExitCode,', press any key]');
163 
      {ожидать нажатия клавиши}
164 
      Konsole.KeyPressed;
165 
      while Konsole.KeyPressed = 0 do kos_delay(2);
166 
      {TODO: исправить косяк при перерисовке Konsole}
167 
      {это невозможно, так как куча освобождается еще до вызова этой процедуры}
168 
      {можно написать свой диспетчер памяти, но это сложно}
169 
      {а если в Konsole использовать выделение памяти напрямую через KosAPI?!}
170 
    end;
171 
    Close(StdErr);
172 
    Close(StdOut);
173 
    Close(ErrOutput);
174 
    Close(Input);
175 
    Close(Output);
176 
    Konsole.Done();
177 
  end;
178 
  asm
179 
    movl $-1, %eax
180 
    int $0x40
181 
  end;
182 
end;
183 
 
184 
{$i kos.inc}
185 
 
186 
begin
187 
  SysResetFPU;
188 
  StackLength := CheckInitialStkLen(InitialStkLen);
189 
  StackBottom := Pointer(StackTop - StackLength);
666 bw 190 
  kos_initheap();
616 bw 191 
  InitHeap;
192 
  SysInitExceptions;
193 
  FPC_CpuCodeInit();
194 
  InOutRes := 0;
195 
  InitSystemThreads;
666 bw 196 
  if IsConsole then
197 
    Konsole.Init();
616 bw 198 
  SysInitStdIO;
199 
  SetupCmdLine;
200 
  InitVariantManager;
201 
  {InitWideStringManager;}
202 
  DispCallByIDProc := @DoDispCallByIDError;
203 
end.