* Fixes Posix dir copied to devel branch

rtl/posix/errno.tem

@@ -0,0 +1,72 @@
+{***********************************************************************}
+{                       POSIX ERROR DEFINITIONS                         }
+{***********************************************************************}
+const
+    { The following constants are system dependent but must all exist }
+    Sys_E2BIG       =
+    Sys_EACCES      =
+    Sys_EAGAIN      =
+    Sys_EBADF       =
+    Sys_EBUSY       =
+    Sys_ECANCELED   =
+    Sys_ECHILD      =
+    Sys_EDEADLK     =
+    Sys_EDOM        =
+    Sys_EEXIST      =
+    Sys_EFAULT      =
+    Sys_EFBIG       =
+    Sys_EINPROGRESS =
+    Sys_EINTR       =
+    Sys_EINVAL      =
+    Sys_EIO         =
+    Sys_EISDIR      =
+    Sys_EMFILE      =
+    Sys_EMLINK      =
+    Sys_EMSGSIZE    =
+    Sys_ENAMETOOLONG=
+    Sys_ENFILE      =
+    Sys_ENODEV      =
+    Sys_ENOENT      =
+    Sys_ENOEXEC     =
+    Sys_ENOLCK      =
+    Sys_ENOMEM      =
+    Sys_ENOSPC      =
+    Sys_ENOSYS      =
+    Sys_ENOTDIR     =
+    Sys_ENOTEMPTY   =
+    Sys_ENOTTY      =
+    Sys_ENXIO       =
+    Sys_EPERM       =
+    Sys_EPIPE       =
+    Sys_ERANGE      =
+    Sys_EROFS       =
+    Sys_ESPIPE      =
+    Sys_ESRCH       =
+    Sys_ETIMEDOUT   =
+    Sys_EXDEV       =
+    { These next errors are POSIX, but only defined when    }
+    { certain types of POSIX extensions are defined:        }
+    {Sys_EBADMSG     =    realtime extension POSIX only   }
+    {Sys_ECANCELED   =    async. I/O extension POSIX only }
+    {Sys_EMSGSIZE    =    realtime extension POSIX only   }
+    {Sys_EINPROGRESS =    async. I/O extension POSIX only }
+    {Sys_ENOTSUP     =    unsupported syscall - optional  }
+
+{
+  $Log$
+  Revision 1.2  2002-08-10 13:42:36  marco
+   * Fixes Posix dir copied to devel branch
+
+  Revision 1.1.2.3  2001/11/30 03:50:17  carl
+  * update a small spelling mistake Sys_EACCESS -> Sys_EACCES
+
+  Revision 1.1.2.2  2001/11/28 03:07:59  carl
+  Sys_ENOTSUP added
+
+  Revision 1.1.2.1  2001/08/15 00:14:52  carl
+  - renamed
+
+  Revision 1.1.2.1  2001/07/07 03:51:32  carl
+  + errno.inc template
+
+}

rtl/posix/objinc.inc

@@ -0,0 +1,139 @@
+
+{
+    $Id$
+    Copyright (c) 2001 by the Freepascal development team
+
+    Objects unit OS specific implementation
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+
+{$i errno.inc}
+{$i osposixh.inc}
+{$i osposix.inc}
+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;
+
+
+FUNCTION FileOpen (Var FileName: AsciiZ; Mode: Word): THandle;
+
+Var FileMode : cint;
+
+BEGIN
+  FileMode:=0;
+  if Mode=stCreate then
+  Begin
+     FileMode:=O_CREAT;
+     FileMode:=FileMode or O_RDWR;
+  end
+  else
+   Begin
+     Case (Mode and 3) of
+      0 : FileMode:=FileMode or O_RDONLY;
+      1 : FileMode:=FileMode or O_WRONLY;
+      2 : FileMode:=FileMode or O_RDWR;
+     end;
+   end;
+  FileOpen:=sys_open (pchar(@FileName[0]),FileMode,MODE_OPEN);
+  if (ErrNo=Sys_EROFS) and ((FileMode and O_RDWR)<>0) then
+   begin
+     FileMode:=FileMode and not(O_RDWR);
+     FileOpen:=sys_open(pchar(@FileName[0]),Filemode,MODE_OPEN);
+   end;
+  If FileOpen=-1 then
+    FileOpen:=0;
+  DosStreamError:=Errno;
+END;
+
+FUNCTION FileRead (Handle: THandle; Var BufferArea; BufferLength: Sw_Word;
+Var BytesMoved: Sw_Word): word;
+var result : cint;
+BEGIN
+  repeat
+     result:=Sys_read (Handle,pchar(@BufferArea),BufferLength);
+  until errno<>Sys_EINTR;
+  if result = -1 then
+    BytesMoved := 0
+  else
+    BytesMoved := result;
+  DosStreamError:=Errno;
+  FileRead:=Errno;
+END;
+
+FUNCTION FileWrite (Handle:  THandle; Var BufferArea; BufferLength: Sw_Word;
+Var BytesMoved: Sw_Word): Word;
+var result: cint;
+BEGIN
+  repeat
+     result:=Sys_Write (Handle,pchar(@BufferArea),BufferLength);
+  until errno<>Sys_EINTR;
+  if result = -1 then
+    BytesMoved := 0
+  else
+    BytesMoved := result; 
+  FileWrite:=Errno;
+  DosStreamError:=Errno;
+END;
+
+FUNCTION SetFilePos (Handle: THandle; Pos: LongInt; MoveType: Word;
+VAR NewPos: LongInt): Word;
+
+var
+ whence : cint;
+BEGIN
+  whence := SEEK_SET;
+  case MoveType of
+  1 : whence := SEEK_CUR;
+  2 : whence := SEEK_END;
+  end;
+  NewPos:=Sys_LSeek (Handle,Pos,whence);
+  SetFilePos:=Errno;
+END;
+
+FUNCTION FileClose (Handle: THandle): Word;
+BEGIN
+  Sys_Close (Handle);
+  DosStreamError:=Errno;
+  FileClose := Errno;
+END;
+
+FUNCTION SetFileSize (Handle: THandle; FileSize: LongInt): Word;
+var
+ Actual : longint;
+BEGIN
+   SetFilePos(Handle,FileSize,0,Actual);
+   If (Actual = FileSize) Then
+    Begin
+      if (Sys_FTruncate(Handle,Filesize)=-1) then
+         SetFileSize:=103
+      else
+         SetFileSize:=0;
+    end;
+END;
+
+{
+ $Log$
+ Revision 1.2  2002-08-10 13:42:36  marco
+  * Fixes Posix dir copied to devel branch
+
+ Revision 1.1.2.1  2001/08/13 05:54:54  carl
+ + objects unit implementation based on POSIX
+
+}

rtl/posix/osposix.tem

@@ -0,0 +1,118 @@
+{
+    $Id$
+    Copyright (c) 2001 by Carl Eric Codere
+
+    Implements POSIX 1003.1 conforming interface
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+
+  {$Linklib c}
+
+{   var
+     Errno : cint; external name 'errno';}
+
+
+
+    function sys_fork : pid_t; cdecl; external name 'fork';
+    function sys_execve(const path : pchar; const argv : ppchar; const envp: ppchar): cint; cdecl; external name 'execve';
+    function sys_waitpid(pid : pid_t; var stat_loc : cint; options: cint): pid_t; cdecl; external name 'waitpid';
+    procedure sys_exit(status : cint); cdecl; external name '_exit';
+    function sys_uname(var name: utsname): cint; cdecl; external name 'uname';
+    function sys_opendir(const dirname : pchar): pdir; cdecl; external name 'opendir';
+    function sys_readdir(dirp : pdir) : pdirent;cdecl; external name 'readdir';
+    function sys_closedir(dirp : pdir): cint; cdecl; external name 'closedir';
+    function sys_chdir(const path : pchar): cint; cdecl; external name 'chdir';
+    function sys_open(const path: pchar; flags : cint; mode: mode_t):cint; cdecl; external name 'open';
+    function sys_mkdir(const path : pchar; mode: mode_t):cint; cdecl; external name 'mkdir';
+    function sys_unlink(const path: pchar): cint; cdecl; external name 'unlink';
+    function sys_rmdir(const path : pchar): cint; cdecl; external name 'rmdir';
+    function sys_rename(const old : pchar; const newpath: pchar): cint; cdecl;external name 'rename';
+    function sys_fstat(fd : cint; var sb : stat): cint; cdecl; external name 'fstat';
+    function sys_stat(const path: pchar; var buf : stat): cint; cdecl; external name 'stat';
+    function sys_access(const pathname : pchar; amode : cint): cint; cdecl; external name 'access';
+    function sys_close(fd : cint): cint; cdecl; external name 'close';
+    function sys_read(fd: cint; buf: pchar; nbytes : size_t): ssize_t; cdecl; external name 'read';
+    function sys_write(fd: cint;const buf:pchar; nbytes : size_t): ssize_t; cdecl; external name 'write';
+    function sys_lseek(fd : cint; offset : off_t; whence : cint): off_t; cdecl; external name 'lseek';
+    function sys_time(var tloc:time_t): time_t; cdecl; external name 'time';
+    function sys_ftruncate(fd : cint; flength : off_t): cint; cdecl; external name 'ftruncate';
+    function sys_sigaction(sig: cint; var act : sigactionrec; var oact : sigactionrec): cint; cdecl; external name 'sigaction';
+
+
+    function S_ISDIR(m : mode_t): boolean;
+      begin
+      end;
+
+    function S_ISCHR(m : mode_t): boolean;
+      begin
+      end;
+
+    function S_ISBLK(m : mode_t): boolean;
+      begin
+      end;
+
+    function S_ISREG(m : mode_t): boolean;
+      begin
+      end;
+
+    function S_ISFIFO(m : mode_t): boolean;
+      begin
+      end;
+
+    function wifexited(status : cint): cint;
+      begin
+      end;
+
+    function wexitstatus(status : cint): cint;
+     begin
+     end;
+
+    function wstopsig(status : cint): cint;
+     begin
+     end;
+
+    function wifsignaled(status : cint): cint;
+     begin
+     end;
+
+{
+
+ $Log$
+ Revision 1.2  2002-08-10 13:42:36  marco
+  * Fixes Posix dir copied to devel branch
+
+ Revision 1.1.2.5  2001/12/09 03:31:50  carl
+ + wifsignaled() added
+
+ Revision 1.1.2.4  2001/12/03 03:13:30  carl
+ * fix ftruncate prototype
+ * fix rename prototype
+ * change readdir / closedir prototype
+
+ Revision 1.1.2.3  2001/11/30 03:50:43  carl
+ + int -> cint
+ + missing prototypes added
+
+ Revision 1.1.2.2  2001/11/28 03:08:29  carl
+ * int -> cint
+ + several other stuff renamed
+
+ Revision 1.1.2.1  2001/08/15 00:15:04  carl
+ - renamed
+
+}

rtl/posix/osposixh.tem

@@ -0,0 +1,133 @@
+{
+    $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 types/constants which must
+    be defined to port FPC to a new POSIX compliant 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.
+
+ **********************************************************************}
+
+{***********************************************************************}
+{                       POSIX TYPE DEFINITIONS                          }
+{***********************************************************************}
+
+type
+    { the following type definitions are compiler dependant }
+    { and system dependant                                  }
+
+    cint  =        { minimum range is : 32-bit                   }
+    cuint =        { minimum range is : 32-bit                   }
+
+
+    dev_t  =              { used for device numbers      }
+    gid_t  =              { used for group IDs           }
+    ino_t  =              { used for file serial numbers }
+    mode_t =              { used for file attributes     }
+    nlink_t  =            { used for link counts         }
+    off_t  =              { used for file sizes          }
+    pid_t  =              { used as process identifier   }
+    size_t =              { as definied in the C standard }
+    ssize_t =             { used by function for returning number of bytes }
+    uid_t =               { used for user ID type        }
+    time_t =              { used for returning the time  }
+
+{***********************************************************************}
+{                         POSIX STRUCTURES                              }
+{***********************************************************************}
+CONST
+    _UTSNAME_LENGTH = ;
+    _UTSNAME_NODENAME_LENGTH = ;
+
+TYPE
+   { system information services }
+   utsname = packed record   { don't forget to verify the alignment }
+   end;
+
+  { file characteristics services }
+   stat = packed record { verify the alignment of the members }
+   end;
+
+  { directory services }
+   pdirent = ^dirent;
+   dirent = packed record    { directory entry record - verify alignment }
+   end;
+
+   pdir = ^dir;
+   dir = packed record
+   end;
+
+
+{***********************************************************************}
+{                  POSIX CONSTANT ROUTINE DEFINITIONS                   }
+{***********************************************************************}
+CONST
+    { access routine - these maybe OR'ed together }
+    F_OK        =  ;   { test for existence of file }
+    R_OK        =  ;   { test for read permission on file }
+    W_OK        =  ;   { test for write permission on file }
+    X_OK        =  ;   { test for execute or search permission }
+    { seek routine }
+    SEEK_SET    =  ;    { seek from beginning of file }
+    SEEK_CUR    =  ;    { seek from current position  }
+    SEEK_END    =  ;    { seek from end of file       }
+    { open routine                                 }
+    { File access modes for `open' and `fcntl'.    }
+    O_RDONLY    =  ;	{ Open read-only.  }
+    O_WRONLY    =  ;	{ Open write-only. }
+    O_RDWR      =  ;	{ Open read/write. }
+    { Bits OR'd into the second argument to open.  }
+    O_CREAT     =  ;	{ Create file if it doesn't exist.  }
+    O_EXCL      =  ;	{ Fail if file already exists.      }
+    O_TRUNC     =  ;	{ Truncate file to zero length.     }
+    O_NOCTTY    =  ;	{ Don't assign a controlling terminal. }
+    { File status flags for `open' and `fcntl'.  }
+    O_APPEND    =  ;	{ Writes append to the file.        }
+    O_NONBLOCK	=  ;	{ Non-blocking I/O.                 }
+
+    { mode_t possible values                                 }
+    S_IRUSR =   ;           { Read permission for owner   }
+    S_IWUSR =   ;           { Write permission for owner  }
+    S_IXUSR =   ;           { Exec  permission for owner  }
+    S_IRGRP =   ;           { Read permission for group   }
+    S_IWGRP =   ;           { Write permission for group  }
+    S_IXGRP =   ;           { Exec permission for group   }
+    S_IROTH =   ;           { Read permission for world   }
+    S_IWOTH =   ;           { Write permission for world  }
+    S_IXOTH =   ;           { Exec permission for world   }
+
+    { Used for waitpid }
+    WNOHANG   = ;               { don't block waiting               }
+    WUNTRACED = ;               { report status of stopped children }
+
+    { POSIX limits, used for buffer and stack allocation }
+    ARG_MAX =           { Maximum number of argument size     }
+    NAME_MAX =          { Maximum number of bytes in filename }
+    PATH_MAX =          { Maximum number of bytes in pathname }
+    
+    {*************************************************************************}
+    {                               SIGNALS                                   }
+    {*************************************************************************}
+    
+    {$i signal.inc}
+
+
+{
+  $Log$
+  Revision 1.2  2002-08-10 13:42:36  marco
+   * Fixes Posix dir copied to devel branch
+
+  Revision 1.1.2.2  2001/11/28 03:08:46  carl
+  - removed signal stuff , moved to signal.inc
+
+  Revision 1.1.2.1  2001/08/15 00:15:08  carl
+  - renamed
+
+}

rtl/posix/posix.tem

@@ -0,0 +1,95 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2001 by Carl Eric Codere
+    development team
+
+    POSIX Compliant interface unit
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit posix;
+
+interface
+
+{***********************************************************************}
+{                       POSIX PUBLIC INTERFACE                          }
+{***********************************************************************}
+
+
+{$i errno.inc}
+{$i osposixh.inc}
+
+
+    function sys_fork : pid_t;
+    function sys_execve(const path : pchar; const argv : ppchar; const envp: ppchar): cint;
+    function sys_waitpid(pid : pid_t; var stat_loc : cint; options: cint): pid_t;
+    procedure sys_exit(status : cint);
+    { get system specific information }
+    function sys_uname(var name: utsname): cint;
+    function sys_opendir(const dirname : pchar): pdir;
+    function sys_readdir(var dirp : dir) : pdirent;
+    function sys_closedir(var dirp : pdir): cint;
+    function sys_chdir(const path : pchar): cint;
+    function sys_open(const path: pchar; flags : cint; mode: mode_t):cint;
+    function sys_mkdir(const path : pchar; mode: mode_t):cint;
+    function sys_unlink(const path: pchar): cint;
+    function sys_rmdir(const path : pchar): cint;
+    function sys_rename(const old : pchar; const newpath: pchar): cint;
+    function sys_fstat(fd : cint; var sb : stat): cint;
+    function sys_stat(const path: pchar; var buf : stat): cint;
+    function sys_access(const pathname : pchar; amode : cint): cint;
+    function sys_close(fd : cint): cint;
+    function sys_read(fd: cint; buf: pchar; nbytes : size_t): ssize_t;
+    function sys_write(fd: cint;const buf:pchar; nbytes : size_t): ssize_t;
+    function sys_lseek(fd : cint; offset : off_t; whence : cint): off_t;
+    function sys_time(var tloc:time_t): time_t;
+
+
+    function sys_sigaction(sig: cint; var act : sigactionrec; var oact : sigactionrec): cint;
+    function sys_ftruncate(fd : cint; flength : off_t): cint;
+
+    function S_ISDIR(m : mode_t): boolean;
+    function S_ISCHR(m : mode_t): boolean;
+    function S_ISBLK(m : mode_t): boolean;
+    function S_ISREG(m : mode_t): boolean;
+    function S_ISFIFO(m : mode_t): boolean;
+
+    function wifexited(status : cint): cint;
+    function wexitstatus(status : cint): cint;
+    function wstopsig(status : cint): cint;
+    function wifsignaled(status : cint): cint;
+
+
+
+
+implementation
+
+{$i osposix.inc}
+
+
+
+
+end.
+
+{
+  $Log$
+  Revision 1.2  2002-08-10 13:42:36  marco
+   * Fixes Posix dir copied to devel branch
+
+  Revision 1.1.2.2  2001/12/09 03:31:56  carl
+  + wifsignaled() added
+
+  Revision 1.1.2.1  2001/12/04 02:29:59  carl
+  + posix unit template file
+
+  Revision 1.1.2.1  2001/08/15 01:06:32  carl
+  + first version of posix unit
+
+}

rtl/posix/readme.txt

@@ -0,0 +1,108 @@
+POSIX directory information
+---------------------------
+This directory contains the system call interface to
+POSIX compliant systems. These files should be
+completed by OS-specific files. This permits to
+easily create  common and maintanable base
+runtime library units (such as dos and system).
+
+Limitations:
+------------
+- Only single byte character sets are supported (ASCII, ISO8859-1)
+- Path and filenames are limited to 255 characters 
+  (shortstrings are limited to 255 characters)
+
+Files in this directory
+
+posix.tem
+----------
+Posix unit template.
+
+dos.pp
+------
+POSIX compliant dos unit. The following routines
+and variables must be implemented / declared on
+a platform by platform basis:
+
+DiskFree()
+DiskSize()
+DosVersion()
+GetTimeZoneString(): Should return the string of
+the timezone information , as defined by POSIX,
+if not available, should return an empty string.
+This string is usually stored in the 'TZ' environment
+variable.
+GetTimeZoneFileName() : Should return the absolute path to 
+the timezone filename to use to convert the UTC time to 
+local time. The format of the timezone files are those 
+specific in glibc.
+FixDriveStr : Array of pchar which contains
+the names of the fixed disks :
+(index 0 : current directory
+ index 1 : first floppy disk
+ index 2 : second floppy disk
+ index 3 : boot disk
+)
+
+
+sysposix.inc
+------------
+Most of the specific operating system
+routines which can be implemented using
+the POSIX interface are implemented in
+this unit. This should be included in
+the target operating system system unit
+to create a complete system unit.
+
+Files required to port the compiler to a POSIX
+compliant system (should reside in the target
+OS directory):
+
+  osposixh.inc : This includes all constants,
+  type definitions and structures used
+  (this is operating system dependant), except
+  for those related to signals. It includes
+  the signal file.
+
+  osposix.inc : The actuall system call routines
+  to the routine prototypes defined in posixh.inc.
+  (either these can be an interface to a libc, or
+  actual system calls).
+
+  errno.inc : All possible error codes which
+  can be returned by the operating system.
+  
+  signal.inc : Defines all constants and types
+  related to signals, it must at least define
+  the POSIX signal types and constants, but
+  can also add other OS specific types and
+  constants related to signals.
+
+
+Templates for the osposix.inc file (when linked
+with the GNU libc), errno.inc and osposixh.inc
+are included in this directory and have the 
+extension .tem . They should be used as a basis 
+to port to a new operating system.
+
+When sysposix.inc is used, the following system
+unit routines must be implemented for each new
+operating system, as they are not reproducable
+under the POSIX interface:
+
+ function sbrk(size : longint): longint;
+ procedure do_truncate (handle,pos:longint);
+ function do_isdevice(handle:longint):boolean;
+
+When dos.pp is used, the following dos
+unit routines must be implemented for each new
+operating system, as they are not reproducable
+under the POSIX interface:
+
+ function diskfree(drive : byte) : int64;
+ function disksize(drive: byte) : int64;
+
+
+
+
+

rtl/posix/signal.tem

@@ -0,0 +1,67 @@
+{
+    $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 types/constants which must
+    be defined to port FPC to a new POSIX compliant OS.
+    This defines all signal related types and constants.
+
+    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.
+
+ **********************************************************************}
+
+type
+    sigset_t =;          { used for additional signal   }
+
+
+   sighandler_t = procedure (signo: cint); cdecl;
+
+   { signal services }
+   sigactionrec = packed record
+   end;
+
+
+const
+
+    {************************ signals *****************************}
+    { more can be provided. Herein are only included the required  }
+    { values.                                                      }
+    {**************************************************************}
+    SIGABRT    =  ;     { abnormal termination           }
+    SIGALRM    =  ;     { alarm clock (used with alarm() }
+    SIGFPE     =  ;     { illegal arithmetic operation   }
+    SIGHUP     =  ;     { Hangup                         }
+    SIGILL     =  ;     { Illegal instruction            }
+    SIGINT     =  ;     { Interactive attention signal   }
+    SIGKILL    =  ;     { Kill, cannot be caught         }
+    SIGPIPE    =  ;     { Broken pipe signal             }
+    SIGQUIT    =  ;     { Interactive termination signal }
+    SIGSEGV    =  ;     { Detection of invalid memory reference }
+    SIGTERM    =  ;     { Termination request           }
+    SIGUSR1    =  ;     { Application defined signal 1  }
+    SIGUSR2    =  ;     { Application defined signal 2  }
+    SIGCHLD    =  ;     { Child process terminated / stopped }
+    SIGCONT    =  ;     { Continue if stopped               }
+    SIGSTOP    =  ;     { Stop signal. cannot be cuaght     }
+    SIGSTP     =  ;     { Interactive stop signal           }
+    SIGTTIN    =  ;     { Background read from TTY          }
+    SIGTTOU    =  ;     { Background write to TTY           }
+    SIGBUS     =  ;     { Access to undefined memory        }
+
+
+{
+  $Log$
+  Revision 1.2  2002-08-10 13:42:36  marco
+   * Fixes Posix dir copied to devel branch
+
+  Revision 1.1.2.1  2001/11/28 03:10:37  carl
+  + signal stuff posix include
+
+  
+}

rtl/posix/sysposix.inc

@@ -0,0 +1,652 @@
+{
+    $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.
+
+ **********************************************************************}
+
+
+
+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;
+
+
+{*****************************************************************************
+                         Stack check code
+*****************************************************************************}
+{$IFOPT S+}
+{$DEFINE STACKCHECK}
+{$ENDIF}
+{$S-}
+procedure int_stackcheck(stack_size:longint);[public,alias:'FPC_STACKCHECK'];
+var
+ c: cardinal;
+begin
+ c := cardinal(Sptr) - cardinal(stack_size) - STACK_MARGIN;
+ if (c <= cardinal(StackBottom)) then
+     HandleError(202);
+end;
+{$IFDEF STACKCHECK}
+{$S+}
+{$ENDIF}
+{$UNDEF STACKCHECK}
+
+
+{*****************************************************************************
+                       Misc. System Dependent Functions
+*****************************************************************************}
+
+procedure System_exit;
+begin
+   sys_exit(cint(ExitCode));
+End;
+
+
+Function ParamCount: Longint;
+Begin
+  Paramcount:=argc-1
+End;
+
+
+function BackPos(c:char; const s: shortstring): integer;
+var
+ i: integer;
+Begin
+  for i:=length(s) downto 0 do
+    if s[i] = c then break;
+  if i=0 then
+    BackPos := 0
+  else
+    BackPos := i;
+end;
+
+
+ { variable where full path and filename and executable is stored }
+ { is setup by the startup of the system unit.                    }
+var
+ execpathstr : shortstring;
+
+function paramstr(l: longint) : string;
+ var
+  s: string;
+  s1: string;
+ begin
+   { stricly conforming POSIX applications  }
+   { have the executing filename as argv[0] }
+   if l=0 then
+     begin
+       paramstr := execpathstr;
+     end
+   else
+     paramstr:=strpas(argv[l]);
+ end;
+
+Procedure Randomize;
+var
+ t: time_t;
+Begin
+  randseed:=longint(sys_time(t));
+End;
+
+
+{*****************************************************************************
+                              Heap Management
+*****************************************************************************}
+
+var
+  _HEAP : longint;external name 'HEAP';
+  _HEAPSIZE : longint;external name 'HEAPSIZE';
+
+{$ifndef SYSTEM_HAS_GETHEAPSTART}
+function getheapstart:pointer;
+begin
+  getheapstart := @_HEAP;
+end;
+{$endif}
+
+
+{$ifndef SYSTEM_HAS_GETHEAPSIZE}
+function getheapsize:longint;
+begin
+  getheapsize := _HEAPSIZE;
+end;
+{$endif}
+
+
+{*****************************************************************************
+                          Low Level File Routines
+*****************************************************************************}
+
+{
+  The lowlevel file functions should take care of setting the InOutRes to the
+  correct value if an error has occured, else leave it untouched
+}
+
+Procedure Errno2Inoutres;
+{
+  Convert ErrNo error to the correct Inoutres value
+}
+
+begin
+  if ErrNo=0 then { Else it will go through all the cases }
+   exit;
+  case ErrNo of
+   Sys_ENFILE,
+   Sys_EMFILE : Inoutres:=4;
+   Sys_ENOENT : Inoutres:=2;
+    Sys_EBADF : Inoutres:=6;
+   Sys_ENOMEM,
+   Sys_EFAULT : Inoutres:=217;
+   Sys_EINVAL : Inoutres:=218;
+    Sys_EPIPE,
+    Sys_EINTR,
+      Sys_EIO,
+   Sys_EAGAIN,
+   Sys_ENOSPC : Inoutres:=101;
+ Sys_ENAMETOOLONG : Inoutres := 3;
+    Sys_EROFS,
+   Sys_EEXIST,
+   Sys_ENOTEMPTY,
+   Sys_EACCES : Inoutres:=5;
+   Sys_EISDIR : InOutRes:=5;
+  else
+    begin
+       InOutRes := Integer(Errno);
+    end;
+  end;
+end;
+
+
+Procedure Do_Close(Handle:Longint);
+Begin
+  sys_close(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 sys_stat(p,fileinfo)<0 then
+   begin
+     Errno2Inoutres;
+     exit;
+   end;
+  if S_ISDIR(fileinfo.st_mode) then
+   begin
+     InOutRes := 2;
+     exit;
+   end;
+  sys_unlink(p);
+  Errno2Inoutres;
+End;
+
+{ truncate at a given position }
+procedure do_truncate (handle,fpos:longint);
+begin
+  { should be simulated in cases where it is not }
+  { available.                                   }
+  sys_ftruncate(handle,fpos);
+  Errno2Inoutres;
+end;
+
+
+
+Procedure Do_Rename(p1,p2:pchar);
+Begin
+  sys_rename(p1,p2);
+  Errno2Inoutres;
+End;
+
+
+Function Do_Write(Handle,Addr,Len:Longint):longint;
+Begin
+  repeat
+    Do_Write:=sys_write(Handle,pchar(addr),len);
+  until ErrNo<>Sys_EINTR;
+  Errno2Inoutres;
+  if Do_Write<0 then
+   Do_Write:=0;
+End;
+
+
+Function Do_Read(Handle,Addr,Len:Longint):Longint;
+Begin
+  repeat
+    Do_Read:=sys_read(Handle,pchar(addr),len);
+  until ErrNo<>Sys_EINTR;
+  Errno2Inoutres;
+  if Do_Read<0 then
+   Do_Read:=0;
+End;
+
+function Do_FilePos(Handle: Longint):longint;
+Begin
+  do_FilePos:=sys_lseek(Handle, 0, SEEK_CUR);
+  Errno2Inoutres;
+End;
+
+Procedure Do_Seek(Handle,Pos:Longint);
+Begin
+  sys_lseek(Handle, pos, SEEK_SET);
+  Errno2Inoutres;
+End;
+
+Function Do_SeekEnd(Handle:Longint): Longint;
+begin
+  Do_SeekEnd:=sys_lseek(Handle,0,SEEK_END);
+  errno2inoutres;
+end;
+
+Function Do_FileSize(Handle:Longint): Longint;
+var
+  Info : Stat;
+Begin
+  if sys_fstat(handle,info)=0 then
+   Do_FileSize:=Info.st_size
+  else
+   Do_FileSize:=0;
+  Errno2InOutRes;
+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:=sys_open(p,oflags,MODE_OPEN);
+  if (ErrNo=Sys_EROFS) and ((OFlags and O_RDWR)<>0) then
+   begin
+     Oflags:=Oflags and not(O_RDWR);
+     FileRec(f).Handle:=sys_open(p,oflags,MODE_OPEN);
+   end;
+  Errno2Inoutres;
+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;
+  sys_mkdir(@buffer, MODE_MKDIR);
+  Errno2Inoutres;
+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;
+  sys_rmdir(@buffer);
+  Errno2Inoutres;
+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;
+  sys_chdir(@buffer);
+  Errno2Inoutres;
+  { file not exists is path not found under tp7 }
+  if InOutRes=2 then
+   InOutRes:=3;
+End;
+
+
+
+procedure getdir(drivenr : byte;var dir : shortstring);
+var
+  cwdinfo      : stat;
+  rootinfo     : stat;
+  thedir,dummy : string[255];
+  dirstream    : pdir;
+  d            : pdirent;
+  name         : string[255];
+  tmp          : string[255];
+  thisdir      : stat;
+begin
+  dir:='';
+  thedir:='';
+  dummy:='';
+
+  { get root directory information }
+  tmp := '/'+#0;
+  if sys_stat(@tmp[1],rootinfo)<0 then
+      exit;
+  repeat
+    tmp := dummy+'.'+#0;
+    { get current directory information }
+    if sys_stat(@tmp[1],cwdinfo)<0 then
+      exit;
+    tmp:=dummy+'..'+#0;
+    { open directory stream }
+    { try to find the current inode number of the cwd }
+    dirstream:=sys_opendir(@tmp[1]);
+    if dirstream=nil then
+       exit;
+    repeat
+      name:='';
+      d:=sys_readdir(dirstream);
+      { no more entries to read ... }
+      if not assigned(d) then
+        begin
+          break;
+        end;
+      tmp:=dummy+'../'+strpas(d^.d_name) + #0;
+      if sys_stat(@tmp[1],thisdir)<0 then
+      begin
+        exit;
+      end;
+      { 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
+            begin
+              name:='/'+strpas(d^.d_name);
+            end;
+        end
+    until (name<>'');
+    sys_closedir(dirstream);
+    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;
+end;
+
+
+{*****************************************************************************
+                         SystemUnit Initialization
+*****************************************************************************}
+
+
+procedure SignalToRunerror(signo: cint); cdecl;
+var
+  res : word;
+begin
+    res:=0;
+    if signo = SIGFPE then
+     begin
+        res := 200;
+     end
+    else
+    if (signo = SIGILL) or (signo = SIGBUS) or (signo = SIGSEGV) then
+      begin
+        res := 216;
+      end;
+  { give runtime error at the position where the signal was raised }
+  if res<>0 then
+   begin
+     HandleError(res);
+   end;
+end;
+
+
+var
+  act: SigActionRec;
+
+Procedure InstallSignals;
+var
+  oldact: SigActionRec;
+begin
+  { Initialize the sigaction structure }
+  { all flags and information set to zero }
+  FillChar(act, sizeof(SigActionRec),0);
+  { initialize handler                    }
+  act.sa_handler := @SignalToRunError;
+  sys_SigAction(SIGFPE,act,oldact);
+  sys_SigAction(SIGSEGV,act,oldact);
+  sys_SigAction(SIGBUS,act,oldact);
+  sys_SigAction(SIGILL,act,oldact);
+end;
+
+
+procedure SetupCmdLine;
+var
+  bufsize,
+  len,j,
+  size,i : longint;
+  found  : boolean;
+  buf    : pchar;
+
+  procedure AddBuf;
+  begin
+    reallocmem(cmdline,size+bufsize);
+    move(buf^,cmdline[size],bufsize);
+    inc(size,bufsize);
+    bufsize:=0;
+  end;
+
+begin
+  GetMem(buf,ARG_MAX);
+  size:=0;
+  bufsize:=0;
+  i:=0;
+  while (i<argc) do
+   begin
+     len:=strlen(argv[i]);
+     if len>ARG_MAX-2 then
+      len:=ARG_MAX-2;
+     found:=false;
+     for j:=1 to len do
+      if argv[i][j]=' ' then
+       begin
+         found:=true;
+         break;
+       end;
+     if bufsize+len>=ARG_MAX-2 then
+      AddBuf;
+     if found then
+      begin
+        buf[bufsize]:='"';
+        inc(bufsize);
+      end;
+     move(argv[i]^,buf[bufsize],len);
+     inc(bufsize,len);
+     if found then
+      begin
+        buf[bufsize]:='"';
+        inc(bufsize);
+      end;
+     if i<argc then
+      buf[bufsize]:=' '
+     else
+      buf[bufsize]:=#0;
+     inc(bufsize);
+     inc(i);
+   end;
+  AddBuf;
+  FreeMem(buf,ARG_MAX);
+end;
+
+(*
+Begin
+{ Set up signals handlers }
+   InstallSignals;
+{ Setup heap }
+  InitHeap;
+  InitExceptions;
+{ Arguments }
+  SetupCmdLine;
+{ Setup stdin, stdout and stderr }
+  OpenStdIO(Input,fmInput,StdInputHandle);
+  OpenStdIO(Output,fmOutput,StdOutputHandle);
+  OpenStdIO(StdOut,fmOutput,StdOutputHandle);
+  OpenStdIO(StdErr,fmOutput,StdErrorHandle);
+{ Reset IO Error }
+  InOutRes:=0;
+End.
+*)
+{
+ $Log$
+ Revision 1.2  2002-08-10 13:42:36  marco
+  * Fixes Posix dir copied to devel branch
+
+ Revision 1.1.2.18  2002/03/10 11:45:02  carl
+ * InOutRes := 16 with rmdir()
+ * InOutRes := 5 more checking
+
+ Revision 1.1.2.17  2002/03/03 15:11:51  carl
+ * erase() bugfix (erasing a directory is done via rmdir() only!)
+
+ Revision 1.1.2.16  2002/02/15 18:13:35  carl
+ * bugfix for paramstr(0)
+
+ Revision 1.1.2.15  2001/12/03 03:15:15  carl
+ * update readdir prototype
+
+ Revision 1.1.2.14  2001/09/27 02:24:43  carl
+ * correct problem with getting paramstr(0) when in root
+
+ Revision 1.1.2.13  2001/08/15 01:05:22  carl
+ + add do_truncate()
+
+ Revision 1.1.2.12  2001/08/13 09:38:12  carl
+ * changed prototype of sys_readdir
+ * bugfix of problems of changing signs with errno!
+
+ Revision 1.1.2.11  2001/08/13 05:55:43  carl
+ - removed some debug code
+
+ Revision 1.1.2.10  2001/08/08 02:01:03  carl
+ * bugfix of getdir() with root
+
+ Revision 1.1.2.9  2001/08/03 02:00:26  carl
+ + hack :(... for heap management.
+ + correct I/O bug (to test) should be also updated in linux
+
+ Revision 1.1.2.8  2001/07/21 19:20:52  carl
+ + getdir() implemented
+ + MAX_ARGS define now used
+
+ Revision 1.1.2.7  2001/07/14 04:18:39  carl
+ + started debugging getdir()
+
+ Revision 1.1.2.6  2001/07/08 04:46:43  carl
+ * correct parameter calls to sigaction
+
+ Revision 1.1.2.5  2001/07/08 00:38:04  carl
+ + updates
+
+ Revision 1.1.2.3  2001/07/06 11:59:58  carl
+ * renamed some defines
+ * correct includes
+
+ Revision 1.1.2.2  2001/07/06 11:42:28  carl
+ * modified for more compliance
+
+ Revision 1.1.2.1  2001/07/06 11:22:18  carl
+ + add files for POSIX
+
+}

rtl/posix/sysutils.pp

@@ -0,0 +1,555 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2001 by Florian Klaempfl
+    member of the Free Pascal development team
+
+    Sysutils unit for POSIX compliant systems
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit sysutils;
+interface
+
+{$MODE objfpc}
+{ force ansistrings }
+{$H+}
+
+
+
+{ Include platform independent interface part }
+{$i sysutilh.inc}
+
+{ Platform dependent calls }
+
+Procedure AddDisk(const path:string);
+
+
+
+implementation
+
+uses dos,posix;
+
+{ Include platform independent implementation part }
+{$i sysutils.inc}
+
+
+
+{****************************************************************************
+                              File Functions
+****************************************************************************}
+{$I-}
+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;
+
+
+Function FileOpen (Const FileName : string; Mode : Integer) : Longint;
+
+Var Flags : cint;
+    FileHandle : cint;
+{    lock: flock;}
+BEGIN
+  Flags:=0;
+  Case (Mode and 3) of
+    fmOpenRead : Flags:=Flags or O_RDONLY;
+    fmOpenWrite : Flags:=Flags or O_WRONLY;
+    fmOpenReadWrite : Flags:=Flags or O_RDWR;
+  end;
+  FileHandle:=sys_Open (pchar(FileName),Flags,MODE_OPEN);
+  if (ErrNo=Sys_EROFS) and ((Flags and O_RDWR)<>0) then
+   begin
+     Flags:=Flags and not(O_RDWR);
+     FileHandle:=sys_open(pchar(FileName),Flags,MODE_OPEN);
+   end;
+  FileOpen := longint(FileHandle);
+(*
+  { if there was an error, then don't do anything }
+  if FileHandle = -1 then
+     exit;
+  { now check if the file can actually be used }
+  { by verifying the locks on the file         }
+  lock.l_whence := SEEK_SET;
+  lock.l_start := 0; { from start of file }
+  lock.l_len := 0;   { to END of file    }
+  if sys_fcntl(FileHandle, F_GETLK, @lock)<>-1 then
+    begin
+        { if another process has created a lock on this file }
+        { exclusive lock? }
+        if (lock.l_type = F_WRLCK) then
+           begin
+             { close and exit }
+             sys_close(FileHandle);
+             FileOpen := -1;
+             exit;
+           end;
+        { shared lock? }
+        if (lock.l_type = F_RDLK) and
+          ((Flags = O_RDWR) or Flags = O_WRONLY)) then
+           begin
+             { close and exit }
+             sys_close(FileHandle);
+             FileOpen := -1;
+             exit;
+           end;
+    end;
+  { now actually set the lock: }
+  { only the following are simulated with sysutils : }
+  {  - fmShareDenywrite (get exclusive lock)         }
+  {  - fmShareExclusive (get exclusive lock)         }
+  if ((Mode and fmShareDenyWrite)<>0) or
+     ((Mode and fmShareExclusive)<>0) then
+    begin
+      lock.l_whence := SEEK_SET;
+      lock.l_start := 0; { from stat of file    }
+      lock.l_len := 0;   { to END of file       }
+      lock.l_type := F_WRLCK;  { exclusive lock }
+      if sys_fcntl(FileHandle, F_SETLK, @lock)=-1 then
+        begin
+          sys_close(FileHandel);
+          FileOpen := -1;
+          exit;
+        end;
+    end;
+*)
+end;
+
+
+Function FileCreate (Const FileName : String) : Longint;
+
+begin
+  FileCreate:=sys_Open(pchar(FileName),O_RDWR or O_CREAT or O_TRUNC,MODE_OPEN);
+end;
+
+
+Function FileRead (Handle : Longint; Var Buffer; Count : longint) : Longint;
+
+begin
+  repeat
+    FileRead:=sys_read(Handle,pchar(@Buffer),Count);
+  until ErrNo<>Sys_EINTR;
+  If FileRead = -1 then
+    FileRead := 0;
+end;
+
+
+Function FileWrite (Handle : Longint; const Buffer; Count : Longint) : Longint;
+
+begin
+  repeat
+    FileWrite:=sys_write(Handle,pchar(@Buffer),Count);
+  until ErrNo<>Sys_EINTR;
+  if FileWrite = -1 then
+    FileWrite := 0;
+end;
+
+
+Function FileSeek (Handle,FOffset,Origin : Longint) : Longint;
+var
+ whence : cint;
+begin
+  FileSeek := -1;
+  case Origin of
+  { from beginning of file }
+  0 :  whence := SEEK_SET;
+  { from current position }
+  1 :  whence := SEEK_CUR;
+  { from end of file       }
+  2 :  whence := SEEK_END;
+  else
+   exit;
+  end;
+  FileSeek := sys_lseek(Handle,FOffset,whence);
+  if errno <> 0 then
+   FileSeek := -1;
+end;
+
+
+Procedure FileClose (Handle : Longint);
+
+begin
+  sys_close(Handle);
+end;
+
+Function FileTruncate (Handle,Size: Longint) : boolean;
+
+begin
+  if sys_ftruncate(Handle,Size)=0 then
+    FileTruncate := true
+  else
+    FileTruncate := false;
+end;
+
+
+Function FileAge (Const FileName : String): Longint;
+
+var F: file;
+    Time: longint;
+begin
+   Assign(F,FileName);
+   Reset(F,1);
+   dos.GetFTime(F,Time);
+   Close(F);
+   FileAge := Time;
+end;
+
+
+Function FileExists (Const FileName : String) : Boolean;
+
+Var Info : Stat;
+
+begin
+  if sys_stat(pchar(filename),Info)<>0 then
+    FileExists := false
+  else
+    FileExists := true;
+end;
+
+
+Function UNIXToWinAttr (FN : Pchar; Const Info : Stat) : Longint;
+
+begin
+  Result:=faArchive;
+  If S_ISDIR(Info.st_mode) then
+    Result:=Result or faDirectory ;
+  If (FN[0]='.') and (not (FN[1] in [#0,'.']))  then
+    Result:=Result or faHidden;
+  if (info.st_mode and S_IWUSR)=0 then
+    Result:=Result or fareadonly;
+  If S_ISREG(Info.st_Mode) Then
+     Result:=Result or faSysFile;
+end;
+
+
+
+
+type 
+  PDOSSearchRec = ^SearchRec;
+
+Function FindFirst (Const Path : String; Attr : Longint; Var Rslt : TSearchRec) : Longint;
+
+Const
+  faSpecial = faHidden or faSysFile or faVolumeID or faDirectory;
+var
+  p : pDOSSearchRec;
+  dosattr: word;
+begin
+ dosattr:=0;
+ if Attr and faHidden <> 0 then
+   dosattr := dosattr or Hidden;
+ if Attr and faSysFile <> 0 then
+   dosattr := dosattr or SysFile;
+ if Attr and favolumeID <> 0 then
+   dosattr := dosattr or VolumeID;
+ if Attr and faDirectory <> 0 then
+   dosattr := dosattr or faDirectory;
+ New(p);
+ Rslt.FindHandle :=  THandle(p);
+ dos.FindFirst(path,dosattr,p^);
+ if DosError <> 0 then
+    begin
+      FindFirst := -1;
+    end
+ else
+   begin
+     Rslt.Name := p^.Name;
+     Rslt.Time := p^.Time;
+     Rslt.Attr := p^.Attr;
+     Rslt.ExcludeAttr := not p^.Attr;
+     Rslt.Size := p^.Size;
+     FindFirst := 0;
+   end;   
+end;
+
+
+Function FindNext (Var Rslt : TSearchRec) : Longint;
+var
+ p : pDOSSearchRec;
+begin
+  p:= PDOsSearchRec(Rslt.FindHandle);
+  if not assigned(p) then
+     begin
+       FindNext := -1;
+       exit;
+     end;
+  Dos.FindNext(p^);
+ if DosError <> 0 then
+    begin
+      FindNext := -1;
+    end
+ else
+   begin
+     Rslt.Name := p^.Name;
+     Rslt.Time := p^.Time;
+     Rslt.Attr := p^.Attr;
+     Rslt.ExcludeAttr := not p^.Attr;
+     Rslt.Size := p^.Size;
+     FindNext := 0;
+   end;     
+end;
+
+
+Procedure FindClose (Var F : TSearchrec);
+
+Var
+  p : PDOSSearchRec;
+
+begin
+  p:=PDOSSearchRec(f.FindHandle); 
+  if not assigned(p) then
+       exit;
+  Dos.FindClose(p^);
+  if assigned(p) then
+     Dispose(p);
+  f.FindHandle := THandle(nil);
+end;
+
+Function FileGetDate (Handle : Longint) : Longint;
+
+Var Info : Stat;
+
+begin
+  If sys_FStat(Handle,Info)<>0 then
+    Result:=-1
+  else
+    Result:=Info.st_mtime;
+end;
+
+
+Function FileSetDate (Handle,Age : Longint) : Longint;
+
+begin
+  // Impossible under unix from FileHandle !!
+  FileSetDate:=-1;
+end;
+
+
+Function FileGetAttr (Const FileName : String) : Longint;
+
+Var Info : Stat;
+
+begin
+  If sys_stat (pchar(FileName),Info)<>0 then
+    Result:=-1
+  Else
+    Result:=UNIXToWinAttr(Pchar(FileName),Info);
+end;
+
+
+Function FileSetAttr (Const Filename : String; Attr: longint) : Longint;
+
+begin
+  Result:=-1;
+end;
+
+
+Function DeleteFile (Const FileName : String) : Boolean;
+begin
+  if sys_unlink(pchar(FileName))=0 then
+    DeleteFile := true
+  else
+    DeleteFile := false;
+end;
+
+Function RenameFile (Const OldName, NewName : String) : Boolean;
+
+begin
+  { you can directly typecast and ansistring to a pchar }
+  if sys_rename(pchar(OldName),pchar(NewName))=0 then
+    RenameFile := TRUE
+  else
+    RenameFile := FALSE;
+end;
+
+
+
+
+{****************************************************************************
+                              Disk Functions
+****************************************************************************}
+
+{
+  The Diskfree and Disksize functions need a file on the specified drive, since this
+  is required for the statfs system call.
+  These filenames are set in drivestr[0..26], and have been preset to :
+   0 - '.'      (default drive - hence current dir is ok.)
+   1 - '/fd0/.'  (floppy drive 1 - should be adapted to local system )
+   2 - '/fd1/.'  (floppy drive 2 - should be adapted to local system )
+   3 - '/'       (C: equivalent of dos is the root partition)
+   4..26          (can be set by you're own applications)
+  ! Use AddDisk() to Add new drives !
+  They both return -1 when a failure occurs.
+}
+Const
+  FixDriveStr : array[0..3] of pchar=(
+    '.',
+    '/fd0/.',
+    '/fd1/.',
+    '/.'
+    );
+var
+  Drives   : byte;
+  DriveStr : array[4..26] of pchar;
+
+Procedure AddDisk(const path:string);
+begin
+  if not (DriveStr[Drives]=nil) then
+   FreeMem(DriveStr[Drives],StrLen(DriveStr[Drives])+1);
+  GetMem(DriveStr[Drives],length(Path)+1);
+  StrPCopy(DriveStr[Drives],path);
+  inc(Drives);
+  if Drives>26 then
+   Drives:=4;
+end;
+
+
+
+Function DiskFree(Drive: Byte): int64;
+Begin
+  DiskFree := dos.diskFree(Drive);
+End;
+
+
+
+Function DiskSize(Drive: Byte): int64;
+Begin
+  DiskSize := dos.DiskSize(Drive);
+End;
+
+
+
+
+Function GetCurrentDir : String;
+begin
+  GetDir (0,Result);
+end;
+
+
+Function SetCurrentDir (Const NewDir : String) : Boolean;
+begin
+   ChDir(NewDir);
+  result := (IOResult = 0);
+end;
+
+
+Function CreateDir (Const NewDir : String) : Boolean;
+begin
+   MkDir(NewDir);
+  result := (IOResult = 0);
+end;
+
+
+Function RemoveDir (Const Dir : String) : Boolean;
+begin
+   RmDir(Dir);
+  result := (IOResult = 0);
+end;
+
+
+{****************************************************************************
+                              Misc Functions
+****************************************************************************}
+
+procedure Beep;
+begin
+end;
+
+
+{****************************************************************************
+                              Locale Functions
+****************************************************************************}
+
+Procedure GetLocalTime(var SystemTime: TSystemTime);
+var
+ dayOfWeek: word;
+begin
+  dos.GetTime(SystemTime.Hour, SystemTime.Minute, SystemTime.Second,SystemTime.Millisecond);
+  dos.GetDate(SystemTime.Year, SystemTime.Month, SystemTime.Day, DayOfWeek);
+end ;
+
+
+Procedure InitAnsi;
+Var
+  i : longint;
+begin
+  {  Fill table entries 0 to 127  }
+  for i := 0 to 96 do
+    UpperCaseTable[i] := chr(i);
+  for i := 97 to 122 do
+    UpperCaseTable[i] := chr(i - 32);
+  for i := 123 to 191 do
+    UpperCaseTable[i] := chr(i);
+  Move (CPISO88591UCT,UpperCaseTable[192],SizeOf(CPISO88591UCT));
+
+  for i := 0 to 64 do
+    LowerCaseTable[i] := chr(i);
+  for i := 65 to 90 do
+    LowerCaseTable[i] := chr(i + 32);
+  for i := 91 to 191 do
+    LowerCaseTable[i] := chr(i);
+  Move (CPISO88591LCT,UpperCaseTable[192],SizeOf(CPISO88591UCT));
+end;
+
+
+Procedure InitInternational;
+begin
+  InitAnsi;
+end;
+
+function SysErrorMessage(ErrorCode: Integer): String;
+
+begin
+{  Result:=StrError(ErrorCode);}
+end;
+
+{****************************************************************************
+                              OS utility functions
+****************************************************************************}
+
+Function GetEnvironmentVariable(Const EnvVar : String) : String;
+
+begin
+  Result:=Dos.Getenv(shortstring(EnvVar));
+end;
+
+
+{****************************************************************************
+                              Initialization code
+****************************************************************************}
+
+Initialization
+  InitExceptions;       { Initialize exceptions. OS independent }
+  InitInternational;    { Initialize internationalization settings }
+Finalization
+  DoneExceptions;
+end.
+{
+    $Log$
+    Revision 1.2  2002-08-10 13:42:36  marco
+     * Fixes Posix dir copied to devel branch
+
+    Revision 1.1.2.5  2002/04/28 07:28:43  carl
+    * some cleanup
+
+    Revision 1.1.2.4  2002/03/03 08:47:37  carl
+    + FindFirst / FindNext implemented
+
+    Revision 1.1.2.3  2002/01/22 07:41:11  michael
+    + Fixed FileSearch bug in Win32 and made FIleSearch platform independent
+
+    Revision 1.1.2.2  2001/09/29 20:16:53  carl
+    * bugfix of read/write wrong address was passed as parameter
+
+    Revision 1.1.2.1  2001/08/15 01:07:07  carl
+    + first version of sysutils
+
+
+}

rtl/posix/timezone.inc

@@ -0,0 +1,442 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2002 by the Free Pascal development team.
+
+    Timezone extraction routines 
+    
+    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
+  TZ_MAGIC = 'TZif';
+
+type
+  plongint=^longint;
+  pbyte=^byte;
+
+  ttzhead=packed record
+    tzh_magic : array[0..3] of char;
+    tzh_reserved : array[1..16] of byte;
+    tzh_ttisgmtcnt,
+    tzh_ttisstdcnt,
+    tzh_leapcnt,
+    tzh_timecnt,
+    tzh_typecnt,
+    tzh_charcnt  : longint;
+  end;
+
+  pttinfo=^tttinfo;
+  tttinfo=packed record
+    offset : longint;
+    isdst  : boolean;
+    idx    : byte;
+    isstd  : byte;
+    isgmt  : byte;
+  end;
+
+  pleap=^tleap;
+  tleap=record
+    transition : longint;
+    change     : longint;
+  end;
+
+var
+  num_transitions,
+  num_leaps,
+  num_types    : longint;
+
+  transitions  : plongint;
+  type_idxs    : pbyte;
+  types        : pttinfo;
+  zone_names   : pchar;
+  leaps        : pleap;
+
+function find_transition(timer:time_t):pttinfo;
+var
+  i : longint;
+begin
+  if (num_transitions=0) or (timer<time_t(transitions[0])) then
+   begin
+     i:=0;
+     while (i<num_types) and (types[i].isdst) do
+      inc(i);
+     if (i=num_types) then
+      i:=0;
+   end
+  else
+   begin
+     for i:=1 to num_transitions do
+      if (timer<transitions[i]) then
+       break;
+     i:=type_idxs[i-1];
+   end;
+  find_transition:=@types[i];
+end;
+
+
+procedure GetLocalTimezone(timer:time_t;var leap_correct,leap_hit:longint);
+var
+  info : pttinfo;
+  i    : longint;
+begin
+{ reset }
+  TZDaylight:=false;
+  TZSeconds:=0;
+  TZName[false]:=nil;
+  TZName[true]:=nil;
+  leap_correct:=0;
+  leap_hit:=0;
+{ get info }
+  info:=find_transition(timer);
+  if not assigned(info) then
+   exit;
+  TZDaylight:=info^.isdst;
+  TZSeconds:=info^.offset;
+  i:=0;
+  while (i<num_types) do
+   begin
+     tzname[types[i].isdst]:=@zone_names[types[i].idx];
+     inc(i);
+   end;
+  tzname[info^.isdst]:=@zone_names[info^.idx];
+  i:=num_leaps;
+  repeat
+    if i=0 then
+     exit;
+    dec(i);
+  until (timer>leaps[i].transition);
+  leap_correct:=leaps[i].change;
+  if (timer=leaps[i].transition) and
+     (((i=0) and (leaps[i].change>0)) or
+      (leaps[i].change>leaps[i-1].change)) then
+   begin
+     leap_hit:=1;
+     while (i>0) and
+           (leaps[i].transition=leaps[i-1].transition+1) and
+           (leaps[i].change=leaps[i-1].change+1) do
+      begin
+        inc(leap_hit);
+        dec(i);
+      end;
+   end;
+end;
+
+
+procedure GetLocalTimezone(timer:longint);
+var
+  lc,lh : longint;
+begin
+  GetLocalTimezone(timer,lc,lh);
+end;
+
+
+procedure ReadTimezoneFile(fn:string);
+
+  procedure decode(var l:longint);
+  var
+    k : longint;
+    p : pbyte;
+  begin
+    p:=pbyte(@l);
+    if (p[0] and (1 shl 7))<>0 then
+     k:=not 0
+    else
+     k:=0;
+    k:=(k shl 8) or p[0];
+    k:=(k shl 8) or p[1];
+    k:=(k shl 8) or p[2];
+    k:=(k shl 8) or p[3];
+    l:=k;
+  end;
+
+var
+  f      : File;
+  tzdir  : string;
+  tzhead : ttzhead;
+  i      : longint;
+  chars  : longint;
+  buf    : pbyte;
+  _result : longint;
+  label  lose;
+begin
+  if fn = '' then
+    exit;
+{$IFOPT I+}
+{$DEFINE IOCHECK_ON}
+{$ENDIF}
+{$I-}
+  Assign(F, fn);
+  Reset(F,1);
+  If IOResult <> 0 then
+   exit;
+{$IFDEF IOCHECK_ON}
+{$I+}
+{$ENDIF}
+{$UNDEF IOCHECK_ON}
+  BlockRead(f,tzhead,sizeof(tzhead),i);
+  if i<>sizeof(tzhead) then
+     goto lose;
+  if tzhead.tzh_magic<>TZ_MAGIC then
+  begin
+     goto lose;
+  end;
+  decode(tzhead.tzh_timecnt);
+  decode(tzhead.tzh_typecnt);
+  decode(tzhead.tzh_charcnt);
+  decode(tzhead.tzh_leapcnt);
+  decode(tzhead.tzh_ttisstdcnt);
+  decode(tzhead.tzh_ttisgmtcnt);
+
+  num_transitions:=tzhead.tzh_timecnt;
+  num_types:=tzhead.tzh_typecnt;
+  chars:=tzhead.tzh_charcnt;
+
+  reallocmem(transitions,num_transitions*sizeof(longint));
+  reallocmem(type_idxs,num_transitions);
+  reallocmem(types,num_types*sizeof(tttinfo));
+  reallocmem(zone_names,chars);
+  reallocmem(leaps,num_leaps*sizeof(tleap));
+
+  BlockRead(f,transitions^,num_transitions*4,_result);
+  if _result <> num_transitions*4 then
+  begin
+     goto lose;
+  end;
+  BlockRead(f,type_idxs^,num_transitions,_result);
+  if _result <> num_transitions then
+  begin
+    goto lose;
+  end;
+  {* Check for bogus indices in the data file, so we can hereafter
+     safely use type_idxs[T] as indices into `types' and never crash.  *}
+  for i := 0 to num_transitions-1 do
+    if (type_idxs[i] >= num_types) then
+    begin
+      goto lose;
+    end;
+
+
+  for i:=0 to num_transitions-1 do
+   decode(transitions[i]);
+
+  for i:=0 to num_types-1 do
+   begin
+     blockread(f,types[i].offset,4,_result);
+     if _result <> 4 then
+     begin
+      goto lose;
+     end;
+     blockread(f,types[i].isdst,1,_result);
+     if _result <> 1 then
+     begin
+      goto lose;
+     end;
+     blockread(f,types[i].idx,1,_result);
+     if _result <> 1 then
+     begin
+      goto lose;
+     end;
+     decode(types[i].offset);
+     types[i].isstd:=0;
+     types[i].isgmt:=0;
+   end;
+
+  blockread(f,zone_names^,chars,_result);
+  if _result<>chars then
+     begin
+      goto lose;
+     end;
+
+
+  for i:=0 to num_leaps-1 do
+   begin
+     blockread(f,leaps[i].transition,4);
+     if _result <> 4 then
+     begin
+      goto lose;
+     end;
+     blockread(f,leaps[i].change,4);
+     begin
+      goto lose;
+     end;
+     decode(leaps[i].transition);
+     decode(leaps[i].change);
+   end;
+
+  getmem(buf,tzhead.tzh_ttisstdcnt);
+  blockread(f,buf^,tzhead.tzh_ttisstdcnt,_result);
+  if _result<>tzhead.tzh_ttisstdcnt then
+     begin
+      goto lose;
+     end;
+  for i:=0 to tzhead.tzh_ttisstdcnt-1 do
+   types[i].isstd:=byte(buf[i]<>0);
+  freemem(buf);
+
+  getmem(buf,tzhead.tzh_ttisgmtcnt);
+  blockread(f,buf^,tzhead.tzh_ttisgmtcnt);
+  if _result<>tzhead.tzh_ttisgmtcnt then
+     begin
+      goto lose;
+     end;
+  for i:=0 to tzhead.tzh_ttisgmtcnt-1 do
+   types[i].isgmt:=byte(buf[i]<>0);
+  freemem(buf);
+  close(f);
+  exit;
+lose:
+  close(f);
+end;
+
+
+{ help function to extract TZ variable data }
+function extractnumberend(tzstr: string; offset : integer): integer;
+var
+ j: integer;
+begin
+ j:=0;
+ extractnumberend := 0;
+ repeat
+   if (offset+j) > length(tzstr) then
+     begin
+       exit;
+     end;
+  inc(j);
+ until not (tzstr[offset+j] in ['0'..'9']);
+ extractnumberend := offset+j;
+end;
+
+function getoffsetseconds(tzstr: string): longint;
+{ extract GMT timezone information }
+{ Returns the number of minutes to }
+{ add or subtract to the GMT time  }
+{ to get the local time.           }
+{ Format of TZ variable (POSIX)    }
+{  std offset dst                  }
+{  std = characters of timezone    }
+{  offset = hh[:mm] to add to GMT  }
+{  dst = daylight savings time     }
+{ CURRENTLY DOES NOT TAKE CARE     }
+{ OF SUMMER TIME DIFFERENCIAL      }
+var
+ s: string;
+ i, j: integer;
+ code : integer;
+ hours : longint;
+ minutes : longint;
+ negative : boolean;
+begin
+ hours:=0;
+ minutes:=0;
+ getoffsetseconds := 0;
+ negative := FALSE;
+ i:=-1;
+ { get to offset field }
+ repeat
+   if i > length(tzstr) then
+     begin
+       exit;
+     end;
+   inc(i);
+ until (tzstr[i] = '-') or (tzstr[i] in ['0'..'9']);
+ if tzstr[i] = '-' then
+  begin
+   Inc(i);
+   negative := TRUE;
+  end;
+ j:=extractnumberend(tzstr,i);
+ s:=copy(tzstr,i,j-i);
+ val(s,hours,code);
+ if code <> 0 then
+   begin
+     exit;
+   end;
+ if tzstr[j] = ':' then
+   begin
+     i:=j;
+     Inc(i);
+     j:=extractnumberend(tzstr,i);
+     s:=copy(tzstr,i,j-i);
+     val(s,minutes,code);
+     if code <> 0 then
+      begin
+        exit;
+      end;
+   end;
+ if negative then
+  begin
+    minutes := -minutes;
+    hours := -hours;
+  end;
+ getoffsetseconds := minutes*60 + hours*3600;
+end;
+
+
+procedure InitLocalTime;
+var
+ tloc: time_t;
+ s : string;
+begin
+  TZSeconds:=0;
+  { try to get the POSIX version  }
+  { of the local time offset      }
+  { if '', then it does not exist }
+  { if ': ..', then non-POSIX     }
+  s:=GetTimezoneString;
+  if (s<>'') and (s[1]<>':') then
+   begin
+     TZSeconds := getoffsetseconds(s);
+   end
+  else
+   begin
+     s:=GetTimeZoneFile;
+     { only read if there is something to read }
+     if s<>'' then
+     begin
+       ReadTimezoneFile(s);
+       tloc:=sys_time(tloc);
+       GetLocalTimezone(tloc);
+     end;
+   end;
+end;
+
+
+procedure DoneLocalTime;
+begin
+  if assigned(transitions) then
+   freemem(transitions);
+  if assigned(type_idxs) then
+   freemem(type_idxs);
+  if assigned(types) then
+   freemem(types);
+  if assigned(zone_names) then
+   freemem(zone_names);
+  if assigned(leaps) then
+   freemem(leaps);
+  num_transitions:=0;
+  num_leaps:=0;
+  num_types:=0;
+end;
+
+
+
+{
+  $Log$
+  Revision 1.2  2002-08-10 13:42:36  marco
+   * Fixes Posix dir copied to devel branch
+
+  Revision 1.1.2.2  2002/05/01 14:06:13  carl
+  * bugfix for stricter POSIX checking
+  + TZ is now taken from GetTimezoneSitrng instead of getenv
+
+  Revision 1.1.2.1  2001/08/12 15:13:50  carl
+  + first version of timezone stuff (more checking than the unix version)
+
+}