PROTOTYPES: ENABLE
void
-import(...)
+import(package="ByteLoader", ...)
+ char *package
PREINIT:
SV *sv = newSVpvn ("", 0);
PPCODE:
filter_add(byteloader_filter, sv);
void
-unimport(...)
+unimport(package="ByteLoader", ...)
+ char *package
PPCODE:
filter_del(byteloader_filter);
*/
+#define PERL_NO_GET_CONTEXT
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#endif
+/* avoid -Wall; DB_File xsubs never make use of `ix' setup for ALIASes */
+#undef dXSI32
+#define dXSI32 dNOOP
+
/* If Perl has been compiled with Threads support,the symbol op will
be defined here. This clashes with a field name in db.h, so get rid of it.
*/
OUTPUT:
RETVAL
-int
+void
db_FETCH(db, key, flags=0)
DB_File db
DBTKEY key
u_int flags
+ PREINIT:
+ int RETVAL;
CODE:
{
DBT value ;
CurrentDB = db ;
-int
+void
db_FIRSTKEY(db)
DB_File db
+ PREINIT:
+ int RETVAL;
CODE:
{
DBTKEY key ;
OutputKey(ST(0), key) ;
}
-int
+void
db_NEXTKEY(db, key)
DB_File db
DBTKEY key
+ PREINIT:
+ int RETVAL;
CODE:
{
DBT value ;
OUTPUT:
RETVAL
-I32
+void
pop(db)
DB_File db
ALIAS: POP = 1
+ PREINIT:
+ I32 RETVAL;
CODE:
{
DBTKEY key ;
}
}
-I32
+void
shift(db)
DB_File db
ALIAS: SHIFT = 1
+ PREINIT:
+ I32 RETVAL;
CODE:
{
DBT value ;
*/
+#define PERL_NO_GET_CONTEXT
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
XS(XS_DB_sub)
{
- dXSARGS;
+ dMARK;
dORIGMARK;
SV *Sub = GvSV(PL_DBsub); /* name of current sub */
(void)dl_private_init(aTHX);
-void *
+void
dl_load_file(filename, flags=0)
char * filename
int flags
PREINIT:
int mode = RTLD_LAZY;
+ void *handle;
CODE:
{
#if defined(DLOPEN_WONT_DO_RELATIVE_PATHS)
Perl_warn(aTHX_ "Can't make loaded symbols global on this platform while loading %s",filename);
#endif
DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,flags));
- RETVAL = dlopen(filename, mode) ;
- DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%lx\n", (unsigned long) RETVAL));
+ handle = dlopen(filename, mode) ;
+ DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%lx\n", (unsigned long) handle));
ST(0) = sv_newmortal() ;
- if (RETVAL == NULL)
+ if (handle == NULL)
SaveError(aTHX_ "%s",dlerror()) ;
else
- sv_setiv( ST(0), PTR2IV(RETVAL));
+ sv_setiv( ST(0), PTR2IV(handle));
}
RETVAL
-void *
+void
dl_find_symbol(libhandle, symbolname)
void * libhandle
char * symbolname
+ PREINIT:
+ void *sym;
CODE:
#ifdef DLSYM_NEEDS_UNDERSCORE
symbolname = Perl_form_nocontext("_%s", symbolname);
DLDEBUG(2, PerlIO_printf(Perl_debug_log,
"dl_find_symbol(handle=%lx, symbol=%s)\n",
(unsigned long) libhandle, symbolname));
- RETVAL = dlsym(libhandle, symbolname);
+ sym = dlsym(libhandle, symbolname);
DLDEBUG(2, PerlIO_printf(Perl_debug_log,
- " symbolref = %lx\n", (unsigned long) RETVAL));
+ " symbolref = %lx\n", (unsigned long) sym));
ST(0) = sv_newmortal() ;
- if (RETVAL == NULL)
+ if (sym == NULL)
SaveError(aTHX_ "%s",dlerror()) ;
else
- sv_setiv( ST(0), PTR2IV(RETVAL));
+ sv_setiv( ST(0), PTR2IV(sym));
void
dl_undef_symbols()
- PPCODE:
+ CODE:
#define DLDEBUG(level,code)
#endif
-
+#ifdef DL_UNLOAD_ALL_AT_EXIT
/* Close all dlopen'd files */
static void
dl_unload_all_files(pTHXo_ void *unused)
}
}
}
-
+#endif
static void
dl_generic_private_init(pTHXo) /* called by dl_*.xs dl_private_init() */
+#define PERL_NO_GET_CONTEXT
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include "Symbols.h"
#define UNIMPLEMENTED(x,y) y x (SV *sv, char *encoding) { \
+ dTHX; \
Perl_croak(aTHX_ "panic_unimplemented"); \
return (y)0; /* fool picky compilers */ \
}
SV *
PerlIOEncode_getarg(PerlIO *f)
{
+ dTHX;
PerlIOEncode *e = PerlIOSelf(f,PerlIOEncode);
SV *sv = &PL_sv_undef;
if (e->enc)
PUSHMARK(sp);
XPUSHs(e->enc);
PUTBACK;
- if (perl_call_method("name",G_SCALAR) == 1)
+ if (call_method("name",G_SCALAR) == 1)
{
SPAGAIN;
sv = newSVsv(POPs);
PUSHMARK(sp);
XPUSHs(arg);
PUTBACK;
- if (perl_call_pv("Encode::find_encoding",G_SCALAR) != 1)
+ if (call_pv("Encode::find_encoding",G_SCALAR) != 1)
{
/* should never happen */
Perl_die(aTHX_ "Encode::find_encoding did not return a value");
XPUSHs(e->bufsv);
XPUSHs(&PL_sv_yes);
PUTBACK;
- if (perl_call_method("decode",G_SCALAR) != 1)
+ if (call_method("decode",G_SCALAR) != 1)
code = -1;
SPAGAIN;
uni = POPs;
XPUSHs(e->bufsv);
XPUSHs(&PL_sv_yes);
PUTBACK;
- if (perl_call_method("encode",G_SCALAR) != 1)
+ if (call_method("encode",G_SCALAR) != 1)
code = -1;
SPAGAIN;
str = POPs;
* colon specially, so it looks for files beginning "C:" in
* the current directory. To fix this, change the pattern to
* add an explicit "./" at the start (just after the drive
- * letter and colon - ie change to "C:./*").
+ * letter and colon - ie change to "C:./").
*/
if (isalpha(pattern[0]) && pattern[1] == ':' &&
pattern[2] != BG_SEP && pattern[2] != BG_SEP2 &&
*
*/
+#define PERL_NO_GET_CONTEXT
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
void
-unimport(...)
+unimport(package="$Package", ...)
+ char *package
PPCODE:
filter_del(filter_call);
errno = EINVAL;
return 0;
+ if (0) {
+ goto not_there; /* -Wall */
+ }
+
not_there:
errno = ENOENT;
return 0;
croak("weak references are not implemented in this release of perl");
#endif
-SV *
+void
isweak(sv)
SV *sv
PROTOTYPE: $
if (PL_dowarn) warn("Premature padding of base64 data");
break;
}
- /* printf("c0=%d,c1=%d,c2=%d,c3=%d\n", c[0],c[1],c[2],c[3]);/**/
+ /* printf("c0=%d,c1=%d,c2=%d,c3=%d\n", c[0],c[1],c[2],c[3]);*/
*r++ = (c[0] << 2) | ((c[1] & 0x30) >> 4);
errno = EINVAL;
return 0;
+ if (0) {
+ not_here(""); /* -Wall */
+ }
+
not_there:
errno = ENOENT;
return 0;
ttyname(fd)
int fd
-char *
+#XXX: use sv_getcwd()
+void
getcwd()
PPCODE:
#ifdef HAS_GETCWD
IV
PerlIOScalar_close(PerlIO *f)
{
- dTHX;
IV code = PerlIOBase_close(f);
PerlIOBase(f)->flags &= ~(PERLIO_F_RDBUF|PERLIO_F_WRBUF);
return code;
PerlIOVia *s = PerlIOSelf(f,PerlIOVia);
if (s->var)
{
- dTHX;
STDCHAR *p = (STDCHAR *)(SvEND(s->var) - s->cnt);
return p;
}
uinterval = finterval * 1000000;
RETVAL = ualarm (useconds, uinterval);
+ OUTPUT:
+ RETVAL
+
#endif
#ifdef HAS_GETTIMEOFDAY
int wday
int yday
int isdst
+
+ PREINIT:
+ char *buf = NULL;
+
CODE:
- {
- char *buf = my_strftime(fmt, sec, min, hour, mday, mon, year, wday, yday, isdst);
- if (buf) {
- ST(0) = sv_2mortal(newSVpv(buf, 0));
- Safefree(buf);
- }
- }
+ #XXX: an sv_strftime() that can make use of the TARG would faster
+ buf = my_strftime(fmt, sec, min, hour, mday, mon, year, wday, yday, isdst);
+ if (buf) {
+ RETVAL = buf;
+ }
+
+ OUTPUT:
+ RETVAL
+
+ CLEANUP:
+ if (buf) {
+ Safefree(buf);
+ }
MODULE = attrs PACKAGE = attrs
void
-import(Class, ...)
-char * Class
+import(...)
ALIAS:
unimport = 1
PREINIT:
int i;
CV *cv;
PPCODE:
+ if (items < 1)
+ Perl_croak(aTHX_ "Usage: %s(Class, ...)", GvNAME(CvGV(cv)));
if (!PL_compcv || !(cv = CvOUTSIDE(PL_compcv)))
croak("can't set attributes outside a subroutine scope");
if (ckWARN(WARN_DEPRECATED))
int
Perl_fprintf_nocontext(PerlIO *stream, const char *format, ...)
{
- dTHX;
va_list(arglist);
va_start(arglist, format);
return PerlIO_vprintf(stream, format, arglist);
int
Perl_printf_nocontext(const char *format, ...)
{
- dTHX;
va_list(arglist);
va_start(arglist, format);
return PerlIO_vprintf(PerlIO_stdout(), format, arglist);
# Perl_croak(aTHX_ "Usage: $pname($report_args)");
EOF
+ #-Wall: if an xsub has no arguments and PPCODE is used
+ #none of ST, XSRETURN or XSprePUSH macros are used
+ #hence `ax' (setup by dXSARGS) is unused
+ print Q<<"EOF" if $PPCODE and $num_args == 0;
+# if (0) ax = ax; /* -Wall */
+EOF
+
print Q<<"EOF" if $PPCODE;
# SP -= items;
EOF
print Q<<"EOF";
#[[
# dXSARGS;
+EOF
+
+#-Wall: if there is no $Full_func_name there are no xsubs in this .xs
+#so `file' is unused
+print Q<<"EOF" if $Full_func_name;
# char* file = __FILE__;
-#
EOF
+print Q "#\n";
+
print Q<<"EOF" if $WantVersionChk ;
# XS_VERSION_BOOTCHECK ;
#
projects / p5sagit/p5-mst-13.2.git / commitdiff