uses dos{$IFDEF FPC},go32 {$ENDIF};

{$CALLING OLDFPCCALL}

type pstring=^string;

const origenvsegm:word=0;
      newenvbuf:longint=0;
      newenvseg:word=0;
      newenvlen:word=0;

Procedure RestoreEnvVariable;
var n:pointer;
    r:registers;
    w:word;
begin
if newenvbuf<>0 then
   begin
   {$IFDEF FPC}
   Global_Dos_Free(word(newenvbuf));
   {$ELSE}
   n:=pointer(newenvbuf);
   FreeMem(n,8192);
   {$ENDIF}
   if origenvsegm<>0 then
      begin
      r.ah:=$62;MsDos(r);w:=r.bx;
      MemW[w:$2c]:=origenvsegm;
      end;
   origenvsegm:=0;
   newenvbuf:=0;
   end;
end;

Function Memb(segm,ofss:word):byte;assembler;
asm
xor ebx,ebx
mov bx,segm
shl ebx,4
add bx,ofss
mov al,fs:[ebx]
end;


Procedure SetEnvVariable(p,h:string);
Var
    t:string;
    w,w2:word;
    i,j,k,m:word;
    l,l2:longint;
    r:registers;
    c:char;
    es:array[1..30] of pstring;
    numes:byte;
    u:pchar;
    n:pointer;

begin
r.ah:=$62;MsDos(r);w:=r.bx;       {a mame segment PSP}

DOSmemGet(w,0,t,255);

for i:=0 to 255 do write(char(mem[w:i]{memb(w,i)}));

w2:=MemW[w:$2c];

writeln;
writeln(w);
writeln(w2);
writeln;

if origenvsegm=0 then
   begin
   origenvsegm:=w2;
   {$IFDEF FPC}
   newenvbuf:=Global_DOS_Alloc(8192);
   newenvseg:=Word(newenvbuf shr 16);
   {$ELSE}
   GetMem(n,8192);
   newenvbuf:=longint(n);
   newenvseg:=seg(n^)+1;
   {$ENDIF}
   end;
i:=0;
k:=0;
numes:=0;
repeat
c:=char(Mem[w2:i]);
if c<>#0 then
   begin
   t:=t+c;
   end
   else begin
   if t<>'' then
      begin
      inc(numes);
      j:=Length(t)+1;
      inc(k,j);
      GetMem(es[numes],j);
      es[numes]^:=t;
      t:='';
      end;
   if char(Mem[w2:i+1])=#0 then Break;
   end;
   inc(i);
until i>8192;
inc(k,1);


inc(numes);
t:=p+'='+h;
GetMem(es[numes],Length(t)+1);
es[numes]^:=t;

writeln;
writeln;
for i:=1 to numes do
    writeln(es[i]^);


m:=0;
{
for i:=1 to numes do
    begin
    j:=Length(es[i]^);
    for k:=0 to j-1 do Mem[newenvseg:m+k]:=byte(es[i]^[k+1]);
    inc(m,j);
    Mem[newenvseg:m]:=0;
    inc(m);
    end;
}

MemW[w:$2c]:=newenvseg;


{for i:=0 to 255 do
    write(char(mem[newenvseg:i]));}
end;

var p:pchar='pokus';
begin
envp:=@p;
writeln(envp^);
envp:=nil;
readln;

SetEnvVariable('LAACA','test');
readln;
end.
