mirror of
				https://gitlab.com/freepascal.org/fpc/source.git
				synced 2025-10-31 14:31:38 +01:00 
			
		
		
		
	
		
			
				
	
	
		
			421 lines
		
	
	
		
			8.9 KiB
		
	
	
	
		
			PHP
		
	
	
	
	
	
			
		
		
	
	
			421 lines
		
	
	
		
			8.9 KiB
		
	
	
	
		
			PHP
		
	
	
	
	
	
| {
 | |
|     $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}
 | |
| 
 | |
| {actualsyscall:
 | |
|   _actualsyscall : int $0x80
 | |
|                    jb someerror
 | |
|                    ret
 | |
|       someerror:   storeerrorsomewhere
 | |
|                    ret
 | |
| }
 | |
| 
 | |
| {
 | |
| procedure actualsyscall; cdecl; EXTERNAL NAME '_actualsyscall';
 | |
| }
 | |
| 
 | |
| procedure actualsyscall; assembler;
 | |
|     asm
 | |
|          int $0x80
 | |
|          jb .LErrorcode
 | |
|          xor %ebx,%ebx
 | |
|          ret
 | |
| .LErrorcode:
 | |
| 	 mov %eax,%ebx
 | |
|          mov $-1,%eax
 | |
|    end;
 | |
| 
 | |
| 
 | |
| function Do_SysCall(sysnr:LONGINT):longint; assembler;
 | |
| 
 | |
| asm
 | |
|   movl  sysnr,%eax
 | |
|   call  actualsyscall
 | |
|   movw  %bx,Errno
 | |
| end;
 | |
| 
 | |
| function Do_SysCall(sysnr,param1:longint):longint; assembler;
 | |
| 
 | |
|  asm
 | |
|   movl  sysnr,%eax
 | |
|   pushl Param1
 | |
|   call  actualsyscall
 | |
|   addl  $4,%esp
 | |
|   movw  %bx,Errno
 | |
|  end;
 | |
| 
 | |
| function Do_SysCall(sysnr,param1:integer):longint; assembler;
 | |
| 
 | |
|  asm
 | |
|   movl  sysnr,%eax
 | |
|   pushw Param1
 | |
|   call  actualsyscall
 | |
|   addw  $2,%esp
 | |
|   movw  %bx,Errno
 | |
|  end;
 | |
| 
 | |
| 
 | |
| function Do_SysCall(sysnr,param1,param2:LONGINT):longint; assembler;
 | |
| 
 | |
|  asm
 | |
|    movl  sysnr,%eax
 | |
|    pushl param2
 | |
|    pushl Param1
 | |
|    call  actualsyscall
 | |
|    addl  $8,%esp
 | |
|    movw  %bx,Errno
 | |
|  end;
 | |
| 
 | |
| function Do_SysCall(sysnr,param1,param2,param3:LONGINT):longint; assembler;
 | |
| 
 | |
|  asm
 | |
|    movl  sysnr,%eax
 | |
|    pushl param3
 | |
|    pushl param2
 | |
|    pushl Param1
 | |
|    call  actualsyscall
 | |
|    addl  $12,%esp
 | |
|    movw  %bx,Errno
 | |
|  end;
 | |
| 
 | |
| function Do_SysCall(sysnr,param1,param2,param3,param4:LONGINT):longint; assembler;
 | |
| 
 | |
| asm
 | |
|    movl  sysnr,%eax
 | |
|    pushl param4
 | |
|    pushl param3
 | |
|    pushl param2
 | |
|    pushl Param1
 | |
|    call  actualsyscall
 | |
|    addl  $16,%esp
 | |
|    movw  %bx,Errno
 | |
| end;
 | |
| 
 | |
| 
 | |
| function Do_SysCall(sysnr,param1,param2,param3,param4,param5:LONGINT):longint;  assembler;
 | |
| 
 | |
|  asm
 | |
|    movl  sysnr,%eax
 | |
|    pushl param5
 | |
|    pushl param4
 | |
|    pushl param3
 | |
|    pushl param2
 | |
|    pushl Param1
 | |
|    call  actualsyscall
 | |
|    addl  $20,%esp
 | |
|    movw  %bx,Errno
 | |
|  end;
 | |
| 
 | |
| function Do_SysCall(sysnr,param1,param2,param3,param4,param5,param6,param7:LONGINT):longint;  assembler;
 | |
| 
 | |
| asm
 | |
|    movl  sysnr,%eax
 | |
|    pushl param7
 | |
|    pushl param6
 | |
|    pushl param5
 | |
|    pushl param4
 | |
|    pushl param3
 | |
|    pushl param2
 | |
|    pushl Param1
 | |
|    call  actualsyscall
 | |
|    addl  $28,%esp
 | |
|    movw  %bx,Errno
 | |
| end;
 | |
| 
 | |
| Function Sys_Time:longint;
 | |
| 
 | |
| VAR tv     : timeval;
 | |
|     tz     : timezone;
 | |
|     retval : longint;
 | |
| 
 | |
| begin
 | |
|   Retval:=do_syscall(116,longint(@tv),longint(@tz));
 | |
|   If retval=-1 then
 | |
|    sys_time:=-1
 | |
|   else
 | |
|    sys_time:=tv.sec;
 | |
| end;
 | |
| 
 | |
| {*****************************************************************************
 | |
|                --- File:File handling related calls ---
 | |
| *****************************************************************************}
 | |
| 
 | |
| 
 | |
| Function Sys_Open(f:pchar;flags:longint;mode:integer):longint;
 | |
| 
 | |
| Begin
 | |
|  sys_open:=do_syscall(syscall_nr_open,longint(f),flags,mode);
 | |
| End;
 | |
| 
 | |
| Function Sys_Close(f:longint):longint;
 | |
| 
 | |
| begin
 | |
|  sys_close:=do_syscall(syscall_nr_close,f);
 | |
| end;
 | |
| 
 | |
| {
 | |
| Function Sys_Lseek(F:longint;Off:longint;Whence:longint):longint;
 | |
| 
 | |
| var returnvalue64 : array[0..1] of longint;
 | |
| 
 | |
| begin
 | |
|  {Lseek's offset is 64-bit, the highword  is the 0}
 | |
|  do_syscall(syscall_nr_lseek,longint(@returnvalue64),F,Off,0,Whence);
 | |
|  sys_lseek:=returnvalue64[0];
 | |
| end;
 | |
| 
 | |
| }
 | |
| 
 | |
| Function Sys_Lseek(F:longint;Off:longint;Whence:longint):longint; assembler;
 | |
| 
 | |
| {this one is special for the return value being 64-bit..}
 | |
| 
 | |
|  asm
 | |
|   pushl Whence
 | |
|   pushl $0      // high dword
 | |
|   pushl Off
 | |
|   pushl $0
 | |
|   pushl F
 | |
|   pushl $0      // Your guess is as good as mine.
 | |
|   pushl $0xc7   // Actual lseek syscall number.
 | |
|   movl  $0xc6,%eax
 | |
|   call  actualsyscall
 | |
|   addl  $28,%esp
 | |
|   mov   %ebx,Errno
 | |
|  end;
 | |
| 
 | |
| Function Sys_Read(f:longint;buffer:pchar;count:longint):longint;
 | |
| 
 | |
| begin
 | |
|   sys_read:=do_syscall(syscall_nr_read,F,longint(buffer),count);
 | |
| end;
 | |
| 
 | |
| Function Sys_Write(f:longint;buffer:pchar;count:longint):longint;
 | |
| 
 | |
| begin
 | |
|  sys_write:=do_syscall(syscall_nr_write,F,longint(buffer),count);
 | |
| end;
 | |
| 
 | |
| Function Sys_Unlink(Filename:pchar):longint;
 | |
| 
 | |
| begin
 | |
|   sys_unlink:=do_syscall(syscall_nr_unlink,longint(Filename));
 | |
| end;
 | |
| 
 | |
| Function Sys_Rename(Oldname,Newname:pchar):longint;
 | |
| 
 | |
| begin
 | |
|   sys_rename:=do_syscall(syscall_nr_rename,longint(oldname),longint(newname));
 | |
| end;
 | |
| 
 | |
| Function Sys_Stat(Filename:pchar;var Buffer: stat):longint;
 | |
| {
 | |
|    We need this for getcwd
 | |
| }
 | |
| 
 | |
| begin
 | |
|  sys_stat:=do_syscall(syscall_nr_stat,longint(filename),longint(@buffer));
 | |
| end;
 | |
| 
 | |
| Function Sys_Symlink(oldname,newname:pchar):longint;
 | |
| {
 | |
|   We need this for erase
 | |
| }
 | |
| 
 | |
| begin
 | |
|  sys_symlink:=do_syscall(syscall_nr_symlink,longint(oldname),longint(newname));
 | |
| end;
 | |
| 
 | |
| 
 | |
| Function Sys_ReadLink(name,linkname:pchar;maxlen:longint):longint;
 | |
| 
 | |
| begin
 | |
|   sys_readlink:=do_syscall(syscall_nr_readlink, longint(name),longint(linkname),maxlen);
 | |
| end;
 | |
| 
 | |
| 
 | |
| 
 | |
| {*****************************************************************************
 | |
|                --- Directory:Directory related calls ---
 | |
| *****************************************************************************}
 | |
| 
 | |
| Function Sys_Chdir(Filename:pchar):longint;
 | |
| 
 | |
| begin
 | |
|  sys_chdir:=do_syscall(syscall_nr_chdir,longint(filename));
 | |
| end;
 | |
| 
 | |
| Function Sys_Mkdir(Filename:pchar;mode:longint):longint;
 | |
| 
 | |
| begin {Mode is 16-bit on F-BSD}
 | |
|   sys_mkdir:=do_syscall(syscall_nr_mkdir,longint(filename),mode shl 8);
 | |
| end;
 | |
| 
 | |
| Function Sys_Rmdir(Filename:pchar):longint;
 | |
| 
 | |
| begin
 | |
|  sys_rmdir:=do_syscall(syscall_nr_rmdir,longint(filename));
 | |
| end;
 | |
| 
 | |
| 
 | |
| const DIRBLKSIZ=1024;
 | |
| 
 | |
| 
 | |
| { we need this for getcwd, NOT touched for BSD version }
 | |
| Function OpenDir(f:pchar):pdir;
 | |
| 
 | |
| var
 | |
|   fd:longint;
 | |
|   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;
 | |
|   Getmem(ptr^.buf,2*DIRBLKSIZ);
 | |
|   if ptr^.buf=nil then
 | |
|    exit;
 | |
|   ptr^.fd:=fd;
 | |
|   ptr^.loc:=-1;
 | |
|   ptr^.rewind:=longint(ptr^.buf);
 | |
|   ptr^.size:=0;
 | |
| //  ptr^.dd_max:=sizeof(ptr^.buf^);
 | |
|   opendir:=ptr;
 | |
| end;
 | |
| 
 | |
| function CloseDir(p:pdir):integer;
 | |
| begin
 | |
|   closedir:=sys_close(p^.fd);
 | |
|   Freemem(p^.buf);
 | |
|   dispose(p);
 | |
| end;
 | |
| 
 | |
| 
 | |
| Function Sys_ReadDir(p:pdir):pdirent;
 | |
| {Different from Linux, Readdir on BSD is based on Getdents, due to the
 | |
| missing of the readdir syscall.
 | |
| Getdents requires the buffer to be larger than the blocksize.
 | |
| This usually the sectorsize =512 bytes, but maybe tapedrives and harddisks
 | |
| with blockmode have this higher?}
 | |
| 
 | |
| function readbuffer:longint;
 | |
| 
 | |
| var retval :longint;
 | |
| 
 | |
| begin
 | |
|    retval:=do_syscall(syscall_nr_getdents,longint(p^.fd),longint(@p^.buf^),DIRBLKSIZ {sizeof(getdentsbuffer)});
 | |
|    p^.rewind:=longint(p^.buf);
 | |
|    if retval=0 then
 | |
|     begin
 | |
|      p^.rewind:=0;
 | |
|      p^.loc:=0;
 | |
|     end
 | |
|    else
 | |
|     P^.loc:=retval;
 | |
|  readbuffer:=retval;
 | |
| end;
 | |
| 
 | |
| var
 | |
|     l              : pdirent;
 | |
|     novalid        : boolean;
 | |
| 
 | |
| begin
 | |
|  if (p^.buf=nil) or (p^.loc=0) THEN
 | |
|   exit(nil);
 | |
|  if p^.loc=-1 then         {First readdir on this pdir. Initial fill of buffer}
 | |
|   begin
 | |
|    if readbuffer()=0 Then    {nothing to be read}
 | |
|     exit(nil)
 | |
|   end;
 | |
|  l:=nil;
 | |
|  repeat
 | |
|   novalid:=false;
 | |
|   if (pdirent(p^.rewind)^.reclen<>0) then
 | |
|    begin {valid direntry?}
 | |
|     if pdirent(P^.rewind)^.ino<>0 then
 | |
|      l:=pdirent(p^.rewind);       
 | |
|     inc(p^.rewind,pdirent(p^.rewind)^.reclen);
 | |
|     if p^.rewind>=(longint(p^.buf)+dirblksiz) then
 | |
|      novalid:=true;
 | |
|    end
 | |
|   else
 | |
|    novalid:=true;
 | |
|   if novalid then
 | |
|    begin {block entirely searched or reclen=0}
 | |
|     if p^.loc<>0 THEN             {blocks left?}
 | |
|      if readbuffer()<>0 then        {succesful read?}
 | |
|       novalid:=false;
 | |
|    end;
 | |
|  until (l<>nil) or novalid;
 | |
|  Sys_ReadDir:=l;
 | |
| end;
 | |
| 
 | |
| 
 | |
| {*****************************************************************************
 | |
|         --- Process:Process & program handling - related calls ---
 | |
| *****************************************************************************}
 | |
| 
 | |
| 
 | |
| Function sys_GetPid:LongInt;
 | |
| {
 | |
|   Get Process ID.
 | |
| }
 | |
| 
 | |
| begin
 | |
|  sys_GetPID:=do_syscall(syscall_nr_getpid);
 | |
| end;
 | |
| 
 | |
| Procedure Sys_Exit(ExitCode:longint);
 | |
| 
 | |
| begin
 | |
|   do_syscall(syscall_nr_exit,exitcode);
 | |
| end;
 | |
| 
 | |
| {
 | |
|   $Log$
 | |
|   Revision 1.2  2000-07-13 11:33:37  michael
 | |
|   + removed logs
 | |
|  
 | |
| }
 | 
