mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-16 10:19:17 +02:00
* Fixes Posix dir copied to devel branch
This commit is contained in:
marco
parent
c7aefd286b
commit
3c59d6dfb9
72
rtl/posix/errno.tem
Normal file
72
rtl/posix/errno.tem
Normal file
@ -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
|
||||||
|
|
||||||
|
}
|
||||||
139
rtl/posix/objinc.inc
Normal file
139
rtl/posix/objinc.inc
Normal file
@ -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
|
||||||
|
|
||||||
|
}
|
||||||
118
rtl/posix/osposix.tem
Normal file
118
rtl/posix/osposix.tem
Normal file
@ -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
|
||||||
|
|
||||||
|
}
|
||||||
133
rtl/posix/osposixh.tem
Normal file
133
rtl/posix/osposixh.tem
Normal file
@ -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
|
||||||
|
|
||||||
|
}
|
||||||
95
rtl/posix/posix.tem
Normal file
95
rtl/posix/posix.tem
Normal file
@ -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
|
||||||
|
|
||||||
|
}
|
||||||
108
rtl/posix/readme.txt
Normal file
108
rtl/posix/readme.txt
Normal file
@ -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;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
67
rtl/posix/signal.tem
Normal file
67
rtl/posix/signal.tem
Normal file
@ -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
|
||||||
|
|
||||||
|
|
||||||
|
}
|
||||||
652
rtl/posix/sysposix.inc
Normal file
652
rtl/posix/sysposix.inc
Normal file
@ -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
|
||||||
|
|
||||||
|
}
|
||||||
555
rtl/posix/sysutils.pp
Normal file
555
rtl/posix/sysutils.pp
Normal file
@ -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
|
||||||
|
|
||||||
|
|
||||||
|
}
|
||||||
442
rtl/posix/timezone.inc
Normal file
442
rtl/posix/timezone.inc
Normal file
@ -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)
|
||||||
|
|
||||||
|
}
|
||||||
Loading…
Reference in New Issue
Block a user