peter před 20 roky
rodič
revize
2808b3acea

+ 4 - 14
rtl/bsd/sysos.inc

@@ -87,22 +87,12 @@ 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.2  2005-02-06 13:06:20  peter
+   Revision 1.3  2005-02-07 22:04:55  peter
+     * moved to unix
+
+   Revision 1.2  2005/02/06 13:06:20  peter
      * moved file and dir functions to sysfile/sysdir
      * win32 thread in systemunit
 

+ 0 - 157
rtl/linux/sysdir.inc

@@ -1,157 +0,0 @@
-{
-    $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
-
-}

+ 0 - 230
rtl/linux/sysfile.inc

@@ -1,230 +0,0 @@
-{
-    $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
-
-}

+ 0 - 53
rtl/linux/sysheap.inc

@@ -1,53 +0,0 @@
-{
-    $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
- ****************************************************************************}
-
-function SysOSAlloc(size: ptrint): pointer;
-begin
-  result:=Fpmmap(nil,Size,3,MAP_PRIVATE+MAP_ANONYMOUS,-1,0);
-  if result=pointer(-1) then
-    result:=nil
-  else
-    seterrno(0);
-end;
-
-{$define HAS_SYSOSFREE}
-
-procedure SysOSFree(p: pointer; size: ptrint);
-begin
-  fpmunmap(p, size);
-end;
-
-
-
-
-{
-   $Log$
-   Revision 1.2  2005-02-06 12:16:52  peter
-     * bsd thread updates
-
-   Revision 1.1  2005/02/06 11:20:52  peter
-     * threading in system unit
-     * removed systhrds unit
-
-}
-

+ 4 - 11
rtl/linux/sysos.inc

@@ -77,20 +77,13 @@ 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.2  2005-02-06 13:06:20  peter
+   Revision 1.3  2005-02-07 22:04:55  peter
+     * moved to unix
+
+   Revision 1.2  2005/02/06 13:06:20  peter
      * moved file and dir functions to sysfile/sysdir
      * win32 thread in systemunit
 

+ 10 - 1
rtl/bsd/sysdir.inc → rtl/unix/sysdir.inc

@@ -20,6 +20,12 @@
 *****************************************************************************}
 
 Procedure MkDir(Const s: String);[IOCheck];
+const
+  { read/write search permission for everyone }
+  MODE_MKDIR = S_IWUSR OR S_IRUSR OR
+               S_IWGRP OR S_IRGRP OR
+               S_IWOTH OR S_IROTH OR
+               S_IXUSR OR S_IXGRP OR S_IXOTH;
 Var
   Buffer: Array[0..255] of Char;
 Begin
@@ -145,7 +151,10 @@ end;
 
 {
   $Log$
-  Revision 1.1  2005-02-06 13:06:20  peter
+  Revision 1.1  2005-02-07 22:04:55  peter
+    * moved to unix
+
+  Revision 1.1  2005/02/06 13:06:20  peter
     * moved file and dir functions to sysfile/sysdir
     * win32 thread in systemunit
 

+ 9 - 2
rtl/bsd/sysfile.inc → rtl/unix/sysfile.inc

@@ -14,7 +14,6 @@
 
  **********************************************************************}
 
-
 Procedure Do_Close(Handle:thandle);
 Begin
   Fpclose(cint(Handle));
@@ -151,6 +150,11 @@ Procedure Do_Open(var f;p:pchar;flags:longint);
   when (flags and $1000)  the file will be truncate/rewritten
   when (flags and $10000) there is no check for close (needed for textfiles)
 }
+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;
 var
   oflags : cint;
 Begin
@@ -223,7 +227,10 @@ End;
 
 {
   $Log$
-  Revision 1.1  2005-02-06 13:06:20  peter
+  Revision 1.1  2005-02-07 22:04:55  peter
+    * moved to unix
+
+  Revision 1.1  2005/02/06 13:06:20  peter
     * moved file and dir functions to sysfile/sysdir
     * win32 thread in systemunit
 

+ 10 - 9
rtl/bsd/sysheap.inc → rtl/unix/sysheap.inc

@@ -16,14 +16,9 @@
 
  **********************************************************************}
 
-
-{*****************************************************************************
-      OS Memory allocation / deallocation
- ****************************************************************************}
-
 function SysOSAlloc(size: ptrint): pointer;
 begin
-  result:=Fpmmap(nil,cardinal(Size),3,MAP_PRIVATE+MAP_ANONYMOUS,-1,0);
+  result:=Fpmmap(nil,Size,3,MAP_PRIVATE+MAP_ANONYMOUS,-1,0);
   if result=pointer(-1) then
     result:=nil
   else
@@ -39,11 +34,17 @@ end;
 
 
 
-
 {
    $Log$
-   Revision 1.1  2005-02-06 12:16:52  peter
-     * bsd thread updates
+   Revision 1.1  2005-02-07 22:04:55  peter
+     * moved to unix
+
+   Revision 1.1  2005/02/06 16:57:18  peter
+     * threads for go32v2,os,emx,netware
+
+   Revision 1.1  2005/02/06 13:06:20  peter
+     * moved file and dir functions to sysfile/sysdir
+     * win32 thread in systemunit
 
 }