paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-18 17:19:32 +02:00
Code Issues Packages Projects Releases Wiki Activity

* fixes after Mac OS X ipc patches

Browse Source
This commit is contained in:
marco 2005-05-04 13:39:22 +00:00
parent 4fff9fb131
commit 1433ef8324
2 changed files with 24 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
docs/ipcex/msgtool.pp
View File

@ -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

21
docs/ipcex/semtool.pp
View File

@ -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;