Browse Source

* fixes after Mac OS X ipc patches

marco 20 years ago
parent
commit
1433ef8324
2 changed files with 24 additions and 17 deletions
  1. 11 9
      docs/ipcex/msgtool.pp
  2. 13 8
      docs/ipcex/semtool.pp

+ 11 - 9
docs/ipcex/msgtool.pp

@@ -1,6 +1,6 @@
 program msgtool;
 
-Uses ipc;
+Uses ipc,baseunix;
 
 Type
   PMyMsgBuf = ^TMyMsgBuf;
@@ -12,7 +12,7 @@ Type
 Procedure DoError (Const Msg : string);
 
 begin
-  Writeln (msg,'returned an error : ',ipcerror);
+  Writeln (msg,' returned an error : ',fpgeterrno);
   halt(1);
 end;
 
@@ -25,7 +25,7 @@ begin
   Writeln ('Sending message.');
   Buf.mtype:=mtype;
   Buf.Mtext:=mtext;
-  If not msgsnd(Id,PMsgBuf(@Buf),256,0) then
+  If  msgsnd(Id,PMsgBuf(@Buf),256,0)=-1 then
     DoError('msgsnd');
 end;
 
@@ -36,7 +36,7 @@ Procedure ReadMessage (ID : Longint;
 begin
   Writeln ('Reading message.');
   Buf.MType:=MType;
-  If msgrcv(ID,PMSGBuf(@Buf),256,mtype,0) then
+  If msgrcv(ID,PMSGBuf(@Buf),256,mtype,0)<>-1 then
     Writeln ('Type : ',buf.mtype,' Text : ',buf.mtext)
   else
     DoError ('msgrcv');
@@ -45,8 +45,8 @@ end;
 Procedure RemoveQueue ( ID : Longint);
 
 begin
-  If msgctl (id,IPC_RMID,Nil) then
-    Writeln ('Removed Queue with id',Id);
+  If msgctl (id,IPC_RMID,Nil)<>-1 then
+    Writeln ('Removed Queue with id ',Id);
 end;
 
 Procedure ChangeQueueMode (ID,mode : longint);
@@ -54,11 +54,11 @@ Procedure ChangeQueueMode (ID,mode : longint);
 Var QueueDS : TMSQid_ds;
 
 begin
-  If Not msgctl (Id,IPC_STAT,@QueueDS) then
+  If  msgctl (Id,IPC_STAT,@QueueDS)=-1 then
     DoError ('msgctl : stat');
   Writeln ('Old permissions : ',QueueDS.msg_perm.mode);
   QueueDS.msg_perm.mode:=Mode;
-  if msgctl (ID,IPC_SET,@QueueDS) then
+  if msgctl (ID,IPC_SET,@QueueDS)=0 then
     Writeln ('New permissions : ',QueueDS.msg_perm.mode)
   else
    DoError ('msgctl : IPC_SET');
@@ -90,9 +90,11 @@ Var
   ID  : longint;
   Buf : TMyMsgBuf;
 
+const ipckey = '.'#0;
+
 begin
   If Paramcount<1 then Usage;
-  key :=Ftok('.','M');
+  key :=Ftok(@ipckey[1],ord('M'));
   ID:=msgget(key,IPC_CREAT or 438);
   If ID<0 then DoError ('MsgGet');
   Case upCase(Paramstr(1)[1]) of

+ 13 - 8
docs/ipcex/semtool.pp

@@ -2,14 +2,14 @@ Program semtool;
 
 { Program to demonstrat the use of semaphores }
 
-Uses ipc;
+Uses ipc,baseunix;
 
 Const MaxSemValue = 5;
 
 Procedure DoError (Const Msg : String);
 
 begin
-  Writeln ('Error : ',msg,' Code : ',IPCerror);
+  Writeln ('Error : ',msg,' Code : ',fpgeterrno);
   Halt(1);
 end;
 
@@ -18,7 +18,7 @@ Function getsemval (ID,Member : longint) : longint;
 Var S : TSEMun;
 
 begin
-  GetSemVal:=SemCtl(id,member,GETVAL,S);
+  GetSemVal:=SemCtl(id,member,SEM_GETVAL,S);
 end;
 
 Procedure DispVal (ID,member : longint);
@@ -54,15 +54,17 @@ Var Count : Longint;
     Semopts : TSemun;
 
 begin
-  If members>semmsl then
+// the semmsl constant seems kernel specific
+{  If members>semmsl then
     DoError ('Sorry, maximum number of semaphores in set exceeded');
+}
   Writeln ('Trying to create a new semaphore set with ',members,' members.');
   CreateSem:=semget(key,members,IPC_CREAT or IPC_Excl or 438);
   If CreateSem=-1 then
     DoError ('Semaphore set already exists.');
   Semopts.val:=MaxSemValue; { Initial value of semaphores }
   For Count:=0 to Members-1 do
-    semctl(CreateSem,count,setval,semopts);
+    semctl(CreateSem,count,SEM_SETVAL,semopts);
 end;
 
 Procedure lockSem (ID,Member: Longint);
@@ -82,7 +84,7 @@ begin
      DoError ('Semaphore resources exhausted (no lock)');
    lock.sem_num:=member;
    Writeln ('Attempting to lock member ',member, ' of semaphore ',ID);
-   if not semop(Id,@lock,1) then
+   if semop(Id,@lock,1)=-1 then
      DoError ('Lock failed')
    else
      Writeln ('Semaphore resources decremented by one');
@@ -106,7 +108,7 @@ begin
      DoError ('Semaphore not locked');
    Unlock.sem_num:=member;
    Writeln ('Attempting to unlock member ',member, ' of semaphore ',ID);
-   if not semop(Id,@unlock,1) then
+   if semop(Id,@unlock,1)=-1 then
      DoError ('Unlock failed')
    else
      Writeln ('Semaphore resources incremented by one');
@@ -179,9 +181,12 @@ end;
 Var Key : TKey;
     ID : Longint;
 
+
+const ipckey='.'#0;  
+
 begin
   If ParamCount<1 then USage;
-  key:=ftok('.','s');
+  key:=ftok(@ipckey[1],ORD('s'));
   Case UpCase(Paramstr(1)[1]) of
    'C' : begin
          if paramcount<>2 then usage;