* OS/2 version of custapp.inc fixed

This commit is contained in:
Tomas Hajny 2003-06-06 22:39:59 +00:00
parent 4de6550853
commit 8463bb0b3b

View File

@ -3,7 +3,7 @@
This file is part of the Free Pascal run time library. This file is part of the Free Pascal run time library.
Copyright (c) 2003 by the Free Pascal development team Copyright (c) 2003 by the Free Pascal development team
Linux version of custom app object routines. OS/2 version of custom app object routines.
See the file COPYING.FPC, included in this distribution, See the file COPYING.FPC, included in this distribution,
for details about the copyright. for details about the copyright.
@ -17,36 +17,27 @@
{ taken from dos unit } { taken from dos unit }
type type
PPchar = ^Pchar; PPChar = ^PChar;
function envs:PPchar;assembler; var EnvC: longint; external name '_envc';
EnvP: PPChar; external name '_environ';
asm function EnvStr (Index: longint): string;
movl envp,%eax
end ['EAX'];
function envcount:longint;assembler; var HP: PChar;
asm
movl envc,%eax
end ['EAX'];
function envstr(index : longint) : string;
var hp:Pchar;
begin begin
if (index<=0) or (index>envcount) then if (Index <= 0) or (Index > EnvC) then
begin begin
envstr:=''; EnvStr := '';
exit; exit;
end; end;
hp:=envs[index-1]; HP := EnvP [Pred (Index)];
envstr:=strpas(hp); EnvStr := StrPas (HP);
end; end;
procedure SysGetEnvironmentList(List : TStrings;NamesOnly : Boolean);
Procedure SysGetEnvironmentList(List : TStrings;NamesOnly : Boolean);
Var Var
S : String; S : String;
@ -54,9 +45,9 @@ Var
begin begin
List.Clear; List.Clear;
For J:=1 to envcount-1 do For J := 1 to Pred (EnvC) do
begin begin
S:=Envsttr(J); S:=EnvStr(J);
If NamesOnly then If NamesOnly then
begin begin
I:=Pos('=',S); I:=Pos('=',S);
@ -66,3 +57,11 @@ begin
List.Add(S); List.Add(S);
end; end;
end; end;
{
$Log$
Revision 1.2 2003-06-06 22:39:59 hajny
* OS/2 version of custapp.inc fixed
}