mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-17 06:39:38 +02:00
* moved to unix
This commit is contained in:
peter
parent
10f7de490e
commit
2808b3acea
@ -87,22 +87,12 @@ end;
|
||||
{$I ossysc.inc}
|
||||
{$I osmain.inc}
|
||||
|
||||
const
|
||||
{ Default creation mode for directories and files }
|
||||
|
||||
{ read/write permission for everyone }
|
||||
MODE_OPEN = S_IWUSR OR S_IRUSR OR
|
||||
S_IWGRP OR S_IRGRP OR
|
||||
S_IWOTH OR S_IROTH;
|
||||
{ read/write search permission for everyone }
|
||||
MODE_MKDIR = MODE_OPEN OR
|
||||
S_IXUSR OR S_IXGRP OR S_IXOTH;
|
||||
|
||||
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.2 2005-02-06 13:06:20 peter
|
||||
Revision 1.3 2005-02-07 22:04:55 peter
|
||||
* moved to unix
|
||||
|
||||
Revision 1.2 2005/02/06 13:06:20 peter
|
||||
* moved file and dir functions to sysfile/sysdir
|
||||
* win32 thread in systemunit
|
||||
|
||||
|
||||
@ -1,157 +0,0 @@
|
||||
{
|
||||
$Id$
|
||||
This file is part of the Free Pascal run time library.
|
||||
|
||||
POSIX Interface to the system unit
|
||||
|
||||
See the file COPYING.FPC, included in this distribution,
|
||||
for details about the copyright.
|
||||
|
||||
This is the core of the system unit *nix systems (now FreeBSD
|
||||
and Unix).
|
||||
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
||||
|
||||
**********************************************************************}
|
||||
|
||||
{*****************************************************************************
|
||||
Directory Handling
|
||||
*****************************************************************************}
|
||||
|
||||
Procedure MkDir(Const s: String);[IOCheck];
|
||||
Var
|
||||
Buffer: Array[0..255] of Char;
|
||||
Begin
|
||||
If (s='') or (InOutRes <> 0) then
|
||||
exit;
|
||||
Move(s[1], Buffer, Length(s));
|
||||
Buffer[Length(s)] := #0;
|
||||
If Fpmkdir(@buffer, MODE_MKDIR)<0 Then
|
||||
Errno2Inoutres
|
||||
Else
|
||||
InOutRes:=0;
|
||||
End;
|
||||
|
||||
Procedure RmDir(Const s: String);[IOCheck];
|
||||
Var
|
||||
Buffer: Array[0..255] of Char;
|
||||
Begin
|
||||
if (s = '.') then
|
||||
InOutRes := 16;
|
||||
If (s='') or (InOutRes <> 0) then
|
||||
exit;
|
||||
Move(s[1], Buffer, Length(s));
|
||||
Buffer[Length(s)] := #0;
|
||||
If Fprmdir(@buffer)<0 Then
|
||||
Errno2Inoutres
|
||||
Else
|
||||
InOutRes:=0;
|
||||
End;
|
||||
|
||||
|
||||
Procedure ChDir(Const s: String);[IOCheck];
|
||||
Var
|
||||
Buffer: Array[0..255] of Char;
|
||||
Begin
|
||||
If (s='') or (InOutRes <> 0) then
|
||||
exit;
|
||||
Move(s[1], Buffer, Length(s));
|
||||
Buffer[Length(s)] := #0;
|
||||
If Fpchdir(@buffer)<0 Then
|
||||
Errno2Inoutres
|
||||
Else
|
||||
InOutRes:=0;
|
||||
{ file not exists is path not found under tp7 }
|
||||
if InOutRes=2 then
|
||||
InOutRes:=3;
|
||||
End;
|
||||
|
||||
procedure getdir(drivenr : byte;var dir : shortstring);
|
||||
var
|
||||
{$ifndef usegetcwd}
|
||||
cwdinfo : stat;
|
||||
rootinfo : stat;
|
||||
thedir,dummy : string[255];
|
||||
dirstream : pdir;
|
||||
d : pdirent;
|
||||
name : string[255];
|
||||
thisdir : stat;
|
||||
tmp : string[255];
|
||||
{$else}
|
||||
tmp : array[0..4095] of char;
|
||||
{$endif}
|
||||
|
||||
begin
|
||||
{$ifdef usegetcwd}
|
||||
if Fpgetcwd(@tmp,10240+512)<>NIL then
|
||||
dir:=pchar(@tmp)
|
||||
else
|
||||
begin
|
||||
dir:='';
|
||||
writeln(geterrno);
|
||||
end;
|
||||
{$else}
|
||||
dir:='';
|
||||
thedir:='';
|
||||
dummy:='';
|
||||
|
||||
{ get root directory information }
|
||||
tmp := '/'+#0;
|
||||
if Fpstat(@tmp[1],rootinfo)<0 then
|
||||
Exit;
|
||||
repeat
|
||||
tmp := dummy+'.'+#0;
|
||||
{ get current directory information }
|
||||
if Fpstat(@tmp[1],cwdinfo)<0 then
|
||||
Exit;
|
||||
tmp:=dummy+'..'+#0;
|
||||
{ open directory stream }
|
||||
{ try to find the current inode number of the cwd }
|
||||
dirstream:=Fpopendir(@tmp[1]);
|
||||
if dirstream=nil then
|
||||
exit;
|
||||
repeat
|
||||
name:='';
|
||||
d:=Fpreaddir(dirstream);
|
||||
{ no more entries to read ... }
|
||||
if not assigned(d) then
|
||||
break;
|
||||
tmp:=dummy+'../'+strpas(d^.d_name) + #0;
|
||||
if (Fpstat(@tmp[1],thisdir)=0) then
|
||||
begin
|
||||
{ found the entry for this directory name }
|
||||
if (cwdinfo.st_dev=thisdir.st_dev) and (cwdinfo.st_ino=thisdir.st_ino) then
|
||||
begin
|
||||
{ are the filenames of type '.' or '..' ? }
|
||||
{ then do not set the name. }
|
||||
if (not ((d^.d_name[0]='.') and ((d^.d_name[1]=#0) or
|
||||
((d^.d_name[1]='.') and (d^.d_name[2]=#0))))) then
|
||||
name:='/'+strpas(d^.d_name);
|
||||
end;
|
||||
end;
|
||||
until (name<>'');
|
||||
If Fpclosedir(dirstream)<0 THen
|
||||
Exit;
|
||||
thedir:=name+thedir;
|
||||
dummy:=dummy+'../';
|
||||
if ((cwdinfo.st_dev=rootinfo.st_dev) and (cwdinfo.st_ino=rootinfo.st_ino)) then
|
||||
begin
|
||||
if thedir='' then
|
||||
dir:='/'
|
||||
else
|
||||
dir:=thedir;
|
||||
exit;
|
||||
end;
|
||||
until false;
|
||||
{$endif}
|
||||
end;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.1 2005-02-06 13:06:20 peter
|
||||
* moved file and dir functions to sysfile/sysdir
|
||||
* win32 thread in systemunit
|
||||
|
||||
}
|
||||
@ -1,230 +0,0 @@
|
||||
{
|
||||
$Id$
|
||||
This file is part of the Free Pascal run time library.
|
||||
|
||||
POSIX Interface to the system unit
|
||||
|
||||
See the file COPYING.FPC, included in this distribution,
|
||||
for details about the copyright.
|
||||
|
||||
This is the core of the system unit *nix systems (now FreeBSD
|
||||
and Unix).
|
||||
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
||||
|
||||
**********************************************************************}
|
||||
|
||||
|
||||
Procedure Do_Close(Handle:thandle);
|
||||
Begin
|
||||
Fpclose(cint(Handle));
|
||||
End;
|
||||
|
||||
|
||||
Procedure Do_Erase(p:pchar);
|
||||
var
|
||||
fileinfo : stat;
|
||||
Begin
|
||||
{ verify if the filename is actually a directory }
|
||||
{ if so return error and do nothing, as defined }
|
||||
{ by POSIX }
|
||||
if Fpstat(p,fileinfo)<0 then
|
||||
begin
|
||||
Errno2Inoutres;
|
||||
exit;
|
||||
end;
|
||||
if FpS_ISDIR(fileinfo.st_mode) then
|
||||
begin
|
||||
InOutRes := 2;
|
||||
exit;
|
||||
end;
|
||||
if Fpunlink(p)<0 then
|
||||
Errno2Inoutres
|
||||
Else
|
||||
InOutRes:=0;
|
||||
End;
|
||||
|
||||
{ truncate at a given position }
|
||||
procedure do_truncate (handle:thandle;fpos:longint);
|
||||
begin
|
||||
{ should be simulated in cases where it is not }
|
||||
{ available. }
|
||||
If Fpftruncate(handle,fpos)<0 Then
|
||||
Errno2Inoutres
|
||||
Else
|
||||
InOutRes:=0;
|
||||
end;
|
||||
|
||||
|
||||
Procedure Do_Rename(p1,p2:pchar);
|
||||
Begin
|
||||
If Fprename(p1,p2)<0 Then
|
||||
Errno2Inoutres
|
||||
Else
|
||||
InOutRes:=0;
|
||||
End;
|
||||
|
||||
|
||||
Function Do_Write(Handle:thandle;Addr:Pointer;Len:SizeInt):SizeInt;
|
||||
Begin
|
||||
repeat
|
||||
Do_Write:=Fpwrite(Handle,addr,len);
|
||||
until (Do_Write>=0) or (getErrNo<>ESysEINTR);
|
||||
If Do_Write<0 Then
|
||||
Begin
|
||||
Errno2InOutRes;
|
||||
Do_Write:=0;
|
||||
End
|
||||
else
|
||||
InOutRes:=0;
|
||||
End;
|
||||
|
||||
|
||||
Function Do_Read(Handle:thandle;Addr:Pointer;Len:SizeInt):SizeInt;
|
||||
Begin
|
||||
repeat
|
||||
Do_Read:=Fpread(Handle,addr,len);
|
||||
until (Do_Read>=0) or (getErrNo<>ESysEINTR);
|
||||
If Do_Read<0 Then
|
||||
Begin
|
||||
Errno2InOutRes;
|
||||
Do_Read:=0;
|
||||
End
|
||||
else
|
||||
InOutRes:=0;
|
||||
End;
|
||||
|
||||
|
||||
function Do_FilePos(Handle: thandle):longint;
|
||||
Begin
|
||||
do_FilePos:=Fplseek(Handle, 0, SEEK_CUR);
|
||||
If Do_FilePos<0 Then
|
||||
Errno2InOutRes
|
||||
else
|
||||
InOutRes:=0;
|
||||
End;
|
||||
|
||||
|
||||
Procedure Do_Seek(Handle:thandle;Pos:Longint);
|
||||
Begin
|
||||
If Fplseek(Handle, pos, SEEK_SET)<0 Then
|
||||
Errno2Inoutres
|
||||
Else
|
||||
InOutRes:=0;
|
||||
End;
|
||||
|
||||
|
||||
Function Do_SeekEnd(Handle:thandle): Longint;
|
||||
begin
|
||||
Do_SeekEnd:=Fplseek(Handle,0,SEEK_END);
|
||||
If Do_SeekEnd<0 Then
|
||||
Errno2Inoutres
|
||||
Else
|
||||
InOutRes:=0;
|
||||
end;
|
||||
|
||||
|
||||
Function Do_FileSize(Handle:thandle): Longint;
|
||||
var
|
||||
Info : Stat;
|
||||
Ret : Longint;
|
||||
Begin
|
||||
Ret:=Fpfstat(handle,info);
|
||||
If Ret=0 Then
|
||||
Do_FileSize:=Info.st_size
|
||||
else
|
||||
Do_FileSize:=0;
|
||||
If Ret<0 Then
|
||||
Errno2InOutRes
|
||||
Else
|
||||
InOutRes:=0;
|
||||
End;
|
||||
|
||||
|
||||
Procedure Do_Open(var f;p:pchar;flags:longint);
|
||||
{
|
||||
FileRec and textrec have both Handle and mode as the first items so
|
||||
they could use the same routine for opening/creating.
|
||||
when (flags and $100) the file will be append
|
||||
when (flags and $1000) the file will be truncate/rewritten
|
||||
when (flags and $10000) there is no check for close (needed for textfiles)
|
||||
}
|
||||
var
|
||||
oflags : cint;
|
||||
Begin
|
||||
{ close first if opened }
|
||||
if ((flags and $10000)=0) then
|
||||
begin
|
||||
case FileRec(f).mode of
|
||||
fminput,fmoutput,fminout : Do_Close(FileRec(f).Handle);
|
||||
fmclosed : ;
|
||||
else
|
||||
begin
|
||||
inoutres:=102; {not assigned}
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
{ reset file Handle }
|
||||
FileRec(f).Handle:=UnusedHandle;
|
||||
{ We do the conversion of filemodes here, concentrated on 1 place }
|
||||
case (flags and 3) of
|
||||
0 : begin
|
||||
oflags :=O_RDONLY;
|
||||
FileRec(f).mode:=fminput;
|
||||
end;
|
||||
1 : begin
|
||||
oflags :=O_WRONLY;
|
||||
FileRec(f).mode:=fmoutput;
|
||||
end;
|
||||
2 : begin
|
||||
oflags :=O_RDWR;
|
||||
FileRec(f).mode:=fminout;
|
||||
end;
|
||||
end;
|
||||
if (flags and $1000)=$1000 then
|
||||
oflags:=oflags or (O_CREAT or O_TRUNC)
|
||||
else
|
||||
if (flags and $100)=$100 then
|
||||
oflags:=oflags or (O_APPEND);
|
||||
{ empty name is special }
|
||||
if p[0]=#0 then
|
||||
begin
|
||||
case FileRec(f).mode of
|
||||
fminput :
|
||||
FileRec(f).Handle:=StdInputHandle;
|
||||
fminout, { this is set by rewrite }
|
||||
fmoutput :
|
||||
FileRec(f).Handle:=StdOutputHandle;
|
||||
fmappend :
|
||||
begin
|
||||
FileRec(f).Handle:=StdOutputHandle;
|
||||
FileRec(f).mode:=fmoutput; {fool fmappend}
|
||||
end;
|
||||
end;
|
||||
exit;
|
||||
end;
|
||||
{ real open call }
|
||||
FileRec(f).Handle:=Fpopen(p,oflags,MODE_OPEN);
|
||||
if (FileRec(f).Handle<0) and
|
||||
(getErrNo=ESysEROFS) and
|
||||
((OFlags and O_RDWR)<>0) then
|
||||
begin
|
||||
Oflags:=Oflags and not(O_RDWR);
|
||||
FileRec(f).Handle:=Fpopen(p,oflags,MODE_OPEN);
|
||||
end;
|
||||
If Filerec(f).Handle<0 Then
|
||||
Errno2Inoutres
|
||||
else
|
||||
InOutRes:=0;
|
||||
End;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.1 2005-02-06 13:06:20 peter
|
||||
* moved file and dir functions to sysfile/sysdir
|
||||
* win32 thread in systemunit
|
||||
|
||||
}
|
||||
@ -1,53 +0,0 @@
|
||||
{
|
||||
$Id$
|
||||
This file is part of the Free Pascal run time library.
|
||||
Copyright (c) 2001 by Free Pascal development team
|
||||
|
||||
This file implements all the base types and limits required
|
||||
for a minimal POSIX compliant subset required to port the compiler
|
||||
to a new OS.
|
||||
|
||||
See the file COPYING.FPC, included in this distribution,
|
||||
for details about the copyright.
|
||||
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
||||
|
||||
**********************************************************************}
|
||||
|
||||
|
||||
{*****************************************************************************
|
||||
OS Memory allocation / deallocation
|
||||
****************************************************************************}
|
||||
|
||||
function SysOSAlloc(size: ptrint): pointer;
|
||||
begin
|
||||
result:=Fpmmap(nil,Size,3,MAP_PRIVATE+MAP_ANONYMOUS,-1,0);
|
||||
if result=pointer(-1) then
|
||||
result:=nil
|
||||
else
|
||||
seterrno(0);
|
||||
end;
|
||||
|
||||
{$define HAS_SYSOSFREE}
|
||||
|
||||
procedure SysOSFree(p: pointer; size: ptrint);
|
||||
begin
|
||||
fpmunmap(p, size);
|
||||
end;
|
||||
|
||||
|
||||
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.2 2005-02-06 12:16:52 peter
|
||||
* bsd thread updates
|
||||
|
||||
Revision 1.1 2005/02/06 11:20:52 peter
|
||||
* threading in system unit
|
||||
* removed systhrds unit
|
||||
|
||||
}
|
||||
|
||||
@ -77,20 +77,13 @@ function fpgetcwd(buf:pchar;_size:size_t):pchar; cdecl; external name 'getcwd';
|
||||
{$I ossysc.inc} // base syscalls
|
||||
{$I osmain.inc} // base wrappers *nix RTL (derivatives)
|
||||
|
||||
const
|
||||
{ read/write permission for everyone }
|
||||
MODE_OPEN = S_IWUSR OR S_IRUSR OR
|
||||
S_IWGRP OR S_IRGRP OR
|
||||
S_IWOTH OR S_IROTH;
|
||||
{ read/write search permission for everyone }
|
||||
MODE_MKDIR = MODE_OPEN OR
|
||||
S_IXUSR OR S_IXGRP OR S_IXOTH;
|
||||
|
||||
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.2 2005-02-06 13:06:20 peter
|
||||
Revision 1.3 2005-02-07 22:04:55 peter
|
||||
* moved to unix
|
||||
|
||||
Revision 1.2 2005/02/06 13:06:20 peter
|
||||
* moved file and dir functions to sysfile/sysdir
|
||||
* win32 thread in systemunit
|
||||
|
||||
|
||||
@ -20,6 +20,12 @@
|
||||
*****************************************************************************}
|
||||
|
||||
Procedure MkDir(Const s: String);[IOCheck];
|
||||
const
|
||||
{ read/write search permission for everyone }
|
||||
MODE_MKDIR = S_IWUSR OR S_IRUSR OR
|
||||
S_IWGRP OR S_IRGRP OR
|
||||
S_IWOTH OR S_IROTH OR
|
||||
S_IXUSR OR S_IXGRP OR S_IXOTH;
|
||||
Var
|
||||
Buffer: Array[0..255] of Char;
|
||||
Begin
|
||||
@ -145,7 +151,10 @@ end;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.1 2005-02-06 13:06:20 peter
|
||||
Revision 1.1 2005-02-07 22:04:55 peter
|
||||
* moved to unix
|
||||
|
||||
Revision 1.1 2005/02/06 13:06:20 peter
|
||||
* moved file and dir functions to sysfile/sysdir
|
||||
* win32 thread in systemunit
|
||||
|
||||
@ -14,7 +14,6 @@
|
||||
|
||||
**********************************************************************}
|
||||
|
||||
|
||||
Procedure Do_Close(Handle:thandle);
|
||||
Begin
|
||||
Fpclose(cint(Handle));
|
||||
@ -151,6 +150,11 @@ Procedure Do_Open(var f;p:pchar;flags:longint);
|
||||
when (flags and $1000) the file will be truncate/rewritten
|
||||
when (flags and $10000) there is no check for close (needed for textfiles)
|
||||
}
|
||||
const
|
||||
{ read/write permission for everyone }
|
||||
MODE_OPEN = S_IWUSR OR S_IRUSR OR
|
||||
S_IWGRP OR S_IRGRP OR
|
||||
S_IWOTH OR S_IROTH;
|
||||
var
|
||||
oflags : cint;
|
||||
Begin
|
||||
@ -223,7 +227,10 @@ End;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.1 2005-02-06 13:06:20 peter
|
||||
Revision 1.1 2005-02-07 22:04:55 peter
|
||||
* moved to unix
|
||||
|
||||
Revision 1.1 2005/02/06 13:06:20 peter
|
||||
* moved file and dir functions to sysfile/sysdir
|
||||
* win32 thread in systemunit
|
||||
|
||||
@ -16,14 +16,9 @@
|
||||
|
||||
**********************************************************************}
|
||||
|
||||
|
||||
{*****************************************************************************
|
||||
OS Memory allocation / deallocation
|
||||
****************************************************************************}
|
||||
|
||||
function SysOSAlloc(size: ptrint): pointer;
|
||||
begin
|
||||
result:=Fpmmap(nil,cardinal(Size),3,MAP_PRIVATE+MAP_ANONYMOUS,-1,0);
|
||||
result:=Fpmmap(nil,Size,3,MAP_PRIVATE+MAP_ANONYMOUS,-1,0);
|
||||
if result=pointer(-1) then
|
||||
result:=nil
|
||||
else
|
||||
@ -39,11 +34,17 @@ end;
|
||||
|
||||
|
||||
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.1 2005-02-06 12:16:52 peter
|
||||
* bsd thread updates
|
||||
Revision 1.1 2005-02-07 22:04:55 peter
|
||||
* moved to unix
|
||||
|
||||
Revision 1.1 2005/02/06 16:57:18 peter
|
||||
* threads for go32v2,os,emx,netware
|
||||
|
||||
Revision 1.1 2005/02/06 13:06:20 peter
|
||||
* moved file and dir functions to sysfile/sysdir
|
||||
* win32 thread in systemunit
|
||||
|
||||
}
|
||||
|
||||
Loading…
Reference in New Issue
Block a user