* fixed the sysutils.GetEnvironment* functions for i8086-msdos

- removed the envp variable from the msdos system unit, because it's not
  compatible with ppchar in all memory models (we use ppfarchar to avoid copying
  the environment in the program's data segment in near data memory models)

git-svn-id: trunk@32017 -

rtl/inc/heaptrc.pp

@@ -1472,6 +1472,48 @@ begin
     Add some way to specify heaptrc options? }
   GetEnv:=nil;
 end;
+{$elseif defined(msdos)}
+   type
+     PFarChar=^Char;far;
+     PPFarChar=^PFarChar;
+   var
+     envp: PPFarChar;external name '__fpc_envp';
+Function GetEnv(P:string):string;
+var
+  ep    : ppfarchar;
+  pc    : pfarchar;
+  i     : smallint;
+  found : boolean;
+Begin
+  getenv:='';
+  p:=p+'=';            {Else HOST will also find HOSTNAME, etc}
+  ep:=envp;
+  found:=false;
+  if ep<>nil then
+    begin
+      while (not found) and (ep^<>nil) do
+        begin
+          found:=true;
+          for i:=1 to length(p) do
+            if p[i]<>ep^[i-1] then
+              begin
+                found:=false;
+                break;
+              end;
+          if not found then
+            inc(ep);
+        end;
+    end;
+  if found then
+    begin
+      pc:=ep^+length(p);
+      while pc^<>#0 do
+        begin
+          getenv:=getenv+pc^;
+          Inc(pc);
+        end;
+    end;
+end;
 {$else}
 Function GetEnv(P:string):Pchar;
 {

rtl/msdos/system.pp

@@ -60,8 +60,6 @@ var
 { C-compatible arguments and environment }
   argc:longint; //!! public name 'operatingsystem_parameter_argc';
   argv:PPchar; //!! public name 'operatingsystem_parameter_argv';
-  envp:PPchar; //!! public name 'operatingsystem_parameter_envp';
-  dos_argv0 : pchar; //!! public name 'dos_argv0';
 
 { The DOS Program Segment Prefix segment (TP7 compatibility) }
   PrefixSeg:Word;public name '__fpc_PrefixSeg';
@@ -103,6 +101,7 @@ type
   PFarByte = ^Byte;far;
   PFarChar = ^Char;far;
   PFarWord = ^Word;far;
+  PPFarChar = ^PFarChar;
 
 var
   __stktop : pointer;public name '__stktop';
@@ -110,6 +109,9 @@ var
   __nearheap_start: pointer;public name '__nearheap_start';
   __nearheap_end: pointer;public name '__nearheap_end';
   dos_version:Word;public name 'dos_version';
+  envp:PPFarChar;public name '__fpc_envp';
+  dos_env_count:smallint;public name '__dos_env_count';
+  dos_argv0 : PFarChar;public name '__fpc_dos_argv0';
 
 {$I registers.inc}
 
@@ -170,46 +172,57 @@ end;
                               ParamStr/Randomize
 *****************************************************************************}
 
+procedure setup_environment;
+var
+  env_count : smallint;
+  cp, dos_env: PFarChar;
+begin
+  env_count:=0;
+  dos_env:=Ptr(MemW[PrefixSeg:$2C], 0);
+  cp:=dos_env;
+  while cp^<>#0 do
+    begin
+      inc(env_count);
+      while (cp^ <> #0) do
+        inc(cp); { skip to NUL }
+      inc(cp); { skip to next character }
+    end;
+  envp := getmem((env_count+1) * sizeof(PFarChar));
+  cp:=dos_env;
+  env_count:=0;
+  while cp^<>#0 do
+    begin
+      envp[env_count] := cp;
+      inc(env_count);
+      while (cp^ <> #0) do
+        inc(cp); { skip to NUL }
+      inc(cp); { skip to next character }
+    end;
+  envp[env_count]:=nil;
+  dos_env_count := env_count;
+  if dos_version >= $300 then
+    begin
+      inc(cp, 3);
+      dos_argv0 := cp;
+    end
+  else
+    dos_argv0 := nil;
+end;
+
+
 function GetProgramName: string;
 var
-  dos_env_seg: Word;
-  ofs: Word;
-  Ch, Ch2: Char;
+  cp: PFarChar;
 begin
-  if dos_version < $300 then
+  GetProgramName := '';
+  cp := dos_argv0;
+  if cp = nil then
+    exit;
+  while cp^ <> #0 do
     begin
-      GetProgramName := '';
-      exit;
+      GetProgramName := GetProgramName + cp^;
+      Inc(cp);
     end;
-  dos_env_seg := PFarWord(Ptr(PrefixSeg, $2C))^;
-  ofs := 1;
-  repeat
-    Ch := PFarChar(Ptr(dos_env_seg,ofs - 1))^;
-    Ch2 := PFarChar(Ptr(dos_env_seg,ofs))^;
-    if (Ch = #0) and (Ch2 = #0) then
-      begin
-        Inc(ofs, 3);
-        GetProgramName := '';
-        repeat
-          Ch := PFarChar(Ptr(dos_env_seg,ofs))^;
-          if Ch <> #0 then
-            GetProgramName := GetProgramName + Ch;
-          Inc(ofs);
-          if ofs = 0 then
-            begin
-              GetProgramName := '';
-              exit;
-            end;
-        until Ch = #0;
-        exit;
-      end;
-    Inc(ofs);
-    if ofs = 0 then
-      begin
-        GetProgramName := '';
-        exit;
-      end;
-  until false;
 end;
 
 
@@ -378,6 +391,8 @@ begin
   initunicodestringmanager;
 { Setup stdin, stdout and stderr }
   SysInitStdIO;
+{ Setup environment and arguments }
+  Setup_Environment;
 { Use LFNSupport LFN }
   LFNSupport:=CheckLFN;
   if LFNSupport then

rtl/msdos/sysutils.pp

@@ -49,6 +49,13 @@ implementation
 { Include platform independent implementation part }
 {$i sysutils.inc}
 
+type
+  PFarChar=^Char;far;
+  PPFarChar=^PFarChar;
+var
+  envp:PPFarChar;external name '__fpc_envp';
+  dos_env_count:smallint;external name '__dos_env_count';
+
 
 {****************************************************************************
                               File Functions
@@ -751,23 +758,86 @@ end;
                               Os utils
 ****************************************************************************}
 
+{$if defined(FPC_MM_TINY) or defined(FPC_MM_SMALL) or defined(FPC_MM_MEDIUM)}
+{ environment handling for near data memory models }
+
+function far_strpas(p: pfarchar): string;
+begin
+  Result:='';
+  if p<>nil then
+    while p^<>#0 do
+      begin
+        Result:=Result+p^;
+        Inc(p);
+      end;
+end;
+
+Function small_FPCGetEnvVarFromP(EP : PPFarChar; EnvVar : String) : String;
+var
+  hp         : ppfarchar;
+  lenvvar,hs : string;
+  eqpos      : smallint;
+begin
+  lenvvar:=upcase(envvar);
+  hp:=EP;
+  Result:='';
+  If (hp<>Nil) then
+    while assigned(hp^) do
+     begin
+       hs:=far_strpas(hp^);
+       eqpos:=pos('=',hs);
+       if upcase(copy(hs,1,eqpos-1))=lenvvar then
+        begin
+          Result:=copy(hs,eqpos+1,length(hs)-eqpos);
+          exit;
+        end;
+       inc(hp);
+     end;
+end;
+
+Function small_FPCGetEnvStrFromP(EP : PPFarChar; Index : SmallInt) : String;
+begin
+  Result:='';
+  while assigned(EP^) and (Index>1) do
+    begin
+      dec(Index);
+      inc(EP);
+    end;
+  if Assigned(EP^) then
+    Result:=far_strpas(EP^);
+end;
+
 Function GetEnvironmentVariable(Const EnvVar : String) : String;
+begin
+  Result:=small_FPCGetEnvVarFromP(envp,EnvVar);
+end;
+
+Function GetEnvironmentVariableCount : Integer;
+begin
+  Result:=dos_env_count;
+end;
 
+Function GetEnvironmentString(Index : Integer) : {$ifdef FPC_RTL_UNICODE}UnicodeString{$else}AnsiString{$endif};
+begin
+  Result:=small_FPCGetEnvStrFromP(Envp,Index);
+end;
+{$else}
+{ environment handling for far data memory models }
+Function GetEnvironmentVariable(Const EnvVar : String) : String;
 begin
   Result:=FPCGetEnvVarFromP(envp,EnvVar);
 end;
 
 Function GetEnvironmentVariableCount : Integer;
-
 begin
-  Result:=FPCCountEnvVar(EnvP);
+  Result:=dos_env_count;
 end;
 
 Function GetEnvironmentString(Index : Integer) : {$ifdef FPC_RTL_UNICODE}UnicodeString{$else}AnsiString{$endif};
-
 begin
   Result:=FPCGetEnvStrFromP(Envp,Index);
 end;
+{$endif}
 
 
 function ExecuteProcess(Const Path: AnsiString; Const ComLine: AnsiString;Flags:TExecuteFlags=[]):integer;