← Back to branch summary

~ubuntu-branches/ubuntu/dapper/fpc/dapper

« back to all changes in this revision

Viewing changes to docs/ipcex/shmtool.pp

  • Committer: Bazaar Package Importer
  • Author(s): Carlos Laviola
  • Date: 2005-05-30 11:59:10 UTC
  • mfrom: (1.2.2 upstream)
  • Revision ID: james.westby@ubuntu.com-20050530115910-x5pbzm4qqta4i94h
Tags: 2.0.0-2
http://bugs.debian.org/310907
debian/fp-compiler.postinst.in: forgot to reapply the patch that
correctly creates the slave link to pc(1).  (Closes: #310907)

Show diffs side-by-side

added added

removed removed

Lines of Context:
docs/ipcex/shmtool.pp
1
1
Program shmtool;
2
2
 
3
 
uses ipc,strings;
 
3
uses ipc,strings,Baseunix;
4
4
 
5
5
Const SegSize = 100;
6
6
 
40
40
Procedure CHangeMode (ID : longint; mode : String);
41
41
 
42
42
Var m : word;
43
 
    code : integer; 
 
43
    code : integer;
44
44
    data : TSHMid_ds;
45
 
    
 
45
 
46
46
begin
47
47
  val (mode,m,code);
48
48
  if code<>0 then
49
49
    usage;
50
 
  If Not shmctl (shmid,IPC_STAT,@data) then 
 
50
  If shmctl (shmid,IPC_STAT,@data)=-1 then
51
51
    begin
52
 
    writeln ('Error : shmctl :',ipcerror);
53
 
    halt(1);
 
52
     writeln ('Error : shmctl :',fpgeterrno);
 
53
     halt(1);
54
54
    end;
55
55
  writeln ('Old permissions : ',data.shm_perm.mode);
56
56
  data.shm_perm.mode:=m;
57
 
  If Not shmctl (shmid,IPC_SET,@data) then 
 
57
  If shmctl (shmid,IPC_SET,@data)=-1 then
58
58
    begin
59
 
    writeln ('Error : shmctl :',ipcerror);
 
59
    writeln ('Error : shmctl :',fpgeterrno);
60
60
    halt(1);
61
61
    end;
62
62
  writeln ('New permissions : ',data.shm_perm.mode);
63
63
end;
64
64
 
 
65
const ftokpath = '.'#0;
 
66
 
65
67
begin
66
68
  if paramcount<1 then usage;
67
 
  key := ftok ('.','S');
 
69
   key := ftok (pchar(@ftokpath[1]),ord('S'));
68
70
  shmid := shmget(key,segsize,IPC_CREAT or IPC_EXCL or 438);
69
71
  If shmid=-1 then
70
72
    begin
71
73
    Writeln ('Shared memory exists. Opening as client');
72
74
    shmid := shmget(key,segsize,0);
73
 
    If shmid = -1 then 
 
75
    If shmid = -1 then
74
76
      begin
75
 
      Writeln ('shmget : Error !',ipcerror);
 
77
      Writeln ('shmget : Error !',fpgeterrno);
76
78
      halt(1);
77
79
      end
78
80
    end
81
83
  segptr:=shmat(shmid,nil,0);
82
84
  if longint(segptr)=-1 then
83
85
    begin
84
 
    Writeln ('Shmat : error !',ipcerror);
 
86
    Writeln ('Shmat : error !',fpgeterrno);
85
87
    halt(1);
86
88
    end;
87
89
  case upcase(paramstr(1)[1]) of