Friday August 19, 2005

STREAMS: tr a-z A-Z

STREAMS: tr a-z A-Z

In my earlier entry I discussed the issues with flow control. This time I want to look at the module which actually looks at the data being passed and will convert all output to upper case letters. Basically, it will do the same thing as tr a-z A-Z command does, but using STREAMS

#define	islower(x)	(((unsigned)(x) >= 'a') && ((unsigned)(x) <= 'z'))
#define	isupper(x)	(((unsigned)(x) >= 'A') && ((unsigned)(x) <= 'Z'))
#define	toupper(x)	(isupper(x) ? (x) : (unsigned)(x) - 'a' + 'A')

/*
 * Convert all ASCII chars in data blocks to upper case
 */
static mblk_t *
upmod_upcase(mblk_t *passed_mp)
{
	mblk_t *mp = passed_mp;

	for (; mp != NULL; mp = mp->b_cont) {
		if ((DB_TYPE(mp) == M_DATA) && (MBLKL(mp) > 0)) {
			unsigned char *p;

			for (p = mp->b_rptr; p < mp->b_wptr; p++)
				if (islower(*p))
					*p = toupper(*p);
		}
	}
	return (passed_mp);
}

The DB_TYPE(mp) macro simply returns mp->b_datab->db_type value and MBLKL(mp) is the amount of data between the read and write pointers . These macros together with some other useful definitions are defined in sys/strsun.h file:

#define	DB_BASE(mp)	((mp)->b_datap->db_base)
#define	DB_LIM(mp)	((mp)->b_datap->db_lim)
#define	DB_REF(mp)	((mp)->b_datap->db_ref)
#define	DB_TYPE(mp)	((mp)->b_datap->db_type)

#define	MBLKL(mp)	((mp)->b_wptr - (mp)->b_rptr)
#define	MBLKSIZE(mp)	((mp)->b_datap->db_lim - (mp)->b_datap->db_base)
#define	MBLKHEAD(mp)	((mp)->b_rptr - (mp)->b_datap->db_base)
#define	MBLKTAIL(mp)	((mp)->b_datap->db_lim - (mp)->b_wptr)
#define	MBLKIN(mp, off, len) (((off) <= MBLKL(mp)) && \
			(((mp)->b_rptr + (off) + (len)) <= (mp)->b_wptr))

/*
 * This example demonstrates a minimum STREAMS module that honors flow control.
 * It converts all data bytes on the read side to the upper case.
 */

/*
 * Required include files.
 */
#include	
#include	
#include	
#include	
#include	
#include	
#include	

/*
 * Function prototypes.
 */
static int	upmodopen(queue_t *, dev_t *, int, int, cred_t *);
static int	upmodclose(queue_t *);

static void	upmodput(queue_t *, mblk_t *);
static void	upmodrput(queue_t *, mblk_t *);
static void	upmodsrv(queue_t *);
static mblk_t	*upmod_upcase(mblk_t *mp);

/*
 * Module linkage data
 */
static struct module_info	upmod_minfo = {
	2,		/* mi_idnum */
	"upmod",	/* mi_idname */
	0,		/* mi_minpsz */
	INFPSZ,		/* mi_maxpsz */
	4096,		/* mi_hiwat */
	512		/* mi_lowat */
};

static struct qinit	upmod_rinit = {
	(int (*)())upmodput,	/* qi_putp */
	(int (*)())upmodsrv,	/* qi_srvp  */
	upmodopen,	/* qi_qopen */
	upmodclose,	/* qi_qclose */
	NULL,		/* qi_qadmin */
	&upmod_minfo,	/* qi_minfo */
};

static struct qinit	upmod_winit = {
	(int (*)())upmodrput,	/* qi_putp */
	(int (*)())upmodsrv,	/* qi_srvp */
	NULL,		/* qi_qopen */
	NULL,		/* qi_qclose */
	NULL,		/* qi_qadmin */
	&upmod_minfo,	/* qi_minfo */
};

static struct streamtab	upmod_info = {
	&upmod_rinit,	/* st_rdinit */
	&upmod_winit,	/* st_wrinit */
};

static struct fmodsw fsw = {
	"upmod",
	&upmod_info,
	D_MP | D_MTPERQ
};

/*
 * Module linkage information for the kernel.
 */
struct mod_ops mod_strmodops;

static struct modlstrmod modlstrmod = {
	&mod_strmodops, "Example up-through module 1.0", &fsw
};

static struct modlinkage modlinkage = {
	MODREV_1, (void *)&modlstrmod, NULL
};

/*
 * Standard module entry points.
 */
int
_init(void)
{
	return (mod_install(&modlinkage));
}

int
_fini(void)
{
	return (mod_remove(&modlinkage));
}

int
_info(struct modinfo *modinfop)
{
	return (mod_info(&modlinkage, modinfop));
}


/*
 * Actual module code.
 */

/*
 * STREAMS entry points.
 */

/* ARGSUSED */
static int
upmodopen(queue_t *rq, dev_t *dev, int oflag, int sflag, cred_t *crp)
{
	if (sflag != MODOPEN)
		return (EINVAL);

	/* Prevent duplicate opens */
	if (rq->q_ptr != NULL)
		return (0);

	rq->q_ptr = WR(rq)->q_ptr = (void *)1;

	qprocson(rq);
	/*
	 * At this point module is linked in the STREAM and can send/receive
	 * messages. Its put/service procedures may execute at any time.
	 */
	return (0);
}

static int
upmodclose(queue_t *rq)
{
	qprocsoff(rq);
	rq->q_ptr = WR(rq)->q_ptr = NULL;
	/*
	 * At this point module is disconnected from the STREAM and can
	 * no longer receive messages. Its put or service procedures are not
	 * running.
	 */
	return (0);
}

/*
 * Support routines.
 */

/* Put procedure */
static void
upmodput(queue_t *q, mblk_t *mp)
{
	/*
	 * If the message is a high-priority message or there is no flow control
	 * and there are no messages in the queue already, pass it forward,
	 * otherwise queue.
	 */
	if (queclass(mp) == QPCTL ||
	    ((q->q_first == NULL) && canputnext(q)))
		putnext(q, mp);
	else
		(void) putq(q, mp);
}


/*
 * Support routines.
 */
static void
upmodrput(queue_t *q, mblk_t *mp)
{
	upmodput(q, upmod_upcase(mp));
}

/* Read/write side service routine */
static void
upmodsrv(queue_t *q)
{
	mblk_t *mp;

	/*
	 * Get messages from the service queue and pass them forward until flow
	 * controlled.
	 */
	while ((mp = getq(q)) != NULL) {
		if (canputnext(q)) {
			putnext(q, mp);
		} else {
			(void) putbq(q, mp);
			break;
		}
	}
}

#ifndef islower
#define	islower(x)	(((unsigned)(x) >= 'a') && ((unsigned)(x) <= 'z'))
#endif

#ifndef isupper
#define	isupper(x)	(((unsigned)(x) >= 'A') && ((unsigned)(x) <= 'Z'))
#endif

#ifndef toupper
#define	toupper(x)	(isupper(x) ? (x) : (unsigned)(x) - 'a' + 'A')
#endif

/*
 * Convert all ASCII chars in data blocks to upper case
 */
static mblk_t *
upmod_upcase(mblk_t *passed_mp)
{
	mblk_t *mp = passed_mp;

	for (; mp != NULL; mp = mp->b_cont) {
		if ((DB_TYPE(mp) == M_DATA) && (MBLKL(mp) > 0)) {
			uchar_t *p;

			for (p = mp->b_rptr; p < mp->b_wptr; p++)
				if (islower(*p))
					*p = toupper(*p);
		}
	}

	return (passed_mp);
}

$ /usr/sfw/bin/gcc -c -m64 -o upmod.o -I/usr/include \
    -O -D_KERNEL  -D_SYSCALL32 -D_SYSCALL32_IMPL upmod.c
$ ld -r -o upmod upmod.o

$ su
# cp upmod /kernel/strmod/sparcv9
# exit
$ strchg -h upmod
$ UPTIME
  4:53PM  UP 35 DAY(S),  4:38,  2 USERS,  LOAD AVERAGE: 0.01, 0.01, 0.00
USER     TTY           LOGIN@  IDLE   JCPU   PCPU  WHAT
USER    PTS/1         8AUG0510DAYS      8         BASH
USER    PTS/2         4:11PM           12      1  W
$ STRCHG -P
$ w
   4:55pm  up 35 day(s),  4:39,  2 users,  load average: 0.00, 0.01, 0.00
User     tty           login@  idle   JCPU   PCPU  what
user    pts/1         8Aug0510days      8         bash
user    pts/2         4:11pm           12      1  w

Tuesday June 14, 2005

Putnext and stack overflows

Now, when the OpenSolaris is finally a reality, engineers can really start talking about the interesting staff. We spend most of our time dealing with code and it quite difficult to talk about what you do without being able to provide examples. Now is the time for the real technical blogging instead of the hand-waving.

I spent quite a lot of my time at Sun hacking STREAMS internals - things that almost no one ever notices, except for some unlucky folks who run into some nasty issues. Here I want to continue the sewer tour, started by Bryan Cantrill and take interested visitors to some of the STREAMS sewers.

Our tour will start with a few lines of code in the putnext() function. In the original implementation it was just a simple macro calling the put procedure of the next module in the STREAM:

#define putnext(q,  mp) ((*(q)->q_next->q_qinfo->qi_putp)((q)->q_next, (mp)))

In Solaris it evolved into a rather complicated code¹. Its inner workings deserve quite a few separate blog entries, but now we will take a side tour to a small piece of code that may catch your attention:

        /*
         * If there are writers or exclusive waiters, there is not much
         * we can do.  Place the message on the syncq and schedule a
         * background thread to drain it.
         *
         * Also if we are approaching end of stack, fill the syncq and
         * switch processing to a background thread - see comments on
         * top.
         */
        if ((flags & (SQ_STAYAWAY|SQ_EXCL|SQ_EVENTS)) ||
            (sq->sq_needexcl != 0) || PUT_STACK_NOTENOUGH()) {

                /*
                 * NOTE: qfill_syncq will need QLOCK. It is safe to drop
                 * SQLOCK because positive sq_count keeps the syncq from
                 * closing.
                 */
                mutex_exit(SQLOCK(sq));

                qfill_syncq(sq, qp, mp);
                /*
                 * NOTE: after the call to qfill_syncq() qp may be
                 * closed, both qp and sq should not be referenced at
                 * this point.
                 *
                 * This ASSERT is located here to prevent stack frame
                 * consumption in the DEBUG code.2
                 */
                ASSERT(sqciplock == NULL);
                return;
        }

The code uses a notion of a syncq, which is a synchronization abstraction used by STREAMS. Whenever some module calls the putnext() function, the code checks for various conditions and if everything seems all-right, it just calls the put procedure of the next module in the STREAM. If something doesn't seem right (e.g. the target module is busy processing other messages), the message is placed on the special queue in the syncq and the framework arranges a different kernel thread to pass the enqueued message to the next module when the module is ready³. The important observation is that this kernel thread executes has its own fresh stack. The highlighted code above hijacks this normal STREAMS mechanism to protect from a rather nasty problem - kernel stack overflow.

Note that STREAMS is a very flexible framework that allows many modules to be linked together in a chain (or even something more complex like a tree or U-pipe). Every new Solaris release includes some new STREAMS modules and drivers that often play in concert to provide some exciting new functionality. The downside is that the chain-calling of module's put procedures creates really long call chains on the stack and sometimes causes kernel panics caused by the stack overflow.

Soon after Solaris 9 release I saw quite a few similar panics, happening because all the kernel thread stack is consumed by a pile of STREAMS modules. Here is a typical example:

  402760b0 allocb+0x180()
  40276110 ip_wput_frag_copyhdr+0x14()
  40276170 ip_wput_frag+0x124()
  40276290 ip_wput_ire+0x1a98()
  402763e8 ire_send+0x218()
  40276448 ire_add_then_send+0x304()
  402764b0 ip_newroute+0xb78()
  40276600 ire_send+0x198()
  40276660 ire_add_then_send+0x304()
  402766c8 ip_wput_nondata+0x874()
  40276748 putnext+0x400()
  402767a8 ar_query_reply+0x150()
  40276808 ar_entry_query+0x154()
  40276878 ar_rput+0x144()
  402768e8 putnext+0x400()
  40276948 ip_newroute+0x1760()
  40276a98 putnext+0x400()
  40276af8 udp_wput+0x63c()
  40276b80 putnext+0x400()
  40276be0 putnext+0x400()
  40276c40 strput+0x57c()
  40276d68 kstrputmsg+0x3bc()
  40276de8 tli_send+0x20()
  40276e48 t_ksndudata+0x284()
  40276ea8 clnt_clts_kcallit_addr+0x3dc()
  40276f90 clnt_clts_kcallit+0x38()
  40277000 rfscall+0x46c()
  402770b8 rfs3call+0x68()
  40277130 nfs3write+0x11c()
  402772b0 nfs3_bio+0x334()
  40277310 nfs3_rdwrlbn+0xf0()
  40277380 nfs3_sync_putapage+0x34()
  402773e0 nfs3_putapage+0x364()
  40277470 pvn_vplist_dirty+0x424()
  40277568 nfs_putpages+0x174()
  402775e0 nfs3_putpage+0xa8()
  40277640 nfs_purge_caches+0x98()
  402776a0 nfs_cache_check+0xf8()
  40277700 nfs3_getattr_otw+0x12c()
  40277840 nfs3_validate_caches+0x11c()
  40277908 nfs3_getpage+0x44()
  40277990 segvn_fault+0xa74()
  40277a90 as_fault+0x4c4()
  40277b40 pagefault+0x40()
  40277ba8 trap+0xd90()
  40277c80 utl0+0x4c()

Although each modules uses just a small amount, numbers quickly add up. It is like going to the grocery store to buy a whole bunch of small items. Each one is really cheap, but you end up paying a lot at the counter.

At the time I was fixing some bugs in the syncq implementation and spent a lot of time fooling around putnext() and its friends, so I spotted the possibility to use the existing putnext() ability to delegate work to a new kernel thread to avoid such panics. The idea was really simple: in addition to the usual work handout in case the perimeter is busy, perform the same handout when we are too close to blowing away the stack. So I added the highlighted code above together with the definition for PUT_STACK_NOTENOUGH:

#define PUT_STACK_NEEDED 5000

#define PUT_STACK_NOTENOUGH()                                   \
        (((STACK_BIAS + (uintptr_t)getfp() -                    \
            (uintptr_t)curthread->t_stkbase) < put_stack_needed))

The value of PUT_STACK_NEEDED was chosen experimentally. It is impossible to predict how much stack will be used in the future. For example, a simple call to allocb() may, in some unlucky circumstances, trigger a long chain of calls through the kmem and vmem memory allocation layers. So the value of PUT_STACK_NEEDED was chosen to prevent common panics that we saw during the PIT runs ⁴.

I run the fix through the real kernel experts - Bryan Cantrill, who fixed a tricky kernel stack overflow problem before⁵ and Mike Shapiro. Mike suggested making PUT_STACK_NOTENOUGH a generic kernel function for others to use, while Bryan objected. We had a heated meeting in Mike's office and as a result, the following comment appeared at the top of putnext.c file:

/*
 * Streams with many modules may create long chains of calls via putnext() which
 * may exhaust stack space. When putnext detects that the stack space left is
 * too small (less then PUT_STACK_NEEDED), the call chain is broken and
 * further processing is delegated to the background thread via call to
 * putnext_tail(). Unfortunately there is no generic solution with fixed stack
 * size, and putnext() is recursive function, so this hack is a necessary evil.
 *
 * The redzone value is chosen dependent on the default stack size which is 8K
 * on 32-bit kernels and on x86 and 16K on 64-bit kernels. The values are chosen
 * empirically. For 64-bit kernels it is 5000 and for 32-bit kernels it is 2500.
 * Experiments showed that 2500 is not enough for 64-bit kernels and 2048 is not
 * enough for 32-bit.
 *
 * The redzone value is a tuneable rather then a constant to allow adjustments
 * in the field.
 *
 * The check in PUT_STACK_NOTENOUGH is taken from segkp_map_red() function. It
 * is possible to define it as a generic function exported by seg_kp, but
 *
 * a) It may sound like an open invitation to use the facility indiscriminately.
 * b) It adds extra function call in putnext path.
 *
 * We keep a global counter `put_stack_notenough' which keeps track how many
 * times the stack switching hack was used.
 */

The hack was integrated⁶ early in Solaris 10 and backported to S9 updates. Later in S10 timeframe another engineer did the real fix for the stack overflow problem - increased the stack size on 64-bit kernel (see bug 4922366 ). It is worth mentioning a comment, made by Jeff Bonwick in the evaluation of this bug:

Yep. Grow the kernel stack. Memory is cheap. Panics are expensive.

I've been through several kernel stack crises before. They always unfold the same way. Some particular workload goes too deep. We prune a few stack frames to fix the offending code path. Then another one comes up. And another. (Right about now someone suggests that instead of growing the stack for every thread, we should finally bite the bullet and make the kernel stack growable. I dig up my mail archive from the last time we contemplated this, and explain why it's much harder than it sounds.) Eventually the panic rate becomes so high that we have to act. Nobody can figure out how to make dynamic stack growth work reliably, so after one more jurassic outage we accept physics and grow the stack.

So my proposal is that this time, we dispense with all the hand-wringing and just grow the damn thing.

Postscriptum

As it often happens, the stack protection hack uncovered another long-standing and interesting bug⁷ in Solaris qfill_syncq() function, but this is a subject of another blog... .

Footnotes:

¹ The added complexity comes from the multi-threaded nature of the kernel. While one thread tries to access q_next, another thread may change it at the same, which leads to chaos. Solaris STREAMS provide a rich set of synchronization mechanism, called STREAMS perimeters which simplify the life of module and driver writers at the cost of internal complexity of the implementation.

² Modern compilers are very smart and can optimize a function call immediately followed by a return statement so that the callee reuses the stack frame of the caller. This is called tail-call optimization. It saves the stack space, but obscures debugging and sometimes even the DTrace. The problem is that the function call back-trace you see in the stack trace does not accurately represent the actuall calling sequences in the presence of tail-calls. To simplify debugging the seemingly useless ASSERT prevents such tail-call optimization on DEBUG kernels, while keeping all the performance benefits of production builds.

³ The STREAMS framework is very careful to pass down all messages in the order received.

⁴ It turned out that the stack barrier value of 5000 was too aggressive for 8K stacks on 32-bit sparc systems, so it was adjusted to 2500 on 32-bit platforms.

⁵ Bryan fixed bug 1259818 back in Solaris 2.6.

⁶ This was fixed as bug 4525533.

⁷ Don't spend your time trying to find the bug in qfill_syncq() function - it was fixed before S10 was released.

Friday May 27, 2005

Playing with STREAMS module from the User-Land

Playing with STREAMS module from the User-Land

In my previous STREAMS blog entry, we discussed, how to construct a do-nothing STREAMS module. Now we will come back to the user-land and see how we can play with STREAMS modules. We will learn, how to

• List all modules in the stream;
• Push a new module;
• Pop a module;

Show me the STREAM

Suppose that you have an open file descriptor fd and would like to know what STREAMS modules and drivers live behind the scene in the kernel in the STREAM representing the file.

The article by Rajesh Ramchandani on the Sun Developer Network provides an excellent example with the full source code of the printmod() function. It uses the I_LIST> ioctl which returns a list of modules in the struct str_mlist structure.

Please add my module

The next thing we are going to try is pushing our new module onto the STREAM. The following simple function should do the trick:

int pushmod(int fd, char *modname)
{
	int rc;

	if ((rc = ioctl(fd, I_PUSH, modname)) < 0) {
		perror("I_PUSH");
		fprintf(stderr, "pushmod(%d, %s) failed\n", fd, modname);
	}
	return rc;
}

The function takes a file descriptor and the module name and pushes the module on top of the stream. It returns 0 on success and -1 on failure. We can extend it a bit to put a whole list of modules. Suppose that the module list is a string with commas separating module names:

/* Push list of modules separated by commas */
int pushlist(int fd, char *s)
{
	char *comma = strchr(s, ',');
	int rc = 0;

	if (comma == NULL)
		return (pushmod(fd, s));

	*comma = '\0';

	if (((rc = pushmod(fd, s)) >= 0) && *(comma+1) != '\0') {
		*comma = ',';
		rc = pushlist(fd, comma + 1);
	}

	return (rc);
}

#include <stdio.h>
#include <stdlib.h>
#include <unistd.h>
#include <stropts.h>
#include <strings.h>

void main(int argc, char *argv[])
{
	if (argc == 1)
		return;

	if (pushlist(0, argv[1]) < 0)
		exit(1);
	exit(0);
}

We can name this program as pushmod.c and try it (assuming that you have installed the nullmodmodule from the previous example:

 $ cc pushmod.c -o pushmod
 $ strconf
 ttcompat
 ldterm
 ptem
 pts
 $ ./pushmod nullmod,nullmod,nullmod
 nullmod
 nullmod
 nullmod
 ttcompat
 ldterm
 ptem
 pts

I don't want to see you any more!

Finally, you may remove the module from the top of the stream using a simple call

  if ((rc = ioctl(fd1, I_POP, 0)) < 0) {
  	perror("I_POP");

Conclusions.

Now you know how to manipulate the content of the STREAM. You may want to play with it a bit and see what happens if you insert and remove some interesting modules.

NOTE: It is quite likely that your terminal window will become unusable as a result of your experiments. Many modules assume certain context and the are designed to play in concert with others, so your terminal may misbehave if it is incorrectly configured.

Saturday May 21, 2005

Open Solaris is Good for Linux!

Open Solaris is Good for Linux!

There is quite a lot of discussion of various reasons and motivations for Sun to open source its crown jewel - the Solaris operating system. Quite a few people, both internally at Sun and externally believe that the move will help Sun as a company, but here I'd like to explore why opening Solaris is good for everyone else - for Linux for FreeBSD and for the computer community, in general.

In my opinion, the real value of the OpenSolaris is the opening of a vast amount of knowledge about the design of very complex computer systems. To really appreciate the value of this knowledge it helps to think about the way humans learn and understand the meaning of things.

The following quote is from the paper by Marvin Minsky:

Castles In The Air.

The secret of what something means lies in the ways that it connects to all the other things we know. The more such links, the more a thing will mean to us. The joke comes when someone looks for the "real" meaning of anything. For, if something had just one meaning, that is, if it were only connected to just one other thing, then it wold scarcely "mean" at all!

That's why I think we shouldn't program our machines that way, with clear and simple logic definitions. A machine programmed that way might never "really" understand anything -- any more than a person would. Rich, multiply-connected networks provide enough different ways to use knowledge that when one way doesn't work, you can try to figure out why. When there are many meanings in a network, you can turn things around in your mind and look at them from different perspectives; when you get stuck, you can try another view. That's what we mean by thinking!

That's why I dislike logic, and prefer to work with webs of circular definitions. Each gives meaning to the rest. There's nothing wrong with liking several different tunes, each one the more because it contrasts with the others. There's nothing wrong with ropes - or knots, or woven cloth - in which each strand helps hold the other strands together - or apart! There's nothing very wrong, in this strange sense, with having all one's mind a castle in the air!

To summarize: of course no computer could understand anything real -- or even what a number is - if forced to single ways to deal with them. But neither could a child or philosopher. So such concerns are not about computers at all, but about our foolish quest for meanings that stand by themselves, outside any context. Our questions about thinking machines should really be questions about our own minds.

In Minsky terminology, Solaris source is an extremely rich body of interwoven knowledge about the design of the state of the art computer systems. This body of knowledge was produced (and packed in the form of C code) in the course of many years of Solaris development by many extremely competent engineers. For a long time this knowledge was only available only to the small community of engineers and soon it will be available to everyone curious enough to tap it.

I am not suggesting that the knowledge embedded in other operating systems source code is any "better" or "worse" than the one embedded in the Solaris code. It was created by different people having different background, different objectives, different environments and different customer bases. It is just different. And, together, all of these provide even richer web of knowledge, that is much more useful then each individual part because they represent quite different dimensions.

So why is opening up a bunch of source code is really important to Linux (or FreeBSD, or any other software project)? Because, someone who takes the time and effort to read and understand even small parts of this embedded knowledge will almost certainly get new insights in whatever projects he or she is currently working on or thinking about. Even if the developer will not reuse any single line of the code, he will, definitely, gain in understanding his own area of expertise. Not to mention the trivial fact that the CDDL license allows developers to directly build their software based on the Solaris source. Consider, for example, an "open-sourcing" of a small part of Solaris design - the Slab Allocator, made by Jeff Bonwick in the form of the USENIX Paper and the followup paper. Was it useful to Linux and other software projects? If we ignore that fact that the slab allocator based on these papers is now the standard Linux kernel memory allocator, I am pretty sure that just reading these two papers was a very useful journey for a reader. And, be assured that the person who invented the Slab Allocator has more to say - and, indeed, says a lot - in C.

Another, more recent, example is DTrace, which is already available. It is not immediately obvious why DTrace is good for Linux, consider how much more effort is now put in creating the adequate Linux tracing facility that could compete with DTrace! Even if not a single line of DTrace source will find its way into the Linux distribution, it would definitely serve as a "prove of existence" and an inspiration. And, as Linux tracing facility will improve under the influence of DTrace, DTrace itself will improve to stay a relevant tool.

As a result of such cross-influence of ideas, the whole body of available software improves in its quality and the coverage and everyone wins!

And for this reason it makes sense for many computer engineers, students and just curious minds around to set aside some time to read and understand some parts of the OpenSolaris source code. And those who think that something embeds the whole meaning should, probably, reread the Minsky paper.

Technorati Tags: OpenSolaris, Solaris.

Friday May 13, 2005

STREAMS Hello World

Ever wondered, what would it take to write a minimum STREAMS module that can be correctly installed onto Solaris system? Here is an example of such module (which we will call nullmod) with some explanations.

Every STREAMS module should define the following entry points:

o Module open routine;

o Module close routine;

o Module read side put procedure;

o Module write side put procedure;

o Module read side service procedure (optional);

o Module write side service procedure (optional);

Since our module will only pass messages back and forth it will use putnext(9f) as both write and read side put procedure and will not have any service procedures. So we need to define only open/close functions which we will call nullmodopen() and nullmodclose().

  /*
   * Module open routine.
   * Mark the module as "opened" and link it to
   * the STRREAM.
   */
  static int
  nullmodopen(queue_t *rq, dev_t *dev,
        int oflag, int sflag, cred_t *crp)
  {
        if (sflag != MODOPEN)
                return (EINVAL);

        /*
         * Prevent duplicate opens.
         * The q_ptr is reserved for module private use
         */
        if (rq->q_ptr != NULL)
                return (0);

        /* Mark the module as "opened" */
        rq->q_ptr = WR(rq)->q_ptr = (void *)1;

        /* Link the module into the STREAM */
        qprocson(rq);
        /*
         * At this point module is linked in the STREAM
         * and can send/receive messages.
         * Its put/service procedures may execute at any time.
         */
        return (0);
  }

  /*
   * Module close routine.
   * Disconnect the module from the STREAM.
   */
  static int
  nullmodclose(queue_t *rq)
  {
        /* Disconnect the module from the STREAM */
        qprocsoff(rq);
        /*
         * At this point module is disconnected from the STREAM and can
         * no longer receive messages. Its put or service procedures are not
         * running.
         */
        rq->q_ptr = WR(rq)->q_ptr = NULL;
        return (0);
  }

This is pretty much the only code we need to write. The rest is the glue code that should be present in any module. Here is the description of this glue code.

Every source file should start with comments, so we shall start the nullmod.c with the appropriate comment:

  /*
   * Nullmod: the minimal functioning STREAMS module.
   *
   * Copyright ..... (place your favorite one here).
   *
   */

We will need certain system include files:

  /*
   * Required include files.
   */
  #include      <sys/types.h>
  #include      <sys/conf.h>
  #include      <sys/cred.h>
  #include      <sys/ddi.h>
  #include      <sys/modctl.h>

As we discussed before, our module will define only two functions - nullmodopen() and nullmodclose():

  /*
   * Function prototypes.
   */
  static int    nullmodopen(queue_t *, dev_t *, int, int, cred_t *);
  static int    nullmodclose(queue_t *);

Every STREAMS kernel module should have a corresponding module_info(9S) structure:

  static struct module_info     nullmod_minfo = {
        1,              /* mi_idnum */
        "nullmod",      /* mi_idname */
        0,              /* mi_minpsz */
        INFPSZ,         /* mi_maxpsz */
        0,              /* mi_hiwat */
        0               /* mi_lowat */
  };

Also it should have qinit(9S) structures for both the read and write sides:

  static struct qinit nullmod_rinit = {
        (int (*)())putnext,     /* qi_putp */
        NULL,           /* qi_srvp  */
        nullmodopen,    /* qi_qopen */
        nullmodclose,   /* qi_qclose */
        NULL,           /* qi_qadmin */
        &nullmod_minfo, /* qi_minfo */
  };

  static struct qinit nullmod_winit = {
        (int (*)())putnext,     /* qi_putp */
        NULL,           /* qi_srvp */
        NULL,           /* qi_qopen */
        NULL,           /* qi_qclose */
        NULL,           /* qi_qadmin */
        &nullmod_minfo, /* qi_minfo */
  };

The streamtab(9S) structure links both together:

  static struct streamtab nullmod_info = {
        &nullmod_rinit, /* st_rdinit */
        &nullmod_winit, /* st_wrinit */
  };

The fmodsw(9S) structure describes tqhe module to the operating system, providing the pointer to the streamtab structure above:

  static struct fmodsw fsw = {
        "nullmod",      /* module name */
        &nullmod_info,  /* streams information */
        D_MP            /* module flags - multithreaded module */
  };

Now we need to provide the linkage information for the module:

  /*
   * Module linkage information for the kernel.
   */
  struct mod_ops mod_strmodops;

  static struct modlstrmod modlstrmod = {
        &mod_strmodops, "Example pass-through module 1.0", &fsw
  };

  static struct modlinkage modlinkage = {
        MODREV_1, (void *)&modlstrmod, NULL
  };

Every loadable kernel module should also provide _init, _fini and _info entry points.

_init(9E) initializes a loadable module. It is called before any other routine in a loadable module. Most modules do not require any specific initialization and can just call mod_install(9F). _fini(9E) prepares a loadable module for unloading. It is called when the system wants to unload a module. In most cases it can just call mod_remove(9F). _info(9E) returns information about a loadable module. In most cases _info(9E) just returns the value returned by mod_info(9F).

  /*
   * Standard module entry points.
   */
  int _init(void)
  {
        return (mod_install(&modlinkage));
  }

  int _fini(void)
  {
        return (mod_remove(&modlinkage));
  }

  int_info(struct modinfo *modinfop)
  {
        return (mod_info(&modlinkage, modinfop));
  }

Now we need to put our definitions for nullmodopen() and nullmodclose() above and we are done! Our ``do-nothing'' module is ready.

Let us save the module in the file nullmod.c. To compile it we need a C compiler which can generate the code for the native kernel mode - 32-it for x86 and 64-bit for Sparc or AMD64 platforms. If we are using Sun compilers we can use the following commands to produce the module binary on sparc:

  cc -c  -D_KERNEL -D_SYSCALL32 -D_SYSCALL32_IMPL -xarch=v9 nullmod.c

Or with gcc

  gcc -c -D_KERNEL -D_SYSCALL32 -D_SYSCALL32_IMPL -m64 nullmod.c

After that we need to use ld with -r option to produce the final binary:

  ld -r -o nullmod nullmod.o

Now we need to copy our module to /usr/kernel/strmod/sparcv9 (you need to be a super-user for this):

  # cp nullmod /usr/kernel/strmod/sparcv9

!!WARNING!!: you are going to install the kernel module. It is possible that the system will panic if there is some problem in the module. Please make sure that no one else is using the system and you will not upset anyone (including yourself) if the system panics as a result of your experiments. End of WARNING.

Now we can load the module:

  # modload nullmod

And verify that it is loaded:

  # modinfo | grep nullmod
  147 7bbbde30 320 - 1 nullmod (Example pass-through module 1.0)

We can also insert our module onto STDIN for our shell:

  # strchg -h nullmod

and verify that it is present:

  # strconf 
  nullmod
  ttcompat
  ldterm
  ptem
  pts

When we are done, we can remove the module from our shell STDIN:

  # strchg -p
  # strconf 
  ttcompat
  ldterm
  ptem
  pts

You can also unload the module (it is usually not rquired as Solaris unloads unused modules itself):

  # modunload -i 147
  # modinfo|grep nullmod
  #

Now you know how to

- Write a trivial Solaris STREAMS kernel module

- Compile the module

- Install the module on your system

- Load and unload the module

Why this module may be of any use? I can think of several reasons:

It provides a good template for more complicated modules

You can use it to estimate performance impact of inserting a module in a STREAM. This is the fastest module possible, so any additional code will only slow things down.

You can demonstrate your Solaris kernel skills duuring the job interview.

Not bad for a simple do-nothing program!

Friday April 08, 2005

Converting C arrays to Perl arrays in XS: Continuation

Converting C arrays to Perl arrays in XS: Continuation

In the previous example we created a Perl function intlist() which returned a list of integers starting from 0.

Here is a simple example:

  $ perl -Mblib -MXS::Test \
        -e 'print join(" ", intlist 5), "\n"';
  0 1 2 3 4

What happens if we call the intlist function in scalar context?

  $ perl -Mblib -MXS::Test \
        -e 'print scalar intlist 5, "\n"';
  4

It prints the last value! It does the same thing when getting scalar value of a list:

  $ perl -e 'print scalar (0,1,2,3,4), "\n"'
  4

The reason is that it treats the value in brackets as the comma operator which returns the last value. Now what if we want to return something different when the function is called in scalar context? For example, we may want to return the total number of elements or some other value. In Perl we can use wantarray() function for that purpose. There is a similar way in XS code.

Let us rewrite the intlist XS definition:

  void
  intlist(size)
        int size;
  PREINIT:
        int *a;
  PPCODE:
        if (GIMME_V == G_SCALAR) {
                if (size >= 0)
                        XSRETURN_IV(size);
                else
                        XSRETURN_UNDEF;
        }
        if (size > 0 && New(0, a, size, int) != NULL) {
                int i;
                intlist(size, a);
                EXTEND(SP, size);
                for (i = 0; i < size; i++)
                        PUSHs(sv_2mortal(newSVnv(a[i])));
        }

The expression GIMME_V == G_SCALAR is true when the function is called in scalar context. In this case we return the size specified as an immediate return value using the XSRETURN_IV macro or return undef value if size is negative. Now, if we repeat the example above, we get what we expect:

  $ perl -Mblib -MXS::Test \
        -e 'print scalar intlist 5, "\n"';
  5

Or, if we specify a negative value

  $ perl -Mblib -MXS::Test -MData::Dumper \
        -e 'print Dumper(scalar intlist -5), "\n"';
  $VAR1 = undef;

Technorati Tag: Perl

Tuesday March 22, 2005

Converting C arrays to Perl lists

Converting C arrays to Perl arrays in XS

Here is a short example of XS dealing with C arrays. I assume that you followed direction in the previous section and have a populated ext/Test/XS directory.

Suppose that we have the following C function:

  void intlist(int size, int *output)
  {
        for (i = 0; i < size; i++)
                output[i] = i;
  }

and we would like to get access to it from Perl. We will start by creating xs_test.c file together with our XS::Test module, containing the function above. We will also add

void intlist(int, int *);

line to the "xs_test.h" file.

Now we can write XS glue code to provide an interface with the C function. What we will do there is get every entry from the C array and push it onto the Perl stack and return it as a Perl list. We need to use the PPCODE directive to do this:

  void
  intlist(size)
        int size;
  PREINIT:
        int *a;
  PPCODE:
        if (size > 0 && New(0, a, size, int) != NULL) {
                int i;
                (void)intlist(size, a);
                /* Create enough space on the stack */
                EXTEND(SP, size);
                for (i = 0; i < size; i++)
                        PUSHs(sv_2mortal(newSVnv(a[i])));
                        
        }

If the size argument is zero or negative or we can't allocate memory the function will return empty list to the caller.

To test the function let's add few tests to the XS-test.t file:

  my @l = intlist 5;
  ok(eq_array(\@l, [0, 1, 2, 3, 4]), 'Correct intlist array') or
    diag("invalid result of intlist 5: \@l = @l");
  my @l1 = intlist(-1);
  my $l1 = @l1;
  is($l1, 0, 'Invalid list is empty') or
    diag("The returned list is @l1");

We are using the Test::More(1) eq_array function to compare two arrays. Everything works fine so far. We can run

  $ make test

in the module directory and all tests pass.

Technorati Tag: Perl

Wednesday March 16, 2005

Pitfals of the Perl XS or what to do when things do not work as advertised

Introduction

I was working on providing Perl interface to the liblgrp(3LIB) library so that simple scripts can be written to understand NUMA topology of a given machine. I started by reading pretty good and extensive documentation explaining how to write Perl extensions: perlxstut(1), perlxs(1), perlguts(1) and h2xs(1).

While these documents explain things pretty well I stumbled across various things that didn't work as advertised, so I decided to do a walk through a simple example and show what can go wrong and how to fix it.

Initial stubs module

The Perl XS documentation suggests using h2xs as a starting point. Let's follow its recommendation. The h2xs documentation provides a simple example for extension based on .h and .c files. We will assume that the header file is called xs_test.h and we want the perl module be named as XS::Test. Let's follow the h2xs(1) man page and perform Start with a dummy run of h2xs:

  $ h2xs h2xs -Afn XS::Test

  Writing ext/XS-Test/ppport.h
  Writing ext/XS-Test/lib/XS/Test.pm
  Writing ext/XS-Test/Test.xs
  Writing ext/XS-Test/Makefile.PL
  Writing ext/XS-Test/README
  Writing ext/XS-Test/t/XS-Test.t
  Writing ext/XS-Test/Changes
  Writing ext/XS-Test/MANIFEST

Let's remove ppport.h and use long option names for readability option names.

  $ h2xs --skip-ppport  --omit-autoload --force --name=XS::Test

  Writing ext/XS-Test/lib/XS/Test.pm
  Writing ext/XS-Test/Test.xs
  Writing ext/XS-Test/Makefile.PL
  Writing ext/XS-Test/README
  Writing ext/XS-Test/t/XS-Test.t
  Writing ext/XS-Test/Changes
  Writing ext/XS-Test/MANIFEST

So far so good.

Adding header file

Now let's populate the directory with an empty header file

  $ touch ext/XS-Test/xs_test.h

and create the actual extension. The man pages suggests to run

    h2xs -Oxan Ext::Ension interface_simple.h

Note that -x requires the C::Scan(1) package. Let us assume that it is installed and continue by replacing short options with long ones and changing the module name:

  $ h2xs --skip-ppport --overwrite-ok --autogen-xsubs \
         --name=XS::Test xs_test.h

  Can't find --overwrite-ok.h in . /usr/include /usr/sfw/include
        ...
        /usr/include ext/XS/Test

Hmm... Looking at the h2xs we see that the actual option name is --overwrite_ok instead of --overwrite-ok as advertised in the man page. So let's retry using the right option name:

  $ h2xs --skip-ppport --overwrite_ok --autogen-xsubs  \
         --name=XS::Test xs_test.h

  Can't find xs_test.h in . /usr/include /usr/sfw/include /opt/sfw/include
        ...
        /opt/GNU/include /usr/include ext/XS/Test

Obviously it is looking in the wrong place, the directory should be ext/XS-Test instead of ext/XS/Test. This is another h2xs bug.

Let's fix both bugs and create our own copy of h2xs in ~/bin/h2xs.fixed:

  $diff /usr/perl5/bin/h2xs ~/bin/h2xs.fixed
  573c573
  <                 'overwrite_ok|O'     => \$opt_O,
  ---
  >                 'overwrite-ok|O'     => \$opt_O,
  787c787
  <     (my $epath = $module) =~ s,::,/,g;
  ---
  >     (my $epath = $module) =~ s,::,-,g;

And now try again:

  $ ~/bin/h2xs.fixed --skip-ppport --overwrite-ok --autogen-xsubs \
                     --name=XS::Test xs_test.h

  Overwriting existing ext/XS-Test!!!
  Scanning typemaps...
  Scanning /usr/perl5/5.8.4/lib/ExtUtils/typemap
  Scanning xs_test.h for functions...
  Scanning xs_test.h for typedefs...
  Writing ext/XS-Test/lib/XS/Test.pm
  Writing ext/XS-Test/Test.xs
  Writing ext/XS-Test/fallback/const-c.inc
  Writing ext/XS-Test/fallback/const-xs.inc
  Writing ext/XS-Test/Makefile.PL
  Writing ext/XS-Test/README
  Writing ext/XS-Test/t/XS-Test.t
  Writing ext/XS-Test/Changes
  Writing ext/XS-Test/MANIFEST

Wow, now we should have a working extension that does nothing useful!

Adding constants

Let's move on and populate the header file with few simple constants:

  $ cat >ext/XS-Test/xs_test.h
  #define XST_DEFINE 1

  typedef enum xst_enum {
          XST_ENUM_1,
          XST_ENUM_2,
  } xst_enum_t;

  typedef enum xst_enum_val {
          XST_ENUM_VAL_1 = 1,
          XST_ENUM_VAL_2 = 2,
  } xst_enum_val_t;
  ^D

Repeating the exercise we get

  $ ~/bin/h2xs.fixed --skip-ppport --overwrite-ok --autogen-xsubs \
                     --name=XS::Test xs_test.h

  Overwriting existing ext/XS-Test!!!
  Scanning typemaps...
  Scanning /usr/perl5/5.8.4/lib/ExtUtils/typemap
  Scanning xs_test.h for functions...
  Scanning xs_test.h for typedefs...
  Use of uninitialized value in exists at 
      /home/akolb/bin/h2xs.fixed line 1025.
  Writing ext/XS-Test/lib/XS/Test.pm
  Writing ext/XS-Test/Test.xs
  Writing ext/XS-Test/fallback/const-c.inc
  Writing ext/XS-Test/fallback/const-xs.inc
  Writing ext/XS-Test/Makefile.PL
  Files "ext/XS-Test/fallback/const-c.inc" and 
        "ext/XS-Test/const-c.inc" differ.
  It appears that the code in ext/XS-Test/Makefile.PL 
             does not autogenerate the files 
             ext/XS-Test/const-c.inc and 
             ext/XS-Test/const-xs.inc correctly.

  Please report the circumstances of this bug in h2xs version 1.23 using the
  perlbug script. 
  Writing ext/XS-Test/README
  Writing ext/XS-Test/t/XS-Test.t
  Writing ext/XS-Test/Changes
  Writing ext/XS-Test/MANIFEST

Something went wrong and we need to start digging around. Running

  $ grep XST ext/XS-Test/* ext/XS-Test/*/* ext/XS-Test/*/*/*

we note that XST_ENUM_1 and XST_ENUM_2 are not present in the generated code. It turns out that there is another bug in h2xs that incorrectly parses enums. Fixing it gives

  870c868
  < my ($key, $declared_val) = $item =~ /(\w*)\s*=\s*(.*)/;
  ---
  > my ($key, $declared_val) = $item =~ /(\w+)\s*[=,]*\s*(.*)/;
 
After we fix it, retry and grep again both missing constants appear together
with other constants.

Hurra! Now our simple extension module it understands all our constants. Or does it? Let's make sure that everything works:

  $ cd ext/XS-Test
  $ perl Makefile.PL
  Checking if your kit is complete...
  Looks good
  Writing Makefile for XS::Test
  $ make test
  ...
  Running Mkbootstrap for XS::Test ()
  chmod 644 Test.bs
  rm -f blib/arch/auto/XS/Test/Test.so
  LD_RUN_PATH="" cc  -G Test.o  xs_test.o  -o blib/arch/auto/XS/Test/Test.so      
  chmod 755 blib/arch/auto/XS/Test/Test.so
  cp Test.bs blib/arch/auto/XS/Test/Test.bs
  chmod 644 blib/arch/auto/XS/Test/Test.bs
  PERL_DL_NONLAZY=1 perl "-MExtUtils::Command::MM" "-e" \
      "test_harness(0, 'blib/lib', 'blib/arch')" t/*.t
  t/XS-Test....ok
  All tests successful.
  Files=1, Tests=2,  0 wallclock secs ( 0.03 cusr +  0.00 csys =  0.03 CPU)

That's promising! Now let's add simple tests to verify that we can actually access all constants from Perl. Going to t/XS_Test.t let's add tests that verify that constants have expected values:

  $ diff XS-Test.t.~1~ XS-Test.t
  8c8
  < use Test::More tests => 2;
---
  > use Test::More tests => 7;
  30a31,35
  > is(XST_DEFINE, 1);
  > is(XST_ENUM_1, 0);
  > is(XST_ENUM_2, 1);
  > is(XST_ENUM_VAL_1, 1);
  > is(XST_ENUM_VAL_2, 2);

repeating the mantra:

  $ make test
  PERL_DL_NONLAZY=1 perl "-MExtUtils::Command::MM" "-e" \
      "test_harness(0, 'blib/lib', 'blib/arch')" t/*.t
  t/XS-Test....ok 2/7
  Your vendor has not defined XS::Test macro XST_ENUM_1, used at t/XS-Test.t line 32
  # Looks like you planned 7 tests but only ran 3.
  # Looks like your test died just after 3.
  t/XS-Test....dubious
        Test returned status 255 (wstat 65280, 0xff00)
  DIED. FAILED tests 4-7
        Failed 4/7 tests, 42.86% okay
  Failed Test Stat Wstat Total Fail  Failed  List of Failed
  ----------------------------------------------------------
  t/XS-Test.t  255 65280     7    8 114.29%  4-7
  Failed 1/1 test scripts, 0.00% okay. 4/7 subtests failed, 42.86% okay.
  *** Error code 2
  make: Fatal error: Command failed for target `test_dynamic'

Not so good! To figure out what's going on let's take a look at const-c.inc file:

    ...
    switch (name[9]) {
    case '1':
      if (memEQ(name, "XST_ENUM_", 9)) {
      /*                        1     */
  #ifdef XST_ENUM_1
        *iv_return = XST_ENUM_1;
        return PERL_constant_ISIV;
  #else
        return PERL_constant_NOTDEF;
  #endif

That explains the problem. Of course, there are no defines for enum constants! We found another bug in h2xs. Instead of fixing it let's take a look at the ExtUtils::Constant module. Looking at the ``macro'' key in the C_constant section we see:

macro

The C pre-processor macro to use in the ``#ifdef''. This defaults to the name, and is mainly used if value is an ``enum''. If a reference an array is passed then the first element is used in place of the ``#ifdef'' line, and the second element in place of the ``#endif''. This allows pre-processor constructions such as

  #if defined (foo)
  #if !defined (bar)
  ...
  #endif
  #endif

to be used to determine if a constant is to be defined.

A ``macro'' 1 signals that the constant is always defined, so the ``#if''/``#endif'' test is omitted.

So let's tweak Makefile.PL a bit:

  $ diff Makefile.PL.~1~ Makefile.PL
  22,23c22,28
  <   my @names = (qw( XST_DEFINE XST_ENUM_1 XST_ENUM_2
  <                    XST_ENUM_VAL_1 XST_ENUM_VAL_2));
  ---
  >   my @names = (qw(XST_DEFINE),
  >            # Enums should be specified as references with macro set to 1.
  >            {name=>"XST_ENUM_1", macro=>"1"},
  >            {name=>"XST_ENUM_2", macro=>"1"},
  >            {name=>"XST_ENUM_VAL_1",macro=>"1"},
  >            {name=>"XST_ENUM_VAL_2",macro=>"1"});

And retry our test:

  $ perl Makefile.PL
  Writing Makefile for XS::Test
  $ make
  ...
  Running Mkbootstrap for XS::Test ()
  chmod 644 Test.bs
  rm -f blib/arch/auto/XS/Test/Test.so
  LD_RUN_PATH="" cc  -G Test.o  xs_test.o  -o blib/arch/auto/XS/Test/Test.so      
  chmod 755 blib/arch/auto/XS/Test/Test.so
  cp Test.bs blib/arch/auto/XS/Test/Test.bs
  chmod 644 blib/arch/auto/XS/Test/Test.bs
  Manifying blib/man3/XS::Test.3

  $ make test
  PERL_DL_NONLAZY=1 perl "-MExtUtils::Command::MM" \
                    "-e" "test_harness(0, 'blib/lib', 'blib/arch')" t/*.t
  t/XS-Test....ok
  All tests successful.
  Files=1, Tests=7,  0 wallclock secs ( 0.03 cusr +  0.00 csys =  0.03 CPU)

Finally it works correctly and we successfully created an extension which exports constants! Uphh... Seems like h2xs should be smart enough to treat enums as advertised, but we found a way around.

Alternative: names directly in the module name space

There is an alternative approach for our module that doesn't require autoloaded functions and auto-generated constants and instead stashes constants directly in the module name space using the XS BOOT keyword.

Our Test.xs file is very simple at this point:

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

  #include <xs_test.h>

  #include "const-c.inc"

  MODULE = XS::Test             PACKAGE = XS::Test

  INCLUDE: const-xs.inc

Here is the trick:

  $ diff Test.xs.~1~ Test.xs

  7,8d6
  < #include "const-c.inc"
  < 
  11c9,27
 < INCLUDE: const-xs.inc
  ---
  > PROTOTYPES: ENABLE
  > 
  >  #
  >  # Define any constants that need to be exported.  By doing it this way we can
  >  # avoid the overhead of using the DynaLoader package, and in addition constants
  >  # defined using this mechanism are eligible for inlining by the perl
  >  # interpreter at compile time.
  >  #
  > BOOT:
  >     {
  >     HV *stash;
  > 
  >     stash = gv_stashpv("XS::Test", TRUE);
  >     newCONSTSUB(stash, "XST_DEFINE", newSViv(XST_DEFINE));
  >     newCONSTSUB(stash, "XST_ENUM_1", newSViv(XST_ENUM_1));
  >     newCONSTSUB(stash, "XST_ENUM_2", newSViv(XST_ENUM_2));
  >     newCONSTSUB(stash, "XST_ENUM_VAL_1", newSViv(XST_ENUM_VAL_1));
  >     newCONSTSUB(stash, "XST_ENUM_VAL_2", newSViv(XST_ENUM_VAL_2));
  >     }

This allows us to simplify Makefile.PL as well removing all uses of ExtUtils::Constant:

  $ diff Makefile.PL.~1~ Makefile.PL
  17,30d16
  < if  (eval {require ExtUtils::Constant; 1}) {
  <   my @names = (qw( XST_DEFINE XST_ENUM_1 XST_ENUM_2
  <                    XST_ENUM_VAL_1 XST_ENUM_VAL_2));
  <   ExtUtils::Constant::WriteConstants(
  <            NAME         => 'XS::Test',
  <            NAMES        => \@names,
  <            DEFAULT_TYPE => 'IV',
  <            C_FILE       => 'const-c.inc',
  <            XS_FILE      => 'const-xs.inc',
  <            );
  32,40d17
  < }
  < else {
  <   use File::Copy;
  <   use File::Spec;
  <   foreach my $file ('const-c.inc', 'const-xs.inc') {
  <     my $fallback = File::Spec->catfile('fallback', $file);
  <     copy ($fallback, $file) or die "Can't copy $fallback to $file: $!";
  <   }
  < }

Also there is no need for the autoload code in Test.pm file:

  $ diff lib/XS/Test.pm.~1~ lib/XS/Test.pm
  9d8
  < use AutoLoader;
  42,64d40
  < sub AUTOLOAD {
  <     # This AUTOLOAD is used to 'autoload' constants from the constant()
  <     # XS function.
  < 
  <     my $constname;
  <     our $AUTOLOAD;
  <     ($constname = $AUTOLOAD) =~ s/.*:://;
  <     croak "&XS::Test::constant not defined" if $constname eq 'constant';
  <     my ($error, $val) = constant($constname);
  <     if ($error) { croak $error; }
  <     {
  <     no strict 'refs';
  <     # Fixed between 5.005_53 and 5.005_61
  < #XXX        if ($] >= 5.00561) {
  < #XXX            *$AUTOLOAD = sub () { $val };
  < #XXX        }
  < #XXX        else {
  <         *$AUTOLOAD = sub { $val };
  < #XXX        }
  <     }
  <     goto &$AUTOLOAD;
  < }
  < 
  68,71d43
  < # Preloaded methods go here.
  < 
  < # Autoload methods go after =cut, and are processed by the autosplit program.
  <

Let's verify that everything works:

  $ make test
  Running Mkbootstrap for XS::Test ()
  chmod 644 Test.bs
  rm -f blib/arch/auto/XS/Test/Test.so
  LD_RUN_PATH="" cc  -G Test.o  xs_test.o  -o blib/arch/auto/XS/Test/Test.so      
  chmod 755 blib/arch/auto/XS/Test/Test.so
  cp Test.bs blib/arch/auto/XS/Test/Test.bs
  chmod 644 blib/arch/auto/XS/Test/Test.bs
  PERL_DL_NONLAZY=1 perl "-MExtUtils::Command::MM" \
             "-e" "test_harness(0, 'blib/lib', 'blib/arch')" t/*.t
  t/XS-Test....ok
  All tests successful.
  Files=1, Tests=7,  0 wallclock secs ( 0.03 cusr +  0.00 csys =  0.03 CPU)

It works! Final Test.pm looks pretty simple:

  package XS::Test;
  
  use strict;
  use warnings;
  
  require Exporter;
  our @ISA = qw(Exporter);
  
  our %EXPORT_TAGS = ( 'all' => [ qw(
        XST_DEFINE
        XST_ENUM_1
        XST_ENUM_2
        XST_ENUM_VAL_1
        XST_ENUM_VAL_2
  ) ] );
  
  our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
  our @EXPORT = qw(
        XST_DEFINE
        XST_ENUM_1
        XST_ENUM_2
        XST_ENUM_VAL_1
        XST_ENUM_VAL_2
  );
  
  our $VERSION = '0.01';
  
  require XSLoader;
  XSLoader::load('XS::Test', $VERSION);
  
  1;
  __END__

And the final Test.xs file:

  #include "EXTERN.h"
  #include "perl.h"
  #include "XSUB.h"
  
  #include <xs_test.h>
  
  MODULE = XS::Test             PACKAGE = XS::Test              
  
  PROTOTYPES: ENABLE
  
  BOOT:
        {
        HV *stash;
  
        stash = gv_stashpv("XS::Test", TRUE);
        newCONSTSUB(stash, "XST_DEFINE", newSViv(XST_DEFINE));
        newCONSTSUB(stash, "XST_ENUM_1", newSViv(XST_ENUM_1));
        newCONSTSUB(stash, "XST_ENUM_2", newSViv(XST_ENUM_2));
        newCONSTSUB(stash, "XST_ENUM_VAL_1", newSViv(XST_ENUM_VAL_1));
        newCONSTSUB(stash, "XST_ENUM_VAL_2", newSViv(XST_ENUM_VAL_2));
        }
    
    
This concludes our exercise. Now you should be able to write simple extensions
that just export constants from header files and avoid dangerous pitfalls!

Technorati Tag: Perl

Monday October 18, 2004

Grand Canyon Recycles Entering the Grand Canyon National Park we can see an interesting sign: "Grand Canyon Recycles". Indeed, I saw some serious birds looking for tourists who didn't stock enough water... ( Oct 18 2004, 06:10:13 PM PDT ) Permalink