diff --git a/rtl/bsd/syslinux.pp b/rtl/bsd/syslinux.pp new file mode 100644 index 0000000000..a4857883a8 --- /dev/null +++ b/rtl/bsd/syslinux.pp @@ -0,0 +1,736 @@ +{ + $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. + + 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 want to link to the C library, set the conditional crtlib } +{ $define crtlib} + +{ If you use an aout system, set the conditional AOUT} +{ $Define AOUT} + +Unit SysLinux; +Interface + +{$ifdef m68k} +{ used for single computations } +const + BIAS4 = $7f-1; +{$endif} + +{$I systemh.inc} +{$I heaph.inc} + +const + UnusedHandle = -1; + StdInputHandle = 0; + StdOutputHandle = 1; + StdErrorHandle = 2; + +var + argc : longint; + argv : ppchar; + envp : ppchar; + +Implementation + +{$I system.inc} + +{$ifdef crtlib} + Procedure _rtl_exit(l: longint); cdecl; + Function _rtl_paramcount: longint; cdecl; + Procedure _rtl_paramstr(st: pchar; l: longint); cdecl; + Function _rtl_open(f: pchar; flags: longint): longint; cdecl; + Procedure _rtl_close(h: longint); cdecl; + Procedure _rtl_write(h: longint; addr: longInt; len : longint); cdecl; + Procedure _rtl_erase(p: pchar); cdecl; + Procedure _rtl_rename(p1: pchar; p2 : pchar); cdecl; + Function _rtl_read(h: longInt; addr: longInt; len : longint) : longint; cdecl; + Function _rtl_filepos(Handle: longint): longint; cdecl; + Procedure _rtl_seek(Handle: longint; pos:longint); cdecl; + Function _rtl_filesize(Handle:longint): longInt; cdecl; + Procedure _rtl_rmdir(buffer: pchar); cdecl; + Procedure _rtl_mkdir(buffer: pchar); cdecl; + Procedure _rtl_chdir(buffer: pchar); cdecl; +{$else} + { 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 syscalls.inc } +{$endif} + +{***************************************************************************** + Misc. System Dependent Functions +*****************************************************************************} + +procedure prthaltproc;external name '_haltproc'; + +procedure System_exit; +begin +{$ifdef i386} + asm + jmp prthaltproc + end; +{$else} + asm + jmp prthaltproc + end; +{$endif} +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); + hs:='/proc/'+hs+'/exe'#0; + i:=Sys_readlink(@hs[1],@link[1],high(link)); + if i>0 then + begin + link[0]:=chr(i); + paramstr:=link; + end + else + paramstr:=strpas(argv[0]); + end + else + if (l>0) and (l0 then + Sbrk:=0; +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; + 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_EACCES : Inoutres:=5; + Sys_ETXTBSY : Inoutres:=162; + end; +end; + + +Procedure Do_Close(Handle:Longint); +Begin + if Handle<=4 then + exit; +{$ifdef crtlib} + _rtl_close(Handle); +{$else} + sys_close(Handle); +{$endif} +End; + + +Procedure Do_Erase(p:pchar); +Begin +{$ifdef crtlib} + _rtl_erase(p); +{$else} + sys_unlink(p); + Errno2Inoutres; +{$endif} +End; + + +Procedure Do_Rename(p1,p2:pchar); +Begin +{$ifdef crtlib} + _rtl_rename(p1,p2); +{$else } + sys_rename(p1,p2); + Errno2Inoutres; +{$endif} +End; + + +Function Do_Write(Handle,Addr,Len:Longint):longint; +Begin +{$ifdef crtlib} + _rtl_write(Handle,addr,len); + Do_Write:=Len; +{$else} + Do_Write:=sys_write(Handle,pchar(addr),len); + Errno2Inoutres; +{$endif} + if Do_Write<0 then + Do_Write:=0; +End; + + +Function Do_Read(Handle,Addr,Len:Longint):Longint; +Begin +{$ifdef crtlib} + Do_Read:=_rtl_read(Handle,addr,len); +{$else} + Do_Read:=sys_read(Handle,pchar(addr),len); + Errno2Inoutres; +{$endif} + if Do_Read<0 then + Do_Read:=0; +End; + + +Function Do_FilePos(Handle: Longint): Longint; +Begin +{$ifdef crtlib} + Do_FilePos:=_rtl_filepos(Handle); +{$else} + Do_FilePos:=sys_lseek(Handle, 0, Seek_Cur); + Errno2Inoutres; +{$endif} +End; + + +Procedure Do_Seek(Handle,Pos:Longint); +Begin +{$ifdef crtlib} + _rtl_seek(Handle, Pos); +{$else} + sys_lseek(Handle, pos, Seek_set); +{$endif} +End; + + +Function Do_SeekEnd(Handle:Longint): Longint; +begin +{$ifdef crtlib} + Do_SeekEnd:=_rtl_filesize(Handle); +{$else} + Do_SeekEnd:=sys_lseek(Handle,0,Seek_End); +{$endif} +end; + + +Function Do_FileSize(Handle:Longint): Longint; +{$ifndef crtlib} +var + Info : Stat; +{$endif} +Begin +{$ifdef crtlib} + Do_FileSize:=_rtl_filesize(Handle); +{$else} + if do_SysCall(189,handle,longint(@info))=0 then + Do_FileSize:=Info.Size + else + Do_FileSize:=0; + Errno2Inoutres; +{$endif} +End; + + +Procedure Do_Truncate(Handle,Pos:longint); + +begin +{$ifndef crtlib} + do_syscall(201,handle,pos); + Errno2Inoutres; +{$endif} +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 +{$ifndef crtlib} + oflags : longint; +{$endif} +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 } +{$ifdef crtlib} + FileRec(f).Handle:=_rtl_open(p, oflags); + if FileRec(f).Handle<0 then + InOutRes:=2 + else + InOutRes:=0; +{$else} + 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; +{$endif} +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:=(do_SysCall(54,handle,$5401,longint(@data))=0); +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 InOutRes <> 0 then exit; + Move(s[1], Buffer, Length(s)); + Buffer[Length(s)] := #0; +{$ifdef crtlib} + _rtl_mkdir(@buffer); +{$else} + sys_mkdir(@buffer, 511); + Errno2Inoutres; +{$endif} +End; + + +Procedure RmDir(Const s: String);[IOCheck]; +Var + Buffer: Array[0..255] of Char; +Begin + If InOutRes <> 0 then exit; + Move(s[1], Buffer, Length(s)); + Buffer[Length(s)] := #0; +{$ifdef crtlib} + _rtl_rmdir(@buffer); +{$else} + sys_rmdir(@buffer); + Errno2Inoutres; +{$endif} +End; + + +Procedure ChDir(Const s: String);[IOCheck]; +Var + Buffer: Array[0..255] of Char; +Begin + If InOutRes <> 0 then exit; + Move(s[1], Buffer, Length(s)); + Buffer[Length(s)] := #0; +{$ifdef crtlib} + _rtl_chdir(@buffer); +{$else} + sys_chdir(@buffer); + Errno2Inoutres; +{$endif} +End; + + +procedure getdir(drivenr : byte;var dir : shortstring); +{$ifndef crtlib} +var + thisdir : stat; + rootino, + thisino, + dotdotino : longint; + rootdev, + thisdev, + dotdotdev : word; + thedir,dummy : string[255]; + dirstream : pdir; + d : pdirent; + mountpoint : boolean; + predot : string[255]; +{$endif} +begin + drivenr:=0; + dir:=''; +{$ifndef crtlib} + 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); + 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; + if sys_stat (@(dummy[1]),thisdir)<0 then + d:=nil; + end; + until (d=nil) or ((thisdir.dev=thisdev) and (thisdir.ino=thisino) ); + if (closedir(dirstream)<0) or (d=nil) then + exit; + { At this point, d.name contains the name of the current dir} + thedir:='/'+strpas(@(d^.name[0]))+thedir; + thisdev:=dotdotdev; + thisino:=dotdotino; + predot:=predot+'../'; + end; +{ Now rootino=thisino and rootdev=thisdev so we've reached / } + dir:=thedir +{$endif} +end; + + +{***************************************************************************** + SystemUnit Initialization +*****************************************************************************} + +Procedure SignalToRunError(Sig:longint); +begin + case sig of + 8 : HandleError(200); + 11 : HandleError(216); + end; +end; + + +Procedure InstallSignals; +begin +{ sr.reg3:=longint(@SignalToRunError); + { sigsegv } + sr.reg2:=11; + syscall(syscall_nr_signal,sr); + { sigfpe } + sr.reg2:=8; + syscall(syscall_nr_signal,sr); +} +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 (isizeof(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 $100, becuase filemode can be upto 255 + + Revision 1.26 1999/09/08 16:14:43 peter + * pointer fixes + + Revision 1.25 1999/07/28 23:18:36 peter + * closedir fixes, which now disposes the pdir itself + +} \ No newline at end of file