* dos interface is now 100% compatible

* fixed call PASCALMAIN which must be direct asm

rtl/win32/dos.pp

@@ -1,9 +1,9 @@
 {
     $Id$
-    This unit mimics the DOS unit for Win32
-
     This file is part of the Free Pascal run time library.
-    Copyright (c) 1998 by the Free Pascal development team.
+    Copyright (c) 1993,97 by the Free Pascal development team.
+
+    Dos unit for BP7 compatible RTL
 
     See the file COPYING.FPC, included in this distribution,
     for details about the copyright.
@@ -13,18 +13,22 @@
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
  **********************************************************************}
+unit dos;
 
 {$I os.inc}
 
-unit dos;
+interface
 
-  interface
+Const
+  {Bitmasks for CPU Flags}
+  fcarry     = $0001;
+  fparity    = $0004;
+  fauxiliary = $0010;
+  fzero      = $0040;
+  fsign      = $0080;
+  foverflow  = $0800;
 
-    uses
+  {Bitmasks for file attribute}
-       strings;
-
-    const
-       { bit masks for file attributes }
   readonly  = $01;
   hidden    = $02;
   sysfile   = $04;
@@ -32,232 +36,153 @@ unit dos;
   directory = $10;
   archive   = $20;
   anyfile   = $3F;
+
+  {File Status}
   fmclosed = $D7B0;
   fminput  = $D7B1;
   fmoutput = $D7B2;
   fminout  = $D7B3;
 
-    type
-       { some string types }
-       comstr = string;          { command line string     }
-       pathstr = string;         { string for a file path  }
-       dirstr = string;          { string for a directory  }
-       namestr = string;         { string for a file name  }
-       extstr = string;          { string for an extension }
 
-       { search record which is used by findfirst and findnext }
+Type
-       { it is compatible with the DOS version                 }
+{ Needed for Win95 LFN Support }
-       { if the fields are access using there names            }
+  ComStr  = String[255];
-       { the fields have another order                         }
+  PathStr = String[255];
-{$PACKRECORDS 1}
+  DirStr  = String[255];
-       searchrec = record
+  NameStr = String[255];
+  ExtStr  = String[255];
+
+{
+  filerec.inc contains the definition of the filerec.
+  textrec.inc contains the definition of the textrec.
+  It is in a separate file to make it available in other units without
+  having to use the DOS unit for it.
+}
+{$i filerec.inc}
+{$i textrec.inc}
+
+  DateTime = packed record
+    Year,
+    Month,
+    Day,
+    Hour,
+    Min,
+    Sec   : word;
+  End;
+
+  searchrec = packed record
      time : longint;
      size : longint;
      attr : longint;
      name : string;
   end;
 
-{$PACKRECORDS 2}
+  registers = packed record
-
+    case i : integer of
-       { file record for untyped files comes from filerec.inc}
+     0 : (ax,f1,bx,f2,cx,f3,dx,f4,bp,f5,si,f51,di,f6,ds,f7,es,f8,flags,fs,gs : word);
-       {$i filerec.inc}
+     1 : (al,ah,f9,f10,bl,bh,f11,f12,cl,ch,f13,f14,dl,dh : byte);
-
+     2 : (eax,  ebx,  ecx,  edx,  ebp,  esi,  edi : longint);
-       { file record for text files  comes from textrec.inc}
-       {$i textrec.inc}
-
-{$PACKRECORDS 1}
-       { record for date and time }
-       datetime = record
-          year,month,day,hour,min,sec : word;
     end;
 
-    var
+Var
-       { error variable }
+  DosError : integer;
-       doserror : longint;
 
-    procedure getdate(var year,month,day,dayofweek : word);
+{Interrupt}
-    procedure gettime(var hour,minute,second,sec100 : word);
+Procedure Intr(intno: byte; var regs: registers);
-    function dosversion : word;
+Procedure MSDos(var regs: registers);
-    procedure setdate(year,month,day : word);
-    procedure settime(hour,minute,second,sec100 : word);
-//    procedure getcbreak(var breakvalue : boolean);
-//    procedure setcbreak(breakvalue : boolean);
-//    procedure getverify(var verify : boolean);
-//    procedure setverify(verify : boolean);
-//    function diskfree(drive : byte) : longint;
-//    function disksize(drive : byte) : longint;
-    procedure findfirst(const path : pathstr;attr : word;var f : searchRec);
-    procedure findnext(var f : searchRec);
 
-    { is a dummy in win32 }
+{Info/Date/Time}
-    procedure swapvectors;
+Function  DosVersion: Word;
+Procedure GetDate(var year, month, mday, wday: word);
+Procedure GetTime(var hour, minute, second, sec100: word);
+procedure SetDate(year,month,day: word);
+Procedure SetTime(hour,minute,second,sec100: word);
+Procedure UnpackTime(p: longint; var t: datetime);
+Procedure PackTime(var t: datetime; var p: longint);
 
-{   not supported:
+{Exec}
-    procedure getintvec(intno : byte;var vector : pointer);
+Procedure Exec(const path: pathstr; const comline: comstr);
-    procedure setintvec(intno : byte;vector : pointer);
+Function  DosExitCode: word;
-    procedure keep(exitcode : word);
-    procedure msdos(var regs : registers);
-    procedure intr(intno : byte;var regs : registers);
-}
 
-    procedure getfattr(var f;var attr : word);
+{Disk}
-    procedure setfattr(var f;attr : word);
+Function  DiskFree(drive: byte) : longint;
+Function  DiskSize(drive: byte) : longint;
+Procedure FindFirst(const path: pathstr; attr: word; var f: searchRec);
+Procedure FindNext(var f: searchRec);
+Procedure FindClose(Var f: SearchRec);
 
-    function fsearch(const path : pathstr;dirlist : string) : pathstr;
+{File}
-    procedure getftime(var f;var time : longint);
+Procedure GetFAttr(var f; var attr: word);
-//    procedure setftime(var f;time : longint);
+Procedure GetFTime(var f; var time: longint);
-    procedure packtime (var d: datetime; var time: longint);
+Function  FSearch(path: pathstr; dirlist: string): pathstr;
-    procedure unpacktime (time: longint; var d: datetime);
+Function  FExpand(const path: pathstr): pathstr;
-    function fexpand(const path : pathstr) : pathstr;
+Procedure FSplit(path: pathstr; var dir: dirstr; var name: namestr; var ext: extstr);
-    procedure fsplit(path : pathstr;var dir : dirstr;var name : namestr;
-      var ext : extstr);
-//    procedure exec(const path : pathstr;const comline : comstr);
-    function dosexitcode : word;
-    function envcount : longint;
-    function envstr(index : longint) : string;
-    function getenv(const envvar : string): string;
 
-  implementation
+{Environment}
+Function  EnvCount: longint;
+Function  EnvStr(index: integer): string;
+Function  GetEnv(envvar: string): string;
+
+{Misc}
+Procedure SetFAttr(var f; attr: word);
+Procedure SetFTime(var f; time: longint);
+Procedure GetCBreak(var breakvalue: boolean);
+Procedure SetCBreak(breakvalue: boolean);
+Procedure GetVerify(var verify: boolean);
+Procedure SetVerify(verify: boolean);
+
+{Do Nothing Functions}
+Procedure SwapVectors;
+Procedure GetIntVec(intno: byte; var vector: pointer);
+Procedure SetIntVec(intno: byte; vector: pointer);
+Procedure Keep(exitcode: word);
+
+implementation
+uses strings;
 
 {$I win32.inc}
 
-    { taken from the DOS version }
+{******************************************************************************
-    function fsearch(const path : pathstr;dirlist : string) : pathstr;
+                           --- Dos Interrupt ---
+******************************************************************************}
 
-      var
+procedure intr(intno : byte;var regs : registers);
-         newdir : pathstr;
+begin
-         i,p1 : byte;
+  { !!!!!!!! }
-         s : searchrec;
+end;
 
-      begin
+procedure msdos(var regs : registers);
-         if (pos('?',path)<>0) or (pos('*',path)<>0) then
+begin
-           { No wildcards allowed in these things }
+  intr($21,regs);
-           fsearch:=''
+end;
-         else
-           begin
-              { allow slash as backslash }
-              for i:=1 to length(dirlist) do
-                if dirlist[i]='/' then dirlist[i]:='\';
 
-              repeat
-                { get first path }
-                p1:=pos(';',dirlist);
-                if p1>0 then
-                  begin
-                     newdir:=copy(dirlist,1,p1-1);
-                     delete(dirlist,1,p1)
-                  end
-                else
-                  begin
-                     newdir:=dirlist;
-                     dirlist:=''
-                  end;
-                if (newdir[length(newdir)]<>'\') and
-                   (newdir[length(newdir)]<>':') then
-                   newdir:=newdir+'\';
-                findfirst(newdir+path,anyfile,s);
-                if doserror=0 then
-                  begin
-                     { this should be newdir:=newdir+path
-                     because path can contain a path part !! }
-                     {newdir:=newdir+s.name;}
-                     newdir:=newdir+path;
-                     { this was for LINUX:
-                     if pos('.\',newdir)=1 then
-                       delete(newdir, 1, 2)
-                      DOS strips off an initial .\
-                     }
-                  end
-                else newdir:='';
-              until(dirlist='') or (length(newdir)>0);
-              fsearch:=newdir;
-           end;
-      end;
 
-    procedure getftime(var f;var time : longint);
+{******************************************************************************
+                        --- Info / Date / Time ---
+******************************************************************************}
 
-      type
+function dosversion : word;
-         lr = record
+begin
-            lo,hi : word;
+  dosversion:=GetVersion;
-         end;
+end;
 
-      var
-         dostime : longint;
-         ft,lft : FILETIME;
 
-      begin
+procedure getdate(var year,month,mday,wday : word);
-         if GetFileTime(filerec(f).handle,nil,nil,@ft) and
+var
-           FileTimeToLocalFileTime(ft,lft) and
-           FileTimeToDosDateTime(lft,lr(time).hi,lr(time).lo) then
-           exit
-         else
-           time:=0;
-      end;
-
-   procedure setftime(var f;time : longint);
-
-      begin
-         {!!!!}
-      end;
-
-    var
-       lastdosexitcode : word;
-
-    procedure exec(const path : pathstr;const comline : comstr);
-
-      procedure do_system(p : pchar);
-
-        begin
-           {!!!!!}
-        end;
-
-      var
-         i : longint;
-         execute : string;
-         b : array[0..255] of char;
-
-      begin
-         doserror:=0;
-         execute:=path+' '+comline;
-         { allow slash as backslash for the program name only }
-         for i:=1 to length(path) do
-           if execute[i]='/' then execute[i]:='\';
-         move(execute[1],b,length(execute));
-         b[length(execute)]:=#0;
-         do_system(b);
-      end;
-
-    function dosexitcode : word;
-
-      begin
-         dosexitcode:=lastdosexitcode;
-      end;
-
-    function dosversion : word;
-
-      begin
-         dosversion:=lo(GetVersion);
-      end;
-
-    procedure getdate(var year,month,day,dayofweek : word);
-
-      var
   t : SYSTEMTIME;
-
+begin
-      begin
   GetLocalTime(t);
   year:=t.wYear;
   month:=t.wMonth;
-         day:=t.wDay;
+  mday:=t.wDay;
-         dayofweek:=t.wDayOfWeek;
+  wday:=t.wDayOfWeek;
-      end;
+end;
 
-    procedure setdate(year,month,day : word);
 
-      var
+procedure setdate(year,month,day : word);
+var
   t : SYSTEMTIME;
-
+begin
-      begin
   { we need the time set privilege   }
   { so this function crash currently }
   {!!!!!}
@@ -267,80 +192,125 @@ unit dos;
   t.wDay:=day;
   { only a quite good solution, we can loose some ms }
   SetLocalTime(t);
-      end;
+end;
 
-    procedure gettime(var hour,minute,second,sec100 : word);
 
-      var
+procedure gettime(var hour,minute,second,sec100 : word);
+var
   t : SYSTEMTIME;
-
+begin
-      begin
    GetLocalTime(t);
    hour:=t.wHour;
    minute:=t.wMinute;
    second:=t.wSecond;
    sec100:=t.wMilliSeconds div 10;
-      end;
+end;
 
-    procedure settime(hour,minute,second,sec100 : word);
 
-      var
+procedure settime(hour,minute,second,sec100 : word);
+var
    t : SYSTEMTIME;
-
+begin
-      begin
    { we need the time set privilege   }
    { so this function crash currently }
    {!!!!!}
-
    GetLocalTime(t);
    t.wHour:=hour;
    t.wMinute:=minute;
    t.wSecond:=second;
    t.wMilliSeconds:=sec100*10;
    SetLocalTime(t);
-      end;
+end;
 
-    procedure getcbreak(var breakvalue : boolean);
 
+Procedure packtime(var t : datetime;var p : longint);
+Begin
+  p:=(t.sec shr 1)+(t.min shl 5)+(t.hour shl 11)+(t.day shl 16)+(t.month shl 21)+((t.year-1980) shl 25);
+End;
+
+
+Procedure unpacktime(p : longint;var t : datetime);
+Begin
+  with t do
    begin
-         {!!!!}
+     sec:=(p and 31) shl 1;
+     min:=(p shr 5) and 63;
+     hour:=(p shr 11) and 31;
+     day:=(p shr 16) and 31;
+     month:=(p shr 21) and 15;
+     year:=(p shr 25)+1980;
    end;
+End;
 
-    procedure setcbreak(breakvalue : boolean);
 
-      begin
+{******************************************************************************
-         {!!!!}
+                               --- Exec ---
-      end;
+******************************************************************************}
 
-    procedure getverify(var verify : boolean);
+var
+  lastdosexitcode : word;
 
-      begin
+procedure exec(const path : pathstr;const comline : comstr);
-         {!!!!}
+begin
-      end;
+  { !!!!!!!! }
+end;
 
-    procedure setverify(verify : boolean);
 
-      begin
+function dosexitcode : word;
-         {!!!!}
+begin
-      end;
+  dosexitcode:=lastdosexitcode;
+end;
 
-    function diskfree(drive : byte) : longint;
 
-      begin
+procedure getcbreak(var breakvalue : boolean);
-         {!!!!}
+begin
-      end;
+{ !! No Win32 Function !! }
+end;
 
-    function disksize(drive : byte) : longint;
 
-      begin
+procedure setcbreak(breakvalue : boolean);
-         {!!!!}
+begin
-      end;
+{ !! No Win32 Function !! }
+end;
+
+
+procedure getverify(var verify : boolean);
+begin
+{ !! No Win32 Function !! }
+end;
+
+
+procedure setverify(verify : boolean);
+begin
+{ !! No Win32 Function !! }
+end;
+
+
+{******************************************************************************
+                               --- Disk ---
+******************************************************************************}
+
+function diskfree(drive : byte) : longint;
+begin
+{ !!!!!!!!! }
+  diskfree:=-1;
+end;
+
+
+function disksize(drive : byte) : longint;
+begin
+{ !!!!!!!!! }
+  disksize:=-1;
+end;
+
+
+{******************************************************************************
+                         --- Findfirst FindNext ---
+******************************************************************************}
 
     procedure searchrec2dossearchrec(var f : searchrec);
-
       var
          l,i : longint;
-
       begin
          l:=length(f.name);
          for i:=1 to 12 do
@@ -349,10 +319,8 @@ unit dos;
       end;
 
     procedure dossearchrec2searchrec(var f : searchrec);
-
       var
          l,i : longint;
-
       begin
          l:=12;
          for i:=0 to 12 do
@@ -369,19 +337,12 @@ unit dos;
     procedure findfirst(const path : pathstr;attr : word;var f : searchRec);
 
       procedure _findfirst(path : pchar;attr : word;var f : searchrec);
-
-        var
-           i : longint;
         begin
-           { allow slash as backslash }
+          {!!!!!!!!!!!!!!}
-           for i:=0 to strlen(path) do
-             if path[i]='/' then path[i]:='\';
-           {!!!!!!!}
         end;
 
       var
          path0 : array[0..80] of char;
-
       begin
          { no error }
          doserror:=0;
@@ -393,9 +354,8 @@ unit dos;
     procedure findnext(var f : searchRec);
 
       procedure _findnext(var f : searchrec);
-
         begin
-           {!!!!}
+          {!!!!!!!!!!!!!!}
         end;
 
       begin
@@ -407,92 +367,22 @@ unit dos;
       end;
 
     procedure swapvectors;
-
       begin
-         { only a dummy }
       end;
 
-    { the environment is a block of zero terminated strings }
-    { terminated by a #0                                    }
-    function envcount : longint;
-
-      var
-         hp,p : pchar;
 
+    Procedure FindClose(Var f: SearchRec);
       begin
-         p:=GetEnvironmentStrings;
-         hp:=p;
-         envcount:=0;
-         while  hp^<>#0 do
-           begin
-              { next string entry}
-              hp:=hp+strlen(hp)+1;
-              inc(envcount);
-           end;
-         FreeEnvironmentStrings(p);
       end;
 
-    function envstr(index : longint) : string;
+{******************************************************************************
+                               --- File ---
+******************************************************************************}
 
-      var
+procedure fsplit(path : pathstr;var dir : dirstr;var name : namestr;var ext : extstr);
-         hp,p : pchar;
+var
-         count,i : longint;
+   p1,i : longint;
-
+begin
-
-      begin
-         { envcount takes some time in win32 }
-         count:=envcount;
-
-         { range checking }
-         if (index<=0) or (index>count) then
-           begin
-              envstr:='';
-              exit;
-           end;
-         p:=GetEnvironmentStrings;
-         hp:=p;
-
-         { retrive the string with the given index }
-         for i:=2 to index do
-           hp:=hp+strlen(hp)+1;
-
-         envstr:=strpas(hp);
-         FreeEnvironmentStrings(p);
-      end;
-
-    function getenv(const envvar : string) : string;
-
-      var
-         s : string;
-         i : longint;
-         hp,p : pchar;
-
-      begin
-         getenv:='';
-         p:=GetEnvironmentStrings;
-         hp:=p;
-         while hp^<>#0 do
-           begin
-              s:=strpas(hp);
-              i:=pos('=',s);
-              if copy(s,1,i-1)=envvar then
-                begin
-                   getenv:=copy(s,i+1,length(s)-i);
-                   break;
-                end;
-              { next string entry}
-              hp:=hp+strlen(hp)+1;
-           end;
-         FreeEnvironmentStrings(p);
-      end;
-
-    procedure fsplit(path : pathstr;var dir : dirstr;var name : namestr;
-      var ext : extstr);
-
-      var
-         p1 : byte;
-         i : longint;
-      begin
    { allow slash as backslash }
    for i:=1 to length(path) do
     if path[i]='/' then path[i]:='\';
@@ -525,23 +415,21 @@ unit dos;
    else
      ext:='';
    name:=path;
-      end;
+end;
 
-    function fexpand(const path : pathstr) : pathstr;
 
-       var
+function fexpand(const path : pathstr) : pathstr;
+var
   s,pa : string[79];
-          i,j : byte;
+  i,j  : longint;
-
+begin
-       begin
-          { There are differences between Free Pascal and Turbo Pascal
-            e.g. for the string 'D:\DEMO\..\HELLO' which isn't handled }
    getdir(0,s);
    pa:=upcase(path);
    { allow slash as backslash }
    for i:=1 to length(pa) do
-             if pa[i]='/' then pa[i]:='\';
+    if pa[i]='/' then
-          if (ord(pa[0])>1) and (((pa[1]>='A') and (pa[1]<='Z')) and (pa[2]=':')) then
+     pa[i]:='\';
+   if (length(pa)>1) and (pa[1] in ['A'..'Z']) and (pa[2]=':') then
      begin
         { we must get the right directory }
         getdir(ord(pa[1])-ord('A')+1,s);
@@ -564,10 +452,13 @@ unit dos;
  {Now remove also all references to '\..\' + of course previous dirs..}
    repeat
      i:=pos('\..\',pa);
+     if i<>0 then
+      begin
         j:=i-1;
         while (j>1) and (pa[j]<>'\') do
          dec (j);
         delete (pa,j,i-j+3);
+      end;
    until i=0;
  {Remove End . and \}
    if (length(pa)>0) and (pa[length(pa)]='.') then
@@ -575,70 +466,194 @@ unit dos;
    if (length(pa)>0) and (pa[length(pa)]='\') then
     dec(byte(pa[0]));
    fexpand:=pa;
-       end;
+end;
 
-     procedure packtime(var d : datetime;var time : longint);
-
-       var
-          zs : longint;
 
+Function FSearch(path: pathstr; dirlist: string): pathstr;
+var
+   i,p1   : longint;
+   s      : searchrec;
+   newdir : pathstr;
+begin
+{ No wildcards allowed in these things }
+   if (pos('?',path)<>0) or (pos('*',path)<>0) then
+     fsearch:=''
+   else
      begin
-          time:=-1980;
+        { allow slash as backslash }
-          time:=time+d.year and 127;
+        for i:=1 to length(dirlist) do
-          time:=time shl 4;
+          if dirlist[i]='/' then dirlist[i]:='\';
-          time:=time+d.month;
+        repeat
-          time:=time shl 5;
+          p1:=pos(';',dirlist);
-          time:=time+d.day;
+          if p1=0 then
-          time:=time shl 16;
-          zs:=d.hour;
-          zs:=zs shl 6;
-          zs:=zs+d.min;
-          zs:=zs shl 5;
-          zs:=zs+d.sec div 2;
-          time:=time+(zs and $ffff);
-       end;
-
-     procedure unpacktime (time: longint;var d : datetime);
-
            begin
-          d.sec:=(time and 31) * 2;
+             newdir:=copy(dirlist,1,p1-1);
-          time:=time shr 5;
+             delete(dirlist,1,p1);
-          d.min:=time and 63;
+           end
-          time:=time shr 6;
+          else
-          d.hour:=time and 31;
+           begin
-          time:=time shr 5;
+             newdir:=dirlist;
-          d.day:=time and 31;
+             dirlist:='';
-          time:=time shr 5;
-          d.month:=time and 15;
-          time:=time shr 4;
-          d.year:=time + 1980;
            end;
+          if (newdir<>'') and (not (newdir[length(newdir)] in ['\',':'])) then
+           newdir:=newdir+'\';
+          findfirst(newdir+path,anyfile,s);
+          if doserror=0 then
+           newdir:=newdir+path
+          else
+           newdir:='';
+        until (dirlist='') or (newdir<>'');
+        fsearch:=newdir;
+     end;
+end;
 
-    procedure getfattr(var f;var attr : word);
 
-      var
+procedure getftime(var f;var time : longint);
+type
+   lr = record
+      lo,hi : word;
+   end;
+var
+   ft,lft : FILETIME;
+begin
+   if GetFileTime(filerec(f).handle,nil,nil,@ft) and
+      FileTimeToLocalFileTime(ft,lft) and
+      FileTimeToDosDateTime(lft,lr(time).hi,lr(time).lo) then
+     exit
+   else
+     time:=0;
+end;
+
+
+procedure setftime(var f;time : longint);
+begin
+   { !!!!!!!!!!!!! }
+end;
+
+
+procedure getfattr(var f;var attr : word);
+var
    l : longint;
-
+begin
-      begin
   l:=GetFileAttributes(filerec(f).name);
   if l=$ffffffff then
    doserror:=getlasterror;
   attr:=l;
-      end;
+end;
 
-    procedure setfattr(var f;attr : word);
 
-      begin
+procedure setfattr(var f;attr : word);
+begin
   doserror:=0;
   if not(SetFileAttributes(filerec(f).name,attr)) then
     doserror:=getlasterror;
-      end;
+end;
 
-end.
+
+{******************************************************************************
+                             --- Environment ---
+******************************************************************************}
 
+{
+  The environment is a block of zero terminated strings
+  terminated by a #0
+}
+
+function envcount : longint;
+var
+   hp,p : pchar;
+   count : longint;
+begin
+   p:=GetEnvironmentStrings;
+   hp:=p;
+   count:=0;
+   while  hp^<>#0 do
+     begin
+        { next string entry}
+        hp:=hp+strlen(hp)+1;
+        inc(count);
+     end;
+   FreeEnvironmentStrings(p);
+   envcount:=count;
+end;
+
+
+Function  EnvStr(index: integer): string;
+var
+   hp,p : pchar;
+   count,i : longint;
+begin
+   { envcount takes some time in win32 }
+   count:=envcount;
+
+   { range checking }
+   if (index<=0) or (index>count) then
+     begin
+        envstr:='';
+        exit;
+     end;
+   p:=GetEnvironmentStrings;
+   hp:=p;
+
+   { retrive the string with the given index }
+   for i:=2 to index do
+     hp:=hp+strlen(hp)+1;
+
+   envstr:=strpas(hp);
+   FreeEnvironmentStrings(p);
+end;
+
+
+Function  GetEnv(envvar: string): string;
+var
+   s : string;
+   i : longint;
+   hp,p : pchar;
+begin
+   getenv:='';
+   p:=GetEnvironmentStrings;
+   hp:=p;
+   while hp^<>#0 do
+     begin
+        s:=strpas(hp);
+        i:=pos('=',s);
+        if copy(s,1,i-1)=envvar then
+          begin
+             getenv:=copy(s,i+1,length(s)-i);
+             break;
+          end;
+        { next string entry}
+        hp:=hp+strlen(hp)+1;
+     end;
+   FreeEnvironmentStrings(p);
+end;
+
+
+{******************************************************************************
+                             --- Not Supported ---
+******************************************************************************}
+
+Procedure keep(exitcode : word);
+Begin
+End;
+
+Procedure getintvec(intno : byte;var vector : pointer);
+Begin
+End;
+
+Procedure setintvec(intno : byte;vector : pointer);
+Begin
+End;
+
+
+end.
 {
   $Log$
-  Revision 1.5  1998-05-06 12:36:50  michael
+  Revision 1.6  1998-06-08 23:07:45  peter
+    * dos interface is now 100% compatible
+    * fixed call PASCALMAIN which must be direct asm
+
+  Revision 1.5  1998/05/06 12:36:50  michael
   + Removed log from before restored version.
 
   Revision 1.4  1998/04/27 14:01:38  florian
@@ -649,7 +664,4 @@ end.
 
   Revision 1.2  1998/04/26 21:49:09  florian
     + first compiling and working version
-
-  Revision 1.1.1.1  1998/03/25 11:18:47  root
-  * Restored version
 }

rtl/win32/syswin32.pp

@@ -468,8 +468,9 @@ procedure getdir(drivenr:byte;var dir:string);
                          SystemUnit Initialization
 *****************************************************************************}
 
-procedure Entry;[public,alias: '_mainCRTStartup'];
+{$ASMMODE DIRECT}
 
+procedure Entry;[public,alias: '_mainCRTStartup'];
 begin
    { call to the pascal main }
    asm
@@ -479,6 +480,8 @@ begin
    ExitProcess(0);
 end;
 
+{$ASMMODE ATT}
+
 
 procedure OpenStdIO(var f:text;mode:word;hdl:longint);
 begin
@@ -543,7 +546,11 @@ end.
 
 {
   $Log$
-  Revision 1.7  1998-05-06 12:36:51  michael
+  Revision 1.8  1998-06-08 23:07:47  peter
+    * dos interface is now 100% compatible
+    * fixed call PASCALMAIN which must be direct asm
+
+  Revision 1.7  1998/05/06 12:36:51  michael
   + Removed log from before restored version.
 
   Revision 1.6  1998/04/27 18:29:09  florian