[perl5.git] / cpan / IPC-SysV / SysV.xs

/*******************************************************************************
*
*  $Revision: 33 $
*  $Author: mhx $
*  $Date: 2010/03/07 16:01:40 +0100 $
*
********************************************************************************
*
*  Version 2.x, Copyright (C) 2007-2010, Marcus Holland-Moritz <mhx@cpan.org>.
*  Version 1.x, Copyright (C) 1999, Graham Barr <gbarr@pobox.com>.
*
*  This program is free software; you can redistribute it and/or
*  modify it under the same terms as Perl itself.
*
*******************************************************************************/

#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

#define NEED_sv_2pv_flags
#define NEED_sv_pvn_force_flags
#include "ppport.h"

#include <sys/types.h>

#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
#  ifndef HAS_SEM
#    include <sys/ipc.h>
#  endif
#  ifdef HAS_MSG
#    include <sys/msg.h>
#  endif
#  ifdef HAS_SHM
#    if defined(PERL_SCO) || defined(PERL_ISC)
#      include <sys/sysmacros.h>	/* SHMLBA */
#    endif
#    include <sys/shm.h>
#    ifndef HAS_SHMAT_PROTOTYPE
       extern Shmat_t shmat(int, char *, int);
#    endif
#    if defined(HAS_SYSCONF) && defined(_SC_PAGESIZE)
#      undef  SHMLBA /* not static: determined at boot time */
#      define SHMLBA sysconf(_SC_PAGESIZE)
#    elif defined(HAS_GETPAGESIZE)
#      undef  SHMLBA /* not static: determined at boot time */
#      define SHMLBA getpagesize()
#    endif
#  endif
#endif

/* Required to get 'struct pte' for SHMLBA on ULTRIX. */
#if defined(__ultrix) || defined(__ultrix__) || defined(ultrix)
#include <machine/pte.h>
#endif

/* Required in BSDI to get PAGE_SIZE definition for SHMLBA.
 * Ugly.  More beautiful solutions welcome.
 * Shouting at BSDI sounds quite beautiful. */
#ifdef __bsdi__
#  include <vm/vm_param.h>	/* move upwards under HAS_SHM? */
#endif

#ifndef S_IRWXU
#  ifdef S_IRUSR
#    define S_IRWXU (S_IRUSR|S_IWUSR|S_IXUSR)
#    define S_IRWXG (S_IRGRP|S_IWGRP|S_IXGRP)
#    define S_IRWXO (S_IROTH|S_IWOTH|S_IXOTH)
#  else
#    define S_IRWXU 0700
#    define S_IRWXG 0070
#    define S_IRWXO 0007
#  endif
#endif

#define AV_FETCH_IV(ident, av, index)                         \
        STMT_START {                                          \
          SV **svp;                                           \
          if ((svp = av_fetch((av), (index), FALSE)) != NULL) \
            ident = SvIV(*svp);                               \
        } STMT_END

#define AV_STORE_IV(ident, av, index)                         \
          av_store((av), (index), newSViv(ident))

static const char *s_fmt_not_isa = "Method %s not called a %s object";
static const char *s_bad_length = "Bad arg length for %s, length is %d, should be %d";
static const char *s_sysv_unimpl PERL_UNUSED_DECL
                                 = "System V %sxxx is not implemented on this machine";

static const char *s_pkg_msg = "IPC::Msg::stat";
static const char *s_pkg_sem = "IPC::Semaphore::stat";
static const char *s_pkg_shm = "IPC::SharedMem::stat";

static void *sv2addr(SV *sv)
{
  if (SvPOK(sv) && SvCUR(sv) == sizeof(void *))
  {
    return *((void **) SvPVX(sv));
  }

  croak("invalid address value");

  return 0;
}

static void assert_sv_isa(SV *sv, const char *name, const char *method)
{
  if (!sv_isa(sv, name))
  {
    croak(s_fmt_not_isa, method, name);
  }
}

static void assert_data_length(const char *name, int got, int expected)
{
  if (got != expected)
  {
    croak(s_bad_length, name, got, expected);
  }
}

#include "const-c.inc"


MODULE=IPC::SysV	PACKAGE=IPC::Msg::stat

PROTOTYPES: ENABLE

void
pack(obj)
    SV	* obj
PPCODE:
  {
#ifdef HAS_MSG
    AV *list = (AV*) SvRV(obj);
    struct msqid_ds ds;
    assert_sv_isa(obj, s_pkg_msg, "pack");
    AV_FETCH_IV(ds.msg_perm.uid , list,  0);
    AV_FETCH_IV(ds.msg_perm.gid , list,  1);
    AV_FETCH_IV(ds.msg_perm.cuid, list,  2);
    AV_FETCH_IV(ds.msg_perm.cgid, list,  3);
    AV_FETCH_IV(ds.msg_perm.mode, list,  4);
    AV_FETCH_IV(ds.msg_qnum     , list,  5);
    AV_FETCH_IV(ds.msg_qbytes   , list,  6);
    AV_FETCH_IV(ds.msg_lspid    , list,  7);
    AV_FETCH_IV(ds.msg_lrpid    , list,  8);
    AV_FETCH_IV(ds.msg_stime    , list,  9);
    AV_FETCH_IV(ds.msg_rtime    , list, 10);
    AV_FETCH_IV(ds.msg_ctime    , list, 11);
    ST(0) = sv_2mortal(newSVpvn((char *) &ds, sizeof(ds)));
    XSRETURN(1);
#else
    croak(s_sysv_unimpl, "msg");
#endif
  }

void
unpack(obj, ds)
    SV * obj
    SV * ds
PPCODE:
  {
#ifdef HAS_MSG
    AV *list = (AV*) SvRV(obj);
    STRLEN len;
    const struct msqid_ds *data = (struct msqid_ds *) SvPV_const(ds, len);
    assert_sv_isa(obj, s_pkg_msg, "unpack");
    assert_data_length(s_pkg_msg, len, sizeof(*data));
    AV_STORE_IV(data->msg_perm.uid , list,  0);
    AV_STORE_IV(data->msg_perm.gid , list,  1);
    AV_STORE_IV(data->msg_perm.cuid, list,  2);
    AV_STORE_IV(data->msg_perm.cgid, list,  3);
    AV_STORE_IV(data->msg_perm.mode, list,  4);
    AV_STORE_IV(data->msg_qnum     , list,  5);
    AV_STORE_IV(data->msg_qbytes   , list,  6);
    AV_STORE_IV(data->msg_lspid    , list,  7);
    AV_STORE_IV(data->msg_lrpid    , list,  8);
    AV_STORE_IV(data->msg_stime    , list,  9);
    AV_STORE_IV(data->msg_rtime    , list, 10);
    AV_STORE_IV(data->msg_ctime    , list, 11);
    XSRETURN(1);
#else
    croak(s_sysv_unimpl, "msg");
#endif
  }


MODULE=IPC::SysV	PACKAGE=IPC::Semaphore::stat

PROTOTYPES: ENABLE

void
pack(obj)
    SV	* obj
PPCODE:
  {
#ifdef HAS_SEM
    AV *list = (AV*) SvRV(obj);
    struct semid_ds ds;
    assert_sv_isa(obj, s_pkg_sem, "pack");
    AV_FETCH_IV(ds.sem_perm.uid , list, 0);
    AV_FETCH_IV(ds.sem_perm.gid , list, 1);
    AV_FETCH_IV(ds.sem_perm.cuid, list, 2);
    AV_FETCH_IV(ds.sem_perm.cgid, list, 3);
    AV_FETCH_IV(ds.sem_perm.mode, list, 4);
    AV_FETCH_IV(ds.sem_ctime    , list, 5);
    AV_FETCH_IV(ds.sem_otime    , list, 6);
    AV_FETCH_IV(ds.sem_nsems    , list, 7);
    ST(0) = sv_2mortal(newSVpvn((char *) &ds, sizeof(ds)));
    XSRETURN(1);
#else
    croak(s_sysv_unimpl, "sem");
#endif
  }

void
unpack(obj, ds)
    SV * obj
    SV * ds
PPCODE:
  {
#ifdef HAS_SEM
    AV *list = (AV*) SvRV(obj);
    STRLEN len;
    const struct semid_ds *data = (struct semid_ds *) SvPV_const(ds, len);
    assert_sv_isa(obj, s_pkg_sem, "unpack");
    assert_data_length(s_pkg_sem, len, sizeof(*data));
    AV_STORE_IV(data->sem_perm.uid , list, 0);
    AV_STORE_IV(data->sem_perm.gid , list, 1);
    AV_STORE_IV(data->sem_perm.cuid, list, 2);
    AV_STORE_IV(data->sem_perm.cgid, list, 3);
    AV_STORE_IV(data->sem_perm.mode, list, 4);
    AV_STORE_IV(data->sem_ctime    , list, 5);
    AV_STORE_IV(data->sem_otime    , list, 6);
    AV_STORE_IV(data->sem_nsems    , list, 7);
    XSRETURN(1);
#else
    croak(s_sysv_unimpl, "sem");
#endif
  }


MODULE=IPC::SysV	PACKAGE=IPC::SharedMem::stat

PROTOTYPES: ENABLE

void
pack(obj)
    SV	* obj
PPCODE:
  {
#ifdef HAS_SHM
    AV *list = (AV*) SvRV(obj);
    struct shmid_ds ds;
    assert_sv_isa(obj, s_pkg_shm, "pack");
    AV_FETCH_IV(ds.shm_perm.uid , list,  0);
    AV_FETCH_IV(ds.shm_perm.gid , list,  1);
    AV_FETCH_IV(ds.shm_perm.cuid, list,  2);
    AV_FETCH_IV(ds.shm_perm.cgid, list,  3);
    AV_FETCH_IV(ds.shm_perm.mode, list,  4);
    AV_FETCH_IV(ds.shm_segsz    , list,  5);
    AV_FETCH_IV(ds.shm_lpid     , list,  6);
    AV_FETCH_IV(ds.shm_cpid     , list,  7);
    AV_FETCH_IV(ds.shm_nattch   , list,  8);
    AV_FETCH_IV(ds.shm_atime    , list,  9);
    AV_FETCH_IV(ds.shm_dtime    , list, 10);
    AV_FETCH_IV(ds.shm_ctime    , list, 11);
    ST(0) = sv_2mortal(newSVpvn((char *) &ds, sizeof(ds)));
    XSRETURN(1);
#else
    croak(s_sysv_unimpl, "shm");
#endif
  }

void
unpack(obj, ds)
    SV * obj
    SV * ds
PPCODE:
  {
#ifdef HAS_SHM
    AV *list = (AV*) SvRV(obj);
    STRLEN len;
    const struct shmid_ds *data = (struct shmid_ds *) SvPV_const(ds, len);
    assert_sv_isa(obj, s_pkg_shm, "unpack");
    assert_data_length(s_pkg_shm, len, sizeof(*data));
    AV_STORE_IV(data->shm_perm.uid , list,  0);
    AV_STORE_IV(data->shm_perm.gid , list,  1);
    AV_STORE_IV(data->shm_perm.cuid, list,  2);
    AV_STORE_IV(data->shm_perm.cgid, list,  3);
    AV_STORE_IV(data->shm_perm.mode, list,  4);
    AV_STORE_IV(data->shm_segsz    , list,  5);
    AV_STORE_IV(data->shm_lpid     , list,  6);
    AV_STORE_IV(data->shm_cpid     , list,  7);
    AV_STORE_IV(data->shm_nattch   , list,  8);
    AV_STORE_IV(data->shm_atime    , list,  9);
    AV_STORE_IV(data->shm_dtime    , list, 10);
    AV_STORE_IV(data->shm_ctime    , list, 11);
    XSRETURN(1);
#else
    croak(s_sysv_unimpl, "shm");
#endif
  }


MODULE=IPC::SysV	PACKAGE=IPC::SysV

PROTOTYPES: ENABLE

void
ftok(path, id = &PL_sv_undef)
    const char *path
    SV *id
  PREINIT:
    int proj_id = 1;
    key_t k;
  CODE:
#if defined(HAS_SEM) || defined(HAS_SHM)
    if (SvOK(id))
    {
      if (SvIOK(id))
      {
        proj_id = (int) SvIVX(id);
      }
      else if (SvPOK(id) && SvCUR(id) == sizeof(char))
      {
        proj_id = (int) *SvPVX(id);
      }
      else
      {
        croak("invalid project id");
      }
    }
/* Including <sys/types.h> before <sys/ipc.h> makes Tru64
 * to see the obsolete prototype of ftok() first, grumble. */
# ifdef __osf__
#  define Ftok_t char*
/* Configure TODO Ftok_t */
# endif 
# ifndef Ftok_t
#  define Ftok_t const char*
# endif
    k = ftok((Ftok_t)path, proj_id);
    ST(0) = k == (key_t) -1 ? &PL_sv_undef : sv_2mortal(newSViv(k));
    XSRETURN(1);
#else
    Perl_die(aTHX_ PL_no_func, "ftok"); return;
#endif

void
memread(addr, sv, pos, size)
    SV *addr
    SV *sv
    int pos
    int size
  CODE:
    char *caddr = (char *) sv2addr(addr);
    char *dst;
    if (!SvOK(sv))
    {
      sv_setpvn(sv, "", 0);
    }
    SvPV_force_nolen(sv);
    dst = SvGROW(sv, (STRLEN) size + 1);
    Copy(caddr + pos, dst, size, char);
    SvCUR_set(sv, size);
    *SvEND(sv) = '\0';
    SvSETMAGIC(sv);
#ifndef INCOMPLETE_TAINTS
    /* who knows who has been playing with this memory? */
    SvTAINTED_on(sv);
#endif
    XSRETURN_YES;

void
memwrite(addr, sv, pos, size)
    SV *addr
    SV *sv
    int pos
    int size
  CODE:
    char *caddr = (char *) sv2addr(addr);
    STRLEN len;
    const char *src = SvPV_const(sv, len);
    int n = ((int) len > size) ? size : (int) len;
    Copy(src, caddr + pos, n, char);
    if (n < size)
    {
      memzero(caddr + pos + n, size - n);
    }
    XSRETURN_YES;

void
shmat(id, addr, flag)
    int id
    SV *addr
    int flag
  CODE:
#ifdef HAS_SHM
    void *caddr = SvOK(addr) ? sv2addr(addr) : NULL;
    void *shm = (void *) shmat(id, caddr, flag);
    ST(0) = shm == (void *) -1 ? &PL_sv_undef
                               : sv_2mortal(newSVpvn((char *) &shm, sizeof(void *)));
    XSRETURN(1);
#else
    Perl_die(aTHX_ PL_no_func, "shmat"); return;
#endif

void
shmdt(addr)
    SV *addr
  CODE:
#ifdef HAS_SHM
    void *caddr = sv2addr(addr);
    int rv = shmdt((Shmat_t)caddr);
    ST(0) = rv == -1 ? &PL_sv_undef : sv_2mortal(newSViv(rv));
    XSRETURN(1);
#else
    Perl_die(aTHX_ PL_no_func, "shmdt"); return;
#endif

INCLUDE: const-xs.inc
Commit	Line	Data
8f85282b MHM	1	/*******************************************************************************
8f85282b MHM	2	*
10613b66	3	* $Revision: 33 $
8f85282b	4	* $Author: mhx $
10613b66	5	* $Date: 2010/03/07 16:01:40 +0100 $
8f85282b MHM	6	*
	7	********************************************************************************
	8	*
10613b66	9	* Version 2.x, Copyright (C) 2007-2010, Marcus Holland-Moritz <mhx@cpan.org>.
8f85282b MHM	10	* Version 1.x, Copyright (C) 1999, Graham Barr <gbarr@pobox.com>.
	11	*
	12	* This program is free software; you can redistribute it and/or
	13	* modify it under the same terms as Perl itself.
	14	*
	15	*******************************************************************************/
	16
0ade1984 JH	17	#include "EXTERN.h"
	18	#include "perl.h"
	19	#include "XSUB.h"
	20
8f85282b MHM	21	#define NEED_sv_2pv_flags
	22	#define NEED_sv_pvn_force_flags
	23	#include "ppport.h"
	24
0ade1984	25	#include <sys/types.h>
8f85282b	26
0ade1984	27	#if defined(HAS_MSG) \|\| defined(HAS_SEM) \|\| defined(HAS_SHM)
8f85282b MHM	28	# ifndef HAS_SEM
	29	# include <sys/ipc.h>
	30	# endif
	31	# ifdef HAS_MSG
	32	# include <sys/msg.h>
	33	# endif
	34	# ifdef HAS_SHM
	35	# if defined(PERL_SCO) \|\| defined(PERL_ISC)
	36	# include <sys/sysmacros.h> /* SHMLBA */
	37	# endif
	38	# include <sys/shm.h>
	39	# ifndef HAS_SHMAT_PROTOTYPE
	40	extern Shmat_t shmat(int, char *, int);
	41	# endif
	42	# if defined(HAS_SYSCONF) && defined(_SC_PAGESIZE)
	43	# undef SHMLBA /* not static: determined at boot time */
	44	# define SHMLBA sysconf(_SC_PAGESIZE)
	45	# elif defined(HAS_GETPAGESIZE)
	46	# undef SHMLBA /* not static: determined at boot time */
	47	# define SHMLBA getpagesize()
	48	# endif
	49	# endif
0ade1984 JH	50	#endif
0ade1984 JH	51
aec308ec SB	52	/* Required to get 'struct pte' for SHMLBA on ULTRIX. */
	53	#if defined(__ultrix) \|\| defined(__ultrix__) \|\| defined(ultrix)
	54	#include <machine/pte.h>
	55	#endif
	56
1e509ade JH	57	/* Required in BSDI to get PAGE_SIZE definition for SHMLBA.
	58	* Ugly. More beautiful solutions welcome.
	59	* Shouting at BSDI sounds quite beautiful. */
	60	#ifdef __bsdi__
8f85282b	61	# include <vm/vm_param.h> /* move upwards under HAS_SHM? */
1e509ade JH	62	#endif
1e509ade JH	63
85ab1d1d	64	#ifndef S_IRWXU
8f85282b MHM	65	# ifdef S_IRUSR
	66	# define S_IRWXU (S_IRUSR\|S_IWUSR\|S_IXUSR)
	67	# define S_IRWXG (S_IRGRP\|S_IWGRP\|S_IXGRP)
	68	# define S_IRWXO (S_IROTH\|S_IWOTH\|S_IXOTH)
	69	# else
	70	# define S_IRWXU 0700
	71	# define S_IRWXG 0070
	72	# define S_IRWXO 0007
	73	# endif
85ab1d1d JH	74	#endif
85ab1d1d JH	75
8f85282b MHM	76	#define AV_FETCH_IV(ident, av, index) \
	77	STMT_START { \
	78	SV **svp; \
	79	if ((svp = av_fetch((av), (index), FALSE)) != NULL) \
	80	ident = SvIV(*svp); \
	81	} STMT_END
	82
	83	#define AV_STORE_IV(ident, av, index) \
	84	av_store((av), (index), newSViv(ident))
	85
	86	static const char *s_fmt_not_isa = "Method %s not called a %s object";
	87	static const char *s_bad_length = "Bad arg length for %s, length is %d, should be %d";
	88	static const char *s_sysv_unimpl PERL_UNUSED_DECL
	89	= "System V %sxxx is not implemented on this machine";
	90
	91	static const char *s_pkg_msg = "IPC::Msg::stat";
	92	static const char *s_pkg_sem = "IPC::Semaphore::stat";
	93	static const char *s_pkg_shm = "IPC::SharedMem::stat";
	94
	95	static void sv2addr(SV sv)
	96	{
	97	if (SvPOK(sv) && SvCUR(sv) == sizeof(void *))
	98	{
	99	return ((void *) SvPVX(sv));
	100	}
	101
	102	croak("invalid address value");
	103
	104	return 0;
	105	}
	106
	107	static void assert_sv_isa(SV sv, const char name, const char *method)
	108	{
	109	if (!sv_isa(sv, name))
	110	{
	111	croak(s_fmt_not_isa, method, name);
	112	}
	113	}
	114
	115	static void assert_data_length(const char *name, int got, int expected)
	116	{
	117	if (got != expected)
	118	{
	119	croak(s_bad_length, name, got, expected);
	120	}
	121	}
	122
	123	#include "const-c.inc"
	124
	125
0ade1984 JH	126	MODULE=IPC::SysV PACKAGE=IPC::Msg::stat
	127
	128	PROTOTYPES: ENABLE
	129
	130	void
	131	pack(obj)
	132	SV * obj
	133	PPCODE:
8f85282b	134	{
6087ac44	135	#ifdef HAS_MSG
8f85282b	136	AV list = (AV) SvRV(obj);
0ade1984	137	struct msqid_ds ds;
8f85282b MHM	138	assert_sv_isa(obj, s_pkg_msg, "pack");
	139	AV_FETCH_IV(ds.msg_perm.uid , list, 0);
	140	AV_FETCH_IV(ds.msg_perm.gid , list, 1);
	141	AV_FETCH_IV(ds.msg_perm.cuid, list, 2);
	142	AV_FETCH_IV(ds.msg_perm.cgid, list, 3);
	143	AV_FETCH_IV(ds.msg_perm.mode, list, 4);
	144	AV_FETCH_IV(ds.msg_qnum , list, 5);
	145	AV_FETCH_IV(ds.msg_qbytes , list, 6);
	146	AV_FETCH_IV(ds.msg_lspid , list, 7);
	147	AV_FETCH_IV(ds.msg_lrpid , list, 8);
	148	AV_FETCH_IV(ds.msg_stime , list, 9);
	149	AV_FETCH_IV(ds.msg_rtime , list, 10);
	150	AV_FETCH_IV(ds.msg_ctime , list, 11);
	151	ST(0) = sv_2mortal(newSVpvn((char *) &ds, sizeof(ds)));
0ade1984	152	XSRETURN(1);
6087ac44	153	#else
8f85282b	154	croak(s_sysv_unimpl, "msg");
6087ac44	155	#endif
8f85282b	156	}
0ade1984 JH	157
0ade1984 JH	158	void
8f85282b	159	unpack(obj, ds)
0ade1984	160	SV * obj
8f85282b	161	SV * ds
0ade1984	162	PPCODE:
8f85282b	163	{
6087ac44	164	#ifdef HAS_MSG
8f85282b	165	AV list = (AV) SvRV(obj);
0ade1984	166	STRLEN len;
8f85282b MHM	167	const struct msqid_ds data = (struct msqid_ds ) SvPV_const(ds, len);
	168	assert_sv_isa(obj, s_pkg_msg, "unpack");
	169	assert_data_length(s_pkg_msg, len, sizeof(*data));
	170	AV_STORE_IV(data->msg_perm.uid , list, 0);
	171	AV_STORE_IV(data->msg_perm.gid , list, 1);
	172	AV_STORE_IV(data->msg_perm.cuid, list, 2);
	173	AV_STORE_IV(data->msg_perm.cgid, list, 3);
	174	AV_STORE_IV(data->msg_perm.mode, list, 4);
	175	AV_STORE_IV(data->msg_qnum , list, 5);
	176	AV_STORE_IV(data->msg_qbytes , list, 6);
	177	AV_STORE_IV(data->msg_lspid , list, 7);
	178	AV_STORE_IV(data->msg_lrpid , list, 8);
	179	AV_STORE_IV(data->msg_stime , list, 9);
	180	AV_STORE_IV(data->msg_rtime , list, 10);
	181	AV_STORE_IV(data->msg_ctime , list, 11);
0ade1984	182	XSRETURN(1);
6087ac44	183	#else
8f85282b	184	croak(s_sysv_unimpl, "msg");
6087ac44	185	#endif
8f85282b MHM	186	}
8f85282b MHM	187
0ade1984 JH	188
	189	MODULE=IPC::SysV PACKAGE=IPC::Semaphore::stat
	190
8f85282b MHM	191	PROTOTYPES: ENABLE
8f85282b MHM	192
0ade1984	193	void
8f85282b MHM	194	pack(obj)
	195	SV * obj
	196	PPCODE:
	197	{
	198	#ifdef HAS_SEM
	199	AV list = (AV) SvRV(obj);
	200	struct semid_ds ds;
	201	assert_sv_isa(obj, s_pkg_sem, "pack");
	202	AV_FETCH_IV(ds.sem_perm.uid , list, 0);
	203	AV_FETCH_IV(ds.sem_perm.gid , list, 1);
	204	AV_FETCH_IV(ds.sem_perm.cuid, list, 2);
	205	AV_FETCH_IV(ds.sem_perm.cgid, list, 3);
	206	AV_FETCH_IV(ds.sem_perm.mode, list, 4);
	207	AV_FETCH_IV(ds.sem_ctime , list, 5);
	208	AV_FETCH_IV(ds.sem_otime , list, 6);
	209	AV_FETCH_IV(ds.sem_nsems , list, 7);
	210	ST(0) = sv_2mortal(newSVpvn((char *) &ds, sizeof(ds)));
	211	XSRETURN(1);
	212	#else
	213	croak(s_sysv_unimpl, "sem");
	214	#endif
	215	}
	216
	217	void
	218	unpack(obj, ds)
0ade1984 JH	219	SV * obj
	220	SV * ds
	221	PPCODE:
8f85282b	222	{
6087ac44	223	#ifdef HAS_SEM
8f85282b	224	AV list = (AV) SvRV(obj);
0ade1984	225	STRLEN len;
8f85282b MHM	226	const struct semid_ds data = (struct semid_ds ) SvPV_const(ds, len);
	227	assert_sv_isa(obj, s_pkg_sem, "unpack");
	228	assert_data_length(s_pkg_sem, len, sizeof(*data));
	229	AV_STORE_IV(data->sem_perm.uid , list, 0);
	230	AV_STORE_IV(data->sem_perm.gid , list, 1);
	231	AV_STORE_IV(data->sem_perm.cuid, list, 2);
	232	AV_STORE_IV(data->sem_perm.cgid, list, 3);
	233	AV_STORE_IV(data->sem_perm.mode, list, 4);
	234	AV_STORE_IV(data->sem_ctime , list, 5);
	235	AV_STORE_IV(data->sem_otime , list, 6);
	236	AV_STORE_IV(data->sem_nsems , list, 7);
0ade1984	237	XSRETURN(1);
6087ac44	238	#else
8f85282b	239	croak(s_sysv_unimpl, "sem");
6087ac44	240	#endif
8f85282b MHM	241	}
	242
	243
	244	MODULE=IPC::SysV PACKAGE=IPC::SharedMem::stat
	245
	246	PROTOTYPES: ENABLE
0ade1984 JH	247
	248	void
	249	pack(obj)
	250	SV * obj
	251	PPCODE:
8f85282b MHM	252	{
	253	#ifdef HAS_SHM
	254	AV list = (AV) SvRV(obj);
	255	struct shmid_ds ds;
	256	assert_sv_isa(obj, s_pkg_shm, "pack");
	257	AV_FETCH_IV(ds.shm_perm.uid , list, 0);
	258	AV_FETCH_IV(ds.shm_perm.gid , list, 1);
	259	AV_FETCH_IV(ds.shm_perm.cuid, list, 2);
	260	AV_FETCH_IV(ds.shm_perm.cgid, list, 3);
	261	AV_FETCH_IV(ds.shm_perm.mode, list, 4);
	262	AV_FETCH_IV(ds.shm_segsz , list, 5);
	263	AV_FETCH_IV(ds.shm_lpid , list, 6);
	264	AV_FETCH_IV(ds.shm_cpid , list, 7);
	265	AV_FETCH_IV(ds.shm_nattch , list, 8);
	266	AV_FETCH_IV(ds.shm_atime , list, 9);
	267	AV_FETCH_IV(ds.shm_dtime , list, 10);
	268	AV_FETCH_IV(ds.shm_ctime , list, 11);
	269	ST(0) = sv_2mortal(newSVpvn((char *) &ds, sizeof(ds)));
0ade1984	270	XSRETURN(1);
6087ac44	271	#else
8f85282b	272	croak(s_sysv_unimpl, "shm");
6087ac44	273	#endif
8f85282b MHM	274	}
	275
	276	void
	277	unpack(obj, ds)
	278	SV * obj
	279	SV * ds
	280	PPCODE:
	281	{
	282	#ifdef HAS_SHM
	283	AV list = (AV) SvRV(obj);
	284	STRLEN len;
	285	const struct shmid_ds data = (struct shmid_ds ) SvPV_const(ds, len);
	286	assert_sv_isa(obj, s_pkg_shm, "unpack");
	287	assert_data_length(s_pkg_shm, len, sizeof(*data));
	288	AV_STORE_IV(data->shm_perm.uid , list, 0);
	289	AV_STORE_IV(data->shm_perm.gid , list, 1);
	290	AV_STORE_IV(data->shm_perm.cuid, list, 2);
	291	AV_STORE_IV(data->shm_perm.cgid, list, 3);
	292	AV_STORE_IV(data->shm_perm.mode, list, 4);
	293	AV_STORE_IV(data->shm_segsz , list, 5);
	294	AV_STORE_IV(data->shm_lpid , list, 6);
	295	AV_STORE_IV(data->shm_cpid , list, 7);
	296	AV_STORE_IV(data->shm_nattch , list, 8);
	297	AV_STORE_IV(data->shm_atime , list, 9);
	298	AV_STORE_IV(data->shm_dtime , list, 10);
	299	AV_STORE_IV(data->shm_ctime , list, 11);
	300	XSRETURN(1);
	301	#else
	302	croak(s_sysv_unimpl, "shm");
	303	#endif
	304	}
	305
0ade1984 JH	306
	307	MODULE=IPC::SysV PACKAGE=IPC::SysV
	308
8f85282b MHM	309	PROTOTYPES: ENABLE
8f85282b MHM	310
8063af02	311	void
8f85282b MHM	312	ftok(path, id = &PL_sv_undef)
	313	const char *path
	314	SV *id
	315	PREINIT:
	316	int proj_id = 1;
	317	key_t k;
	318	CODE:
0ade1984	319	#if defined(HAS_SEM) \|\| defined(HAS_SHM)
8f85282b MHM	320	if (SvOK(id))
	321	{
	322	if (SvIOK(id))
	323	{
	324	proj_id = (int) SvIVX(id);
	325	}
	326	else if (SvPOK(id) && SvCUR(id) == sizeof(char))
	327	{
	328	proj_id = (int) *SvPVX(id);
	329	}
	330	else
	331	{
	332	croak("invalid project id");
	333	}
	334	}
899488ba JH	335	/* Including <sys/types.h> before <sys/ipc.h> makes Tru64
	336	* to see the obsolete prototype of ftok() first, grumble. */
	337	# ifdef __osf__
	338	# define Ftok_t char*
	339	/* Configure TODO Ftok_t */
	340	# endif
	341	# ifndef Ftok_t
	342	# define Ftok_t const char*
	343	# endif
	344	k = ftok((Ftok_t)path, proj_id);
8f85282b MHM	345	ST(0) = k == (key_t) -1 ? &PL_sv_undef : sv_2mortal(newSViv(k));
8f85282b MHM	346	XSRETURN(1);
0ade1984	347	#else
8f85282b	348	Perl_die(aTHX_ PL_no_func, "ftok"); return;
0ade1984 JH	349	#endif
0ade1984 JH	350
8063af02	351	void
8f85282b MHM	352	memread(addr, sv, pos, size)
	353	SV *addr
	354	SV *sv
	355	int pos
	356	int size
	357	CODE:
a7c93bfc	358	char caddr = (char ) sv2addr(addr);
8f85282b MHM	359	char *dst;
	360	if (!SvOK(sv))
	361	{
	362	sv_setpvn(sv, "", 0);
	363	}
	364	SvPV_force_nolen(sv);
	365	dst = SvGROW(sv, (STRLEN) size + 1);
	366	Copy(caddr + pos, dst, size, char);
	367	SvCUR_set(sv, size);
	368	*SvEND(sv) = '\0';
	369	SvSETMAGIC(sv);
	370	#ifndef INCOMPLETE_TAINTS
	371	/* who knows who has been playing with this memory? */
	372	SvTAINTED_on(sv);
	373	#endif
	374	XSRETURN_YES;
	375
	376	void
	377	memwrite(addr, sv, pos, size)
	378	SV *addr
	379	SV *sv
	380	int pos
	381	int size
	382	CODE:
a7c93bfc	383	char caddr = (char ) sv2addr(addr);
8f85282b MHM	384	STRLEN len;
	385	const char *src = SvPV_const(sv, len);
	386	int n = ((int) len > size) ? size : (int) len;
	387	Copy(src, caddr + pos, n, char);
	388	if (n < size)
	389	{
	390	memzero(caddr + pos + n, size - n);
	391	}
	392	XSRETURN_YES;
	393
	394	void
	395	shmat(id, addr, flag)
	396	int id
	397	SV *addr
	398	int flag
	399	CODE:
	400	#ifdef HAS_SHM
	401	void *caddr = SvOK(addr) ? sv2addr(addr) : NULL;
	402	void shm = (void ) shmat(id, caddr, flag);
	403	ST(0) = shm == (void *) -1 ? &PL_sv_undef
	404	: sv_2mortal(newSVpvn((char ) &shm, sizeof(void )));
	405	XSRETURN(1);
0ade1984	406	#else
8f85282b	407	Perl_die(aTHX_ PL_no_func, "shmat"); return;
0ade1984 JH	408	#endif
0ade1984 JH	409
8f85282b MHM	410	void
	411	shmdt(addr)
	412	SV *addr
	413	CODE:
	414	#ifdef HAS_SHM
	415	void *caddr = sv2addr(addr);
899488ba	416	int rv = shmdt((Shmat_t)caddr);
8f85282b MHM	417	ST(0) = rv == -1 ? &PL_sv_undef : sv_2mortal(newSViv(rv));
	418	XSRETURN(1);
	419	#else
	420	Perl_die(aTHX_ PL_no_func, "shmdt"); return;
0ade1984	421	#endif
0ade1984	422
8f85282b	423	INCLUDE: const-xs.inc
0ade1984	424