kolibrios-gitea/programs/develop/fp/rtl/system.pp
siemargl 24fde9ea89 freepascal rtl fix to work
git-svn-id: svn://kolibrios.org@7625 a494cfbc-eb01-0410-851d-a64ba20cac60
2019-04-10 06:10:13 +00:00

207 lines
4.4 KiB
ObjectPascal
Raw Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

{utf8}
unit System;
{$i _defines.inc}
{$define HAS_CMDLINE}
interface
{$i systemh.inc}
{$i kos_def.inc}
{$i kosh.inc}
const
LineEnding = #13#10;
LFNSupport = True;
DirectorySeparator = '/';
DriveSeparator = '/';
PathSeparator = ';';
MaxExitCode = 65535;
MaxPathLen = 512;
InitialStkLen = 20480; /// siemargl
UnusedHandle : THandle = -1;
StdInputHandle : THandle = 0;
StdOutputHandle: THandle = 0;
StdErrorHandle : THandle = 0;
FileNameCaseSensitive: Boolean = True;
CtrlZMarksEOF: Boolean = True;
sLineBreak = LineEnding;
DefaultTextLineBreakStyle: TTextLineBreakStyle = tlbsCRLF;
var
Argc: Longint = 0;
Argv: PPChar = nil;
Konsole: TKonsole;
implementation
var
SysInstance: Longint; public name '_FPC_SysInstance';
{$i system.inc}
procedure SetupCmdLine;
var
Ptrs: array of PChar;
Args: PChar;
InQuotes: Boolean;
I, L: Longint;
begin
Argc := 1;
Args := PKosHeader(0)^.args;
if Assigned(Args) then
begin
while Args^ <> #0 do
begin
{Пропустить лидирующие пробелы}
while Args^ in [#1..#32] do Inc(Args);
if Args^ = #0 then Break;
{Запомнить указатель на параметр}
SetLength(Ptrs, Argc);
Ptrs[Argc - 1] := Args;
Inc(Argc);
{Пропустить текущий параметр}
InQuotes := False;
while (Args^ <> #0) and (not (Args^ in [#1..#32]) or InQuotes) do
begin
if Args^ = '"' then InQuotes := not InQuotes;
Inc(Args);
end;
{Установить окончание параметра}
if Args^ in [#1..#32] then
begin
Args^ := #0;
Inc(Args);
end;
end;
end;
Argv := GetMem(Argc * SizeOf(PChar)); {XXX: память не освобождается}
Argv[0] := PKosHeader(0)^.path;
for I := 1 to Argc - 1 do
begin
Argv[I] := Ptrs[I - 1];
{Исключить кавычки из строки}
Args := Argv[I];
L := 0;
while Args^ <> #0 do begin Inc(Args); Inc(L); end;
Args := Argv[I];
while Args^ <> #0 do
begin
if Args^ = '"' then
begin
Move(PChar(Args + 1)^, Args^, L);
Dec(L);
end;
Inc(Args);
Dec(L);
end;
end;
end;
function ParamCount: Longint;
begin
Result := Argc - 1;
end;
function ParamStr(L: Longint): String;
begin
if (L >= 0) and (L < Argc) then
Result := StrPas(Argv[L]) else
Result := '';
end;
procedure Randomize;
begin
randseed := kos_timecounter();
end;
const
ProcessID: SizeUInt = 0;
function GetProcessID: SizeUInt;
begin
GetProcessID := ProcessID;
end;
function CheckInitialStkLen(stklen: SizeUInt): SizeUInt;
begin
{TODO}
Result := stklen;
end;
{$i kos_stdio.inc}
procedure SysInitStdIO;
begin
if IsConsole then
begin
AssignStdin(Input);
AssignStdout(Output);
AssignStdout(ErrOutput);
AssignStdout(StdOut);
AssignStdout(StdErr);
end;
end;
procedure System_Exit; [public, alias: 'SystemExit'];
var
event, count: DWord;
begin
if IsConsole then
begin
if ExitCode <> 0 then
begin
{XXX: обязательное условие на однопоточный Konsole}
Write(StdErr, '[Error #', ExitCode,', press any key]');
{ожидать нажатия клавиши}
Konsole.KeyPressed;
while Konsole.KeyPressed = 0 do kos_delay(2);
{TODO: исправить косяк при перерисовке Konsole}
{это невозможно, так как куча освобождается еще до вызова этой процедуры}
{можно написать свой диспетчер памяти, но это сложно}
{а если в Konsole использовать выделение памяти напрямую через KosAPI?!}
end;
Close(StdErr);
Close(StdOut);
Close(ErrOutput);
Close(Input);
Close(Output);
Konsole.Done();
end;
asm
movl $-1, %eax
int $0x40
end;
end;
{$i kos.inc}
begin
SysResetFPU;
StackLength := CheckInitialStkLen(InitialStkLen);
StackBottom := Pointer(StackTop - StackLength);
kos_initheap();
InitHeap;
SysInitExceptions;
FPC_CpuCodeInit();
InOutRes := 0;
InitSystemThreads;
if IsConsole then
Konsole.Init();
SysInitStdIO;
SetupCmdLine;
InitVariantManager;
{InitWideStringManager;}
DispCallByIDProc := @DoDispCallByIDError;
end.