paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-09 01:29:08 +02:00
Code Issues Packages Projects Releases Wiki Activity

rtl/atari: move common code of getenv

Browse Source
This commit is contained in:
Thorsten Otto 2022-02-10 10:43:48 +01:00 committed by Charlie Balogh
parent 67fedc6b5b
commit 0b1734cc04
3 changed files with 31 additions and 43 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
rtl/atari/dos.pp
View File

@ -418,29 +418,11 @@ begin
end;
end;
function fpGetEnv(const envvar : ShortString): RawByteString; external name '_fpc_atari_getenv';
function GetEnv(envvar : String): String;
var
hp : pchar;
i : longint;
upperenv, str : RawByteString;
begin
GetEnv:='';
hp:=basepage^.p_env;
if (hp=nil) then
exit;
upperenv:=upcase(envvar);
while hp^<>#0 do
begin
str:=hp;
i:=pos('=',str);
if upcase(copy(str,1,i-1))=upperenv then
begin
GetEnv:=copy(str,i+1,length(str)-i);
break;
end;
{ next string entry}
hp:=hp+strlen(hp)+1;
end;
GetEnv := fpgetenv(envvar);
end;

26
rtl/atari/system.pp
View File

@ -74,7 +74,6 @@ var
{$endif defined(FPUSOFT)}
implementation
{$define FPC_SYSTEM_HAS_STACKTOP}
@ -131,6 +130,31 @@ var
randseed:=xbios_random;
end;
function fpGetEnv(const envvar : ShortString): RawByteString; public name '_fpc_atari_getenv';
var
hp : pchar;
i : longint;
upperenv, str : RawByteString;
begin
fpGetEnv:='';
hp:=basepage^.p_env;
if (hp=nil) then
exit;
upperenv:=upcase(envvar);
while hp^<>#0 do
begin
str:=hp;
i:=pos('=',str);
if upcase(copy(str,1,i-1))=upperenv then
begin
fpGetEnv:=copy(str,i+1,length(str)-i);
break;
end;
{ next string entry}
hp:=hp+strlen(hp)+1;
end;
end;
{*****************************************************************************
System Dependent Exit code
*****************************************************************************}

24
rtl/atari/sysutils.pp
View File

@ -449,6 +449,8 @@ end;
OS utility functions
****************************************************************************}
function fpGetEnv(const envvar : ShortString): RawByteString; external name '_fpc_atari_getenv';
function GetPathString: String;
begin
{writeln('Unimplemented GetPathString');}
@ -456,28 +458,8 @@ begin
end;
Function GetEnvironmentVariable(Const EnvVar : String) : String;
var
hp : pchar;
i : longint;
upperenv, str : RawByteString;
begin
result:='';
hp:=basepage^.p_env;
if (hp=nil) then
exit;
upperenv:=uppercase(envvar);
while hp^<>#0 do
begin
str:=hp;
i:=pos('=',str);
if uppercase(copy(str,1,i-1))=upperenv then
begin
Result:=copy(str,i+1,length(str)-i);
break;
end;
{ next string entry}
hp:=hp+strlen(hp)+1;
end;
GetEnvironmentVariable := fpgetenv(envvar);
end;
Function GetEnvironmentVariableCount : Integer;