* Has been merged with linux/ version

rtl/bsd/syslinux.pp

@@ -1,749 +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.
-
-    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 (l<argc) then
-    paramstr:=strpas(argv[l])
-  else
-    paramstr:='';
-end;
-
-
-Procedure Randomize;
-Begin
-  randseed:=sys_time;
-End;
-
-
-{*****************************************************************************
-                              Heap Management
-*****************************************************************************}
-
-var
-  _HEAP : longint;external name 'HEAP';
-  _HEAPSIZE : longint;external name 'HEAPSIZE';
-
-function getheapstart:pointer;assembler;
-{$ifdef i386}
-asm
-        leal    _HEAP,%eax
-end ['EAX'];
-{$else}
-asm
-        lea.l   _HEAP,a0
-        move.l  a0,d0
-end;
-{$endif}
-
-
-function getheapsize:longint;assembler;
-{$ifdef i386}
-asm
-        movl    _HEAPSIZE,%eax
-end ['EAX'];
-{$else}
-asm
-       move.l   _HEAPSIZE,d0
-end ['D0'];
-{$endif}
-
-
-Function sbrk(size : longint) : Longint;
-
-CONST MAP_PRIVATE   =2;
-      MAP_ANONYMOUS =$1000;		{$20 under linux}
-
-begin
-  Sbrk:=do_syscall(syscall_nr_mmap,0,size,3,MAP_PRIVATE+MAP_ANONYMOUS,-1,0,0);
-  if ErrNo<>0 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(syscall_nr_fstat,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(syscall_nr_ftruncate,handle,pos,0);
-  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_CREATE 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(syscall_nr_ioctl,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 (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;
-
-
-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.5  2000-04-10 15:46:52  marco
-   * worked all day. probably a lot changed
-
-  Revision 1.3  2000/03/17 12:58:57  marco
-   * some changes to ftruncate based procs. Added a "0" as extra parameter
-
-  Revision 1.2  2000/03/16 16:21:10  marco
-   * changes to get ppc386 -h working
-
-  Revision 1.1  2000/03/01 20:23:07  marco
-   * Initial version. Compiles (syscall.inc inclusion prob has to be solved
-
-  Revision 1.37  2000/02/09 16:59:32  peter
-    * truncated log
-
-  Revision 1.36  2000/02/09 12:17:51  peter
-    * moved halt to system.inc
-    * syslinux doesn't use direct asm anymore
-
-  Revision 1.35  2000/02/08 11:47:09  peter
-    * paramstr(0) support
-
-  Revision 1.34  2000/01/20 23:38:02  peter
-    * support fm_inout as stdoutput for assign(f,'');rewrite(f,1); becuase
-      rewrite opens always with filemode 2
-
-  Revision 1.33  2000/01/16 22:25:38  peter
-    * check handle for file closing
-
-  Revision 1.32  2000/01/07 16:41:41  daniel
-    * copyright 2000
-
-  Revision 1.31  2000/01/07 16:32:28  daniel
-    * copyright 2000 added
-
-  Revision 1.30  1999/12/01 22:57:31  peter
-    * cmdline support
-
-  Revision 1.29  1999/11/06 14:39:12  peter
-    * truncated log
-
-  Revision 1.28  1999/10/28 09:50:06  peter
-    * use mmap instead of brk
-
-  Revision 1.27  1999/09/10 15:40:35  peter
-    * fixed do_open flags to be > $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
-
-}