1 /* Filename: Spread.xs
2 * Author: Theo Schlossnagle <jesus@cnds.jhu.edu>
3 * Created: 12th October 1999
4 * Version: 1.03152
5 *
6 * Copyright (c) 1999-2001 Theo Schlossnagle. All rights reserved.
7 * This program is free software; you can redistribute it and/or
8 * modify it under the same terms as Perl itself.
9 *
10 */
11
12 #include "EXTERN.h"
13 #include "perl.h"
14 #include "XSUB.h"
15
16 #include "sp.h"
17
18 #ifndef MIN
19 #define MIN(a,b) (((a)<(b))?(a):(b))
20 #endif
21
22 #ifndef PERL_VERSION
23 #include "patchlevel.h"
24 #define PERL_REVISION 5
25 #define PERL_VERSION PATCHLEVEL
26 #define PERL_SUBVERSION SUBVERSION
27 #endif
28
29 #if PERL_REVISION == 5 && (PERL_VERSION < 4 || (PERL_VERSION == 4 && PERL_SUBVERSION <= 75 ))
30
31 # define PL_sv_undef sv_undef
32 # define PL_na na
33 # define PL_curcop curcop
34 # define PL_compiling compiling
35
36 #endif
37
38
39 #define SPERRNO "Spread::sperrno"
40 #define SELECT_TIMEOUT 3
41 #define ARGS_INSUFF 2
42 static char *my_e_errmsg[] = {
43 "Select Timed Out", /* SELECT_TIMEOUT 3 */
44 "Insufficient Arguments", /* ARGS_INSUFF 2 */
45 "Accept Session", /* ACCEPT_SESSION 1 */
46 "" , /* 0 */
47 "Illegal Spread", /* ILLEGAL_SPREAD -1 */
48 "Could Not Connect", /* COULD_NOT_CONNECT -2 */
49 "Reject: Quota", /* REJECT_QUOTA -3 */
50 "Reject: No Name", /* REJECT_NO_NAME -4 */
51 "Reject: Illegal Name",/* REJECT_ILLEGAL_NAME -5 */
52 "Reject: Not Unique", /* REJECT_NOT_UNIQUE -6 */
53 "Reject: Version", /* REJECT_VERSION -7 */
54 "Connection Closed", /* CONNECTION_CLOSED -8 */
55 "" , /* -9 */
56 "" , /* -10 */
57 "Illegal Session", /* ILLEGAL_SESSION -11 */
58 "Illegal Service", /* ILLEGAL_SERVICE -12 */
59 "Illegal Message", /* ILLEGAL_MESSAGE -13 */
60 "Illegal Group", /* ILLEGAL_GROUP -14 */
61 "Buffer Too Short", /* BUFFER_TOO_SHORT -15 */
62 #ifdef GROUP_TOO_SHORT
63 "Groups Too Short", /* GROUPS_TOO_SHORT -16 */
64 #endif
65 #ifdef MESSAGE_TOO_LONG
66 "Message Too Long", /* MESSAGE_TOO_LONG -17 */
67 #else
68 #error You must install spread 3.17.0 client libraries to build perl Spread.
69 #endif
70 ""};
71 static char *connect_params[] = {
72 "spread_name",
73 "private_name",
74 "priority",
75 "group_membership",
76 ""};
77 static int nconnect_params = 4;
78
79 SV *sv_NULL ;
80
81 static int
not_here(s)82 not_here(s)
83 char *s;
84 {
85 croak("%s not implemented on this architecture", s);
86 return -1;
87 }
88
89 static double
constant(name,arg)90 constant(name, arg)
91 char *name;
92 int arg;
93 {
94 errno = 0;
95 switch (*name) {
96 case 'A':
97 if (strEQ(name, "ACCEPT_SESSION"))
98 #ifdef ACCEPT_SESSION
99 return ACCEPT_SESSION;
100 #else
101 goto not_there;
102 #endif
103 if (strEQ(name, "AGREED_MESS"))
104 #ifdef AGREED_MESS
105 return AGREED_MESS;
106 #else
107 goto not_there;
108 #endif
109 break;
110 case 'B':
111 if (strEQ(name, "BUFFER_TOO_SHORT"))
112 #ifdef BUFFER_TOO_SHORT
113 return BUFFER_TOO_SHORT;
114 #else
115 goto not_there;
116 #endif
117 break;
118 case 'C':
119 if (strEQ(name, "CAUSAL_MESS"))
120 #ifdef CAUSAL_MESS
121 return CAUSAL_MESS;
122 #else
123 goto not_there;
124 #endif
125 if (strEQ(name, "CAUSED_BY_DISCONNECT"))
126 #ifdef CAUSED_BY_DISCONNECT
127 return CAUSED_BY_DISCONNECT;
128 #else
129 goto not_there;
130 #endif
131 if (strEQ(name, "CAUSED_BY_JOIN"))
132 #ifdef CAUSED_BY_JOIN
133 return CAUSED_BY_JOIN;
134 #else
135 goto not_there;
136 #endif
137 if (strEQ(name, "CAUSED_BY_LEAVE"))
138 #ifdef CAUSED_BY_LEAVE
139 return CAUSED_BY_LEAVE;
140 #else
141 goto not_there;
142 #endif
143 if (strEQ(name, "CAUSED_BY_NETWORK"))
144 #ifdef CAUSED_BY_NETWORK
145 return CAUSED_BY_NETWORK;
146 #else
147 goto not_there;
148 #endif
149 if (strEQ(name, "CONNECTION_CLOSED"))
150 #ifdef CONNECTION_CLOSED
151 return CONNECTION_CLOSED;
152 #else
153 goto not_there;
154 #endif
155 if (strEQ(name, "COULD_NOT_CONNECT"))
156 #ifdef COULD_NOT_CONNECT
157 return COULD_NOT_CONNECT;
158 #else
159 goto not_there;
160 #endif
161 break;
162 case 'D':
163 if (strEQ(name, "DROP_RECV"))
164 #ifdef DROP_RECV
165 return DROP_RECV;
166 #else
167 goto not_there;
168 #endif
169 break;
170 case 'E':
171 break;
172 case 'F':
173 if (strEQ(name, "FIFO_MESS"))
174 #ifdef FIFO_MESS
175 return FIFO_MESS;
176 #else
177 goto not_there;
178 #endif
179 break;
180 case 'G':
181 if (strEQ(name, "GROUPS_TOO_SHORT"))
182 #ifdef GROUPS_TOO_SHORT
183 return GROUPS_TOO_SHORT;
184 #else
185 goto not_there;
186 #endif
187 break;
188 case 'H':
189 if (strEQ(name, "HIGH_PRIORITY"))
190 #ifdef HIGH_PRIORITY
191 return HIGH_PRIORITY;
192 #else
193 goto not_there;
194 #endif
195 break;
196 case 'I':
197 if (strEQ(name, "ILLEGAL_GROUP"))
198 #ifdef ILLEGAL_GROUP
199 return ILLEGAL_GROUP;
200 #else
201 goto not_there;
202 #endif
203 if (strEQ(name, "ILLEGAL_MESSAGE"))
204 #ifdef ILLEGAL_MESSAGE
205 return ILLEGAL_MESSAGE;
206 #else
207 goto not_there;
208 #endif
209 if (strEQ(name, "ILLEGAL_SERVICE"))
210 #ifdef ILLEGAL_SERVICE
211 return ILLEGAL_SERVICE;
212 #else
213 goto not_there;
214 #endif
215 if (strEQ(name, "ILLEGAL_SESSION"))
216 #ifdef ILLEGAL_SESSION
217 return ILLEGAL_SESSION;
218 #else
219 goto not_there;
220 #endif
221 if (strEQ(name, "ILLEGAL_SPREAD"))
222 #ifdef ILLEGAL_SPREAD
223 return ILLEGAL_SPREAD;
224 #else
225 goto not_there;
226 #endif
227 break;
228 case 'J':
229 break;
230 case 'K':
231 break;
232 case 'L':
233 if (strEQ(name, "LOW_PRIORITY"))
234 #ifdef LOW_PRIORITY
235 return LOW_PRIORITY;
236 #else
237 goto not_there;
238 #endif
239 break;
240 case 'M':
241 if (strEQ(name, "MAX_SCATTER_ELEMENTS"))
242 #ifdef MAX_SCATTER_ELEMENTS
243 return MAX_SCATTER_ELEMENTS;
244 #else
245 goto not_there;
246 #endif
247 if (strEQ(name, "MEDIUM_PRIORITY"))
248 #ifdef MEDIUM_PRIORITY
249 return MEDIUM_PRIORITY;
250 #else
251 goto not_there;
252 #endif
253 if (strEQ(name, "MEMBERSHIP_MESS"))
254 #ifdef MEMBERSHIP_MESS
255 return MEMBERSHIP_MESS;
256 #else
257 goto not_there;
258 #endif
259 if (strEQ(name, "MESSAGE_TOO_LONG"))
260 #ifdef MESSAGE_TOO_LONG
261 return MESSAGE_TOO_LONG;
262 #else
263 goto not_there;
264 #endif
265 break;
266 case 'N':
267 break;
268 case 'O':
269 break;
270 case 'P':
271 break;
272 case 'Q':
273 break;
274 case 'R':
275 if (strEQ(name, "REGULAR_MESS"))
276 #ifdef REGULAR_MESS
277 return REGULAR_MESS;
278 #else
279 goto not_there;
280 #endif
281 if (strEQ(name, "REG_MEMB_MESS"))
282 #ifdef REG_MEMB_MESS
283 return REG_MEMB_MESS;
284 #else
285 goto not_there;
286 #endif
287 if (strEQ(name, "REJECT_ILLEGAL_NAME"))
288 #ifdef REJECT_ILLEGAL_NAME
289 return REJECT_ILLEGAL_NAME;
290 #else
291 goto not_there;
292 #endif
293 if (strEQ(name, "REJECT_NOT_UNIQUE"))
294 #ifdef REJECT_NOT_UNIQUE
295 return REJECT_NOT_UNIQUE;
296 #else
297 goto not_there;
298 #endif
299 if (strEQ(name, "REJECT_NO_NAME"))
300 #ifdef REJECT_NO_NAME
301 return REJECT_NO_NAME;
302 #else
303 goto not_there;
304 #endif
305 if (strEQ(name, "REJECT_QUOTA"))
306 #ifdef REJECT_QUOTA
307 return REJECT_QUOTA;
308 #else
309 goto not_there;
310 #endif
311 if (strEQ(name, "REJECT_VERSION"))
312 #ifdef REJECT_VERSION
313 return REJECT_VERSION;
314 #else
315 goto not_there;
316 #endif
317 if (strEQ(name, "RELIABLE_MESS"))
318 #ifdef RELIABLE_MESS
319 return RELIABLE_MESS;
320 #else
321 goto not_there;
322 #endif
323 break;
324 case 'S':
325 if (strEQ(name, "SAFE_MESS"))
326 #ifdef SAFE_MESS
327 return SAFE_MESS;
328 #else
329 goto not_there;
330 #endif
331 if (strEQ(name, "SELF_DISCARD"))
332 #ifdef SELF_DISCARD
333 return SELF_DISCARD;
334 #else
335 goto not_there;
336 #endif
337 break;
338 case 'T':
339 if (strEQ(name, "TRANSITION_MESS"))
340 #ifdef TRANSITION_MESS
341 return TRANSITION_MESS;
342 #else
343 goto not_there;
344 #endif
345 break;
346 case 'U':
347 if (strEQ(name, "UNRELIABLE_MESS"))
348 #ifdef UNRELIABLE_MESS
349 return UNRELIABLE_MESS;
350 #else
351 goto not_there;
352 #endif
353 break;
354 case 'V':
355 break;
356 case 'W':
357 break;
358 case 'X':
359 break;
360 case 'Y':
361 break;
362 case 'Z':
363 break;
364 case 'a':
365 break;
366 case 'b':
367 break;
368 case 'c':
369 break;
370 case 'd':
371 break;
372 case 'e':
373 break;
374 case 'f':
375 break;
376 case 'g':
377 break;
378 case 'h':
379 break;
380 case 'i':
381 break;
382 case 'j':
383 break;
384 case 'k':
385 break;
386 case 'l':
387 break;
388 case 'm':
389 break;
390 case 'n':
391 break;
392 case 'o':
393 break;
394 case 'p':
395 break;
396 case 'q':
397 break;
398 case 'r':
399 break;
400 case 's':
401 break;
402 case 't':
403 break;
404 case 'u':
405 break;
406 case 'v':
407 break;
408 case 'w':
409 break;
410 case 'x':
411 break;
412 case 'y':
413 break;
414 case 'z':
415 break;
416 }
417 errno = EINVAL;
418 return 0;
419
420 not_there:
421 errno = ENOENT;
422 return 0;
423 }
424
425 static void
SetSpErrorNo(error_no)426 SetSpErrorNo(error_no)
427 int error_no ;
428 {
429 char * errstr ;
430 SV * sperror_sv = perl_get_sv(SPERRNO, FALSE);
431
432 errstr = (char *) my_e_errmsg[3 - error_no];
433 if (SvIV(sperror_sv) != error_no) {
434 sv_setiv(sperror_sv, error_no) ;
435 sv_setpv(sperror_sv, errstr) ;
436 SvIOK_on(sperror_sv) ;
437 }
438 }
439 static char *
SPversionstr()440 SPversionstr() {
441 static char version_string[60];
442 int major, minor, patch;
443 if(SP_version(&major, &minor, &patch) > 0) {
444 sprintf(version_string, "%d.%d.%d", major, minor, patch);
445 } else {
446 sprintf(version_string, "SP_version failed, could not retrieve version.");
447 }
448 return version_string;
449 }
450
451 MODULE = Spread PACKAGE = Spread PREFIX = GC_
452
453 REQUIRE: 1.9505
454 PROTOTYPES: DISABLE
455
456 BOOT:
457 /* Check version of Spread == 3.11 */
458 {
459 int major, minor, patch;
460 if(SP_version(&major, &minor, &patch) <= 0 ||
461 major<3 || (major==3 && minor<15) ||
462 (major==3 && minor==15 && patch<1))
463 croak(SPversionstr()) ;
464
465 {
466 SV * sperror_sv = perl_get_sv(SPERRNO, GV_ADDMULTI) ;
467 sv_setiv(sperror_sv, 0) ;
468 sv_setpv(sperror_sv, "") ;
469 SvIOK_on(sperror_sv) ;
470 }
471 }
472 sv_NULL = newSVpv("", 0) ;
473
474 double
constant(name,arg)475 constant(name,arg)
476 char * name
477 int arg
478
479 #define GC_version() SPversionstr()
480 char *
481 GC_version()
482
483 SV *
484 GC_disconnect(svmbox)
485 SV * svmbox
486 CODE:
487 {
488 int mbox = SvIV(svmbox);
489 if((mbox = SP_disconnect(mbox))==0)
490 RETVAL = &PL_sv_yes;
491 else {
492 SetSpErrorNo(mbox);
493 RETVAL = &PL_sv_no;
494 }
495 }
496 OUTPUT:
497 RETVAL
498
499 AV *
500 GC_connect_i(rv)
501 SV * rv
502 PREINIT:
503 SV *MAILBOX, *PRIVATE_GROUP;
504 SV **afetch;
505 int i, error, pr, gm;
506 mailbox mbox = -1;
507 char *sn, *pn, pg[MAX_GROUP_NAME];
508 HV *hv;
509 PPCODE:
510 MAILBOX = PRIVATE_GROUP = &PL_sv_undef;
511 if(!SvROK(rv) || SvTYPE(hv = (HV *)SvRV(rv))!=SVt_PVHV)
512 croak("not a HASH reference");
513 for(i=0;i<nconnect_params;i++)
514 if(hv_exists(hv, connect_params[i],
515 strlen(connect_params[i])) == FALSE) {
516 SetSpErrorNo(ARGS_INSUFF);
517 goto ending;
518 }
519 i=0;
520 afetch = hv_fetch(hv, connect_params[i],
521 strlen(connect_params[i]), FALSE); i++;
522 sn = SvPV(*afetch, PL_na);
523 afetch = hv_fetch(hv, connect_params[i],
524 strlen(connect_params[i]), FALSE); i++;
525 pn = SvPV(*afetch, PL_na);
526 afetch = hv_fetch(hv, connect_params[i],
527 strlen(connect_params[i]), FALSE); i++;
528 pr = SvIV(*afetch);
529 afetch = hv_fetch(hv, connect_params[i],
530 strlen(connect_params[i]), FALSE); i++;
531 gm = SvIV(*afetch);
532 if((error = SP_connect(sn,pn,pr,gm,&mbox,pg))>0 && mbox>0) {
533 MAILBOX = sv_2mortal(newSViv(mbox));
534 PRIVATE_GROUP = sv_2mortal(newSVpv(pg, 0));
535 } else {
536 SetSpErrorNo(error);
537 }
538 ending:
539 EXTEND(SP, 2);
540 PUSHs(MAILBOX);
541 PUSHs(PRIVATE_GROUP);
542
543 SV *
GC_join(svmbox,group_name)544 GC_join(svmbox, group_name)
545 SV * svmbox
546 char *group_name
547 CODE:
548 {
549 int mbox = SvIV(svmbox);
550 if((mbox = SP_join(mbox, group_name))==0) {
551 RETVAL = &PL_sv_yes;
552 } else {
553 SetSpErrorNo(mbox);
554 RETVAL = &PL_sv_no;
555 }
556 }
557 OUTPUT:
558 RETVAL
559
560 SV *
GC_leave(svmbox,group_name)561 GC_leave(svmbox, group_name)
562 SV * svmbox
563 char *group_name
564 CODE:
565 {
566 int mbox = SvIV(svmbox);
567 if((mbox = SP_leave(mbox, group_name))==0) {
568 RETVAL = &PL_sv_yes;
569 } else {
570 SetSpErrorNo(mbox);
571 RETVAL = &PL_sv_no;
572 }
573 }
574 OUTPUT:
575 RETVAL
576
577 SV *
578 GC_multicast(svmbox, stype, svgroups, mtype, mess)
579 SV * svmbox
580 service stype
581 SV * svgroups
582 int16 mtype
583 SV * mess
584 INIT:
585 static char *groupnames=NULL;
586 static int gsize=-1;
587 CODE:
588 {
589 int mbox = SvIV(svmbox);
590 int mlength, i, ret, ngroups=0;
591 char *groupname;
592 char *message;
593 /* It is OK to use NULL.. We only see this, it isn't returned */
594 AV * groups = (AV *)NULL;
595 SV * group = (SV *)NULL;
596 RETVAL = &PL_sv_undef;
597 if(SvROK(svgroups)) {
598 if(SvTYPE(groups = (AV *)SvRV(svgroups))==SVt_PVAV) {
599 ngroups = av_len(groups)+1;
600 if(gsize<ngroups) {
601 if(gsize<0) gsize=1;
602 while(gsize<ngroups) gsize<<=1;
603 if(!groupnames)
604 New(0, groupnames,gsize*MAX_GROUP_NAME,char);
605 else
606 Renew(groupnames,gsize*MAX_GROUP_NAME,char);
607 }
608 for(i=0;i<ngroups;i++) {
609 char *string;
610 int slength;
611 SV **afetch = av_fetch(groups, i, FALSE);
612 string = SvPV(*afetch, slength);
613 strncpy(&groupnames[i*MAX_GROUP_NAME],
614 string,
615 MIN(MAX_GROUP_NAME,slength));
616 }
617 } else if(SvTYPE(group = SvRV(svgroups))==SVt_PV) {
618 groupname = SvPV(group, PL_na);
619 } else {
620 croak("not a SCALAR or ARRAY reference.");
621 }
622 } else if(groupname=SvPV(svgroups, PL_na)) {
623 group = svgroups;
624 } else {
625 SetSpErrorNo(ARGS_INSUFF);
626 goto multi_ending;
627 }
628
629 message = SvPV(mess, mlength);
630 if(group != NULL) {
631 /* groupname is already set and
632 we are multicasting to a single group */
633 ret = SP_multicast(mbox, stype, groupname,
634 mtype, mlength, message);
635 } else if(groups != NULL) {
636 /* groupnames is already set and
637 we are multicasting to a multigroup */
638 ret = SP_multigroup_multicast(mbox, stype, ngroups,
639 groupnames,
640 mtype, mlength, message);
641 } else {
642 /* Something went horrbily wrong */
643 croak("not SCALAR, SCALAR ref or ARRAY ref.");
644 }
645 if(ret<0)
646 SetSpErrorNo(ret);
647 else
648 RETVAL = newSViv(ret);
649 }
650 multi_ending:
651 OUTPUT:
652 RETVAL
653
654 AV *
655 GC_receive(svmbox, svtimeout=&PL_sv_undef)
656 SV * svmbox
657 SV * svtimeout
658 PREINIT:
659 static int oldgsize=0, newgsize=(1<<6);
660 static int oldmsize=0, newmsize=(1<<15); /* 65k */
661 int i, mbox, endmis, ret, ngrps, msize;
662 int16 mtype;
663 service stype;
664 struct timeval towait;
665 static char *groups=NULL;
666 static char *mess=NULL;
667 char sender[MAX_GROUP_NAME];
668 SV *STYPE, *MTYPE, *MESSAGE, *SENDER, *ENDMIS, *ERROR;
669 AV *GROUPS=(AV *)&PL_sv_undef;
670 PPCODE:
671 if(svmbox == &PL_sv_undef) {
672 STYPE=SENDER=MTYPE=ENDMIS=MESSAGE=&PL_sv_undef;
673 SetSpErrorNo(ILLEGAL_SESSION);
674 goto rec_ending;
675 }
676 mbox = SvIV(svmbox);
677 ERROR=&PL_sv_undef;
678 if(svtimeout != &PL_sv_undef) {
679 double timeout;
680 fd_set readfs;
681 towait.tv_sec = 0L;
682 towait.tv_usec = 0L;
683 timeout = SvNV(svtimeout);
684 towait.tv_sec = (unsigned long)timeout;
685 towait.tv_usec =
686 (unsigned long)(1000000.0*(timeout-(double)towait.tv_sec));
687 FD_ZERO(&readfs); FD_SET(mbox, &readfs);
688 if((ret = select(mbox+1, &readfs, NULL, &readfs, &towait))!=1) {
689 STYPE=SENDER=MTYPE=ENDMIS=MESSAGE=&PL_sv_undef;
690 SetSpErrorNo(SELECT_TIMEOUT);
691 goto rec_ending;
692 }
693 }
694 try_again:
695 /* realloc or alloc buffer if necessary */
696 if(oldgsize != newgsize) {
697 if(groups)
698 Renew(groups, newgsize*MAX_GROUP_NAME, char);
699 else
700 New(0, groups, newgsize*MAX_GROUP_NAME, char);
701 oldgsize=newgsize;
702 }
703 if(oldmsize != newmsize) {
704 if(mess)
705 Renew(mess, newmsize, char);
706 else
707 New(0, mess, newmsize, char);
708 oldmsize=newmsize;
709 }
710 if((ret=SP_receive(mbox, &stype, sender, newgsize, &ngrps, groups,
711 &mtype, &endmis, newmsize, mess))<0) {
712 if(ret==BUFFER_TOO_SHORT) {
713 /* Lets double it, so this won't happen again */
714 newmsize=-endmis;
715 ERROR = newSViv(BUFFER_TOO_SHORT);
716 msize = oldmsize;
717 goto try_again;
718 #ifdef GROUPS_TOO_SHORT
719 } else if (ret==GROUPS_TOO_SHORT) {
720 newgsize=--ngrps;
721 ERROR = newSViv(GROUPS_TOO_SHORT);
722 ngrps = oldgsize;
723 goto try_again;
724 #endif
725 } else {
726 STYPE=SENDER=MTYPE=ENDMIS=MESSAGE=&PL_sv_undef;
727 SetSpErrorNo(ret);
728 }
729 } else {
730 msize=ret;
731 still_okay:
732 /* We recieved the message */
733 if(newgsize+ngrps < 0)
734 newgsize*=2;
735 if(ngrps<0) ngrps=oldgsize;
736 if(ngrps>0) {
737 GROUPS = (AV *)sv_2mortal((SV *)newAV());
738 for(i=0;i<ngrps;i++)
739 av_push(GROUPS, newSVpv(&groups[i*MAX_GROUP_NAME],
740 MIN(strlen(&groups[i*MAX_GROUP_NAME]),
741 MAX_GROUP_NAME)));
742 }
743 SENDER=sv_2mortal(newSVpv(sender, 0));
744 STYPE=sv_2mortal(newSViv(stype));
745 MTYPE=sv_2mortal(newSViv(mtype));
746 ENDMIS=(endmis)?(&PL_sv_yes):(&PL_sv_no);
747 MESSAGE=sv_2mortal(newSVpv(mess, msize));
748 }
749 rec_ending:
750 EXTEND(SP, 6);
751 PUSHs(STYPE);
752 PUSHs(SENDER);
753 PUSHs(sv_2mortal(newRV((SV *)GROUPS)));
754 PUSHs(MTYPE);
755 PUSHs(ENDMIS);
756 PUSHs(MESSAGE);
757
758 SV *
759 GC_poll(svmbox)
760 SV * svmbox
761 PREINIT:
762 int mbox = SvIV(svmbox);
763 CODE:
764 mbox = SP_poll(mbox);
765 if(mbox<0) {
766 SetSpErrorNo(mbox);
767 RETVAL = &PL_sv_undef;
768 } else {
769 RETVAL = newSViv(mbox);
770 }
771 OUTPUT:
772 RETVAL
773