paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-10-27 09:31:52 +01:00
Code Issues Packages Projects Releases Wiki Activity

* x86-64 fixes

Browse Source
This commit is contained in:
peter 2004-04-22 17:17:13 +00:00
parent 0fbb1fe9e8
commit 9a7a1e2489
7 changed files with 277 additions and 111 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
rtl/linux/bunxfunc.inc
View File

@ -25,7 +25,7 @@
{$endif} {$endif}
//{$i genfuncs.inc} //{$i genfuncs.inc}
{$i bunxmacr.inc} // macro's. {$i bunxmacr.inc} // macros.
{$I gensigset.inc} // general sigset funcs implementation. {$I gensigset.inc} // general sigset funcs implementation.
{$I genfdset.inc} {$I genfdset.inc}
@ -61,7 +61,7 @@ Function fpSigProcMask(how:cint;nset : pSigSet; oset : pSigSet):cint; [public, a
} }
begin begin
fpsigprocmask:=do_syscall(syscall_nr_sigprocmask,longint(how),longint(nset),longint(oset)); fpsigprocmask:=do_syscall(syscall_nr_rt_sigprocmask,longint(how),longint(nset),longint(oset));
end; end;
@ -71,7 +71,7 @@ Function fpSigPending(var nset: TSigSet):cint;
signals is set in SSet signals is set in SSet
} }
begin begin
fpsigpending:=do_syscall(syscall_nr_sigpending,longint(@nset)); fpsigpending:=do_syscall(syscall_nr_rt_sigpending,longint(@nset));
end; end;
function fpsigsuspend(const sigmask:TSigSet):cint; function fpsigsuspend(const sigmask:TSigSet):cint;
@ -81,7 +81,7 @@ function fpsigsuspend(const sigmask:TSigSet):cint;
} }
begin begin
fpsigsuspend:= do_syscall(syscall_nr_sigsuspend,longint(@sigmask)); fpsigsuspend:= do_syscall(syscall_nr_rt_sigsuspend,longint(@sigmask));
end; end;
Type Type
@ -446,7 +446,10 @@ end;
{ {
$Log$ $Log$
Revision 1.8 2004-02-21 23:18:50 marco Revision 1.9 2004-04-22 17:17:23 peter
* x86-64 fixes
Revision 1.8 2004/02/21 23:18:50 marco
* powerpc select fix * powerpc select fix
Revision 1.7 2003/12/30 15:43:20 marco Revision 1.7 2003/12/30 15:43:20 marco

97
rtl/linux/unixsock.inc
View File

@ -14,10 +14,16 @@
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
} }
{$ifndef cpux86_64}
{$define NEED_SOCKETCALL}
{$endif}
{****************************************************************************** {******************************************************************************
Basic Socket Functions Basic Socket Functions
******************************************************************************} ******************************************************************************}
{$ifdef NEED_SOCKETCALL}
Const Const
{ {
Arguments to the Linux Kernel system call for sockets. All Arguments to the Linux Kernel system call for sockets. All
@ -61,15 +67,15 @@ begin
end; end;
Function SocketCall(SockCallNr,a1,a2,a3:longint):longint; function SocketCall(SockCallNr,a1,a2,a3:longint):longint;
begin begin
SocketCall:=SocketCall(SockCallNr,a1,a2,a3,0,0,0); SocketCall:=SocketCall(SockCallNr,a1,a2,a3,0,0,0);
end; end;
function fpsocket (domain:cint; xtype:cint; protocol: cint):cint; function fpsocket (domain:cint; xtype:cint; protocol: cint):cint;
Begin begin
fpSocket:=SocketCall(Socket_Sys_socket,Domain,xtype,Protocol); fpSocket:=SocketCall(Socket_Sys_socket,Domain,xtype,Protocol);
End; end;
function fpsend (s:cint; msg:pointer; len:size_t; flags:cint):ssize_t; function fpsend (s:cint; msg:pointer; len:size_t; flags:cint):ssize_t;
begin begin
@ -137,14 +143,95 @@ begin
end; end;
function fpsocketpair (d:cint; xtype:cint; protocol:cint; sv:pcint):cint; function fpsocketpair (d:cint; xtype:cint; protocol:cint; sv:pcint):cint;
begin begin
fpSocketPair:=SocketCall(Socket_Sys_SocketPair,d,xtype,protocol,TSysParam(sv),0,0); fpSocketPair:=SocketCall(Socket_Sys_SocketPair,d,xtype,protocol,TSysParam(sv),0,0);
end; end;
{$else NEED_SOCKETCALL}
function fpsocket (domain:cint; xtype:cint; protocol: cint):cint;
begin
fpSocket:=do_syscall(syscall_nr_socket,Domain,xtype,Protocol);
end;
function fpsend (s:cint; msg:pointer; len:size_t; flags:cint):ssize_t;
begin
fpSend:=do_syscall(syscall_nr_sendto,S,TSysParam(msg),Len,Flags);
end;
function fpsendto (s:cint; msg:pointer; len:size_t; flags:cint; tox :psockaddr; tolen: tsocklen):ssize_t;
begin
fpSendto:=do_syscall(syscall_nr_sendto,S,TSysParam(msg),Len,Flags,TSysParam(tox),tolen);
end;
function fprecv (s:cint; buf: pointer; len: size_t; flags:cint):ssize_t;
begin
fpRecv:=do_syscall(syscall_nr_Recvfrom,S,tsysparam(buf),len,flags);
end;
function fprecvfrom (s:cint; buf: pointer; len: size_t; flags: cint; from : psockaddr; fromlen : psocklen):ssize_t;
begin
fpRecvFrom:=do_syscall(syscall_nr_Recvfrom,S,TSysParam(buf),len,flags,TSysParam(from),TSysParam(fromlen));
end;
function fpbind (s:cint; addrx : psockaddr; addrlen : tsocklen):cint;
begin
fpBind:=do_syscall(syscall_nr_Bind,S,TSysParam(addrx),addrlen);
end;
function fplisten (s:cint; backlog : cint):cint;
begin
fpListen:=do_syscall(syscall_nr_Listen,S,backlog);
end;
function fpaccept (s:cint; addrx : psockaddr; addrlen : psocklen):cint;
begin
fpAccept:=do_syscall(syscall_nr_accept,S,TSysParam(addrx),TSysParam(addrlen));
end;
function fpconnect (s:cint; name : psockaddr; namelen : tsocklen):cint;
begin
fpConnect:=do_syscall(syscall_nr_connect,S,TSysParam(name),namelen);
end;
function fpshutdown (s:cint; how:cint):cint;
begin
fpShutDown:=do_syscall(syscall_nr_shutdown,S,how);
end;
function fpgetsockname (s:cint; name : psockaddr; namelen : psocklen):cint;
begin
fpGetSockName:=do_syscall(syscall_nr_GetSockName,S,TSysParam(name),TSysParam(namelen));
end;
function fpgetpeername (s:cint; name : psockaddr; namelen : psocklen):cint;
begin
fpGetPeerName:=do_syscall(syscall_nr_GetPeerName,S,TSysParam(name),TSysParam(namelen));
end;
function fpsetsockopt (s:cint; level:cint; optname:cint; optval:pointer; optlen : tsocklen):cint;
begin
fpSetSockOpt:=do_syscall(syscall_nr_SetSockOpt,S,level,optname,TSysParam(optval),optlen);
end;
function fpgetsockopt (s:cint; level:cint; optname:cint; optval:pointer; optlen : psocklen):cint;
begin
fpGetSockOpt:=do_syscall(syscall_nr_GetSockOpt,S,level,TSysParam(optname),TSysParam(optval),TSysParam(optlen));
end;
function fpsocketpair (d:cint; xtype:cint; protocol:cint; sv:pcint):cint;
begin
fpSocketPair:=do_syscall(syscall_nr_SocketPair,d,xtype,protocol,TSysParam(sv));
end;
{$endif NEED_do_syscall}
{ {
$Log$ $Log$
Revision 1.12 2004-03-22 06:49:28 marco Revision 1.13 2004-04-22 17:17:23 peter
* x86-64 fixes
Revision 1.12 2004/03/22 06:49:28 marco
* more fixes from Lloyd * more fixes from Lloyd
Revision 1.11 2004/03/20 15:19:29 marco Revision 1.11 2004/03/20 15:19:29 marco

18
rtl/linux/unxsysc.inc
View File

@ -17,13 +17,24 @@
function fpNice(N:cint):cint; function fpNice(N:cint):cint;
{ {
Set process priority. A positive N means a lower priority. Set process priority. A positive N means a lower priority.
A negative N decreases priority. A negative N increases priority.
Doesn't exist in BSD. Linux emu uses setpriority in a construct as below: Doesn't exist in BSD. Linux emu uses setpriority in a construct as below:
} }
{$ifdef cpux86_64}
var
oldprio : cint;
{$endif}
begin begin
{$ifdef cpux86_64}
oldprio:=fpGetPriority(Prio_Process,0);
fpNice:=fpSetPriority(Prio_Process,0,oldprio+N);
if fpNice=0 then
fpNice:=fpGetPriority(Prio_Process,0);
{$else}
fpNice:=do_syscall(Syscall_nr_nice,N); fpNice:=do_syscall(Syscall_nr_nice,N);
{$endif}
end; end;
Function fpGetPriority(Which,Who:cint):cint; Function fpGetPriority(Which,Who:cint):cint;
@ -105,7 +116,10 @@ end;
{ {
$Log$ $Log$
Revision 1.4 2004-01-01 16:10:23 marco Revision 1.5 2004-04-22 17:17:23 peter
* x86-64 fixes
Revision 1.4 2004/01/01 16:10:23 marco
* fpreadlink(pathstr) moved to unxovl (since not platform specific), * fpreadlink(pathstr) moved to unxovl (since not platform specific),
small fixes for "make all OPT='-dFPC_USE_LIBC' small fixes for "make all OPT='-dFPC_USE_LIBC'

68
rtl/linux/x86_64/syscall.inc
View File

@ -30,7 +30,7 @@ asm
movq %r9, %r8 movq %r9, %r8
syscall { Do the system call. } syscall { Do the system call. }
cmpq $-4095, %rax { Check %rax for error. } cmpq $-4095, %rax { Check %rax for error. }
jnae .LSyscOK { Jump to error handler if error. } jnae .LSyscOK { Jump to error handler if error. }
negq %rax negq %rax
movq %rax,%rdx movq %rax,%rdx
movq FPC_THREADVAR_RELOCATE,%rax movq FPC_THREADVAR_RELOCATE,%rax
@ -56,7 +56,7 @@ asm
movq param1, %rdi { shift arg1 - arg5. } movq param1, %rdi { shift arg1 - arg5. }
syscall { Do the system call. } syscall { Do the system call. }
cmpq $-4095, %rax { Check %rax for error. } cmpq $-4095, %rax { Check %rax for error. }
jnae .LSyscOK { Jump to error handler if error. } jnae .LSyscOK { Jump to error handler if error. }
negq %rax negq %rax
movq %rax,%rdx movq %rax,%rdx
movq FPC_THREADVAR_RELOCATE,%rax movq FPC_THREADVAR_RELOCATE,%rax
@ -83,7 +83,7 @@ asm
movq param2, %rsi movq param2, %rsi
syscall { Do the system call. } syscall { Do the system call. }
cmpq $-4095, %rax { Check %rax for error. } cmpq $-4095, %rax { Check %rax for error. }
jnae .LSyscOK { Jump to error handler if error. } jnae .LSyscOK { Jump to error handler if error. }
negq %rax negq %rax
movq %rax,%rdx movq %rax,%rdx
movq FPC_THREADVAR_RELOCATE,%rax movq FPC_THREADVAR_RELOCATE,%rax
@ -111,7 +111,7 @@ asm
movq param3, %rdx movq param3, %rdx
syscall { Do the system call. } syscall { Do the system call. }
cmpq $-4095, %rax { Check %rax for error. } cmpq $-4095, %rax { Check %rax for error. }
jnae .LSyscOK { Jump to error handler if error. } jnae .LSyscOK { Jump to error handler if error. }
negq %rax negq %rax
movq %rax,%rdx movq %rax,%rdx
movq FPC_THREADVAR_RELOCATE,%rax movq FPC_THREADVAR_RELOCATE,%rax
@ -140,7 +140,7 @@ asm
movq param4, %r10 movq param4, %r10
syscall { Do the system call. } syscall { Do the system call. }
cmpq $-4095, %rax { Check %rax for error. } cmpq $-4095, %rax { Check %rax for error. }
jnae .LSyscOK { Jump to error handler if error. } jnae .LSyscOK { Jump to error handler if error. }
negq %rax negq %rax
movq %rax,%rdx movq %rax,%rdx
movq FPC_THREADVAR_RELOCATE,%rax movq FPC_THREADVAR_RELOCATE,%rax
@ -170,7 +170,7 @@ asm
movq param5, %r8 movq param5, %r8
syscall { Do the system call. } syscall { Do the system call. }
cmpq $-4095, %rax { Check %rax for error. } cmpq $-4095, %rax { Check %rax for error. }
jnae .LSyscOK { Jump to error handler if error. } jnae .LSyscOK { Jump to error handler if error. }
negq %rax negq %rax
movq %rax,%rdx movq %rax,%rdx
movq FPC_THREADVAR_RELOCATE,%rax movq FPC_THREADVAR_RELOCATE,%rax
@ -189,43 +189,38 @@ asm
.LSyscOK: .LSyscOK:
end; end;
{$ifdef notsupported}
{ Only 5 params are pushed, so it'll not work as expected (PFV) }
function FpSysCall(sysnr,param1,param2,param3,param4,param5,param6 : TSysParam):TSysResult; assembler;[public,alias:'FPC_SYSCALL6']; function FpSysCall(sysnr,param1,param2,param3,param4,param5,param6 : TSysParam):TSysResult; assembler;[public,alias:'FPC_SYSCALL6'];
asm asm
{ load the registers... } movq sysnr, %rax { Syscall number -> rax. }
movl sysnr,%eax movq param1, %rdi { shift arg1 - arg5. }
movl param1,%ebx movq param2, %rsi
movl param2,%ecx movq param3, %rdx
movl param3,%edx movq param4, %r10
movl param4,%esi movq param5, %r8
movl param5,%edi movq param6, %r9
int $0x80 syscall { Do the system call. }
testl %eax,%eax cmpq $-4095, %rax { Check %rax for error. }
jns .LSyscOK jnae .LSyscOK { Jump to error handler if error. }
negl %eax negq %rax
{$ifdef VER1_0} movq %rax,%rdx
movl %eax,Errno movq FPC_THREADVAR_RELOCATE,%rax
{$else} testq %rax,%rax
movl %eax,%edx
movl FPC_THREADVAR_RELOCATE,%eax
testl %eax,%eax
jne .LThread jne .LThread
movl %edx,Errno+4 movq %rdx,Errno+4
jmp .LNoThread jmp .LNoThread
.LThread: .LThread:
pushl %edx pushq %rdx
pushl Errno pushq Errno
call *%eax call *%rax
popl %edx popq %rdx
movl %edx,(%eax) movq %rdx,(%rax)
.LNoThread: .LNoThread:
movl $-1,%eax movq $-1,%rax
{$endif}
.LSyscOK: .LSyscOK:
end; end;
{$endif notsupported}
{No debugging for syslinux include !} {No debugging for syslinux include !}
{$IFDEF SYS_LINUX} {$IFDEF SYS_LINUX}
@ -235,7 +230,10 @@ end;
{ {
$Log$ $Log$
Revision 1.4 2004-02-06 23:06:16 florian Revision 1.5 2004-04-22 17:17:23 peter
* x86-64 fixes
Revision 1.4 2004/02/06 23:06:16 florian
- killed tsyscallregs - killed tsyscallregs
Revision 1.3 2004/02/06 15:58:21 florian Revision 1.3 2004/02/06 15:58:21 florian

34
rtl/linux/x86_64/syscallh.inc
View File

@ -39,13 +39,14 @@ function Do_SysCall(sysnr,param1,param2:TSysParam):TSysResult; external name 'F
function Do_SysCall(sysnr,param1,param2,param3:TSysParam):TSysResult; external name 'FPC_SYSCALL3'; function Do_SysCall(sysnr,param1,param2,param3:TSysParam):TSysResult; external name 'FPC_SYSCALL3';
function Do_SysCall(sysnr,param1,param2,param3,param4:TSysParam):TSysResult; external name 'FPC_SYSCALL4'; function Do_SysCall(sysnr,param1,param2,param3,param4:TSysParam):TSysResult; external name 'FPC_SYSCALL4';
function Do_SysCall(sysnr,param1,param2,param3,param4,param5:TSysParam):TSysResult; external name 'FPC_SYSCALL5'; function Do_SysCall(sysnr,param1,param2,param3,param4,param5:TSysParam):TSysResult; external name 'FPC_SYSCALL5';
{$ifdef notsupported} function Do_SysCall(sysnr,param1,param2,param3,param4,param5,param6:TSysParam):TSysResult; external name 'FPC_SYSCALL6';
function Do_SysCall(sysnr,param1,param2,param3,param4,param5,param6:TSysParam):TSysResult; external name 'FPC_SYSCALL5';
{$endif notsupported}
{ {
$Log$ $Log$
Revision 1.3 2004-02-06 15:58:21 florian Revision 1.4 2004-04-22 17:17:23 peter
* x86-64 fixes
Revision 1.3 2004/02/06 15:58:21 florian
* fixed x86-64 assembler problems * fixed x86-64 assembler problems
Revision 1.2 2003/05/01 08:05:23 florian Revision 1.2 2003/05/01 08:05:23 florian
@ -53,29 +54,4 @@ function Do_SysCall(sysnr,param1,param2,param3,param4,param5,param6:TSysParam):T
Revision 1.1 2003/04/30 22:11:06 florian Revision 1.1 2003/04/30 22:11:06 florian
+ for a lot of x86-64 dependend files mostly dummies added + for a lot of x86-64 dependend files mostly dummies added
Revision 1.3 2002/12/18 20:41:33 peter
* Threadvar support for Errno
* Fixed syscall error return check
* Uncommented Syscall with 6 parameters, only 5 were really set
Revision 1.2 2002/12/18 16:46:37 marco
* Some mods.
Revision 1.1 2002/11/16 15:37:47 marco
* TSysParam + result moved to -h
Revision 1.4 2002/10/16 18:44:00 marco
* and again for ftruncate (sigh)
Revision 1.3 2002/10/16 18:41:14 marco
* the 7 param syscall (for lseek and truncate) now returns a int64.
Revision 1.2 2002/09/07 16:01:17 peter
* old logs removed and tabs fixed
Revision 1.1 2002/08/20 08:28:14 marco
* Updates for new errno scheme.
} }

137
rtl/unix/ipc.pp
View File

@ -241,6 +241,27 @@ implementation
uses BaseUnix,Syscall; uses BaseUnix,Syscall;
//{$ifdef linux}
{$ifndef cpux86_64}
{$define NEED_IPCCALL}
{$endif}
//{$endif}
Function ftok (Path : String; ID : char) : TKey;
Var Info : TStat;
begin
If fpstat(path,info)<0 then
ftok:=-1
else
begin
ftok:= (info.st_ino and $FFFF) or ((info.st_dev and $ff) shl 16) or (byte(ID) shl 24)
end;
end;
{$ifdef NEED_IPCCALL}
{ The following definitions come from linux/ipc.h } { The following definitions come from linux/ipc.h }
Const Const
@ -259,38 +280,21 @@ Const
{ generic call that handles all IPC calls } { generic call that handles all IPC calls }
function ipccall(Call,First,Second,Third : Longint; P : Pointer) : longint; function ipccall(Call,First,Second,Third : Longint; P : Pointer) : longint;
begin begin
{$IFNDEF bsd} {$ifndef BSD}
ipccall:=do_syscall(syscall_nr_ipc,call,first,second,third,longint(P)); ipccall:=do_syscall(syscall_nr_ipc,call,first,second,third,longint(P));
{$Endif} {$endif}
ipcerror:=fpgetErrno; ipcerror:=fpgetErrno;
end; end;
Function ftok (Path : String; ID : char) : TKey;
Var Info : TStat;
begin
If fpstat(path,info)<0 then
ftok:=-1
else
begin
ftok:= (info.st_ino and $FFFF) or ((info.st_dev and $ff) shl 16) or (byte(ID) shl 24)
end;
end;
function shmget(key: Tkey; size:longint; flag:longint):longint; function shmget(key: Tkey; size:longint; flag:longint):longint;
begin begin
shmget:=ipccall (CALL_SHMGET,key,size,flag,nil); shmget:=ipccall (CALL_SHMGET,key,size,flag,nil);
end; end;
function shmat (shmid:longint; shmaddr:pchar; shmflg:longint): pchar; function shmat (shmid:longint; shmaddr:pchar; shmflg:longint): pchar;
Var raddr : pchar; Var raddr : pchar;
error : longint; error : longint;
begin begin
error:=ipccall(CALL_SHMAT,shmid,shmflg,longint(@raddr),shmaddr); error:=ipccall(CALL_SHMAT,shmid,shmflg,longint(@raddr),shmaddr);
If Error<0 then If Error<0 then
@ -309,29 +313,24 @@ begin
shmctl:=ipccall(CALL_SHMCTL,shmid,cmd,0,buf)=0; shmctl:=ipccall(CALL_SHMCTL,shmid,cmd,0,buf)=0;
end; end;
Function msgget(key:Tkey; msgflg:longint):longint; function msgget(key:Tkey; msgflg:longint):longint;
begin begin
msgget:=ipccall(CALL_MSGGET,key,msgflg,0,Nil); msgget:=ipccall(CALL_MSGGET,key,msgflg,0,Nil);
end; end;
Function msgsnd(msqid:longint; msgp: PMSGBuf; msgsz: longint; msgflg:longint):Boolean; function msgsnd(msqid:longint; msgp: PMSGBuf; msgsz: longint; msgflg:longint):Boolean;
begin begin
msgsnd:=ipccall(Call_MSGSND,msqid,msgsz,msgflg,msgp)=0; msgsnd:=ipccall(Call_MSGSND,msqid,msgsz,msgflg,msgp)=0;
end; end;
Function msgrcv(msqid:longint; msgp: PMSGBuf; msgsz: longint; msgtyp:longint; msgflg:longint):Boolean; function msgrcv(msqid:longint; msgp: PMSGBuf; msgsz: longint; msgtyp:longint; msgflg:longint):Boolean;
Type Type
TIPC_Kludge = Record TIPC_Kludge = Record
msgp : pmsgbuf; msgp : pmsgbuf;
msgtyp : longint; msgtyp : longint;
end; end;
Var Var
tmp : TIPC_Kludge; tmp : TIPC_Kludge;
begin begin
tmp.msgp := msgp; tmp.msgp := msgp;
tmp.msgtyp := msgtyp; tmp.msgtyp := msgtyp;
@ -339,19 +338,16 @@ begin
end; end;
Function msgctl(msqid:longint; cmd: longint; buf: PMSQid_ds): Boolean; Function msgctl(msqid:longint; cmd: longint; buf: PMSQid_ds): Boolean;
begin begin
msgctl:=ipccall(CALL_MSGCTL,msqid,cmd,0,buf)=0; msgctl:=ipccall(CALL_MSGCTL,msqid,cmd,0,buf)=0;
end; end;
Function semget(key:Tkey; nsems:longint; semflg:longint): longint; Function semget(key:Tkey; nsems:longint; semflg:longint): longint;
begin begin
semget:=ipccall (CALL_SEMGET,key,nsems,semflg,Nil); semget:=ipccall (CALL_SEMGET,key,nsems,semflg,Nil);
end; end;
Function semop(semid:longint; sops: pointer; nsops:cardinal): Boolean; Function semop(semid:longint; sops: pointer; nsops:cardinal): Boolean;
begin begin
semop:=ipccall (CALL_SEMOP,semid,Longint(nsops),0,Pointer(sops))=0; semop:=ipccall (CALL_SEMOP,semid,Longint(nsops),0,Pointer(sops))=0;
end; end;
@ -361,10 +357,87 @@ begin
semctl:=ipccall(CALL_SEMCTL,semid,semnum,cmd,@arg); semctl:=ipccall(CALL_SEMCTL,semid,semnum,cmd,@arg);
end; end;
{$else NEED_IPCCALL}
function shmget(key: Tkey; size:longint; flag:longint):longint;
begin
shmget:=do_syscall (syscall_nr_SHMGET,TSysParam(key),TSysParam(size),TSysParam(flag),TSysParam(0));
end;
function shmat (shmid:longint; shmaddr:pchar; shmflg:longint): pchar;
Var raddr : pchar;
error : longint;
begin
error:=do_syscall(syscall_nr_SHMAT,TSysParam(shmid),TSysParam(shmflg),TSysParam(@raddr),TSysParam(shmaddr));
If Error<0 then
shmat:=pchar(error)
else
shmat:=raddr;
end;
function shmdt (shmaddr:pchar): boolean;
begin
shmdt:=do_syscall(syscall_nr_SHMDT,TSysParam(0),TSysParam(0),TSysParam(0),TSysParam(shmaddr))<>-1;
end;
function shmctl(shmid:longint; cmd:longint; buf: pshmid_ds): Boolean;
begin
shmctl:=do_syscall(syscall_nr_SHMCTL,TSysParam(shmid),TSysParam(cmd),TSysParam(0),TSysParam(buf))=0;
end;
function msgget(key:Tkey; msgflg:longint):longint;
begin
msgget:=do_syscall(syscall_nr_MSGGET,TSysParam(key),TSysParam(msgflg),TSysParam(0),TSysParam(0));
end;
function msgsnd(msqid:longint; msgp: PMSGBuf; msgsz: longint; msgflg:longint):Boolean;
begin
msgsnd:=do_syscall(syscall_nr_MSGSND,TSysParam(msqid),TSysParam(msgsz),TSysParam(msgflg),TSysParam(msgp))=0;
end;
function msgrcv(msqid:longint; msgp: PMSGBuf; msgsz: longint; msgtyp:longint; msgflg:longint):Boolean;
Type
TIPC_Kludge = Record
msgp : pmsgbuf;
msgtyp : longint;
end;
Var
tmp : TIPC_Kludge;
begin
tmp.msgp := msgp;
tmp.msgtyp := msgtyp;
msgrcv:=do_syscall(syscall_nr_MSGRCV,TSysParam(msqid),TSysParam(msgsz),TSysParam(msgflg),TSysParam(@tmp))>=0;
end;
Function msgctl(msqid:longint; cmd: longint; buf: PMSQid_ds): Boolean;
begin
msgctl:=do_syscall(syscall_nr_MSGCTL,TSysParam(msqid),TSysParam(cmd),TSysParam(0),TSysParam(buf))=0;
end;
Function semget(key:Tkey; nsems:longint; semflg:longint): longint;
begin
semget:=do_syscall (syscall_nr_SEMGET,TSysParam(key),TSysParam(nsems),TSysParam(semflg),TSysParam(0));
end;
Function semop(semid:longint; sops: pointer; nsops:cardinal): Boolean;
begin
semop:=do_syscall (syscall_nr_SEMOP,TSysParam(semid),TSysParam(nsops),TSysParam(0),TSysParam(sops))=0;
end;
Function semctl(semid:longint; semnum:longint; cmd:longint; var arg: tsemun): longint;
begin
semctl:=do_syscall(syscall_nr_SEMCTL,TSysParam(semid),TSysParam(semnum),TSysParam(cmd),TSysParam(@arg));
end;
{$endif NEED_IPCCALL}
end. end.
{ {
$Log$ $Log$
Revision 1.7 2004-02-06 23:06:16 florian Revision 1.8 2004-04-22 17:17:13 peter
* x86-64 fixes
Revision 1.7 2004/02/06 23:06:16 florian
- killed tsyscallregs - killed tsyscallregs
Revision 1.6 2003/11/16 14:09:25 marco Revision 1.6 2003/11/16 14:09:25 marco

21
rtl/unix/unix.pp
View File

@ -537,7 +537,7 @@ Var
Begin Begin
If SearchPath and (pos('/',pathname)=0) Then If SearchPath and (pos('/',pathname)=0) Then
Begin Begin
// The above could be better. (check if not escaped/quoted '/' 's) ? // The above could be better. (check if not escaped/quoted '/'s) ?
// (Jilles says this is ok) // (Jilles says this is ok)
// Stevens says only search if newcmd contains no '/' // Stevens says only search if newcmd contains no '/'
// fsearch is not ansistring clean yet. // fsearch is not ansistring clean yet.
@ -882,11 +882,23 @@ function intstime (t:ptime_t):cint; external name 'stime';
{$endif} {$endif}
Function stime (t : cint) : boolean; Function stime (t : cint) : boolean;
{$ifndef FPC_USE_LIBC}
{$ifdef cpux86_64}
var
tv : ttimeval;
{$endif}
{$endif}
begin begin
{$ifdef FPC_USE_LIBC} {$ifdef FPC_USE_LIBC}
stime:=intstime(@t)=0; stime:=intstime(@t)=0;
{$else} {$else}
stime:=do_SysCall(Syscall_nr_stime,cint(@t))=0; {$ifdef cpux86_64}
tv.tv_sec:=t;
tv.tv_usec:=0;
stime:=do_SysCall(Syscall_nr_settimeofday,TSysParam(@tv),0)=0;
{$else}
stime:=do_SysCall(Syscall_nr_stime,TSysParam(@t))=0;
{$endif}
{$endif} {$endif}
end; end;
{$endif} {$endif}
@ -1742,7 +1754,10 @@ End.
{ {
$Log$ $Log$
Revision 1.68 2004-03-04 22:15:17 marco Revision 1.69 2004-04-22 17:17:13 peter
* x86-64 fixes
Revision 1.68 2004/03/04 22:15:17 marco
* UnixType changes. Please report problems to me. * UnixType changes. Please report problems to me.
Revision 1.66 2004/02/16 13:21:18 marco Revision 1.66 2004/02/16 13:21:18 marco