develooper Front page | perl.perl5.porters | Postings from November 2013

[perl #120635] Perl 64 bit big-endian semctl SETVAL bug

Thread Previous
November 26, 2013 19:34
[perl #120635] Perl 64 bit big-endian semctl SETVAL bug
Message ID:
# New Ticket Created by   
# Please include the string:  [perl #120635]
# in the subject line of all future correspondence about this issue. 
# <URL: >

This is a bug report for perl from,
generated with the help of perlbug 1.39 running under perl 5.16.0.

[Please describe your issue here]

calls to semctl(id,semnum,SETVAL,$wantedval)
On 64 bit big-endian boxes, will ignore the passed
in $wantedval, and always use 0

Here's a script that shows the bug in action....

use strict;

my $nsem = 10;

my $id = semget(IPC_PRIVATE, $nsem, S_IRUSR | S_IWUSR | IPC_CREAT);

my $ret = semctl($id, "ignore", SETALL, pack("s!*",(0)x$nsem));
warn "semctl setall: $!\n" unless(defined($ret));

$ret = semctl($id, 3, SETVAL, 17);
warn "semctl setval: $!\n" unless(defined($ret));

my $semvals;
$ret = semctl($id, "ignore", GETALL, $semvals);
    warn "semctl GETALL: $!\n" unless(defined($ret));
    my @semvals = unpack("s!*", $semvals);
    print "semvals=@semvals\n";

$ret = semctl($id, "ignored", IPC_RMID, "ignored");
die "semctl rmid: $!\n" unless(defined($ret));

On a linux 64 bit box, the output is correct:
semvals=0 0 0 17 0 0 0 0 0 0

On solaris 64 bit box, this is the output:
semvals=0 0 0 0 0 0 0 0 0 0

when I truss the perl process I see this:
semctl(100, 3, SETVAL, 0)   = 0

I looked into it, and I think I found the problem:

The problem begins in union semun, defined as...

           union semun {
               int              val;    /* Value for SETVAL */
               struct semid_ds *buf;    /* Buffer for IPC_STAT, IPC_SET */
               unsigned short  *array;  /* Array for GETALL, SETALL */

In a 64 bit build, val will be a 32 bit signed integer.
It will share the first 32 bits of buf.

In the perl code, doio.c:2128, we have...
        const IV i = SvIV(astr);
        a = INT2PTR(char *,i);          /* ouch */

That takes the passed in 17, and coerces it into a char*,
and assigns it to "a"

Finally, doio.c:2147 does
            unsemds.buf = (struct semid_ds *)a;

Now, on little endian (intel linux) boxes, val gets set to the lower
32bits of a, and things work pretty much like we want.

On a big endian box (Sun Sparc), val gets set to the upper 32 bits,
which are all zeros, and it does not do what we want.

Here's a patch against the git tree...

>From 1752788b779244024f086167a5517d50aa6af5bc Mon Sep 17 00:00:00 2001
From: Brian Childs <>
Date: Tue, 26 Nov 2013 13:12:30 -0500
Subject: [PATCH] Fixes the case where on 64bit big-endian boxes, calls to
 semctl(id,semnum,SETVAL,$wantedval) will ignore the passed
 in $wantedval, and always use 0

 doio.c |    9 +++++++--
 1 file changed, 7 insertions(+), 2 deletions(-)

diff --git a/doio.c b/doio.c
index 3ee975d..e7e90d3 100644
--- a/doio.c
+++ b/doio.c
@@ -2141,11 +2141,16 @@ Perl_do_ipcctl(pTHX_ I32 optype, SV **mark, SV **sp)
 #ifdef Semctl
             union semun unsemds;
+            if(cmd == SETVAL) {
+                unsemds.val = PTR2nat(a);
+            }
+            else {
-            unsemds.buff = (struct semid_ds *)a;
+                unsemds.buff = (struct semid_ds *)a;
-            unsemds.buf = (struct semid_ds *)a;
+                unsemds.buf = (struct semid_ds *)a;
+            }
 	    ret = Semctl(id, n, cmd, unsemds);
 	    /* diag_listed_as: sem%s not implemented */

[Please do not change anything below this line]
This perlbug was built using Perl 5.16.0 - Mon Mar 11 10:57:50 UTC 2013
It is being executed now by  Perl 5.16.0 - Mon Mar 11 10:54:42 UTC 2013.

Site configuration information for perl 5.16.0:

Configured by abuild at Mon Mar 11 10:54:42 UTC 2013.

Summary of my perl5 (revision 5 version 16 subversion 0) configuration:
    osname=linux, osvers=3.4.6-2.10-default, archname=x86_64-linux-thread-multi
    uname='linux build30 3.4.6-2.10-default #1 smp thu jul 26 09:36:26 utc 2012 (641c197) x86_64 x86_64 x86_64 gnulinux '
    config_args='-ds -e -Dprefix=/usr -Dvendorprefix=/usr -Dinstallusrbinperl -Dusethreads -Di_db -Di_dbm -Di_ndbm -Di_gdbm -Dd_dbm_open -Duseshrplib=true -Doptimize=-fmessage-length=0 -O2 -Wall -D_FORTIFY_SOURCE=2 -fstack-protector -funwind-tables -fasynchronous-unwind-tables -g -Wall -pipe -Accflags=-DPERL_USE_SAFE_PUTENV -Dotherlibdirs=/usr/lib/perl5/site_perl'
    hint=recommended, useposix=true, d_sigaction=define
    useithreads=define, usemultiplicity=define
    useperlio=define, d_sfio=undef, uselargefiles=define, usesocks=undef
    use64bitint=define, use64bitall=define, uselongdouble=undef
    usemymalloc=n, bincompat5005=undef
    cc='cc', ccflags ='-D_REENTRANT -D_GNU_SOURCE -DPERL_USE_SAFE_PUTENV -fno-strict-aliasing -pipe -fstack-protector -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64',
    optimize='-fmessage-length=0 -O2 -Wall -D_FORTIFY_SOURCE=2 -fstack-protector -funwind-tables -fasynchronous-unwind-tables -g -Wall -pipe',
    cppflags='-D_REENTRANT -D_GNU_SOURCE -DPERL_USE_SAFE_PUTENV -fno-strict-aliasing -pipe -fstack-protector'
    ccversion='', gccversion='4.7.1 20120723 [gcc-4_7-branch revision 189773]', gccosandvers=''
    intsize=4, longsize=8, ptrsize=8, doublesize=8, byteorder=12345678
    d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=16
    ivtype='long', ivsize=8, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8
    alignbytes=8, prototype=define
  Linker and Libraries:
    ld='cc', ldflags =' -L/usr/local/lib64 -fstack-protector'
    libpth=/lib64 /usr/lib64 /usr/local/lib64
    libs=-lm -ldl -lcrypt -lpthread
    perllibs=-lm -ldl -lcrypt -lpthread
    libc=/lib64/, so=so, useshrplib=true,
  Dynamic Linking:
    dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-Wl,-E -Wl,-rpath,/usr/lib/perl5/5.16.0/x86_64-linux-thread-multi/CORE'
    cccdlflags='-fPIC', lddlflags='-shared -L/usr/local/lib64 -fstack-protector'

Locally applied patches:

@INC for perl 5.16.0:

Environment for perl 5.16.0:
    LANGUAGE (unset)
    LOGDIR (unset)
    PERL_BADLANG (unset)

Thread Previous Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at | Group listing | About