fpc/rtl/bsd/syscalls.inc

{
    $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.

 **********************************************************************}

{BSD version of the syscalls required to implement SysLinux.}

{No debugging for syslinux include !}
{$IFDEF SYS_LINUX}
  {$UNDEF SYSCALL_DEBUG}
{$ENDIF SYS_LINUX}  

{*****************************************************************************
                     --- Main:The System Call Self ---
*****************************************************************************}

{ The system designed for Linux can't be used for FreeBSD so easily, since 
  FreeBSD pushes arguments, instead of loading them to registers.

For now I do them in assembler, which makes it easier to test them (copy and
paste to and AS source). Ultimately I hope to design something like this}

{
Function SysCall( callnr:longint;var regs : SysCallregs ):longint;
{
  This function serves as an interface to do_SysCall.
  If the SysCall returned a negative number, it returns -1, and puts the
  SysCall result in errno. Otherwise, it returns the SysCall return value
}
begin
  do_SysCall(callnr,regs);
  if regs.reg1<0 then
   begin
{$IFDEF SYSCALL_DEBUG}
     If DoSysCallDebug then
       debugtxt:=' syscall error: ';
{$endif}
     ErrNo:=-regs.reg1;
     SysCall:=-1;
   end
  else
   begin
{$IFDEF SYSCALL_DEBUG}
  if DoSysCallDebug then
       debugtxt:=' syscall returned: ';
{$endif}
     SysCall:=regs.reg1;
     errno:=0
   end;
{$IFDEF SYSCALL_DEBUG}
  if DoSysCallDebug then
    begin
    inc(lastcnt);
    if (callnr<>lastcall) or (regs.reg1<>lasteax) then
      begin
      if lastcnt>1 then
        writeln(sys_nr_txt[lastcall],debugtxt,lasteax,' (',lastcnt,'x)');
      lastcall:=callnr;
      lasteax:=regs.reg1;
      lastcnt:=0;
      writeln(sys_nr_txt[lastcall],debugtxt,lasteax);
      end;
    end;     
{$endif}
end;
}

{$PACKRECORDS C}
{
TYPE timeval=RECORD
	      tv_sec,
	      tv_used : int64;
	      END;
    timezone=RECORD
	      tz_minuteswest,
	      tz_dsttime   : LONGINT;
              END;

}
function checkreturnvalue(retval:LONGINT;value:LONGINT):LONGINT;

begin
 if retval<0 THEN
   begin
     errno:=-retval;
     checkreturnvalue:=-1;
   end
  else
   begin
     checkreturnvalue:=value;
     errno:=0
   end;
end;

Function Sys_Time:longint;

VAR tv : timeval;
    tz : timezone;
    retval : longint;
begin
  asm
   lea   tz,%ebx
   pushl %ebx
   lea   tv,%ecx
   pushl %ecx
   mov   $116,%eax
   int   $0x80
   add   $8,%esp
   mov   %eax,retval
  end;
  
 sys_time:=checkreturnvalue(retval,tv.sec);
end;

{*****************************************************************************
               --- File:File handling related calls ---
*****************************************************************************}


Function Sys_Open(f:pchar;flags:longint;mode:integer):longint;

var retval: LONGINT;

Begin
 asm 
   pushw mode
   pushl flags
   pushl f
   movl  $5,%eax
   int   $0x80
   add   $10,%esp
   mov   %eax,retval
  end;
 sys_open:=checkreturnvalue(retval,retval);
End;

Function Sys_Close(f:longint):longint;

var retval: LONGINT;

begin
 asm 
   pushl f
   movl  $6,%eax
   int   $0x80
   addl  $4,%esp
   mov   %eax,retval
 end;
 Sys_Close:=checkreturnvalue(retval,retval);
end;

Function Sys_Lseek(F:longint;Off:longint;Whence:longint):longint;

var retval: LONGINT;

begin
  asm
    pushl Whence
    pushl Off
    pushl F
    mov   $199,%eax
    int   $0x80
    addl  $12,%eax
    mov   %eax,retval
  end;
  Sys_Lseek:=checkreturnvalue(retval,retval);
end;

Function Sys_Read(f:longint;buffer:pchar;count:longint):longint;

var retval: LONGINT;

begin
  asm
    pushl Count
    pushl Buffer
    pushl F
    mov   $3,%eax
    int   $0x80
    addl  $12,%eax
    mov   %eax,retval
  end;   
  Sys_Read:=checkreturnvalue(retval,retval);

end;

Function Sys_Write(f:longint;buffer:pchar;count:longint):longint;

var retval: LONGINT;

begin
  asm
    pushl Count
    pushl Buffer
    pushl F
    mov   $4,%eax
    int   $0x80
    addl  $12,%eax
    mov   %eax,retval
  end;   
 Sys_Write:=checkreturnvalue(retval,retval);
end;

Function Sys_Unlink(Filename:pchar):longint;

var retval: LONGINT;

begin
  asm
    pushl FileName
    mov   $10,%eax
    int   $0x80
    addl  $4,%eax
    mov   %eax,retval
  end;   
 Sys_UnLink:=checkreturnvalue(retval,retval);
end;

Function Sys_Rename(Oldname,Newname:pchar):longint;

var retval: LONGINT;

begin
  asm
    pushl NewName
    pushl OldName
    mov   $38,%eax
    int   $0x80
    addl  $8,%eax
    mov   %eax,retval
  end;   
 Sys_Rename:=checkreturnvalue(retval,retval);
end;

Function Sys_Stat(Filename:pchar;var Buffer: stat):longint;
{
   We need this for getcwd
}

var retval: LONGINT;

begin
  asm
    pushl buffer
    pushl FileName
    mov   $188,%eax
    int   $0x80
    addl  $8,%eax
    mov   %eax,retval
  end;   
Sys_Stat:=checkreturnvalue(retval,retval);
end;
 
Function Sys_Symlink(oldname,newname:pchar):longint;
{
  We need this for erase
}
var retval : longint;

begin
 asm
    pushl newname
    pushl oldname
    mov   $57,%eax
    int   $0x80
    addl  $8,%eax
    mov   %eax,retval
  end;   
 Sys_Symlink:=checkreturnvalue(retval,retval);
end;

{*****************************************************************************
               --- Directory:Directory related calls ---
*****************************************************************************}

Function Sys_Chdir(Filename:pchar):longint;

var retval : longint;

begin
 asm
    pushl FileName
    mov   $12,%eax
    int   $0x80
    addl  $4,%eax
    mov   %eax,retval
  end;   
 Sys_ChDir:=checkreturnvalue(retval,retval);
end;

Function Sys_Mkdir(Filename:pchar;mode:longint):longint;

var retval : longint;

begin {Mode is 16-bit on F-BSD}
 asm
    mov  mode,%eax
    pushw %ax
    pushl FileName
    mov   $136,%eax
    int   $0x80
    addl  $6,%eax
    mov   %eax,retval
  end;   
 Sys_MkDir:=checkreturnvalue(retval,retval);
end;

Function Sys_Rmdir(Filename:pchar):longint;

var retval : longint;

begin
 asm
    pushl FileName
    mov   $137,%eax
    int   $0x80
    addl  $4,%eax
    mov   %eax,retval
  end;   
 Sys_RmDir:=checkreturnvalue(retval,retval);
end;

{ we need this for getcwd, NOT touched for BSD version }
Function OpenDir(f:pchar):pdir;

var
  fd:integer;
  st:stat;
  ptr:pdir;
begin
  opendir:=nil;
  if sys_stat(f,st)<0 then
   exit;
{ Is it a dir ? }
  if not((st.mode and $f000)=$4000)then 
   begin
     errno:=sys_enotdir;
     exit
   end;
{ Open it}
  fd:=sys_open(f,OPEN_RDONLY,438);
  if fd<0 then
   exit;
  new(ptr);
  if ptr=nil then
   exit;
  new(ptr^.buf);
  if ptr^.buf=nil then
   exit;
  ptr^.fd:=fd;
  ptr^.loc:=0;
  ptr^.size:=0;
  ptr^.dd_max:=sizeof(ptr^.buf^);
  opendir:=ptr;
end;

function CloseDir(p:pdir):integer;
begin
  closedir:=sys_close(p^.fd);
  dispose(p^.buf);
  dispose(p);
end;


Function Sys_ReadDir(p:pdir):pdirent;
var
    retval : longint;
begin
 retval:=SIZEOF(dirent) ;
 asm 
    mov p,%esi
    push retval
    push tdir.buf(%esi)
    push tdir.fd(%esi)
    mov  $272,%eax 
    int  $0x80
    addl $12,%esp
    mov  %eax,retval    
  end; 
  retval:=checkreturnvalue(retval,retval); 
  if retval=0 then 
   sys_readdir:=nil 
  else 
   sys_readdir:=p^.buf
end;

{*****************************************************************************
        --- Process:Process & program handling - related calls ---
*****************************************************************************}

Procedure Sys_Exit(ExitCode:longint);

var retval : longint;

begin
 asm
    pushl ExitCode
    mov   $1,%eax
    int   $0x80
    addl  $4,%eax
    mov   %eax,retval
  end;   
 checkreturnvalue(retval,retval); {is nonsense :-)}
end;

{
  $Log$
  Revision 1.5  2000-02-04 16:53:26  marco
   * Finished Linux (and rest syscalls) roughly. Some things still need to be
    tested, and checked (off_t calls specially)

  Revision 1.4  2000/02/03 17:04:47  marco
   * additions fixes due to port linux

  Revision 1.3  2000/02/02 18:07:27  marco
   * Ported except for readdir which is 200 lines C code in FBSD linux
  	emulator

  Revision 1.2  2000/02/02 16:35:10  marco
   * Ported more functions. Half done now.

  Revision 1.1  2000/02/02 15:41:56  marco
   * Initial BSD version. Still needs a lot of work.

}