#define PERL_constant_NOTFOUND 1
#define PERL_constant_NOTDEF 2
#define PERL_constant_ISIV 3
-#define PERL_constant_ISNV 4
-#define PERL_constant_ISPV 5
-#define PERL_constant_ISPVN 6
-#define PERL_constant_ISUV 7
-
-#ifndef NVTYPE
-typedef double NV; /* 5.6 and later define NVTYPE, and typedef NV to it. */
-#endif
-
-static int
-constant_5 (const char *name, IV *iv_return) {
- /* Names all of length 5. */
- /* When generated this function returned values for the list of names given
- here. However, subsequent manual editing may have added or removed some.
- AF_NS PF_NS */
- /* Offset 0 gives the best switch position. */
- switch (name[0]) {
- case 'A':
- if (memEQ(name, "AF_NS", 5)) {
- /* ^ */
-#ifdef AF_NS
- *iv_return = AF_NS;
- return PERL_constant_ISIV;
-#else
- return PERL_constant_NOTDEF;
-#endif
- }
- break;
- case 'P':
- if (memEQ(name, "PF_NS", 5)) {
- /* ^ */
-#ifdef PF_NS
- *iv_return = PF_NS;
- return PERL_constant_ISIV;
-#else
- return PERL_constant_NOTDEF;
-#endif
- }
- break;
- }
- return PERL_constant_NOTFOUND;
-}
+#define PERL_constant_ISNO 4
+#define PERL_constant_ISNV 5
+#define PERL_constant_ISPV 6
+#define PERL_constant_ISPVN 7
+#define PERL_constant_ISSV 8
+#define PERL_constant_ISUNDEF 9
+#define PERL_constant_ISUV 10
+#define PERL_constant_ISYES 11
static int
-constant_6 (const char *name, IV *iv_return) {
- /* Names all of length 6. */
+constant_6 (const char *name, IV *iv_return, SV **sv_return) {
/* When generated this function returned values for the list of names given
here. However, subsequent manual editing may have added or removed some.
AF_802 AF_DLI AF_LAT AF_MAX AF_NBS AF_NIT AF_OSI AF_PUP AF_SNA AF_X25
}
static int
-constant_7 (const char *name, IV *iv_return) {
- /* Names all of length 7. */
+constant_7 (const char *name, IV *iv_return, SV **sv_return) {
/* When generated this function returned values for the list of names given
here. However, subsequent manual editing may have added or removed some.
AF_ECMA AF_INET AF_UNIX IOV_MAX MSG_EOF MSG_EOR MSG_FIN MSG_OOB MSG_RST
break;
case 'O':
if (memEQ(name, "MSG_OOB", 7)) {
- /* ^ */
+ /* ^ */
#if defined(MSG_OOB) || defined(HAS_MSG_OOB) /* might be an enum */
*iv_return = MSG_OOB;
return PERL_constant_ISIV;
}
static int
-constant_8 (const char *name, IV *iv_return) {
- /* Names all of length 8. */
+constant_8 (const char *name, IV *iv_return, SV **sv_return) {
/* When generated this function returned values for the list of names given
here. However, subsequent manual editing may have added or removed some.
AF_CCITT AF_CHAOS AF_GOSIP MSG_PEEK PF_CCITT PF_CHAOS PF_GOSIP SOCK_RAW
}
static int
-constant_9 (const char *name, IV *iv_return) {
- /* Names all of length 9. */
+constant_9 (const char *name, IV *iv_return, SV **sv_return) {
/* When generated this function returned values for the list of names given
here. However, subsequent manual editing may have added or removed some.
AF_DECnet AF_HYLINK AF_OSINET AF_UNSPEC MSG_BCAST MSG_MCAST MSG_PROXY
}
static int
-constant_10 (const char *name, IV *iv_return) {
- /* Names all of length 10. */
+constant_10 (const char *name, IV *iv_return, SV **sv_return) {
/* When generated this function returned values for the list of names given
here. However, subsequent manual editing may have added or removed some.
- AF_DATAKIT AF_IMPLINK MSG_CTRUNC PF_DATAKIT PF_IMPLINK SCM_RIGHTS
- SOCK_DGRAM SOL_SOCKET TCP_MAXSEG TCP_STDURG UIO_MAXIOV */
+ AF_DATAKIT AF_IMPLINK INADDR_ANY MSG_CTRUNC PF_DATAKIT PF_IMPLINK
+ SCM_RIGHTS SOCK_DGRAM SOL_SOCKET TCP_MAXSEG TCP_STDURG UIO_MAXIOV */
/* Offset 6 gives the best switch position. */
switch (name[6]) {
case 'A':
#endif
}
break;
+ case '_':
+ if (memEQ(name, "INADDR_ANY", 10)) {
+ /* ^ */
+#ifdef INADDR_ANY
+ {
+struct in_addr ip_address; ip_address.s_addr = htonl(INADDR_ANY);
+ *sv_return = sv_2mortal(newSVpvn((char *)&ip_address,sizeof ip_address ));
+ return PERL_constant_ISSV;
+ }
+#else
+ return PERL_constant_NOTDEF;
+#endif
+ }
+ break;
}
return PERL_constant_NOTFOUND;
}
static int
-constant_11 (const char *name, IV *iv_return) {
- /* Names all of length 11. */
+constant_11 (const char *name, IV *iv_return, SV **sv_return) {
/* When generated this function returned values for the list of names given
here. However, subsequent manual editing may have added or removed some.
- IPPROTO_TCP MSG_WAITALL SCM_CONNECT SOCK_STREAM SO_RCVLOWAT SO_RCVTIMEO
- SO_SNDLOWAT SO_SNDTIMEO TCP_NODELAY */
- /* Offset 7 gives the best switch position. */
- switch (name[7]) {
- case 'E':
- if (memEQ(name, "TCP_NODELAY", 11)) {
- /* ^ */
-#ifdef TCP_NODELAY
- *iv_return = TCP_NODELAY;
+ INADDR_NONE IPPROTO_TCP MSG_WAITALL SCM_CONNECT SOCK_STREAM SO_RCVLOWAT
+ SO_RCVTIMEO SO_SNDLOWAT SO_SNDTIMEO TCP_NODELAY */
+ /* Offset 5 gives the best switch position. */
+ switch (name[5]) {
+ case 'A':
+ if (memEQ(name, "MSG_WAITALL", 11)) {
+ /* ^ */
+#ifdef MSG_WAITALL
+ *iv_return = MSG_WAITALL;
return PERL_constant_ISIV;
#else
return PERL_constant_NOTDEF;
#endif
}
break;
- case 'I':
- if (memEQ(name, "SO_RCVTIMEO", 11)) {
- /* ^ */
-#ifdef SO_RCVTIMEO
- *iv_return = SO_RCVTIMEO;
+ case 'D':
+ if (memEQ(name, "SO_SNDLOWAT", 11)) {
+ /* ^ */
+#ifdef SO_SNDLOWAT
+ *iv_return = SO_SNDLOWAT;
return PERL_constant_ISIV;
#else
return PERL_constant_NOTDEF;
#endif
}
if (memEQ(name, "SO_SNDTIMEO", 11)) {
- /* ^ */
+ /* ^ */
#ifdef SO_SNDTIMEO
*iv_return = SO_SNDTIMEO;
return PERL_constant_ISIV;
#endif
}
break;
- case 'N':
+ case 'O':
if (memEQ(name, "SCM_CONNECT", 11)) {
- /* ^ */
+ /* ^ */
#ifdef SCM_CONNECT
*iv_return = SCM_CONNECT;
return PERL_constant_ISIV;
return PERL_constant_NOTDEF;
#endif
}
- break;
- case 'O':
- if (memEQ(name, "SO_RCVLOWAT", 11)) {
- /* ^ */
-#ifdef SO_RCVLOWAT
- *iv_return = SO_RCVLOWAT;
+ if (memEQ(name, "TCP_NODELAY", 11)) {
+ /* ^ */
+#ifdef TCP_NODELAY
+ *iv_return = TCP_NODELAY;
return PERL_constant_ISIV;
#else
return PERL_constant_NOTDEF;
#endif
}
- if (memEQ(name, "SO_SNDLOWAT", 11)) {
- /* ^ */
-#ifdef SO_SNDLOWAT
- *iv_return = SO_SNDLOWAT;
- return PERL_constant_ISIV;
+ break;
+ case 'R':
+ if (memEQ(name, "INADDR_NONE", 11)) {
+ /* ^ */
+#ifdef INADDR_NONE
+ {
+struct in_addr ip_address; ip_address.s_addr = htonl(INADDR_NONE);
+ *sv_return = sv_2mortal(newSVpvn((char *)&ip_address,sizeof ip_address ));
+ return PERL_constant_ISSV;
+ }
#else
return PERL_constant_NOTDEF;
#endif
}
break;
- case 'R':
+ case 'S':
if (memEQ(name, "SOCK_STREAM", 11)) {
- /* ^ */
+ /* ^ */
#ifdef SOCK_STREAM
*iv_return = SOCK_STREAM;
return PERL_constant_ISIV;
}
break;
case 'T':
- if (memEQ(name, "MSG_WAITALL", 11)) {
- /* ^ */
-#ifdef MSG_WAITALL
- *iv_return = MSG_WAITALL;
+ if (memEQ(name, "IPPROTO_TCP", 11)) {
+ /* ^ */
+#ifdef IPPROTO_TCP
+ *iv_return = IPPROTO_TCP;
return PERL_constant_ISIV;
#else
return PERL_constant_NOTDEF;
#endif
}
break;
- case '_':
- if (memEQ(name, "IPPROTO_TCP", 11)) {
- /* ^ */
-#ifdef IPPROTO_TCP
- *iv_return = IPPROTO_TCP;
+ case 'V':
+ if (memEQ(name, "SO_RCVLOWAT", 11)) {
+ /* ^ */
+#ifdef SO_RCVLOWAT
+ *iv_return = SO_RCVLOWAT;
+ return PERL_constant_ISIV;
+#else
+ return PERL_constant_NOTDEF;
+#endif
+ }
+ if (memEQ(name, "SO_RCVTIMEO", 11)) {
+ /* ^ */
+#ifdef SO_RCVTIMEO
+ *iv_return = SO_RCVTIMEO;
return PERL_constant_ISIV;
#else
return PERL_constant_NOTDEF;
}
static int
-constant_12 (const char *name, IV *iv_return) {
- /* Names all of length 12. */
+constant_12 (const char *name, IV *iv_return, SV **sv_return) {
/* When generated this function returned values for the list of names given
here. However, subsequent manual editing may have added or removed some.
AF_APPLETALK MSG_CTLFLAGS MSG_DONTWAIT MSG_ERRQUEUE MSG_NOSIGNAL
}
static int
-constant_13 (const char *name, IV *iv_return) {
- /* Names all of length 13. */
+constant_13 (const char *name, IV *iv_return, SV **sv_return) {
/* When generated this function returned values for the list of names given
here. However, subsequent manual editing may have added or removed some.
MSG_CTLIGNORE MSG_DONTROUTE MSG_MAXIOVLEN SCM_TIMESTAMP SO_ACCEPTCONN
}
static int
-constant_14 (const char *name, IV *iv_return) {
- /* Names all of length 14. */
- /* When generated this function returned values for the list of names given
- here. However, subsequent manual editing may have added or removed some.
- SOCK_SEQPACKET SO_USELOOPBACK */
- /* Offset 8 gives the best switch position. */
- switch (name[8]) {
- case 'O':
- if (memEQ(name, "SO_USELOOPBACK", 14)) {
- /* ^ */
-#ifdef SO_USELOOPBACK
- *iv_return = SO_USELOOPBACK;
- return PERL_constant_ISIV;
-#else
- return PERL_constant_NOTDEF;
-#endif
- }
- break;
- case 'P':
- if (memEQ(name, "SOCK_SEQPACKET", 14)) {
- /* ^ */
-#ifdef SOCK_SEQPACKET
- *iv_return = SOCK_SEQPACKET;
- return PERL_constant_ISIV;
-#else
- return PERL_constant_NOTDEF;
-#endif
- }
- break;
- }
- return PERL_constant_NOTFOUND;
-}
-
-static int
-constant (const char *name, STRLEN len, IV *iv_return) {
+constant (const char *name, STRLEN len, IV *iv_return, SV **sv_return) {
/* Initially switch on the length of the name. */
/* When generated this function returned values for the list of names given
in this section of perl code. Rather than manually editing these functions
Regenerate these constant functions by feeding this entire source file to
perl -x
-#!perl -w
+#!../../perl -w
use ExtUtils::Constant qw (constant_types C_constant XS_constant);
-my $types = {IV => 1};
+my $types = {map {($_, 1)} qw(IV SV)};
my @names = (qw(AF_802 AF_APPLETALK AF_CCITT AF_CHAOS AF_DATAKIT AF_DECnet
AF_DLI AF_ECMA AF_GOSIP AF_HYLINK AF_IMPLINK AF_INET AF_LAT
AF_MAX AF_NBS AF_NIT AF_NS AF_OSI AF_OSINET AF_PUP AF_SNA
AF_UNIX AF_UNSPEC AF_X25 IOV_MAX IPPROTO_TCP MSG_BCAST
MSG_CTLFLAGS MSG_CTLIGNORE MSG_DONTWAIT MSG_EOF MSG_EOR
MSG_ERRQUEUE MSG_FIN MSG_MAXIOVLEN MSG_MCAST MSG_NOSIGNAL
- MSG_RST MSG_SYN MSG_TRUNC MSG_WAITALL PF_802 PF_APPLETALK
- PF_CCITT PF_CHAOS PF_DATAKIT PF_DECnet PF_DLI PF_ECMA PF_GOSIP
- PF_HYLINK PF_IMPLINK PF_INET PF_LAT PF_MAX PF_NBS PF_NIT PF_NS
- PF_OSI PF_OSINET PF_PUP PF_SNA PF_UNIX PF_UNSPEC PF_X25
- SCM_CONNECT SCM_CREDENTIALS SCM_CREDS SCM_TIMESTAMP SOCK_DGRAM
- SOCK_RAW SOCK_RDM SOCK_SEQPACKET SOCK_STREAM SOL_SOCKET
- SOMAXCONN SO_ACCEPTCONN SO_BROADCAST SO_DEBUG SO_DONTLINGER
- SO_DONTROUTE SO_ERROR SO_KEEPALIVE SO_LINGER SO_OOBINLINE
- SO_RCVBUF SO_RCVLOWAT SO_RCVTIMEO SO_REUSEADDR SO_REUSEPORT
- SO_SNDBUF SO_SNDLOWAT SO_SNDTIMEO SO_TYPE SO_USELOOPBACK
- TCP_KEEPALIVE TCP_MAXRT TCP_MAXSEG TCP_NODELAY TCP_STDURG
- UIO_MAXIOV MSG_URG),
+ MSG_RST MSG_SYN MSG_TRUNC MSG_URG MSG_WAITALL PF_802
+ PF_APPLETALK PF_CCITT PF_CHAOS PF_DATAKIT PF_DECnet PF_DLI
+ PF_ECMA PF_GOSIP PF_HYLINK PF_IMPLINK PF_INET PF_LAT PF_MAX
+ PF_NBS PF_NIT PF_NS PF_OSI PF_OSINET PF_PUP PF_SNA PF_UNIX
+ PF_UNSPEC PF_X25 SCM_CONNECT SCM_CREDENTIALS SCM_CREDS
+ SCM_TIMESTAMP SOCK_DGRAM SOCK_RAW SOCK_RDM SOCK_SEQPACKET
+ SOCK_STREAM SOL_SOCKET SOMAXCONN SO_ACCEPTCONN SO_BROADCAST
+ SO_DEBUG SO_DONTLINGER SO_DONTROUTE SO_ERROR SO_KEEPALIVE
+ SO_LINGER SO_OOBINLINE SO_RCVBUF SO_RCVLOWAT SO_RCVTIMEO
+ SO_REUSEADDR SO_REUSEPORT SO_SNDBUF SO_SNDLOWAT SO_SNDTIMEO
+ SO_TYPE SO_USELOOPBACK TCP_KEEPALIVE TCP_MAXRT TCP_MAXSEG
+ TCP_NODELAY TCP_STDURG UIO_MAXIOV),
+ {name=>"INADDR_ANY", type=>"SV", value=>"sv_2mortal(newSVpvn((char *)&ip_address,sizeof ip_address ))", pre=>"struct in_addr ip_address; ip_address.s_addr = htonl(INADDR_ANY);"},
+ {name=>"INADDR_BROADCAST", type=>"SV", value=>"sv_2mortal(newSVpvn((char *)&ip_address,sizeof ip_address ))", pre=>"struct in_addr ip_address; ip_address.s_addr = htonl(INADDR_BROADCAST);"},
+ {name=>"INADDR_LOOPBACK", type=>"SV", value=>"sv_2mortal(newSVpvn((char *)&ip_address,sizeof ip_address ))", pre=>"struct in_addr ip_address; ip_address.s_addr = htonl(INADDR_LOOPBACK);"},
+ {name=>"INADDR_NONE", type=>"SV", value=>"sv_2mortal(newSVpvn((char *)&ip_address,sizeof ip_address ))", pre=>"struct in_addr ip_address; ip_address.s_addr = htonl(INADDR_NONE);"},
{name=>"MSG_CTRUNC", type=>"IV", macro=>["#if defined(MSG_CTRUNC) || defined(HAS_MSG_CTRUNC) /" . "* might be an enum *" . "/\n", "#endif\n"]},
{name=>"MSG_DONTROUTE", type=>"IV", macro=>["#if defined(MSG_DONTROUTE) || defined(HAS_MSG_DONTROUTE) /" . "* might be an enum *" . "/\n", "#endif\n"]},
{name=>"MSG_OOB", type=>"IV", macro=>["#if defined(MSG_OOB) || defined(HAS_MSG_OOB) /" . "* might be an enum *" . "/\n", "#endif\n"]},
{name=>"SHUT_WR", type=>"IV", default=>["IV", "1"]});
print constant_types(); # macro defs
-foreach (C_constant ("Socket", 'constant', 'IV', $types, undef, undef, @names) ) {
+foreach (C_constant ("Socket", 'constant', 'IV', $types, undef, 3, @names) ) {
print $_, "\n"; # C constant subs
}
print "#### XS Section:\n";
switch (len) {
case 5:
- return constant_5 (name, iv_return);
+ /* Names all of length 5. */
+ /* AF_NS PF_NS */
+ /* Offset 0 gives the best switch position. */
+ switch (name[0]) {
+ case 'A':
+ if (memEQ(name, "AF_NS", 5)) {
+ /* ^ */
+#ifdef AF_NS
+ *iv_return = AF_NS;
+ return PERL_constant_ISIV;
+#else
+ return PERL_constant_NOTDEF;
+#endif
+ }
+ break;
+ case 'P':
+ if (memEQ(name, "PF_NS", 5)) {
+ /* ^ */
+#ifdef PF_NS
+ *iv_return = PF_NS;
+ return PERL_constant_ISIV;
+#else
+ return PERL_constant_NOTDEF;
+#endif
+ }
+ break;
+ }
break;
case 6:
- return constant_6 (name, iv_return);
+ return constant_6 (name, iv_return, sv_return);
break;
case 7:
- return constant_7 (name, iv_return);
+ return constant_7 (name, iv_return, sv_return);
break;
case 8:
- return constant_8 (name, iv_return);
+ return constant_8 (name, iv_return, sv_return);
break;
case 9:
- return constant_9 (name, iv_return);
+ return constant_9 (name, iv_return, sv_return);
break;
case 10:
- return constant_10 (name, iv_return);
+ return constant_10 (name, iv_return, sv_return);
break;
case 11:
- return constant_11 (name, iv_return);
+ return constant_11 (name, iv_return, sv_return);
break;
case 12:
- return constant_12 (name, iv_return);
+ return constant_12 (name, iv_return, sv_return);
break;
case 13:
- return constant_13 (name, iv_return);
+ return constant_13 (name, iv_return, sv_return);
break;
case 14:
- return constant_14 (name, iv_return);
+ /* Names all of length 14. */
+ /* SOCK_SEQPACKET SO_USELOOPBACK */
+ /* Offset 8 gives the best switch position. */
+ switch (name[8]) {
+ case 'O':
+ if (memEQ(name, "SO_USELOOPBACK", 14)) {
+ /* ^ */
+#ifdef SO_USELOOPBACK
+ *iv_return = SO_USELOOPBACK;
+ return PERL_constant_ISIV;
+#else
+ return PERL_constant_NOTDEF;
+#endif
+ }
+ break;
+ case 'P':
+ if (memEQ(name, "SOCK_SEQPACKET", 14)) {
+ /* ^ */
+#ifdef SOCK_SEQPACKET
+ *iv_return = SOCK_SEQPACKET;
+ return PERL_constant_ISIV;
+#else
+ return PERL_constant_NOTDEF;
+#endif
+ }
+ break;
+ }
break;
case 15:
- if (memEQ(name, "SCM_CREDENTIALS", 15)) {
+ /* Names all of length 15. */
+ /* INADDR_LOOPBACK SCM_CREDENTIALS */
+ /* Offset 4 gives the best switch position. */
+ switch (name[4]) {
+ case 'C':
+ if (memEQ(name, "SCM_CREDENTIALS", 15)) {
+ /* ^ */
#ifdef SCM_CREDENTIALS
- *iv_return = SCM_CREDENTIALS;
- return PERL_constant_ISIV;
+ *iv_return = SCM_CREDENTIALS;
+ return PERL_constant_ISIV;
+#else
+ return PERL_constant_NOTDEF;
+#endif
+ }
+ break;
+ case 'D':
+ if (memEQ(name, "INADDR_LOOPBACK", 15)) {
+ /* ^ */
+#ifdef INADDR_LOOPBACK
+ {
+struct in_addr ip_address; ip_address.s_addr = htonl(INADDR_LOOPBACK);
+ *sv_return = sv_2mortal(newSVpvn((char *)&ip_address,sizeof ip_address ));
+ return PERL_constant_ISSV;
+ }
+#else
+ return PERL_constant_NOTDEF;
+#endif
+ }
+ break;
+ }
+ break;
+ case 16:
+ if (memEQ(name, "INADDR_BROADCAST", 16)) {
+#ifdef INADDR_BROADCAST
+ {
+struct in_addr ip_address; ip_address.s_addr = htonl(INADDR_BROADCAST);
+ *sv_return = sv_2mortal(newSVpvn((char *)&ip_address,sizeof ip_address ));
+ return PERL_constant_ISSV;
+ }
#else
return PERL_constant_NOTDEF;
#endif
void
constant(sv)
PREINIT:
-#ifdef dXSTARG
- dXSTARG; /* Faster if we have it. */
-#else
- dTARGET;
-#endif
+ dXSTARG;
STRLEN len;
int type;
IV iv;
PPCODE:
/* Change this to constant(s, len, &iv, &nv);
if you need to return both NVs and IVs */
- type = constant(s, len, &iv);
+ type = constant(s, len, &iv, &sv);
/* Return 1 or 2 items. First is error message, or undef if no error.
Second, if present, is found value */
switch (type) {
PUSHs(&PL_sv_undef);
PUSHi(iv);
break;
+ case PERL_constant_ISSV:
+ EXTEND(SP, 1);
+ PUSHs(&PL_sv_undef);
+ PUSHs(sv);
+ break;
/* Uncomment this if you need to return UVs
case PERL_constant_ISUV:
EXTEND(SP, 1);
break; */
default:
sv = sv_2mortal(newSVpvf(
- "Unexpected return type %d while processing Socket macro %s used",
+ "Unexpected return type %d while processing Socket macro %s, used",
type, s));
PUSHs(sv);
}
PUSHs(sv_2mortal(newSViv((IV) port)));
PUSHs(sv_2mortal(newSVpvn((char *)&ip_address,sizeof ip_address)));
}
-
-void
-INADDR_ANY()
- CODE:
- {
- struct in_addr ip_address;
- ip_address.s_addr = htonl(INADDR_ANY);
- ST(0) = sv_2mortal(newSVpvn((char *)&ip_address,sizeof ip_address ));
- }
-
-void
-INADDR_LOOPBACK()
- CODE:
- {
- struct in_addr ip_address;
- ip_address.s_addr = htonl(INADDR_LOOPBACK);
- ST(0) = sv_2mortal(newSVpvn((char *)&ip_address,sizeof ip_address));
- }
-
-void
-INADDR_NONE()
- CODE:
- {
- struct in_addr ip_address;
- ip_address.s_addr = htonl(INADDR_NONE);
- ST(0) = sv_2mortal(newSVpvn((char *)&ip_address,sizeof ip_address));
- }
-
-void
-INADDR_BROADCAST()
- CODE:
- {
- struct in_addr ip_address;
- ip_address.s_addr = htonl(INADDR_BROADCAST);
- ST(0) = sv_2mortal(newSVpvn((char *)&ip_address,sizeof ip_address));
- }
package ExtUtils::Constant;
use vars qw (@ISA $VERSION %XS_Constant %XS_TypeSet @EXPORT_OK %EXPORT_TAGS);
-$VERSION = '0.05';
+$VERSION = '0.06';
=head1 NAME
A fixed length thing, given as a [pointer, length] pair. If you know the
length of a string at compile time you may use this instead of I<PV>
+=item PVN
+
+A B<mortal> SV.
+
=item YES
Truth. (C<PL_sv_yes>) The value is not needed (and ignored).
@EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
%XS_Constant = (
- IV => 'PUSHi(iv)',
- UV => 'PUSHu((UV)iv)',
- NV => 'PUSHn(nv)',
- PV => 'PUSHp(pv, strlen(pv))',
- PVN => 'PUSHp(pv, iv)',
- YES => 'PUSHs(&PL_sv_yes)',
- NO => 'PUSHs(&PL_sv_no)',
+ IV => 'PUSHi(iv)',
+ UV => 'PUSHu((UV)iv)',
+ NV => 'PUSHn(nv)',
+ PV => 'PUSHp(pv, strlen(pv))',
+ PVN => 'PUSHp(pv, iv)',
+ SV => 'PUSHs(sv)',
+ YES => 'PUSHs(&PL_sv_yes)',
+ NO => 'PUSHs(&PL_sv_no)',
UNDEF => '', # implicit undef
);
%XS_TypeSet = (
- IV => '*iv_return =',
- UV => '*iv_return = (IV)',
- NV => '*nv_return =',
- PV => '*pv_return =',
- PVN => ['*pv_return =', '*iv_return = (IV)'],
+ IV => '*iv_return =',
+ UV => '*iv_return = (IV)',
+ NV => '*nv_return =',
+ PV => '*pv_return =',
+ PVN => ['*pv_return =', '*iv_return = (IV)'],
+ SV => '*sv_return = ',
YES => undef,
NO => undef,
UNDEF => undef,
return $body;
}
-=item assign INDENT, TYPE, VALUE...
+=item assign INDENT, TYPE, PRE, POST, VALUE...
A function to return a suitable assignment clause. If I<TYPE> is aggregate
(eg I<PVN> expects both pointer and length) then there should be multiple
-I<VALUE>s for the components.
+I<VALUE>s for the components. I<PRE> and I<POST> if defined give snippets
+of C code to preceed and follow the assignment. I<PRE> will be at the start
+of a block, so variables may be defined in it.
=cut
sub assign {
my $indent = shift;
my $type = shift;
+ my $pre = shift;
+ my $post = shift || '';
my $clause;
+ my $close;
+ if ($pre) {
+ chomp $pre;
+ $clause = $indent . "{\n$pre";
+ $clause .= ";" unless $pre =~ /;$/;
+ $clause .= "\n";
+ $close = "$indent}\n";
+ $indent .= " ";
+ }
die "Can't generate code for type $type" unless exists $XS_TypeSet{$type};
my $typeset = $XS_TypeSet{$type};
if (ref $typeset) {
if @_ > 1;
$clause .= $indent . "$typeset $_[0];\n";
}
+ chomp $post;
+ if (length $post) {
+ $clause .= "$post";
+ $clause .= ";" unless $post =~ /;$/;
+ $clause .= "\n";
+ }
$clause .= "${indent}return PERL_constant_IS$type;\n";
+ $clause .= $close if $close;
return $clause;
}
-=item return_clause VALUE, TYPE, INDENT, MACRO, DEFAULT
+=item return_clause VALUE, TYPE, INDENT, MACRO, DEFAULT, PRE, POST, PRE, POST
A function to return a suitable C<#ifdef> clause. I<MACRO> defaults to
I<VALUE> when not defined. If I<TYPE> is aggregate (eg I<PVN> expects both
this function with I<MACRO> defined, defaulting to the constant's name.
I<DEFAULT> if defined is an array reference giving default type and and
value(s) if the clause generated by I<MACRO> doesn't evaluate to true.
+The two pairs I<PRE> and I<POST> if defined give C code snippets to proceed
+and follow the value, and the default value.
=cut
-sub return_clause ($$$$$) {
+sub return_clause ($$$$$$$$$) {
##ifdef thingy
# *iv_return = thingy;
# return PERL_constant_ISIV;
##else
# return PERL_constant_NOTDEF;
##endif
- my ($value, $type, $indent, $macro, $default) = @_;
+ my ($value, $type, $indent, $macro, $default, $pre, $post,
+ $def_pre, $def_post) = @_;
$macro = $value unless defined $macro;
$indent = ' ' x ($indent || 6);
# *iv_return = thingy;
# return PERL_constant_ISIV;
- $clause .= assign ($indent, $type, ref $value ? @$value : $value);
+ $clause .= assign ($indent, $type, $pre, $post,
+ ref $value ? @$value : $value);
##else
$clause .= "#else\n";
if (!defined $default) {
$clause .= "${indent}return PERL_constant_NOTDEF;\n";
} else {
- $clause .= assign ($indent, ref $default ? @$default : $default);
+ my @default = ref $default ? @$default : $default;
+ $type = shift @default;
+ $clause .= assign ($indent, $type, $def_pre, $def_post, @default);
}
##endif
$body .= $indent . "case '" . C_stringify ($char) . "':\n";
foreach my $name (sort @{$best->{$char}}) {
my $thisone = $items->{$name};
- my ($value, $macro, $default) = @$thisone{qw (value macro default)};
+ my ($value, $macro, $default, $pre, $post, $def_pre, $def_post)
+ = @$thisone{qw (value macro default pre post def_pre def_post)};
$value = $name unless defined $value;
$macro = $name unless defined $macro;
# We have checked this offset.
$body .= memEQ_clause ($name, $offset, 2 + length $indent);
$body .= return_clause ($value, $thisone->{type}, 4 + length $indent,
- $macro, $default);
+ $macro, $default, $pre, $post,
+ $def_pre, $def_post);
$body .= $indent . " }\n";
}
$body .= $indent . " break;\n";
my $use_iv = $what->{IV} || $what->{UV} || $what->{PVN};
my $use_nv = $what->{NV};
my $use_pv = $what->{PV} || $what->{PVN};
- return ($use_iv, $use_nv, $use_pv);
+ my $use_sv = $what->{SV};
+ return ($use_iv, $use_nv, $use_pv, $use_sv);
}
=item dump_names
my $type = $_->{type} || $default_type;
if ($type eq $default_type and 0 == ($_->{name} =~ tr/A-Za-z0-9_//c)
and !defined ($_->{macro}) and !defined ($_->{value})
- and !defined ($_->{default})) {
+ and !defined ($_->{default}) and !defined ($_->{pre})
+ and !defined ($_->{post}) and !defined ($_->{def_pre})
+ and !defined ($_->{def_post})) {
# It's the default type, and the name consists only of A-Za-z0-9_
push @simple, $_->{name};
} else {
if (@complex) {
foreach my $item (sort {$a->{name} cmp $b->{name}} @complex) {
my $name = C_stringify $item->{name};
- my ($macro, $value, $default) = @$item{qw (macro value default)};
my $line = ",\n {name=>\"$name\"";
$line .= ", type=>\"$item->{type}\"" if defined $item->{type};
- if (defined $macro) {
- if (ref $macro) {
- $line .= ', macro=>["'. join ('", "', map {C_stringify $_} @$macro)
- . '"]';
- } else {
- $line .= ", macro=>\"" . C_stringify($macro) . "\"";
- }
- }
- if (defined $value) {
- if (ref $value) {
- $line .= ', value=>["'. join ('", "', map {C_stringify $_} @$value)
- . '"]';
- } else {
- $line .= ", value=>\"" . C_stringify($value) . "\"";
- }
- }
- if (defined $default) {
- if (ref $default) {
- $line .= ', default=>["'. join ('", "', map {C_stringify $_}
- @$default)
- . '"]';
- } else {
- $line .= ", default=>\"" . C_stringify($default) . "\"";
+ foreach my $thing (qw (macro value default pre post def_pre def_post)) {
+ my $value = $item->{$thing};
+ if (defined $value) {
+ if (ref $value) {
+ $line .= ", $thing=>[\""
+ . join ('", "', map {C_stringify $_} @$value) . '"]';
+ } else {
+ $line .= ", $thing=>\"" . C_stringify($value) . "\"";
+ }
}
}
$line .= "}";
defined...") to return if the macro isn't defined. Specify a reference to
an array with type followed by value(s).
+=item pre
+
+C code to use before the assignment of the value of the constant. This allows
+you to use temporary variables to extract a value from part of a C<struct>
+and return this as I<value>. This C code is places at the start of a block,
+so you can declare variables in it.
+
+=item post
+
+C code to place between the assignment of value (to a temporary) and the
+return from the function. This allows you to clear up anything in I<pre>.
+Rarely needed.
+
+=item def_pre
+=item def_post
+
+Equivalents of I<pre> and I<post> for the default value.
+
=back
I<PACKAGE> is the name of the package, and is only used in comments inside the
foreach (@items) {
my $name;
if (ref $_) {
+ my $orig = $_;
# Make a copy which is a normalised version of the ref passed in.
$name = $_->{name};
- my ($type, $macro, $value, $default) = @$_{qw (type macro value default)};
+ my ($type, $macro, $value) = @$_{qw (type macro value)};
$type ||= $default_type;
$what->{$type} = 1;
$_ = {name=>$name, type=>$type};
$_->{macro} = $macro if defined $macro;
undef $value if defined $value and $value eq $name;
$_->{value} = $value if defined $value;
- $_->{default} = $default if defined $default;
+ foreach my $key (qw(default pre post def_pre def_post)) {
+ my $value = $orig->{$key};
+ $_->{$key} = $value if defined $value;
+ # warn "$key $value";
+ }
} else {
$name = $_;
$_ = {name=>$_, type=>$default_type};
}
$items{$name} = $_;
}
- my ($use_iv, $use_nv, $use_pv) = params ($what);
+ my ($use_iv, $use_nv, $use_pv, $use_sv) = params ($what);
my ($body, @subs) = "static int\n$subname (const char *name";
$body .= ", STRLEN len" unless defined $namelen;
$body .= ", IV *iv_return" if $use_iv;
$body .= ", NV *nv_return" if $use_nv;
$body .= ", const char **pv_return" if $use_pv;
+ $body .= ", SV **sv_return" if $use_sv;
$body .= ") {\n";
if (defined $namelen) {
$body .= " case $i:\n";
if (@{$by_length[$i]} == 1) {
my $thisone = $by_length[$i]->[0];
- my ($name, $value, $macro, $default)
- = @$thisone{qw (name value macro default)};
+ my ($name, $value, $macro, $default, $pre, $post, $def_pre, $def_post)
+ = @$thisone{qw (name value macro default pre post def_pre def_post)};
$value = $name unless defined $value;
$macro = $name unless defined $macro;
$body .= memEQ_clause ($name);
$body .= return_clause ($value, $thisone->{type}, undef, $macro,
- $default);
+ $default, $pre, $post, $def_pre, $def_post);
$body .= " }\n";
} elsif (@{$by_length[$i]} < $breakout) {
$body .= switch_clause (4, '', $i, \%items, @{$by_length[$i]});
$body .= ", iv_return" if $use_iv;
$body .= ", nv_return" if $use_nv;
$body .= ", pv_return" if $use_pv;
+ $body .= ", sv_return" if $use_sv;
$body .= ");\n";
}
$body .= " break;\n";
# Convert line of the form IV,UV,NV to hash
$what = {map {$_ => 1} split /,\s*/, ($what)};
}
- my ($use_iv, $use_nv, $use_pv) = params ($what);
+ my ($use_iv, $use_nv, $use_pv, $use_sv) = params ($what);
my $type;
my $xs = <<"EOT";
$xs .= ', &iv' if $use_iv;
$xs .= ', &nv' if $use_nv;
$xs .= ', &pv' if $use_pv;
+ $xs .= ', &sv' if $use_sv;
$xs .= ");\n";
$xs .= << "EOT";
projects / p5sagit/p5-mst-13.2.git / commitdiff