* go32v1, go32v2 recompiles with the new objects

  * remake3 works again with go32v2
  - removed some "optimizes" from daniel which were wrong

rtl/dos/dos.pp

@@ -3,6 +3,8 @@
     This file is part of the Free Pascal run time library.
     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.
 
@@ -68,9 +70,7 @@ Type
 {$i filerec.inc}
 {$i textrec.inc}
 
-{$PACKRECORDS 1}
-
-  DateTime = record
+  DateTime = packed record
     Year,
     Month,
     Day,
@@ -79,8 +79,9 @@ Type
     Sec   : word;
   End;
 
-{$IFDEF GO32V2}
-  searchrec = record
+{$ifdef GO32V2}
+
+  searchrec = packed record
      fill : array[1..21] of byte;
      attr : byte;
      time : longint;
@@ -92,7 +93,8 @@ Type
   Registers = Go32.Registers;
 
 {$ELSE}
-  searchrec = record
+
+  searchrec = packed record
      fill     : array[1..21] of byte;
      attr     : byte;
      time     : longint;
@@ -101,7 +103,7 @@ Type
      name     : string[15]; { the same size as declared by (DJ GNU C) }
   end;
 
-  registers = record
+  registers = packed record
     case i : integer of
      0 : (ax,f1,bx,f2,cx,f3,dx,f4,bp,f5,si,f51,di,f6,ds,f7,es,f8,flags,fs,gs : word);
      1 : (al,ah,f9,f10,bl,bh,f11,f12,cl,ch,f13,f14,dl,dh : byte);
@@ -109,8 +111,6 @@ Type
     end;
 {$endif GO32V1}
 
-{$PACKRECORDS 2}
-
 Var
   DosError : integer;
 
@@ -249,95 +249,99 @@ var
       end;
 {$endif GO32V2}
 
-    procedure msdos(var regs : registers);
-      begin
-         intr($21,regs);
-      end;
+procedure msdos(var regs : registers);
+begin
+  intr($21,regs);
+end;
+
 
 {******************************************************************************
                         --- Info / Date / Time ---
 ******************************************************************************}
 
-    function dosversion : word;
-      begin
-         dosregs.ax:=$3000;
-         msdos(dosregs);
-         dosversion:=dosregs.ax;
-      end;
-
-    procedure getdate(var year,month,mday,wday : word);
-      begin
-         dosregs.ax:=$2a00;
-         msdos(dosregs);
-         wday:=dosregs.al;
-         year:=dosregs.cx;
-         month:=dosregs.dh;
-         mday:=dosregs.dl;
-      end;
-
-    procedure setdate(year,month,day : word);
-      begin
-         dosregs.cx:=year;
-         dosregs.dh:=month;
-         dosregs.dl:=day;
-         dosregs.ah:=$2b;
-         msdos(dosregs);
-         LoadDosError;
-      end;
+function dosversion : word;
+begin
+  dosregs.ax:=$3000;
+  msdos(dosregs);
+  dosversion:=dosregs.ax;
+end;
+
+
+procedure getdate(var year,month,mday,wday : word);
+begin
+  dosregs.ax:=$2a00;
+  msdos(dosregs);
+  wday:=dosregs.al;
+  year:=dosregs.cx;
+  month:=dosregs.dh;
+  mday:=dosregs.dl;
+end;
+
+
+procedure setdate(year,month,day : word);
+begin
+   dosregs.cx:=year;
+   dosregs.dh:=month;
+   dosregs.dl:=day;
+   dosregs.ah:=$2b;
+   msdos(dosregs);
+   LoadDosError;
+end;
+
+
+procedure gettime(var hour,minute,second,sec100 : word);
+begin
+  dosregs.ah:=$2c;
+  msdos(dosregs);
+  hour:=dosregs.ch;
+  minute:=dosregs.cl;
+  second:=dosregs.dh;
+  sec100:=dosregs.dl;
+end;
+
+
+procedure settime(hour,minute,second,sec100 : word);
+begin
+  dosregs.ch:=hour;
+  dosregs.cl:=minute;
+  dosregs.dh:=second;
+  dosregs.dl:=sec100;
+  dosregs.ah:=$2d;
+  msdos(dosregs);
+  LoadDosError;
+end;
+
+
+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 gettime(var hour,minute,second,sec100 : word);
-      begin
-         dosregs.ah:=$2c;
-         msdos(dosregs);
-         hour:=dosregs.ch;
-         minute:=dosregs.cl;
-         second:=dosregs.dh;
-         sec100:=dosregs.dl;
-      end;
 
-    procedure settime(hour,minute,second,sec100 : word);
-      begin
-         dosregs.ch:=hour;
-         dosregs.cl:=minute;
-         dosregs.dh:=second;
-         dosregs.dl:=sec100;
-         dosregs.ah:=$2d;
-         msdos(dosregs);
-         LoadDosError;
-      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 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
-         t.sec:=(p and 31) shl 1;
-         t.min:=(p shr 5) and 63;
-         t.hour:=(p shr 11) and 31;
-         t.day:=(p shr 16) and 31;
-         t.month:=(p shr 21) and 15;
-         t.year:=(p shr 25)+1980;
-       End;
 
 {******************************************************************************
                                --- Exec ---
 ******************************************************************************}
 
-    var
-       lastdosexitcode : word;
+var
+  lastdosexitcode : word;
 
 {$ifdef GO32V2}
 
-    { this code is just the most basic part of dosexec.c from
-    the djgpp code }
-
-    procedure exec(const path : pathstr;const comline : comstr);
-
-      procedure do_system(p,c : string);
-
-      {
+{
         Table 0931
         Format of EXEC parameter block for AL=00h,01h,04h:
         Offset  Size    Description
@@ -350,222 +354,224 @@ var
          0Eh    DWORD   (AL=01h) will hold subprogram's initial SS:SP on return
          12h    DWORD   (AL=01h) will hold entry point (CS:IP) on return
         INT 21 4B--
-      }
+}
 
-      type
-         realptr = record
-            ofs,seg : word;
-         end;
+procedure exec(const path : pathstr;const comline : comstr);
+type
+  realptr = packed record
+    ofs,seg : word;
+  end;
+  texecblock = packed record
+    envseg    : word;
+    comtail   : realptr;
+    firstFCB  : realptr;
+    secondFCB : realptr;
+    iniStack  : realptr;
+    iniCSIP   : realptr;
+  end;
+var
+  current_dos_buffer_pos,
+  arg_ofs,
+  i,la_env,
+  la_p,la_c,la_e,
+  fcb1_la,fcb2_la : longint;
+  execblock       : texecblock;
+  c,p             : string;
+
+  function paste_to_dos(src : string) : boolean;
+  var
+    c : array[0..255] of char;
+  begin
+     paste_to_dos:=false;
+     if current_dos_buffer_pos+length(src)+1>transfer_buffer+tb_size then
+      RunError(217);
+     move(src[1],c[0],length(src));
+     c[length(src)]:=#0;
+     seg_move(get_ds,longint(@c),dosmemselector,current_dos_buffer_pos,length(src)+1);
+     current_dos_buffer_pos:=current_dos_buffer_pos+length(src)+1;
+     paste_to_dos:=true;
+  end;
 
-         texecblock = record
-            envseg : word;
-            comtail : realptr;
-            firstFCB : realptr;
-            secondFCB : realptr;
-            iniStack : realptr;
-            iniCSIP : realptr;
-         end;
+begin
+{ create command line }
+  move(comline[0],c[1],length(comline)+1);
+  c[length(comline)+2]:=#13;
+  c[0]:=char(length(comline)+2);
+{ create path }
+  p:=path;
+  for i:=1 to length(p) do
+   if p[i]='/' then
+    p[i]:='\';
+{ create buffer }
+  la_env:=transfer_buffer;
+  while (la_env and 15)<>0 do
+   inc(la_env);
+  current_dos_buffer_pos:=la_env;
+{ copy environment }
+  for i:=1 to envcount do
+   paste_to_dos(envstr(i));
+  paste_to_dos(''); { adds a double zero at the end }
+{ allow slash as backslash }
+  la_p:=current_dos_buffer_pos;
+  paste_to_dos(p);
+  la_c:=current_dos_buffer_pos;
+  paste_to_dos(c);
+  la_e:=current_dos_buffer_pos;
+  fcb1_la:=la_e;
+  la_e:=la_e+16;
+  fcb2_la:=la_e;
+  la_e:=la_e+16;
+{ allocate FCB see dosexec code }
+  arg_ofs:=1;
+  while (c[arg_ofs] in [' ',#9]) do
+   inc(arg_ofs);
+  dosregs.ax:=$2901;
+  dosregs.ds:=(la_c+arg_ofs) shr 4;
+  dosregs.esi:=(la_c+arg_ofs) and 15;
+  dosregs.es:=fcb1_la shr 4;
+  dosregs.edi:=fcb1_la and 15;
+  msdos(dosregs);
+{ allocate second FCB see dosexec code }
+  repeat
+    inc(arg_ofs);
+  until (c[arg_ofs] in [' ',#9,#13]);
+  if c[arg_ofs]<>#13 then
+   begin
+     repeat
+       inc(arg_ofs);
+     until not (c[arg_ofs] in [' ',#9]);
+   end;
+  dosregs.ax:=$2901;
+  dosregs.ds:=(la_c+arg_ofs) shr 4;
+  dosregs.si:=(la_c+arg_ofs) and 15;
+  dosregs.es:=fcb2_la shr 4;
+  dosregs.di:=fcb2_la and 15;
+  msdos(dosregs);
+  with execblock do
+   begin
+     envseg:=la_env shr 4;
+     comtail.seg:=la_c shr 4;
+     comtail.ofs:=la_c and 15;
+     firstFCB.seg:=fcb1_la shr 4;
+     firstFCB.ofs:=fcb1_la and 15;
+     secondFCB.seg:=fcb2_la shr 4;
+     secondFCB.ofs:=fcb2_la and 15;
+   end;
+  seg_move(get_ds,longint(@execblock),dosmemselector,la_e,sizeof(texecblock));
+  dosregs.edx:=la_p and 15;
+  dosregs.ds:=la_p shr 4;
+  dosregs.ebx:=la_e and 15;
+  dosregs.es:=la_e shr 4;
+  dosregs.ax:=$4b00;
+  msdos(dosregs);
+  LoadDosError;
+  if DosError=0 then
+   begin
+     dosregs.ax:=$4d00;
+     msdos(dosregs);
+     LastDosExitCode:=DosRegs.al
+   end
+  else
+   LastDosExitCode:=0;
+end;
 
-      var current_dos_buffer_pos : longint;
-      function paste_to_dos(src : string) : boolean;
-        var c : array[0..255] of char;
-        begin
-           paste_to_dos:=false;
-           if current_dos_buffer_pos+length(src)+1>transfer_buffer+tb_size then
-            RunError(217);
-           move(src[1],c[0],length(src));
-           c[length(src)]:=#0;
-           seg_move(get_ds,longint(@c),dosmemselector,current_dos_buffer_pos,length(src)+1);
-           current_dos_buffer_pos:=current_dos_buffer_pos+length(src)+1;
-           paste_to_dos:=true;
-        end;
-      var
-         i,la_env,la_p,la_c,la_e,fcb1_la,fcb2_la : longint;
-         arg_ofs : longint;
-              execblock : texecblock;
+{$else GO32V2}
 
-      begin
-         la_env:=transfer_buffer;
-         while (la_env mod 16)<>0 do inc(la_env);
-         current_dos_buffer_pos:=la_env;
-         for i:=1 to envcount do
-           begin
-              paste_to_dos(envstr(i));
-           end;
-         paste_to_dos(''); { adds a double zero at the end }
-         { allow slash as backslash }
-         for i:=1 to length(p) do
-           if p[i]='/' then p[i]:='\';
-         la_p:=current_dos_buffer_pos;
-         paste_to_dos(p);
-         la_c:=current_dos_buffer_pos;
-         paste_to_dos(c);
-              la_e:=current_dos_buffer_pos;
-         fcb1_la:=la_e;
-         la_e:=la_e+16;
-         fcb2_la:=la_e;
-         la_e:=la_e+16;
-         { allocate FCB see dosexec code }
-         dosregs.ax:=$2901;
-         arg_ofs:=1;
-         while (c[arg_ofs]=' ') or (c[arg_ofs]=#9) do inc(arg_ofs);
-         dosregs.ds:=(la_c+arg_ofs) div 16;
-         dosregs.si:=(la_c+arg_ofs) mod 16;
-         dosregs.es:=fcb1_la div 16;
-         dosregs.di:=fcb1_la mod 16;
-         msdos(dosregs);
-         repeat
-            inc(arg_ofs);
-         until (c[arg_ofs]=' ') or
-               (c[arg_ofs]=#9) or
-               (c[arg_ofs]=#13);
-         if c[arg_ofs]<>#13 then
-           begin
-              inc(arg_ofs);
-              while (c[arg_ofs]=' ') or (c[arg_ofs]=#9) do inc(arg_ofs);
-           end;
-         { allocate second FCB see dosexec code }
-         dosregs.ax:=$2901;
-         dosregs.ds:=(la_c+arg_ofs) div 16;
-         dosregs.si:=(la_c+arg_ofs) mod 16;
-         dosregs.es:=fcb2_la div 16;
-         dosregs.di:=fcb2_la mod 16;
-         msdos(dosregs);
-           with execblock do
-          begin
-             envseg:=la_env div 16;
-             comtail.seg:=la_c div 16;
-             comtail.ofs:=la_c mod 16;
-             firstFCB.seg:=fcb1_la div 16;
-             firstFCB.ofs:=fcb1_la mod 16;
-             secondFCB.seg:=fcb2_la div 16;
-             secondFCB.ofs:=fcb2_la mod 16;
-          end;
-        seg_move(get_ds,longint(@execblock),dosmemselector,la_e,sizeof(texecblock));
-         dosregs.edx:=la_p mod 16;
-         dosregs.ds:=la_p div 16;
-         dosregs.ebx:=la_e mod 16;
-         dosregs.es:=la_e div 16;
-         dosregs.ax:=$4b00;
-         msdos(dosregs);
-         LoadDosError;
-         if DosError=0 then
-          begin
-            dosregs.ax:=$4d00;
-            msdos(dosregs);
-            LastDosExitCode:=DosRegs.al
-          end
-         else
-          LastDosExitCode:=0;
-        end;
+procedure exec(const path : pathstr;const comline : comstr);
+var
+  i : longint;
+  b : array[0..255] of char;
+begin
+  doserror:=0;
+  for i:=1to length(path) do
+   if path[i]='/' then
+    b[i-1]:='\'
+   else
+    b[i-1]:=path[i];
+  b[i]:=' ';
+  inc(i);
+  move(comline[1],b[i],length(comline));
+  inc(i,length(comline));
+  b[i]:=#0;
+  asm
+        leal    b,%ebx
+        movw    $0xff07,%ax
+        int     $0x21
+        movw    %ax,_LASTDOSEXITCODE
+  end;
+end;
 
-      { var
-         p,c : array[0..255] of char; }
-        var  c : string;
-      begin
-         doserror:=0;
-         { move(path[1],p,length(path));
-         p[length(path)]:=#0; }
-         move(comline[0],c[1],length(comline)+1);
-         c[length(comline)+2]:=#13;
-         c[0]:=char(length(comline)+2);
-         do_system(path,c);
-      end;
+{$endif}
 
-{$else GO32V2}
 
-    procedure exec(const path : pathstr;const comline : comstr);
+function dosexitcode : word;
+begin
+  dosexitcode:=lastdosexitcode;
+end;
 
-      procedure do_system(p : pchar);
-        begin
-           asm
-              movl 12(%ebp),%ebx
-              movw $0xff07,%ax
-              int $0x21
-              movw %ax,_LASTDOSEXITCODE
-           end;
-        end;
 
-      var
-         i : longint;
-         execute : string;
-         b : array[0..255] of char;
+procedure getcbreak(var breakvalue : boolean);
+begin
+  dosregs.ax:=$3300;
+  msdos(dosregs);
+  breakvalue:=dosregs.dl<>0;
+end;
 
-      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;
 
-{$endif GO32V2}
+procedure setcbreak(breakvalue : boolean);
+begin
+  dosregs.ax:=$3301;
+  dosregs.dl:=ord(breakvalue);
+  msdos(dosregs);
+end;
 
-    function dosexitcode : word;
-      begin
-         dosexitcode:=lastdosexitcode;
-      end;
 
-    procedure getcbreak(var breakvalue : boolean);
-      begin
-         dosregs.ax:=$3300;
-         msdos(dosregs);
-         breakvalue:=dosregs.dl<>0;
-      end;
+procedure getverify(var verify : boolean);
+begin
+  dosregs.ah:=$54;
+  msdos(dosregs);
+  verify:=dosregs.al<>0;
+end;
 
-    procedure setcbreak(breakvalue : boolean);
-      begin
-         dosregs.ax:=$3301;
-         dosregs.dl:=ord(breakvalue);
-         msdos(dosregs);
-      end;
 
-    procedure getverify(var verify : boolean);
-      begin
-         dosregs.ah:=$54;
-         msdos(dosregs);
-         verify:=dosregs.al<>0;
-      end;
+procedure setverify(verify : boolean);
+begin
+  dosregs.ah:=$2e;
+  dosregs.al:=ord(verify);
+  msdos(dosregs);
+end;
 
-    procedure setverify(verify : boolean);
-      begin
-         dosregs.ah:=$2e;
-         dosregs.al:=ord(verify);
-         msdos(dosregs);
-      end;
 
 {******************************************************************************
                                --- Disk ---
 ******************************************************************************}
 
-    function diskfree(drive : byte) : longint;
-      begin
-         dosregs.dl:=drive;
-         dosregs.ah:=$36;
-         msdos(dosregs);
-         if dosregs.ax<>$FFFF then
-          diskfree:=dosregs.ax*dosregs.bx*dosregs.cx
-         else
-          diskfree:=-1;
-      end;
+function diskfree(drive : byte) : longint;
+begin
+  dosregs.dl:=drive;
+  dosregs.ah:=$36;
+  msdos(dosregs);
+  if dosregs.ax<>$FFFF then
+   diskfree:=dosregs.ax*dosregs.bx*dosregs.cx
+  else
+   diskfree:=-1;
+end;
+
+
+function disksize(drive : byte) : longint;
+begin
+  dosregs.dl:=drive;
+  dosregs.ah:=$36;
+  msdos(dosregs);
+  if dosregs.ax<>$FFFF then
+   disksize:=dosregs.ax*dosregs.cx*dosregs.dx
+  else
+   disksize:=-1;
+end;
 
-    function disksize(drive : byte) : longint;
-
-      begin
-         dosregs.dl:=drive;
-         dosregs.ah:=$36;
-         msdos(dosregs);
-         if dosregs.ax<>$FFFF then
-          disksize:=dosregs.ax*dosregs.cx*dosregs.dx
-         else
-          disksize:=-1;
-      end;
 
 {******************************************************************************
-                       --- Findfirst FindNext ---
+                         --- Findfirst FindNext ---
 ******************************************************************************}
 
     procedure searchrec2dossearchrec(var f : searchrec);
@@ -814,10 +820,13 @@ var
         {Now remove also all references to '\..\' + of course previous dirs..}
           repeat
             i:=pos('\..\',pa);
-            if i<>0 then j:=i-1;
-            while (j>1) and (pa[j]<>'\') do
-             dec (j);
-            delete (pa,j,i-j+3);
+            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
@@ -866,8 +875,6 @@ var
            end;
       end;
 
-{$ifdef GO32V2}
-
     procedure getftime(var f;var time : longint);
       begin
          dosregs.bx:=textrec(f).handle;
@@ -887,109 +894,100 @@ var
          doserror:=dosregs.al;
       end;
 
-    procedure getfattr(var f;var attr : word);
-      begin
-         copytodos(filerec(f).name,strlen(filerec(f).name)+1);
-         dosregs.ax:=$4300;
-         dosregs.edx:=transfer_buffer and 15;
-         dosregs.ds:=transfer_buffer shr 4;
-         msdos(dosregs);
-         LoadDosError;
-         Attr:=dosregs.cx;
-      end;
-
-    procedure setfattr(var f;attr : word);
-      begin
-         copytodos(filerec(f).name,strlen(filerec(f).name)+1);
-         dosregs.ax:=$4301;
-         dosregs.edx:=transfer_buffer mod 16;
-         dosregs.ds:=transfer_buffer div 16;
-         dosregs.cx:=attr;
-         msdos(dosregs);
-         LoadDosError;
-      end;
-
-{$else GO32V2}
-
-    procedure getfattr(var f;var attr : word);
-      var
-         n : array[0..255] of char;
-         r : registers;
-      begin
-         strpcopy(n,filerec(f).name);
-         dosregs.ax:=$4300;
-         dosregs.edx:=longint(@n);
-         msdos(dosregs);
-         LoadDosError;
-         attr:=dosregs.cx;
-      end;
-
-    procedure setfattr(var f;attr : word);
-      var
-         n : array[0..255] of char;
-         r : registers;
-      begin
-         strpcopy(n,filerec(f).name);
-         dosregs.ax:=$4301;
-         dosregs.edx:=longint(@n);
-         dosregs.cx:=attr;
-         msdos(dosregs);
-         LoadDosError;
-      end;
 
-{$endif GO32V2}
+procedure getfattr(var f;var attr : word);
+{$ifndef GO32V2}
+var
+  n : array[0..255] of char;
+{$endif}
+begin
+{$ifdef GO32V2}
+  copytodos(filerec(f).name,strlen(filerec(f).name)+1);
+  dosregs.edx:=transfer_buffer and 15;
+  dosregs.ds:=transfer_buffer shr 4;
+{$else}
+  strpcopy(n,filerec(f).name);
+  dosregs.edx:=longint(@n);
+{$endif}
+  dosregs.ax:=$4300;
+  msdos(dosregs);
+  LoadDosError;
+  Attr:=dosregs.cx;
+end;
+
+
+procedure setfattr(var f;attr : word);
+{$ifndef GO32V2}
+var
+  n : array[0..255] of char;
+{$endif}
+begin
+{$ifdef GO32V2}
+  copytodos(filerec(f).name,strlen(filerec(f).name)+1);
+  dosregs.edx:=transfer_buffer mod 16;
+  dosregs.ds:=transfer_buffer div 16;
+{$else}
+  strpcopy(n,filerec(f).name);
+  dosregs.edx:=longint(@n);
+{$endif}
+  dosregs.ax:=$4301;
+  dosregs.cx:=attr;
+  msdos(dosregs);
+  LoadDosError;
+end;
 
 
 {******************************************************************************
                              --- Environment ---
 ******************************************************************************}
 
-    function envcount : longint;
-    var
-      hp : ppchar;
-    begin
-      hp:=envp;
-      envcount:=0;
-      while assigned(hp^) do
-       begin
-         inc(envcount);
-         hp:=hp+4;
-       end;
-    end;
-
+function envcount : longint;
+var
+  hp : ppchar;
+begin
+  hp:=envp;
+  envcount:=0;
+  while assigned(hp^) do
+   begin
+     inc(envcount);
+     hp:=hp+4;
+   end;
+end;
+
+
+function envstr(index : integer) : string;
+begin
+  if (index<=0) or (index>envcount) then
+   begin
+     envstr:='';
+     exit;
+   end;
+  envstr:=strpas(ppchar(envp+4*(index-1))^);
+end;
 
-    function envstr(index : integer) : string;
-    begin
-      if (index<=0) or (index>envcount) then
-       begin
-         envstr:='';
-         exit;
-       end;
-      envstr:=strpas(ppchar(envp+4*(index-1))^);
-    end;
 
+Function  GetEnv(envvar: string): string;
+var
+  hp      : ppchar;
+  hs    : string;
+  eqpos : longint;
+begin
+  envvar:=upcase(envvar);
+  hp:=envp;
+  getenv:='';
+  while assigned(hp^) do
+   begin
+     hs:=strpas(hp^);
+     eqpos:=pos('=',hs);
+     if copy(hs,1,eqpos-1)=envvar then
+      begin
+        getenv:=copy(hs,eqpos+1,255);
+        exit;
+      end;
+     hp:=hp+4;
+   end;
+end;
 
-    Function  GetEnv(envvar: string): string;
-    var
-      hp      : ppchar;
-      hs    : string;
-      eqpos : longint;
-    begin
-      envvar:=upcase(envvar);
-      hp:=envp;
-      getenv:='';
-      while assigned(hp^) do
-       begin
-         hs:=strpas(hp^);
-         eqpos:=pos('=',hs);
-         if copy(hs,1,eqpos-1)=envvar then
-          begin
-            getenv:=copy(hs,eqpos+1,255);
-            exit;
-          end;
-         hp:=hp+4;
-       end;
-    end;
 
 {******************************************************************************
                              --- Not Supported ---
@@ -1011,7 +1009,12 @@ End;
 end.
 {
   $Log$
-  Revision 1.3  1998-05-21 19:30:47  peter
+  Revision 1.4  1998-05-22 00:39:22  peter
+    * go32v1, go32v2 recompiles with the new objects
+    * remake3 works again with go32v2
+    - removed some "optimizes" from daniel which were wrong
+
+  Revision 1.3  1998/05/21 19:30:47  peter
     * objects compiles for linux
     + assign(pchar), assign(char), rename(pchar), rename(char)
     * fixed read_text_as_array

rtl/dos/go32v1/makefile

@@ -86,13 +86,13 @@ PPI=../ppi
 include $(CFG)/makefile.cfg
 
 # Get the system independent include file names.
-# This will set the following variables : 
+# This will set the following variables :
 # SYSINCNAMES
 include $(INC)/makefile.inc
 SYSINCDEPS=$(addprefix $(INC)/,$(SYSINCNAMES))
 
 # Get the processor dependent include file names.
-# This will set the following variables : 
+# This will set the following variables :
 # CPUINCNAMES
 include $(PROCINC)/makefile.cpu
 SYSCPUDEPS=$(addprefix $(PROCINC)/,$(CPUINCNAMES))
@@ -198,15 +198,15 @@ dos$(PPUEXT) : ../dos.pp $(INC)/filerec.inc $(INC)/textrec.inc \
 	       go32$(PPUEXT) strings$(PPUEXT) $(SYSTEMPPU)
 	$(COPY) ../dos.pp .
 	$(PP) $(OPT) dos $(REDIR)
-	$(DEL) dos.pp 
+	$(DEL) dos.pp
 
 crt$(PPUEXT) : ../crt.pp $(INC)/textrec.inc go32$(PPUEXT) $(SYSTEMPPU)
 	$(COPY) ../crt.pp .
 	$(PP) $(OPT) crt $(REDIR)
 	$(DEL) crt.pp
 
-objects$(PPUEXT) : ../objects.pp $(SYSTEMPPU)
-	$(COPY) ../objects.pp .
+objects$(PPUEXT) : $(INC)/objects.pp objinc.inc $(SYSTEMPPU)
+	$(COPY) $(INC)/objects.pp .
 	$(PP) $(OPT) objects.pp $(REDIR)
 	$(DEL) objects.pp
 
@@ -234,15 +234,15 @@ mouse$(PPUEXT) : ../mouse.pp $(SYSTEMPPU)
 	$(PP) $(OPT) mouse.pp $(REDIR)
 	$(DEL) mouse.pp
 
-getopts$(PPUEXT) : $(PROCINC)/getopts.pp $(SYSTEMPPU)
-	$(COPY) $(PROCINC)/getopts.pp .
+getopts$(PPUEXT) : $(INC)/getopts.pp $(SYSTEMPPU)
+	$(COPY) $(INC)/getopts.pp .
 	$(PP) $(OPT) getopts.pp $(REDIR)
 	$(DEL) getopts.pp
 
-graph$(PPUEXT) : ../graph.pp go32$(PPUEXT) $(SYSTEMPPU) mmx$(PPUEXT) \
-	$(PPIDEPS)
+PPIFILES:=$(wildcard $(PPI)/*.ppi)
+graph$(PPUEXT) : ../graph.pp go32$(PPUEXT) $(SYSTEMPPU) mmx$(PPUEXT) $(PPIFILES)
 	$(COPY) ../graph.pp .
-	$(PP) $(OPT) -Up$(PPI) graph $(REDIR)
+	$(PP) $(OPT) -I$(PPI) graph $(REDIR)
 	$(DEL) graph.pp
 
 

rtl/dos/go32v1/os.inc

@@ -11,7 +11,7 @@
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
  **********************************************************************}
-{$define dos}
+{$define go32v1}
 {$undef go32v2}
 {$undef os2}
 {$undef linux}
@@ -19,27 +19,9 @@
 
 {
   $Log$
-  Revision 1.1  1998-03-25 11:18:41  root
-  Initial revision
+  Revision 1.2  1998-05-22 00:39:31  peter
+    * go32v1, go32v2 recompiles with the new objects
+    * remake3 works again with go32v2
+    - removed some "optimizes" from daniel which were wrong
 
-  Revision 1.3  1998/01/26 11:57:08  michael
-  + Added log at the end
-
-
-  
-  Working file: rtl/dos/go32v1/os.inc
-  description:
-  ----------------------------
-  revision 1.2
-  date: 1997/12/01 12:24:05;  author: michael;  state: Exp;  lines: +13 -0
-  + added copyright reference in header.
-  ----------------------------
-  revision 1.1
-  date: 1997/11/27 08:33:53;  author: michael;  state: Exp;
-  Initial revision
-  ----------------------------
-  revision 1.1.1.1
-  date: 1997/11/27 08:33:53;  author: michael;  state: Exp;  lines: +0 -0
-  FPC RTL CVS start
-  =============================================================================
 }

rtl/dos/go32v1/prt0.as

@@ -3,6 +3,8 @@
 #    This file is part of the Free Pascal run time library.
 #    Copyright (c) 1993,97 by the Free Pascal development team.
 #
+#    Go32V1 Startup code
+#
 #    See the file COPYING.FPC, included in this distribution,
 #    for details about the copyright.
 #
@@ -11,14 +13,13 @@
 #    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 #
 # **********************************************************************
-#///*
-#//**   Called as start(argc, argv, envp)
-#//*/
-#///*   gs:edx points to prog_info structure.  All other registers are OBSOLETE
-#//**   but included for backwards compatibility
-#//*/
-
-        .text
+#
+#  Called as start(argc, argv, envp)
+#
+#  gs:edx points to prog_info structure.  All other registers are OBSOLETE
+#  but included for backwards compatibility
+#
+.text
         .globl  _start
 _start:
         .globl  start
@@ -36,7 +37,7 @@ start:
         movw    %ds,%ax
         cmpw    %cx,%ax
         je      Lcopy_none
-#   /* set the right size */
+# set the right size
         movl  $40,U_SYSTEM_GO32_INFO_BLOCK
 
         movl    %gs:(%edx), %ecx
@@ -84,9 +85,9 @@ Lcopy_done:
 
         movw    U_SYSTEM_GO32_INFO_BLOCK+36,%ax
         movw    %ax,_run_mode
-#/* I need a value for the stack bottom,            */
-#/* but I don't know how to get it from go32        */
-#/* I suppose the stack is 4Ko long, is this true ? */
+# I need a value for the stack bottom,
+# but I don't know how to get it from go32
+# I suppose the stack is 4Ko long, is this true ?
         movl    %esp,%eax
         subl    $0x4000,%eax
         movl    %eax,__stkbottom
@@ -94,7 +95,7 @@ Lcopy_done:
         movw    U_SYSTEM_GO32_INFO_BLOCK+26,%ax
         movw    %ax,_core_selector
         movl    U_SYSTEM_GO32_INFO_BLOCK+28,%eax
-        movl  %eax,U_SYSTEM_STUB_INFO
+        movl    %eax,U_SYSTEM_STUB_INFO
         xorl    %esi,%esi
         xorl    %edi,%edi
         xorl    %ebp,%ebp
@@ -105,15 +106,16 @@ Lcopy_done:
         movl    %esp,%ebx
         movl    8(%ebx),%eax
         movl    %eax,_environ
-        movl    %eax,U_SYSTEM_ENVIRON
+        movl    %eax,U_SYSTEM_ENVP
         movl    4(%ebx),%eax
         movl    %eax,_args
+        movl    %eax,U_SYSTEM_ARGV
         movl    (%ebx),%eax
         movl    %eax,_argc
+        movl    %eax,U_SYSTEM_ARGC
 
         call    PASCALMAIN
 
-
 exit_again:
         movl    $0x4c00,%eax
         int     $0x21
@@ -121,22 +123,30 @@ exit_again:
 
         ret
 
-        .data
+.data
         .globl _argc
 _argc:
         .long   0
+
         .globl  _args
 _args:
         .long   0
+
+        .globl  _environ
+_environ:
+        .long   0
+
+        .globl  __stkbottom
+__stkbottom:
+        .long   0
+
         .globl  _run_mode
 _run_mode:
         .word   0
+
         .globl  _core_selector
 _core_selector:
         .word   0
-        .globl  _environ
-_environ:
-        .long   0
 
         .globl  ___pid
 ___pid:
@@ -155,30 +165,21 @@ _ScreenSecondary:
         .long   0
 
         .globl  __hard_master
-        .globl  __hard_slave
-        .globl  __core_select
 __hard_master:
         .byte   0
+
+        .globl  __hard_slave
 __hard_slave:
         .byte   0
+
+        .globl  __core_select
 __core_select:
         .short  0
-        .globl  __stkbottom
-__stkbottom:
-        .long   0
-#  .globl U_SYSTEM_GO32_INFO_BLOCK
-# U_SYSTEM_GO32_INFO_BLOCK:
-#  .long  __go32_end - U_SYSTEM_GO32_INFO_BLOCK #//* size */
-#  .long  0 #//* offs 4 linear_address_of_primary_screen; */
-#  .long  0 #//* offs 8 linear_address_of_secondary_screen; */
-#  .long  0 #//* offs 12 linear_address_of_transfer_buffer; */
-#  .long  0 #//* offs 16 size_of_transfer_buffer;  >= 4k */
-#  .long  0 #//* offs 20 pid; */
-#  .byte  0 #//* offs 24 u_char master_interrupt_controller_base; */
-#  .byte  0 #//* offs 25 u_char slave_interrupt_controller_base; */
-#  .word  0 #//* offs 26 u_short selector_for_linear_memory; */
-#  .long  0 #//* offs 28 u_long linear_address_of_stub_info_structure; */
-#  .long  0 #//* offs 32 u_long linear_address_of_original_psp; */
-#  .word  0 #//* offs 36 u_short run_mode; */
-#  .word  0 #//* offs 38 u_short run_mode_info; */
-#__go32_end:
+#
+# $Log$
+# Revision 1.3  1998-05-22 00:39:32  peter
+#   * go32v1, go32v2 recompiles with the new objects
+#   * remake3 works again with go32v2
+#   - removed some "optimizes" from daniel which were wrong
+#
+#

rtl/dos/go32v1/system.pp

@@ -12,30 +12,45 @@
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
  **********************************************************************}
-
-{ system unit for go32v1 }
-{$define DOS}
 unit system;
+interface
+
+{ no stack check in system }
+{$S-}
 
 {$I os.inc}
 
-  interface
+{ include system-independent routine headers }
 
-    { die betriebssystemunabhangigen Deklarationen einfuegen: }
+{$I systemh.inc}
 
-    {$I systemh.inc}
+{ include heap support headers }
 
-    {$I heaph.inc}
+{$I heaph.inc}
 
 const
-  UnusedHandle=$ffff;
-  StdInputHandle=0;
-  StdOutputHandle=1;
-  StdErrorHandle=2;
+{ Default filehandles }
+  UnusedHandle    = $ffff;
+  StdInputHandle  = 0;
+  StdOutputHandle = 1;
+  StdErrorHandle  = 2;
+
+{ Default memory segments (Tp7 compatibility) }
+  seg0040 = $0040;
+  segA000 = $A000;
+  segB000 = $B000;
+  segB800 = $B800;
+
+var
+{ C-compatible arguments and environment }
+  argc  : longint;
+  argv  : ppchar;
+  envp  : ppchar;
 
 type
-{$PACKRECORDS 1}
-       t_stub_info   = record
+{ Dos Extender info }
+  p_stub_info   = ^t_stub_info;
+  t_stub_info = packed record
        magic         : array[0..15] of char;
        size          : longint;
        minstack      : longint;
@@ -50,49 +65,47 @@ type
        basename      : array[0..7] of char;
        argv0         : array [0..15] of char;
        dpmi_server   : array [0..15] of char;
-       end;
-       p_stub_info   = ^t_stub_info;
+  end;
 
-       t_go32_info_block = record
-       size_of_this_structure_in_bytes : longint; {offset 0}
-       linear_address_of_primary_screen : longint; {offset 4}
+  t_go32_info_block = packed record
+       size_of_this_structure_in_bytes    : longint; {offset 0}
+       linear_address_of_primary_screen   : longint; {offset 4}
        linear_address_of_secondary_screen : longint; {offset 8}
-       linear_address_of_transfer_buffer : longint; {offset 12}
-       size_of_transfer_buffer : longint; {offset 16}
-       pid : longint; {offset 20}
-       master_interrupt_controller_base : byte; {offset 24}
-       slave_interrupt_controller_base : byte; {offset 25}
-       selector_for_linear_memory : word; {offset 26}
+       linear_address_of_transfer_buffer  : longint; {offset 12}
+       size_of_transfer_buffer            : longint; {offset 16}
+       pid                                : longint; {offset 20}
+       master_interrupt_controller_base   : byte; {offset 24}
+       slave_interrupt_controller_base    : byte; {offset 25}
+       selector_for_linear_memory         : word; {offset 26}
        linear_address_of_stub_info_structure : longint; {offset 28}
-       linear_address_of_original_psp : longint; {offset 32}
-       run_mode : word; {offset 36}
-       run_mode_info : word; {offset 38}
-       end;
-{$PACKRECORDS NORMAL}
+       linear_address_of_original_psp     : longint; {offset 32}
+       run_mode                           : word; {offset 36}
+       run_mode_info                      : word; {offset 38}
+  end;
 
 var
   stub_info       : p_stub_info;
   go32_info_block : t_go32_info_block;
-  environ         : ppchar;
 
-  implementation
+{ Needed for CRT unit }
+function do_read(h,addr,len : longint) : longint;
 
-    { include system independent routines }
 
-    {$I system.inc}
+implementation
 
-{$S-}
-    procedure st1(stack_size : longint);[public,alias: 'STACKCHECK'];
+{ include system independent routines }
 
-      begin
-         { called when trying to get local stack }
-         { if the compiler directive $S is set   }
-         { this function must preserve esi !!!!  }
-         { because esi is set by the calling     }
-         { proc for methods                      }
-         { it must preserve all registers !!     }
-
-         asm
+{$I system.inc}
+
+procedure int_stackcheck(stack_size:longint);[public,alias: 'STACKCHECK'];
+begin
+{ called when trying to get local stack
+  if the compiler directive $S is set
+  this function must preserve esi !!!!
+  because esi is set by the calling
+  proc for methods
+  it must preserve all registers !!     }
+  asm
             pushl %eax
             pushl %ebx
             movl stack_size,%ebx
@@ -116,88 +129,62 @@ var
             { can be usefull for error recovery !! }
             popl %ebx
             popl %eax
-         end['EAX','EBX'];
-         RunError(202);
-         { this needs a local variable }
-         { so the function called itself !! }
-         { Writeln('low in stack ');
-         RunError(202);             }
-      end;
+  end['EAX','EBX'];
+  RunError(202);
+end;
 
-    procedure halt(errnum : byte);
 
-      begin
-         do_exit;
-         flush(stderr);
-         asm
-            movl $0x4c00,%eax
-            movb 8(%ebp),%al
-            int $0x21
-         end;
-      end;
+{$I386_ATT}
 
-    function paramcount : longint;
+procedure halt(errnum : byte);
+begin
+  do_exit;
+  flush(stderr);
+  asm
+        movl    $0x4c00,%eax
+        movb    errnum,%al
+        int     $0x21
+  end;
+end;
 
-      begin
-         asm
-            movl _argc,%eax
-            decl %eax
-            leave
-            ret
-         end ['EAX'];
-      end;
 
-    function paramstr(l : longint) : string;
+function paramcount : longint;
+begin
+  paramcount := argc - 1;
+end;
 
-      function args : pointer;
 
-        begin
-           asm
-              movl _args,%eax
-              leave
-              ret
-           end ['EAX'];
-        end;
+function paramstr(l : longint) : string;
+begin
+  if (l>=0) and (l+1<=argc) then
+   paramstr:=strpas(argv[l])
+  else
+   paramstr:='';
+end;
 
-      var
-         p : ^pchar;
 
-      begin
-         if (l>=0) and (l<=paramcount) then
-           begin
-              p:=args;
-              paramstr:=strpas(p[l]);
-           end
-         else paramstr:='';
-      end;
+procedure randomize;assembler;
+asm
+        movb    $0x2c,%ah
+        int     $0x21
+        shll    $16,%ecx
+        movw    %dx,%cx
+        movl    %ecx,randseed
+end;
 
-    procedure randomize;
 
-      var
-         hl : longint;
-      begin
-         asm
-            movb $0x2c,%ah
-            int $0x21
-            movw %cx,-4(%ebp)
-            movw %dx,-2(%ebp)
-         end;
-         randseed:=hl;
-      end;
-
-{ use standard heap management }
-{ sbrk function of go32v1 }
-  function Sbrk(size : longint) : longint;
+{*****************************************************************************
+                              Heap Management
+*****************************************************************************}
 
-    begin
-       asm
-         movl size,%ebx
-         movl $0x4a01,%eax
-         int  $0x21
-         movl %eax,__RESULT
-       end;
-    end;
+function Sbrk(size : longint) : longint;assembler;
+asm
+        movl    size,%ebx
+        movl    $0x4a01,%eax
+        int     $0x21
+end;
 
+{ include standard heap management }
 {$I heap.inc}
 
 
@@ -215,15 +202,13 @@ begin
 end;
 
 
-procedure do_close(h : longint);
-begin
-   asm
-      movl 8(%ebp),%ebx
-      movb $0x3e,%ah
-      pushl %ebp
-      intl $0x21
-      popl %ebp
-   end;
+procedure do_close(h : longint);assembler;
+asm
+        movl    h,%ebx
+        movb    $0x3e,%ah
+        pushl   %ebp
+        intl    $0x21
+        popl    %ebp
 end;
 
 
@@ -231,14 +216,14 @@ procedure do_erase(p : pchar);
 begin
   AllowSlash(p);
   asm
-     movl 8(%ebp),%edx
-     movb $0x41,%ah
-     pushl %ebp
-     int $0x21
-     popl %ebp
-     jnc .LERASE1
-     movw %ax,U_SYSTEM_INOUTRES;
-  .LERASE1:
+        movl    p,%edx
+        movb    $0x41,%ah
+        pushl   %ebp
+        int     $0x21
+        popl    %ebp
+        jnc     .LERASE1
+        movw    %ax,inoutres
+.LERASE1:
   end;
 end;
 
@@ -248,159 +233,135 @@ begin
   AllowSlash(p1);
   AllowSlash(p2);
   asm
-     movl 8(%ebp),%edx
-     movl 12(%ebp),%edi
-     movb $0x56,%ah
-     pushl %ebp
-     int $0x21
-     popl %ebp
-     jnc .LRENAME1
-     movw %ax,U_SYSTEM_INOUTRES;
-  .LRENAME1:
+        movl    p1,%edx
+        movl    p2,%edi
+        movb    $0x56,%ah
+        pushl   %ebp
+        int     $0x21
+        popl    %ebp
+        jnc     .LRENAME1
+        movw    %ax,inoutres
+.LRENAME1:
   end;
 end;
 
 
-function do_write(h,addr,len : longint) : longint;
-begin
-  asm
-     movl 16(%ebp),%ecx
-     movl 12(%ebp),%edx
-     movl 8(%ebp),%ebx
-     movb $0x40,%ah
-     int $0x21
-     jnc .LDOSWRITE1
-     movw %ax,U_SYSTEM_INOUTRES;
-  .LDOSWRITE1:
-     movl %eax,-4(%ebp)
-  end;
+function do_write(h,addr,len : longint) : longint;assembler;
+asm
+        movl    len,%ecx
+        movl    addr,%edx
+        movl    h,%ebx
+        movb    $0x40,%ah
+        int     $0x21
+        jnc     .LDOSWRITE1
+        movw    %ax,inoutres
+        xorl    %eax,%eax
+.LDOSWRITE1:
 end;
 
 
-function do_read(h,addr,len : longint) : longint;
-begin
-  asm
-     movl 16(%ebp),%ecx
-     movl 12(%ebp),%edx
-     movl 8(%ebp),%ebx
-     movb $0x3f,%ah
-     int $0x21
-     jnc .LDOSREAD1
-     movw %ax,U_SYSTEM_INOUTRES;
-     xorl %eax,%eax
-  .LDOSREAD1:
-     leave
-     ret $12
-  end;
+function do_read(h,addr,len : longint) : longint;assembler;
+asm
+        movl    len,%ecx
+        movl    addr,%edx
+        movl    h,%ebx
+        movb    $0x3f,%ah
+        int     $0x21
+        jnc     .LDOSREAD1
+        movw    %ax,inoutres
+        xorl    %eax,%eax
+.LDOSREAD1:
 end;
 
 
-function do_filepos(handle : longint) : longint;
-begin
-  asm
-     movb $0x42,%ah
-     movb $0x1,%al
-     movl 8(%ebp),%ebx
-     xorl %ecx,%ecx
-     xorl %edx,%edx
-     pushl %ebp
-     int $0x21
-     popl %ebp
-     jnc .LDOSFILEPOS1
-     movw %ax,U_SYSTEM_INOUTRES;
-     xorl %eax,%eax
-     jmp .LDOSFILEPOS2
-  .LDOSFILEPOS1:
-     shll $16,%edx
-     movzwl %ax,%eax
-     orl %edx,%eax
-  .LDOSFILEPOS2:
-     leave
-     ret $4
-  end;
+function do_filepos(handle : longint) : longint;assembler;
+asm
+        movl    $0x4201,%eax
+        movl    handle,%ebx
+        xorl    %ecx,%ecx
+        xorl    %edx,%edx
+        pushl   %ebp
+        int     $0x21
+        popl    %ebp
+        jnc     .LDOSFILEPOS1
+        movw    %ax,inoutres
+        xorl    %eax,%eax
+        jmp     .LDOSFILEPOS2
+.LDOSFILEPOS1:
+        shll    $16,%edx
+        movzwl  %ax,%eax
+        orl     %edx,%eax
+.LDOSFILEPOS2:
 end;
 
 
-procedure do_seek(handle,pos : longint);
-begin
-  asm
-     movl $0x4200,%eax
-     movl 8(%ebp),%ebx
-     movl 12(%ebp),%edx
-     movl %edx,%ecx
-     shrl $16,%ecx
-     pushl %ebp
-     int $0x21
-     popl %ebp
-     jnc .LDOSSEEK1
-     movw %ax,U_SYSTEM_INOUTRES;
-  .LDOSSEEK1:
-     leave
-     ret $8
-  end;
+procedure do_seek(handle,pos : longint);assembler;
+asm
+        movl    $0x4200,%eax
+        movl    handle,%ebx
+        movl    pos,%edx
+        movl    %edx,%ecx
+        shrl    $16,%ecx
+        pushl   %ebp
+        int     $0x21
+        popl    %ebp
+        jnc     .LDOSSEEK1
+        movw    %ax,inoutres
+.LDOSSEEK1:
 end;
 
 
-function do_seekend(handle : longint) : longint;
-begin
-  asm
-     movl $0x4202,%eax
-     movl 8(%ebp),%ebx
-     xorl %ecx,%ecx
-     xorl %edx,%edx
-     pushl %ebp
-     int $0x21
-     popl %ebp
-     jnc .Lset_at_end1
-     movw %ax,U_SYSTEM_INOUTRES;
-     xorl %eax,%eax
-     jmp .Lset_at_end2
-  .Lset_at_end1:
-     shll $16,%edx
-     movzwl %ax,%eax
-     orl %edx,%eax
-  .Lset_at_end2:
-     leave
-     ret $4
-  end;
+function do_seekend(handle : longint) : longint;assembler;
+asm
+        movl    $0x4202,%eax
+        movl    handle,%ebx
+        xorl    %ecx,%ecx
+        xorl    %edx,%edx
+        pushl   %ebp
+        int     $0x21
+        popl    %ebp
+        jnc     .Lset_at_end1
+        movw    %ax,inoutres
+        xorl    %eax,%eax
+        jmp     .Lset_at_end2
+.Lset_at_end1:
+        shll    $16,%edx
+        movzwl  %ax,%eax
+        orl     %edx,%eax
+.Lset_at_end2:
 end;
 
 
 function do_filesize(handle : longint) : longint;
 var
-   aktfilepos : longint;
+  aktfilepos : longint;
 begin
-   aktfilepos:=do_filepos(handle);
-   do_filesize:=do_seekend(handle);
-   do_seek(handle,aktfilepos);
+  aktfilepos:=do_filepos(handle);
+  do_filesize:=do_seekend(handle);
+  do_seek(handle,aktfilepos);
 end;
 
 
-procedure do_truncate(handle,pos : longint);
-begin
-   asm
-      movl $0x4200,%eax
-      movl 8(%ebp),%ebx
-      movl 12(%ebp),%edx
-      movl %edx,%ecx
-      shrl $16,%ecx
-      pushl %ebp
-      int $0x21
-      popl %ebp
-      jc .LTruncate1
-      movl 8(%ebp),%ebx
-      movl 12(%ebp),%edx
-      movl %ebp,%edx
-      xorl %ecx,%ecx
-      movb $0x40,%ah
-      int $0x21
-      jnc .LTruncate2
-   .LTruncate1:
-      movw %ax,U_SYSTEM_INOUTRES;
-   .LTruncate2:
-      leave
-      ret $8
-   end;
+procedure do_truncate(handle,pos : longint);assembler;
+asm
+        movl    $0x4200,%eax
+        movl    handle,%ebx
+        movl    pos,%edx
+        movl    %edx,%ecx
+        shrl    $16,%ecx
+        pushl   %ebp
+        int     $0x21
+        popl    %ebp
+        jc      .LTruncate1
+        movl    handle,%ebx
+        movl    %ebp,%edx
+        xorl    %ecx,%ecx
+        movb    $0x40,%ah
+        int     $0x21
+        jnc     .LTruncate2
+.LTruncate1:
+        movw    %ax,inoutres
+.LTruncate2:
 end;
 
 
@@ -413,7 +374,7 @@ procedure do_open(var f;p:pchar;flags:longint);
   when (flags and $1000) there is no check for close (needed for textfiles)
 }
 var
-   oflags : longint;
+  oflags : longint;
 begin
   AllowSlash(p);
 { close first if opened }
@@ -465,18 +426,18 @@ begin
      end;
      exit;
    end;
-   asm
-      movl $0xff02,%ax
-      movl -4(%ebp),%ecx
-      movl 12(%ebp),%ebx
-      int $0x21
-      jnc .LOPEN1
-      movw %ax,U_SYSTEM_INOUTRES;
-      movw $0xffff,%ax
-   .LOPEN1:
-      movl 8(%ebp),%edx
-      movw %ax,(%edx)
-   end;
+  asm
+        movl    $0xff02,%eax
+        movl    oflags,%ecx
+        movl    flags,%ebx
+        int     $0x21
+        jnc     .LOPEN1
+        movw    %ax,inoutres
+        movw    $0xffff,%ax
+.LOPEN1:
+        movl    f,%edx
+        movw    %ax,(%edx)
+  end;
   if (flags and $10)<>0 then
    do_seekend(filerec(f).handle);
 end;
@@ -513,12 +474,12 @@ begin
   buffer[length(s)]:=#0;
   AllowSlash(pchar(@buffer));
   asm
-    leal buffer,%edx
-    movb 8(%ebp),%ah
-    int  $0x21
-    jnc  .LDOS_DIRS1
-    movw %ax,U_SYSTEM_INOUTRES;
-  .LDOS_DIRS1:
+        leal    buffer,%edx
+        movb    func,%ah
+        int     $0x21
+        jnc     .LDOS_DIRS1
+        movw    %ax,inoutres
+.LDOS_DIRS1:
   end;
 end;
 
@@ -540,9 +501,7 @@ begin
   DosDir($3b,s);
 end;
 
-{ thanks to Michael Van Canneyt <[email protected]>, }
-{ who writes this code                                               }
-{ her is a problem if the getdir is called with a pathstr var in dos.pp }
+
 procedure getdir(drivenr : byte;var dir : string);
 var
   temp : array[0..255] of char;
@@ -550,18 +509,16 @@ var
   i    : byte;
 begin
   sof:=pchar(@dir[4]);
-  { dir[1..3] will contain '[drivenr]:\', but is not }
-  { supplied by DOS, so we let dos string start at   }
-  { dir[4]                                           }
-  { Get dir from drivenr : 0=default, 1=A etc... }
+{ dir[1..3] will contain '[drivenr]:\', but is not supplied by DOS,
+  so we let dos string start at dir[4]
+  Get dir from drivenr : 0=default, 1=A etc }
   asm
-    movb drivenr,%dl
-    movl sof,%esi
-    mov  $0x47,%ah
-    int  $0x21
+        movb    drivenr,%dl
+        movl    sof,%esi
+        mov     $0x47,%ah
+        int     $0x21
   end;
-{ Now Dir should be filled with directory in ASCIIZ, }
-{ starting from dir[4]                               }
+{ Now Dir should be filled with directory in ASCIIZ starting from dir[4] }
   dir[0]:=#3;
   dir[2]:=':';
   dir[3]:='\';
@@ -575,7 +532,7 @@ begin
      dir[0]:=chr(i);
      inc(i);
    end;
-{ upcase the string (FPKPascal function) }
+{ upcase the string }
   dir:=upcase(dir);
   if drivenr<>0 then   { Drive was supplied. We know it }
    dir[1]:=chr(65+drivenr-1)
@@ -584,10 +541,10 @@ begin
    { We need to get the current drive from DOS function 19H  }
    { because the drive was the default, which can be unknown }
      asm
-       movb $0x19,%ah
-       int $0x21
-       addb $65,%al
-       movb %al,i
+        movb    $0x19,%ah
+        int     $0x21
+        addb    $65,%al
+        movb    %al,i
      end;
      dir[1]:=chr(i);
    end;
@@ -623,60 +580,11 @@ Begin
 { Reset IO Error }
   InOutRes:=0;
 End.
-
 {
   $Log$
-  Revision 1.2  1998-03-26 12:21:02  peter
-    * makefile works again
-    * environ is now defined in system.pp (like go32v2)
-
-  Revision 1.1.1.1  1998/03/25 11:18:41  root
-  * Restored version
-
-  Revision 1.9  1998/02/14 01:41:35  peter
-    * fixed unusedhandle bug which was -1
-
-  Revision 1.8  1998/01/26 11:57:03  michael
-  + Added log at the end
-
-
-
-  Working file: rtl/dos/go32v1/system.pp
-  description:
-  ----------------------------
-  revision 1.7
-  date: 1998/01/25 21:53:22;  author: peter;  state: Exp;  lines: +12 -8
-    + Universal Handles support for StdIn/StdOut/StdErr
-    * Updated layout of sysamiga.pas
-  ----------------------------
-  revision 1.6
-  date: 1998/01/16 23:10:50;  author: florian;  state: Exp;  lines: +2 -2
-    + some tobject stuff
-  ----------------------------
-  revision 1.5
-  date: 1998/01/11 02:47:31;  author: michael;  state: Exp;  lines: +384 -507
-  * Changed files to use the new filestructure in /inc directory.
-    (By Peter Vreman)
-  ----------------------------
-  revision 1.4
-  date: 1998/01/07 00:05:04;  author: michael;  state: Exp;  lines: +189 -184
-  + Final adjustments  for a uniform file handling interface.
-     (From Peter Vreman)
-  ----------------------------
-  revision 1.3
-  date: 1998/01/05 16:51:04;  author: michael;  state: Exp;  lines: +18 -46
-  + Moved init of heap to heap.inc: INITheap() (From Peter Vreman)
-  ----------------------------
-  revision 1.2
-  date: 1997/12/01 12:24:06;  author: michael;  state: Exp;  lines: +12 -3
-  + added copyright reference in header.
-  ----------------------------
-  revision 1.1
-  date: 1997/11/27 08:33:53;  author: michael;  state: Exp;
-  Initial revision
-  ----------------------------
-  revision 1.1.1.1
-  date: 1997/11/27 08:33:53;  author: michael;  state: Exp;  lines: +0 -0
-  FPC RTL CVS start
-  =============================================================================
+  Revision 1.3  1998-05-22 00:39:33  peter
+    * go32v1, go32v2 recompiles with the new objects
+    * remake3 works again with go32v2
+    - removed some "optimizes" from daniel which were wrong
+
 }

rtl/dos/go32v2/makefile

@@ -200,8 +200,8 @@ crt$(PPUEXT) : ../crt.pp $(INC)/textrec.inc go32$(PPUEXT) $(SYSTEMPPU)
 	$(PP) $(OPT) crt $(REDIR)
 	$(DEL) crt.pp
 
-objects$(PPUEXT) : ../objects.pp $(SYSTEMPPU)
-	$(COPY) ../objects.pp .
+objects$(PPUEXT) : $(INC)/objects.pp $(INC)/platform.inc objinc.inc $(SYSTEMPPU)
+	$(COPY) $(INC)/objects.pp .
 	$(PP) $(OPT) objects.pp $(REDIR)
 	$(DEL) objects.pp
 
@@ -229,8 +229,8 @@ mouse$(PPUEXT) : ../mouse.pp $(SYSTEMPPU)
 	$(PP) $(OPT) mouse.pp $(REDIR)
 	$(DEL) mouse.pp
 
-getopts$(PPUEXT) : $(PROCINC)/getopts.pp $(SYSTEMPPU)
-	$(COPY) $(PROCINC)/getopts.pp .
+getopts$(PPUEXT) : $(INC)/getopts.pp $(SYSTEMPPU)
+	$(COPY) $(INC)/getopts.pp .
 	$(PP) $(OPT) getopts.pp $(REDIR)
 	$(DEL) getopts.pp
 
@@ -264,7 +264,12 @@ include $(CFG)/makefile.def
 
 #
 # $Log$
-# Revision 1.8  1998-05-06 11:53:40  peter
+# Revision 1.9  1998-05-22 00:39:36  peter
+#   * go32v1, go32v2 recompiles with the new objects
+#   * remake3 works again with go32v2
+#   - removed some "optimizes" from daniel which were wrong
+#
+# Revision 1.8	1998/05/06 11:53:40  peter
 #   * update
 #
 #

rtl/dos/graph.pp

@@ -1,9 +1,11 @@
 {
     $Id$
     This file is part of the Free Pascal run time library.
-    Copyright (c) 1993,97 by Florian  klaempf  & Gernot Tenchio
+    Copyright (c) 1993-98 by Florian Klaempf & Gernot Tenchio
     members of the Free Pascal development team.
 
+    Graph unit for BP7 compatible RTL
+    
     See the file COPYING.FPC, included in this distribution,
     for details about the copyright.
 
@@ -824,44 +826,9 @@ end.
 
 {
   $Log$
-  Revision 1.2  1998-03-26 10:41:15  florian
-    * some warnings fixed
-
-  Revision 1.1.1.1  1998/03/25 11:18:41  root
-  * Restored version
-
-  Revision 1.7  1998/03/03 22:48:41  florian
-    + graph.drawpoly procedure
-    + putimage with xorput uses mmx if available
-
-  Revision 1.6  1998/03/02 00:17:26  carl
-    +GraphErrorMsg function implemented
+  Revision 1.3  1998-05-22 00:39:23  peter
+    * go32v1, go32v2 recompiles with the new objects
+    * remake3 works again with go32v2
+    - removed some "optimizes" from daniel which were wrong
 
-  Revision 1.5  1998/02/25 17:08:07  jonas
-    * change interface definition of SetGraphMode to match the implementation
-
-  Revision 1.4  1998/01/26 11:56:33  michael
-  + Added log at the end
-
-
-  
-  Working file: rtl/dos/graph.pp
-  description:
-  ----------------------------
-  revision 1.3
-  date: 1997/12/03 15:24:19;  author: florian;  state: Exp;  lines: +38 -11
-  Graph.SetGraphMode for DOS added
-  ----------------------------
-  revision 1.2
-  date: 1997/12/01 12:15:46;  author: michael;  state: Exp;  lines: +15 -73
-  + added copyright reference in header.
-  ----------------------------
-  revision 1.1
-  date: 1997/11/27 08:33:50;  author: michael;  state: Exp;
-  Initial revision
-  ----------------------------
-  revision 1.1.1.1
-  date: 1997/11/27 08:33:50;  author: michael;  state: Exp;  lines: +0 -0
-  FPC RTL CVS start
-  =============================================================================
 }

rtl/dos/mouse.pp

@@ -3,6 +3,8 @@
     This file is part of the Free Pascal run time library.
     Copyright (c) 1993,97 by the Free Pascal development team
 
+    Mouse unit containing allmost all interrupt 33h functions
+    
     See the file COPYING.FPC, included in this distribution,
     for details about the copyright.
 
@@ -405,31 +407,9 @@ Begin
 End.
 {
   $Log$
-  Revision 1.3  1998-04-05 13:56:54  peter
-    - fixed mouse to compile with $i386_att
-    + linux crt supports redirecting (not Esc-codes anymore)
+  Revision 1.4  1998-05-22 00:39:25  peter
+    * go32v1, go32v2 recompiles with the new objects
+    * remake3 works again with go32v2
+    - removed some "optimizes" from daniel which were wrong
 
-  Revision 1.2  1998/03/26 12:25:22  peter
-    * integrated both mouse units
-
-  Revision 1.1.1.1  1998/03/25 11:18:41  root
-  * Restored version
-
-  Revision 1.4  1998/03/24 15:53:12  peter
-    * cleanup and doesn't give warnings when compiling
-
-  Revision 1.3  1998/01/26 11:56:24  michael
-  + Added log at the end
-
-  Revision 1.2
-  date: 1997/12/01 12:15:45;  author: michael;  state: Exp;  lines: +14 -12
-  + added copyright reference in header.
-
-  Revision 1.1
-  date: 1997/11/27 08:33:49;  author: michael;  state: Exp;
-  Initial revision
-
-  Revision 1.1.1.1
-  date: 1997/11/27 08:33:49;  author: michael;  state: Exp;  lines: +0 -0
-  FPC RTL CVS start
 }

rtl/dos/printer.pp

@@ -1,9 +1,11 @@
 {
     $Id$
     This file is part of the Free Pascal run time library.
-    Copyright (c) 1993,97 by Florian Klaempfl
+    Copyright (c) 1993,98 by Florian Klaempfl
     member of the Free Pascal development team
 
+    Printer unit for BP7 compatible RTL
+    
     See the file COPYING.FPC, included in this distribution,
     for details about the copyright.
 
@@ -12,62 +14,35 @@
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
  **********************************************************************}
-
-{
-  History:
-  10.4.1994: Version 1.0
-             Unit is completely implemented
-}
- 
 unit printer;
-
-  interface
+interface
   
-    var
-       lst : text;
+var
+  lst : text;
        
-  implementation
-  
-    var
-       old_exit : pointer;
+implementation
   
-    procedure printer_exit;
+var
+  old_exit : pointer;
   
-      begin
-         close(lst);
-         exitproc:=old_exit;
-      end;
+procedure printer_exit;
+begin
+  close(lst);
+  exitproc:=old_exit;
+end;
     
+
 begin
-   assign(lst,'PRN');
-   rewrite(lst);
-   old_exit:=exitproc;
-   exitproc:=@printer_exit;
+  assign(lst,'PRN');
+  rewrite(lst);
+  old_exit:=exitproc;
+  exitproc:=@printer_exit;
 end.
-
 {
   $Log$
-  Revision 1.1  1998-03-25 11:18:41  root
-  Initial revision
+  Revision 1.2  1998-05-22 00:39:26  peter
+    * go32v1, go32v2 recompiles with the new objects
+    * remake3 works again with go32v2
+    - removed some "optimizes" from daniel which were wrong
 
-  Revision 1.3  1998/01/26 11:56:59  michael
-  + Added log at the end
-
-
-  
-  Working file: rtl/dos/printer.pp
-  description:
-  ----------------------------
-  revision 1.2
-  date: 1997/12/01 12:15:48;  author: michael;  state: Exp;  lines: +13 -6
-  + added copyright reference in header.
-  ----------------------------
-  revision 1.1
-  date: 1997/11/27 08:33:50;  author: michael;  state: Exp;
-  Initial revision
-  ----------------------------
-  revision 1.1.1.1
-  date: 1997/11/27 08:33:50;  author: michael;  state: Exp;  lines: +0 -0
-  FPC RTL CVS start
-  =============================================================================
 }