Browse Source

* IPC reform

marco 21 years ago
parent
commit
1340afc320
4 changed files with 563 additions and 262 deletions
  1. 92 0
      rtl/bsd/ipcbsd.inc
  2. 125 0
      rtl/linux/ipccall.inc
  3. 107 0
      rtl/linux/ipcsys.inc
  4. 239 262
      rtl/unix/ipc.pp

+ 92 - 0
rtl/bsd/ipcbsd.inc

@@ -0,0 +1,92 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2004 by Marco van de Voort
+    member of the Free Pascal development team
+
+    *BSD syscalls for ipc unit.
+
+    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.
+
+ **********************************************************************}
+
+function ftok(path:Pchar; id:cint):key_t;
+
+var st:stat;
+
+begin
+  if fpstat(path,st)<0 then 
+   ftok:=key_t(-1)
+ else
+   ftok:=key_t( byte(id) shl 24 + ((st.st_dev and 255) shl 16) + (st.st_ino and $ffff)); 
+end;
+
+function shmget(key:key_t;size:cint;flag:cint):cint;
+begin
+  shmget:=do_syscall(syscall_nr_shmsys,3, key, size, flag);
+end;
+
+Function shmat (shmid:cint; shmaddr:pointer; shmflg:cint):pointer;
+begin
+  shmat:=pointer(do_syscall(syscall_nr_shmsys,0, shmid, TSysParam(shmaddr), shmflg));
+end;
+
+Function shmdt (shmaddr:pointer):cint;
+
+begin
+  shmdt:=do_syscall(syscall_nr_shmsys,2, TSysParam(shmaddr));
+end;
+
+Function shmctl(shmid:cint; cmd:cint; buf: pshmid_ds): cint;
+
+begin
+  shmctl:= do_syscall(syscall_nr_shmsys,4, shmid, cmd, TSysParam(buf));
+end;
+
+Function semget(key:Tkey; nsems:cint; semflg:cint): cint;
+begin
+  semget:=do_syscall(syscall_nr_semsys,1, key, nsems, semflg);
+end;
+
+Function semop(semid:cint; sops: psembuf; nsops: cuint): cint;
+begin
+  semop:=do_syscall(syscall_nr_semsys,2, semid, TSysParam(sops), nsops, 0);
+end;
+
+Function semctl(semid:cint; semnum:cint; cmd:cint; var arg: tsemun): cint;
+begin
+  semctl:=cint(do_syscall(syscall_nr_semsys, 0, semid, semnum, cmd,TSysParam(@arg)));
+end;
+
+Function msgget(key: TKey; msgflg:cint):cint;
+begin
+  msgget:=do_syscall(syscall_nr_msgsys,1, key, msgflg);
+end;
+
+Function msgsnd(msqid:cint; msgp: PMSGBuf; msgsz: size_t; msgflg:cint): cint;
+begin
+  msgsnd:=do_syscall(syscall_nr_msgsys,2, msqid, TSysParam(msgp), TSysParam(msgsz), msgflg);
+end;
+
+Function msgrcv(msqid:cint; msgp: PMSGBuf; msgsz: size_t; msgtyp:cint; msgflg:cint):cint;
+begin
+  msgrcv:=(do_syscall(syscall_nr_msgsys,3, msqid, TSysParam(msgp), msgsz, msgtyp, msgflg));
+end;
+
+Function msgctl(msqid:cint; cmd: cint; buf: PMSQid_ds): cint;
+begin
+ msgctl:= (do_syscall(syscall_nr_msgsys,0, msqid, cmd, tsysparam(buf)));
+end;
+
+{
+  $Log$
+  Revision 1.1  2004-04-25 19:15:43  marco
+   * IPC reform
+
+
+}

+ 125 - 0
rtl/linux/ipccall.inc

@@ -0,0 +1,125 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2001 by Free Pascal development team
+
+    Linux IPC implemented with ipccall
+
+    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.
+
+ ***********************************************************************}
+{ The following definitions come from linux/ipc.h }
+
+Function ftok (Path : pchar; ID : cint) : 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;
+
+Const
+  CALL_SEMOP   = 1;
+  CALL_SEMGET  = 2;
+  CALL_SEMCTL  = 3;
+  CALL_MSGSND  = 11;
+  CALL_MSGRCV  = 12;
+  CALL_MSGGET  = 13;
+  CALL_MSGCTL  = 14;
+  CALL_SHMAT   = 21;
+  CALL_SHMDT   = 22;
+  CALL_SHMGET  = 23;
+  CALL_SHMCTL  = 24;
+
+{ generic call that handles all IPC calls }
+
+function ipccall(Call,First,Second,Third : cint; P : Pointer) : cint;
+begin
+ ipccall:=do_syscall(syscall_nr_ipc,call,first,second,third,cint(P));
+// ipcerror:=fpgetErrno;
+end;
+
+function shmget(key: Tkey; size:cint; flag:cint):cint;
+begin
+  shmget:=ipccall (CALL_SHMGET,key,size,flag,nil);
+end;
+
+Function shmat (shmid:cint; shmaddr:pointer; shmflg:cint):pointer;
+Var raddr : pchar;
+    error : cint;
+begin
+  error:=ipccall(CALL_SHMAT,shmid,shmflg,cint(@raddr),shmaddr);
+  If Error<0 then
+    shmat:=pchar(error)
+  else
+    shmat:=raddr;
+end;
+
+function shmdt (shmaddr:pointer): cint;
+begin
+  shmdt:=ipccall(CALL_SHMDT,0,0,0,shmaddr);
+end;
+
+function shmctl(shmid:cint; cmd:cint; buf: pshmid_ds): cint;
+begin
+ shmctl:=ipccall(CALL_SHMCTL,shmid,cmd,0,buf);
+end;
+
+function msgget(key:Tkey; msgflg:cint):cint;
+begin
+  msgget:=ipccall(CALL_MSGGET,key,msgflg,0,Nil);
+end;
+
+function msgsnd(msqid:cint; msgp: PMSGBuf; msgsz: size_t; msgflg:cint):cint;
+begin
+  msgsnd:=ipccall(Call_MSGSND,msqid,msgsz,msgflg,msgp);
+end;
+
+function msgrcv(msqid:cint; msgp: PMSGBuf; msgsz: size_t; msgtyp:cint; msgflg:cint):cint;
+Type
+  TIPC_Kludge = Record
+    msgp   : pmsgbuf;
+    msgtyp : cint;
+  end;
+Var
+   tmp : TIPC_Kludge;
+begin
+  tmp.msgp   := msgp;
+  tmp.msgtyp := msgtyp;
+  msgrcv:=ipccall(CALL_MSGRCV,msqid,msgsz,msgflg,@tmp);
+end;
+
+Function msgctl(msqid:cint; cmd: cint; buf: PMSQid_ds): cint;
+begin
+  msgctl:=ipccall(CALL_MSGCTL,msqid,cmd,0,buf);
+end;
+
+Function semget(key:Tkey; nsems:cint; semflg:cint): cint;
+begin
+  semget:=ipccall (CALL_SEMGET,key,nsems,semflg,Nil);
+end;
+
+Function semop(semid:cint; sops: psembuf; nsops:cuint): cint;
+begin
+  semop:=ipccall (CALL_SEMOP,semid,cint(nsops),0,Pointer(sops));
+end;
+
+Function semctl(semid:cint; semnum:cint; cmd:cint; var arg: tsemun): cint;
+begin
+  semctl:=ipccall(CALL_SEMCTL,semid,semnum,cmd,@arg);
+end;
+
+{
+  $Log$
+  Revision 1.1  2004-04-25 19:15:43  marco
+   * IPC reform
+
+}

+ 107 - 0
rtl/linux/ipcsys.inc

@@ -0,0 +1,107 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2001 by Free Pascal development team
+
+    Ipc body implemented using direct linux syscalls
+
+    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.
+
+ ***********************************************************************}
+
+
+Function ftok (Path : pchar; ID : cint) : 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:cint; flag:cint):cint;
+begin
+  shmget:=do_syscall (syscall_nr_SHMGET,TSysParam(key),TSysParam(size),TSysParam(flag),TSysParam(0));
+end;
+
+function shmat (shmid:cint; shmaddr:pointer; shmflg:cint): pointer;
+Var raddr : pointer;
+    error : cint;
+begin
+  error:=do_syscall(syscall_nr_SHMAT,TSysParam(shmid),TSysParam(shmflg),TSysParam(@raddr),TSysParam(shmaddr));
+  If Error<0 then
+    shmat:=pointer(error)
+  else
+    shmat:=raddr;
+end;
+
+function shmdt (shmaddr:pointer): cint;
+begin
+  shmdt:=do_syscall(syscall_nr_SHMDT,TSysParam(0),TSysParam(0),TSysParam(0),TSysParam(shmaddr));
+end;
+
+function shmctl(shmid:cint; cmd:cint; buf: pshmid_ds): cint;
+begin
+ shmctl:=do_syscall(syscall_nr_SHMCTL,TSysParam(shmid),TSysParam(cmd),TSysParam(0),TSysParam(buf));
+end;
+
+function msgget(key:Tkey; msgflg:cint):cint;
+begin
+  msgget:=do_syscall(syscall_nr_MSGGET,TSysParam(key),TSysParam(msgflg),TSysParam(0),TSysParam(0));
+end;
+
+function msgsnd(msqid:cint; msgp: pmsgbuf; msgsz: size_t; msgflg:cint):cint;
+begin
+  msgsnd:=do_syscall(syscall_nr_MSGSND,TSysParam(msqid),TSysParam(msgsz),TSysParam(msgflg),TSysParam(msgp));
+end;
+
+function msgrcv(msqid:cint; msgp: PMSGBuf; msgsz: size_t; msgtyp:cint; msgflg:cint):cint;
+Type
+  TIPC_Kludge = Record
+    msgp   : pmsgbuf;
+    msgtyp : cint;
+  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));
+end;
+
+Function msgctl(msqid:cint; cmd: cint; buf: PMSQid_ds): cint;
+begin
+  msgctl:=do_syscall(syscall_nr_MSGCTL,TSysParam(msqid),TSysParam(cmd),TSysParam(0),TSysParam(buf));
+end;
+
+Function semget(key:Tkey; nsems:cint; semflg:cint): cint;
+begin
+  semget:=do_syscall (syscall_nr_SEMGET,TSysParam(key),TSysParam(nsems),TSysParam(semflg),TSysParam(0));
+end;
+
+Function semop(semid:cint; sops: psembuf; nsops:cuint): cint;
+begin
+  semop:=do_syscall (syscall_nr_SEMOP,TSysParam(semid),TSysParam(nsops),TSysParam(0),TSysParam(sops));
+end;
+
+Function semctl(semid:cint; semnum:cint; cmd:cint; var arg: tsemun): cint;
+begin
+  semctl:=do_syscall(syscall_nr_SEMCTL,TSysParam(semid),TSysParam(semnum),TSysParam(cmd),TSysParam(@arg));
+end;
+
+{
+  $Log$
+  Revision 1.1  2004-04-25 19:15:43  marco
+   * IPC reform
+
+}
+
+ 

+ 239 - 262
rtl/unix/ipc.pp

@@ -1,9 +1,9 @@
 {
 {
     $Id$
     $Id$
     This file is part of the Free Pascal run time library.
     This file is part of the Free Pascal run time library.
-    Copyright (c) 1999-2000 by the Free Pascal development team
+    Copyright (c) 1999-2004 by the Free Pascal development team
 
 
-    This file implements IPC calls calls for Linux
+    This file implements IPC calls calls for Linu/FreeBSD
 
 
     See the file COPYING.FPC, included in this distribution,
     See the file COPYING.FPC, included in this distribution,
     for details about the copyright.
     for details about the copyright.
@@ -18,25 +18,42 @@ Unit ipc;
 
 
 interface
 interface
 
 
+Uses BaseUnix;
+
 { ----------------------------------------------------------------------
 { ----------------------------------------------------------------------
   General IPC stuff
   General IPC stuff
   ----------------------------------------------------------------------}
   ----------------------------------------------------------------------}
 
 
-Var
-  IPCError : longint;
+//Var
+//  IPCError : longint;
 
 
 Type
 Type
-   TKey   = Longint;
-   PULong = ^Cardinal;
-   PWord  = ^Word;
+
+   {$IFDEF FreeBSD}
+   TKey   = clong;
+   {$ELSE}
+   TKey   = longint;
+   {$ENDIF}
+   key_t  = TKey;
+   
 
 
 Const
 Const
   { IPC flags for get calls }
   { IPC flags for get calls }
 
 
+{$ifdef FreeBSD}  // BSD_VISIBLE
+  IPC_R	     =  4 shl 6;
+  IPC_W	     =  2 shl 6;
+  IPC_M	     =  2 shl 12;
+{$endif}
+
   IPC_CREAT  =  1 shl 9;  { create if key is nonexistent }
   IPC_CREAT  =  1 shl 9;  { create if key is nonexistent }
   IPC_EXCL   =  2 shl 9;  { fail if key exists }
   IPC_EXCL   =  2 shl 9;  { fail if key exists }
   IPC_NOWAIT =  4 shl 9;  { return error on wait }
   IPC_NOWAIT =  4 shl 9;  { return error on wait }
 
 
+  {$IFDEF FreeBSD}
+  IPC_PRIVATE : TKey = 0;
+  {$ENDIF}
+
   { Actions for ctl calls }
   { Actions for ctl calls }
 
 
   IPC_RMID = 0;     { remove resource }
   IPC_RMID = 0;     { remove resource }
@@ -46,25 +63,38 @@ Const
 
 
 type
 type
   PIPC_Perm = ^TIPC_Perm;
   PIPC_Perm = ^TIPC_Perm;
+  {$ifdef FreeBSD} 
   TIPC_Perm = record
   TIPC_Perm = record
-    key : TKey;
-    uid,
-    gid,
-    cuid,
-    cgid,
-    mode,
-    seq : Word;
-  end;
+        cuid  : cushort;  { creator user id }
+        cgid  : cushort;  { creator group id }
+        uid   : cushort;  { user id }
+        gid   : cushort;  { group id }
+        mode  : cushort;  { r/w permission }
+        seq   : cushort;  { sequence # (to generate unique msg/sem/shm id) }
+        key   : key_t;    { user specified msg/sem/shm key }
+        End;
+  {$else} // linux
+  TIPC_Perm = record
+        key   : TKey;
+        uid,
+        gid,
+        cuid,
+        cgid,
+        mode,
+        seq   : Word;
+        End;
+  {$endif}
 
 
 { Function to generate a IPC key. }
 { Function to generate a IPC key. }
-Function ftok (Path : String; ID : char) : TKey;
+Function ftok (Path : pchar;  ID : cint) : TKey;
 
 
 { ----------------------------------------------------------------------
 { ----------------------------------------------------------------------
-  Shared memory stuff
+  Sys V Shared memory stuff
   ----------------------------------------------------------------------}
   ----------------------------------------------------------------------}
 
 
 Type
 Type
   PShmid_DS = ^TShmid_ds;
   PShmid_DS = ^TShmid_ds;
+{$ifdef linux}
   TShmid_ds = record
   TShmid_ds = record
     shm_perm  : TIPC_Perm;
     shm_perm  : TIPC_Perm;
     shm_segsz : longint;
     shm_segsz : longint;
@@ -78,30 +108,70 @@ Type
     shm_pages  : Pointer;
     shm_pages  : Pointer;
     attaches   : pointer;
     attaches   : pointer;
   end;
   end;
+{$else} // FreeBSD checked
+  TShmid_ds = record
+    shm_perm  : TIPC_Perm;
+    shm_segsz : cint;
+    shm_lpid  : pid_t;
+    shm_cpid  : pid_t;
+    shm_nattch : cshort;
+    shm_atime : time_t;
+    shm_dtime : time_t;
+    shm_ctime : time_t;
+    shm_internal : pointer;
+  end;
+{$endif}
 
 
   const
   const
+{$ifdef linux}
      SHM_R      = 4 shl 6;
      SHM_R      = 4 shl 6;
      SHM_W      = 2 shl 6;
      SHM_W      = 2 shl 6;
+{$else}
+     SHM_R	= IPC_R;
+     SHM_W	= IPC_W;
+{$endif}
+
      SHM_RDONLY = 1 shl 12;
      SHM_RDONLY = 1 shl 12;
      SHM_RND    = 2 shl 12;
      SHM_RND    = 2 shl 12;
+{$ifdef Linux}
      SHM_REMAP  = 4 shl 12;
      SHM_REMAP  = 4 shl 12;
+{$endif}
+
      SHM_LOCK   = 11;
      SHM_LOCK   = 11;
      SHM_UNLOCK = 12;
      SHM_UNLOCK = 12;
 
 
-type
+{$ifdef FreeBSD}	// ipcs shmctl commands
+     SHM_STAT   = 13;
+     SHM_INFO   = 14;
+{$endif}
+    
+type		// the shm*info kind is "kernel" only.
   PSHMinfo = ^TSHMinfo;
   PSHMinfo = ^TSHMinfo;
-  TSHMinfo = record
-    shmmax : longint;
-    shmmin : longint;
-    shmmni : longint;
-    shmseg : longint;
-    shmall : longint;
+  TSHMinfo = record		// comment under FreeBSD: do we really need
+				// this?	
+    shmmax : cint;
+    shmmin : cint;
+    shmmni : cint;
+    shmseg : cint;
+    shmall : cint;
+  end;
+
+{$ifdef FreeBSD}
+  PSHM_info = ^TSHM_info;
+  TSHM_info = record
+    used_ids : cint;
+    shm_tot,
+    shm_rss,
+    shm_swp,
+    swap_attempts,
+    swap_successes : culong;
   end;
   end;
+{$endif}
 
 
-Function shmget(key: Tkey; size:longint; flag:longint):longint;
-Function shmat (shmid:longint; shmaddr:pchar; shmflg:longint):pchar;
-Function shmdt (shmaddr:pchar):boolean;
-Function shmctl(shmid:longint; cmd:longint; buf: pshmid_ds): Boolean;
+Function shmget(key: Tkey; size:cint; flag:cint):cint;
+Function shmat (shmid:cint; shmaddr:pointer; shmflg:cint):pointer;
+Function shmdt (shmaddr:pointer):cint;
+Function shmctl(shmid:cint; cmd:cint; buf: pshmid_ds): cint;
 
 
 { ----------------------------------------------------------------------
 { ----------------------------------------------------------------------
   Message queue stuff
   Message queue stuff
@@ -109,25 +179,33 @@ Function shmctl(shmid:longint; cmd:longint; buf: pshmid_ds): Boolean;
 
 
 const
 const
   MSG_NOERROR = 1 shl 12;
   MSG_NOERROR = 1 shl 12;
+
+{$ifdef Linux}
   MSG_EXCEPT  = 2 shl 12;
   MSG_EXCEPT  = 2 shl 12;
 
 
   MSGMNI = 128;
   MSGMNI = 128;
   MSGMAX = 4056;
   MSGMAX = 4056;
   MSGMNB = 16384;
   MSGMNB = 16384;
-
+{$endif}
 
 
 type
 type
+  msglen_t = culong;
+  msgqnum_t= culong;
+
   PMSG = ^TMSG;
   PMSG = ^TMSG;
   TMSG = record
   TMSG = record
+{$ifndef FreeBSD}			// opague in FreeBSD
     msg_next  : PMSG;
     msg_next  : PMSG;
     msg_type  : Longint;
     msg_type  : Longint;
     msg_spot  : PChar;
     msg_spot  : PChar;
     msg_stime : Longint;
     msg_stime : Longint;
     msg_ts    : Integer;
     msg_ts    : Integer;
+{$endif}
   end;
   end;
 
 
 type
 type
 
 
+{$ifdef Linux}
   PMSQid_ds = ^TMSQid_ds;
   PMSQid_ds = ^TMSQid_ds;
   TMSQid_ds = record
   TMSQid_ds = record
     msg_perm   : TIPC_perm;
     msg_perm   : TIPC_perm;
@@ -144,13 +222,34 @@ type
     msg_lspid  : word;
     msg_lspid  : word;
     msg_lrpid  : word;
     msg_lrpid  : word;
   end;
   end;
+{$else}
+  PMSQid_ds = ^TMSQid_ds;
+  TMSQid_ds = record
+    msg_perm   : TIPC_perm;
+    msg_first  : PMsg;
+    msg_last   : PMsg;
+    msg_cbytes : msglen_t;
+    msg_qnum   : msgqnum_t;
+    msg_qbytes : msglen_t;
+    msg_lspid  : pid_t;
+    msg_lrpid  : pid_t;
+    msg_stime  : time_t;
+    msg_pad1   : clong;
+    msg_rtime  : time_t;
+    msg_pad2   : clong;
+    msg_ctime  : time_t;
+    msg_pad3   : clong;
+    msg_pad4   : array [0..3] of clong;
+  end;
+{$endif}
 
 
   PMSGbuf = ^TMSGbuf;
   PMSGbuf = ^TMSGbuf;
-  TMSGbuf = record
+  TMSGbuf = record		// called mymsg on freebsd and SVID manual
     mtype : longint;
     mtype : longint;
     mtext : array[0..0] of char;
     mtext : array[0..0] of char;
   end;
   end;
 
 
+{$ifdef linux}
   PMSGinfo = ^TMSGinfo;
   PMSGinfo = ^TMSGinfo;
   TMSGinfo = record
   TMSGinfo = record
     msgpool : Longint;
     msgpool : Longint;
@@ -162,33 +261,63 @@ type
     msgtql  : Longint;
     msgtql  : Longint;
     msgseg  : Word;
     msgseg  : Word;
   end;
   end;
+{$else}
+  PMSGinfo = ^TMSGinfo;
+  TMSGinfo = record
+    msgmax,  
+    msgmni,  
+    msgmnb,  
+    msgtql,  
+    msgssz,  
+    msgseg  : cint;
+  end;
+{$endif}
 
 
-Function msgget(key: TKey; msgflg:longint):longint;
-Function msgsnd(msqid:longint; msgp: PMSGBuf; msgsz: longint; msgflg:longint): Boolean;
-Function msgrcv(msqid:longint; msgp: PMSGBuf; msgsz: longint; msgtyp:longint; msgflg:longint): Boolean;
-Function msgctl(msqid:longint; cmd: longint; buf: PMSQid_ds): Boolean;
+Function msgget(key: TKey; msgflg:cint):cint;
+Function msgsnd(msqid:cint; msgp: PMSGBuf; msgsz: size_t; msgflg:cint): cint;
+Function msgrcv(msqid:cint; msgp: PMSGBuf; msgsz: size_t; msgtyp:cint; msgflg:cint):cint;
+Function msgctl(msqid:cint; cmd: cint; buf: PMSQid_ds): cint;
 
 
 { ----------------------------------------------------------------------
 { ----------------------------------------------------------------------
   Semaphores stuff
   Semaphores stuff
   ----------------------------------------------------------------------}
   ----------------------------------------------------------------------}
 
 
 const
 const
+{$ifdef Linux}			// renamed to many name clashes
   SEM_UNDO = $1000;
   SEM_UNDO = $1000;
-  ipc_GETPID = 11;
-  ipc_GETVAL = 12;
-  ipc_GETALL = 13;
-  ipc_GETNCNT = 14;
-  ipc_GETZCNT = 15;
-  ipc_SETVAL = 16;
-  ipc_SETALL = 17;
-
-  SEMMNI = 128;
-  SEMMSL = 32;
-  SEMMNS = (SEMMNI * SEMMSL);
-  SEMOPM = 32;
-  SEMVMX = 32767;
+  SEM_GETPID = 11;
+  SEM_GETVAL = 12;
+  SEM_GETALL = 13;
+  SEM_GETNCNT = 14;
+  SEM_GETZCNT = 15;
+  SEM_SETVAL = 16;
+  SEM_SETALL = 17;
+
+  SEM_SEMMNI = 128;
+  SEM_SEMMSL = 32;
+  SEM_SEMMNS = (SEM_SEMMNI * SEM_SEMMSL);
+  SEM_SEMOPM = 32;
+  SEM_SEMVMX = 32767;
+{$else}
+  SEM_UNDO = 1 shl 12; 
+  MAX_SOPS = 5;
+
+  SEM_GETNCNT = 3;   { Return the value of sempid {READ}  }
+  SEM_GETPID  = 4;   { Return the value of semval {READ}  }
+  SEM_GETVAL  = 5;   { Return semvals into arg.array {READ}  }
+  SEM_GETALL  = 6;   { Return the value of semzcnt {READ}  }
+  SEM_GETZCNT = 7;   { Set the value of semval to arg.val {ALTER}  }
+  SEM_SETVAL  = 8;   { Set semvals from arg.array {ALTER}  }
+  SEM_SETALL  = 9;
+
+  { Permissions  }
+
+  SEM_A = 2 shl 6;  { alter permission  }
+  SEM_R = 4 shl 6;  { read permission  }
+{$endif}
 
 
 type
 type
+{$ifdef Linux}
   PSEMid_ds = ^TSEMid_ds;
   PSEMid_ds = ^TSEMid_ds;
   TSEMid_ds = record
   TSEMid_ds = record
     sem_perm : tipc_perm;
     sem_perm : tipc_perm;
@@ -200,248 +329,96 @@ type
     undo             : pointer;
     undo             : pointer;
     sem_nsems : word;
     sem_nsems : word;
   end;
   end;
+{$else}
+
+     sem=record end; // opague
+
+  PSEMid_ds = ^TSEMid_ds;
+  TSEMid_ds = record
+          sem_perm : tipc_perm;
+          sem_base : ^sem;
+          sem_nsems : cushort;
+          sem_otime : time_t;
+          sem_pad1 : cint;
+          sem_ctime : time_t;
+          sem_pad2 : cint;
+          sem_pad3 : array[0..3] of cint;
+       end;
+{$endif}
 
 
   PSEMbuf = ^TSEMbuf;
   PSEMbuf = ^TSEMbuf;
   TSEMbuf = record
   TSEMbuf = record
-    sem_num : word;
-    sem_op  : integer;
-    sem_flg : integer;
+    sem_num : cushort;
+    sem_op  : cshort;
+    sem_flg : cshort;
   end;
   end;
 
 
 
 
   PSEMinfo = ^TSEMinfo;
   PSEMinfo = ^TSEMinfo;
   TSEMinfo = record
   TSEMinfo = record
-    semmap : longint;
-    semmni : longint;
-    semmns : longint;
-    semmnu : longint;
-    semmsl : longint;
-    semopm : longint;
-    semume : longint;
-    semusz : longint;
-    semvmx : longint;
-    semaem : longint;
+    semmap : cint;
+    semmni : cint;
+    semmns : cint;
+    semmnu : cint;
+    semmsl : cint;
+    semopm : cint;
+    semume : cint;
+    semusz : cint;
+    semvmx : cint;
+    semaem : cint;
   end;
   end;
 
 
+{ internal mode bits}
+
+{$ifdef FreeBSD}
+Const
+  SEM_ALLOC = 1 shl 9;
+  SEM_DEST  = 2 shl 9;
+{$endif}
+
+Type
   PSEMun = ^TSEMun;
   PSEMun = ^TSEMun;
   TSEMun = record
   TSEMun = record
-   case longint of
-      0 : ( val : longint );
+   case cint of
+      0 : ( val : cint );
       1 : ( buf : PSEMid_ds );
       1 : ( buf : PSEMid_ds );
-      2 : ( arr : PWord );
+      2 : ( arr : PWord );		// ^ushort
+{$ifdef linux}
       3 : ( padbuf : PSeminfo );
       3 : ( padbuf : PSeminfo );
       4 : ( padpad : pointer );
       4 : ( padpad : pointer );
+{$endif}
    end;
    end;
 
 
-Function semget(key:Tkey; nsems:longint; semflg:longint): longint;
-Function semop(semid:longint; sops: pointer; nsops: cardinal): Boolean;
-Function semctl(semid:longint; semnum:longint; cmd:longint; var arg: tsemun): longint;
+Function semget(key:Tkey; nsems:cint; semflg:cint): cint;
+Function semop(semid:cint; sops: psembuf; nsops: cuint): cint;
+Function semctl(semid:cint; semnum:cint; cmd:cint; var arg: tsemun): longint;
 
 
 implementation
 implementation
 
 
-uses BaseUnix,Syscall;
+uses Syscall;
 
 
-//{$ifdef linux}
-  {$ifndef cpux86_64}
-    {$define NEED_IPCCALL}
+{$ifdef FPC_USE_LIBC}
+ {$i ipccdecl.inc}
+{$else}
+ {$ifdef Linux}
+  {$ifdef cpux86_64}
+    {$i ipcsys.inc}
+  {$else}
+    {$i ipccall.inc}
   {$endif}
   {$endif}
-//{$endif}
-
+ {$endif}
+ {$ifdef BSD}
+   {$i ipcbsd.inc}
+ {$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 }
-
-Const
-  CALL_SEMOP   = 1;
-  CALL_SEMGET  = 2;
-  CALL_SEMCTL  = 3;
-  CALL_MSGSND  = 11;
-  CALL_MSGRCV  = 12;
-  CALL_MSGGET  = 13;
-  CALL_MSGCTL  = 14;
-  CALL_SHMAT   = 21;
-  CALL_SHMDT   = 22;
-  CALL_SHMGET  = 23;
-  CALL_SHMCTL  = 24;
-
-{ generic call that handles all IPC calls }
-
-function ipccall(Call,First,Second,Third : Longint; P : Pointer) : longint;
-begin
-{$ifndef BSD}
- ipccall:=do_syscall(syscall_nr_ipc,call,first,second,third,longint(P));
-{$endif} 
- ipcerror:=fpgetErrno;
-end;
-
-function shmget(key: Tkey; size:longint; flag:longint):longint;
-begin
-  shmget:=ipccall (CALL_SHMGET,key,size,flag,nil);
-end;
-
-function shmat (shmid:longint; shmaddr:pchar; shmflg:longint): pchar;
-Var raddr : pchar;
-    error : longint;
-begin
-  error:=ipccall(CALL_SHMAT,shmid,shmflg,longint(@raddr),shmaddr);
-  If Error<0 then
-    shmat:=pchar(error)
-  else
-    shmat:=raddr;
-end;
-
-function shmdt (shmaddr:pchar): boolean;
-begin
-  shmdt:=ipccall(CALL_SHMDT,0,0,0,shmaddr)<>-1;
-end;
-
-function shmctl(shmid:longint; cmd:longint; buf: pshmid_ds): Boolean;
-begin
- shmctl:=ipccall(CALL_SHMCTL,shmid,cmd,0,buf)=0;
-end;
-
-function msgget(key:Tkey; msgflg:longint):longint;
-begin
-  msgget:=ipccall(CALL_MSGGET,key,msgflg,0,Nil);
-end;
-
-function msgsnd(msqid:longint; msgp: PMSGBuf; msgsz: longint; msgflg:longint):Boolean;
-begin
-  msgsnd:=ipccall(Call_MSGSND,msqid,msgsz,msgflg,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:=ipccall(CALL_MSGRCV,msqid,msgsz,msgflg,@tmp)>=0;
-end;
-
-Function msgctl(msqid:longint; cmd: longint; buf: PMSQid_ds): Boolean;
-begin
-  msgctl:=ipccall(CALL_MSGCTL,msqid,cmd,0,buf)=0;
-end;
-
-Function semget(key:Tkey; nsems:longint; semflg:longint): longint;
-begin
-  semget:=ipccall (CALL_SEMGET,key,nsems,semflg,Nil);
-end;
-
-Function semop(semid:longint; sops: pointer; nsops:cardinal): Boolean;
-begin
-  semop:=ipccall (CALL_SEMOP,semid,Longint(nsops),0,Pointer(sops))=0;
-end;
-
-Function semctl(semid:longint; semnum:longint; cmd:longint; var arg: tsemun): longint;
-begin
-  semctl:=ipccall(CALL_SEMCTL,semid,semnum,cmd,@arg);
-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.8  2004-04-22 17:17:13  peter
-    * x86-64 fixes
-
-  Revision 1.7  2004/02/06 23:06:16  florian
-    - killed tsyscallregs
-
-  Revision 1.6  2003/11/16 14:09:25  marco
-   * few things renamed
+  Revision 1.9  2004-04-25 19:15:43  marco
+   * IPC reform
 
 
   Revision 1.5  2003/09/14 20:15:01  marco
   Revision 1.5  2003/09/14 20:15:01  marco
    * Unix reform stage two. Remove all calls from Unix that exist in Baseunix.
    * Unix reform stage two. Remove all calls from Unix that exist in Baseunix.