* truncated log

rtl/go32v2/crt.pp

@@ -817,7 +817,10 @@ end.
 
 {
   $Log$
-  Revision 1.7  1999-11-03 23:47:34  peter
+  Revision 1.8  1999-11-06 14:38:23  peter
+    * truncated log
+
+  Revision 1.7  1999/11/03 23:47:34  peter
     * support extended keys
 
   Revision 1.6  1999/10/22 14:36:20  peter
@@ -880,11 +883,6 @@ end.
   Revision 1.3  1998/05/27 00:19:16  peter
     * fixed crt input
 
-  Revision 1.2  1998/05/21 19:30:46  peter
-    * objects compiles for linux
-    + assign(pchar), assign(char), rename(pchar), rename(char)
-    * fixed read_text_as_array
-    + read_text_as_pchar which was not yet in the rtl
 }
 
 

rtl/go32v2/dos.pp

@@ -1,1139 +1,1098 @@
-{
-    $Id$
-    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.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
-unit dos;
-interface
-
-Uses
-  Go32;
-
-Const
-  {Bitmasks for CPU Flags}
-  fcarry     = $0001;
-  fparity    = $0004;
-  fauxiliary = $0010;
-  fzero      = $0040;
-  fsign      = $0080;
-  foverflow  = $0800;
-
-  {Bitmasks for file attribute}
-  readonly  = $01;
-  hidden    = $02;
-  sysfile   = $04;
-  volumeid  = $08;
-  directory = $10;
-  archive   = $20;
-  anyfile   = $3F;
-
-  {File Status}
-  fmclosed = $D7B0;
-  fminput  = $D7B1;
-  fmoutput = $D7B2;
-  fminout  = $D7B3;
-
-
-Type
-{ Needed for LFN Support }
-  ComStr  = String[255];
-  PathStr = String[255];
-  DirStr  = String[255];
-  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
-     fill : array[1..21] of byte;
-     attr : byte;
-     time : longint;
-     { reserved : word; not in DJGPP V2 }
-     size : longint;
-     name : string[255]; { LFN Name, DJGPP uses only [12] but more can't hurt (PFV) }
-  end;
-
-  Registers = Go32.Registers;
-
-Var
-  DosError : integer;
-
-{Interrupt}
-Procedure Intr(intno: byte; var regs: registers);
-Procedure MSDos(var regs: registers);
-
-{Info/Date/Time}
-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);
-
-{Exec}
-Procedure Exec(const path: pathstr; const comline: comstr);
-Function  DosExitCode: word;
-
-{Disk}
-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);
-
-{File}
-Procedure GetFAttr(var f; var attr: word);
-Procedure GetFTime(var f; var time: longint);
-Function  FSearch(path: pathstr; dirlist: string): pathstr;
-Function  FExpand(const path: pathstr): pathstr;
-Procedure FSplit(path: pathstr; var dir: dirstr; var name: namestr; var ext: extstr);
-
-{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;
-
-{$ASMMODE ATT}
-
-{******************************************************************************
-                           --- Dos Interrupt ---
-******************************************************************************}
-
-var
-  dosregs : registers;
-
-procedure LoadDosError;
-var
-  r : registers;
-begin
-  if (dosregs.flags and carryflag) <> 0 then
-   begin
-     r.eax:=$5900;
-     r.ebx:=$0;
-     realintr($21,r);
-     { conversion from word to integer !!
-       gave a Bound check error if ax is $FFFF !! PM }
-     doserror:=integer(r.ax);
-     case doserror of
-      19 : DosError:=150;
-      21 : DosError:=152;
-     end;
-   end
-  else
-    doserror:=0;
-end;
-
-
-procedure intr(intno : byte;var regs : registers);
-begin
-  realintr(intno,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);
-   DosError:=0;
-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;
-  DosError:=0;
-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);
-  DosError:=0;
-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
-  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;
-
-
-{******************************************************************************
-                               --- Exec ---
-******************************************************************************}
-
-var
-  lastdosexitcode : word;
-
-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;
-
-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;
-
-
-function dosexitcode : word;
-begin
-  dosexitcode:=lastdosexitcode;
-end;
-
-
-procedure getcbreak(var breakvalue : boolean);
-begin
-  DosError:=0;
-  dosregs.ax:=$3300;
-  msdos(dosregs);
-  breakvalue:=dosregs.dl<>0;
-end;
-
-
-procedure setcbreak(breakvalue : boolean);
-begin
-  DosError:=0;
-  dosregs.ax:=$3301;
-  dosregs.dl:=ord(breakvalue);
-  msdos(dosregs);
-end;
-
-
-procedure getverify(var verify : boolean);
-begin
-  DosError:=0;
-  dosregs.ah:=$54;
-  msdos(dosregs);
-  verify:=dosregs.al<>0;
-end;
-
-
-procedure setverify(verify : boolean);
-begin
-  DosError:=0;
-  dosregs.ah:=$2e;
-  dosregs.al:=ord(verify);
-  msdos(dosregs);
-end;
-
-
-{******************************************************************************
-                               --- Disk ---
-******************************************************************************}
-
-function diskfree(drive : byte) : longint;
-begin
-  DosError:=0;
-  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
-  DosError:=0;
-  dosregs.dl:=drive;
-  dosregs.ah:=$36;
-  msdos(dosregs);
-  if dosregs.ax<>$FFFF then
-   disksize:=dosregs.ax*dosregs.cx*dosregs.dx
-  else
-   disksize:=-1;
-end;
-
-
-{******************************************************************************
-                      --- LFNFindfirst LFNFindNext ---
-******************************************************************************}
-
-type
-  LFNSearchRec=packed record
-    attr,
-    crtime,
-    crtimehi,
-    actime,
-    actimehi,
-    lmtime,
-    lmtimehi,
-    sizehi,
-    size      : longint;
-    reserved  : array[0..7] of byte;
-    name      : array[0..259] of byte;
-    shortname : array[0..13] of byte;
-  end;
-
-procedure LFNSearchRec2Dos(const w:LFNSearchRec;hdl:longint;var d:Searchrec);
-var
-  Len : longint;
-begin
-  With w do
-   begin
-     FillChar(d,sizeof(SearchRec),0);
-     if DosError=0 then
-      len:=StrLen(@Name)
-     else
-      len:=0;
-     d.Name[0]:=chr(len);
-     Move(Name[0],d.Name[1],Len);
-     d.Time:=lmTime;
-     d.Size:=Size;
-     d.Attr:=Attr and $FF;
-     Move(hdl,d.Fill,4);
-   end;
-end;
-
-
-procedure LFNFindFirst(path:pchar;attr:longint;var s:searchrec);
-var
-  i : longint;
-  w : LFNSearchRec;
-begin
-  { allow slash as backslash }
-  for i:=0 to strlen(path) do
-    if path[i]='/' then path[i]:='\';
-  dosregs.si:=1; { use ms-dos time }
-  { don't include the label if not asked for it, needed for network drives }
-  if attr=$8 then
-   dosregs.ecx:=8
-  else
-   dosregs.ecx:=attr and (not 8);
-  dosregs.edx:=tb_offset+Sizeof(LFNSearchrec)+1;
-  dosmemput(tb_segment,tb_offset+Sizeof(LFNSearchrec)+1,path^,strlen(path)+1);
-  dosregs.ds:=tb_segment;
-  dosregs.edi:=tb_offset;
-  dosregs.es:=tb_segment;
-  dosregs.ax:=$714e;
-  msdos(dosregs);
-  LoadDosError;
-  copyfromdos(w,sizeof(LFNSearchRec));
-  LFNSearchRec2Dos(w,dosregs.ax,s);
-end;
-
-
-procedure LFNFindNext(var s:searchrec);
-var
-  hdl : longint;
-  w   : LFNSearchRec;
-begin
-  Move(s.Fill,hdl,4);
-  dosregs.si:=1; { use ms-dos time }
-  dosregs.edi:=tb_offset;
-  dosregs.es:=tb_segment;
-  dosregs.ebx:=hdl;
-  dosregs.ax:=$714f;
-  msdos(dosregs);
-  LoadDosError;
-  copyfromdos(w,sizeof(LFNSearchRec));
-  LFNSearchRec2Dos(w,hdl,s);
-end;
-
-
-procedure LFNFindClose(var s:searchrec);
-var
-  hdl : longint;
-begin
-  Move(s.Fill,hdl,4);
-  dosregs.ebx:=hdl;
-  dosregs.ax:=$71a1;
-  msdos(dosregs);
-  LoadDosError;
-end;
-
-
-{******************************************************************************
-                     --- DosFindfirst DosFindNext ---
-******************************************************************************}
-
-procedure dossearchrec2searchrec(var f : searchrec);
-var
-  len : longint;
-begin
-  len:=StrLen(@f.Name);
-  Move(f.Name[0],f.Name[1],Len);
-  f.Name[0]:=chr(len);
-end;
-
-
-procedure DosFindfirst(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]:='\';
-  copytodos(f,sizeof(searchrec));
-  dosregs.edx:=tb_offset;
-  dosregs.ds:=tb_segment;
-  dosregs.ah:=$1a;
-  msdos(dosregs);
-  dosregs.ecx:=attr;
-  dosregs.edx:=tb_offset+Sizeof(searchrec)+1;
-  dosmemput(tb_segment,tb_offset+Sizeof(searchrec)+1,path^,strlen(path)+1);
-  dosregs.ds:=tb_segment;
-  dosregs.ah:=$4e;
-  msdos(dosregs);
-  copyfromdos(f,sizeof(searchrec));
-  LoadDosError;
-  dossearchrec2searchrec(f);
-end;
-
-
-procedure Dosfindnext(var f : searchrec);
-begin
-  copytodos(f,sizeof(searchrec));
-  dosregs.edx:=tb_offset;
-  dosregs.ds:=tb_segment;
-  dosregs.ah:=$1a;
-  msdos(dosregs);
-  dosregs.ah:=$4f;
-  msdos(dosregs);
-  copyfromdos(f,sizeof(searchrec));
-  LoadDosError;
-  dossearchrec2searchrec(f);
-end;
-
-
-{******************************************************************************
-                     --- Findfirst FindNext ---
-******************************************************************************}
-
-procedure findfirst(const path : pathstr;attr : word;var f : searchRec);
-var
-  path0 : array[0..256] of char;
-begin
-  doserror:=0;
-  strpcopy(path0,path);
-  if LFNSupport then
-   LFNFindFirst(path0,attr,f)
-  else
-   Dosfindfirst(path0,attr,f);
-end;
-
-
-procedure findnext(var f : searchRec);
-begin
-  doserror:=0;
-  if LFNSupport then
-   LFNFindnext(f)
-  else
-   Dosfindnext(f);
-end;
-
-
-Procedure FindClose(Var f: SearchRec);
-begin
-  DosError:=0;
-  if LFNSupport then
-   LFNFindClose(f);
-end;
-
-
-type swap_proc = procedure;
-
-var
-  _swap_in  : swap_proc;external name '_swap_in';
-  _swap_out : swap_proc;external name '_swap_out';
-  _exception_exit : pointer;external name '_exception_exit';
-  _v2prt0_exceptions_on : longbool;external name '_v2prt0_exceptions_on';
-
-procedure swapvectors;
-begin
-  DosError:=0;
-  if _exception_exit<>nil then
-    if _v2prt0_exceptions_on then
-      _swap_in()
-    else
-      _swap_out();
-
-(*  asm
-{ uses four global symbols from v2prt0.as to be able to know the current
-  exception state without using dpmiexcp unit }
-            movl _exception_exit,%eax
-            orl  %eax,%eax
-            je   .Lno_excep
-            movl _v2prt0_exceptions_on,%eax
-            orl  %eax,%eax
-            je   .Lexceptions_off
-            call *_swap_out
-            jmp  .Lno_excep
-         .Lexceptions_off:
-            call *_swap_in
-         .Lno_excep:
-  end; *)
-end;
-
-
-{******************************************************************************
-                               --- File ---
-******************************************************************************}
-
-procedure fsplit(path : pathstr;var dir : dirstr;var name : namestr;var ext : extstr);
-var
-   dotpos,p1,i : longint;
-begin
-  { allow slash as backslash }
-  for i:=1 to length(path) do
-   if path[i]='/' then path[i]:='\';
-  { get drive name }
-  p1:=pos(':',path);
-  if p1>0 then
-    begin
-       dir:=path[1]+':';
-       delete(path,1,p1);
-    end
-  else
-    dir:='';
-  { split the path and the name, there are no more path informtions }
-  { if path contains no backslashes                                 }
-  while true do
-    begin
-       p1:=pos('\',path);
-       if p1=0 then
-         break;
-       dir:=dir+copy(path,1,p1);
-       delete(path,1,p1);
-    end;
-  { try to find out a extension }
-  if LFNSupport then
-    begin
-       Ext:='';
-       i:=Length(Path);
-       DotPos:=256;
-       While (i>0) Do
-         Begin
-            If (Path[i]='.') Then
-              begin
-                 DotPos:=i;
-                 break;
-              end;
-            Dec(i);
-         end;
-       Ext:=Copy(Path,DotPos,255);
-       Name:=Copy(Path,1,DotPos - 1);
-    end
-  else
-    begin
-       p1:=pos('.',path);
-       if p1>0 then
-         begin
-            ext:=copy(path,p1,4);
-            delete(path,p1,length(path)-p1+1);
-         end
-       else
-         ext:='';
-       name:=path;
-    end;
-end;
-
-
-    function fexpand(const path : pathstr) : pathstr;
-       var
-         s,pa : pathstr;
-         i,j  : longint;
-       begin
-          getdir(0,s);
-          i:=ioresult;
-          if LFNSupport then
-           begin
-             pa:=path;
-           end
-          else
-           if FileNameCaseSensitive then
-            pa:=path
-           else
-            pa:=upcase(path);
-
-          { allow slash as backslash }
-          for i:=1 to length(pa) do
-           if pa[i]='/' then
-            pa[i]:='\';
-
-          if (length(pa)>1) and (pa[2]=':') and (pa[1] in ['A'..'Z','a'..'z']) then
-            begin
-               { Always uppercase driveletter }
-               if (pa[1] in ['a'..'z']) then
-                pa[1]:=Chr(Ord(Pa[1])-32);
-               { we must get the right directory }
-               getdir(ord(pa[1])-ord('A')+1,s);
-               i:=ioresult;
-               if (ord(pa[0])>2) and (pa[3]<>'\') then
-                 if pa[1]=s[1] then
-                   begin
-                     { remove ending slash if it already exists }
-                     if s[length(s)]='\' then
-                      dec(s[0]);
-                     pa:=s+'\'+copy (pa,3,length(pa));
-                   end
-                 else
-                   pa:=pa[1]+':\'+copy (pa,3,length(pa))
-            end
-          else
-            if pa[1]='\' then
-              pa:=s[1]+':'+pa
-            else if s[0]=#3 then
-              pa:=s+pa
-            else
-              pa:=s+'\'+pa;
-
-        { Turbo Pascal gives current dir on drive if only drive given as parameter! }
-        if length(pa) = 2 then
-         begin
-           getdir(byte(pa[1])-64,s);
-           pa := s;
-         end;
-
-        {First remove all references to '\.\'}
-          while pos ('\.\',pa)<>0 do
-           delete (pa,pos('\.\',pa),2);
-        {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);
-               if pa[j+1] = ':' then j := 3;
-               delete (pa,j,i-j+3);
-             end;
-          until i=0;
-
-          { Turbo Pascal gets rid of a \.. at the end of the path }
-          { Now remove also any reference to '\..'  at end of line
-            + of course previous dir.. }
-          i:=pos('\..',pa);
-          if i<>0 then
-           begin
-             if i = length(pa) - 2 then
-              begin
-                j:=i-1;
-                while (j>1) and (pa[j]<>'\') do
-                 dec (j);
-                delete (pa,j,i-j+3);
-              end;
-              pa := pa + '\';
-            end;
-          { Remove End . and \}
-          if (length(pa)>0) and (pa[length(pa)]='.') then
-           dec(byte(pa[0]));
-          { if only the drive + a '\' is left then the '\' should be left to prevtn the program
-            accessing the current directory on the drive rather than the root!}
-          { if the last char of path = '\' then leave it in as this is what TP does! }
-          if ((length(pa)>3) and (pa[length(pa)]='\')) and (path[length(path)] <> '\') then
-           dec(byte(pa[0]));
-          { if only a drive is given in path then there should be a '\' at the
-            end of the string given back }
-          if length(pa) = 2 then pa := pa + '\';
-          fexpand:=pa;
-       end;
-
-
-Function FSearch(path: pathstr; dirlist: string): pathstr;
-var
-  i,p1   : longint;
-  s      : searchrec;
-  newdir : pathstr;
-begin
-{ check if the file specified exists }
-  findfirst(path,anyfile,s);
-  if doserror=0 then
-   begin
-     findclose(s);
-     fsearch:=path;
-     exit;
-   end;
-{ No wildcards allowed in these things }
-  if (pos('?',path)<>0) or (pos('*',path)<>0) then
-    fsearch:=''
-  else
-    begin
-       { allow slash as backslash }
-       for i:=1 to length(dirlist) do
-         if dirlist[i]='/' then dirlist[i]:='\';
-       repeat
-         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<>'') 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;
-  findclose(s);
-end;
-
-
-{******************************************************************************
-                       --- Get/Set File Time,Attr ---
-******************************************************************************}
-
-procedure getftime(var f;var time : longint);
-begin
-  dosregs.bx:=textrec(f).handle;
-  dosregs.ax:=$5700;
-  msdos(dosregs);
-  loaddoserror;
-  time:=(dosregs.dx shl 16)+dosregs.cx;
-end;
-
-
-procedure setftime(var f;time : longint);
-begin
-  dosregs.bx:=textrec(f).handle;
-  dosregs.cx:=time and $ffff;
-  dosregs.dx:=time shr 16;
-  dosregs.ax:=$5701;
-  msdos(dosregs);
-  loaddoserror;
-end;
-
-
-procedure getfattr(var f;var attr : word);
-begin
-  copytodos(filerec(f).name,strlen(filerec(f).name)+1);
-  dosregs.edx:=tb_offset;
-  dosregs.ds:=tb_segment;
-  if LFNSupport then
-   begin
-     dosregs.ax:=$7143;
-     dosregs.bx:=0;
-   end
-  else
-   dosregs.ax:=$4300;
-  msdos(dosregs);
-  LoadDosError;
-  Attr:=dosregs.cx;
-end;
-
-
-procedure setfattr(var f;attr : word);
-begin
-  copytodos(filerec(f).name,strlen(filerec(f).name)+1);
-  dosregs.edx:=tb_offset;
-  dosregs.ds:=tb_segment;
-  if LFNSupport then
-   begin
-     dosregs.ax:=$7143;
-     dosregs.bx:=1;
-   end
-  else
-   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);
-     inc(hp);
-   end;
-end;
-
-
-function envstr(index : integer) : string;
-begin
-  if (index<=0) or (index>envcount) then
-   begin
-     envstr:='';
-     exit;
-   end;
-  envstr:=strpas(ppchar(pointer(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;
-     inc(hp);
-   end;
-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.
-{
+{
+    $Id$
+    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.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit dos;
+interface
+
+Uses
+  Go32;
+
+Const
+  {Bitmasks for CPU Flags}
+  fcarry     = $0001;
+  fparity    = $0004;
+  fauxiliary = $0010;
+  fzero      = $0040;
+  fsign      = $0080;
+  foverflow  = $0800;
+
+  {Bitmasks for file attribute}
+  readonly  = $01;
+  hidden    = $02;
+  sysfile   = $04;
+  volumeid  = $08;
+  directory = $10;
+  archive   = $20;
+  anyfile   = $3F;
+
+  {File Status}
+  fmclosed = $D7B0;
+  fminput  = $D7B1;
+  fmoutput = $D7B2;
+  fminout  = $D7B3;
+
+
+Type
+{ Needed for LFN Support }
+  ComStr  = String[255];
+  PathStr = String[255];
+  DirStr  = String[255];
+  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
+     fill : array[1..21] of byte;
+     attr : byte;
+     time : longint;
+     { reserved : word; not in DJGPP V2 }
+     size : longint;
+     name : string[255]; { LFN Name, DJGPP uses only [12] but more can't hurt (PFV) }
+  end;
+
+  Registers = Go32.Registers;
+
+Var
+  DosError : integer;
+
+{Interrupt}
+Procedure Intr(intno: byte; var regs: registers);
+Procedure MSDos(var regs: registers);
+
+{Info/Date/Time}
+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);
+
+{Exec}
+Procedure Exec(const path: pathstr; const comline: comstr);
+Function  DosExitCode: word;
+
+{Disk}
+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);
+
+{File}
+Procedure GetFAttr(var f; var attr: word);
+Procedure GetFTime(var f; var time: longint);
+Function  FSearch(path: pathstr; dirlist: string): pathstr;
+Function  FExpand(const path: pathstr): pathstr;
+Procedure FSplit(path: pathstr; var dir: dirstr; var name: namestr; var ext: extstr);
+
+{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;
+
+{$ASMMODE ATT}
+
+{******************************************************************************
+                           --- Dos Interrupt ---
+******************************************************************************}
+
+var
+  dosregs : registers;
+
+procedure LoadDosError;
+var
+  r : registers;
+begin
+  if (dosregs.flags and carryflag) <> 0 then
+   begin
+     r.eax:=$5900;
+     r.ebx:=$0;
+     realintr($21,r);
+     { conversion from word to integer !!
+       gave a Bound check error if ax is $FFFF !! PM }
+     doserror:=integer(r.ax);
+     case doserror of
+      19 : DosError:=150;
+      21 : DosError:=152;
+     end;
+   end
+  else
+    doserror:=0;
+end;
+
+
+procedure intr(intno : byte;var regs : registers);
+begin
+  realintr(intno,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);
+   DosError:=0;
+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;
+  DosError:=0;
+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);
+  DosError:=0;
+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
+  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;
+
+
+{******************************************************************************
+                               --- Exec ---
+******************************************************************************}
+
+var
+  lastdosexitcode : word;
+
+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;
+
+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;
+
+
+function dosexitcode : word;
+begin
+  dosexitcode:=lastdosexitcode;
+end;
+
+
+procedure getcbreak(var breakvalue : boolean);
+begin
+  DosError:=0;
+  dosregs.ax:=$3300;
+  msdos(dosregs);
+  breakvalue:=dosregs.dl<>0;
+end;
+
+
+procedure setcbreak(breakvalue : boolean);
+begin
+  DosError:=0;
+  dosregs.ax:=$3301;
+  dosregs.dl:=ord(breakvalue);
+  msdos(dosregs);
+end;
+
+
+procedure getverify(var verify : boolean);
+begin
+  DosError:=0;
+  dosregs.ah:=$54;
+  msdos(dosregs);
+  verify:=dosregs.al<>0;
+end;
+
+
+procedure setverify(verify : boolean);
+begin
+  DosError:=0;
+  dosregs.ah:=$2e;
+  dosregs.al:=ord(verify);
+  msdos(dosregs);
+end;
+
+
+{******************************************************************************
+                               --- Disk ---
+******************************************************************************}
+
+function diskfree(drive : byte) : longint;
+begin
+  DosError:=0;
+  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
+  DosError:=0;
+  dosregs.dl:=drive;
+  dosregs.ah:=$36;
+  msdos(dosregs);
+  if dosregs.ax<>$FFFF then
+   disksize:=dosregs.ax*dosregs.cx*dosregs.dx
+  else
+   disksize:=-1;
+end;
+
+
+{******************************************************************************
+                      --- LFNFindfirst LFNFindNext ---
+******************************************************************************}
+
+type
+  LFNSearchRec=packed record
+    attr,
+    crtime,
+    crtimehi,
+    actime,
+    actimehi,
+    lmtime,
+    lmtimehi,
+    sizehi,
+    size      : longint;
+    reserved  : array[0..7] of byte;
+    name      : array[0..259] of byte;
+    shortname : array[0..13] of byte;
+  end;
+
+procedure LFNSearchRec2Dos(const w:LFNSearchRec;hdl:longint;var d:Searchrec);
+var
+  Len : longint;
+begin
+  With w do
+   begin
+     FillChar(d,sizeof(SearchRec),0);
+     if DosError=0 then
+      len:=StrLen(@Name)
+     else
+      len:=0;
+     d.Name[0]:=chr(len);
+     Move(Name[0],d.Name[1],Len);
+     d.Time:=lmTime;
+     d.Size:=Size;
+     d.Attr:=Attr and $FF;
+     Move(hdl,d.Fill,4);
+   end;
+end;
+
+
+procedure LFNFindFirst(path:pchar;attr:longint;var s:searchrec);
+var
+  i : longint;
+  w : LFNSearchRec;
+begin
+  { allow slash as backslash }
+  for i:=0 to strlen(path) do
+    if path[i]='/' then path[i]:='\';
+  dosregs.si:=1; { use ms-dos time }
+  { don't include the label if not asked for it, needed for network drives }
+  if attr=$8 then
+   dosregs.ecx:=8
+  else
+   dosregs.ecx:=attr and (not 8);
+  dosregs.edx:=tb_offset+Sizeof(LFNSearchrec)+1;
+  dosmemput(tb_segment,tb_offset+Sizeof(LFNSearchrec)+1,path^,strlen(path)+1);
+  dosregs.ds:=tb_segment;
+  dosregs.edi:=tb_offset;
+  dosregs.es:=tb_segment;
+  dosregs.ax:=$714e;
+  msdos(dosregs);
+  LoadDosError;
+  copyfromdos(w,sizeof(LFNSearchRec));
+  LFNSearchRec2Dos(w,dosregs.ax,s);
+end;
+
+
+procedure LFNFindNext(var s:searchrec);
+var
+  hdl : longint;
+  w   : LFNSearchRec;
+begin
+  Move(s.Fill,hdl,4);
+  dosregs.si:=1; { use ms-dos time }
+  dosregs.edi:=tb_offset;
+  dosregs.es:=tb_segment;
+  dosregs.ebx:=hdl;
+  dosregs.ax:=$714f;
+  msdos(dosregs);
+  LoadDosError;
+  copyfromdos(w,sizeof(LFNSearchRec));
+  LFNSearchRec2Dos(w,hdl,s);
+end;
+
+
+procedure LFNFindClose(var s:searchrec);
+var
+  hdl : longint;
+begin
+  Move(s.Fill,hdl,4);
+  dosregs.ebx:=hdl;
+  dosregs.ax:=$71a1;
+  msdos(dosregs);
+  LoadDosError;
+end;
+
+
+{******************************************************************************
+                     --- DosFindfirst DosFindNext ---
+******************************************************************************}
+
+procedure dossearchrec2searchrec(var f : searchrec);
+var
+  len : longint;
+begin
+  len:=StrLen(@f.Name);
+  Move(f.Name[0],f.Name[1],Len);
+  f.Name[0]:=chr(len);
+end;
+
+
+procedure DosFindfirst(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]:='\';
+  copytodos(f,sizeof(searchrec));
+  dosregs.edx:=tb_offset;
+  dosregs.ds:=tb_segment;
+  dosregs.ah:=$1a;
+  msdos(dosregs);
+  dosregs.ecx:=attr;
+  dosregs.edx:=tb_offset+Sizeof(searchrec)+1;
+  dosmemput(tb_segment,tb_offset+Sizeof(searchrec)+1,path^,strlen(path)+1);
+  dosregs.ds:=tb_segment;
+  dosregs.ah:=$4e;
+  msdos(dosregs);
+  copyfromdos(f,sizeof(searchrec));
+  LoadDosError;
+  dossearchrec2searchrec(f);
+end;
+
+
+procedure Dosfindnext(var f : searchrec);
+begin
+  copytodos(f,sizeof(searchrec));
+  dosregs.edx:=tb_offset;
+  dosregs.ds:=tb_segment;
+  dosregs.ah:=$1a;
+  msdos(dosregs);
+  dosregs.ah:=$4f;
+  msdos(dosregs);
+  copyfromdos(f,sizeof(searchrec));
+  LoadDosError;
+  dossearchrec2searchrec(f);
+end;
+
+
+{******************************************************************************
+                     --- Findfirst FindNext ---
+******************************************************************************}
+
+procedure findfirst(const path : pathstr;attr : word;var f : searchRec);
+var
+  path0 : array[0..256] of char;
+begin
+  doserror:=0;
+  strpcopy(path0,path);
+  if LFNSupport then
+   LFNFindFirst(path0,attr,f)
+  else
+   Dosfindfirst(path0,attr,f);
+end;
+
+
+procedure findnext(var f : searchRec);
+begin
+  doserror:=0;
+  if LFNSupport then
+   LFNFindnext(f)
+  else
+   Dosfindnext(f);
+end;
+
+
+Procedure FindClose(Var f: SearchRec);
+begin
+  DosError:=0;
+  if LFNSupport then
+   LFNFindClose(f);
+end;
+
+
+type swap_proc = procedure;
+
+var
+  _swap_in  : swap_proc;external name '_swap_in';
+  _swap_out : swap_proc;external name '_swap_out';
+  _exception_exit : pointer;external name '_exception_exit';
+  _v2prt0_exceptions_on : longbool;external name '_v2prt0_exceptions_on';
+
+procedure swapvectors;
+begin
+  DosError:=0;
+  if _exception_exit<>nil then
+    if _v2prt0_exceptions_on then
+      _swap_in()
+    else
+      _swap_out();
+
+(*  asm
+{ uses four global symbols from v2prt0.as to be able to know the current
+  exception state without using dpmiexcp unit }
+            movl _exception_exit,%eax
+            orl  %eax,%eax
+            je   .Lno_excep
+            movl _v2prt0_exceptions_on,%eax
+            orl  %eax,%eax
+            je   .Lexceptions_off
+            call *_swap_out
+            jmp  .Lno_excep
+         .Lexceptions_off:
+            call *_swap_in
+         .Lno_excep:
+  end; *)
+end;
+
+
+{******************************************************************************
+                               --- File ---
+******************************************************************************}
+
+procedure fsplit(path : pathstr;var dir : dirstr;var name : namestr;var ext : extstr);
+var
+   dotpos,p1,i : longint;
+begin
+  { allow slash as backslash }
+  for i:=1 to length(path) do
+   if path[i]='/' then path[i]:='\';
+  { get drive name }
+  p1:=pos(':',path);
+  if p1>0 then
+    begin
+       dir:=path[1]+':';
+       delete(path,1,p1);
+    end
+  else
+    dir:='';
+  { split the path and the name, there are no more path informtions }
+  { if path contains no backslashes                                 }
+  while true do
+    begin
+       p1:=pos('\',path);
+       if p1=0 then
+         break;
+       dir:=dir+copy(path,1,p1);
+       delete(path,1,p1);
+    end;
+  { try to find out a extension }
+  if LFNSupport then
+    begin
+       Ext:='';
+       i:=Length(Path);
+       DotPos:=256;
+       While (i>0) Do
+         Begin
+            If (Path[i]='.') Then
+              begin
+                 DotPos:=i;
+                 break;
+              end;
+            Dec(i);
+         end;
+       Ext:=Copy(Path,DotPos,255);
+       Name:=Copy(Path,1,DotPos - 1);
+    end
+  else
+    begin
+       p1:=pos('.',path);
+       if p1>0 then
+         begin
+            ext:=copy(path,p1,4);
+            delete(path,p1,length(path)-p1+1);
+         end
+       else
+         ext:='';
+       name:=path;
+    end;
+end;
+
+
+    function fexpand(const path : pathstr) : pathstr;
+       var
+         s,pa : pathstr;
+         i,j  : longint;
+       begin
+          getdir(0,s);
+          i:=ioresult;
+          if LFNSupport then
+           begin
+             pa:=path;
+           end
+          else
+           if FileNameCaseSensitive then
+            pa:=path
+           else
+            pa:=upcase(path);
+
+          { allow slash as backslash }
+          for i:=1 to length(pa) do
+           if pa[i]='/' then
+            pa[i]:='\';
+
+          if (length(pa)>1) and (pa[2]=':') and (pa[1] in ['A'..'Z','a'..'z']) then
+            begin
+               { Always uppercase driveletter }
+               if (pa[1] in ['a'..'z']) then
+                pa[1]:=Chr(Ord(Pa[1])-32);
+               { we must get the right directory }
+               getdir(ord(pa[1])-ord('A')+1,s);
+               i:=ioresult;
+               if (ord(pa[0])>2) and (pa[3]<>'\') then
+                 if pa[1]=s[1] then
+                   begin
+                     { remove ending slash if it already exists }
+                     if s[length(s)]='\' then
+                      dec(s[0]);
+                     pa:=s+'\'+copy (pa,3,length(pa));
+                   end
+                 else
+                   pa:=pa[1]+':\'+copy (pa,3,length(pa))
+            end
+          else
+            if pa[1]='\' then
+              pa:=s[1]+':'+pa
+            else if s[0]=#3 then
+              pa:=s+pa
+            else
+              pa:=s+'\'+pa;
+
+        { Turbo Pascal gives current dir on drive if only drive given as parameter! }
+        if length(pa) = 2 then
+         begin
+           getdir(byte(pa[1])-64,s);
+           pa := s;
+         end;
+
+        {First remove all references to '\.\'}
+          while pos ('\.\',pa)<>0 do
+           delete (pa,pos('\.\',pa),2);
+        {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);
+               if pa[j+1] = ':' then j := 3;
+               delete (pa,j,i-j+3);
+             end;
+          until i=0;
+
+          { Turbo Pascal gets rid of a \.. at the end of the path }
+          { Now remove also any reference to '\..'  at end of line
+            + of course previous dir.. }
+          i:=pos('\..',pa);
+          if i<>0 then
+           begin
+             if i = length(pa) - 2 then
+              begin
+                j:=i-1;
+                while (j>1) and (pa[j]<>'\') do
+                 dec (j);
+                delete (pa,j,i-j+3);
+              end;
+              pa := pa + '\';
+            end;
+          { Remove End . and \}
+          if (length(pa)>0) and (pa[length(pa)]='.') then
+           dec(byte(pa[0]));
+          { if only the drive + a '\' is left then the '\' should be left to prevtn the program
+            accessing the current directory on the drive rather than the root!}
+          { if the last char of path = '\' then leave it in as this is what TP does! }
+          if ((length(pa)>3) and (pa[length(pa)]='\')) and (path[length(path)] <> '\') then
+           dec(byte(pa[0]));
+          { if only a drive is given in path then there should be a '\' at the
+            end of the string given back }
+          if length(pa) = 2 then pa := pa + '\';
+          fexpand:=pa;
+       end;
+
+
+Function FSearch(path: pathstr; dirlist: string): pathstr;
+var
+  i,p1   : longint;
+  s      : searchrec;
+  newdir : pathstr;
+begin
+{ check if the file specified exists }
+  findfirst(path,anyfile,s);
+  if doserror=0 then
+   begin
+     findclose(s);
+     fsearch:=path;
+     exit;
+   end;
+{ No wildcards allowed in these things }
+  if (pos('?',path)<>0) or (pos('*',path)<>0) then
+    fsearch:=''
+  else
+    begin
+       { allow slash as backslash }
+       for i:=1 to length(dirlist) do
+         if dirlist[i]='/' then dirlist[i]:='\';
+       repeat
+         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<>'') 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;
+  findclose(s);
+end;
+
+
+{******************************************************************************
+                       --- Get/Set File Time,Attr ---
+******************************************************************************}
+
+procedure getftime(var f;var time : longint);
+begin
+  dosregs.bx:=textrec(f).handle;
+  dosregs.ax:=$5700;
+  msdos(dosregs);
+  loaddoserror;
+  time:=(dosregs.dx shl 16)+dosregs.cx;
+end;
+
+
+procedure setftime(var f;time : longint);
+begin
+  dosregs.bx:=textrec(f).handle;
+  dosregs.cx:=time and $ffff;
+  dosregs.dx:=time shr 16;
+  dosregs.ax:=$5701;
+  msdos(dosregs);
+  loaddoserror;
+end;
+
+
+procedure getfattr(var f;var attr : word);
+begin
+  copytodos(filerec(f).name,strlen(filerec(f).name)+1);
+  dosregs.edx:=tb_offset;
+  dosregs.ds:=tb_segment;
+  if LFNSupport then
+   begin
+     dosregs.ax:=$7143;
+     dosregs.bx:=0;
+   end
+  else
+   dosregs.ax:=$4300;
+  msdos(dosregs);
+  LoadDosError;
+  Attr:=dosregs.cx;
+end;
+
+
+procedure setfattr(var f;attr : word);
+begin
+  copytodos(filerec(f).name,strlen(filerec(f).name)+1);
+  dosregs.edx:=tb_offset;
+  dosregs.ds:=tb_segment;
+  if LFNSupport then
+   begin
+     dosregs.ax:=$7143;
+     dosregs.bx:=1;
+   end
+  else
+   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);
+     inc(hp);
+   end;
+end;
+
+
+function envstr(index : integer) : string;
+begin
+  if (index<=0) or (index>envcount) then
+   begin
+     envstr:='';
+     exit;
+   end;
+  envstr:=strpas(ppchar(pointer(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;
+     inc(hp);
+   end;
+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.12  1999-09-10 17:14:09  peter
+  Revision 1.13  1999-11-06 14:38:23  peter
+    * truncated log
+
+  Revision 1.12  1999/09/10 17:14:09  peter
     * better errorcode returning using int21h,5900
-
-  Revision 1.11  1999/09/08 18:55:49  peter
-    * pointer fixes
-
-  Revision 1.10  1999/08/13 21:23:15  peter
-    * fsearch checks first if the specified file exists and returns that
-      if it was found
-
-  Revision 1.9  1999/05/16 17:08:58  peter
-    * fixed driveletter checking
-
-  Revision 1.8  1999/05/08 19:47:22  peter
-    * check ioresult after getdir calls
-
-  Revision 1.7  1999/05/04 23:55:50  pierre
-   * unneeded assembler code converted to pascal
-
-  Revision 1.6  1999/04/28 11:42:44  peter
-    + FileNameCaseSensetive boolean
-
-  Revision 1.5  1999/04/02 00:01:29  peter
-    * fixed LFNFindfirst on network drives
-
-  Revision 1.4  1999/03/01 15:40:48  peter
-    * use external names
-    * removed all direct assembler modes
-
-  Revision 1.3  1999/01/22 15:44:59  pierre
-   Daniel change removed : broke make cycle !!
-
-  Revision 1.2  1999/01/22 10:07:03  daniel
-  - Findclose removed: This is TP incompatible!!
-
-  Revision 1.1  1998/12/21 13:07:02  peter
-    * use -FE
-
-  Revision 1.19  1998/11/23 13:53:59  peter
-    * more fexpand fixes from marco van de voort
-
-  Revision 1.18  1998/11/23 12:48:02  peter
-    * fexpand('o:') fixed to return o:\ (from the mailinglist)
-
-  Revision 1.17  1998/11/22 09:33:21  florian
-    * fexpand bug (temp. strings were too shoort) fixed, was reported
-      by Marco van de Voort
-
-  Revision 1.16  1998/11/17 09:37:41  pierre
-   * explicit conversion from word dosreg.ax to integer doserror
-
-  Revision 1.15  1998/11/01 20:27:18  peter
-    * fixed some doserror settings
-
-  Revision 1.14  1998/10/22 15:05:28  pierre
-   * fsplit adapted to long filenames
-
-  Revision 1.13  1998/09/16 16:47:24  peter
-    * merged fixes
-
-  Revision 1.11.2.2  1998/09/16 16:16:04  peter
-    * go32v1 compiles again
-
-  Revision 1.12  1998/09/11 12:46:44  pierre
-    * range check problem with LFN attr removed
-
-  Revision 1.11.2.1  1998/09/11 12:38:41  pierre
-    * conversion from LFN attr to Dos attr did not respect range checking
-
-  Revision 1.11  1998/08/28 10:45:58  peter
-    * fixed path buffer in findfirst
-
-  Revision 1.10  1998/08/27 10:30:48  pierre
-    * go32v1 RTL did not compile (LFNsupport outside go32v2 defines !)
-      I renamed tb_selector to tb_segment because
-        it is a real mode segment as opposed to
-        a protected mode selector
-      Fixed it for go32v1 (remove the $E0000000 offset !)
-
-  Revision 1.9  1998/08/26 10:04:01  peter
-    * new lfn check from mailinglist
-    * renamed win95 -> LFNSupport
-    + tb_selector, tb_offset for easier access to transferbuffer
-
-  Revision 1.8  1998/08/16 20:39:49  peter
-    + LFN Support
-
-  Revision 1.7  1998/08/16 09:12:13  michael
-  Corrected fexpand behaviour.
-
-  Revision 1.6  1998/08/05 21:01:50  michael
-  applied bugfix from maillist to fsearch
-
-  Revision 1.5  1998/05/31 14:18:13  peter
-    * force att or direct assembling
-    * cleanup of some files
-
-  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
-    + read_text_as_pchar which was not yet in the rtl
-}
-
-
-
+
+  Revision 1.11  1999/09/08 18:55:49  peter
+    * pointer fixes
+
+  Revision 1.10  1999/08/13 21:23:15  peter
+    * fsearch checks first if the specified file exists and returns that
+      if it was found
+
+  Revision 1.9  1999/05/16 17:08:58  peter
+    * fixed driveletter checking
+
+  Revision 1.8  1999/05/08 19:47:22  peter
+    * check ioresult after getdir calls
+
+  Revision 1.7  1999/05/04 23:55:50  pierre
+   * unneeded assembler code converted to pascal
+
+  Revision 1.6  1999/04/28 11:42:44  peter
+    + FileNameCaseSensetive boolean
+
+  Revision 1.5  1999/04/02 00:01:29  peter
+    * fixed LFNFindfirst on network drives
+
+  Revision 1.4  1999/03/01 15:40:48  peter
+    * use external names
+    * removed all direct assembler modes
+
+  Revision 1.3  1999/01/22 15:44:59  pierre
+   Daniel change removed : broke make cycle !!
+
+  Revision 1.2  1999/01/22 10:07:03  daniel
+  - Findclose removed: This is TP incompatible!!
+
+  Revision 1.1  1998/12/21 13:07:02  peter
+    * use -FE
+
+  Revision 1.19  1998/11/23 13:53:59  peter
+    * more fexpand fixes from marco van de voort
+
+  Revision 1.18  1998/11/23 12:48:02  peter
+    * fexpand('o:') fixed to return o:\ (from the mailinglist)
+
+  Revision 1.17  1998/11/22 09:33:21  florian
+    * fexpand bug (temp. strings were too shoort) fixed, was reported
+      by Marco van de Voort
+
+  Revision 1.16  1998/11/17 09:37:41  pierre
+   * explicit conversion from word dosreg.ax to integer doserror
+
+  Revision 1.15  1998/11/01 20:27:18  peter
+    * fixed some doserror settings
+
+  Revision 1.14  1998/10/22 15:05:28  pierre
+   * fsplit adapted to long filenames
+
+  Revision 1.13  1998/09/16 16:47:24  peter
+    * merged fixes
+
+  Revision 1.11.2.2  1998/09/16 16:16:04  peter
+    * go32v1 compiles again
+
+}
+
+
+

rtl/go32v2/system.pp

@@ -1285,7 +1285,10 @@ Begin
 End.
 {
   $Log$
-  Revision 1.21  1999-10-31 09:34:48  jonas
+  Revision 1.22  1999-11-06 14:38:24  peter
+    * truncated log
+
+  Revision 1.21  1999/10/31 09:34:48  jonas
     * updated for new syntax of sysgetmem
 
   Revision 1.20  1999/10/28 09:53:19  peter
@@ -1347,99 +1350,4 @@ End.
   Revision 1.2  1998/12/21 14:22:02  pierre
    * old_int?? transformed to cvar to be readable by dpmiexcp
 
-  Revision 1.1  1998/12/21 13:07:03  peter
-    * use -FE
-
-  Revision 1.25  1998/12/15 22:42:52  peter
-    * removed temp symbols
-
-  Revision 1.24  1998/11/29 22:28:10  peter
-    + io-error 103 added
-
-  Revision 1.23  1998/11/16 14:15:02  pierre
-    * changed getdir(byte,string) to getdir(byte,shortstring)
-
-  Revision 1.22  1998/10/26 14:49:46  pierre
-   * system debug info output to stderr
-
-  Revision 1.21  1998/10/20 07:34:07  pierre
-   + systemdebug reports about unclosed files at exit
-
-  Revision 1.20  1998/10/13 21:41:06  peter
-    + int 0 for divide by zero
-
-  Revision 1.19  1998/09/14 10:48:05  peter
-    * FPC_ names
-    * Heap manager is now system independent
-
-  Revision 1.18  1998/08/28 10:48:04  peter
-    * fixed chdir with drive changing
-    * updated checklfn from mailinglist
-
-  Revision 1.17  1998/08/27 10:30:51  pierre
-    * go32v1 RTL did not compile (LFNsupport outside go32v2 defines !)
-      I renamed tb_selector to tb_segment because
-        it is a real mode segment as opposed to
-        a protected mode selector
-      Fixed it for go32v1 (remove the $E0000000 offset !)
-
-  Revision 1.16  1998/08/26 10:04:03  peter
-    * new lfn check from mailinglist
-    * renamed win95 -> LFNSupport
-    + tb_selector, tb_offset for easier access to transferbuffer
-
-  Revision 1.15  1998/08/19 10:56:34  pierre
-    + added some special code for C interface
-      to avoid loading of crt1.o or dpmiexcp.o from the libc.a
-
-  Revision 1.14  1998/08/04 14:34:38  pierre
-    * small bug fix to get it compiled with bugfix version !!
-      (again the asmmode problem !!!
-      Peter it was really not the best idea you had !!)
-
-  Revision 1.13  1998/07/30 13:26:22  michael
-  + Added support for ErrorProc variable. All internal functions are required
-    to call HandleError instead of runerror from now on.
-    This is necessary for exception support.
-
-  Revision 1.12  1998/07/13 21:19:08  florian
-    * some problems with ansi string support fixed
-
-  Revision 1.11  1998/07/07 12:33:08  carl
-    * added 2k buffer for stack checking for correct io on error
-
-  Revision 1.10  1998/07/02 12:29:20  carl
-    * IOCheck for rmdir,chdir and mkdir as in TP
-    NOTE: I'm pretty SURE this will not compile and link correctly with FPC
-  0.99.5
-
-  Revision 1.9  1998/07/01 15:29:57  peter
-    * better readln/writeln
-
-  Revision 1.8  1998/06/26 08:19:10  pierre
-    + all debug in ifdef SYSTEMDEBUG
-    + added local arrays :
-      opennames names of opened files
-      fileopen boolean array to know if still open
-      usefull with gdb if you get problems about too
-      many open files !!
-
-  Revision 1.7  1998/06/15 15:17:08  daniel
-  * RTLLITE conditional added to produce smaller RTL.
-
-  Revision 1.6  1998/05/31 14:18:29  peter
-    * force att or direct assembling
-    * cleanup of some files
-
-  Revision 1.5  1998/05/21 19:30:52  peter
-    * objects compiles for linux
-    + assign(pchar), assign(char), rename(pchar), rename(char)
-    * fixed read_text_as_array
-    + read_text_as_pchar which was not yet in the rtl
-
-  Revision 1.4  1998/05/04 17:58:41  peter
-    * fix for smartlinking with _ARGS
-
-  Revision 1.3  1998/05/04 16:21:54  florian
-    + LFNSupport flag to the interface moved
 }

rtl/inc/astrings.inc

@@ -633,7 +633,10 @@ end;
 
 {
   $Log$
-  Revision 1.34  1999-11-02 23:57:54  peter
+  Revision 1.35  1999-11-06 14:35:38  peter
+    * truncated log
+
+  Revision 1.34  1999/11/02 23:57:54  peter
     * fixed copy where size+index could be < 0
 
   Revision 1.33  1999/10/27 14:27:49  florian
@@ -696,164 +699,4 @@ end;
   Revision 1.16  1999/04/06 10:06:51  michael
   * Fixed chararray to ansistring conversion
 
-  Revision 1.15  1999/04/01 22:00:48  peter
-    * universal names for str/val (ansistr instead of stransi)
-    * '1.' support for val() this is compatible with tp7
-
-  Revision 1.14  1999/03/16 17:49:40  jonas
-    * changes for internal Val code (do a "make cycle OPT=-dvalintern" to test)
-    * in text.inc: changed RTE 106 when read integer values are out of bounds to RTE 201
-    * in systemh.inc: disabled "support_fixed" for the i386 because it gave internal errors,
-
-  Revision 1.13  1999/03/02 18:24:51  peter
-    * function names cleanup
-    + chararray -> ansistring
-
-  Revision 1.12  1999/03/01 15:41:02  peter
-    * use external names
-    * removed all direct assembler modes
-
-  Revision 1.11  1999/02/04 14:55:42  michael
-  * Fixed pos
-
-  Revision 1.10  1999/02/04 10:49:21  florian
-    + routines for range checking added
-
-  Revision 1.9  1999/02/02 11:37:34  peter
-    * fixed ansi2short
-
-  Revision 1.8  1999/01/06 14:48:43  michael
-  + Implemented more str() functions
-
-  Revision 1.7  1999/01/06 13:03:39  peter
-    * fixed str() and made it working
-
-  Revision 1.6  1999/01/06 12:25:02  florian
-    * naming for str(...) routines inserted
-    * don't know what in int64 changed
-
-  Revision 1.5  1998/12/15 22:43:01  peter
-    * removed temp symbols
-
-  Revision 1.4  1998/11/18 10:56:46  michael
-  + Fixed pchar2ansi
-
-  Revision 1.3  1998/11/17 12:16:07  michael
-  + Fixed copy. Now reference count is correct
-
-  Revision 1.2  1998/11/17 11:33:22  peter
-    + several checks for empty string
-
-  Revision 1.1  1998/11/17 10:34:18  michael
-  + renamed from astrings.pp to astrings.inc
-
-  Revision 1.34  1998/11/17 00:41:11  peter
-    * renamed string functions
-
-  Revision 1.33  1998/11/16 15:42:04  peter
-    + char2ansi
-
-  Revision 1.32  1998/11/16 11:11:47  michael
-  + Fix for Insert and Delete functions
-
-  Revision 1.31  1998/11/13 14:37:11  michael
-  + Insert procedure corrected
-
-  Revision 1.30  1998/11/05 14:20:36  peter
-    * removed warnings
-
-  Revision 1.29  1998/11/04 20:34:04  michael
-  + Removed ifdef useansistrings
-
-  Revision 1.28  1998/11/04 15:39:44  michael
-  + Small fixes to assign and add
-
-  Revision 1.27  1998/11/04 10:20:48  peter
-    * ansistring fixes
-
-  Revision 1.26  1998/11/02 09:46:12  michael
-  + Fix for assign of null string
-
-  Revision 1.25  1998/10/30 21:42:48  michael
-  Fixed assignment of NIL string.
-
-  Revision 1.24  1998/10/22 11:32:23  michael
-  + AssignAnsistring no longer copies constant ansistrings;
-  + CompareAnsiString is now faster (1 call to length less)
-  + UniqueAnsiString is fixed.
-
-  Revision 1.23  1998/10/21 23:01:54  michael
-  + Some more corrections
-
-  Revision 1.22  1998/10/21 09:03:11  michael
-  + more fixes so it compiles
-
-  Revision 1.21  1998/10/21 08:56:58  michael
-  + Fix so it compiles
-
-  Revision 1.20  1998/10/21 08:38:46  florian
-    * ansistringconcat fixed
-
-  Revision 1.19  1998/10/20 12:46:11  florian
-    * small fixes to ansicompare
-
-  Revision 1.18  1998/09/28 14:02:34  michael
-  + AnsiString changes
-
-  Revision 1.17  1998/09/27 22:44:50  florian
-    * small fixes
-    * made UniqueAnsistring public
-    * ...
-
-  Revision 1.16  1998/09/20 17:49:08  florian
-    * some ansistring fixes
-
-  Revision 1.15  1998/09/19 08:33:17  florian
-    * some internal procedures take now an pointer instead of a
-      ansistring
-
-  Revision 1.14  1998/09/14 10:48:14  peter
-    * FPC_ names
-    * Heap manager is now system independent
-
-  Revision 1.13  1998/08/23 20:58:51  florian
-    + rtti for objects and classes
-    + TObject.GetClassName implemented
-
-  Revision 1.12  1998/08/22 09:32:12  michael
-  + minor fixes typos, and ansi2pchar
-
-  Revision 1.11  1998/08/08 12:28:10  florian
-    * a lot small fixes to the extended data type work
-
-  Revision 1.10  1998/07/29 21:44:34  michael
-  + Implemented reading/writing of ansistrings
-
-  Revision 1.9  1998/07/20 23:36:56  michael
-  changes for ansistrings
-
-  Revision 1.8  1998/07/13 21:19:09  florian
-    * some problems with ansi string support fixed
-
-  Revision 1.7  1998/07/06 14:29:08  michael
-  + Added Public,Alias directives for some calls
-
-  Revision 1.6  1998/06/25 08:41:44  florian
-    * better rtti
-
-  Revision 1.5  1998/06/12 07:39:13  michael
-  + Added aliases for Incr/Decr ref.
-
-  Revision 1.4  1998/06/08 19:35:02  michael
-  Some changes to integrate in system unit
-
-  Revision 1.3  1998/06/08 12:38:22  michael
-  Implemented rtti, inserted ansistrings again
-
-  Revision 1.2  1998/05/12 10:42:44  peter
-    * moved getopts to inc/, all supported OS's need argc,argv exported
-    + strpas, strlen are now exported in the systemunit
-    * removed logs
-    * removed $ifdef ver_above
-
 }

rtl/inc/heaptrc.pp

@@ -897,7 +897,10 @@ finalization
 end.
 {
   $Log$
-  Revision 1.26  1999-11-01 13:56:50  peter
+  Revision 1.27  1999-11-06 14:35:38  peter
+    * truncated log
+
+  Revision 1.26  1999/11/01 13:56:50  peter
     * freemem,reallocmem now get var argument
 
   Revision 1.25  1999/10/30 17:39:05  peter
@@ -959,33 +962,4 @@ end.
   Revision 1.9  1999/01/22 12:39:22  pierre
    + added text arg for dump_stack
 
-  Revision 1.8  1998/12/15 23:49:51  michael
-  + Removed underscores in heaptrc unit
-
-  Revision 1.7  1998/11/16 12:20:13  peter
-    * write extra info also for wrong size
-
-  Revision 1.6  1998/11/06 08:46:01  pierre
-    * size is now also checked
-    + added halt_on_error variable (default true)
-      to stop at first error in getmem/freemem
-
-  Revision 1.5  1998/10/09 11:59:31  pierre
-    * changed default to keepreleased=false
-      (allows to compile pp in one call without reaching the
-      64Mb limit of Windows 95 dos box)
-    * corrected so typo errors
-
-  Revision 1.4  1998/10/08 14:49:05  pierre
-   + added possibility for more info
-
-  Revision 1.3  1998/10/06 17:09:13  pierre
-   + added trace of first dispose for errors
-
-  Revision 1.2  1998/10/02 10:35:38  peter
-    + quicktrace
-
-  Revision 1.1  1998/10/01 14:54:20  peter
-    + first version
-
 }

rtl/inc/objects.pp

@@ -2758,7 +2758,10 @@ END;
 END.
 {
   $Log$
-  Revision 1.30  1999-09-10 17:15:13  peter
+  Revision 1.31  1999-11-06 14:35:38  peter
+    * truncated log
+
+  Revision 1.30  1999/09/10 17:15:13  peter
     * fixed freeall
 
   Revision 1.29  1999/06/14 17:48:04  peter
@@ -2822,29 +2825,4 @@ END.
   Revision 1.10  1998/10/23 16:51:18  pierre
    * vmtlink type changed to pointer
 
-  Revision 1.9  1998/10/22 18:23:55  peter
-    + packed record for conversion records
-
-  Revision 1.8  1998/09/09 15:29:02  peter
-    * removed some warnings
-
-  Revision 1.7  1998/07/15 12:08:33  carl
-    + Atari TOS support
-
-  Revision 1.6  1998/07/08 12:00:25  carl
-    * fixed problem with m68k asm syntax
-    * i386_att put back in, and only in cpu86 defined
-
-  Revision 1.4  1998/05/30 14:24:42  peter
-    * ATT asmparsing always
-
-  Revision 1.3  1998/05/25 09:50:04  peter
-    * Platform.inc -> platform.inc
-
-  Revision 1.2  1998/05/21 19:30:58  peter
-    * objects compiles for linux
-    + assign(pchar), assign(char), rename(pchar), rename(char)
-    * fixed read_text_as_array
-    + read_text_as_pchar which was not yet in the rtl
-
 }

rtl/inc/sstrings.inc

@@ -565,7 +565,10 @@ end;
 
 {
   $Log$
-  Revision 1.29  1999-07-05 20:04:26  peter
+  Revision 1.30  1999-11-06 14:35:39  peter
+    * truncated log
+
+  Revision 1.29  1999/07/05 20:04:26  peter
     * removed temp defines
 
   Revision 1.28  1999/05/06 09:05:13  peter
@@ -633,28 +636,4 @@ end;
   Revision 1.10  1998/08/08 12:28:13  florian
     * a lot small fixes to the extended data type work
 
-  Revision 1.9  1998/07/18 17:14:23  florian
-    * strlenint type implemented
-
-  Revision 1.8  1998/07/10 11:02:38  peter
-    * support_fixed, becuase fixed is not 100% yet for the m68k
-
-  Revision 1.7  1998/07/02 12:14:19  carl
-    * No SINGLE type for non-intel processors!!
-
-  Revision 1.6  1998/06/25 09:44:19  daniel
-  + RTLLITE directive to compile minimal RTL.
-
-  Revision 1.5  1998/06/04 23:45:59  peter
-    * comp,extended are only i386 added support_comp,support_extended
-
-  Revision 1.4  1998/05/31 14:14:52  peter
-    * removed warnings using comp()
-
-  Revision 1.3  1998/05/12 10:42:45  peter
-    * moved getopts to inc/, all supported OS's need argc,argv exported
-    + strpas, strlen are now exported in the systemunit
-    * removed logs
-    * removed $ifdef ver_above
-
 }

rtl/inc/system.inc

@@ -580,7 +580,10 @@ end;
 
 {
   $Log$
-  Revision 1.68  1999-10-26 12:31:00  peter
+  Revision 1.69  1999-11-06 14:35:39  peter
+    * truncated log
+
+  Revision 1.68  1999/10/26 12:31:00  peter
     * *errorproc are not procvars instead of pointers which allows better
       error checking for the parameters (shortstring<->ansistring)
 
@@ -647,157 +650,4 @@ end;
       assembler code in i386.inc
       (call to overloaded function in assembler block !)
 
-  Revision 1.48  1998/12/18 17:21:33  peter
-    * fixed io-error handling
-
-  Revision 1.47  1998/12/15 22:43:03  peter
-    * removed temp symbols
-
-  Revision 1.46  1998/12/10 23:59:56  peter
-    * removed warnign
-
-  Revision 1.45  1998/12/01 14:00:10  pierre
-    + added conversion from exceptions into run time error
-      (only if syswin32 compiled with -ddebug for now !)
-    * added HandleError(errno,frame)
-      where you specify the frame
-      needed for win32 exception handling
-
-  Revision 1.44  1998/11/26 23:16:15  jonas
-    * changed RandSeed and OldRandSeed to Cardinal to avoid negative random numbers
-
-  Revision 1.43  1998/11/17 10:36:07  michael
-  + renamed astrings.pp to astrings.inc
-
-  Revision 1.42  1998/11/16 10:21:25  peter
-    * fixes for H+
-
-  Revision 1.41  1998/11/05 10:29:36  pierre
-   * fix for length(char) in const expressions
-
-  Revision 1.40  1998/11/04 20:34:02  michael
-  + Removed ifdef useansistrings
-
-  Revision 1.39  1998/10/12 22:11:28  jonas
-    * fixed RandSeed bug
-
-  Revision 1.38  1998/10/12 12:43:37  florian
-    * made FPC_HANDLEERROR public
-
-  Revision 1.37  1998/10/07 11:40:08  jonas
-    * changed seed2 and seed3 to cardinal to prevent overflow
-
-
-  Revision 1.36  1998/10/05 12:32:51  peter
-    + assert() support
-
-  Revision 1.35  1998/10/02 09:25:11  peter
-    * more constant expression evals
-
-  Revision 1.34  1998/09/22 15:30:54  peter
-    * shortstring=string type added
-
-  Revision 1.33  1998/09/16 13:08:03  michael
-  Added AbstractErrorHandler
-
-  Revision 1.32  1998/09/16 12:37:07  michael
-  Added FPC_ prefix to abstracterror
-
-  Revision 1.31  1998/09/15 17:12:32  michael
-  + Merged changes from fixes branch
-
-
-  Revision 1.30  1998/09/14 10:48:20  peter
-    * FPC_ names
-    * Heap manager is now system independent
-
-  Revision 1.29.2.1  1998/09/15 17:08:43  michael
-  + Added abstracterror call
-
-  Revision 1.29  1998/09/01 17:36:21  peter
-    + internconst
-
-  Revision 1.28  1998/08/17 12:24:16  carl
-    + important comment added
-
-  Revision 1.27  1998/08/13 16:22:11  jonas
-  * random now returns a value between 0 and max-1 instead of between 0 and max
-
-  Revision 1.26  1998/08/11 00:05:26  peter
-    * $ifdef ver0_99_5 updates
-
-  Revision 1.25  1998/07/30 13:26:18  michael
-  + Added support for ErrorProc variable. All internal functions are required
-    to call HandleError instead of runerror from now on.
-    This is necessary for exception support.
-
-  Revision 1.24  1998/07/28 20:37:45  michael
-  + added setjmp/longjmp and exception support
-
-  Revision 1.23  1998/07/23 19:53:20  michael
-  + Adapted assert to Delphi format
-
-  Revision 1.22  1998/07/23 13:08:41  michael
-  + Implemented DO_ASSERT function.
-
-  Revision 1.21  1998/07/15 12:09:35  carl
-    * would not compile under FPC v0.99.5
-
-  Revision 1.20  1998/07/13 21:19:12  florian
-    * some problems with ansi string support fixed
-
-  Revision 1.19  1998/07/08 11:56:55  carl
-    * randon and Random(l) now work correctly - don't touch it works!
-
-  Revision 1.18  1998/07/02 13:01:55  carl
-    * hmmm... it is luck (BSS zeroed with GAS) that DoError and ErrorBase work.
-      Now they are initilized instead.
-
-  Revision 1.17  1998/07/02 12:53:09  carl
-    * DOERROR RESOTRED! DON'T TOUCH :)
-
-  Revision 1.16  1998/07/02 12:11:50  carl
-    * no SINGLE in m68k and other processors!
-
-  Revision 1.15  1998/07/02 09:25:05  peter
-    * fixed do_error in runtimeerror
-
-  Revision 1.14  1998/07/01 15:29:59  peter
-    * better readln/writeln
-
-  Revision 1.13  1998/06/26 08:21:09  daniel
-  - Doerror removed.
-
-  Revision 1.12  1998/06/25 14:04:25  peter
-    + internal inc/dec
-
-  Revision 1.11  1998/06/25 09:44:20  daniel
-  + RTLLITE directive to compile minimal RTL.
-
-  Revision 1.10  1998/06/15 15:16:26  daniel
-  * RTLLITE conditional added to produce smaller RTL
-
-  Revision 1.9  1998/06/10 07:46:45  michael
-  + Forgot to commit some changes
-
-  Revision 1.8  1998/06/08 12:38:24  michael
-  Implemented rtti, inserted ansistrings again
-
-  Revision 1.7  1998/06/04 23:46:01  peter
-    * comp,extended are only i386 added support_comp,support_extended
-
-  Revision 1.6  1998/05/20 11:23:09  cvs
-  * test commit. Shouldn't be allowed.
-
-  Revision 1.5  1998/05/12 10:42:45  peter
-    * moved getopts to inc/, all supported OS's need argc,argv exported
-    + strpas, strlen are now exported in the systemunit
-    * removed logs
-    * removed $ifdef ver_above
-
-  Revision 1.4  1998/04/16 12:30:47  peter
-    + inc(pchar), dec(pchar), incc(pchar,a),dec(pchar,a)
-
-  Revision 1.3  1998/04/08 07:53:32  michael
-  + Changed Random() function. Moved from system to processor dependent files (from Pedro Gimeno)
 }

rtl/inc/systemh.inc

@@ -398,7 +398,10 @@ const
 
 {
   $Log$
-  Revision 1.64  1999-10-27 14:19:10  florian
+  Revision 1.65  1999-11-06 14:35:39  peter
+    * truncated log
+
+  Revision 1.64  1999/10/27 14:19:10  florian
     + StringOfChar
 
   Revision 1.63  1999/10/26 12:31:00  peter
@@ -464,142 +467,4 @@ const
   Revision 1.45  1998/12/15 22:43:04  peter
     * removed temp symbols
 
-  Revision 1.44  1998/11/27 14:50:57  peter
-    + open strings, $P switch support
-
-  Revision 1.43  1998/11/26 23:16:13  jonas
-    * changed RandSeed and OldRandSeed to Cardinal to avoid negative random numbers
-
-  Revision 1.42  1998/11/24 17:12:43  peter
-    * fixed length(char)
-    - removed obsolete version.inc
-
-  Revision 1.41  1998/11/16 10:21:26  peter
-    * fixes for H+
-
-  Revision 1.40  1998/11/05 10:29:37  pierre
-   * fix for length(char) in const expressions
-
-  Revision 1.39  1998/11/04 20:34:01  michael
-  + Removed ifdef useansistrings
-
-  Revision 1.38  1998/11/04 10:20:51  peter
-    * ansistring fixes
-
-  Revision 1.37  1998/10/10 15:28:47  peter
-    + read single,fixed
-    + val with code:longint
-    + val for fixed
-
-  Revision 1.36  1998/10/05 17:22:54  pierre
-   * avoid overflow on $8000000 with $Q-
-
-  Revision 1.35  1998/10/05 12:32:52  peter
-    + assert() support
-
-  Revision 1.34  1998/10/01 14:54:48  peter
-    * export also stackframe functions
-
-  Revision 1.33  1998/09/28 14:02:33  michael
-  + AnsiString changes
-
-  Revision 1.32  1998/09/22 15:30:55  peter
-    * shortstring=string type added
-
-  Revision 1.31  1998/09/20 17:49:09  florian
-    * some ansistring fixes
-
-  Revision 1.30  1998/09/17 16:34:17  peter
-    * new eof,eoln,seekeoln,seekeof
-    * speed upgrade for read_string
-    * inoutres 104/105 updates for read_* and write_*
-
-  Revision 1.29  1998/09/16 13:08:04  michael
-  Added AbstractErrorHandler
-
-  Revision 1.28  1998/09/14 10:48:22  peter
-    * FPC_ names
-    * Heap manager is now system independent
-
-  Revision 1.27  1998/09/08 15:03:28  peter
-    * moved getmem/freemem/memavail/maxavail to heaph.inc
-
-  Revision 1.26  1998/09/04 18:16:14  peter
-    * uniform filerec/textrec (with recsize:longint and name:0..255)
-
-  Revision 1.25  1998/09/01 17:36:22  peter
-    + internconst
-
-  Revision 1.24  1998/08/11 21:39:08  peter
-    * splitted default_extended from support_extended
-
-  Revision 1.23  1998/08/11 00:05:27  peter
-    * $ifdef ver0_99_5 updates
-
-  Revision 1.22  1998/08/08 12:28:14  florian
-    * a lot small fixes to the extended data type work
-
-  Revision 1.21  1998/07/30 13:26:17  michael
-  + Added support for ErrorProc variable. All internal functions are required
-    to call HandleError instead of runerror from now on.
-    This is necessary for exception support.
-
-  Revision 1.20  1998/07/28 20:37:47  michael
-  + added setjmp/longjmp and exception support
-
-  Revision 1.19  1998/07/20 23:36:57  michael
-  changes for ansistrings
-
-  Revision 1.18  1998/07/18 17:14:24  florian
-    * strlenint type implemented
-
-  Revision 1.17  1998/07/10 11:02:39  peter
-    * support_fixed, becuase fixed is not 100% yet for the m68k
-
-  Revision 1.16  1998/07/02 12:13:18  carl
-    * No SINGLE type for m68k or other non-intel processors!
-
-  Revision 1.15  1998/07/01 14:43:46  carl
-    - max_frame_dump reduced to 8, 20 is too much!
-
-  Revision 1.14  1998/06/25 14:04:26  peter
-    + internal inc/dec
-
-  Revision 1.13  1998/06/25 09:44:21  daniel
-  + RTLLITE directive to compile minimal RTL.
-
-  Revision 1.12  1998/06/15 15:16:27  daniel
-
-  * RTLLITE conditional added to produce smaller RTL
-
-  Revision 1.11  1998/06/08 12:38:23  michael
-  Implemented rtti, inserted ansistrings again
-
-  Revision 1.10  1998/06/04 23:46:02  peter
-    * comp,extended are only i386 added support_comp,support_extended
-
-  Revision 1.9  1998/06/04 08:26:03  pierre
-    * boolean internal definition again (needed to compile
-      older RTL's)
-
-  Revision 1.8  1998/06/03 23:39:53  peter
-    + boolean=bytebool
-
-  Revision 1.7  1998/05/22 12:34:11  peter
-    * fixed the optimizes of daniel
-
-  Revision 1.6  1998/05/21 19:31:00  peter
-    * objects compiles for linux
-    + assign(pchar), assign(char), rename(pchar), rename(char)
-    * fixed read_text_as_array
-    + read_text_as_pchar which was not yet in the rtl
-
-  Revision 1.5  1998/05/12 10:42:45  peter
-    * moved getopts to inc/, all supported OS's need argc,argv exported
-    + strpas, strlen are now exported in the systemunit
-    * removed logs
-    * removed $ifdef ver_above
-
-  Revision 1.4  1998/04/16 12:30:47  peter
-    + inc(pchar), dec(pchar), incc(pchar,a),dec(pchar,a)
 }

rtl/inc/text.inc

@@ -994,7 +994,10 @@ end;
 
 {
   $Log$
-  Revision 1.59  1999-10-26 12:25:19  peter
+  Revision 1.60  1999-11-06 14:35:39  peter
+    * truncated log
+
+  Revision 1.59  1999/10/26 12:25:19  peter
     * inoutres 103 for closed files, just like delphi
 
   Revision 1.58  1999/10/04 20:42:45  peter
@@ -1059,126 +1062,4 @@ end;
     * use external names
     * removed all direct assembler modes
 
-  Revision 1.39  1999/02/17 10:13:29  peter
-    * when error when opening a file, then reset the mode to fmclosed
-
-  Revision 1.38  1999/01/28 19:38:19  peter
-    * fixed readln(ansistring)
-
-  Revision 1.37  1998/12/15 22:43:06  peter
-    * removed temp symbols
-
-  Revision 1.36  1998/12/11 18:07:39  peter
-    * fixed read(char) with empty buffer
-
-  Revision 1.35  1998/11/27 14:50:58  peter
-    + open strings, $P switch support
-
-  Revision 1.34  1998/11/16 12:21:48  peter
-    * fixes for 0.99.8
-
-  Revision 1.33  1998/10/23 00:03:29  peter
-    * write(pchar) has check for nil
-
-  Revision 1.32  1998/10/20 14:37:45  peter
-    * fixed maxlen which was not correct after my read_string update
-
-  Revision 1.31  1998/10/10 15:28:48  peter
-    + read single,fixed
-    + val with code:longint
-    + val for fixed
-
-  Revision 1.30  1998/09/29 08:39:07  michael
-  + Ansistring write now gets pointer.
-
-  Revision 1.29  1998/09/28 14:27:08  michael
-  + AnsiStrings update
-
-  Revision 1.28  1998/09/24 23:32:24  peter
-    * fixed small bug with a #13#10 on a line
-
-  Revision 1.27  1998/09/18 12:23:22  peter
-    * fixed a bug introduced by my previous update
-
-  Revision 1.26  1998/09/17 16:34:18  peter
-    * new eof,eoln,seekeoln,seekeof
-    * speed upgrade for read_string
-    * inoutres 104/105 updates for read_* and write_*
-
-  Revision 1.25  1998/09/14 10:48:23  peter
-    * FPC_ names
-    * Heap manager is now system independent
-
-  Revision 1.24  1998/09/08 10:14:06  peter
-    + textrecbufsize
-
-  Revision 1.23  1998/08/26 15:33:28  peter
-    * reset bufpos,bufend in opentext like tp7
-
-  Revision 1.22  1998/08/26 11:23:25  pierre
-    * close did not reset the bufpos and bufend fields
-      led to problems when using the same file several times
-
-  Revision 1.21  1998/08/17 22:42:17  michael
-  + Flush on close only for output files cd ../inc
-
-  Revision 1.20  1998/08/11 00:05:28  peter
-    * $ifdef ver0_99_5 updates
-
-  Revision 1.19  1998/07/30 13:26:16  michael
-  + Added support for ErrorProc variable. All internal functions are required
-    to call HandleError instead of runerror from now on.
-    This is necessary for exception support.
-
-  Revision 1.18  1998/07/29 21:44:35  michael
-  + Implemented reading/writing of ansistrings
-
-  Revision 1.17  1998/07/19 19:55:33  michael
-  + fixed rename. Changed p to p^
-
-  Revision 1.16  1998/07/10 11:02:40  peter
-    * support_fixed, becuase fixed is not 100% yet for the m68k
-
-  Revision 1.15  1998/07/06 15:56:43  michael
-  Added length checking for string reading
-
-  Revision 1.14  1998/07/02 12:14:56  carl
-    + Each IOCheck routine now check InOutRes before, just like TP
-
-  Revision 1.13  1998/07/01 15:30:00  peter
-    * better readln/writeln
-
-  Revision 1.12  1998/07/01 14:48:10  carl
-    * bugfix of WRITE_TEXT_BOOLEAN , was not TP compatible
-    + added explicit typecast in OpenText
-
-  Revision 1.11  1998/06/25 09:44:22  daniel
-  + RTLLITE directive to compile minimal RTL.
-
-  Revision 1.10  1998/06/04 23:46:03  peter
-    * comp,extended are only i386 added support_comp,support_extended
-
-  Revision 1.9  1998/06/02 16:47:56  pierre
-    * bug for boolean values greater than one fixed
-
-  Revision 1.8  1998/05/31 14:14:54  peter
-    * removed warnings using comp()
-
-  Revision 1.7  1998/05/27 00:19:21  peter
-    * fixed crt input
-
-  Revision 1.6  1998/05/21 19:31:01  peter
-    * objects compiles for linux
-    + assign(pchar), assign(char), rename(pchar), rename(char)
-    * fixed read_text_as_array
-    + read_text_as_pchar which was not yet in the rtl
-
-  Revision 1.5  1998/05/12 10:42:45  peter
-    * moved getopts to inc/, all supported OS's need argc,argv exported
-    + strpas, strlen are now exported in the systemunit
-    * removed logs
-    * removed $ifdef ver_above
-
-  Revision 1.4  1998/04/07 22:40:46  florian
-    * final fix of comp writing
 }

rtl/linux/linux.pp

@@ -3790,7 +3790,10 @@ End.
 
 {
   $Log$
-  Revision 1.49  1999-10-28 09:48:31  peter
+  Revision 1.50  1999-11-06 14:39:12  peter
+    * truncated log
+
+  Revision 1.49  1999/10/28 09:48:31  peter
     + mmap
 
   Revision 1.48  1999/10/22 10:37:44  peter
@@ -3852,86 +3855,4 @@ End.
   Revision 1.29  1999/02/02 21:19:54  michael
   Corrected wrong mode error in fdopen
 
-  Revision 1.28  1999/01/20 13:29:09  peter
-    * utimbuf alias added
-
-  Revision 1.27  1998/12/11 18:08:57  peter
-    * fixed assignstream
-
-  Revision 1.26  1998/11/24 15:30:12  michael
-  * Bugfix in assignstream. . Now wait is performed upon close
-
-  Revision 1.25  1998/11/16 10:21:28  peter
-    * fixes for H+
-
-  Revision 1.24  1998/11/10 14:57:53  peter
-    * renamed rename -> FRename
-
-  Revision 1.23  1998/10/30 15:47:11  peter
-    * fixed glob, which did not reset  the root
-
-  Revision 1.22  1998/10/23 00:05:32  peter
-    * getenv with envp=nil check
-
-  Revision 1.21  1998/10/15 08:31:11  peter
-    * type aliases using delphi typenaming
-
-  Revision 1.20  1998/10/11 12:23:11  michael
-  + Implemented Rename
-
-  Revision 1.19  1998/09/18 09:56:33  peter
-    * merged
-
-  Revision 1.18.2.1  1998/09/18 09:53:46  peter
-    * fixed winsize record
-
-  Revision 1.18  1998/09/08 13:01:51  michael
-  + Signal call now correctly implemented
-
-  Revision 1.17  1998/08/19 00:50:31  peter
-    * 'i<>0 and ' needs brackets
-
-  Revision 1.16  1998/08/16 10:23:28  michael
-  fixed typos
-
-  Revision 1.15  1998/08/16 09:12:14  michael
-  Corrected fexpand behaviour.
-
-  Revision 1.14  1998/08/14 12:01:04  carl
-    * ifdef i386 for ports access
-
-  Revision 1.13  1998/08/12 11:10:25  michael
-  Added settimeofday function
-
-  Revision 1.12  1998/07/28 09:27:06  michael
-  restored previous version. A bug in the compiler prevents compilation.
-
-  Revision 1.10  1998/06/16 08:21:58  michael
-  * PClose didn't flush textfiles before closing. Now it does
-
-  Revision 1.9  1998/06/03 11:55:33  michael
-  + Added IO port calls
-
-  Revision 1.8  1998/05/06 18:45:32  peter
-    * fixed the shell() bug (the correct code was also in Popen) moved the
-      argv generation to CreateShellArgv
-    + Execve with pchar instead of string
-
-  Revision 1.7  1998/05/06 12:35:26  michael
-  + Removed log from before restored version.
-
-  Revision 1.6  1998/04/15 11:23:53  michael
-  + Added some calls to make common API more efficient
-
-  Revision 1.5  1998/04/10 15:23:03  michael
-  + Pclose now returns exit status of process
-
-  Revision 1.4  1998/04/07 13:08:29  michael
-  + Added flock for file locking
-
-  Revision 1.3  1998/04/07 12:27:41  peter
-    * fixed fexpand('..')
-
-  Revision 1.2  1998/04/04 17:07:17  michael
-  + Fixed AssignStream, it completely refused to work
 }

rtl/linux/ports.pp

@@ -101,4 +101,4 @@ begin
   Linux.readport(p,Result);
 end;
 
-end.
+end.

rtl/linux/syslinux.pp

@@ -680,7 +680,10 @@ End.
 
 {
   $Log$
-  Revision 1.28  1999-10-28 09:50:06  peter
+  Revision 1.29  1999-11-06 14:39:12  peter
+    * truncated log
+
+  Revision 1.28  1999/10/28 09:50:06  peter
     * use mmap instead of brk
 
   Revision 1.27  1999/09/10 15:40:35  peter
@@ -744,24 +747,4 @@ End.
   Revision 1.9  1998/07/20 23:40:20  michael
   changed sbrk to fc_sbrk, to avoid conflicts with C library.
 
-  Revision 1.8  1998/07/13 21:19:14  florian
-    * some problems with ansi string support fixed
-
-  Revision 1.7  1998/07/02 12:36:21  carl
-    * IOCheck/InOutRes check for mkdir, chdir and rmdir as in TP
-
-  Revision 1.6  1998/07/01 15:30:01  peter
-    * better readln/writeln
-
-  Revision 1.4  1998/05/30 14:18:43  peter
-    * fixed to remake with -Rintel in the ppc386.cfg
-
-  Revision 1.3  1998/05/12 10:42:48  peter
-    * moved getopts to inc/, all supported OS's need argc,argv exported
-    + strpas, strlen are now exported in the systemunit
-    * removed logs
-    * removed $ifdef ver_above
-
-  Revision 1.2  1998/05/06 12:35:26  michael
-  + Removed log from before restored version.
 }

rtl/objpas/dati.inc

@@ -1,743 +1,746 @@
-{
-    *********************************************************************
-    $Id$
-    Copyright (C) 1997, 1998 Gertjan Schouten
-
-    This program is free software; you can redistribute it and/or modify
-    it under the terms of the GNU General Public License as published by
-    the Free Software Foundation; either version 2 of the License, or
-    (at your option) any later version.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-    GNU General Public License for more details.
-
-    You should have received a copy of the GNU General Public License
-    along with this program; if not, write to the Free Software
-    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-    *********************************************************************
-
-    System Utilities For Free Pascal
-}
-
-{==============================================================================}
-{   internal functions                                                         }
-{==============================================================================}
-
-const
-   DayTable: array[Boolean, 1..12] of longint =
-      ((0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334),
-       (0, 31, 60, 91, 121, 152, 182, 213, 244, 274, 305, 335));
-
-function DoEncodeDate(Year, Month, Day: Word): longint;
-var
-  c, ya: cardinal;
-begin
-if (Month > 0) and (Month < 13) and (Day > 0) and (Day < 32) then
-   begin
-     if month > 2 then Month := Month - 3 else
-     begin
-       Month := Month + 9;
-       Year:= Year - 1;
-     end;
-     c:= Year DIV 100;
-     ya:= Year - 100*c;
-     result := (146097*c) SHR 2 + (1461*ya) SHR 2 + (153*Month+2) DIV 5 + Day -
-693900;
-   end else result:=0;
-end;
-
-function DoEncodeTime(Hour, Minute, Second, MilliSecond: word): longint;
-begin
-If ((hour>=0) and (Hour<24)) and
-   ((Minute>=0) and (Minute<60)) and
-   ((Second>=0) and (Second<60)) and
-   ((MilliSecond>=0) and (Millisecond<1000)) then
-  Result := (Hour * 3600000 + Minute * 60000 + Second * 1000 + MilliSecond)
-else
-  Result:=0;
-end ;
-
-{==============================================================================}
-{   Public functions                                                           }
-{==============================================================================}
-
-{   DateTimeToTimeStamp converts DateTime to a TTimeStamp   }
-
-function DateTimeToTimeStamp(DateTime: TDateTime): TTimeStamp;
-
-
-begin
-result.Time := Trunc(Frac(DateTime) * MSecsPerDay);
-result.Date := 1
-               + DateDelta
-               + Trunc(System.Int(DateTime));
-end ;
-
-{   TimeStampToDateTime converts TimeStamp to a TDateTime value   }
-
-function TimeStampToDateTime(const TimeStamp: TTimeStamp): TDateTime;
-begin
-result := (TimeStamp.Date - DateDelta - 1) + (TimeStamp.Time / MSecsPerDay);
-end ;
-
-{   MSecsToTimeStamp   }
-
-function MSecsToTimeStamp(MSecs: comp): TTimeStamp;
-begin
-  result.Date := trunc(msecs / msecsperday);
-  msecs:= msecs - comp(result.date) * comp(msecsperday);
-  result.Time := Trunc(MSecs);
-end ;
-
-{   TimeStampToMSecs   }
-
-function TimeStampToMSecs(const TimeStamp: TTimeStamp): comp;
-begin
-  result := TimeStamp.Time + timestamp.date*msecsperday;
-end ;
-
-{   EncodeDate packs three variables Year, Month and Day into a
-    TDateTime value the result is the number of days since 12/30/1899   }
-
-function EncodeDate(Year, Month, Day: word): TDateTime;
-begin
-result := DoEncodeDate(Year, Month, Day);
-end ;
-
-{   EncodeTime packs four variables Hour, Minute, Second and MilliSecond into
-    a TDateTime value     }
-
-function EncodeTime(Hour, Minute, Second, MilliSecond:word):TDateTime;
-begin
-Result := DoEncodeTime(hour, minute, second, millisecond) / MSecsPerDay;
-end ;
-
-{   DecodeDate unpacks the value Date into three values:
-    Year, Month and Day   }
-
-procedure DecodeDate(Date: TDateTime; var Year, Month, Day: word);
-var
-  j : cardinal;
-begin
-  j := pred((Trunc(System.Int(Date)) + 693900) SHL 2);
-  Year:= j DIV 146097;
-  j:= j - 146097 * Year;
-  Day := j SHR 2;
-  j:=(Day SHL 2 + 3) DIV 1461;
-  Day:= (Day SHL 2 + 7 - 1461*j) SHR 2;
-  Month:=(5 * Day-3) DIV 153;
-  Day:= (5 * Day +2 - 153*Month) DIV 5;
-  Year:= 100 * Year + j;
-  if Month < 10 then Month:= Month + 3 else begin
-    Month:= Month-9;
-    inc(Year);
-  end;
-end ;
-
-{   DecodeTime unpacks Time into four values:
-    Hour, Minute, Second and MilliSecond    }
-
-procedure DecodeTime(Time: TDateTime; var Hour, Minute, Second, MilliSecond: word);
-Var
-  l : cardinal;
-begin
- l := Trunc(Frac(time) * MSecsPerDay);
- Hour   := l div 3600000;
- l := l mod 3600000;
- Minute := l div 60000;
- l := l mod 60000;
- Second := l div 1000;
- l := l mod 1000;
- MilliSecond := l;
-end;
-
-{   DateTimeToSystemTime converts DateTime value to SystemTime   }
-
-procedure DateTimeToSystemTime(DateTime: TDateTime; var SystemTime: TSystemTime);
-begin
-  DecodeDate(DateTime, SystemTime.Year, SystemTime.Month, SystemTime.Day);
-  DecodeTime(DateTime, SystemTime.Hour, SystemTime.Minute, SystemTime.Second, SystemTime.MilliSecond);
-end ;
-
-{   SystemTimeToDateTime converts SystemTime to a TDateTime value   }
-
-function SystemTimeToDateTime(const SystemTime: TSystemTime): TDateTime;
-begin
-result := DoEncodeDate(SystemTime.Year,
-                       SystemTime.Month,
-                       SystemTime.Day) +
-          DoEncodeTime(SystemTime.Hour,
-                       SystemTime.Minute,
-                       SystemTime.Second,
-                       SystemTime.MilliSecond) / MSecsPerDay;
-end ;
-
-{   DayOfWeek returns the Day of the week (sunday is day 1)  }
-
-function DayOfWeek(DateTime: TDateTime): integer;
-begin
-  Result := 1 + (Abs(Trunc(DateTime) - 1) mod 7);
-end ;
-
-{   Date returns the current Date   }
-
-function Date: TDateTime;
-var SystemTime: TSystemTime;
-begin
-GetLocalTime(SystemTime);
-result := DoEncodeDate(SystemTime.Year,
-                       SystemTime.Month,
-                       SystemTime.Day);
-end ;
-
-{   Time returns the current Time   }
-
-function Time: TDateTime;
-var SystemTime: TSystemTime;
-begin
-GetLocalTime(SystemTime);
-Result := DoEncodeTime(SystemTime.Hour,
-                       SystemTime.Minute,
-                       SystemTime.Second,
-                       SystemTime.MilliSecond) / MSecsPerDay;
-end ;
-
-{   Now returns the current Date and Time    }
-
-function Now: TDateTime;
-var SystemTime: TSystemTime;
-begin
-GetLocalTime(SystemTime);
-result := DoEncodeDate(SystemTime.Year,
-                       SystemTime.Month,
-                       SystemTime.Day) +
-          DoEncodeTime(SystemTime.Hour,
-                       SystemTime.Minute,
-                       SystemTime.Second,
-                       SystemTime.MilliSecond) / MSecsPerDay;
-end ;
-
-{   IncMonth increments DateTime with NumberOfMonths months,
-    NumberOfMonths can be less than zero   }
-
-function IncMonth(const DateTime: TDateTime; NumberOfMonths: integer): TDateTime;
-var Year, Month, Day: word;
-    S : Integer;
-
-begin
-If NumberOfMonths>=0 then s:=1 else s:=-1;
-DecodeDate(DateTime, Year, Month, Day);
-Year := Year + (NumberOfMonths div 12);
-Month := Month + (NumberOfMonths mod 12)-1 ; // Mod result always positive
-if Month>11 then begin
-   Dec(Month, S*12);
-   Inc(Year, S);
-   end ;
-Inc(Month, 1);                            {   Months from 1 to 12   }
-if (Month = 2) and (IsLeapYear(Year)) and (Day > 28) then
-   Day := 28;
-result := Frac(DateTime) + DoEncodeDate(Year, Month, Day);
-end ;
-
-{  IsLeapYear returns true if Year is a leap year   }
-
-function IsLeapYear(Year: Word): boolean;
-begin
-Result := (Year mod 4 = 0) and ((Year mod 100 <> 0) or (Year mod 400 = 0));
-end;
-
-{  DateToStr returns a string representation of Date using ShortDateFormat   }
-
-function DateToStr(Date: TDateTime): string;
-begin
-result := FormatDateTime('ddddd', Date);
-end ;
-
-{  TimeToStr returns a string representation of Time using ShortTimeFormat   }
-
-function TimeToStr(Time: TDateTime): string;
-begin
-result := FormatDateTime('t', Time);
-end ;
-
-{   DateTimeToStr returns a string representation of DateTime using ShortDateTimeFormat   }
-
-function DateTimeToStr(DateTime: TDateTime): string;
-begin
-result := FormatDateTime('c', DateTime);
-end ;
-
-{   StrToDate converts the string S to a TDateTime value
-    if S does not represent a valid date value
-    an EConvertError will be raised   }
-
-function StrToDate(const S: string): TDateTime;
-
-var
-   df:string;
-   d,m,y:word;
-   n,i:longint;
-   c:word;
-   dp,mp,yp,which : Byte;
-   s1:string[4];
-   values:array[1..3] of longint;
-   LocalTime:tsystemtime;
-
-begin
-  df := UpperCase(ShortDateFormat);
-  { Determine order of D,M,Y }
-  yp:=0;
-  mp:=0;
-  dp:=0;
-  Which:=0;
-  i:=0;
-  while (i<Length(df)) and (Which<3) do
-   begin
-     inc(i);
-     Case df[i] of
-       'Y' :
-         if yp=0 then
-          begin
-            Inc(Which);
-            yp:=which;
-          end;
-       'M' :
-         if mp=0 then
-          begin
-            Inc(Which);
-            mp:=which;
-          end;
-       'D' :
-         if dp=0 then
-          begin
-            Inc(Which);
-            dp:=which;
-          end;
-     end;
-   end;
-  if Which<>3 then
-   Raise EConvertError.Create('Illegal format string');
-{ Get actual values }
-  for i := 1 to 3 do
-    values[i] := 0;
-  s1 := '';
-  n := 0;
-  for i := 1 to length(s) do
-   begin
-     if (s[i] in ['0'..'9']) then
-      s1 := s1 + s[i];
-     if (s[i] in [dateseparator,' ']) or (i = length(s)) then
-      begin
-        inc(n);
-        if n>3 then
-         Raise EConvertError.Create('Invalid date format');
-        val(s1, values[n], c);
-        if c<>0 then
-         Raise EConvertError.Create('Invalid date format');
-        s1 := '';
-      end ;
-   end ;
-  // Fill in values.
-  If N=3 then
-   begin
-     y:=values[yp];
-     m:=values[mp];
-     d:=values[dp];
-   end
-  Else
-  begin
-    getLocalTime(LocalTime);
-    y := LocalTime.Year;
-    If n<2 then
-     begin
-       d:=values[1];
-       m := LocalTime.Month;
-     end
-    else
-     If dp<mp then
-      begin
-        d:=values[1];
-        m:=values[2];
-      end
-    else
-      begin
-        d:=values[2];
-        m:=values[1];
-      end;
-  end;
-  if (y >= 0) and (y < 100) then
-   inc(y,1900);
-  Result := DoEncodeDate(y, m, d);
-end ;
-
-
-{   StrToTime converts the string S to a TDateTime value
-    if S does not represent a valid time value an
-    EConvertError will be raised   }
-
-function StrToTime(const s: string): TDateTime;
-var
-   Len, Current: integer; PM: boolean;
-
-   function GetElement: integer;
-   var
-     j: integer; c: word;
-   begin
-   result := -1;
-   Inc(Current);
-   while (result = -1) and (Current < Len) do begin
-      if S[Current] in ['0'..'9'] then begin
-         j := Current;
-         while (Current < Len) and (s[Current + 1] in ['0'..'9']) do
-            Inc(Current);
-         val(copy(S, j, 1 + Current - j), result, c);
-         end
-      else if (S[Current] = TimeAMString[1]) or (S[Current] in ['a', 'A']) then begin
-         Current := 1 + Len;
-         end
-      else if (S[Current] = TimePMString[1]) or (S[Current] in ['p', 'P']) then begin
-         Current := 1 + Len;
-         PM := True;
-         end
-      else if (S[Current] = TimeSeparator) or (S[Current] = ' ') then
-         Inc(Current)
-      else
-        raise EConvertError.Create('Invalid Time format');
-      end ;
-   end ;
-
-var
-   i: integer;
-   TimeValues: array[0..4] of integer;
-
-begin
-Current := 0;
-Len := length(s);
-PM := False;
-for i:=0 to 4 do
-  timevalues[i]:=0;
-i := 0;
-TimeValues[i] := GetElement;
-while (i < 5) and (TimeValues[i] <> -1) do begin
-   i := i + 1;
-   TimeValues[i] := GetElement;
-   end ;
-If (i<5) and (TimeValues[I]=-1) then
-  TimeValues[I]:=0;
-if PM then Inc(TimeValues[0], 12);
-result := EncodeTime(TimeValues[0], TimeValues[1], TimeValues[2], TimeValues[3]);
-end ;
-
-{   StrToDateTime converts the string S to a TDateTime value
-    if S does not represent a valid date and time value
-    an EConvertError will be raised   }
-
-function StrToDateTime(const s: string): TDateTime;
-var i: integer;
-begin
-i := pos(' ', s);
-if i > 0 then result := StrToDate(Copy(S, 1, i - 1)) + StrToTime(Copy(S, i + 1, length(S)))
-else result := StrToDate(S);
-end ;
-
-{   FormatDateTime formats DateTime to the given format string FormatStr   }
-
-function FormatDateTime(FormatStr: string; DateTime: TDateTime): string;
-var
-   ResultLen: integer;
-   ResultBuffer: array[0..255] of char;
-   ResultCurrent: pchar;
-
-   procedure StoreStr(Str: pchar; Len: integer);
-   begin
-   if ResultLen + Len < SizeOf(ResultBuffer) then begin
-      StrMove(ResultCurrent, Str, Len);
-      ResultCurrent := ResultCurrent + Len;
-      ResultLen := ResultLen + Len;
-      end ;
-   end ;
-
-   procedure StoreString(const Str: string);
-   var Len: integer;
-   begin
-   Len := Length(Str);
-   if ResultLen + Len < SizeOf(ResultBuffer) then begin
-      StrMove(ResultCurrent, pchar(Str), Len);
-      ResultCurrent := ResultCurrent + Len;
-      ResultLen := ResultLen + Len;
-      end;
-   end;
-
-   procedure StoreInt(Value, Digits: integer);
-   var S: string; Len: integer;
-   begin
-   S := IntToStr(Value);
-   Len := Length(S);
-   if Len < Digits then begin
-      S := copy('0000', 1, Digits - Len) + S;
-      Len := Digits;
-      end ;
-   StoreStr(pchar(@S[1]), Len);
-   end ;
-
-   Function TimeReFormat(Const S : string) : string;
-   // Change m into n for time formatting.
-   Var i : longint;
-
-   begin
-     Result:=S;
-     For I:=1 to Length(Result) do
-       If Result[i]='m' then
-         result[i]:='n';
-   end;
-
-var
-   Year, Month, Day, DayOfWeek, Hour, Minute, Second, MilliSecond: word;
-
-   procedure StoreFormat(const FormatStr: string);
-   var
-      Token: char;
-      FormatCurrent: pchar;
-      FormatEnd: pchar;
-      Count: integer;
-      Clock12: boolean;
-      P: pchar;
-
-   begin
-   FormatCurrent := Pchar(FormatStr);
-   FormatEnd := FormatCurrent + Length(FormatStr);
-   Clock12 := false;
-   P := FormatCurrent;
-   while P < FormatEnd do begin
-      Token := UpCase(P^);
-      if Token in ['"', ''''] then begin
-         P := P + 1;
-         while (P < FormatEnd) and (P^ <> Token) do
-            P := P + 1;
-         end
-      else if Token = 'A' then begin
-         if (StrLIComp(P, 'A/P', 3) = 0) or
-            (StrLIComp(P, 'AMPM', 4) = 0) or
-            (StrLIComp(P, 'AM/PM', 5) = 0) then begin
-            Clock12 := true;
-            break;
-            end ;
-         end ;
-      P := P + 1;
-      end ;
-   while FormatCurrent < FormatEnd do begin
-      Token := UpCase(FormatCurrent^);
-      Count := 1;
-      P := FormatCurrent + 1;
-         case Token of
-            '''', '"': begin
-               while (P < FormatEnd) and (p^ <> Token) do
-                  P := P + 1;
-               P := P + 1;
-               Count := P - FormatCurrent;
-               StoreStr(FormatCurrent + 1, Count - 2);
-               end ;
-            'A': begin
-               if StrLIComp(FormatCurrent, 'AMPM', 4) = 0 then begin
-                  Count := 4;
-                  if Hour < 12 then StoreString(TimeAMString)
-                  else StoreString(TimePMString);
-                  end
-               else if StrLIComp(FormatCurrent, 'AM/PM', 5) = 0 then begin
-                  Count := 5;
-                  if Hour < 12 then StoreStr('am', 2)
-                  else StoreStr('pm', 2);
-                  end
-               else if StrLIComp(FormatCurrent, 'A/P', 3) = 0 then begin
-                  Count := 3;
-                  if Hour < 12 then StoreStr('a', 1)
-                  else StoreStr('p', 1);
-                  end
-               else
-                 Raise EConvertError.Create('Illegal character in format string');
-               end ;
-            '/': StoreStr(@DateSeparator, 1);
-            ':': StoreStr(@TimeSeparator, 1);
-            ' ', 'C', 'D', 'H', 'M', 'N', 'S', 'T', 'Y': begin
-               while (P < FormatEnd) and (UpCase(P^) = Token) do
-                  P := P + 1;
-               Count := P - FormatCurrent;
-                  case Token of
-                     ' ': StoreStr(FormatCurrent, Count);
-                     'Y': begin
-                           case Count of
-                              1: StoreInt(Year, 0);
-                              2: StoreInt(Year mod 100, 2);
-                              4: StoreInt(Year, 4);
-                           end ;
-                        end ;
-                     'M': begin
-                           case Count of
-                              1: StoreInt(Month, 0);
-                              2: StoreInt(Month, 2);
-                              3: StoreString(ShortMonthNames[Month]);
-                              4: StoreString(LongMonthNames[Month]);
-                           end ;
-                        end ;
-                     'D': begin
-                           case Count of
-                              1: StoreInt(Day, 0);
-                              2: StoreInt(Day, 2);
-                              3: StoreString(ShortDayNames[DayOfWeek]);
-                              4: StoreString(LongDayNames[DayOfWeek]);
-                              5: StoreFormat(ShortDateFormat);
-                              6: StoreFormat(LongDateFormat);
-                           end ;
-                        end ;
-                     'H': begin
-                        if Clock12 then begin
-                           if Count = 1 then StoreInt(Hour mod 12, 0)
-                           else StoreInt(Hour mod 12, 2);
-                           end
-                        else begin
-                           if Count = 1 then StoreInt(Hour, 0)
-                           else StoreInt(Hour, 2);
-                           end ;
-                        end ;
-                     'N': begin
-                        if Count = 1 then StoreInt(Minute, 0)
-                        else StoreInt(Minute, 2);
-                        end ;
-                     'S': begin
-                        if Count = 1 then StoreInt(Second, 0)
-                        else StoreInt(Second, 2);
-                        end ;
-                     'T': begin
-                        if Count = 1 then StoreFormat(timereformat(ShortTimeFormat))
-                        else StoreFormat(TimeReformat(LongTimeFormat));
-                        end ;
-                     'C':
-                       begin
-                         StoreFormat(ShortDateFormat);
-                         if (Hour<>0) or (Minute<>0) or (Second<>0) then
-                          begin
-                            StoreString(' ');
-                            StoreFormat(TimeReformat(ShortTimeFormat));
-                          end;
-                       end;
-                  end ;
-               end ;
-            else
-              StoreStr(@Token, 1);
-         end ;
-      FormatCurrent := FormatCurrent + Count;
-      end ;
-   end ;
-
-begin
-  DecodeDate(DateTime, Year, Month, Day);
-  DecodeTime(DateTime, Hour, Minute, Second, MilliSecond);
-  DayOfWeek := SysUtils.DayOfWeek(DateTime);
-  ResultLen := 0;
-  ResultCurrent := @ResultBuffer;
-  StoreFormat(FormatStr);
-  ResultBuffer[ResultLen] := #0;
-  result := StrPas(@ResultBuffer);
-end ;
-
-{   DateTimeToString formats DateTime to the given format in FormatStr   }
-
-procedure DateTimeToString(var Result: string; const FormatStr: string; const DateTime: TDateTime);
-begin
-  Result := FormatDateTime(FormatStr, DateTime);
-end ;
-
-
-Function DateTimeToFileDate(DateTime : TDateTime) : Longint;
-
-Var YY,MM,DD,H,m,s,msec : Word;
-
-begin
-  Decodedate (DateTime,YY,MM,DD);
-  If (YY<1980) or (YY>2099) then
-    Result:=0
-  else
-    begin
-    DecodeTime (DateTime,h,m,s,msec);
-    Result:=(s shr 1) or (m shl 5) or (h shl 11);
-    Result:=Result or DD shl 16 or (MM shl 21) or ((YY-1980) shl 25);
-    end;
-end;
-
-
-Function FileDateToDateTime (Filedate : Longint) : TDateTime;
-
-Var Date,Time : Word;
-
-begin
-  Date:=FileDate shl 16;
-  Time:=FileDate and $ffff;
-  Result:=EncodeDate((Date shr 9) + 1980,(Date shr 5) and 15, Date and 31) +
-          EncodeTime(Time shr 11, (Time shr 5) and 63, (Time and 31) shl 1,0);
-end;
-
-{
+{
+    *********************************************************************
+    $Id$
+    Copyright (C) 1997, 1998 Gertjan Schouten
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+    *********************************************************************
+
+    System Utilities For Free Pascal
+}
+
+{==============================================================================}
+{   internal functions                                                         }
+{==============================================================================}
+
+const
+   DayTable: array[Boolean, 1..12] of longint =
+      ((0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334),
+       (0, 31, 60, 91, 121, 152, 182, 213, 244, 274, 305, 335));
+
+function DoEncodeDate(Year, Month, Day: Word): longint;
+var
+  c, ya: cardinal;
+begin
+if (Month > 0) and (Month < 13) and (Day > 0) and (Day < 32) then
+   begin
+     if month > 2 then Month := Month - 3 else
+     begin
+       Month := Month + 9;
+       Year:= Year - 1;
+     end;
+     c:= Year DIV 100;
+     ya:= Year - 100*c;
+     result := (146097*c) SHR 2 + (1461*ya) SHR 2 + (153*Month+2) DIV 5 + Day -
+693900;
+   end else result:=0;
+end;
+
+function DoEncodeTime(Hour, Minute, Second, MilliSecond: word): longint;
+begin
+If ((hour>=0) and (Hour<24)) and
+   ((Minute>=0) and (Minute<60)) and
+   ((Second>=0) and (Second<60)) and
+   ((MilliSecond>=0) and (Millisecond<1000)) then
+  Result := (Hour * 3600000 + Minute * 60000 + Second * 1000 + MilliSecond)
+else
+  Result:=0;
+end ;
+
+{==============================================================================}
+{   Public functions                                                           }
+{==============================================================================}
+
+{   DateTimeToTimeStamp converts DateTime to a TTimeStamp   }
+
+function DateTimeToTimeStamp(DateTime: TDateTime): TTimeStamp;
+
+
+begin
+result.Time := Trunc(Frac(DateTime) * MSecsPerDay);
+result.Date := 1
+               + DateDelta
+               + Trunc(System.Int(DateTime));
+end ;
+
+{   TimeStampToDateTime converts TimeStamp to a TDateTime value   }
+
+function TimeStampToDateTime(const TimeStamp: TTimeStamp): TDateTime;
+begin
+result := (TimeStamp.Date - DateDelta - 1) + (TimeStamp.Time / MSecsPerDay);
+end ;
+
+{   MSecsToTimeStamp   }
+
+function MSecsToTimeStamp(MSecs: comp): TTimeStamp;
+begin
+  result.Date := trunc(msecs / msecsperday);
+  msecs:= msecs - comp(result.date) * comp(msecsperday);
+  result.Time := Trunc(MSecs);
+end ;
+
+{   TimeStampToMSecs   }
+
+function TimeStampToMSecs(const TimeStamp: TTimeStamp): comp;
+begin
+  result := TimeStamp.Time + timestamp.date*msecsperday;
+end ;
+
+{   EncodeDate packs three variables Year, Month and Day into a
+    TDateTime value the result is the number of days since 12/30/1899   }
+
+function EncodeDate(Year, Month, Day: word): TDateTime;
+begin
+result := DoEncodeDate(Year, Month, Day);
+end ;
+
+{   EncodeTime packs four variables Hour, Minute, Second and MilliSecond into
+    a TDateTime value     }
+
+function EncodeTime(Hour, Minute, Second, MilliSecond:word):TDateTime;
+begin
+Result := DoEncodeTime(hour, minute, second, millisecond) / MSecsPerDay;
+end ;
+
+{   DecodeDate unpacks the value Date into three values:
+    Year, Month and Day   }
+
+procedure DecodeDate(Date: TDateTime; var Year, Month, Day: word);
+var
+  j : cardinal;
+begin
+  j := pred((Trunc(System.Int(Date)) + 693900) SHL 2);
+  Year:= j DIV 146097;
+  j:= j - 146097 * Year;
+  Day := j SHR 2;
+  j:=(Day SHL 2 + 3) DIV 1461;
+  Day:= (Day SHL 2 + 7 - 1461*j) SHR 2;
+  Month:=(5 * Day-3) DIV 153;
+  Day:= (5 * Day +2 - 153*Month) DIV 5;
+  Year:= 100 * Year + j;
+  if Month < 10 then Month:= Month + 3 else begin
+    Month:= Month-9;
+    inc(Year);
+  end;
+end ;
+
+{   DecodeTime unpacks Time into four values:
+    Hour, Minute, Second and MilliSecond    }
+
+procedure DecodeTime(Time: TDateTime; var Hour, Minute, Second, MilliSecond: word);
+Var
+  l : cardinal;
+begin
+ l := Trunc(Frac(time) * MSecsPerDay);
+ Hour   := l div 3600000;
+ l := l mod 3600000;
+ Minute := l div 60000;
+ l := l mod 60000;
+ Second := l div 1000;
+ l := l mod 1000;
+ MilliSecond := l;
+end;
+
+{   DateTimeToSystemTime converts DateTime value to SystemTime   }
+
+procedure DateTimeToSystemTime(DateTime: TDateTime; var SystemTime: TSystemTime);
+begin
+  DecodeDate(DateTime, SystemTime.Year, SystemTime.Month, SystemTime.Day);
+  DecodeTime(DateTime, SystemTime.Hour, SystemTime.Minute, SystemTime.Second, SystemTime.MilliSecond);
+end ;
+
+{   SystemTimeToDateTime converts SystemTime to a TDateTime value   }
+
+function SystemTimeToDateTime(const SystemTime: TSystemTime): TDateTime;
+begin
+result := DoEncodeDate(SystemTime.Year,
+                       SystemTime.Month,
+                       SystemTime.Day) +
+          DoEncodeTime(SystemTime.Hour,
+                       SystemTime.Minute,
+                       SystemTime.Second,
+                       SystemTime.MilliSecond) / MSecsPerDay;
+end ;
+
+{   DayOfWeek returns the Day of the week (sunday is day 1)  }
+
+function DayOfWeek(DateTime: TDateTime): integer;
+begin
+  Result := 1 + (Abs(Trunc(DateTime) - 1) mod 7);
+end ;
+
+{   Date returns the current Date   }
+
+function Date: TDateTime;
+var SystemTime: TSystemTime;
+begin
+GetLocalTime(SystemTime);
+result := DoEncodeDate(SystemTime.Year,
+                       SystemTime.Month,
+                       SystemTime.Day);
+end ;
+
+{   Time returns the current Time   }
+
+function Time: TDateTime;
+var SystemTime: TSystemTime;
+begin
+GetLocalTime(SystemTime);
+Result := DoEncodeTime(SystemTime.Hour,
+                       SystemTime.Minute,
+                       SystemTime.Second,
+                       SystemTime.MilliSecond) / MSecsPerDay;
+end ;
+
+{   Now returns the current Date and Time    }
+
+function Now: TDateTime;
+var SystemTime: TSystemTime;
+begin
+GetLocalTime(SystemTime);
+result := DoEncodeDate(SystemTime.Year,
+                       SystemTime.Month,
+                       SystemTime.Day) +
+          DoEncodeTime(SystemTime.Hour,
+                       SystemTime.Minute,
+                       SystemTime.Second,
+                       SystemTime.MilliSecond) / MSecsPerDay;
+end ;
+
+{   IncMonth increments DateTime with NumberOfMonths months,
+    NumberOfMonths can be less than zero   }
+
+function IncMonth(const DateTime: TDateTime; NumberOfMonths: integer): TDateTime;
+var Year, Month, Day: word;
+    S : Integer;
+
+begin
+If NumberOfMonths>=0 then s:=1 else s:=-1;
+DecodeDate(DateTime, Year, Month, Day);
+Year := Year + (NumberOfMonths div 12);
+Month := Month + (NumberOfMonths mod 12)-1 ; // Mod result always positive
+if Month>11 then begin
+   Dec(Month, S*12);
+   Inc(Year, S);
+   end ;
+Inc(Month, 1);                            {   Months from 1 to 12   }
+if (Month = 2) and (IsLeapYear(Year)) and (Day > 28) then
+   Day := 28;
+result := Frac(DateTime) + DoEncodeDate(Year, Month, Day);
+end ;
+
+{  IsLeapYear returns true if Year is a leap year   }
+
+function IsLeapYear(Year: Word): boolean;
+begin
+Result := (Year mod 4 = 0) and ((Year mod 100 <> 0) or (Year mod 400 = 0));
+end;
+
+{  DateToStr returns a string representation of Date using ShortDateFormat   }
+
+function DateToStr(Date: TDateTime): string;
+begin
+result := FormatDateTime('ddddd', Date);
+end ;
+
+{  TimeToStr returns a string representation of Time using ShortTimeFormat   }
+
+function TimeToStr(Time: TDateTime): string;
+begin
+result := FormatDateTime('t', Time);
+end ;
+
+{   DateTimeToStr returns a string representation of DateTime using ShortDateTimeFormat   }
+
+function DateTimeToStr(DateTime: TDateTime): string;
+begin
+result := FormatDateTime('c', DateTime);
+end ;
+
+{   StrToDate converts the string S to a TDateTime value
+    if S does not represent a valid date value
+    an EConvertError will be raised   }
+
+function StrToDate(const S: string): TDateTime;
+
+var
+   df:string;
+   d,m,y:word;
+   n,i:longint;
+   c:word;
+   dp,mp,yp,which : Byte;
+   s1:string[4];
+   values:array[1..3] of longint;
+   LocalTime:tsystemtime;
+
+begin
+  df := UpperCase(ShortDateFormat);
+  { Determine order of D,M,Y }
+  yp:=0;
+  mp:=0;
+  dp:=0;
+  Which:=0;
+  i:=0;
+  while (i<Length(df)) and (Which<3) do
+   begin
+     inc(i);
+     Case df[i] of
+       'Y' :
+         if yp=0 then
+          begin
+            Inc(Which);
+            yp:=which;
+          end;
+       'M' :
+         if mp=0 then
+          begin
+            Inc(Which);
+            mp:=which;
+          end;
+       'D' :
+         if dp=0 then
+          begin
+            Inc(Which);
+            dp:=which;
+          end;
+     end;
+   end;
+  if Which<>3 then
+   Raise EConvertError.Create('Illegal format string');
+{ Get actual values }
+  for i := 1 to 3 do
+    values[i] := 0;
+  s1 := '';
+  n := 0;
+  for i := 1 to length(s) do
+   begin
+     if (s[i] in ['0'..'9']) then
+      s1 := s1 + s[i];
+     if (s[i] in [dateseparator,' ']) or (i = length(s)) then
+      begin
+        inc(n);
+        if n>3 then
+         Raise EConvertError.Create('Invalid date format');
+        val(s1, values[n], c);
+        if c<>0 then
+         Raise EConvertError.Create('Invalid date format');
+        s1 := '';
+      end ;
+   end ;
+  // Fill in values.
+  If N=3 then
+   begin
+     y:=values[yp];
+     m:=values[mp];
+     d:=values[dp];
+   end
+  Else
+  begin
+    getLocalTime(LocalTime);
+    y := LocalTime.Year;
+    If n<2 then
+     begin
+       d:=values[1];
+       m := LocalTime.Month;
+     end
+    else
+     If dp<mp then
+      begin
+        d:=values[1];
+        m:=values[2];
+      end
+    else
+      begin
+        d:=values[2];
+        m:=values[1];
+      end;
+  end;
+  if (y >= 0) and (y < 100) then
+   inc(y,1900);
+  Result := DoEncodeDate(y, m, d);
+end ;
+
+
+{   StrToTime converts the string S to a TDateTime value
+    if S does not represent a valid time value an
+    EConvertError will be raised   }
+
+function StrToTime(const s: string): TDateTime;
+var
+   Len, Current: integer; PM: boolean;
+
+   function GetElement: integer;
+   var
+     j: integer; c: word;
+   begin
+   result := -1;
+   Inc(Current);
+   while (result = -1) and (Current < Len) do begin
+      if S[Current] in ['0'..'9'] then begin
+         j := Current;
+         while (Current < Len) and (s[Current + 1] in ['0'..'9']) do
+            Inc(Current);
+         val(copy(S, j, 1 + Current - j), result, c);
+         end
+      else if (S[Current] = TimeAMString[1]) or (S[Current] in ['a', 'A']) then begin
+         Current := 1 + Len;
+         end
+      else if (S[Current] = TimePMString[1]) or (S[Current] in ['p', 'P']) then begin
+         Current := 1 + Len;
+         PM := True;
+         end
+      else if (S[Current] = TimeSeparator) or (S[Current] = ' ') then
+         Inc(Current)
+      else
+        raise EConvertError.Create('Invalid Time format');
+      end ;
+   end ;
+
+var
+   i: integer;
+   TimeValues: array[0..4] of integer;
+
+begin
+Current := 0;
+Len := length(s);
+PM := False;
+for i:=0 to 4 do
+  timevalues[i]:=0;
+i := 0;
+TimeValues[i] := GetElement;
+while (i < 5) and (TimeValues[i] <> -1) do begin
+   i := i + 1;
+   TimeValues[i] := GetElement;
+   end ;
+If (i<5) and (TimeValues[I]=-1) then
+  TimeValues[I]:=0;
+if PM then Inc(TimeValues[0], 12);
+result := EncodeTime(TimeValues[0], TimeValues[1], TimeValues[2], TimeValues[3]);
+end ;
+
+{   StrToDateTime converts the string S to a TDateTime value
+    if S does not represent a valid date and time value
+    an EConvertError will be raised   }
+
+function StrToDateTime(const s: string): TDateTime;
+var i: integer;
+begin
+i := pos(' ', s);
+if i > 0 then result := StrToDate(Copy(S, 1, i - 1)) + StrToTime(Copy(S, i + 1, length(S)))
+else result := StrToDate(S);
+end ;
+
+{   FormatDateTime formats DateTime to the given format string FormatStr   }
+
+function FormatDateTime(FormatStr: string; DateTime: TDateTime): string;
+var
+   ResultLen: integer;
+   ResultBuffer: array[0..255] of char;
+   ResultCurrent: pchar;
+
+   procedure StoreStr(Str: pchar; Len: integer);
+   begin
+   if ResultLen + Len < SizeOf(ResultBuffer) then begin
+      StrMove(ResultCurrent, Str, Len);
+      ResultCurrent := ResultCurrent + Len;
+      ResultLen := ResultLen + Len;
+      end ;
+   end ;
+
+   procedure StoreString(const Str: string);
+   var Len: integer;
+   begin
+   Len := Length(Str);
+   if ResultLen + Len < SizeOf(ResultBuffer) then begin
+      StrMove(ResultCurrent, pchar(Str), Len);
+      ResultCurrent := ResultCurrent + Len;
+      ResultLen := ResultLen + Len;
+      end;
+   end;
+
+   procedure StoreInt(Value, Digits: integer);
+   var S: string; Len: integer;
+   begin
+   S := IntToStr(Value);
+   Len := Length(S);
+   if Len < Digits then begin
+      S := copy('0000', 1, Digits - Len) + S;
+      Len := Digits;
+      end ;
+   StoreStr(pchar(@S[1]), Len);
+   end ;
+
+   Function TimeReFormat(Const S : string) : string;
+   // Change m into n for time formatting.
+   Var i : longint;
+
+   begin
+     Result:=S;
+     For I:=1 to Length(Result) do
+       If Result[i]='m' then
+         result[i]:='n';
+   end;
+
+var
+   Year, Month, Day, DayOfWeek, Hour, Minute, Second, MilliSecond: word;
+
+   procedure StoreFormat(const FormatStr: string);
+   var
+      Token: char;
+      FormatCurrent: pchar;
+      FormatEnd: pchar;
+      Count: integer;
+      Clock12: boolean;
+      P: pchar;
+
+   begin
+   FormatCurrent := Pchar(FormatStr);
+   FormatEnd := FormatCurrent + Length(FormatStr);
+   Clock12 := false;
+   P := FormatCurrent;
+   while P < FormatEnd do begin
+      Token := UpCase(P^);
+      if Token in ['"', ''''] then begin
+         P := P + 1;
+         while (P < FormatEnd) and (P^ <> Token) do
+            P := P + 1;
+         end
+      else if Token = 'A' then begin
+         if (StrLIComp(P, 'A/P', 3) = 0) or
+            (StrLIComp(P, 'AMPM', 4) = 0) or
+            (StrLIComp(P, 'AM/PM', 5) = 0) then begin
+            Clock12 := true;
+            break;
+            end ;
+         end ;
+      P := P + 1;
+      end ;
+   while FormatCurrent < FormatEnd do begin
+      Token := UpCase(FormatCurrent^);
+      Count := 1;
+      P := FormatCurrent + 1;
+         case Token of
+            '''', '"': begin
+               while (P < FormatEnd) and (p^ <> Token) do
+                  P := P + 1;
+               P := P + 1;
+               Count := P - FormatCurrent;
+               StoreStr(FormatCurrent + 1, Count - 2);
+               end ;
+            'A': begin
+               if StrLIComp(FormatCurrent, 'AMPM', 4) = 0 then begin
+                  Count := 4;
+                  if Hour < 12 then StoreString(TimeAMString)
+                  else StoreString(TimePMString);
+                  end
+               else if StrLIComp(FormatCurrent, 'AM/PM', 5) = 0 then begin
+                  Count := 5;
+                  if Hour < 12 then StoreStr('am', 2)
+                  else StoreStr('pm', 2);
+                  end
+               else if StrLIComp(FormatCurrent, 'A/P', 3) = 0 then begin
+                  Count := 3;
+                  if Hour < 12 then StoreStr('a', 1)
+                  else StoreStr('p', 1);
+                  end
+               else
+                 Raise EConvertError.Create('Illegal character in format string');
+               end ;
+            '/': StoreStr(@DateSeparator, 1);
+            ':': StoreStr(@TimeSeparator, 1);
+            ' ', 'C', 'D', 'H', 'M', 'N', 'S', 'T', 'Y': begin
+               while (P < FormatEnd) and (UpCase(P^) = Token) do
+                  P := P + 1;
+               Count := P - FormatCurrent;
+                  case Token of
+                     ' ': StoreStr(FormatCurrent, Count);
+                     'Y': begin
+                           case Count of
+                              1: StoreInt(Year, 0);
+                              2: StoreInt(Year mod 100, 2);
+                              4: StoreInt(Year, 4);
+                           end ;
+                        end ;
+                     'M': begin
+                           case Count of
+                              1: StoreInt(Month, 0);
+                              2: StoreInt(Month, 2);
+                              3: StoreString(ShortMonthNames[Month]);
+                              4: StoreString(LongMonthNames[Month]);
+                           end ;
+                        end ;
+                     'D': begin
+                           case Count of
+                              1: StoreInt(Day, 0);
+                              2: StoreInt(Day, 2);
+                              3: StoreString(ShortDayNames[DayOfWeek]);
+                              4: StoreString(LongDayNames[DayOfWeek]);
+                              5: StoreFormat(ShortDateFormat);
+                              6: StoreFormat(LongDateFormat);
+                           end ;
+                        end ;
+                     'H': begin
+                        if Clock12 then begin
+                           if Count = 1 then StoreInt(Hour mod 12, 0)
+                           else StoreInt(Hour mod 12, 2);
+                           end
+                        else begin
+                           if Count = 1 then StoreInt(Hour, 0)
+                           else StoreInt(Hour, 2);
+                           end ;
+                        end ;
+                     'N': begin
+                        if Count = 1 then StoreInt(Minute, 0)
+                        else StoreInt(Minute, 2);
+                        end ;
+                     'S': begin
+                        if Count = 1 then StoreInt(Second, 0)
+                        else StoreInt(Second, 2);
+                        end ;
+                     'T': begin
+                        if Count = 1 then StoreFormat(timereformat(ShortTimeFormat))
+                        else StoreFormat(TimeReformat(LongTimeFormat));
+                        end ;
+                     'C':
+                       begin
+                         StoreFormat(ShortDateFormat);
+                         if (Hour<>0) or (Minute<>0) or (Second<>0) then
+                          begin
+                            StoreString(' ');
+                            StoreFormat(TimeReformat(ShortTimeFormat));
+                          end;
+                       end;
+                  end ;
+               end ;
+            else
+              StoreStr(@Token, 1);
+         end ;
+      FormatCurrent := FormatCurrent + Count;
+      end ;
+   end ;
+
+begin
+  DecodeDate(DateTime, Year, Month, Day);
+  DecodeTime(DateTime, Hour, Minute, Second, MilliSecond);
+  DayOfWeek := SysUtils.DayOfWeek(DateTime);
+  ResultLen := 0;
+  ResultCurrent := @ResultBuffer;
+  StoreFormat(FormatStr);
+  ResultBuffer[ResultLen] := #0;
+  result := StrPas(@ResultBuffer);
+end ;
+
+{   DateTimeToString formats DateTime to the given format in FormatStr   }
+
+procedure DateTimeToString(var Result: string; const FormatStr: string; const DateTime: TDateTime);
+begin
+  Result := FormatDateTime(FormatStr, DateTime);
+end ;
+
+
+Function DateTimeToFileDate(DateTime : TDateTime) : Longint;
+
+Var YY,MM,DD,H,m,s,msec : Word;
+
+begin
+  Decodedate (DateTime,YY,MM,DD);
+  If (YY<1980) or (YY>2099) then
+    Result:=0
+  else
+    begin
+    DecodeTime (DateTime,h,m,s,msec);
+    Result:=(s shr 1) or (m shl 5) or (h shl 11);
+    Result:=Result or DD shl 16 or (MM shl 21) or ((YY-1980) shl 25);
+    end;
+end;
+
+
+Function FileDateToDateTime (Filedate : Longint) : TDateTime;
+
+Var Date,Time : Word;
+
+begin
+  Date:=FileDate shl 16;
+  Time:=FileDate and $ffff;
+  Result:=EncodeDate((Date shr 9) + 1980,(Date shr 5) and 15, Date and 31) +
+          EncodeTime(Time shr 11, (Time shr 5) and 63, (Time and 31) shl 1,0);
+end;
+
+{
   $Log$
-  Revision 1.17  1999-10-28 09:52:29  peter
+  Revision 1.18  1999-11-06 14:41:30  peter
+    * truncated log
+
+  Revision 1.17  1999/10/28 09:52:29  peter
     * fixed dayofweek
-
-  Revision 1.16  1999/08/11 21:53:04  peter
-    * fixed formatdatetime('c',...)
-    * fixed strtodate
-    * dateencode/decode is now delphi compatible
-
-  Revision 1.15  1999/07/24 11:21:14  peter
-    * fixed encode/decode date/time
-
-  Revision 1.14  1999/07/14 08:47:54  michael
-  * faster En/Decodedate routines from Frank Reichert
-  * Fixed FormatDateTime with short/longtimeformat.
-
-  Revision 1.13  1999/05/31 20:50:44  peter
-    * removed warnings
-
-  Revision 1.12  1999/05/13 21:51:41  michael
-  * several fixes
-
-  Revision 1.11  1999/05/11 09:05:13  michael
-  * SMall fixes to date/time routines
-
-  Revision 1.10  1999/04/18 19:03:03  michael
-  + Now EConvertError is used everywhere in conversions
-
-  Revision 1.9  1999/04/08 11:31:02  peter
-    * removed warnings
-
-  Revision 1.8  1999/02/24 15:56:28  michael
-  + Small fixes. Moved getlocaltime to system-dependent files
-
-  Revision 1.7  1999/02/10 22:15:10  michael
-  + Changed to ansistrings
-
-  Revision 1.6  1999/02/09 12:38:42  michael
-  * Fixed INt() proble. Defined THandle, included Filemode constants
-
-  Revision 1.5  1998/10/15 09:39:12  michael
-  Changes from Gretjan Schouten
-
-  Revision 1.4  1998/10/11 13:40:52  michael
-  + Added Conversion TDateTime <-> file date and time
-
-  Revision 1.3  1998/09/16 08:28:36  michael
-  Update from gertjan Schouten, plus small fix for linux
-
-  Revision 1.1  1998/04/10 15:17:46  michael
-  + Initial implementation; Donated by Gertjan Schouten
-    His file was split into several files, to keep it a little bit structured.
-
-  1998/08/25 Gertjan
-  + uses Go32 instead of Dos unit
-    GetLocalTime
-    DayOfWeek
-    DoDecodeDate
-    DoEncodeDate
-    FormatDateTime
-}
-
+
+  Revision 1.16  1999/08/11 21:53:04  peter
+    * fixed formatdatetime('c',...)
+    * fixed strtodate
+    * dateencode/decode is now delphi compatible
+
+  Revision 1.15  1999/07/24 11:21:14  peter
+    * fixed encode/decode date/time
+
+  Revision 1.14  1999/07/14 08:47:54  michael
+  * faster En/Decodedate routines from Frank Reichert
+  * Fixed FormatDateTime with short/longtimeformat.
+
+  Revision 1.13  1999/05/31 20:50:44  peter
+    * removed warnings
+
+  Revision 1.12  1999/05/13 21:51:41  michael
+  * several fixes
+
+  Revision 1.11  1999/05/11 09:05:13  michael
+  * SMall fixes to date/time routines
+
+  Revision 1.10  1999/04/18 19:03:03  michael
+  + Now EConvertError is used everywhere in conversions
+
+  Revision 1.9  1999/04/08 11:31:02  peter
+    * removed warnings
+
+  Revision 1.8  1999/02/24 15:56:28  michael
+  + Small fixes. Moved getlocaltime to system-dependent files
+
+  Revision 1.7  1999/02/10 22:15:10  michael
+  + Changed to ansistrings
+
+  Revision 1.6  1999/02/09 12:38:42  michael
+  * Fixed INt() proble. Defined THandle, included Filemode constants
+
+  Revision 1.5  1998/10/15 09:39:12  michael
+  Changes from Gretjan Schouten
+
+  Revision 1.4  1998/10/11 13:40:52  michael
+  + Added Conversion TDateTime <-> file date and time
+
+  Revision 1.3  1998/09/16 08:28:36  michael
+  Update from gertjan Schouten, plus small fix for linux
+
+  Revision 1.1  1998/04/10 15:17:46  michael
+  + Initial implementation; Donated by Gertjan Schouten
+    His file was split into several files, to keep it a little bit structured.
+
+  1998/08/25 Gertjan
+  + uses Go32 instead of Dos unit
+    GetLocalTime
+    DayOfWeek
+    DoDecodeDate
+    DoEncodeDate
+    FormatDateTime
+}
+

rtl/objpas/diskh.inc

@@ -4,7 +4,7 @@
     Copyright (c) 1998 by the Free Pascal development team
 
     Disk functions from Delphi's sysutils.pas
-        
+
     See the file COPYING.FPC, included in this distribution,
     for details about the copyright.
 
@@ -23,7 +23,10 @@ Function RemoveDir (Const Dir : String) : Boolean;
 
 {
  $Log$
- Revision 1.1  1998-10-11 13:41:32  michael
+ Revision 1.2  1999-11-06 14:41:30  peter
+   * truncated log
+
+ Revision 1.1  1998/10/11 13:41:32  michael
  + Added disk functions
 
-}
+}

rtl/objpas/objpas.pp

@@ -362,7 +362,10 @@ end.
 
 {
   $Log$
-  Revision 1.43  1999-10-30 17:39:05  peter
+  Revision 1.44  1999-11-06 14:41:30  peter
+    * truncated log
+
+  Revision 1.43  1999/10/30 17:39:05  peter
     * memorymanager expanded with allocmem/reallocmem
 
   Revision 1.42  1999/10/03 19:41:30  peter
@@ -425,69 +428,4 @@ end.
   Revision 1.24  1999/05/17 21:52:43  florian
     * most of the Object Pascal stuff moved to the system unit
 
-  Revision 1.23  1999/05/13 21:54:28  peter
-    * objpas fixes
-
-  Revision 1.22  1999/04/16 20:47:20  florian
-    + tobject.messagestringtable function for Megido/GTK support
-      added
-
-  Revision 1.21  1999/02/23 14:04:36  pierre
-   * call %edi => call *%edi
-
-  Revision 1.20  1999/02/22 23:30:54  florian
-    + TObject.Dispatch and TObject.DispatchStr added, working
-
-  Revision 1.19  1998/12/24 10:12:03  michael
-  Implemented AssignFile and CloseFile compatibility
-
-  Revision 1.18  1998/10/12 12:42:58  florian
-    * as operator runtime error can be now caught by an errorproc
-
-  Revision 1.17  1998/10/05 12:32:53  peter
-    + assert() support
-
-  Revision 1.16  1998/10/03 15:07:16  florian
-    + TObject.AfterConstruction and TObject.BeforeDestruction of Delphi 4
-
-  Revision 1.15  1998/09/24 16:13:48  michael
-  Changes in exception and open array handling
-
-  Revision 1.14  1998/09/23 12:40:43  michael
-  Fixed TVarRec again. Should be OK now
-
-  Revision 1.13  1998/09/23 12:18:32  michael
-  + added VType in TVArRec
-
-  Revision 1.12  1998/09/23 10:00:47  peter
-    * tvarrec should be 8 bytes
-
-  Revision 1.11  1998/09/22 15:30:07  peter
-    * array of const update
-
-  Revision 1.9  1998/09/16 13:08:19  michael
-  Added AbstractErrorHandler
-
-  Revision 1.8  1998/09/06 21:27:31  florian
-    + method tobject.classinfo added
-
-  Revision 1.7  1998/09/04 08:49:06  peter
-    * 0.99.5 doesn't compile a whole objpas anymore to overcome crashes
-
-  Revision 1.6  1998/08/23 20:58:52  florian
-    + rtti for objects and classes
-    + TObject.GetClassName implemented
-
-  Revision 1.5  1998/07/30 16:10:11  michael
-  + Added support for ExceptProc+
-
-  Revision 1.4  1998/07/29 15:44:33  michael
-   included sysutils and math.pp as target. They compile now.
-
-  Revision 1.3  1998/07/29 10:09:28  michael
-  + put in exception support
-
-  Revision 1.2  1998/03/25 23:40:24  florian
-    + stuff from old objpash.inc and objpas.inc merged in
-
 }

rtl/objpas/syspch.inc

@@ -101,7 +101,10 @@ end ;
 
 {
   $Log$
-  Revision 1.6  1999-08-24 13:14:50  peter
+  Revision 1.7  1999-11-06 14:41:31  peter
+    * truncated log
+
+  Revision 1.6  1999/08/24 13:14:50  peter
     * disposestr allocstr compatible with delphi
 
   Revision 1.5  1999/07/09 10:06:34  peter
@@ -128,4 +131,4 @@ end ;
     His file was split into several files, to keep it a little bit structured.
 
 
-}
+}

rtl/objpas/sysstr.inc

@@ -1137,7 +1137,10 @@ const
 
 {
   $Log$
-  Revision 1.28  1999-10-12 19:16:27  florian
+  Revision 1.29  1999-11-06 14:41:31  peter
+    * truncated log
+
+  Revision 1.28  1999/10/12 19:16:27  florian
     * bug 645 fixed: format('%x',...) should writes unsigned hexadecimals, also
       prec fixed: max. value in delphi is 15 (and not 32)
 
@@ -1199,30 +1202,5 @@ const
   Revision 1.9  1998/11/04 10:20:52  peter
     * ansistring fixes
 
-  Revision 1.8  1998/10/02 13:57:38  michael
-  Format error now causes exception
-
-  Revision 1.7  1998/10/02 12:17:17  michael
-  + Made sure it compiles with official 0.99.8
-
-  Revision 1.6  1998/10/02 10:42:17  michael
-  + Initial implementation of format
-
-  Revision 1.5  1998/10/01 16:05:37  michael
-  Added (empty) format function
-
-  Revision 1.4  1998/09/17 12:39:52  michael
-  + Further fixes from GertJan Schouten
-
-  Revision 1.3  1998/09/16 14:34:37  pierre
-    * go32v2 did not compile
-    * wrong code in systr.inc corrected
-
-  Revision 1.2  1998/09/16 08:28:42  michael
-  Update from gertjan Schouten, plus small fix for linux
-
-  Revision 1.1  1998/04/10 15:17:46  michael
-  + Initial implementation; Donated by Gertjan Schouten
-    His file was split into several files, to keep it a little bit structured.
 }
 

rtl/objpas/sysutils.pp

@@ -293,7 +293,10 @@ Finalization
 end.
 {
     $Log$
-    Revision 1.34  1999-10-30 17:39:05  peter
+    Revision 1.35  1999-11-06 14:41:31  peter
+      * truncated log
+
+    Revision 1.34  1999/10/30 17:39:05  peter
       * memorymanager expanded with allocmem/reallocmem
 
     Revision 1.33  1999/10/26 12:29:07  peter
@@ -354,40 +357,4 @@ end.
     Revision 1.15  1998/10/10 09:53:10  michael
     Added assertion handling
 
-    Revision 1.14  1998/10/03 15:08:05  florian
-      * EInvalidCast added (from runerror 219)
-
-    Revision 1.13  1998/10/02 13:00:11  michael
-    + More RTL error handling
-
-    Revision 1.12  1998/10/02 12:17:18  michael
-    + Made sure it compiles with official 0.99.8
-
-    Revision 1.11  1998/10/01 16:04:11  michael
-    + Added RTL error handling
-
-    Revision 1.10  1998/09/24 23:45:27  peter
-      * updated for auto objpas loading
-
-    Revision 1.9  1998/09/24 16:13:49  michael
-    Changes in exception and open array handling
-
-    Revision 1.8  1998/09/18 23:57:26  michael
-    * Changed use_excepions to useexceptions
-
-    Revision 1.7  1998/09/16 14:34:38  pierre
-      * go32v2 did not compile
-      * wrong code in systr.inc corrected
-
-    Revision 1.6  1998/09/16 08:28:44  michael
-    Update from gertjan Schouten, plus small fix for linux
-
-    Revision 1.5  1998/09/04 08:49:07  peter
-      * 0.99.5 doesn't compile a whole objpas anymore to overcome crashes
-
-    Revision 1.4  1998/08/10 15:52:27  peter
-      * fixed so 0.99.5 compiles it, but no exception class
-
-    Revision 1.3  1998/07/29 15:44:32  michael
-     included sysutils and math.pp as target. They compile now.
 }

rtl/objpas/typinfo.pp

@@ -759,8 +759,8 @@ unit typinfo;
               CallIntegerProc(Instance,PropInfo^.SetProc,Integer(@Value), Index, IValue);
             ptvirtual:
               CallIntegerProc(Instance,
-	        PPointer(Pointer(Instance.ClassType)+Longint(PropInfo^.SetProc))^,
-		Integer(@Value), Index, IValue);
+                PPointer(Pointer(Instance.ClassType)+Longint(PropInfo^.SetProc))^,
+                Integer(@Value), Index, IValue);
          end;
       end;
 
@@ -807,7 +807,10 @@ end.
 
 {
   $Log$
-  Revision 1.29  1999-09-16 08:59:48  florian
+  Revision 1.30  1999-11-06 14:41:31  peter
+    * truncated log
+
+  Revision 1.29  1999/09/16 08:59:48  florian
     * GetPropInfo returns now nil if the property wasn't found
 
   Revision 1.28  1999/09/15 20:27:24  florian
@@ -868,23 +871,4 @@ end.
   Revision 1.7  1998/09/08 09:52:31  florian
     * small problems fixed
 
-  Revision 1.6  1998/09/08 00:08:36  michael
-  Made it compilable
-
-  Revision 1.5  1998/09/07 23:11:43  florian
-    + more fields to TTypeInfo added
-
-  Revision 1.4  1998/09/07 19:34:47  florian
-    * constant value is now supported as stored condition
-
-  Revision 1.3  1998/09/07 08:32:59  florian
-    + procedure IsStoredProc added
-
-  Revision 1.2  1998/09/06 21:27:05  florian
-    + some methods and declarations added
-
-  Revision 1.1  1998/08/25 22:30:00  florian
-    + initial revision:
-       o constants
-       o basic type data record
 }