|
@@ -1,865 +0,0 @@
|
|
|
-{
|
|
|
- $Id$
|
|
|
- This file is part of the Free Pascal run time library.
|
|
|
- Copyright (c) 1999-2000 by Michael Van Canneyt,
|
|
|
- member of the Free Pascal development team.
|
|
|
-
|
|
|
- This is the core of the system unit *nix systems (now FreeBSD
|
|
|
- and Unix).
|
|
|
-
|
|
|
- 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.
|
|
|
-
|
|
|
- **********************************************************************}
|
|
|
-
|
|
|
-{ These things are set in the makefile, }
|
|
|
-{ But you can override them here.}
|
|
|
-
|
|
|
-{ If you use an aout system, set the conditional AOUT}
|
|
|
-{ $Define AOUT}
|
|
|
-
|
|
|
-{$I system.inc}
|
|
|
-
|
|
|
-{ used in syscall to report errors.}
|
|
|
-var
|
|
|
- Errno : longint;
|
|
|
-
|
|
|
-{ Include constant and type definitions }
|
|
|
-{$i errno.inc } { Error numbers }
|
|
|
-{$i sysnr.inc } { System call numbers }
|
|
|
-{$i sysconst.inc } { Miscellaneous constants }
|
|
|
-{$i systypes.inc } { Types needed for system calls }
|
|
|
-
|
|
|
-{ Read actual system call definitions. }
|
|
|
-{$i signal.inc}
|
|
|
-{$i syscalls.inc }
|
|
|
-
|
|
|
-
|
|
|
-{*****************************************************************************
|
|
|
- Misc. System Dependent Functions
|
|
|
-*****************************************************************************}
|
|
|
-
|
|
|
-procedure prthaltproc;external name '_haltproc';
|
|
|
-
|
|
|
-Procedure System_exit;
|
|
|
-Begin
|
|
|
- prthaltproc;
|
|
|
-End;
|
|
|
-
|
|
|
-
|
|
|
-Function ParamCount: Longint;
|
|
|
-Begin
|
|
|
- Paramcount:=argc-1;
|
|
|
-End;
|
|
|
-
|
|
|
-
|
|
|
-Function ParamStr(l: Longint): String;
|
|
|
-var
|
|
|
- link,
|
|
|
- hs : string;
|
|
|
- i : longint;
|
|
|
-begin
|
|
|
- if l=0 then
|
|
|
- begin
|
|
|
- str(sys_getpid,hs);
|
|
|
- {$ifdef FreeBSD}
|
|
|
- hs:='/proc/'+hs+'/file'#0;
|
|
|
- {$else}
|
|
|
- hs:='/proc/'+hs+'/exe'#0;
|
|
|
- {$endif}
|
|
|
- i:=Sys_readlink(@hs[1],@link[1],high(link));
|
|
|
- { it must also be an absolute filename, linux 2.0 points to a memory
|
|
|
- location so this will skip that }
|
|
|
- if (i>0) and (link[1]='/') then
|
|
|
- begin
|
|
|
- link[0]:=chr(i);
|
|
|
- paramstr:=link;
|
|
|
- end
|
|
|
- else
|
|
|
- paramstr:=strpas(argv[0]);
|
|
|
- end
|
|
|
- else
|
|
|
- if (l>0) and (l<argc) then
|
|
|
- paramstr:=strpas(argv[l])
|
|
|
- else
|
|
|
- paramstr:='';
|
|
|
-end;
|
|
|
-
|
|
|
-
|
|
|
-Procedure Randomize;
|
|
|
-Begin
|
|
|
- randseed:=sys_time;
|
|
|
-End;
|
|
|
-
|
|
|
-
|
|
|
-{*****************************************************************************
|
|
|
- Heap Management
|
|
|
-*****************************************************************************}
|
|
|
-
|
|
|
-var
|
|
|
- _HEAP : pointer;external name 'HEAP';
|
|
|
- _HEAPSIZE : longint;external name 'HEAPSIZE';
|
|
|
-
|
|
|
-function getheapstart:pointer;assembler;
|
|
|
-{$undef fpc_getheapstart_ok}
|
|
|
-{$ifdef cpui386}
|
|
|
-{$define fpc_getheapstart_ok}
|
|
|
-asm
|
|
|
- leal _HEAP,%eax
|
|
|
-end ['EAX'];
|
|
|
-{$endif cpui386}
|
|
|
-{$ifdef cpum68k}
|
|
|
-{$define fpc_getheapstart_ok}
|
|
|
-asm
|
|
|
- lea.l _HEAP,a0
|
|
|
- move.l a0,d0
|
|
|
-end['A0','D0'];
|
|
|
-{$endif cpum68k}
|
|
|
-{$ifdef cpupowerpc}
|
|
|
-{$define fpc_getheapstart_ok}
|
|
|
-asm
|
|
|
- lis r3,HEAP@ha
|
|
|
- la r3,HEAP@l(r3)
|
|
|
-end['R3'];
|
|
|
-{$endif cpupowerpc}
|
|
|
-{$ifndef fpc_getheapstart_ok}
|
|
|
-asm
|
|
|
-end;
|
|
|
-{$error Getheapstart code is not implemented }
|
|
|
-{$endif not fpc_getheapstart_ok}
|
|
|
-
|
|
|
-
|
|
|
-function getheapsize:longint;assembler;
|
|
|
-{$undef fpc_getheapsize_ok}
|
|
|
-{$ifdef cpui386}
|
|
|
-{$define fpc_getheapsize_ok}
|
|
|
-asm
|
|
|
- movl _HEAPSIZE,%eax
|
|
|
-end ['EAX'];
|
|
|
-{$endif cpui386}
|
|
|
-{$ifdef cpum68k}
|
|
|
-{$define fpc_getheapsize_ok}
|
|
|
-asm
|
|
|
- move.l _HEAPSIZE,d0
|
|
|
-end ['D0'];
|
|
|
-{$endif cpum68k}
|
|
|
-{$ifdef cpupowerpc}
|
|
|
-{$define fpc_getheapsize_ok}
|
|
|
-asm
|
|
|
- lis r9,HEAPSIZE@ha
|
|
|
- lwz r3,HEAPSIZE@l(r9)
|
|
|
-end ['R0','R9'];
|
|
|
-{$endif cpupowerpc}
|
|
|
-{$ifndef fpc_getheapsize_ok}
|
|
|
-asm
|
|
|
-end;
|
|
|
-{$error Getheapsize code is not implemented }
|
|
|
-{$endif not fpc_getheapsize_ok}
|
|
|
-
|
|
|
-
|
|
|
-Function sbrk(size : longint) : pointer;
|
|
|
-var address:longint;
|
|
|
-begin
|
|
|
- address:=Sys_mmap(0,Size,3,MAP_PRIVATE+MAP_ANONYMOUS,-1,0);
|
|
|
- if addres=-1 then inc(address) else errno := 0;
|
|
|
- sbrk:=pointer(address);
|
|
|
-end;
|
|
|
-
|
|
|
-
|
|
|
-{ include standard heap management }
|
|
|
-{$I heap.inc}
|
|
|
-
|
|
|
-
|
|
|
-{*****************************************************************************
|
|
|
- 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;
|
|
|
- If errno<0 then Errno:=-errno;
|
|
|
- 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,
|
|
|
- Sys_ELOOP,
|
|
|
- Sys_ENOTDIR : Inoutres:=3;
|
|
|
- Sys_EROFS,
|
|
|
- Sys_EEXIST,
|
|
|
- Sys_EISDIR,
|
|
|
- Sys_ENOTEMPTY,
|
|
|
- Sys_EACCES,
|
|
|
- Sys_ETXTBSY : Inoutres:=5;
|
|
|
- else
|
|
|
- InOutRes := Integer(Errno);
|
|
|
- end;
|
|
|
-end;
|
|
|
-
|
|
|
-
|
|
|
-Procedure Do_Close(Handle:Longint);
|
|
|
-Begin
|
|
|
- sys_close(Handle);
|
|
|
- {Errno2Inoutres;}
|
|
|
-End;
|
|
|
-
|
|
|
-
|
|
|
-Procedure Do_Erase(p:pchar);
|
|
|
-{$ifdef BSD}
|
|
|
- var FileInfo : Stat;
|
|
|
-{$endif}
|
|
|
-
|
|
|
-Begin
|
|
|
- {$ifdef BSD} {or POSIX}
|
|
|
- { 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;
|
|
|
- {$ifdef BSD}
|
|
|
- if (fileinfo.mode and STAT_IFMT)=STAT_IFDIR then
|
|
|
- {$else}
|
|
|
- if s_ISDIR(fileinfo.st_mode) then
|
|
|
- {$endif}
|
|
|
- begin
|
|
|
- InOutRes := 2;
|
|
|
- exit;
|
|
|
- end;
|
|
|
- {$endif}
|
|
|
- sys_unlink(p);
|
|
|
- Errno2Inoutres;
|
|
|
- {$ifdef Linux}
|
|
|
- { tp compatible result }
|
|
|
- if (Errno=Sys_EISDIR) then
|
|
|
- InOutRes:=2;
|
|
|
- {$endif}
|
|
|
-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_Write(Handle,Addr,Len:Longint):longint;
|
|
|
-var
|
|
|
- total,
|
|
|
- res : longint;
|
|
|
-Begin
|
|
|
- total:=0;
|
|
|
- repeat
|
|
|
- res:=sys_write(Handle,pchar(pchar(addr)+total),len-total);
|
|
|
- if res>0 then
|
|
|
- inc(total,res);
|
|
|
- until ErrNo<>Sys_EINTR;
|
|
|
- Errno2Inoutres;
|
|
|
- if res<0 then
|
|
|
- Do_Write:=0
|
|
|
- else
|
|
|
- Do_Write:=total;
|
|
|
-End;
|
|
|
-
|
|
|
-
|
|
|
-Function Do_Read(Handle,Addr,Len:Longint):Longint;
|
|
|
-var
|
|
|
- total,
|
|
|
- res : longint;
|
|
|
-Begin
|
|
|
- total:=0;
|
|
|
- repeat
|
|
|
- res:=sys_read(Handle,pchar(pchar(addr)+total),len-total);
|
|
|
- if res>0 then
|
|
|
- inc(total,res);
|
|
|
- until ErrNo<>Sys_EINTR;
|
|
|
- Errno2Inoutres;
|
|
|
- if res<0 then
|
|
|
- Do_Read:=0
|
|
|
- else
|
|
|
- Do_Read:=total;
|
|
|
-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.Size
|
|
|
- else
|
|
|
- Do_FileSize:=0;
|
|
|
- Errno2Inoutres;
|
|
|
-End;
|
|
|
-
|
|
|
-
|
|
|
-Procedure Do_Truncate(Handle,fPos:longint);
|
|
|
-begin
|
|
|
- sys_ftruncate(handle,fpos);
|
|
|
- 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 : longint;
|
|
|
-
|
|
|
-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 :=Open_RDONLY;
|
|
|
- FileRec(f).mode:=fminput;
|
|
|
- end;
|
|
|
- 1 : begin
|
|
|
- oflags :=Open_WRONLY;
|
|
|
- FileRec(f).mode:=fmoutput;
|
|
|
- end;
|
|
|
- 2 : begin
|
|
|
- oflags :=Open_RDWR;
|
|
|
- FileRec(f).mode:=fminout;
|
|
|
- end;
|
|
|
- end;
|
|
|
- if (flags and $1000)=$1000 then
|
|
|
- oflags:=oflags or (Open_CREAT or Open_TRUNC)
|
|
|
- else
|
|
|
- if (flags and $100)=$100 then
|
|
|
- oflags:=oflags or (Open_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,438);
|
|
|
- if (ErrNo=Sys_EROFS) and ((OFlags and Open_RDWR)<>0) then
|
|
|
- begin
|
|
|
- Oflags:=Oflags and not(Open_RDWR);
|
|
|
- FileRec(f).Handle:=sys_open(p,oflags,438);
|
|
|
- end;
|
|
|
- Errno2Inoutres;
|
|
|
-End;
|
|
|
-
|
|
|
-
|
|
|
-Function Do_IsDevice(Handle:Longint):boolean;
|
|
|
-{
|
|
|
- Interface to Unix ioctl call.
|
|
|
- Performs various operations on the filedescriptor Handle.
|
|
|
- Ndx describes the operation to perform.
|
|
|
- Data points to data needed for the Ndx function. The structure of this
|
|
|
- data is function-dependent.
|
|
|
-}
|
|
|
-var
|
|
|
- Data : array[0..255] of byte; {Large enough for termios info}
|
|
|
-begin
|
|
|
- Do_IsDevice:=(sys_ioctl(handle,IOCTL_TCGETS,@data)<>-1);
|
|
|
-end;
|
|
|
-
|
|
|
-
|
|
|
-{*****************************************************************************
|
|
|
- UnTyped File Handling
|
|
|
-*****************************************************************************}
|
|
|
-
|
|
|
-{$i file.inc}
|
|
|
-
|
|
|
-{*****************************************************************************
|
|
|
- Typed File Handling
|
|
|
-*****************************************************************************}
|
|
|
-
|
|
|
-{$i typefile.inc}
|
|
|
-
|
|
|
-{*****************************************************************************
|
|
|
- Text File Handling
|
|
|
-*****************************************************************************}
|
|
|
-
|
|
|
-{$DEFINE SHORT_LINEBREAK}
|
|
|
-{$DEFINE EXTENDED_EOF}
|
|
|
-
|
|
|
-{$i text.inc}
|
|
|
-
|
|
|
-{*****************************************************************************
|
|
|
- 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, 511);
|
|
|
- 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);
|
|
|
- {$ifdef BSD}
|
|
|
- if (Errno=Sys_EINVAL) Then
|
|
|
- InOutRes:=5
|
|
|
- Else
|
|
|
- {$endif}
|
|
|
- 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
|
|
|
- thisdir : stat;
|
|
|
- rootino,
|
|
|
- thisino,
|
|
|
- dotdotino : longint;
|
|
|
- rootdev,
|
|
|
- thisdev,
|
|
|
- dotdotdev : dev_t;
|
|
|
- thedir,dummy : string[255];
|
|
|
- dirstream : pdir;
|
|
|
- d : pdirent;
|
|
|
- mountpoint,validdir : boolean;
|
|
|
- predot : string[255];
|
|
|
-begin
|
|
|
- drivenr:=0;
|
|
|
- dir:='';
|
|
|
- thedir:='/'#0;
|
|
|
- if sys_stat(@thedir[1],thisdir)<0 then
|
|
|
- exit;
|
|
|
- rootino:=thisdir.ino;
|
|
|
- rootdev:=thisdir.dev;
|
|
|
- thedir:='.'#0;
|
|
|
- if sys_stat(@thedir[1],thisdir)<0 then
|
|
|
- exit;
|
|
|
- thisino:=thisdir.ino;
|
|
|
- thisdev:=thisdir.dev;
|
|
|
- { Now we can uniquely identify the current and root dir }
|
|
|
- thedir:='';
|
|
|
- predot:='';
|
|
|
- while not ((thisino=rootino) and (thisdev=rootdev)) do
|
|
|
- begin
|
|
|
- { Are we on a mount point ? }
|
|
|
- dummy:=predot+'..'#0;
|
|
|
- if sys_stat(@dummy[1],thisdir)<0 then
|
|
|
- exit;
|
|
|
- dotdotino:=thisdir.ino;
|
|
|
- dotdotdev:=thisdir.dev;
|
|
|
- mountpoint:=(thisdev<>dotdotdev);
|
|
|
- { Now, Try to find the name of this dir in the previous one }
|
|
|
- dirstream:=opendir (@dummy[1]);
|
|
|
- if dirstream=nil then
|
|
|
- exit;
|
|
|
- repeat
|
|
|
- d:=sys_readdir (dirstream);
|
|
|
- validdir:=false;
|
|
|
- if (d<>nil) and
|
|
|
- (not ((d^.name[0]='.') and ((d^.name[1]=#0) or ((d^.name[1]='.')
|
|
|
- and (d^.name[2]=#0))))) and
|
|
|
- (mountpoint or (d^.ino=thisino)) then
|
|
|
- begin
|
|
|
- dummy:=predot+'../'+strpas(@(d^.name[0]))+#0;
|
|
|
- validdir:=not (sys_stat (@(dummy[1]),thisdir)<0);
|
|
|
- end
|
|
|
- else
|
|
|
- validdir:=false;
|
|
|
- until (d=nil) or
|
|
|
- ((validdir) and (thisdir.dev=thisdev) and (thisdir.ino=thisino) );
|
|
|
- { At this point, d.name contains the name of the current dir}
|
|
|
- if (d<>nil) then
|
|
|
- thedir:='/'+strpas(@(d^.name[0]))+thedir;
|
|
|
- { closedir also makes d invalid }
|
|
|
- if (closedir(dirstream)<0) or (d=nil) then
|
|
|
- exit;
|
|
|
- thisdev:=dotdotdev;
|
|
|
- thisino:=dotdotino;
|
|
|
- predot:=predot+'../';
|
|
|
- end;
|
|
|
-{ Now rootino=thisino and rootdev=thisdev so we've reached / }
|
|
|
- dir:=thedir
|
|
|
-end;
|
|
|
-
|
|
|
-
|
|
|
-{*****************************************************************************
|
|
|
- SystemUnit Initialization
|
|
|
-*****************************************************************************}
|
|
|
-
|
|
|
-{$ifdef BSD}
|
|
|
- procedure SignalToRunerror(Sig: longint; SigContext: SigContextRec;someptr:pointer); cdecl;
|
|
|
-{$else}
|
|
|
- {$ifdef Solaris}
|
|
|
- procedure SignalToRunerror(Sig: longint; SigContext: SigContextRec;someptr:pointer); cdecl;
|
|
|
- {$else}
|
|
|
- procedure SignalToRunerror(Sig: longint; SigContext: SigContextRec); cdecl;
|
|
|
- {$endif}
|
|
|
-{$ENDIF}
|
|
|
-var
|
|
|
-
|
|
|
- res,fpustate : word;
|
|
|
-begin
|
|
|
- res:=0;
|
|
|
- case sig of
|
|
|
- SIGFPE :
|
|
|
- begin
|
|
|
- { this is not allways necessary but I don't know yet
|
|
|
- how to tell if it is or not PM }
|
|
|
-{$ifdef cpui386}
|
|
|
- fpustate:=0;
|
|
|
- res:=200;
|
|
|
- {$ifndef FreeBSD}
|
|
|
- if assigned(SigContext.fpstate) then
|
|
|
- fpuState:=SigContext.fpstate^.sw;
|
|
|
- {$else}
|
|
|
- fpustate:=SigContext.en_sw;
|
|
|
- {$ifdef SYSTEM_DEBUG}
|
|
|
- writeln('xx:',sigcontext.en_tw,' ',sigcontext.en_cw);
|
|
|
- {$endif SYSTEM_DEBUG}
|
|
|
- {$endif}
|
|
|
- {$ifdef SYSTEM_DEBUG}
|
|
|
- Writeln(stderr,'FpuState = ',FpuState);
|
|
|
- {$endif SYSTEM_DEBUG}
|
|
|
- if (FpuState and $7f) <> 0 then
|
|
|
- begin
|
|
|
- { first check te more precise options }
|
|
|
- if (FpuState and FPU_DivisionByZero)<>0 then
|
|
|
- res:=200
|
|
|
- else if (FpuState and FPU_Overflow)<>0 then
|
|
|
- res:=205
|
|
|
- else if (FpuState and FPU_Underflow)<>0 then
|
|
|
- res:=206
|
|
|
- else if (FpuState and FPU_Denormal)<>0 then
|
|
|
- res:=216
|
|
|
- else if (FpuState and (FPU_StackOverflow or FPU_StackUnderflow))<>0 then
|
|
|
- res:=207
|
|
|
- else if (FpuState and FPU_Invalid)<>0 then
|
|
|
- res:=216
|
|
|
- else
|
|
|
- res:=207; {'Coprocessor Error'}
|
|
|
- end;
|
|
|
-{$endif cpui386}
|
|
|
- SysResetFPU;
|
|
|
- end;
|
|
|
- SIGILL,
|
|
|
- SIGBUS,
|
|
|
- SIGSEGV :
|
|
|
- res:=216;
|
|
|
- end;
|
|
|
-{ give runtime error at the position where the signal was raised }
|
|
|
- if res<>0 then
|
|
|
- begin
|
|
|
-{$ifdef cpui386}
|
|
|
- {$ifdef FreeBSD}
|
|
|
- HandleErrorAddrFrame(res,SigContext.sc_eip,SigContext.sc_ebp);
|
|
|
- {$else}
|
|
|
- HandleErrorAddrFrame(res,SigContext.eip,SigContext.ebp);
|
|
|
- {$endif}
|
|
|
-{$else}
|
|
|
- HandleError(res);
|
|
|
-{$endif}
|
|
|
- end;
|
|
|
-end;
|
|
|
-
|
|
|
-
|
|
|
-Procedure InstallSignals;
|
|
|
-const
|
|
|
-{$Ifndef BSD}
|
|
|
- {$ifdef solaris}
|
|
|
- act: SigActionRec =(sa_flags:SA_SIGINFO;Handler:(sa:@signaltorunerror;sa_mask:0);
|
|
|
- {$else}
|
|
|
- act: SigActionRec = (handler:(Sa:@SignalToRunError);sa_mask:0;sa_flags:0;
|
|
|
- Sa_restorer: NIL);
|
|
|
- {$endif}
|
|
|
-{$ELSE}
|
|
|
- act: SigActionRec = (handler:(Sa:@SignalToRunError);sa_flags:SA_SIGINFO;
|
|
|
- sa_mask:0);
|
|
|
-{$endif}
|
|
|
-
|
|
|
- oldact: PSigActionRec = Nil; {Probably not necessary anymore, now
|
|
|
- VAR is removed}
|
|
|
-begin
|
|
|
- SysResetFPU;
|
|
|
- SigAction(SIGFPE,@act,oldact);
|
|
|
-{$ifndef Solaris}
|
|
|
- SigAction(SIGSEGV,@act,oldact);
|
|
|
- SigAction(SIGBUS,@act,oldact);
|
|
|
- SigAction(SIGILL,@act,oldact);
|
|
|
-{$endif}
|
|
|
-end;
|
|
|
-
|
|
|
-
|
|
|
-procedure SetupCmdLine;
|
|
|
-var
|
|
|
- bufsize,
|
|
|
- len,j,
|
|
|
- size,i : longint;
|
|
|
- found : boolean;
|
|
|
- buf : array[0..1026] of char;
|
|
|
-
|
|
|
- procedure AddBuf;
|
|
|
- begin
|
|
|
- reallocmem(cmdline,size+bufsize);
|
|
|
- move(buf,cmdline[size],bufsize);
|
|
|
- inc(size,bufsize);
|
|
|
- bufsize:=0;
|
|
|
- end;
|
|
|
-
|
|
|
-begin
|
|
|
- size:=0;
|
|
|
- bufsize:=0;
|
|
|
- i:=0;
|
|
|
- while (i<argc) do
|
|
|
- begin
|
|
|
- len:=strlen(argv[i]);
|
|
|
- if len>sizeof(buf)-2 then
|
|
|
- len:=sizeof(buf)-2;
|
|
|
- found:=false;
|
|
|
- for j:=1 to len do
|
|
|
- if argv[i][j]=' ' then
|
|
|
- begin
|
|
|
- found:=true;
|
|
|
- break;
|
|
|
- end;
|
|
|
- if bufsize+len>=sizeof(buf)-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;
|
|
|
-end;
|
|
|
-
|
|
|
-
|
|
|
-procedure SysInitStdIO;
|
|
|
-begin
|
|
|
- OpenStdIO(Input,fmInput,StdInputHandle);
|
|
|
- OpenStdIO(Output,fmOutput,StdOutputHandle);
|
|
|
- OpenStdIO(StdOut,fmOutput,StdOutputHandle);
|
|
|
- OpenStdIO(StdErr,fmOutput,StdErrorHandle);
|
|
|
-end;
|
|
|
-
|
|
|
-
|
|
|
-Begin
|
|
|
- IsConsole := TRUE;
|
|
|
- IsLibrary := FALSE;
|
|
|
-{ Setup stack checking variables }
|
|
|
- StackLength := InitialStkLen;
|
|
|
- StackBottom := Sptr - StackLength;
|
|
|
-{ Set up signals handlers }
|
|
|
- InstallSignals;
|
|
|
-{ Setup heap }
|
|
|
- InitHeap;
|
|
|
- SysInitExceptions;
|
|
|
-{ Arguments }
|
|
|
- SetupCmdLine;
|
|
|
-{ Setup stdin, stdout and stderr }
|
|
|
- SysInitStdIO;
|
|
|
-{ Reset IO Error }
|
|
|
- InOutRes:=0;
|
|
|
-{ Setup variant support }
|
|
|
-{$ifdef HASVARIANT}
|
|
|
- initvariantmanager;
|
|
|
-{$endif HASVARIANT}
|
|
|
-End.
|
|
|
-
|
|
|
-{
|
|
|
- $Log$
|
|
|
- Revision 1.36 2003-10-17 20:45:58 olle
|
|
|
- * Changed mapping of Sys_ETXTBSY to 5
|
|
|
- * Changed m68k to cpum68k, i386 to cpui386
|
|
|
-
|
|
|
- Revision 1.35 2003/10/13 21:24:04 hajny
|
|
|
- * sbrk error handling corrected
|
|
|
-
|
|
|
- Revision 1.34 2003/09/27 11:52:36 peter
|
|
|
- * sbrk returns pointer
|
|
|
-
|
|
|
- Revision 1.33 2003/09/03 14:09:37 florian
|
|
|
- * arm fixes to the common rtl code
|
|
|
- * some generic math code fixed
|
|
|
- * ...
|
|
|
-
|
|
|
- Revision 1.32 2003/08/21 22:21:00 olle
|
|
|
- - removed parameter from fpc_iocheck
|
|
|
-
|
|
|
- Revision 1.31 2002/10/14 19:39:17 peter
|
|
|
- * threads unit added for thread support
|
|
|
-
|
|
|
- Revision 1.30 2002/10/13 09:20:56 peter
|
|
|
- * added initvariantmanager
|
|
|
-
|
|
|
- Revision 1.29 2002/09/07 16:01:27 peter
|
|
|
- * old logs removed and tabs fixed
|
|
|
-
|
|
|
- Revision 1.28 2002/09/02 19:46:37 florian
|
|
|
- * fixed line breaks
|
|
|
-
|
|
|
- Revision 1.27 2002/08/31 21:29:57 florian
|
|
|
- * several PC related fixes
|
|
|
-
|
|
|
- Revision 1.26 2002/08/13 18:11:08 florian
|
|
|
- * heap stuff for powerpc fixed
|
|
|
-
|
|
|
- Revision 1.25 2002/08/03 20:05:13 florian
|
|
|
- + ppc implementation of heap functions added
|
|
|
-
|
|
|
- Revision 1.24 2002/07/29 21:28:17 florian
|
|
|
- * several fixes to get further with linux/ppc system unit compilation
|
|
|
-
|
|
|
- Revision 1.23 2002/07/28 20:43:49 florian
|
|
|
- * several fixes for linux/powerpc
|
|
|
- * several fixes to MT
|
|
|
-
|
|
|
- Revision 1.22 2002/05/31 13:37:24 marco
|
|
|
- * more Renamefest
|
|
|
-
|
|
|
- Revision 1.21 2002/04/21 15:55:00 carl
|
|
|
- + initialize some global variables
|
|
|
-
|
|
|
- Revision 1.20 2002/04/12 17:43:28 carl
|
|
|
- + generic stack checking
|
|
|
-
|
|
|
- Revision 1.19 2002/03/11 19:10:33 peter
|
|
|
- * Regenerated with updated fpcmake
|
|
|
-
|
|
|
-}
|