* moved file and dir functions to sysfile/sysdir

  * win32 thread in systemunit

rtl/bsd/osmain.inc

@@ -14,18 +14,6 @@
 
  **********************************************************************}
 
-const
-     { Default creation mode for directories and files }
-
-     { read/write permission for everyone }
-     MODE_OPEN = S_IWUSR OR S_IRUSR OR
-                 S_IWGRP OR S_IRGRP OR
-                 S_IWOTH OR S_IROTH;
-     { read/write search permission for everyone }
-     MODE_MKDIR = MODE_OPEN OR
-                 S_IXUSR OR S_IXGRP OR S_IXOTH;
-
-
 {*****************************************************************************
                        Misc. System Dependent Functions
 *****************************************************************************}
@@ -132,342 +120,6 @@ begin
   InoutRes:=Errno2InoutRes;
 end;
 
-Procedure Do_Close(Handle:thandle);
-Begin
-  Fpclose(cint(Handle));
-End;
-
-Procedure Do_Erase(p:pchar);
-var
- fileinfo : stat;
-Begin
-  { verify if the filename is actually a directory }
-  { if so return error and do nothing, as defined  }
-  { by POSIX                                       }
-  if Fpstat(p,fileinfo)<0 then
-   begin
-     Errno2Inoutres;
-     exit;
-   end;
-  if FpS_ISDIR(fileinfo.st_mode) then
-   begin
-     InOutRes := 2;
-     exit;
-   end;
-  if Fpunlink(p)<0 then
-   Errno2Inoutres
-  Else
-   InOutRes:=0;
-End;
-
-{ truncate at a given position }
-procedure do_truncate (handle:thandle;fpos:longint);
-begin
-  { should be simulated in cases where it is not }
-  { available.                                   }
-  If Fpftruncate(handle,fpos)<0 Then
-   Errno2Inoutres
-  Else
-   InOutRes:=0;
-end;
-
-
-
-Procedure Do_Rename(p1,p2:pchar);
-Begin
-  If Fprename(p1,p2)<0 Then
-   Errno2Inoutres
-  Else
-   InOutRes:=0;
-End;
-
-
-Function Do_Write(Handle:thandle;Addr:Pointer;Len:Longint):longint;
-
-var j : cint;
-Begin
-  repeat
-    Do_Write:=Fpwrite(Handle,addr,len);
-    j:=geterrno;
-  until (do_write<>-1) or ((j<>ESysEINTR) and (j<>ESysEAgain));
-  If Do_Write<0 Then
-   Begin
-    Errno2InOutRes;
-    Do_Write:=0;
-   End
-  else
-   InOutRes:=0;
-End;
-
-
-Function Do_Read(Handle:thandle;Addr:Pointer;Len:Longint):Longint;
-
-var j:cint;
-
-Begin
-  repeat
-    Do_Read:=Fpread(Handle,addr,len);
-    j:=geterrno;
-  until (do_read<>-1) or ((j<>ESysEINTR) and (j<>ESysEAgain));
-  If Do_Read<0 Then
-   Begin
-    Errno2InOutRes;
-    Do_Read:=0;
-   End
-  else
-   InOutRes:=0;
-End;
-
-function Do_FilePos(Handle: thandle):longint;
-Begin
-  do_FilePos:=Fplseek(Handle, 0, SEEK_CUR);
-  If Do_FilePos<0 Then
-    Errno2InOutRes
-  else
-   InOutRes:=0;
-End;
-
-Procedure Do_Seek(Handle:thandle;Pos:Longint);
-Begin
-  If Fplseek(Handle, pos, SEEK_SET)<0 Then
-   Errno2Inoutres
-  Else
-   InOutRes:=0;
-End;
-
-Function Do_SeekEnd(Handle:thandle): Longint;
-begin
-  Do_SeekEnd:=Fplseek(Handle,0,SEEK_END);
-  If Do_SeekEnd<0 Then
-   Errno2Inoutres
-  Else
-   InOutRes:=0;
-end;
-
-Function Do_FileSize(Handle:thandle): Longint;
-var
-  Info : Stat;
-  Ret  : Longint;
-Begin
-  Ret:=Fpfstat(handle,info);
-  If Ret=0 Then
-   Do_FileSize:=Info.st_size
-  else
-   Do_FileSize:=0;
-  If Ret<0 Then
-   Errno2InOutRes
-  Else
-   InOutRes:=0;
-End;
-
-Procedure Do_Open(var f;p:pchar;flags:longint);
-{
-  FileRec and textrec have both Handle and mode as the first items so
-  they could use the same routine for opening/creating.
-  when (flags and $100)   the file will be append
-  when (flags and $1000)  the file will be truncate/rewritten
-  when (flags and $10000) there is no check for close (needed for textfiles)
-}
-var
-  oflags : cint;
-Begin
-{ close first if opened }
-  if ((flags and $10000)=0) then
-   begin
-     case FileRec(f).mode of
-      fminput,fmoutput,fminout : Do_Close(FileRec(f).Handle);
-      fmclosed : ;
-     else
-      begin
-        inoutres:=102; {not assigned}
-        exit;
-      end;
-     end;
-   end;
-{ reset file Handle }
-  FileRec(f).Handle:=UnusedHandle;
-{ We do the conversion of filemodes here, concentrated on 1 place }
-  case (flags and 3) of
-   0 : begin
-         oflags :=O_RDONLY;
-         FileRec(f).mode:=fminput;
-       end;
-   1 : begin
-         oflags :=O_WRONLY;
-         FileRec(f).mode:=fmoutput;
-       end;
-   2 : begin
-         oflags :=O_RDWR;
-         FileRec(f).mode:=fminout;
-       end;
-  end;
-  if (flags and $1000)=$1000 then
-   oflags:=oflags or (O_CREAT or O_TRUNC)
-  else
-   if (flags and $100)=$100 then
-    oflags:=oflags or (O_APPEND);
-{ empty name is special }
-  if p[0]=#0 then
-   begin
-     case FileRec(f).mode of
-       fminput :
-         FileRec(f).Handle:=StdInputHandle;
-       fminout, { this is set by rewrite }
-       fmoutput :
-         FileRec(f).Handle:=StdOutputHandle;
-       fmappend :
-         begin
-           FileRec(f).Handle:=StdOutputHandle;
-           FileRec(f).mode:=fmoutput; {fool fmappend}
-         end;
-     end;
-     exit;
-   end;
-{ real open call }
-  FileRec(f).Handle:=Fpopen(p,oflags,MODE_OPEN);
-  if (FileRec(f).Handle<0) and
-    (getErrNo=ESysEROFS) and ((OFlags and O_RDWR)<>0) then
-   begin
-     Oflags:=Oflags and not(O_RDWR);
-     FileRec(f).Handle:=Fpopen(p,oflags,MODE_OPEN);
-   end;
-  If Filerec(f).Handle<0 Then
-   Errno2Inoutres
-  else
-   InOutRes:=0;
-End;
-
-
-
-{*****************************************************************************
-                           Directory Handling
-*****************************************************************************}
-
-Procedure MkDir(Const s: String);[IOCheck];
-Var
-  Buffer: Array[0..255] of Char;
-Begin
-  If (s='') or (InOutRes <> 0) then
-   exit;
-  Move(s[1], Buffer, Length(s));
-  Buffer[Length(s)] := #0;
-  If Fpmkdir(@buffer, MODE_MKDIR)<0 Then
-   Errno2Inoutres
-  Else
-   InOutRes:=0;
-End;
-
-
-Procedure RmDir(Const s: String);[IOCheck];
-Var
-  Buffer: Array[0..255] of Char;
-Begin
-  if (s = '.') then
-    InOutRes := 16;
-  If (s='') or (InOutRes <> 0) then
-   exit;
-  Move(s[1], Buffer, Length(s));
-  Buffer[Length(s)] := #0;
-  If Fprmdir(@buffer)<0 Then
-   Errno2Inoutres
-  Else
-   InOutRes:=0;
-End;
-
-
-Procedure ChDir(Const s: String);[IOCheck];
-Var
-  Buffer: Array[0..255] of Char;
-Begin
-  If (s='') or (InOutRes <> 0) then
-   exit;
-  Move(s[1], Buffer, Length(s));
-  Buffer[Length(s)] := #0;
-  If Fpchdir(@buffer)<0 Then
-   Errno2Inoutres
-  Else
-   InOutRes:=0;
-  { file not exists is path not found under tp7 }
-  if InOutRes=2 then
-   InOutRes:=3;
-End;
-
-{ // $define usegetcwd}
-
-procedure getdir(drivenr : byte;var dir : shortstring);
-var
-{$ifndef usegetcwd}
-  cwdinfo      : stat;
-  rootinfo     : stat;
-  thedir,dummy : string[255];
-  dirstream    : pdir;
-  d            : pdirent;
-  name         : string[255];
-  thisdir      : stat;
-{$endif}
-  tmp          : string[255];
-
-begin
-{$ifdef usegetcwd}
- Fpgetcwd(@tmp[1],4096);
- dir:=tmp;
-{$else}
-  dir:='';
-  thedir:='';
-  dummy:='';
-
-  { get root directory information }
-  tmp := '/'+#0;
-  if Fpstat(@tmp[1],rootinfo)<0 then
-    Exit;
-  repeat
-    tmp := dummy+'.'+#0;
-    { get current directory information }
-    if Fpstat(@tmp[1],cwdinfo)<0 then
-      Exit;
-    tmp:=dummy+'..'+#0;
-    { open directory stream }
-    { try to find the current inode number of the cwd }
-    dirstream:=Fpopendir(@tmp[1]);
-    if dirstream=nil then
-       exit;
-    repeat
-      name:='';
-      d:=Fpreaddir(dirstream);
-      { no more entries to read ... }
-      if not assigned(d) then
-        break;
-      tmp:=dummy+'../'+strpas(d^.d_name) + #0;
-      if (Fpstat(@tmp[1],thisdir)=0) then
-       begin
-         { found the entry for this directory name }
-         if (cwdinfo.st_dev=thisdir.st_dev) and (cwdinfo.st_ino=thisdir.st_ino) then
-          begin
-            { are the filenames of type '.' or '..' ? }
-            { then do not set the name.               }
-            if (not ((d^.d_name[0]='.') and ((d^.d_name[1]=#0) or
-                    ((d^.d_name[1]='.') and (d^.d_name[2]=#0))))) then
-              name:='/'+strpas(d^.d_name);
-          end;
-       end;
-    until (name<>'');
-    if Fpclosedir(dirstream)<0 then
-      Exit;
-    thedir:=name+thedir;
-    dummy:=dummy+'../';
-    if ((cwdinfo.st_dev=rootinfo.st_dev) and (cwdinfo.st_ino=rootinfo.st_ino)) then
-      begin
-        if thedir='' then
-          dir:='/'
-        else
-          dir:=thedir;
-        exit;
-      end;
-  until false;
- {$endif}
-end;
-
-
 {*****************************************************************************
                          SystemUnit Initialization
 *****************************************************************************}
@@ -570,7 +222,11 @@ end;
 
 {
    $Log$
-   Revision 1.16  2004-10-25 15:38:59  peter
+   Revision 1.17  2005-02-06 13:06:20  peter
+     * moved file and dir functions to sysfile/sysdir
+     * win32 thread in systemunit
+
+   Revision 1.16  2004/10/25 15:38:59  peter
      * compiler defined HEAP and HEAPSIZE removed
 
    Revision 1.15  2004/07/17 15:20:55  jonas

rtl/bsd/sysdir.inc

@@ -0,0 +1,152 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+
+    Main OS dependant body of the system unit, loosely modelled
+    after POSIX.  *BSD version (Linux version is near identical)
+
+    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.
+
+ **********************************************************************}
+
+
+{*****************************************************************************
+                           Directory Handling
+*****************************************************************************}
+
+Procedure MkDir(Const s: String);[IOCheck];
+Var
+  Buffer: Array[0..255] of Char;
+Begin
+  If (s='') or (InOutRes <> 0) then
+   exit;
+  Move(s[1], Buffer, Length(s));
+  Buffer[Length(s)] := #0;
+  If Fpmkdir(@buffer, MODE_MKDIR)<0 Then
+   Errno2Inoutres
+  Else
+   InOutRes:=0;
+End;
+
+
+Procedure RmDir(Const s: String);[IOCheck];
+Var
+  Buffer: Array[0..255] of Char;
+Begin
+  if (s = '.') then
+    InOutRes := 16;
+  If (s='') or (InOutRes <> 0) then
+   exit;
+  Move(s[1], Buffer, Length(s));
+  Buffer[Length(s)] := #0;
+  If Fprmdir(@buffer)<0 Then
+   Errno2Inoutres
+  Else
+   InOutRes:=0;
+End;
+
+
+Procedure ChDir(Const s: String);[IOCheck];
+Var
+  Buffer: Array[0..255] of Char;
+Begin
+  If (s='') or (InOutRes <> 0) then
+   exit;
+  Move(s[1], Buffer, Length(s));
+  Buffer[Length(s)] := #0;
+  If Fpchdir(@buffer)<0 Then
+   Errno2Inoutres
+  Else
+   InOutRes:=0;
+  { file not exists is path not found under tp7 }
+  if InOutRes=2 then
+   InOutRes:=3;
+End;
+
+{ // $define usegetcwd}
+
+procedure getdir(drivenr : byte;var dir : shortstring);
+var
+{$ifndef usegetcwd}
+  cwdinfo      : stat;
+  rootinfo     : stat;
+  thedir,dummy : string[255];
+  dirstream    : pdir;
+  d            : pdirent;
+  name         : string[255];
+  thisdir      : stat;
+{$endif}
+  tmp          : string[255];
+
+begin
+{$ifdef usegetcwd}
+ Fpgetcwd(@tmp[1],4096);
+ dir:=tmp;
+{$else}
+  dir:='';
+  thedir:='';
+  dummy:='';
+
+  { get root directory information }
+  tmp := '/'+#0;
+  if Fpstat(@tmp[1],rootinfo)<0 then
+    Exit;
+  repeat
+    tmp := dummy+'.'+#0;
+    { get current directory information }
+    if Fpstat(@tmp[1],cwdinfo)<0 then
+      Exit;
+    tmp:=dummy+'..'+#0;
+    { open directory stream }
+    { try to find the current inode number of the cwd }
+    dirstream:=Fpopendir(@tmp[1]);
+    if dirstream=nil then
+       exit;
+    repeat
+      name:='';
+      d:=Fpreaddir(dirstream);
+      { no more entries to read ... }
+      if not assigned(d) then
+        break;
+      tmp:=dummy+'../'+strpas(d^.d_name) + #0;
+      if (Fpstat(@tmp[1],thisdir)=0) then
+       begin
+         { found the entry for this directory name }
+         if (cwdinfo.st_dev=thisdir.st_dev) and (cwdinfo.st_ino=thisdir.st_ino) then
+          begin
+            { are the filenames of type '.' or '..' ? }
+            { then do not set the name.               }
+            if (not ((d^.d_name[0]='.') and ((d^.d_name[1]=#0) or
+                    ((d^.d_name[1]='.') and (d^.d_name[2]=#0))))) then
+              name:='/'+strpas(d^.d_name);
+          end;
+       end;
+    until (name<>'');
+    if Fpclosedir(dirstream)<0 then
+      Exit;
+    thedir:=name+thedir;
+    dummy:=dummy+'../';
+    if ((cwdinfo.st_dev=rootinfo.st_dev) and (cwdinfo.st_ino=rootinfo.st_ino)) then
+      begin
+        if thedir='' then
+          dir:='/'
+        else
+          dir:=thedir;
+        exit;
+      end;
+  until false;
+ {$endif}
+end;
+
+{
+  $Log$
+  Revision 1.1  2005-02-06 13:06:20  peter
+    * moved file and dir functions to sysfile/sysdir
+    * win32 thread in systemunit
+
+}

rtl/bsd/sysfile.inc

@@ -0,0 +1,230 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+
+    Main OS dependant body of the system unit, loosely modelled
+    after POSIX.  *BSD version (Linux version is near identical)
+
+    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.
+
+ **********************************************************************}
+
+
+Procedure Do_Close(Handle:thandle);
+Begin
+  Fpclose(cint(Handle));
+End;
+
+Procedure Do_Erase(p:pchar);
+var
+ fileinfo : stat;
+Begin
+  { verify if the filename is actually a directory }
+  { if so return error and do nothing, as defined  }
+  { by POSIX                                       }
+  if Fpstat(p,fileinfo)<0 then
+   begin
+     Errno2Inoutres;
+     exit;
+   end;
+  if FpS_ISDIR(fileinfo.st_mode) then
+   begin
+     InOutRes := 2;
+     exit;
+   end;
+  if Fpunlink(p)<0 then
+   Errno2Inoutres
+  Else
+   InOutRes:=0;
+End;
+
+{ truncate at a given position }
+procedure do_truncate (handle:thandle;fpos:longint);
+begin
+  { should be simulated in cases where it is not }
+  { available.                                   }
+  If Fpftruncate(handle,fpos)<0 Then
+   Errno2Inoutres
+  Else
+   InOutRes:=0;
+end;
+
+
+
+Procedure Do_Rename(p1,p2:pchar);
+Begin
+  If Fprename(p1,p2)<0 Then
+   Errno2Inoutres
+  Else
+   InOutRes:=0;
+End;
+
+
+Function Do_Write(Handle:thandle;Addr:Pointer;Len:Longint):longint;
+
+var j : cint;
+Begin
+  repeat
+    Do_Write:=Fpwrite(Handle,addr,len);
+    j:=geterrno;
+  until (do_write<>-1) or ((j<>ESysEINTR) and (j<>ESysEAgain));
+  If Do_Write<0 Then
+   Begin
+    Errno2InOutRes;
+    Do_Write:=0;
+   End
+  else
+   InOutRes:=0;
+End;
+
+
+Function Do_Read(Handle:thandle;Addr:Pointer;Len:Longint):Longint;
+
+var j:cint;
+
+Begin
+  repeat
+    Do_Read:=Fpread(Handle,addr,len);
+    j:=geterrno;
+  until (do_read<>-1) or ((j<>ESysEINTR) and (j<>ESysEAgain));
+  If Do_Read<0 Then
+   Begin
+    Errno2InOutRes;
+    Do_Read:=0;
+   End
+  else
+   InOutRes:=0;
+End;
+
+function Do_FilePos(Handle: thandle):longint;
+Begin
+  do_FilePos:=Fplseek(Handle, 0, SEEK_CUR);
+  If Do_FilePos<0 Then
+    Errno2InOutRes
+  else
+   InOutRes:=0;
+End;
+
+Procedure Do_Seek(Handle:thandle;Pos:Longint);
+Begin
+  If Fplseek(Handle, pos, SEEK_SET)<0 Then
+   Errno2Inoutres
+  Else
+   InOutRes:=0;
+End;
+
+Function Do_SeekEnd(Handle:thandle): Longint;
+begin
+  Do_SeekEnd:=Fplseek(Handle,0,SEEK_END);
+  If Do_SeekEnd<0 Then
+   Errno2Inoutres
+  Else
+   InOutRes:=0;
+end;
+
+Function Do_FileSize(Handle:thandle): Longint;
+var
+  Info : Stat;
+  Ret  : Longint;
+Begin
+  Ret:=Fpfstat(handle,info);
+  If Ret=0 Then
+   Do_FileSize:=Info.st_size
+  else
+   Do_FileSize:=0;
+  If Ret<0 Then
+   Errno2InOutRes
+  Else
+   InOutRes:=0;
+End;
+
+Procedure Do_Open(var f;p:pchar;flags:longint);
+{
+  FileRec and textrec have both Handle and mode as the first items so
+  they could use the same routine for opening/creating.
+  when (flags and $100)   the file will be append
+  when (flags and $1000)  the file will be truncate/rewritten
+  when (flags and $10000) there is no check for close (needed for textfiles)
+}
+var
+  oflags : cint;
+Begin
+{ close first if opened }
+  if ((flags and $10000)=0) then
+   begin
+     case FileRec(f).mode of
+      fminput,fmoutput,fminout : Do_Close(FileRec(f).Handle);
+      fmclosed : ;
+     else
+      begin
+        inoutres:=102; {not assigned}
+        exit;
+      end;
+     end;
+   end;
+{ reset file Handle }
+  FileRec(f).Handle:=UnusedHandle;
+{ We do the conversion of filemodes here, concentrated on 1 place }
+  case (flags and 3) of
+   0 : begin
+         oflags :=O_RDONLY;
+         FileRec(f).mode:=fminput;
+       end;
+   1 : begin
+         oflags :=O_WRONLY;
+         FileRec(f).mode:=fmoutput;
+       end;
+   2 : begin
+         oflags :=O_RDWR;
+         FileRec(f).mode:=fminout;
+       end;
+  end;
+  if (flags and $1000)=$1000 then
+   oflags:=oflags or (O_CREAT or O_TRUNC)
+  else
+   if (flags and $100)=$100 then
+    oflags:=oflags or (O_APPEND);
+{ empty name is special }
+  if p[0]=#0 then
+   begin
+     case FileRec(f).mode of
+       fminput :
+         FileRec(f).Handle:=StdInputHandle;
+       fminout, { this is set by rewrite }
+       fmoutput :
+         FileRec(f).Handle:=StdOutputHandle;
+       fmappend :
+         begin
+           FileRec(f).Handle:=StdOutputHandle;
+           FileRec(f).mode:=fmoutput; {fool fmappend}
+         end;
+     end;
+     exit;
+   end;
+{ real open call }
+  FileRec(f).Handle:=Fpopen(p,oflags,MODE_OPEN);
+  if (FileRec(f).Handle<0) and
+    (getErrNo=ESysEROFS) and ((OFlags and O_RDWR)<>0) then
+   begin
+     Oflags:=Oflags and not(O_RDWR);
+     FileRec(f).Handle:=Fpopen(p,oflags,MODE_OPEN);
+   end;
+  If Filerec(f).Handle<0 Then
+   Errno2Inoutres
+  else
+   InOutRes:=0;
+End;
+
+
+{
+  $Log$
+  Revision 1.1  2005-02-06 13:06:20  peter
+    * moved file and dir functions to sysfile/sysdir
+    * win32 thread in systemunit
+
+}

rtl/bsd/sysos.inc

@@ -87,11 +87,26 @@ end;
 {$I ossysc.inc}
 {$I osmain.inc}
 
+const
+     { Default creation mode for directories and files }
+
+     { read/write permission for everyone }
+     MODE_OPEN = S_IWUSR OR S_IRUSR OR
+                 S_IWGRP OR S_IRGRP OR
+                 S_IWOTH OR S_IROTH;
+     { read/write search permission for everyone }
+     MODE_MKDIR = MODE_OPEN OR
+                 S_IXUSR OR S_IXGRP OR S_IXOTH;
+
 
 
 {
    $Log$
-   Revision 1.1  2005-02-06 12:16:52  peter
+   Revision 1.2  2005-02-06 13:06:20  peter
+     * moved file and dir functions to sysfile/sysdir
+     * win32 thread in systemunit
+
+   Revision 1.1  2005/02/06 12:16:52  peter
      * bsd thread updates
 
 }

rtl/freebsd/sysconst.inc

@@ -90,10 +90,6 @@ const
   fs_proc     = $9fa0;
   fs_xia      = $012FD16D;
 
-  { Constansts for MMAP }
-  MAP_PRIVATE   =2;
-  MAP_ANONYMOUS =$1000;
-
   {Constansts Termios/Ioctl (used in Do_IsDevice) }
   IOCtl_TCGETS= $40000000+$2C7400+ 19; // TCGETS is also in termios.inc, but the sysunix needs only this
 
@@ -117,7 +113,11 @@ type
 
 {
   $Log$
-  Revision 1.10  2004-11-14 12:21:08  marco
+  Revision 1.11  2005-02-06 13:06:20  peter
+    * moved file and dir functions to sysfile/sysdir
+    * win32 thread in systemunit
+
+  Revision 1.10  2004/11/14 12:21:08  marco
    * moved some calls from unix to baseunix. Darwin untested.
 
   Revision 1.9  2003/11/19 10:12:02  marco

rtl/inc/system.inc

@@ -850,7 +850,7 @@ var p   : ppchar;
 begin
   if High(s)<Low(s) Then Exit(NIL);
   Getmem(p,sizeof(pchar)*(high(s)-low(s)+ReserveEntries+2));  // one more for NIL, one more
-					      // for cmd
+                                              // for cmd
   if p=nil then
     begin
       {$ifdef xunix}
@@ -886,23 +886,23 @@ begin
   buf:=s;
   nr:=1;
   InQuote:=false;
-  while (buf^<>#0) do			// count nr of args
+  while (buf^<>#0) do                   // count nr of args
    begin
-     while (buf^ in [' ',#9,#10]) do	// Kill separators.
+     while (buf^ in [' ',#9,#10]) do    // Kill separators.
       inc(buf);
      inc(nr);
-     if buf^='"' Then			// quotes argument?
+     if buf^='"' Then                   // quotes argument?
       begin
-	inc(buf);
-	while not (buf^ in [#0,'"']) do	// then end of argument is end of string or next quote
-	 inc(buf);
-        if buf^='"' then		// skip closing quote.
-	  inc(buf);
+        inc(buf);
+        while not (buf^ in [#0,'"']) do // then end of argument is end of string or next quote
+         inc(buf);
+        if buf^='"' then                // skip closing quote.
+          inc(buf);
       end
      else
-       begin				// else std
-	 while not (buf^ in [' ',#0,#9,#10]) do
-	   inc(buf);
+       begin                            // else std
+         while not (buf^ in [' ',#0,#9,#10]) do
+           inc(buf);
        end;
    end;
   getmem(p,(ReserveEntries+nr)*sizeof(pchar));
@@ -914,36 +914,36 @@ begin
      {$endif}
      exit;
    end;
-  for i:=1 to ReserveEntries do inc(p);	// skip empty slots
+  for i:=1 to ReserveEntries do inc(p); // skip empty slots
   buf:=s;
   while (buf^<>#0) do
    begin
-     while (buf^ in [' ',#9,#10]) do	// Kill separators.
+     while (buf^ in [' ',#9,#10]) do    // Kill separators.
       begin
        buf^:=#0;
        inc(buf);
       end;
-     if buf^='"' Then			// quotes argument?
+     if buf^='"' Then                   // quotes argument?
       begin
-	inc(buf);
+        inc(buf);
         p^:=buf;
-	inc(p);
-	p^:=nil;
-	while not (buf^ in [#0,'"']) do	// then end of argument is end of string or next quote
-	 inc(buf);
-        if buf^='"' then		// skip closing quote.
-	  begin
-	    buf^:=#0;
-  	    inc(buf);
+        inc(p);
+        p^:=nil;
+        while not (buf^ in [#0,'"']) do // then end of argument is end of string or next quote
+         inc(buf);
+        if buf^='"' then                // skip closing quote.
+          begin
+            buf^:=#0;
+            inc(buf);
           end;
       end
      else
        begin
-	p^:=buf;
-	inc(p);
-	p^:=nil;
-	 while not (buf^ in [' ',#0,#9,#10]) do
-	   inc(buf);
+        p^:=buf;
+        inc(p);
+        p^:=nil;
+         while not (buf^ in [' ',#0,#9,#10]) do
+           inc(buf);
        end;
    end;
 end;
@@ -1034,28 +1034,37 @@ end;
 
 
 {*****************************************************************************
-                       Text File Handling
+                            File Handling
 *****************************************************************************}
 
-{$I text.inc}
+{ OS dependent low level file functions }
+{$i sysfile.inc}
 
-{*****************************************************************************
-                 UnTyped File Handling
-*****************************************************************************}
+{ Text file }
+{$i text.inc}
 
+{ Untyped file }
 {$i file.inc}
 
+{ Typed file }
+{$i typefile.inc}
+
+
 {*****************************************************************************
-                 Typed File Handling
+                            Directory Handling
 *****************************************************************************}
 
-{$i typefile.inc}
-
+{ OS dependent dir functions }
+{$i sysdir.inc}
 
 
 {
   $Log$
-  Revision 1.72  2005-02-06 11:20:52  peter
+  Revision 1.73  2005-02-06 13:06:20  peter
+    * moved file and dir functions to sysfile/sysdir
+    * win32 thread in systemunit
+
+  Revision 1.72  2005/02/06 11:20:52  peter
     * threading in system unit
     * removed systhrds unit
 

rtl/linux/osmain.inc

@@ -16,17 +16,6 @@
 
  **********************************************************************}
 
-const
-     { Default creation mode for directories and files }
-
-     { read/write permission for everyone }
-     MODE_OPEN = S_IWUSR OR S_IRUSR OR
-                 S_IWGRP OR S_IRGRP OR
-                 S_IWOTH OR S_IROTH;
-     { read/write search permission for everyone }
-     MODE_MKDIR = MODE_OPEN OR
-                 S_IXUSR OR S_IXGRP OR S_IXOTH;
-
 
 {*****************************************************************************
                        Misc. System Dependent Functions
@@ -134,345 +123,6 @@ begin
 end;
 
 
-Procedure Do_Close(Handle:thandle);
-Begin
-  Fpclose(cint(Handle));
-End;
-
-
-Procedure Do_Erase(p:pchar);
-var
-  fileinfo : stat;
-Begin
-  { verify if the filename is actually a directory }
-  { if so return error and do nothing, as defined  }
-  { by POSIX                                       }
-  if Fpstat(p,fileinfo)<0 then
-   begin
-     Errno2Inoutres;
-     exit;
-   end;
-  if FpS_ISDIR(fileinfo.st_mode) then
-   begin
-     InOutRes := 2;
-     exit;
-   end;
-  if Fpunlink(p)<0 then
-   Errno2Inoutres
-  Else
-   InOutRes:=0;
-End;
-
-{ truncate at a given position }
-procedure do_truncate (handle:thandle;fpos:longint);
-begin
-  { should be simulated in cases where it is not }
-  { available.                                   }
-  If Fpftruncate(handle,fpos)<0 Then
-   Errno2Inoutres
-  Else
-   InOutRes:=0;
-end;
-
-
-Procedure Do_Rename(p1,p2:pchar);
-Begin
-  If Fprename(p1,p2)<0 Then
-   Errno2Inoutres
-  Else
-   InOutRes:=0;
-End;
-
-
-Function Do_Write(Handle:thandle;Addr:Pointer;Len:SizeInt):SizeInt;
-Begin
-  repeat
-    Do_Write:=Fpwrite(Handle,addr,len);
-  until (Do_Write>=0) or (getErrNo<>ESysEINTR);
-  If Do_Write<0 Then
-   Begin
-    Errno2InOutRes;
-    Do_Write:=0;
-   End
-  else
-   InOutRes:=0;
-End;
-
-
-Function Do_Read(Handle:thandle;Addr:Pointer;Len:SizeInt):SizeInt;
-Begin
-  repeat
-    Do_Read:=Fpread(Handle,addr,len);
-  until (Do_Read>=0) or (getErrNo<>ESysEINTR);
-  If Do_Read<0 Then
-   Begin
-    Errno2InOutRes;
-    Do_Read:=0;
-   End
-  else
-   InOutRes:=0;
-End;
-
-
-function Do_FilePos(Handle: thandle):longint;
-Begin
-  do_FilePos:=Fplseek(Handle, 0, SEEK_CUR);
-  If Do_FilePos<0 Then
-    Errno2InOutRes
-  else
-   InOutRes:=0;
-End;
-
-
-Procedure Do_Seek(Handle:thandle;Pos:Longint);
-Begin
-  If Fplseek(Handle, pos, SEEK_SET)<0 Then
-   Errno2Inoutres
-  Else
-   InOutRes:=0;
-End;
-
-
-Function Do_SeekEnd(Handle:thandle): Longint;
-begin
-  Do_SeekEnd:=Fplseek(Handle,0,SEEK_END);
-  If Do_SeekEnd<0 Then
-   Errno2Inoutres
-  Else
-   InOutRes:=0;
-end;
-
-
-Function Do_FileSize(Handle:thandle): Longint;
-var
-  Info : Stat;
-  Ret  : Longint;
-Begin
-  Ret:=Fpfstat(handle,info);
-  If Ret=0 Then
-   Do_FileSize:=Info.st_size
-  else
-   Do_FileSize:=0;
-  If Ret<0 Then
-   Errno2InOutRes
-  Else
-   InOutRes:=0;
-End;
-
-
-Procedure Do_Open(var f;p:pchar;flags:longint);
-{
-  FileRec and textrec have both Handle and mode as the first items so
-  they could use the same routine for opening/creating.
-  when (flags and $100)   the file will be append
-  when (flags and $1000)  the file will be truncate/rewritten
-  when (flags and $10000) there is no check for close (needed for textfiles)
-}
-var
-  oflags : cint;
-Begin
-{ close first if opened }
-  if ((flags and $10000)=0) then
-   begin
-     case FileRec(f).mode of
-      fminput,fmoutput,fminout : Do_Close(FileRec(f).Handle);
-      fmclosed : ;
-     else
-      begin
-        inoutres:=102; {not assigned}
-        exit;
-      end;
-     end;
-   end;
-{ reset file Handle }
-  FileRec(f).Handle:=UnusedHandle;
-{ We do the conversion of filemodes here, concentrated on 1 place }
-  case (flags and 3) of
-   0 : begin
-         oflags :=O_RDONLY;
-         FileRec(f).mode:=fminput;
-       end;
-   1 : begin
-         oflags :=O_WRONLY;
-         FileRec(f).mode:=fmoutput;
-       end;
-   2 : begin
-         oflags :=O_RDWR;
-         FileRec(f).mode:=fminout;
-       end;
-  end;
-  if (flags and $1000)=$1000 then
-   oflags:=oflags or (O_CREAT or O_TRUNC)
-  else
-   if (flags and $100)=$100 then
-    oflags:=oflags or (O_APPEND);
-{ empty name is special }
-  if p[0]=#0 then
-   begin
-     case FileRec(f).mode of
-       fminput :
-         FileRec(f).Handle:=StdInputHandle;
-       fminout, { this is set by rewrite }
-       fmoutput :
-         FileRec(f).Handle:=StdOutputHandle;
-       fmappend :
-         begin
-           FileRec(f).Handle:=StdOutputHandle;
-           FileRec(f).mode:=fmoutput; {fool fmappend}
-         end;
-     end;
-     exit;
-   end;
-{ real open call }
-  FileRec(f).Handle:=Fpopen(p,oflags,MODE_OPEN);
-  if (FileRec(f).Handle<0) and
-     (getErrNo=ESysEROFS) and
-     ((OFlags and O_RDWR)<>0) then
-   begin
-     Oflags:=Oflags and not(O_RDWR);
-     FileRec(f).Handle:=Fpopen(p,oflags,MODE_OPEN);
-   end;
-  If Filerec(f).Handle<0 Then
-   Errno2Inoutres
-  else
-   InOutRes:=0;
-End;
-
-
-
-{*****************************************************************************
-                           Directory Handling
-*****************************************************************************}
-
-Procedure MkDir(Const s: String);[IOCheck];
-Var
-  Buffer: Array[0..255] of Char;
-Begin
-  If (s='') or (InOutRes <> 0) then
-   exit;
-  Move(s[1], Buffer, Length(s));
-  Buffer[Length(s)] := #0;
-  If Fpmkdir(@buffer, MODE_MKDIR)<0 Then
-   Errno2Inoutres
-  Else
-   InOutRes:=0;
-End;
-
-Procedure RmDir(Const s: String);[IOCheck];
-Var
-  Buffer: Array[0..255] of Char;
-Begin
-  if (s = '.') then
-    InOutRes := 16;
-  If (s='') or (InOutRes <> 0) then
-   exit;
-  Move(s[1], Buffer, Length(s));
-  Buffer[Length(s)] := #0;
-  If Fprmdir(@buffer)<0 Then
-   Errno2Inoutres
-  Else
-   InOutRes:=0;
-End;
-
-
-Procedure ChDir(Const s: String);[IOCheck];
-Var
-  Buffer: Array[0..255] of Char;
-Begin
-  If (s='') or (InOutRes <> 0) then
-   exit;
-  Move(s[1], Buffer, Length(s));
-  Buffer[Length(s)] := #0;
-  If Fpchdir(@buffer)<0 Then
-   Errno2Inoutres
-  Else
-   InOutRes:=0;
-  { file not exists is path not found under tp7 }
-  if InOutRes=2 then
-   InOutRes:=3;
-End;
-
-procedure getdir(drivenr : byte;var dir : shortstring);
-var
-{$ifndef usegetcwd}
-  cwdinfo      : stat;
-  rootinfo     : stat;
-  thedir,dummy : string[255];
-  dirstream    : pdir;
-  d            : pdirent;
-  name         : string[255];
-  thisdir      : stat;
-  tmp          : string[255];
-{$else}
-  tmp	       : array[0..4095] of char;
-{$endif}
-
-begin
-{$ifdef usegetcwd}
- if Fpgetcwd(@tmp,10240+512)<>NIL then
-  dir:=pchar(@tmp)
- else
-  begin
-    dir:='';
-    writeln(geterrno);
-  end;
-{$else}
-  dir:='';
-  thedir:='';
-  dummy:='';
-
-  { get root directory information }
-  tmp := '/'+#0;
-  if Fpstat(@tmp[1],rootinfo)<0 then
-    Exit;
-  repeat
-    tmp := dummy+'.'+#0;
-    { get current directory information }
-    if Fpstat(@tmp[1],cwdinfo)<0 then
-      Exit;
-    tmp:=dummy+'..'+#0;
-    { open directory stream }
-    { try to find the current inode number of the cwd }
-    dirstream:=Fpopendir(@tmp[1]);
-    if dirstream=nil then
-      exit;
-    repeat
-      name:='';
-      d:=Fpreaddir(dirstream);
-      { no more entries to read ... }
-      if not assigned(d) then
-        break;
-      tmp:=dummy+'../'+strpas(d^.d_name) + #0;
-      if (Fpstat(@tmp[1],thisdir)=0) then
-       begin
-         { found the entry for this directory name }
-         if (cwdinfo.st_dev=thisdir.st_dev) and (cwdinfo.st_ino=thisdir.st_ino) then
-          begin
-            { are the filenames of type '.' or '..' ? }
-            { then do not set the name.               }
-            if (not ((d^.d_name[0]='.') and ((d^.d_name[1]=#0) or
-                    ((d^.d_name[1]='.') and (d^.d_name[2]=#0))))) then
-              name:='/'+strpas(d^.d_name);
-          end;
-       end;
-    until (name<>'');
-    If Fpclosedir(dirstream)<0 THen
-      Exit;
-    thedir:=name+thedir;
-    dummy:=dummy+'../';
-    if ((cwdinfo.st_dev=rootinfo.st_dev) and (cwdinfo.st_ino=rootinfo.st_ino)) then
-      begin
-        if thedir='' then
-          dir:='/'
-        else
-          dir:=thedir;
-        exit;
-      end;
-  until false;
- {$endif}
-end;
-
-
 {*****************************************************************************
                          SystemUnit Initialization
 *****************************************************************************}
@@ -563,7 +213,11 @@ end;
 
 {
  $Log$
- Revision 1.26  2005-02-05 22:53:43  peter
+ Revision 1.27  2005-02-06 13:06:20  peter
+   * moved file and dir functions to sysfile/sysdir
+   * win32 thread in systemunit
+
+ Revision 1.26  2005/02/05 22:53:43  peter
    * use typecasted sigactionhandler, needed for arm
 
  Revision 1.25  2005/02/03 21:42:17  peter

rtl/linux/sysdir.inc

@@ -0,0 +1,157 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+
+    POSIX Interface to the system unit
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This is the core of the system unit *nix systems (now FreeBSD
+     and Unix).
+
+    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.
+
+ **********************************************************************}
+
+{*****************************************************************************
+                           Directory Handling
+*****************************************************************************}
+
+Procedure MkDir(Const s: String);[IOCheck];
+Var
+  Buffer: Array[0..255] of Char;
+Begin
+  If (s='') or (InOutRes <> 0) then
+   exit;
+  Move(s[1], Buffer, Length(s));
+  Buffer[Length(s)] := #0;
+  If Fpmkdir(@buffer, MODE_MKDIR)<0 Then
+   Errno2Inoutres
+  Else
+   InOutRes:=0;
+End;
+
+Procedure RmDir(Const s: String);[IOCheck];
+Var
+  Buffer: Array[0..255] of Char;
+Begin
+  if (s = '.') then
+    InOutRes := 16;
+  If (s='') or (InOutRes <> 0) then
+   exit;
+  Move(s[1], Buffer, Length(s));
+  Buffer[Length(s)] := #0;
+  If Fprmdir(@buffer)<0 Then
+   Errno2Inoutres
+  Else
+   InOutRes:=0;
+End;
+
+
+Procedure ChDir(Const s: String);[IOCheck];
+Var
+  Buffer: Array[0..255] of Char;
+Begin
+  If (s='') or (InOutRes <> 0) then
+   exit;
+  Move(s[1], Buffer, Length(s));
+  Buffer[Length(s)] := #0;
+  If Fpchdir(@buffer)<0 Then
+   Errno2Inoutres
+  Else
+   InOutRes:=0;
+  { file not exists is path not found under tp7 }
+  if InOutRes=2 then
+   InOutRes:=3;
+End;
+
+procedure getdir(drivenr : byte;var dir : shortstring);
+var
+{$ifndef usegetcwd}
+  cwdinfo      : stat;
+  rootinfo     : stat;
+  thedir,dummy : string[255];
+  dirstream    : pdir;
+  d            : pdirent;
+  name         : string[255];
+  thisdir      : stat;
+  tmp          : string[255];
+{$else}
+  tmp          : array[0..4095] of char;
+{$endif}
+
+begin
+{$ifdef usegetcwd}
+ if Fpgetcwd(@tmp,10240+512)<>NIL then
+  dir:=pchar(@tmp)
+ else
+  begin
+    dir:='';
+    writeln(geterrno);
+  end;
+{$else}
+  dir:='';
+  thedir:='';
+  dummy:='';
+
+  { get root directory information }
+  tmp := '/'+#0;
+  if Fpstat(@tmp[1],rootinfo)<0 then
+    Exit;
+  repeat
+    tmp := dummy+'.'+#0;
+    { get current directory information }
+    if Fpstat(@tmp[1],cwdinfo)<0 then
+      Exit;
+    tmp:=dummy+'..'+#0;
+    { open directory stream }
+    { try to find the current inode number of the cwd }
+    dirstream:=Fpopendir(@tmp[1]);
+    if dirstream=nil then
+      exit;
+    repeat
+      name:='';
+      d:=Fpreaddir(dirstream);
+      { no more entries to read ... }
+      if not assigned(d) then
+        break;
+      tmp:=dummy+'../'+strpas(d^.d_name) + #0;
+      if (Fpstat(@tmp[1],thisdir)=0) then
+       begin
+         { found the entry for this directory name }
+         if (cwdinfo.st_dev=thisdir.st_dev) and (cwdinfo.st_ino=thisdir.st_ino) then
+          begin
+            { are the filenames of type '.' or '..' ? }
+            { then do not set the name.               }
+            if (not ((d^.d_name[0]='.') and ((d^.d_name[1]=#0) or
+                    ((d^.d_name[1]='.') and (d^.d_name[2]=#0))))) then
+              name:='/'+strpas(d^.d_name);
+          end;
+       end;
+    until (name<>'');
+    If Fpclosedir(dirstream)<0 THen
+      Exit;
+    thedir:=name+thedir;
+    dummy:=dummy+'../';
+    if ((cwdinfo.st_dev=rootinfo.st_dev) and (cwdinfo.st_ino=rootinfo.st_ino)) then
+      begin
+        if thedir='' then
+          dir:='/'
+        else
+          dir:=thedir;
+        exit;
+      end;
+  until false;
+ {$endif}
+end;
+
+{
+  $Log$
+  Revision 1.1  2005-02-06 13:06:20  peter
+    * moved file and dir functions to sysfile/sysdir
+    * win32 thread in systemunit
+
+}

rtl/linux/sysfile.inc

@@ -0,0 +1,230 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+
+    POSIX Interface to the system unit
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This is the core of the system unit *nix systems (now FreeBSD
+     and Unix).
+
+    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.
+
+ **********************************************************************}
+
+
+Procedure Do_Close(Handle:thandle);
+Begin
+  Fpclose(cint(Handle));
+End;
+
+
+Procedure Do_Erase(p:pchar);
+var
+  fileinfo : stat;
+Begin
+  { verify if the filename is actually a directory }
+  { if so return error and do nothing, as defined  }
+  { by POSIX                                       }
+  if Fpstat(p,fileinfo)<0 then
+   begin
+     Errno2Inoutres;
+     exit;
+   end;
+  if FpS_ISDIR(fileinfo.st_mode) then
+   begin
+     InOutRes := 2;
+     exit;
+   end;
+  if Fpunlink(p)<0 then
+   Errno2Inoutres
+  Else
+   InOutRes:=0;
+End;
+
+{ truncate at a given position }
+procedure do_truncate (handle:thandle;fpos:longint);
+begin
+  { should be simulated in cases where it is not }
+  { available.                                   }
+  If Fpftruncate(handle,fpos)<0 Then
+   Errno2Inoutres
+  Else
+   InOutRes:=0;
+end;
+
+
+Procedure Do_Rename(p1,p2:pchar);
+Begin
+  If Fprename(p1,p2)<0 Then
+   Errno2Inoutres
+  Else
+   InOutRes:=0;
+End;
+
+
+Function Do_Write(Handle:thandle;Addr:Pointer;Len:SizeInt):SizeInt;
+Begin
+  repeat
+    Do_Write:=Fpwrite(Handle,addr,len);
+  until (Do_Write>=0) or (getErrNo<>ESysEINTR);
+  If Do_Write<0 Then
+   Begin
+    Errno2InOutRes;
+    Do_Write:=0;
+   End
+  else
+   InOutRes:=0;
+End;
+
+
+Function Do_Read(Handle:thandle;Addr:Pointer;Len:SizeInt):SizeInt;
+Begin
+  repeat
+    Do_Read:=Fpread(Handle,addr,len);
+  until (Do_Read>=0) or (getErrNo<>ESysEINTR);
+  If Do_Read<0 Then
+   Begin
+    Errno2InOutRes;
+    Do_Read:=0;
+   End
+  else
+   InOutRes:=0;
+End;
+
+
+function Do_FilePos(Handle: thandle):longint;
+Begin
+  do_FilePos:=Fplseek(Handle, 0, SEEK_CUR);
+  If Do_FilePos<0 Then
+    Errno2InOutRes
+  else
+   InOutRes:=0;
+End;
+
+
+Procedure Do_Seek(Handle:thandle;Pos:Longint);
+Begin
+  If Fplseek(Handle, pos, SEEK_SET)<0 Then
+   Errno2Inoutres
+  Else
+   InOutRes:=0;
+End;
+
+
+Function Do_SeekEnd(Handle:thandle): Longint;
+begin
+  Do_SeekEnd:=Fplseek(Handle,0,SEEK_END);
+  If Do_SeekEnd<0 Then
+   Errno2Inoutres
+  Else
+   InOutRes:=0;
+end;
+
+
+Function Do_FileSize(Handle:thandle): Longint;
+var
+  Info : Stat;
+  Ret  : Longint;
+Begin
+  Ret:=Fpfstat(handle,info);
+  If Ret=0 Then
+   Do_FileSize:=Info.st_size
+  else
+   Do_FileSize:=0;
+  If Ret<0 Then
+   Errno2InOutRes
+  Else
+   InOutRes:=0;
+End;
+
+
+Procedure Do_Open(var f;p:pchar;flags:longint);
+{
+  FileRec and textrec have both Handle and mode as the first items so
+  they could use the same routine for opening/creating.
+  when (flags and $100)   the file will be append
+  when (flags and $1000)  the file will be truncate/rewritten
+  when (flags and $10000) there is no check for close (needed for textfiles)
+}
+var
+  oflags : cint;
+Begin
+{ close first if opened }
+  if ((flags and $10000)=0) then
+   begin
+     case FileRec(f).mode of
+      fminput,fmoutput,fminout : Do_Close(FileRec(f).Handle);
+      fmclosed : ;
+     else
+      begin
+        inoutres:=102; {not assigned}
+        exit;
+      end;
+     end;
+   end;
+{ reset file Handle }
+  FileRec(f).Handle:=UnusedHandle;
+{ We do the conversion of filemodes here, concentrated on 1 place }
+  case (flags and 3) of
+   0 : begin
+         oflags :=O_RDONLY;
+         FileRec(f).mode:=fminput;
+       end;
+   1 : begin
+         oflags :=O_WRONLY;
+         FileRec(f).mode:=fmoutput;
+       end;
+   2 : begin
+         oflags :=O_RDWR;
+         FileRec(f).mode:=fminout;
+       end;
+  end;
+  if (flags and $1000)=$1000 then
+   oflags:=oflags or (O_CREAT or O_TRUNC)
+  else
+   if (flags and $100)=$100 then
+    oflags:=oflags or (O_APPEND);
+{ empty name is special }
+  if p[0]=#0 then
+   begin
+     case FileRec(f).mode of
+       fminput :
+         FileRec(f).Handle:=StdInputHandle;
+       fminout, { this is set by rewrite }
+       fmoutput :
+         FileRec(f).Handle:=StdOutputHandle;
+       fmappend :
+         begin
+           FileRec(f).Handle:=StdOutputHandle;
+           FileRec(f).mode:=fmoutput; {fool fmappend}
+         end;
+     end;
+     exit;
+   end;
+{ real open call }
+  FileRec(f).Handle:=Fpopen(p,oflags,MODE_OPEN);
+  if (FileRec(f).Handle<0) and
+     (getErrNo=ESysEROFS) and
+     ((OFlags and O_RDWR)<>0) then
+   begin
+     Oflags:=Oflags and not(O_RDWR);
+     FileRec(f).Handle:=Fpopen(p,oflags,MODE_OPEN);
+   end;
+  If Filerec(f).Handle<0 Then
+   Errno2Inoutres
+  else
+   InOutRes:=0;
+End;
+
+{
+  $Log$
+  Revision 1.1  2005-02-06 13:06:20  peter
+    * moved file and dir functions to sysfile/sysdir
+    * win32 thread in systemunit
+
+}

rtl/linux/sysos.inc

@@ -77,11 +77,24 @@ function fpgetcwd(buf:pchar;_size:size_t):pchar; cdecl; external name 'getcwd';
 {$I ossysc.inc}                         // base syscalls
 {$I osmain.inc}                         // base wrappers *nix RTL (derivatives)
 
+const
+     { read/write permission for everyone }
+     MODE_OPEN = S_IWUSR OR S_IRUSR OR
+                 S_IWGRP OR S_IRGRP OR
+                 S_IWOTH OR S_IROTH;
+     { read/write search permission for everyone }
+     MODE_MKDIR = MODE_OPEN OR
+                 S_IXUSR OR S_IXGRP OR S_IXOTH;
+
 
 
 {
    $Log$
-   Revision 1.1  2005-02-06 11:20:52  peter
+   Revision 1.2  2005-02-06 13:06:20  peter
+     * moved file and dir functions to sysfile/sysdir
+     * win32 thread in systemunit
+
+   Revision 1.1  2005/02/06 11:20:52  peter
      * threading in system unit
      * removed systhrds unit
 

rtl/win32/Makefile

@@ -253,103 +253,103 @@ GRAPHDIR=$(INC)/graph
 include $(WININC)/makefile.inc
 WINDOWS_SOURCE_FILES=$(addprefix $(WININC)/,$(addsuffix .inc,$(WINDOWS_FILES)))
 ifeq ($(FULL_TARGET),i386-linux)
-override TARGET_UNITS+=$(SYSTEMUNIT) ctypes systhrds objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconst sysconst sysutils typinfo math types strutils convutils dateutils varutils variants classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard comobj winsysut ole2 activex shellapi shlobj
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconst sysconst sysutils typinfo math types strutils convutils dateutils varutils variants classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard comobj winsysut ole2 activex shellapi shlobj
 endif
 ifeq ($(FULL_TARGET),i386-go32v2)
-override TARGET_UNITS+=$(SYSTEMUNIT) ctypes systhrds objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconst sysconst sysutils typinfo math types strutils convutils dateutils varutils variants classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard comobj winsysut ole2 activex shellapi shlobj
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconst sysconst sysutils typinfo math types strutils convutils dateutils varutils variants classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard comobj winsysut ole2 activex shellapi shlobj
 endif
 ifeq ($(FULL_TARGET),i386-win32)
-override TARGET_UNITS+=$(SYSTEMUNIT) ctypes systhrds objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconst sysconst sysutils typinfo math types strutils convutils dateutils varutils variants classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard comobj winsysut ole2 activex shellapi shlobj
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconst sysconst sysutils typinfo math types strutils convutils dateutils varutils variants classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard comobj winsysut ole2 activex shellapi shlobj
 endif
 ifeq ($(FULL_TARGET),i386-os2)
-override TARGET_UNITS+=$(SYSTEMUNIT) ctypes systhrds objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconst sysconst sysutils typinfo math types strutils convutils dateutils varutils variants classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard comobj winsysut ole2 activex shellapi shlobj
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconst sysconst sysutils typinfo math types strutils convutils dateutils varutils variants classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard comobj winsysut ole2 activex shellapi shlobj
 endif
 ifeq ($(FULL_TARGET),i386-freebsd)
-override TARGET_UNITS+=$(SYSTEMUNIT) ctypes systhrds objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconst sysconst sysutils typinfo math types strutils convutils dateutils varutils variants classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard comobj winsysut ole2 activex shellapi shlobj
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconst sysconst sysutils typinfo math types strutils convutils dateutils varutils variants classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard comobj winsysut ole2 activex shellapi shlobj
 endif
 ifeq ($(FULL_TARGET),i386-beos)
-override TARGET_UNITS+=$(SYSTEMUNIT) ctypes systhrds objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconst sysconst sysutils typinfo math types strutils convutils dateutils varutils variants classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard comobj winsysut ole2 activex shellapi shlobj
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconst sysconst sysutils typinfo math types strutils convutils dateutils varutils variants classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard comobj winsysut ole2 activex shellapi shlobj
 endif
 ifeq ($(FULL_TARGET),i386-netbsd)
-override TARGET_UNITS+=$(SYSTEMUNIT) ctypes systhrds objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconst sysconst sysutils typinfo math types strutils convutils dateutils varutils variants classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard comobj winsysut ole2 activex shellapi shlobj
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconst sysconst sysutils typinfo math types strutils convutils dateutils varutils variants classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard comobj winsysut ole2 activex shellapi shlobj
 endif
 ifeq ($(FULL_TARGET),i386-sunos)
-override TARGET_UNITS+=$(SYSTEMUNIT) ctypes systhrds objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconst sysconst sysutils typinfo math types strutils convutils dateutils varutils variants classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard comobj winsysut ole2 activex shellapi shlobj
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconst sysconst sysutils typinfo math types strutils convutils dateutils varutils variants classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard comobj winsysut ole2 activex shellapi shlobj
 endif
 ifeq ($(FULL_TARGET),i386-qnx)
-override TARGET_UNITS+=$(SYSTEMUNIT) ctypes systhrds objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconst sysconst sysutils typinfo math types strutils convutils dateutils varutils variants classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard comobj winsysut ole2 activex shellapi shlobj
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconst sysconst sysutils typinfo math types strutils convutils dateutils varutils variants classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard comobj winsysut ole2 activex shellapi shlobj
 endif
 ifeq ($(FULL_TARGET),i386-netware)
-override TARGET_UNITS+=$(SYSTEMUNIT) ctypes systhrds objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconst sysconst sysutils typinfo math types strutils convutils dateutils varutils variants classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard comobj winsysut ole2 activex shellapi shlobj
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconst sysconst sysutils typinfo math types strutils convutils dateutils varutils variants classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard comobj winsysut ole2 activex shellapi shlobj
 endif
 ifeq ($(FULL_TARGET),i386-openbsd)
-override TARGET_UNITS+=$(SYSTEMUNIT) ctypes systhrds objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconst sysconst sysutils typinfo math types strutils convutils dateutils varutils variants classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard comobj winsysut ole2 activex shellapi shlobj
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconst sysconst sysutils typinfo math types strutils convutils dateutils varutils variants classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard comobj winsysut ole2 activex shellapi shlobj
 endif
 ifeq ($(FULL_TARGET),i386-wdosx)
-override TARGET_UNITS+=$(SYSTEMUNIT) ctypes systhrds objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconst sysconst sysutils typinfo math types strutils convutils dateutils varutils variants classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard comobj winsysut ole2 activex shellapi shlobj
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconst sysconst sysutils typinfo math types strutils convutils dateutils varutils variants classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard comobj winsysut ole2 activex shellapi shlobj
 endif
 ifeq ($(FULL_TARGET),i386-emx)
-override TARGET_UNITS+=$(SYSTEMUNIT) ctypes systhrds objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconst sysconst sysutils typinfo math types strutils convutils dateutils varutils variants classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard comobj winsysut ole2 activex shellapi shlobj
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconst sysconst sysutils typinfo math types strutils convutils dateutils varutils variants classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard comobj winsysut ole2 activex shellapi shlobj
 endif
 ifeq ($(FULL_TARGET),i386-watcom)
-override TARGET_UNITS+=$(SYSTEMUNIT) ctypes systhrds objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconst sysconst sysutils typinfo math types strutils convutils dateutils varutils variants classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard comobj winsysut ole2 activex shellapi shlobj
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconst sysconst sysutils typinfo math types strutils convutils dateutils varutils variants classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard comobj winsysut ole2 activex shellapi shlobj
 endif
 ifeq ($(FULL_TARGET),i386-netwlibc)
-override TARGET_UNITS+=$(SYSTEMUNIT) ctypes systhrds objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconst sysconst sysutils typinfo math types strutils convutils dateutils varutils variants classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard comobj winsysut ole2 activex shellapi shlobj
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconst sysconst sysutils typinfo math types strutils convutils dateutils varutils variants classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard comobj winsysut ole2 activex shellapi shlobj
 endif
 ifeq ($(FULL_TARGET),m68k-linux)
-override TARGET_UNITS+=$(SYSTEMUNIT) ctypes systhrds objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconst sysconst sysutils typinfo math types strutils convutils dateutils varutils variants classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard comobj winsysut ole2 activex shellapi shlobj
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconst sysconst sysutils typinfo math types strutils convutils dateutils varutils variants classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard comobj winsysut ole2 activex shellapi shlobj
 endif
 ifeq ($(FULL_TARGET),m68k-freebsd)
-override TARGET_UNITS+=$(SYSTEMUNIT) ctypes systhrds objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconst sysconst sysutils typinfo math types strutils convutils dateutils varutils variants classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard comobj winsysut ole2 activex shellapi shlobj
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconst sysconst sysutils typinfo math types strutils convutils dateutils varutils variants classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard comobj winsysut ole2 activex shellapi shlobj
 endif
 ifeq ($(FULL_TARGET),m68k-netbsd)
-override TARGET_UNITS+=$(SYSTEMUNIT) ctypes systhrds objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconst sysconst sysutils typinfo math types strutils convutils dateutils varutils variants classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard comobj winsysut ole2 activex shellapi shlobj
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconst sysconst sysutils typinfo math types strutils convutils dateutils varutils variants classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard comobj winsysut ole2 activex shellapi shlobj
 endif
 ifeq ($(FULL_TARGET),m68k-amiga)
-override TARGET_UNITS+=$(SYSTEMUNIT) ctypes systhrds objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconst sysconst sysutils typinfo math types strutils convutils dateutils varutils variants classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard comobj winsysut ole2 activex shellapi shlobj
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconst sysconst sysutils typinfo math types strutils convutils dateutils varutils variants classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard comobj winsysut ole2 activex shellapi shlobj
 endif
 ifeq ($(FULL_TARGET),m68k-atari)
-override TARGET_UNITS+=$(SYSTEMUNIT) ctypes systhrds objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconst sysconst sysutils typinfo math types strutils convutils dateutils varutils variants classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard comobj winsysut ole2 activex shellapi shlobj
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconst sysconst sysutils typinfo math types strutils convutils dateutils varutils variants classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard comobj winsysut ole2 activex shellapi shlobj
 endif
 ifeq ($(FULL_TARGET),m68k-openbsd)
-override TARGET_UNITS+=$(SYSTEMUNIT) ctypes systhrds objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconst sysconst sysutils typinfo math types strutils convutils dateutils varutils variants classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard comobj winsysut ole2 activex shellapi shlobj
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconst sysconst sysutils typinfo math types strutils convutils dateutils varutils variants classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard comobj winsysut ole2 activex shellapi shlobj
 endif
 ifeq ($(FULL_TARGET),m68k-palmos)
-override TARGET_UNITS+=$(SYSTEMUNIT) ctypes systhrds objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconst sysconst sysutils typinfo math types strutils convutils dateutils varutils variants classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard comobj winsysut ole2 activex shellapi shlobj
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconst sysconst sysutils typinfo math types strutils convutils dateutils varutils variants classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard comobj winsysut ole2 activex shellapi shlobj
 endif
 ifeq ($(FULL_TARGET),powerpc-linux)
-override TARGET_UNITS+=$(SYSTEMUNIT) ctypes systhrds objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconst sysconst sysutils typinfo math types strutils convutils dateutils varutils variants classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard comobj winsysut ole2 activex shellapi shlobj
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconst sysconst sysutils typinfo math types strutils convutils dateutils varutils variants classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard comobj winsysut ole2 activex shellapi shlobj
 endif
 ifeq ($(FULL_TARGET),powerpc-netbsd)
-override TARGET_UNITS+=$(SYSTEMUNIT) ctypes systhrds objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconst sysconst sysutils typinfo math types strutils convutils dateutils varutils variants classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard comobj winsysut ole2 activex shellapi shlobj
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconst sysconst sysutils typinfo math types strutils convutils dateutils varutils variants classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard comobj winsysut ole2 activex shellapi shlobj
 endif
 ifeq ($(FULL_TARGET),powerpc-macos)
-override TARGET_UNITS+=$(SYSTEMUNIT) ctypes systhrds objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconst sysconst sysutils typinfo math types strutils convutils dateutils varutils variants classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard comobj winsysut ole2 activex shellapi shlobj
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconst sysconst sysutils typinfo math types strutils convutils dateutils varutils variants classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard comobj winsysut ole2 activex shellapi shlobj
 endif
 ifeq ($(FULL_TARGET),powerpc-darwin)
-override TARGET_UNITS+=$(SYSTEMUNIT) ctypes systhrds objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconst sysconst sysutils typinfo math types strutils convutils dateutils varutils variants classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard comobj winsysut ole2 activex shellapi shlobj
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconst sysconst sysutils typinfo math types strutils convutils dateutils varutils variants classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard comobj winsysut ole2 activex shellapi shlobj
 endif
 ifeq ($(FULL_TARGET),powerpc-morphos)
-override TARGET_UNITS+=$(SYSTEMUNIT) ctypes systhrds objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconst sysconst sysutils typinfo math types strutils convutils dateutils varutils variants classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard comobj winsysut ole2 activex shellapi shlobj
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconst sysconst sysutils typinfo math types strutils convutils dateutils varutils variants classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard comobj winsysut ole2 activex shellapi shlobj
 endif
 ifeq ($(FULL_TARGET),sparc-linux)
-override TARGET_UNITS+=$(SYSTEMUNIT) ctypes systhrds objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconst sysconst sysutils typinfo math types strutils convutils dateutils varutils variants classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard comobj winsysut ole2 activex shellapi shlobj
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconst sysconst sysutils typinfo math types strutils convutils dateutils varutils variants classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard comobj winsysut ole2 activex shellapi shlobj
 endif
 ifeq ($(FULL_TARGET),sparc-netbsd)
-override TARGET_UNITS+=$(SYSTEMUNIT) ctypes systhrds objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconst sysconst sysutils typinfo math types strutils convutils dateutils varutils variants classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard comobj winsysut ole2 activex shellapi shlobj
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconst sysconst sysutils typinfo math types strutils convutils dateutils varutils variants classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard comobj winsysut ole2 activex shellapi shlobj
 endif
 ifeq ($(FULL_TARGET),sparc-sunos)
-override TARGET_UNITS+=$(SYSTEMUNIT) ctypes systhrds objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconst sysconst sysutils typinfo math types strutils convutils dateutils varutils variants classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard comobj winsysut ole2 activex shellapi shlobj
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconst sysconst sysutils typinfo math types strutils convutils dateutils varutils variants classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard comobj winsysut ole2 activex shellapi shlobj
 endif
 ifeq ($(FULL_TARGET),x86_64-linux)
-override TARGET_UNITS+=$(SYSTEMUNIT) ctypes systhrds objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconst sysconst sysutils typinfo math types strutils convutils dateutils varutils variants classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard comobj winsysut ole2 activex shellapi shlobj
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconst sysconst sysutils typinfo math types strutils convutils dateutils varutils variants classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard comobj winsysut ole2 activex shellapi shlobj
 endif
 ifeq ($(FULL_TARGET),x86_64-freebsd)
-override TARGET_UNITS+=$(SYSTEMUNIT) ctypes systhrds objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconst sysconst sysutils typinfo math types strutils convutils dateutils varutils variants classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard comobj winsysut ole2 activex shellapi shlobj
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconst sysconst sysutils typinfo math types strutils convutils dateutils varutils variants classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard comobj winsysut ole2 activex shellapi shlobj
 endif
 ifeq ($(FULL_TARGET),arm-linux)
-override TARGET_UNITS+=$(SYSTEMUNIT) ctypes systhrds objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconst sysconst sysutils typinfo math types strutils convutils dateutils varutils variants classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard comobj winsysut ole2 activex shellapi shlobj
+override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc matrix windows winsock initc cmem dynlibs signals dos crt objects graph messages rtlconst sysconst sysutils typinfo math types strutils convutils dateutils varutils variants classes cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer video mouse keyboard comobj winsysut ole2 activex shellapi shlobj
 endif
 ifeq ($(FULL_TARGET),i386-linux)
 override TARGET_LOADERS+=wprt0 wdllprt0 gprt0 wcygprt0
@@ -1966,7 +1966,6 @@ wdllprt0$(OEXT) : wdllprt0.as
 wcygprt0$(OEXT) : wcygprt0.as
 $(SYSTEMUNIT)$(PPUEXT) : $(SYSTEMUNIT).pp win32.inc $(SYSDEPS)
 	$(COMPILER) -Us -Sg $(SYSTEMUNIT).pp
-systhrds$(PPUEXT): systhrds.pp $(INC)/threadh.inc $(SYSTEMUNIT)$(PPUEXT) objpas$(PPUEXT)
 objpas$(PPUEXT): $(OBJPASDIR)/objpas.pp $(INC)/except.inc $(SYSTEMUNIT)$(PPUEXT)
 	$(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/objpas.pp
 strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc\

rtl/win32/Makefile.fpc

@@ -7,7 +7,7 @@ main=rtl
 
 [target]
 loaders=wprt0 wdllprt0 gprt0 wcygprt0
-units=$(SYSTEMUNIT) ctypes systhrds objpas macpas strings \
+units=$(SYSTEMUNIT) ctypes objpas macpas strings \
       lineinfo heaptrc matrix \
       windows winsock initc cmem dynlibs signals \
       dos crt objects graph messages \
@@ -107,8 +107,6 @@ wcygprt0$(OEXT) : wcygprt0.as
 $(SYSTEMUNIT)$(PPUEXT) : $(SYSTEMUNIT).pp win32.inc $(SYSDEPS)
         $(COMPILER) -Us -Sg $(SYSTEMUNIT).pp
 
-systhrds$(PPUEXT): systhrds.pp $(INC)/threadh.inc $(SYSTEMUNIT)$(PPUEXT) objpas$(PPUEXT)
-
 objpas$(PPUEXT): $(OBJPASDIR)/objpas.pp $(INC)/except.inc $(SYSTEMUNIT)$(PPUEXT)
         $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/objpas.pp
 

rtl/win32/classes.pp

@@ -16,11 +16,6 @@
 
 {$mode objfpc}
 
-{ Require threading }
-{$ifndef ver1_0}
-  {$threading on}
-{$endif ver1_0}
-
 { determine the type of the resource/form file }
 {$define Win16Res}
 
@@ -48,20 +43,24 @@ uses
 initialization
   CommonInit;
   {$ifndef ver1_0}
-  systhrds.InitCriticalSection(SynchronizeCritSect);
+  InitCriticalSection(SynchronizeCritSect);
   ExecuteEvent := RtlEventCreate;
   SynchronizeMethod := nil;
   {$endif}
 finalization
   CommonCleanup;
   {$ifndef ver1_0}
-    systhrds.DoneCriticalSection(SynchronizeCritSect);
+    DoneCriticalSection(SynchronizeCritSect);
   RtlEventDestroy(ExecuteEvent);
   {$endif}
 end.
 {
   $Log$
-  Revision 1.6  2004-12-23 09:42:42  marco
+  Revision 1.7  2005-02-06 13:06:20  peter
+    * moved file and dir functions to sysfile/sysdir
+    * win32 thread in systemunit
+
+  Revision 1.6  2004/12/23 09:42:42  marco
    * first tthread.synchronize support (merged neli's patches)
 
   Revision 1.5  2004/01/22 17:11:23  peter

rtl/win32/sysdir.inc

@@ -0,0 +1,104 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2000 by Florian Klaempfl and Pavel Ozerski
+    member of the Free Pascal development team.
+
+    FPC Pascal system unit for the Win32 API.
+
+    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.
+
+ **********************************************************************}
+
+{*****************************************************************************
+                           Directory Handling
+*****************************************************************************}
+
+type
+ TDirFnType=function(name:pointer):longbool;stdcall;
+
+procedure dirfn(afunc : TDirFnType;const s:string);
+var
+  buffer : array[0..255] of char;
+begin
+  move(s[1],buffer,length(s));
+  buffer[length(s)]:=#0;
+  AllowSlash(pchar(@buffer));
+  if not aFunc(@buffer) then
+    begin
+      errno:=GetLastError;
+      Errno2InoutRes;
+    end;
+end;
+
+function CreateDirectoryTrunc(name:pointer):longbool;stdcall;
+begin
+  CreateDirectoryTrunc:=CreateDirectory(name,nil);
+end;
+
+procedure mkdir(const s:string);[IOCHECK];
+begin
+  If (s='') or (InOutRes <> 0) then
+   exit;
+  dirfn(TDirFnType(@CreateDirectoryTrunc),s);
+end;
+
+procedure rmdir(const s:string);[IOCHECK];
+begin
+  if (s ='.') then
+    InOutRes := 16;
+  If (s='') or (InOutRes <> 0) then
+   exit;
+  dirfn(TDirFnType(@RemoveDirectory),s);
+end;
+
+procedure chdir(const s:string);[IOCHECK];
+begin
+  If (s='') or (InOutRes <> 0) then
+   exit;
+  dirfn(TDirFnType(@SetCurrentDirectory),s);
+  if Inoutres=2 then
+   Inoutres:=3;
+end;
+
+procedure GetDir (DriveNr: byte; var Dir: ShortString);
+const
+  Drive:array[0..3]of char=(#0,':',#0,#0);
+var
+  defaultdrive:boolean;
+  DirBuf,SaveBuf:array[0..259] of Char;
+begin
+  defaultdrive:=drivenr=0;
+  if not defaultdrive then
+   begin
+    byte(Drive[0]):=Drivenr+64;
+    GetCurrentDirectory(SizeOf(SaveBuf),SaveBuf);
+    if not SetCurrentDirectory(@Drive) then
+     begin
+      errno := word (GetLastError);
+      Errno2InoutRes;
+      Dir := char (DriveNr + 64) + ':\';
+      SetCurrentDirectory(@SaveBuf);
+      Exit;
+     end;
+   end;
+  GetCurrentDirectory(SizeOf(DirBuf),DirBuf);
+  if not defaultdrive then
+   SetCurrentDirectory(@SaveBuf);
+  dir:=strpas(DirBuf);
+  if not FileNameCaseSensitive then
+   dir:=upcase(dir);
+end;
+
+{
+  $Log$
+  Revision 1.1  2005-02-06 13:06:20  peter
+    * moved file and dir functions to sysfile/sysdir
+    * win32 thread in systemunit
+
+}

rtl/win32/sysfile.inc

@@ -0,0 +1,272 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2001 by Free Pascal development team
+
+    Low leve file functions
+
+    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.
+
+ **********************************************************************}
+
+
+{*****************************************************************************
+                          Low Level File Routines
+*****************************************************************************}
+
+procedure AllowSlash(p:pchar);
+var
+   i : longint;
+begin
+{ allow slash as backslash }
+   for i:=0 to strlen(p) do
+     if p[i]='/' then p[i]:='\';
+end;
+
+function do_isdevice(handle:thandle):boolean;
+begin
+  do_isdevice:=(getfiletype(handle)=2);
+end;
+
+
+procedure do_close(h : thandle);
+begin
+  if do_isdevice(h) then
+   exit;
+  CloseHandle(h);
+end;
+
+
+procedure do_erase(p : pchar);
+begin
+   AllowSlash(p);
+   if DeleteFile(p)=0 then
+    Begin
+      errno:=GetLastError;
+      if errno=5 then
+       begin
+         if (GetFileAttributes(p)=FILE_ATTRIBUTE_DIRECTORY) then
+          errno:=2;
+       end;
+      Errno2InoutRes;
+    end;
+end;
+
+
+procedure do_rename(p1,p2 : pchar);
+begin
+  AllowSlash(p1);
+  AllowSlash(p2);
+  if MoveFile(p1,p2)=0 then
+   Begin
+      errno:=GetLastError;
+      Errno2InoutRes;
+   end;
+end;
+
+
+function do_write(h:thandle;addr:pointer;len : longint) : longint;
+var
+   size:longint;
+begin
+   if writefile(h,addr,len,size,nil)=0 then
+    Begin
+      errno:=GetLastError;
+      Errno2InoutRes;
+    end;
+   do_write:=size;
+end;
+
+
+function do_read(h:thandle;addr:pointer;len : longint) : longint;
+var
+  _result:longint;
+begin
+  if readfile(h,addr,len,_result,nil)=0 then
+    Begin
+      errno:=GetLastError;
+      if errno=ERROR_BROKEN_PIPE then
+        errno:=0
+      else
+        Errno2InoutRes;
+    end;
+  do_read:=_result;
+end;
+
+
+function do_filepos(handle : thandle) : longint;
+var
+  l:longint;
+begin
+  l:=SetFilePointer(handle,0,nil,FILE_CURRENT);
+  if l=-1 then
+   begin
+    l:=0;
+    errno:=GetLastError;
+    Errno2InoutRes;
+   end;
+  do_filepos:=l;
+end;
+
+
+procedure do_seek(handle:thandle;pos : longint);
+begin
+  if SetFilePointer(handle,pos,nil,FILE_BEGIN)=-1 then
+   Begin
+    errno:=GetLastError;
+    Errno2InoutRes;
+   end;
+end;
+
+
+function do_seekend(handle:thandle):longint;
+begin
+  do_seekend:=SetFilePointer(handle,0,nil,FILE_END);
+  if do_seekend=-1 then
+    begin
+      errno:=GetLastError;
+      Errno2InoutRes;
+    end;
+end;
+
+
+function do_filesize(handle : thandle) : longint;
+var
+  aktfilepos : longint;
+begin
+  aktfilepos:=do_filepos(handle);
+  do_filesize:=do_seekend(handle);
+  do_seek(handle,aktfilepos);
+end;
+
+
+procedure do_truncate (handle:thandle;pos:longint);
+begin
+   do_seek(handle,pos);
+   if not(SetEndOfFile(handle)) then
+    begin
+      errno:=GetLastError;
+      Errno2InoutRes;
+    end;
+end;
+
+
+procedure do_open(var f;p:pchar;flags:longint);
+{
+  filerec and textrec have both handle and mode as the first items so
+  they could use the same routine for opening/creating.
+  when (flags and $100)   the file will be append
+  when (flags and $1000)  the file will be truncate/rewritten
+  when (flags and $10000) there is no check for close (needed for textfiles)
+}
+Const
+  file_Share_Read  = $00000001;
+  file_Share_Write = $00000002;
+Var
+  shflags,
+  oflags,cd : longint;
+  security : TSecurityAttributes;
+begin
+  AllowSlash(p);
+{ close first if opened }
+  if ((flags and $10000)=0) then
+   begin
+     case filerec(f).mode of
+       fminput,fmoutput,fminout : Do_Close(filerec(f).handle);
+       fmclosed : ;
+     else
+      begin
+        {not assigned}
+        inoutres:=102;
+        exit;
+      end;
+     end;
+   end;
+{ reset file handle }
+  filerec(f).handle:=UnusedHandle;
+{ convert filesharing }
+  shflags:=0;
+  if ((filemode and fmshareExclusive) = fmshareExclusive) then
+    { no sharing }
+  else
+    if (filemode = fmShareCompat) or ((filemode and fmshareDenyWrite) = fmshareDenyWrite) then
+      shflags := file_Share_Read
+  else
+    if ((filemode and fmshareDenyRead) = fmshareDenyRead) then
+      shflags := file_Share_Write
+  else
+    if ((filemode and fmshareDenyNone) = fmshareDenyNone) then
+      shflags := file_Share_Read + file_Share_Write;
+{ convert filemode to filerec modes }
+  case (flags and 3) of
+   0 : begin
+         filerec(f).mode:=fminput;
+         oflags:=longint(GENERIC_READ);
+       end;
+   1 : begin
+         filerec(f).mode:=fmoutput;
+         oflags:=longint(GENERIC_WRITE);
+       end;
+   2 : begin
+         filerec(f).mode:=fminout;
+         oflags:=longint(GENERIC_WRITE or GENERIC_READ);
+       end;
+  end;
+{ create it ? }
+  if (flags and $1000)<>0 then
+   cd:=CREATE_ALWAYS
+{ or Append/Open ? }
+  else
+    cd:=OPEN_EXISTING;
+{ empty name is special }
+  if p[0]=#0 then
+   begin
+     case FileRec(f).mode of
+       fminput :
+         FileRec(f).Handle:=StdInputHandle;
+       fminout, { this is set by rewrite }
+       fmoutput :
+         FileRec(f).Handle:=StdOutputHandle;
+       fmappend :
+         begin
+           FileRec(f).Handle:=StdOutputHandle;
+           FileRec(f).mode:=fmoutput; {fool fmappend}
+         end;
+     end;
+     exit;
+   end;
+  security.nLength := Sizeof(TSecurityAttributes);
+  security.bInheritHandle:=true;
+  security.lpSecurityDescriptor:=nil;
+  filerec(f).handle:=CreateFile(p,oflags,shflags,@security,cd,FILE_ATTRIBUTE_NORMAL,0);
+{ append mode }
+  if ((flags and $100)<>0) and
+     (filerec(f).handle<>0) and
+     (filerec(f).handle<>UnusedHandle) then
+   begin
+     do_seekend(filerec(f).handle);
+     filerec(f).mode:=fmoutput; {fool fmappend}
+   end;
+{ get errors }
+  { handle -1 is returned sometimes !! (PM) }
+  if (filerec(f).handle=0) or (filerec(f).handle=UnusedHandle) then
+    begin
+      errno:=GetLastError;
+      Errno2InoutRes;
+    end;
+end;
+
+
+{
+   $Log$
+   Revision 1.1  2005-02-06 13:06:20  peter
+     * moved file and dir functions to sysfile/sysdir
+     * win32 thread in systemunit
+
+}
+

rtl/win32/sysheap.inc

@@ -0,0 +1,63 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2001 by Free Pascal development team
+
+    This file implements all the base types and limits required
+    for a minimal POSIX compliant subset required to port the compiler
+    to a new OS.
+
+    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.
+
+ **********************************************************************}
+
+
+{*****************************************************************************
+      OS Memory allocation / deallocation
+ ****************************************************************************}
+
+   { memory functions }
+   function GetProcessHeap : DWord;
+     stdcall;external 'kernel32' name 'GetProcessHeap';
+   function HeapAlloc(hHeap : DWord; dwFlags : DWord; dwBytes : DWord) : Longint;
+     stdcall;external 'kernel32' name 'HeapAlloc';
+   function HeapFree(hHeap : dword; dwFlags : dword; lpMem: pointer) : boolean;
+     stdcall;external 'kernel32' name 'HeapFree';
+{$IFDEF SYSTEMDEBUG}
+   function WinAPIHeapSize(hHeap : DWord; dwFlags : DWord; ptr : Pointer) : DWord;
+     stdcall;external 'kernel32' name 'HeapSize';
+{$ENDIF}
+
+
+function SysOSAlloc(size: ptrint): pointer;
+var
+  l : longword;
+begin
+  l := HeapAlloc(GetProcessHeap, 0, size);
+{$ifdef DUMPGROW}
+  Writeln('new heap part at $',hexstr(l,8), ' size = ',WinAPIHeapSize(GetProcessHeap()));
+{$endif}
+  SysOSAlloc := pointer(l);
+end;
+
+{$define HAS_SYSOSFREE}
+
+procedure SysOSFree(p: pointer; size: ptrint);
+begin
+  HeapFree(GetProcessHeap, 0, p);
+end;
+
+
+{
+   $Log$
+   Revision 1.1  2005-02-06 13:06:20  peter
+     * moved file and dir functions to sysfile/sysdir
+     * win32 thread in systemunit
+
+}
+

rtl/win32/sysos.inc

@@ -0,0 +1,289 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2001 by Free Pascal development team
+
+    This file implements all the base types and limits required
+    for a minimal POSIX compliant subset required to port the compiler
+    to a new OS.
+
+    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.
+
+ **********************************************************************}
+
+const
+   { constants for GetStdHandle }
+   STD_INPUT_HANDLE = longint($fffffff6);
+   STD_OUTPUT_HANDLE = longint($fffffff5);
+   STD_ERROR_HANDLE = longint($fffffff4);
+   INVALID_HANDLE_VALUE = longint($ffffffff);
+
+   IGNORE = 0;               { Ignore signal }
+   INFINITE = longint($FFFFFFFF);     { Infinite timeout }
+
+   { flags for CreateFile }
+   GENERIC_READ=$80000000;
+   GENERIC_WRITE=$40000000;
+   CREATE_NEW = 1;
+   CREATE_ALWAYS = 2;
+   OPEN_EXISTING = 3;
+   OPEN_ALWAYS = 4;
+   TRUNCATE_EXISTING = 5;
+
+   FILE_ATTRIBUTE_ARCHIVE = 32;
+   FILE_ATTRIBUTE_COMPRESSED = 2048;
+   FILE_ATTRIBUTE_NORMAL = 128;
+   FILE_ATTRIBUTE_DIRECTORY = 16;
+   FILE_ATTRIBUTE_HIDDEN = 2;
+   FILE_ATTRIBUTE_READONLY = 1;
+   FILE_ATTRIBUTE_SYSTEM = 4;
+   FILE_ATTRIBUTE_TEMPORARY = 256;
+
+   { Share mode open }
+   fmShareCompat    = $00000000;
+   fmShareExclusive = $10;
+   fmShareDenyWrite = $20;
+   fmShareDenyRead  = $30;
+   fmShareDenyNone  = $40;
+
+   { flags for SetFilePos }
+   FILE_BEGIN = 0;
+   FILE_CURRENT = 1;
+   FILE_END = 2;
+
+   { GetFileType  }
+   FILE_TYPE_UNKNOWN = 0;
+   FILE_TYPE_DISK = 1;
+   FILE_TYPE_CHAR = 2;
+   FILE_TYPE_PIPE = 3;
+
+   VER_PLATFORM_WIN32s = 0;
+   VER_PLATFORM_WIN32_WINDOWS = 1;
+   VER_PLATFORM_WIN32_NT = 2;
+   
+  { These constants are used for conversion of error codes }
+  { from win32 i/o errors to tp i/o errors                 }
+  { errors 1 to 18 are the same as in Turbo Pascal         }
+  { DO NOT MODIFY UNLESS YOU KNOW EXACTLY WHAT YOU ARE DOING! }
+
+{  The media is write protected.                   }
+    ERROR_WRITE_PROTECT       =      19;
+{  The system cannot find the device specified.    }
+    ERROR_BAD_UNIT            =      20;
+{  The device is not ready.                        }
+    ERROR_NOT_READY           =      21;
+{  The device does not recognize the command.      }
+    ERROR_BAD_COMMAND         =      22;
+{  Data error (cyclic redundancy check)            }
+    ERROR_CRC                 =      23;
+{  The program issued a command but the            }
+{  command length is incorrect.                    }
+    ERROR_BAD_LENGTH           =     24;
+{  The drive cannot locate a specific              }
+{  area or track on the disk.                      }
+    ERROR_SEEK                 =     25;
+{  The specified disk or diskette cannot be accessed. }
+    ERROR_NOT_DOS_DISK         =     26;
+{  The drive cannot find the sector requested.     }
+    ERROR_SECTOR_NOT_FOUND      =    27;
+{  The printer is out of paper.                    }
+    ERROR_OUT_OF_PAPER          =    28;
+{  The system cannot write to the specified device. }
+    ERROR_WRITE_FAULT           =    29;
+{  The system cannot read from the specified device. }
+    ERROR_READ_FAULT            =    30;
+{  A device attached to the system is not functioning.}
+    ERROR_GEN_FAILURE           =    31;
+{  The process cannot access the file because         }
+{  it is being used by another process.               }
+    ERROR_SHARING_VIOLATION      =   32;
+{   A pipe has been closed on the other end }
+{   Removing that error allows eof to works as on other OSes }
+    ERROR_BROKEN_PIPE = 109;
+    ERROR_DIR_NOT_EMPTY = 145;
+    ERROR_ALREADY_EXISTS = 183;
+
+type
+   {UINT  = longint;
+   BOOL  = longint; obsolete }
+   UINT  = cardinal;
+   BOOL  = longbool;
+//   WCHAR = word;
+{$ifdef UNICODE}
+   LPTCH   = ^word;
+   LPTSTR  = ^word;
+   LPCTSTR = ^word;
+{$else UNICODE}
+   LPTCH   = ^char;
+   LPTSTR  = ^char;
+   LPCTSTR = ^char;
+{$endif UNICODE}
+   LPWSTR  = ^wchar;
+   PVOID   = pointer;
+   LPVOID  = pointer;
+   LPCVOID = pointer;
+   LPDWORD = ^DWORD;
+   HLocal  = THandle;
+   PStr    = pchar;
+   LPStr   = pchar;
+   PLPSTR  = ^LPSTR;
+   PLPWSTR = ^LPWSTR;
+
+  PSecurityAttributes = ^TSecurityAttributes;
+  TSecurityAttributes = packed record
+    nLength : DWORD;
+    lpSecurityDescriptor : Pointer;
+    bInheritHandle : BOOL;
+  end;
+
+  PProcessInformation = ^TProcessInformation;
+  TProcessInformation = record
+    hProcess: THandle;
+    hThread: THandle;
+    dwProcessId: DWORD;
+    dwThreadId: DWORD;
+  end;
+
+  PFileTime = ^TFileTime;
+  TFileTime = record
+    dwLowDateTime,
+    dwHighDateTime : DWORD;
+  end;
+
+  LPSystemTime= ^PSystemTime;
+  PSystemTime = ^TSystemTime;
+  TSystemTime = record
+    wYear,
+    wMonth,
+    wDayOfWeek,
+    wDay,
+    wHour,
+    wMinute,
+    wSecond,
+    wMilliseconds: Word;
+  end;
+
+{$IFDEF SUPPORT_THREADVAR}
+threadvar
+{$ELSE SUPPORT_THREADVAR}
+var
+{$ENDIF SUPPORT_THREADVAR}
+    errno : longint;
+
+{$ASMMODE ATT}
+
+
+   { misc. functions }
+   function GetLastError : DWORD;
+     stdcall;external 'kernel32' name 'GetLastError';
+
+   { time and date functions }
+   function GetTickCount : longint;
+     stdcall;external 'kernel32' name 'GetTickCount';
+
+   { process functions }
+   procedure ExitProcess(uExitCode : UINT);
+     stdcall;external 'kernel32' name 'ExitProcess';
+
+   { Startup }
+   procedure GetStartupInfo(p : pointer);
+     stdcall;external 'kernel32' name 'GetStartupInfoA';
+   function GetStdHandle(nStdHandle:DWORD):THANDLE;
+     stdcall;external 'kernel32' name 'GetStdHandle';
+
+   { command line/enviroment functions }
+   function GetCommandLine : pchar;
+     stdcall;external 'kernel32' name 'GetCommandLineA';
+
+  function GetCurrentProcessId:DWORD;
+    stdcall; external 'kernel32' name 'GetCurrentProcessId';
+ 
+  function Win32GetCurrentThreadId:DWORD;
+    stdcall; external 'kernel32' name 'GetCurrentThreadId';
+
+   { module functions }
+   function GetModuleFileName(l1:longint;p:pointer;l2:longint):longint;
+     stdcall;external 'kernel32' name 'GetModuleFileNameA';
+   function GetModuleHandle(p : pointer) : longint;
+     stdcall;external 'kernel32' name 'GetModuleHandleA';
+   function GetCommandFile:pchar;forward;
+
+   { file functions }
+   function WriteFile(fh:thandle;buf:pointer;len:longint;var loaded:longint;
+     overlap:pointer):longint;
+     stdcall;external 'kernel32' name 'WriteFile';
+   function ReadFile(fh:thandle;buf:pointer;len:longint;var loaded:longint;
+     overlap:pointer):longint;
+     stdcall;external 'kernel32' name 'ReadFile';
+   function CloseHandle(h : thandle) : longint;
+     stdcall;external 'kernel32' name 'CloseHandle';
+   function DeleteFile(p : pchar) : longint;
+     stdcall;external 'kernel32' name 'DeleteFileA';
+   function MoveFile(old,_new : pchar) : longint;
+     stdcall;external 'kernel32' name 'MoveFileA';
+   function SetFilePointer(l1,l2 : thandle;l3 : pointer;l4 : longint) : longint;
+     stdcall;external 'kernel32' name 'SetFilePointer';
+   function GetFileSize(h:thandle;p:pointer) : longint;
+     stdcall;external 'kernel32' name 'GetFileSize';
+   function CreateFile(lpFileName:pchar; dwDesiredAccess:DWORD; dwShareMode:DWORD;
+                       lpSecurityAttributes:PSECURITYATTRIBUTES; dwCreationDisposition:DWORD;
+                       dwFlagsAndAttributes:DWORD; hTemplateFile:DWORD):longint;
+     stdcall;external 'kernel32' name 'CreateFileA';
+   function SetEndOfFile(h : thandle) : longbool;
+     stdcall;external 'kernel32' name 'SetEndOfFile';
+   function GetFileType(Handle:thandle):DWord;
+     stdcall;external 'kernel32' name 'GetFileType';
+   function GetFileAttributes(p : pchar) : dword;
+     stdcall;external 'kernel32' name 'GetFileAttributesA';
+
+   { Directory }
+   function CreateDirectory(name : pointer;sec : pointer) : longbool;
+     stdcall;external 'kernel32' name 'CreateDirectoryA';
+   function RemoveDirectory(name:pointer):longbool;
+     stdcall;external 'kernel32' name 'RemoveDirectoryA';
+   function SetCurrentDirectory(name : pointer) : longbool;
+     stdcall;external 'kernel32' name 'SetCurrentDirectoryA';
+   function GetCurrentDirectory(bufsize : longint;name : pchar) : longbool;
+     stdcall;external 'kernel32' name 'GetCurrentDirectoryA';
+
+
+
+   Procedure Errno2InOutRes;
+   Begin
+     { DO NOT MODIFY UNLESS YOU KNOW EXACTLY WHAT YOU ARE DOING }
+     case Errno of
+       ERROR_WRITE_PROTECT..ERROR_GEN_FAILURE :
+         begin
+           { This is the offset to the Win32 to add to directly map  }
+           { to the DOS/TP compatible error codes when in this range }
+           InOutRes := word(errno)+131;
+         end;
+       ERROR_DIR_NOT_EMPTY,
+       ERROR_ALREADY_EXISTS,
+       ERROR_SHARING_VIOLATION :
+         begin
+           InOutRes :=5;
+         end;
+       else
+         begin
+           { other error codes can directly be mapped }
+           InOutRes := Word(errno);
+         end;
+     end;
+     errno:=0;
+   end;
+
+
+{
+   $Log$
+   Revision 1.1  2005-02-06 13:06:20  peter
+     * moved file and dir functions to sysfile/sysdir
+     * win32 thread in systemunit
+
+}
+

rtl/win32/sysosh.inc

@@ -0,0 +1,47 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2001 by Free Pascal development team
+
+    This file implements all the base types and limits required
+    for a minimal POSIX compliant subset required to port the compiler
+    to a new OS.
+
+    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.
+
+ **********************************************************************}
+
+{Platform specific information}
+type
+{$ifdef CPU64}
+  THandle = QWord;
+{$else CPU64}
+  THandle = DWord;
+{$endif CPU64}
+  
+    { the fields of this record are os dependent  }
+    { and they shouldn't be used in a program     }
+    { only the type TCriticalSection is important }
+    PRTLCriticalSection = ^TRTLCriticalSection;
+    TRTLCriticalSection = packed record
+      DebugInfo : pointer;
+      LockCount : longint;
+      RecursionCount : longint;
+      OwningThread : DWord;
+      LockSemaphore : DWord;
+      Reserved : DWord;
+    end;
+
+{
+   $Log$
+   Revision 1.1  2005-02-06 13:06:20  peter
+     * moved file and dir functions to sysfile/sysdir
+     * win32 thread in systemunit
+
+}
+

rtl/win32/system.pp

@@ -28,17 +28,12 @@ interface
   {$define Set_i386_Exception_handler}
 {$endif cpui386}
 
+{ Ctrl-Z means EOF }
+{$DEFINE EOF_CTRLZ}
+
 { include system-independent routine headers }
 {$I systemh.inc}
 
-{Platform specific information}
-type
-{$ifdef CPU64}
-  THandle = QWord;
-{$else CPU64}
-  THandle = DWord;
-{$endif CPU64}
-
 const
  LineEnding = #13#10;
  LFNSupport = true;
@@ -55,9 +50,6 @@ type
      handler : pointer;
    end;
 
-{ include heap support headers }
-{$I heaph.inc}
-
 const
 { Default filehandles }
   UnusedHandle    : THandle = -1;
@@ -127,578 +119,10 @@ implementation
 { include system independent routines }
 {$I system.inc}
 
-{ some declarations for Win32 API calls }
-{$I win32.inc}
-
-
-CONST
-  { These constants are used for conversion of error codes }
-  { from win32 i/o errors to tp i/o errors                 }
-  { errors 1 to 18 are the same as in Turbo Pascal         }
-  { DO NOT MODIFY UNLESS YOU KNOW EXACTLY WHAT YOU ARE DOING! }
-
-{  The media is write protected.                   }
-    ERROR_WRITE_PROTECT       =      19;
-{  The system cannot find the device specified.    }
-    ERROR_BAD_UNIT            =      20;
-{  The device is not ready.                        }
-    ERROR_NOT_READY           =      21;
-{  The device does not recognize the command.      }
-    ERROR_BAD_COMMAND         =      22;
-{  Data error (cyclic redundancy check)            }
-    ERROR_CRC                 =      23;
-{  The program issued a command but the            }
-{  command length is incorrect.                    }
-    ERROR_BAD_LENGTH           =     24;
-{  The drive cannot locate a specific              }
-{  area or track on the disk.                      }
-    ERROR_SEEK                 =     25;
-{  The specified disk or diskette cannot be accessed. }
-    ERROR_NOT_DOS_DISK         =     26;
-{  The drive cannot find the sector requested.     }
-    ERROR_SECTOR_NOT_FOUND      =    27;
-{  The printer is out of paper.                    }
-    ERROR_OUT_OF_PAPER          =    28;
-{  The system cannot write to the specified device. }
-    ERROR_WRITE_FAULT           =    29;
-{  The system cannot read from the specified device. }
-    ERROR_READ_FAULT            =    30;
-{  A device attached to the system is not functioning.}
-    ERROR_GEN_FAILURE           =    31;
-{  The process cannot access the file because         }
-{  it is being used by another process.               }
-    ERROR_SHARING_VIOLATION      =   32;
-{   A pipe has been closed on the other end }
-{   Removing that error allows eof to works as on other OSes }
-    ERROR_BROKEN_PIPE = 109;
-    ERROR_DIR_NOT_EMPTY = 145;
-    ERROR_ALREADY_EXISTS = 183;
-
-{$IFDEF SUPPORT_THREADVAR}
-threadvar
-{$ELSE SUPPORT_THREADVAR}
-var
-{$ENDIF SUPPORT_THREADVAR}
-    errno : longint;
-
-{$ASMMODE ATT}
-
-
-   { misc. functions }
-   function GetLastError : DWORD;
-     stdcall;external 'kernel32' name 'GetLastError';
-
-   { time and date functions }
-   function GetTickCount : longint;
-     stdcall;external 'kernel32' name 'GetTickCount';
-
-   { process functions }
-   procedure ExitProcess(uExitCode : UINT);
-     stdcall;external 'kernel32' name 'ExitProcess';
-
-
-   Procedure Errno2InOutRes;
-   Begin
-     { DO NOT MODIFY UNLESS YOU KNOW EXACTLY WHAT YOU ARE DOING }
-     case Errno of
-       ERROR_WRITE_PROTECT..ERROR_GEN_FAILURE :
-         begin
-           { This is the offset to the Win32 to add to directly map  }
-           { to the DOS/TP compatible error codes when in this range }
-           InOutRes := word(errno)+131;
-         end;
-       ERROR_DIR_NOT_EMPTY,
-       ERROR_ALREADY_EXISTS,
-       ERROR_SHARING_VIOLATION :
-         begin
-           InOutRes :=5;
-         end;
-       else
-         begin
-           { other error codes can directly be mapped }
-           InOutRes := Word(errno);
-         end;
-     end;
-     errno:=0;
-   end;
-
-
-function paramcount : longint;
-begin
-  paramcount := argc - 1;
-end;
-
-   { module functions }
-   function GetModuleFileName(l1:longint;p:pointer;l2:longint):longint;
-     stdcall;external 'kernel32' name 'GetModuleFileNameA';
-   function GetModuleHandle(p : pointer) : longint;
-     stdcall;external 'kernel32' name 'GetModuleHandleA';
-   function GetCommandFile:pchar;forward;
-
-function paramstr(l : longint) : string;
-begin
-  if (l>=0) and (l<argc) then
-    paramstr:=strpas(argv[l])
-  else
-    paramstr:='';
-end;
-
-
-procedure randomize;
-begin
-  randseed:=GetTickCount;
-end;
-
-
-{*****************************************************************************
-                              Heap Management
-*****************************************************************************}
-   { memory functions }
-   function GetProcessHeap : DWord;
-     stdcall;external 'kernel32' name 'GetProcessHeap';
-   function HeapAlloc(hHeap : DWord; dwFlags : DWord; dwBytes : DWord) : Longint;
-     stdcall;external 'kernel32' name 'HeapAlloc';
-   function HeapFree(hHeap : dword; dwFlags : dword; lpMem: pointer) : boolean;
-     stdcall;external 'kernel32' name 'HeapFree';
-{$IFDEF SYSTEMDEBUG}
-   function WinAPIHeapSize(hHeap : DWord; dwFlags : DWord; ptr : Pointer) : DWord;
-     stdcall;external 'kernel32' name 'HeapSize';
-{$ENDIF}
-
-
-{*****************************************************************************
-      OS Memory allocation / deallocation
- ****************************************************************************}
-
-function SysOSAlloc(size: ptrint): pointer;
-var
-  l : longword;
-begin
-  l := HeapAlloc(GetProcessHeap, 0, size);
-{$ifdef DUMPGROW}
-  Writeln('new heap part at $',hexstr(l,8), ' size = ',WinAPIHeapSize(GetProcessHeap()));
-{$endif}
-  SysOSAlloc := pointer(l);
-end;
-
-{$define HAS_SYSOSFREE}
-
-procedure SysOSFree(p: pointer; size: ptrint);
-begin
-  HeapFree(GetProcessHeap, 0, p);
-end;
-
-
-{ include standard heap management }
-{$I heap.inc}
-
-
-{*****************************************************************************
-                          Low Level File Routines
-*****************************************************************************}
-
-   function WriteFile(fh:thandle;buf:pointer;len:longint;var loaded:longint;
-     overlap:pointer):longint;
-     stdcall;external 'kernel32' name 'WriteFile';
-   function ReadFile(fh:thandle;buf:pointer;len:longint;var loaded:longint;
-     overlap:pointer):longint;
-     stdcall;external 'kernel32' name 'ReadFile';
-   function CloseHandle(h : thandle) : longint;
-     stdcall;external 'kernel32' name 'CloseHandle';
-   function DeleteFile(p : pchar) : longint;
-     stdcall;external 'kernel32' name 'DeleteFileA';
-   function MoveFile(old,_new : pchar) : longint;
-     stdcall;external 'kernel32' name 'MoveFileA';
-   function SetFilePointer(l1,l2 : thandle;l3 : pointer;l4 : longint) : longint;
-     stdcall;external 'kernel32' name 'SetFilePointer';
-   function GetFileSize(h:thandle;p:pointer) : longint;
-     stdcall;external 'kernel32' name 'GetFileSize';
-   function CreateFile(lpFileName:pchar; dwDesiredAccess:DWORD; dwShareMode:DWORD;
-                       lpSecurityAttributes:PSECURITYATTRIBUTES; dwCreationDisposition:DWORD;
-                       dwFlagsAndAttributes:DWORD; hTemplateFile:DWORD):longint;
-     stdcall;external 'kernel32' name 'CreateFileA';
-   function SetEndOfFile(h : thandle) : longbool;
-     stdcall;external 'kernel32' name 'SetEndOfFile';
-   function GetFileType(Handle:thandle):DWord;
-     stdcall;external 'kernel32' name 'GetFileType';
-   function GetFileAttributes(p : pchar) : dword;
-     stdcall;external 'kernel32' name 'GetFileAttributesA';
-
-procedure AllowSlash(p:pchar);
-var
-   i : longint;
-begin
-{ allow slash as backslash }
-   for i:=0 to strlen(p) do
-     if p[i]='/' then p[i]:='\';
-end;
-
-function do_isdevice(handle:thandle):boolean;
-begin
-  do_isdevice:=(getfiletype(handle)=2);
-end;
-
-
-procedure do_close(h : thandle);
-begin
-  if do_isdevice(h) then
-   exit;
-  CloseHandle(h);
-end;
-
-
-procedure do_erase(p : pchar);
-begin
-   AllowSlash(p);
-   if DeleteFile(p)=0 then
-    Begin
-      errno:=GetLastError;
-      if errno=5 then
-       begin
-         if (GetFileAttributes(p)=FILE_ATTRIBUTE_DIRECTORY) then
-          errno:=2;
-       end;
-      Errno2InoutRes;
-    end;
-end;
-
-
-procedure do_rename(p1,p2 : pchar);
-begin
-  AllowSlash(p1);
-  AllowSlash(p2);
-  if MoveFile(p1,p2)=0 then
-   Begin
-      errno:=GetLastError;
-      Errno2InoutRes;
-   end;
-end;
-
-
-function do_write(h:thandle;addr:pointer;len : longint) : longint;
-var
-   size:longint;
-begin
-   if writefile(h,addr,len,size,nil)=0 then
-    Begin
-      errno:=GetLastError;
-      Errno2InoutRes;
-    end;
-   do_write:=size;
-end;
-
-
-function do_read(h:thandle;addr:pointer;len : longint) : longint;
-var
-  _result:longint;
-begin
-  if readfile(h,addr,len,_result,nil)=0 then
-    Begin
-      errno:=GetLastError;
-      if errno=ERROR_BROKEN_PIPE then
-        errno:=0
-      else
-        Errno2InoutRes;
-    end;
-  do_read:=_result;
-end;
-
-
-function do_filepos(handle : thandle) : longint;
-var
-  l:longint;
-begin
-  l:=SetFilePointer(handle,0,nil,FILE_CURRENT);
-  if l=-1 then
-   begin
-    l:=0;
-    errno:=GetLastError;
-    Errno2InoutRes;
-   end;
-  do_filepos:=l;
-end;
-
-
-procedure do_seek(handle:thandle;pos : longint);
-begin
-  if SetFilePointer(handle,pos,nil,FILE_BEGIN)=-1 then
-   Begin
-    errno:=GetLastError;
-    Errno2InoutRes;
-   end;
-end;
-
-
-function do_seekend(handle:thandle):longint;
-begin
-  do_seekend:=SetFilePointer(handle,0,nil,FILE_END);
-  if do_seekend=-1 then
-    begin
-      errno:=GetLastError;
-      Errno2InoutRes;
-    end;
-end;
-
-
-function do_filesize(handle : thandle) : longint;
-var
-  aktfilepos : longint;
-begin
-  aktfilepos:=do_filepos(handle);
-  do_filesize:=do_seekend(handle);
-  do_seek(handle,aktfilepos);
-end;
-
-
-procedure do_truncate (handle:thandle;pos:longint);
-begin
-   do_seek(handle,pos);
-   if not(SetEndOfFile(handle)) then
-    begin
-      errno:=GetLastError;
-      Errno2InoutRes;
-    end;
-end;
-
-
-procedure do_open(var f;p:pchar;flags:longint);
-{
-  filerec and textrec have both handle and mode as the first items so
-  they could use the same routine for opening/creating.
-  when (flags and $100)   the file will be append
-  when (flags and $1000)  the file will be truncate/rewritten
-  when (flags and $10000) there is no check for close (needed for textfiles)
-}
-Const
-  file_Share_Read  = $00000001;
-  file_Share_Write = $00000002;
-Var
-  shflags,
-  oflags,cd : longint;
-  security : TSecurityAttributes;
-begin
-  AllowSlash(p);
-{ close first if opened }
-  if ((flags and $10000)=0) then
-   begin
-     case filerec(f).mode of
-       fminput,fmoutput,fminout : Do_Close(filerec(f).handle);
-       fmclosed : ;
-     else
-      begin
-        {not assigned}
-        inoutres:=102;
-        exit;
-      end;
-     end;
-   end;
-{ reset file handle }
-  filerec(f).handle:=UnusedHandle;
-{ convert filesharing }
-  shflags:=0;
-  if ((filemode and fmshareExclusive) = fmshareExclusive) then
-    { no sharing }
-  else
-    if (filemode = fmShareCompat) or ((filemode and fmshareDenyWrite) = fmshareDenyWrite) then
-      shflags := file_Share_Read
-  else
-    if ((filemode and fmshareDenyRead) = fmshareDenyRead) then
-      shflags := file_Share_Write
-  else
-    if ((filemode and fmshareDenyNone) = fmshareDenyNone) then
-      shflags := file_Share_Read + file_Share_Write;
-{ convert filemode to filerec modes }
-  case (flags and 3) of
-   0 : begin
-         filerec(f).mode:=fminput;
-         oflags:=longint(GENERIC_READ);
-       end;
-   1 : begin
-         filerec(f).mode:=fmoutput;
-         oflags:=longint(GENERIC_WRITE);
-       end;
-   2 : begin
-         filerec(f).mode:=fminout;
-         oflags:=longint(GENERIC_WRITE or GENERIC_READ);
-       end;
-  end;
-{ create it ? }
-  if (flags and $1000)<>0 then
-   cd:=CREATE_ALWAYS
-{ or Append/Open ? }
-  else
-    cd:=OPEN_EXISTING;
-{ empty name is special }
-  if p[0]=#0 then
-   begin
-     case FileRec(f).mode of
-       fminput :
-         FileRec(f).Handle:=StdInputHandle;
-       fminout, { this is set by rewrite }
-       fmoutput :
-         FileRec(f).Handle:=StdOutputHandle;
-       fmappend :
-         begin
-           FileRec(f).Handle:=StdOutputHandle;
-           FileRec(f).mode:=fmoutput; {fool fmappend}
-         end;
-     end;
-     exit;
-   end;
-  security.nLength := Sizeof(TSecurityAttributes);
-  security.bInheritHandle:=true;
-  security.lpSecurityDescriptor:=nil;
-  filerec(f).handle:=CreateFile(p,oflags,shflags,@security,cd,FILE_ATTRIBUTE_NORMAL,0);
-{ append mode }
-  if ((flags and $100)<>0) and
-     (filerec(f).handle<>0) and
-     (filerec(f).handle<>UnusedHandle) then
-   begin
-     do_seekend(filerec(f).handle);
-     filerec(f).mode:=fmoutput; {fool fmappend}
-   end;
-{ get errors }
-  { handle -1 is returned sometimes !! (PM) }
-  if (filerec(f).handle=0) or (filerec(f).handle=UnusedHandle) then
-    begin
-      errno:=GetLastError;
-      Errno2InoutRes;
-    end;
-end;
-
-
-
-
-{*****************************************************************************
-                           UnTyped File Handling
-*****************************************************************************}
-
-{$i file.inc}
-
-{*****************************************************************************
-                           Typed File Handling
-*****************************************************************************}
-
-{$i typefile.inc}
-
 {*****************************************************************************
-                           Text File Handling
+                              Parameter Handling
 *****************************************************************************}
 
-{$DEFINE EOF_CTRLZ}
-
-{$i text.inc}
-
-{*****************************************************************************
-                           Directory Handling
-*****************************************************************************}
-
-   function CreateDirectory(name : pointer;sec : pointer) : longbool;
-     stdcall;external 'kernel32' name 'CreateDirectoryA';
-   function RemoveDirectory(name:pointer):longbool;
-     stdcall;external 'kernel32' name 'RemoveDirectoryA';
-   function SetCurrentDirectory(name : pointer) : longbool;
-     stdcall;external 'kernel32' name 'SetCurrentDirectoryA';
-   function GetCurrentDirectory(bufsize : longint;name : pchar) : longbool;
-     stdcall;external 'kernel32' name 'GetCurrentDirectoryA';
-
-type
- TDirFnType=function(name:pointer):longbool;stdcall;
-
-procedure dirfn(afunc : TDirFnType;const s:string);
-var
-  buffer : array[0..255] of char;
-begin
-  move(s[1],buffer,length(s));
-  buffer[length(s)]:=#0;
-  AllowSlash(pchar(@buffer));
-  if not aFunc(@buffer) then
-    begin
-      errno:=GetLastError;
-      Errno2InoutRes;
-    end;
-end;
-
-function CreateDirectoryTrunc(name:pointer):longbool;stdcall;
-begin
-  CreateDirectoryTrunc:=CreateDirectory(name,nil);
-end;
-
-procedure mkdir(const s:string);[IOCHECK];
-begin
-  If (s='') or (InOutRes <> 0) then
-   exit;
-  dirfn(TDirFnType(@CreateDirectoryTrunc),s);
-end;
-
-procedure rmdir(const s:string);[IOCHECK];
-begin
-  if (s ='.') then
-    InOutRes := 16;
-  If (s='') or (InOutRes <> 0) then
-   exit;
-  dirfn(TDirFnType(@RemoveDirectory),s);
-end;
-
-procedure chdir(const s:string);[IOCHECK];
-begin
-  If (s='') or (InOutRes <> 0) then
-   exit;
-  dirfn(TDirFnType(@SetCurrentDirectory),s);
-  if Inoutres=2 then
-   Inoutres:=3;
-end;
-
-procedure GetDir (DriveNr: byte; var Dir: ShortString);
-const
-  Drive:array[0..3]of char=(#0,':',#0,#0);
-var
-  defaultdrive:boolean;
-  DirBuf,SaveBuf:array[0..259] of Char;
-begin
-  defaultdrive:=drivenr=0;
-  if not defaultdrive then
-   begin
-    byte(Drive[0]):=Drivenr+64;
-    GetCurrentDirectory(SizeOf(SaveBuf),SaveBuf);
-    if not SetCurrentDirectory(@Drive) then
-     begin
-      errno := word (GetLastError);
-      Errno2InoutRes;
-      Dir := char (DriveNr + 64) + ':\';
-      SetCurrentDirectory(@SaveBuf);
-      Exit;
-     end;
-   end;
-  GetCurrentDirectory(SizeOf(DirBuf),DirBuf);
-  if not defaultdrive then
-   SetCurrentDirectory(@SaveBuf);
-  dir:=strpas(DirBuf);
-  if not FileNameCaseSensitive then
-   dir:=upcase(dir);
-end;
-
-{*****************************************************************************
-                         SystemUnit Initialization
-*****************************************************************************}
-
-   { Startup }
-   procedure GetStartupInfo(p : pointer);
-     stdcall;external 'kernel32' name 'GetStartupInfoA';
-   function GetStdHandle(nStdHandle:DWORD):THANDLE;
-     stdcall;external 'kernel32' name 'GetStdHandle';
-
-   { command line/enviroment functions }
-   function GetCommandLine : pchar;
-     stdcall;external 'kernel32' name 'GetCommandLineA';
-
-  function GetCurrentProcessId:DWORD;
-    stdcall; external 'kernel32' name 'GetCurrentProcessId';
- 
-  function GetCurrentThreadId:DWORD;
-    stdcall; external 'kernel32' name 'GetCurrentThreadId';
-
-
 var
   ModuleName : array[0..255] of char;
 
@@ -895,6 +319,26 @@ begin
 end;
 
 
+function paramcount : longint;
+begin
+  paramcount := argc - 1;
+end;
+
+function paramstr(l : longint) : string;
+begin
+  if (l>=0) and (l<argc) then
+    paramstr:=strpas(argv[l])
+  else
+    paramstr:='';
+end;
+
+
+procedure randomize;
+begin
+  randseed:=GetTickCount;
+end;
+
+
 {*****************************************************************************
                          System Dependent Exit code
 *****************************************************************************}
@@ -1608,7 +1052,8 @@ begin
   { Reset IO Error }
   InOutRes:=0;
   ProcessID := GetCurrentProcessID;
-  ThreadID := GetCurrentThreadID;
+  { threading }
+  InitSystemThreads;
   { Reset internal error variable }
   errno:=0;
 {$ifdef HASVARIANT}
@@ -1621,7 +1066,11 @@ end.
 
 {
   $Log$
-  Revision 1.66  2005-02-01 20:22:50  florian
+  Revision 1.67  2005-02-06 13:06:20  peter
+    * moved file and dir functions to sysfile/sysdir
+    * win32 thread in systemunit
+
+  Revision 1.66  2005/02/01 20:22:50  florian
     * improved widestring infrastructure manager
 
   Revision 1.65  2004/12/12 11:53:47  florian

rtl/win32/systhrds.pp → rtl/win32/systhrd.inc

@@ -4,7 +4,7 @@
     Copyright (c) 2002 by Peter Vreman,
     member of the Free Pascal development team.
 
-    Win32 threading support implementation
+    Linux (pthreads) threading support implementation
 
     See the file COPYING.FPC, included in this distribution,
     for details about the copyright.
@@ -14,40 +14,7 @@
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
  **********************************************************************}
-{$mode objfpc}
-unit systhrds;
-interface
-
-{$S-}
-
-  type
-    { the fields of this record are os dependent  }
-    { and they shouldn't be used in a program     }
-    { only the type TCriticalSection is important }
-    PRTLCriticalSection = ^TRTLCriticalSection;
-    TRTLCriticalSection = packed record
-      DebugInfo : pointer;
-      LockCount : longint;
-      RecursionCount : longint;
-      OwningThread : DWord;
-      LockSemaphore : DWord;
-      Reserved : DWord;
-    end;
-
-{ Include generic thread interface }
-{$i threadh.inc}
-
-
-implementation
-
-function  SysGetCurrentThreadId : dword;forward;
-
-{*****************************************************************************
-                             Generic overloaded
-*****************************************************************************}
 
-{ Include generic overloaded routines }
-{$i thread.inc}
 
 {*****************************************************************************
                            Local WINApi imports
@@ -79,13 +46,11 @@ procedure Sleep(dwMilliseconds: DWord); stdcall;external 'kernel32' name 'Sleep'
 function  WinSuspendThread (threadHandle : dword) : dword; stdcall;external 'kernel32' name 'SuspendThread';
 function  WinResumeThread  (threadHandle : dword) : dword; stdcall;external 'kernel32' name 'ResumeThread';
 function  TerminateThread  (threadHandle : dword; var exitCode : dword) : boolean; stdcall;external 'kernel32' name 'TerminateThread';
-function  GetLastError : dword; stdcall;external 'kernel32' name 'GetLastError';
 function  WaitForSingleObject (hHandle,Milliseconds: dword): dword; stdcall;external 'kernel32' name 'WaitForSingleObject';
 function  WinThreadSetPriority (threadHandle : dword; Prio: longint): boolean; stdcall;external 'kernel32' name 'SetThreadPriority';
-function  WinThreadGetPriority (threadHandle : dword): Integer; stdcall;external 'kernel32' name 'GetThreadPriority';
+function  WinThreadGetPriority (threadHandle : dword): LongInt; stdcall;external 'kernel32' name 'GetThreadPriority';
 function  WinGetCurrentThreadId : dword; stdcall;external 'kernel32' name 'GetCurrentThread';
 function  CreateEvent(lpEventAttributes:pointer;bManualReset:longbool;bInitialState:longbool;lpName:pchar):CARDINAL; stdcall; external 'kernel32' name 'CreateEventA';
-function  CloseHandle(hObject:CARDINAL):LONGBOOL; stdcall; external 'kernel32' name 'CloseHandle';
 function  ResetEvent(hEvent:CARDINAL):LONGBOOL; stdcall; external 'kernel32' name 'ResetEvent';
 function  SetEvent(hEvent:CARDINAL):LONGBOOL; stdcall; external 'kernel32' name 'SetEvent';
 function PulseEvent(hEvent:THANDLE):CARDINAL {WINBOOL}; stdcall; external 'kernel32' name 'PulseEvent';
@@ -142,9 +107,6 @@ CONST
         GlobalFree(TlsGetValue(tlskey));
       end;
 
-{ Include OS independent Threadvar initialization }
-{$i threadvr.inc}
-
 {$endif HASTHREADVAR}
 
 
@@ -169,7 +131,7 @@ CONST
       end;
 
 
-    function ThreadMain(param : pointer) : integer; stdcall;
+    function ThreadMain(param : pointer) : Longint; stdcall;
       var
         ti : tthreadinfo;
       begin
@@ -274,14 +236,14 @@ CONST
     end;
 
 
-    function  SysThreadGetPriority (threadHandle : dword): Integer;
+    function  SysThreadGetPriority (threadHandle : dword): longint;
     begin
       SysThreadGetPriority:=WinThreadGetPriority(threadHandle);
     end;
 
     function  SysGetCurrentThreadId : dword;
     begin
-      SysGetCurrentThreadId:=WinGetCurrentThreadId;
+      SysGetCurrentThreadId:=Win32GetCurrentThreadId;
     end;
 
 {*****************************************************************************
@@ -435,14 +397,14 @@ begin
   PulseEvent(THANDLE(AEvent));
 end;
 
-CONST INFINITE=-1;
-
 procedure intRTLEventStartWait(AEvent: PRTLEvent);
 begin
   // nothing to do, win32 events stay signalled after being set
 end;
 
 procedure intRTLEventWaitFor(AEvent: PRTLEvent);
+CONST
+  INFINITE=-1;
 begin
   WaitForSingleObject(THANDLE(AEvent), INFINITE);
 end;
@@ -452,8 +414,7 @@ end;
 Var
   WinThreadManager : TThreadManager;
 
-Procedure SetWinThreadManager;
-
+Procedure InitSystemThreads;
 begin
   With WinThreadManager do
     begin
@@ -492,64 +453,15 @@ begin
     end;
   SetThreadManager(WinThreadManager);
   InitHeapMutexes;
+  ThreadID := GetCurrentThreadID;
 end;
 
-initialization
-  SetWinThreadManager;
-end.
 
 {
   $Log$
-  Revision 1.15  2005-01-30 21:48:14  marco
-   * stdcall added to few calls
-
-  Revision 1.14  2004/12/28 14:20:03  marco
-   * tthread patch from neli
-
-  Revision 1.13  2004/12/26 13:46:45  peter
-    * tthread uses systhrds
-
-  Revision 1.12  2004/12/22 21:29:24  marco
-   * rtlevent kraam. Checked (compile): Linux, FreeBSD, Darwin, Windows
-        Check work: ask Neli.
-
-  Revision 1.11  2004/05/23 15:30:13  marco
-   * first try
-
-  Revision 1.10  2004/01/21 14:15:42  florian
-    * fixed win32 compilation
-
-  Revision 1.9  2003/11/29 17:34:53  michael
-  + Removed dummy variable from SetCthreadManager
-
-  Revision 1.8  2003/11/27 10:28:41  michael
-  + Patch from peter to fix make cycle
-
-  Revision 1.7  2003/11/26 20:10:59  michael
-  + New threadmanager implementation
-
-  Revision 1.6  2003/10/01 21:00:09  peter
-    * GetCurrentThreadHandle renamed to GetCurrentThreadId
-
-  Revision 1.5  2003/09/17 15:06:36  peter
-    * stdcall patch
-
-  Revision 1.4  2003/03/27 17:14:27  armin
-  * more platform independent thread routines, needs to be implemented for unix
-
-  Revision 1.3  2003/03/24 16:12:01  jonas
-    * BeginThread() now returns the thread handle instead of the threadid
-      (needed because you have to free the handle after your thread is
-       finished, and the threadid is already returned via a var-parameter)
-
-  Revision 1.2  2002/10/31 13:45:44  carl
-    * threadvar.inc -> threadvr.inc
-
-  Revision 1.1  2002/10/16 06:27:30  michael
-  + Renamed thread unit to systhrds
-
-  Revision 1.1  2002/10/14 19:39:18  peter
-    * threads unit added for thread support
+  Revision 1.1  2005-02-06 13:06:20  peter
+    * moved file and dir functions to sysfile/sysdir
+    * win32 thread in systemunit
 
 }
 

rtl/win32/tthread.inc

@@ -20,7 +20,7 @@ var
 }
   ExecuteEvent: PRtlEvent;
   { guard for synchronization variables }
-  SynchronizeCritSect: systhrds.TRtlCriticalSection;
+  SynchronizeCritSect: TRtlCriticalSection;
   { method to execute }
   SynchronizeMethod: TThreadMethod;
   { caught exception in gui thread, to be raised in calling thread }
@@ -201,7 +201,7 @@ begin
     { raise some error? }
     exit;
 
-  systhrds.EnterCriticalSection(SynchronizeCritSect);
+  EnterCriticalSection(SynchronizeCritSect);
   SynchronizeMethod := Method;
   SynchronizeException := nil;
   SynchronizeMethodProc;
@@ -209,7 +209,7 @@ begin
   RtlEventWaitFor(ExecuteEvent);
   SynchronizeMethod := nil;
   LocalSyncException := SynchronizeException;
-  systhrds.LeaveCriticalSection(SynchronizeCritSect);
+  LeaveCriticalSection(SynchronizeCritSect);
   if LocalSyncException <> nil then
     raise LocalSyncException;
 end;
@@ -265,7 +265,11 @@ begin
 end;
 {
   $Log$
-  Revision 1.4  2004-12-26 13:46:45  peter
+  Revision 1.5  2005-02-06 13:06:20  peter
+    * moved file and dir functions to sysfile/sysdir
+    * win32 thread in systemunit
+
+  Revision 1.4  2004/12/26 13:46:45  peter
     * tthread uses systhrds
 
   Revision 1.3  2004/12/23 09:42:42  marco

rtl/win32/win32.inc

@@ -14,118 +14,14 @@
 
  **********************************************************************}
 
-const
-   { constants for GetStdHandle }
-   STD_INPUT_HANDLE = longint($fffffff6);
-   STD_OUTPUT_HANDLE = longint($fffffff5);
-   STD_ERROR_HANDLE = longint($fffffff4);
-   INVALID_HANDLE_VALUE = longint($ffffffff);
-
-   IGNORE = 0;               { Ignore signal }
-   INFINITE = longint($FFFFFFFF);     { Infinite timeout }
-
-   { flags for CreateFile }
-   GENERIC_READ=$80000000;
-   GENERIC_WRITE=$40000000;
-   CREATE_NEW = 1;
-   CREATE_ALWAYS = 2;
-   OPEN_EXISTING = 3;
-   OPEN_ALWAYS = 4;
-   TRUNCATE_EXISTING = 5;
-
-   FILE_ATTRIBUTE_ARCHIVE = 32;
-   FILE_ATTRIBUTE_COMPRESSED = 2048;
-   FILE_ATTRIBUTE_NORMAL = 128;
-   FILE_ATTRIBUTE_DIRECTORY = 16;
-   FILE_ATTRIBUTE_HIDDEN = 2;
-   FILE_ATTRIBUTE_READONLY = 1;
-   FILE_ATTRIBUTE_SYSTEM = 4;
-   FILE_ATTRIBUTE_TEMPORARY = 256;
-
-   { Share mode open }
-   fmShareCompat    = $00000000;
-   fmShareExclusive = $10;
-   fmShareDenyWrite = $20;
-   fmShareDenyRead  = $30;
-   fmShareDenyNone  = $40;
-
-   { flags for SetFilePos }
-   FILE_BEGIN = 0;
-   FILE_CURRENT = 1;
-   FILE_END = 2;
-
-   { GetFileType  }
-   FILE_TYPE_UNKNOWN = 0;
-   FILE_TYPE_DISK = 1;
-   FILE_TYPE_CHAR = 2;
-   FILE_TYPE_PIPE = 3;
-
-   VER_PLATFORM_WIN32s = 0;
-   VER_PLATFORM_WIN32_WINDOWS = 1;
-   VER_PLATFORM_WIN32_NT = 2;
-type
-   {UINT  = longint;
-   BOOL  = longint; obsolete }
-   UINT  = cardinal;
-   BOOL  = longbool;
-//   WCHAR = word;
-{$ifdef UNICODE}
-   LPTCH   = ^word;
-   LPTSTR  = ^word;
-   LPCTSTR = ^word;
-{$else UNICODE}
-   LPTCH   = ^char;
-   LPTSTR  = ^char;
-   LPCTSTR = ^char;
-{$endif UNICODE}
-   LPWSTR  = ^wchar;
-   PVOID   = pointer;
-   LPVOID  = pointer;
-   LPCVOID = pointer;
-   LPDWORD = ^DWORD;
-   HLocal  = THandle;
-   PStr    = pchar;
-   LPStr   = pchar;
-   PLPSTR  = ^LPSTR;
-   PLPWSTR = ^LPWSTR;
-
-  PSecurityAttributes = ^TSecurityAttributes;
-  TSecurityAttributes = packed record
-    nLength : DWORD;
-    lpSecurityDescriptor : Pointer;
-    bInheritHandle : BOOL;
-  end;
-
-  PProcessInformation = ^TProcessInformation;
-  TProcessInformation = record
-    hProcess: THandle;
-    hThread: THandle;
-    dwProcessId: DWORD;
-    dwThreadId: DWORD;
-  end;
-
-  PFileTime = ^TFileTime;
-  TFileTime = record
-    dwLowDateTime,
-    dwHighDateTime : DWORD;
-  end;
-
-  LPSystemTime= ^PSystemTime;
-  PSystemTime = ^TSystemTime;
-  TSystemTime = record
-    wYear,
-    wMonth,
-    wDayOfWeek,
-    wDay,
-    wHour,
-    wMinute,
-    wSecond,
-    wMilliseconds: Word;
-  end;
 
 {
   $Log$
-  Revision 1.10  2003-10-06 23:52:53  florian
+  Revision 1.11  2005-02-06 13:06:20  peter
+    * moved file and dir functions to sysfile/sysdir
+    * win32 thread in systemunit
+
+  Revision 1.10  2003/10/06 23:52:53  florian
     * some data types cleaned up
 
   Revision 1.9  2002/09/07 16:01:29  peter

rtl/win32/wininc/redef.inc

@@ -17,9 +17,6 @@
 {$ifdef read_interface}
 
 type
-  TRTLCriticalSection = CRITICAL_SECTION;
-  PRTLCriticalSection = PCRITICAL_SECTION;
-
   PIID = PGUID;
   TIID = TGUID;
   THANDLE = HANDLE;
@@ -1061,7 +1058,11 @@ end;
 
 {
   $Log$
-  Revision 1.29  2005-01-15 11:44:48  marco
+  Revision 1.30  2005-02-06 13:06:20  peter
+    * moved file and dir functions to sysfile/sysdir
+    * win32 thread in systemunit
+
+  Revision 1.29  2005/01/15 11:44:48  marco
    * scrollwindow(ex) added at Neli's request
 
   Revision 1.28  2004/12/18 20:00:59  michael

rtl/win32/wininc/struct.inc

@@ -1206,19 +1206,13 @@
      TCRITICALSECTIONDEBUG = CRITICAL_SECTION_DEBUG;
      PCRITICALSECTIONDEBUG = ^CRITICAL_SECTION_DEBUG;
 
-     CRITICAL_SECTION = record
-          DebugInfo : PCRITICAL_SECTION_DEBUG;
-          LockCount : LONG;
-          RecursionCount : LONG;
-          OwningThread : HANDLE;
-          LockSemaphore : HANDLE;
-          Reserved : DWORD;
-       end;
-     LPCRITICAL_SECTION = ^CRITICAL_SECTION;
-     PCRITICAL_SECTION = ^CRITICAL_SECTION;
-     _CRITICAL_SECTION = CRITICAL_SECTION;
-     TCRITICALSECTION = CRITICAL_SECTION;
-     PCRITICALSECTION = ^CRITICAL_SECTION;
+     CRITICAL_SECTION = TRTLCriticalSection;
+     _CRITICAL_SECTION = TRTLCriticalSection;
+     TCRITICAL_SECTION = TRTLCriticalSection;
+     PCRITICAL_SECTION = PRTLCriticalSection;
+     LPCRITICAL_SECTION = PRTLCriticalSection;
+     TCRITICALSECTION = TRTLCriticalSection;
+     PCRITICALSECTION = PRTLCriticalSection;
 
   { SECURITY_CONTEXT_TRACKING_MODE ContextTrackingMode;  }
 
@@ -7197,7 +7191,11 @@ type
 
 {
   $Log$
-  Revision 1.33  2005-02-03 18:41:12  florian
+  Revision 1.34  2005-02-06 13:06:20  peter
+    * moved file and dir functions to sysfile/sysdir
+    * win32 thread in systemunit
+
+  Revision 1.33  2005/02/03 18:41:12  florian
     * more clx compilation fixed
 
   Revision 1.32  2005/01/19 14:24:46  marco