diff options
Diffstat (limited to 'ext')
31 files changed, 519 insertions, 176 deletions
diff --git a/ext/B/B.pm b/ext/B/B.pm index e4730cd9c9..2187e59a72 100644 --- a/ext/B/B.pm +++ b/ext/B/B.pm @@ -107,6 +107,11 @@ sub timing_info { } my %symtable; + +sub clearsym { + %symtable = (); +} + sub savesym { my ($obj, $value) = @_; # warn(sprintf("savesym: sym_%x => %s\n", $$obj, $value)); # debug diff --git a/ext/B/B.xs b/ext/B/B.xs index ad3d00842d..2d6145da66 100644 --- a/ext/B/B.xs +++ b/ext/B/B.xs @@ -202,7 +202,7 @@ make_sv_object(pTHX_ SV *arg, SV *sv) } if (!type) { type = svclassnames[SvTYPE(sv)]; - iv = (IV)PTR_CAST sv; + iv = PTR2IV(sv); } sv_setiv(newSVrv(arg, type), iv); return arg; @@ -211,7 +211,7 @@ make_sv_object(pTHX_ SV *arg, SV *sv) static SV * make_mg_object(pTHX_ SV *arg, MAGIC *mg) { - sv_setiv(newSVrv(arg, "B::MAGIC"), (IV)PTR_CAST mg); + sv_setiv(newSVrv(arg, "B::MAGIC"), PTR2IV(mg)); return arg; } @@ -317,7 +317,7 @@ walkoptree(pTHX_ SV *opsv, char *method) if (!SvROK(opsv)) croak("opsv is not a reference"); opsv = sv_mortalcopy(opsv); - o = (OP*)PTR_CAST SvIV((SV*)SvRV(opsv)); + o = INT2PTR(OP*,SvIV((SV*)SvRV(opsv))); if (walkoptree_debug) { PUSHMARK(sp); XPUSHs(opsv); @@ -332,7 +332,7 @@ walkoptree(pTHX_ SV *opsv, char *method) OP *kid; for (kid = ((UNOP*)o)->op_first; kid; kid = kid->op_sibling) { /* Use the same opsv. Rely on methods not to mess it up. */ - sv_setiv(newSVrv(opsv, cc_opclassname(aTHX_ kid)), (IV)PTR_CAST kid); + sv_setiv(newSVrv(opsv, cc_opclassname(aTHX_ kid)), PTR2IV(kid)); walkoptree(aTHX_ opsv, method); } } @@ -437,7 +437,7 @@ walkoptree_debug(...) OUTPUT: RETVAL -#define address(sv) (IV)PTR_CAST sv +#define address(sv) PTR2IV(sv) IV address(sv) @@ -647,10 +647,10 @@ PMOP_pmreplroot(o) if (o->op_type == OP_PUSHRE) { sv_setiv(newSVrv(ST(0), root ? svclassnames[SvTYPE((SV*)root)] : "B::SV"), - (IV)PTR_CAST root); + PTR2IV(root)); } else { - sv_setiv(newSVrv(ST(0), cc_opclassname(aTHX_ root)), (IV)PTR_CAST root); + sv_setiv(newSVrv(ST(0), cc_opclassname(aTHX_ root)), PTR2IV(root)); } B::OP @@ -1153,7 +1153,7 @@ void CvXSUB(cv) B::CV cv CODE: - ST(0) = sv_2mortal(newSViv((IV)PTR_CAST CvXSUB(cv))); + ST(0) = sv_2mortal(newSViv(PTR2IV(CvXSUB(cv)))); void diff --git a/ext/B/B/Bblock.pm b/ext/B/B/Bblock.pm index d2ef78f616..b914bc661b 100644 --- a/ext/B/B/Bblock.pm +++ b/ext/B/B/Bblock.pm @@ -129,6 +129,7 @@ sub B::PMOP::mark_if_leader { sub compile { my @options = @_; + B::clearsym(); if (@options) { return sub { my $objname; diff --git a/ext/B/B/Debug.pm b/ext/B/B/Debug.pm index 75636265e6..89100689a8 100644 --- a/ext/B/B/Debug.pm +++ b/ext/B/B/Debug.pm @@ -247,6 +247,7 @@ sub B::SPECIAL::debug { sub compile { my $order = shift; + B::clearsym(); if ($order eq "exec") { return sub { walkoptree_exec(main_start, "debug") } } else { diff --git a/ext/B/B/Terse.pm b/ext/B/B/Terse.pm index 93757f34ce..35bf9b8d0d 100644 --- a/ext/B/B/Terse.pm +++ b/ext/B/B/Terse.pm @@ -17,6 +17,7 @@ sub terse { sub compile { my $order = shift; my @options = @_; + B::clearsym(); if (@options) { return sub { my $objname; diff --git a/ext/B/Makefile.PL b/ext/B/Makefile.PL index 9af85c9a62..dcff65a50b 100644 --- a/ext/B/Makefile.PL +++ b/ext/B/Makefile.PL @@ -16,7 +16,8 @@ if ($^O eq 'MSWin32') { WriteMakefile( NAME => "B", VERSION => "a5", - MAN3PODS => {}, + PL_FILES => { 'defsubs_h.PL' => 'defsubs.h' }, + MAN3PODS => {}, clean => { FILES => "perl$e *$o B.c defsubs.h *~" } diff --git a/ext/B/defsubs.h.PL b/ext/B/defsubs_h.PL index 2129c8c5bb..8dfa3a5fe2 100644 --- a/ext/B/defsubs.h.PL +++ b/ext/B/defsubs_h.PL @@ -4,6 +4,7 @@ #!perl my ($out) = __FILE__ =~ /(^.*)\.PL/; if ($^O eq 'VMS') { ($out) = __FILE__ =~ /^(.+)_PL$/i; } +$out =~ s/_h$/.h/; open(OUT,">$out") || die "Cannot open $file:$!"; print "Extracting $out . . .\n"; foreach my $const (qw(AVf_REAL diff --git a/ext/B/typemap b/ext/B/typemap index 5f6af0f2dc..febadf8d62 100644 --- a/ext/B/typemap +++ b/ext/B/typemap @@ -35,7 +35,7 @@ INPUT T_OP_OBJ if (SvROK($arg)) { IV tmp = SvIV((SV*)SvRV($arg)); - $var = ($type)PTR_CAST tmp; + $var = INT2PTR($type,tmp); } else croak(\"$var is not a reference\") @@ -43,7 +43,7 @@ T_OP_OBJ T_SV_OBJ if (SvROK($arg)) { IV tmp = SvIV((SV*)SvRV($arg)); - $var = ($type)PTR_CAST tmp; + $var = INT2PTR($type,tmp); } else croak(\"$var is not a reference\") @@ -51,18 +51,18 @@ T_SV_OBJ T_MG_OBJ if (SvROK($arg)) { IV tmp = SvIV((SV*)SvRV($arg)); - $var = ($type)PTR_CAST tmp; + $var = INT2PTR($type,tmp); } else croak(\"$var is not a reference\") OUTPUT T_OP_OBJ - sv_setiv(newSVrv($arg, cc_opclassname(aTHX_ (OP*)$var)), (IV)PTR_CAST $var); + sv_setiv(newSVrv($arg, cc_opclassname(aTHX_ (OP*)$var)), PTR2IV($var)); T_SV_OBJ make_sv_object(aTHX_ ($arg), (SV*)($var)); T_MG_OBJ - sv_setiv(newSVrv($arg, "B::MAGIC"), (IV)PTR_CAST $var); + sv_setiv(newSVrv($arg, "B::MAGIC"), PTR2IV($var)); diff --git a/ext/DB_File/Changes b/ext/DB_File/Changes index 6d374bf1f1..8f364564a5 100644 --- a/ext/DB_File/Changes +++ b/ext/DB_File/Changes @@ -272,3 +272,10 @@ * Added a BOOT check to test for equivalent versions of db.h & libdb.a/so. +1.71 7th September 1999 + + * Fixed a bug that prevented 1.70 from compiling under win32 + + * Updated to support Berkeley DB 3.x + + * Updated dbinfo for Berkeley DB 3.x file formats. diff --git a/ext/DB_File/DB_File.pm b/ext/DB_File/DB_File.pm index e20a5621e7..44bdad61f6 100644 --- a/ext/DB_File/DB_File.pm +++ b/ext/DB_File/DB_File.pm @@ -1,8 +1,8 @@ # DB_File.pm -- Perl 5 interface to Berkeley DB # # written by Paul Marquess (Paul.Marquess@btinternet.com) -# last modified 4th August 1999 -# version 1.70 +# last modified 4th September 1999 +# version 1.71 # # Copyright (c) 1995-1999 Paul Marquess. All rights reserved. # This program is free software; you can redistribute it and/or @@ -145,7 +145,7 @@ use vars qw($VERSION @ISA @EXPORT $AUTOLOAD $DB_BTREE $DB_HASH $DB_RECNO $db_ver use Carp; -$VERSION = "1.70" ; +$VERSION = "1.71" ; #typedef enum { DB_BTREE, DB_HASH, DB_RECNO } DBTYPE; $DB_BTREE = new DB_File::BTREEINFO ; @@ -421,10 +421,10 @@ DB_File - Perl5 access to Berkeley DB version 1.x B<DB_File> is a module which allows Perl programs to make use of the facilities provided by Berkeley DB version 1.x (if you have a newer -version of DB, see L<Using DB_File with Berkeley DB version 2>). It is -assumed that you have a copy of the Berkeley DB manual pages at hand -when reading this documentation. The interface defined here mirrors the -Berkeley DB interface closely. +version of DB, see L<Using DB_File with Berkeley DB version 2 or 3>). +It is assumed that you have a copy of the Berkeley DB manual pages at +hand when reading this documentation. The interface defined here +mirrors the Berkeley DB interface closely. Berkeley DB is a C library which provides a consistent interface to a number of database formats. B<DB_File> provides an interface to all @@ -465,32 +465,33 @@ number. =back -=head2 Using DB_File with Berkeley DB version 2 +=head2 Using DB_File with Berkeley DB version 2 or 3 Although B<DB_File> is intended to be used with Berkeley DB version 1, -it can also be used with version 2. In this case the interface is +it can also be used with version 2.or 3 In this case the interface is limited to the functionality provided by Berkeley DB 1.x. Anywhere the -version 2 interface differs, B<DB_File> arranges for it to work like -version 1. This feature allows B<DB_File> scripts that were built with -version 1 to be migrated to version 2 without any changes. +version 2 or 3 interface differs, B<DB_File> arranges for it to work +like version 1. This feature allows B<DB_File> scripts that were built +with version 1 to be migrated to version 2 or 3 without any changes. If you want to make use of the new features available in Berkeley DB -2.x, use the Perl module B<BerkeleyDB> instead. +2.x or 3.x, use the Perl module B<BerkeleyDB> instead. At the time of writing this document the B<BerkeleyDB> module is still alpha quality (the version number is < 1.0), and so unsuitable for use in any serious development work. Once its version number is >= 1.0, it is considered stable enough for real work. -B<Note:> The database file format has changed in Berkeley DB version 2. -If you cannot recreate your databases, you must dump any existing -databases with the C<db_dump185> utility that comes with Berkeley DB. -Once you have rebuilt DB_File to use Berkeley DB version 2, your +B<Note:> The database file format has changed in both Berkeley DB +version 2 and 3. If you cannot recreate your databases, you must dump +any existing databases with the C<db_dump185> utility that comes with +Berkeley DB. +Once you have rebuilt DB_File to use Berkeley DB version 2 or 3, your databases can be recreated using C<db_load>. Refer to the Berkeley DB documentation for further details. -Please read L<"COPYRIGHT"> before using version 2.x of Berkeley DB with -DB_File. +Please read L<"COPYRIGHT"> before using version 2.x or 3.x of Berkeley +DB with DB_File. =head2 Interface to Berkeley DB @@ -1940,11 +1941,12 @@ date, so the most recent version can always be found on CPAN (see L<perlmod/CPAN> for details), in the directory F<modules/by-module/DB_File>. -This version of B<DB_File> will work with either version 1.x or 2.x of -Berkeley DB, but is limited to the functionality provided by version 1. +This version of B<DB_File> will work with either version 1.x, 2.x or +3.x of Berkeley DB, but is limited to the functionality provided by +version 1. The official web site for Berkeley DB is F<http://www.sleepycat.com>. -Both versions 1 and 2 of Berkeley DB are available there. +All versions of Berkeley DB are available there. Alternatively, Berkeley DB version 1 is available at your nearest CPAN archive in F<src/misc/db.1.85.tar.gz>. diff --git a/ext/DB_File/DB_File.xs b/ext/DB_File/DB_File.xs index 2ee1e61f0f..ccb9b757fe 100644 --- a/ext/DB_File/DB_File.xs +++ b/ext/DB_File/DB_File.xs @@ -3,8 +3,8 @@ DB_File.xs -- Perl 5 interface to Berkeley DB written by Paul Marquess <Paul.Marquess@btinternet.com> - last modified 4th August 1999 - version 1.70 + last modified 7th September 1999 + version 1.71 All comments/suggestions/problems are welcome @@ -78,6 +78,9 @@ GV_ADD|GV_ADDMULT -- bug spotted by Nick Ing-Simmons. Added a BOOT check to test for equivalent versions of db.h & libdb.a/so. + 1.71 - Support for Berkeley DB version 3. + Support for Berkeley DB 2/3's backward compatability mode. + Rewrote push */ @@ -116,7 +119,12 @@ #ifdef op # undef op #endif -#include <db.h> + +#ifdef COMPAT185 +# include <db_185.h> +#else +# include <db.h> +#endif #ifndef pTHX # define pTHX @@ -134,10 +142,21 @@ /* #define TRACE */ #define DBM_FILTERING +#ifdef TRACE +# define Trace(x) printf x +#else +# define Trace(x) +#endif + +#define DBT_clear(x) Zero(&x, 1, DBT) ; #ifdef DB_VERSION_MAJOR +#if DB_VERSION_MAJOR == 2 +# define BERKELEY_DB_1_OR_2 +#endif + /* map version 2 features & constants onto their version 1 equivalent */ #ifdef DB_Prefix_t @@ -152,7 +171,11 @@ /* DBTYPE stays the same */ /* HASHINFO, RECNOINFO and BTREEINFO map to DB_INFO */ -typedef DB_INFO INFO ; +#if DB_VERSION_MAJOR == 2 + typedef DB_INFO INFO ; +#else /* DB_VERSION_MAJOR > 2 */ +# define DB_FIXEDLEN (0x8000) +#endif /* DB_VERSION_MAJOR == 2 */ /* version 2 has db_recno_t in place of recno_t */ typedef db_recno_t recno_t; @@ -166,15 +189,18 @@ typedef db_recno_t recno_t; #define R_NEXT DB_NEXT #define R_NOOVERWRITE DB_NOOVERWRITE #define R_PREV DB_PREV + #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 5 -#define R_SETCURSOR 0x800000 +# define R_SETCURSOR 0x800000 #else -#define R_SETCURSOR (-100) +# define R_SETCURSOR (-100) #endif + #define R_RECNOSYNC 0 #define R_FIXEDLEN DB_FIXEDLEN #define R_DUP DB_DUP + #define db_HA_hash h_hash #define db_HA_ffactor h_ffactor #define db_HA_nelem h_nelem @@ -209,13 +235,15 @@ typedef db_recno_t recno_t; #define DB_flags(x, v) x |= v #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 5 -#define flagSet(flags, bitmask) ((flags) & (bitmask)) +# define flagSet(flags, bitmask) ((flags) & (bitmask)) #else -#define flagSet(flags, bitmask) (((flags) & DB_OPFLAGS_MASK) == (bitmask)) +# define flagSet(flags, bitmask) (((flags) & DB_OPFLAGS_MASK) == (bitmask)) #endif #else /* db version 1.x */ +#define BERKELEY_DB_1_OR_2 + typedef union INFO { HASHINFO hash ; RECNOINFO recno ; @@ -224,17 +252,17 @@ typedef union INFO { #ifdef mDB_Prefix_t -#ifdef DB_Prefix_t -#undef DB_Prefix_t -#endif -#define DB_Prefix_t mDB_Prefix_t +# ifdef DB_Prefix_t +# undef DB_Prefix_t +# endif +# define DB_Prefix_t mDB_Prefix_t #endif #ifdef mDB_Hash_t -#ifdef DB_Hash_t -#undef DB_Hash_t -#endif -#define DB_Hash_t mDB_Hash_t +# ifdef DB_Hash_t +# undef DB_Hash_t +# endif +# define DB_Hash_t mDB_Hash_t #endif #define db_HA_hash hash.hash @@ -281,20 +309,20 @@ typedef union INFO { #ifdef DB_VERSION_MAJOR #define db_DESTROY(db) ( db->cursor->c_close(db->cursor),\ - db->dbp->close(db->dbp, 0) ) + (db->dbp->close)(db->dbp, 0) ) #define db_close(db) ((db->dbp)->close)(db->dbp, 0) #define db_del(db, key, flags) (flagSet(flags, R_CURSOR) \ ? ((db->cursor)->c_del)(db->cursor, 0) \ : ((db->dbp)->del)(db->dbp, NULL, &key, flags) ) -#else +#else /* ! DB_VERSION_MAJOR */ #define db_DESTROY(db) ((db->dbp)->close)(db->dbp) #define db_close(db) ((db->dbp)->close)(db->dbp) #define db_del(db, key, flags) ((db->dbp)->del)(db->dbp, &key, flags) #define db_put(db, key, value, flags) ((db->dbp)->put)(db->dbp, &key, &value, flags) -#endif +#endif /* ! DB_VERSION_MAJOR */ #define db_seq(db, key, value, flags) do_SEQ(db, key, value, flags) @@ -306,7 +334,9 @@ typedef struct { SV * prefix ; SV * hash ; int in_memory ; +#ifdef BERKELEY_DB_1_OR_2 INFO info ; +#endif #ifdef DB_VERSION_MAJOR DBC * cursor ; #endif @@ -439,48 +469,6 @@ u_int flags ; #endif /* DB_VERSION_MAJOR */ -static void -GetVersionInfo(pTHX) -{ - SV * version_sv = perl_get_sv("DB_File::db_version", GV_ADD|GV_ADDMULTI) ; - SV * ver_sv = perl_get_sv("DB_File::db_ver", GV_ADD|GV_ADDMULTI) ; -#ifdef DB_VERSION_MAJOR - int Major, Minor, Patch ; - - (void)db_version(&Major, &Minor, &Patch) ; - - /* Check that the versions of db.h and libdb.a are the same */ - if (Major != DB_VERSION_MAJOR || Minor != DB_VERSION_MINOR - || Patch != DB_VERSION_PATCH) - croak("\nDB_File needs compatible versions of libdb & db.h\n\tyou have db.h version %d.%d.%d and libdb version %d.%d.%d\n", - DB_VERSION_MAJOR, DB_VERSION_MINOR, DB_VERSION_PATCH, - Major, Minor, Patch) ; - - /* check that libdb is recent enough -- we need 2.3.4 or greater */ - if (Major == 2 && (Minor < 3 || (Minor == 3 && Patch < 4))) - croak("DB_File needs Berkeley DB 2.3.4 or greater, you have %d.%d.%d\n", - Major, Minor, Patch) ; - -#if PERL_VERSION > 3 - sv_setpvf(version_sv, "%d.%d", Major, Minor) ; - sv_setpvf(ver_sv, "%d.%03d%03d", Major, Minor, Patch) ; -#else - { - char buffer[40] ; - sprintf(buffer, "%d.%d", Major, Minor) ; - sv_setpv(version_sv, buffer) ; - sprintf(buffer, "%d.%03d%03d", Major, Minor, Patch) ; - sv_setpv(ver_sv, buffer) ; - } -#endif - -#else - sv_setiv(version_sv, 1) ; - sv_setiv(ver_sv, 1) ; -#endif - -} - static int #ifdef CAN_PROTOTYPE @@ -641,7 +629,7 @@ size_t size ; } -#ifdef TRACE +#if defined(TRACE) && defined(BERKELEY_DB_1_OR_2) static void #ifdef CAN_PROTOTYPE @@ -724,8 +712,8 @@ DB_File db ; DBT value ; int RETVAL ; - DBT_flags(key) ; - DBT_flags(value) ; + DBT_clear(key) ; + DBT_clear(value) ; RETVAL = do_SEQ(db, key, value, R_LAST) ; if (RETVAL == 0) RETVAL = *(I32 *)key.data ; @@ -760,6 +748,7 @@ I32 value ; return value ; } + static DB_File #ifdef CAN_PROTOTYPE ParseOpenInfo(pTHX_ int isHASH, char *name, int flags, int mode, SV *sv) @@ -772,6 +761,9 @@ int mode ; SV * sv ; #endif { + +#ifdef BERKELEY_DB_1_OR_2 /* Berkeley DB Version 1 or 2 */ + SV ** svp; HV * action ; DB_File RETVAL = (DB_File)safemalloc(sizeof(DB_File_type)) ; @@ -1032,11 +1024,265 @@ SV * sv ; } #else + +#if defined(DB_LIBRARY_COMPATIBILITY_API) && DB_VERSION_MAJOR > 2 + RETVAL->dbp = __db185_open(name, flags, mode, RETVAL->type, openinfo) ; +#else RETVAL->dbp = dbopen(name, flags, mode, RETVAL->type, openinfo) ; +#endif /* DB_LIBRARY_COMPATIBILITY_API */ + #endif return (RETVAL) ; -} + +#else /* Berkeley DB Version > 2 */ + + SV ** svp; + HV * action ; + DB_File RETVAL = (DB_File)safemalloc(sizeof(DB_File_type)) ; + DB * dbp ; + STRLEN n_a; + int status ; + +/* printf("In ParseOpenInfo name=[%s] flags=[%d] mode = [%d]\n", name, flags, mode) ; */ + Zero(RETVAL, 1, DB_File_type) ; + + /* Default to HASH */ +#ifdef DBM_FILTERING + RETVAL->filtering = 0 ; + RETVAL->filter_fetch_key = RETVAL->filter_store_key = + RETVAL->filter_fetch_value = RETVAL->filter_store_value = +#endif /* DBM_FILTERING */ + RETVAL->hash = RETVAL->compare = RETVAL->prefix = NULL ; + RETVAL->type = DB_HASH ; + + /* DGH - Next line added to avoid SEGV on existing hash DB */ + CurrentDB = RETVAL; + + /* fd for 1.86 hash in memory files doesn't return -1 like 1.85 */ + RETVAL->in_memory = (name == NULL) ; + + status = db_create(&RETVAL->dbp, NULL,0) ; + /* printf("db_create returned %d %s\n", status, db_strerror(status)) ; */ + if (status) { + RETVAL->dbp = NULL ; + return (RETVAL) ; + } + dbp = RETVAL->dbp ; + + if (sv) + { + if (! SvROK(sv) ) + croak ("type parameter is not a reference") ; + + svp = hv_fetch( (HV*)SvRV(sv), "GOT", 3, FALSE) ; + if (svp && SvOK(*svp)) + action = (HV*) SvRV(*svp) ; + else + croak("internal error") ; + + if (sv_isa(sv, "DB_File::HASHINFO")) + { + + if (!isHASH) + croak("DB_File can only tie an associative array to a DB_HASH database") ; + + RETVAL->type = DB_HASH ; + + svp = hv_fetch(action, "hash", 4, FALSE); + + if (svp && SvOK(*svp)) + { + (void)dbp->set_h_hash(dbp, hash_cb) ; + RETVAL->hash = newSVsv(*svp) ; + } + + svp = hv_fetch(action, "ffactor", 7, FALSE); + if (svp) + (void)dbp->set_h_ffactor(dbp, SvIV(*svp)) ; + + svp = hv_fetch(action, "nelem", 5, FALSE); + if (svp) + (void)dbp->set_h_nelem(dbp, SvIV(*svp)) ; + + svp = hv_fetch(action, "bsize", 5, FALSE); + if (svp) + (void)dbp->set_pagesize(dbp, SvIV(*svp)); + + svp = hv_fetch(action, "cachesize", 9, FALSE); + if (svp) + (void)dbp->set_cachesize(dbp, 0, SvIV(*svp), 0) ; + + svp = hv_fetch(action, "lorder", 6, FALSE); + if (svp) + (void)dbp->set_lorder(dbp, SvIV(*svp)) ; + + PrintHash(info) ; + } + else if (sv_isa(sv, "DB_File::BTREEINFO")) + { + if (!isHASH) + croak("DB_File can only tie an associative array to a DB_BTREE database"); + + RETVAL->type = DB_BTREE ; + + svp = hv_fetch(action, "compare", 7, FALSE); + if (svp && SvOK(*svp)) + { + (void)dbp->set_bt_compare(dbp, btree_compare) ; + RETVAL->compare = newSVsv(*svp) ; + } + + svp = hv_fetch(action, "prefix", 6, FALSE); + if (svp && SvOK(*svp)) + { + (void)dbp->set_bt_prefix(dbp, btree_prefix) ; + RETVAL->prefix = newSVsv(*svp) ; + } + + svp = hv_fetch(action, "flags", 5, FALSE); + if (svp) + (void)dbp->set_flags(dbp, SvIV(*svp)) ; + + svp = hv_fetch(action, "cachesize", 9, FALSE); + if (svp) + (void)dbp->set_cachesize(dbp, 0, SvIV(*svp), 0) ; + + svp = hv_fetch(action, "psize", 5, FALSE); + if (svp) + (void)dbp->set_pagesize(dbp, SvIV(*svp)) ; + + svp = hv_fetch(action, "lorder", 6, FALSE); + if (svp) + (void)dbp->set_lorder(dbp, SvIV(*svp)) ; + + PrintBtree(info) ; + + } + else if (sv_isa(sv, "DB_File::RECNOINFO")) + { + int fixed = FALSE ; + + if (isHASH) + croak("DB_File can only tie an array to a DB_RECNO database"); + + RETVAL->type = DB_RECNO ; + + svp = hv_fetch(action, "flags", 5, FALSE); + if (svp) { + int flags = SvIV(*svp) ; + /* remove FIXDLEN, if present */ + if (flags & DB_FIXEDLEN) { + fixed = TRUE ; + flags &= ~DB_FIXEDLEN ; + } + } + + svp = hv_fetch(action, "cachesize", 9, FALSE); + if (svp) { + status = dbp->set_cachesize(dbp, 0, SvIV(*svp), 0) ; + } + + svp = hv_fetch(action, "psize", 5, FALSE); + if (svp) { + status = dbp->set_pagesize(dbp, SvIV(*svp)) ; + } + + svp = hv_fetch(action, "lorder", 6, FALSE); + if (svp) { + status = dbp->set_lorder(dbp, SvIV(*svp)) ; + } + + svp = hv_fetch(action, "bval", 4, FALSE); + if (svp && SvOK(*svp)) + { + int value ; + if (SvPOK(*svp)) + value = (int)*SvPV(*svp, n_a) ; + else + value = SvIV(*svp) ; + + if (fixed) { + status = dbp->set_re_pad(dbp, value) ; + } + else { + status = dbp->set_re_delim(dbp, value) ; + } + + } + + if (fixed) { + svp = hv_fetch(action, "reclen", 6, FALSE); + if (svp) { + u_int32_t len = (u_int32_t)SvIV(*svp) ; + status = dbp->set_re_len(dbp, len) ; + } + } + + if (name != NULL) { + status = dbp->set_re_source(dbp, name) ; + name = NULL ; + } + + svp = hv_fetch(action, "bfname", 6, FALSE); + if (svp && SvOK(*svp)) { + char * ptr = SvPV(*svp,n_a) ; + name = (char*) n_a ? ptr : NULL ; + } + else + name = NULL ; + + + status = dbp->set_flags(dbp, DB_RENUMBER) ; + + if (flags){ + (void)dbp->set_flags(dbp, flags) ; + } + PrintRecno(info) ; + } + else + croak("type is not of type DB_File::HASHINFO, DB_File::BTREEINFO or DB_File::RECNOINFO"); + } + + { + int Flags = 0 ; + int status ; + + /* Map 1.x flags to 3.x flags */ + if ((flags & O_CREAT) == O_CREAT) + Flags |= DB_CREATE ; + +#if O_RDONLY == 0 + if (flags == O_RDONLY) +#else + if ((flags & O_RDONLY) == O_RDONLY && (flags & O_RDWR) != O_RDWR) +#endif + Flags |= DB_RDONLY ; + +#ifdef O_TRUNC + if ((flags & O_TRUNC) == O_TRUNC) + Flags |= DB_TRUNCATE ; +#endif + + status = RETVAL->dbp->open(RETVAL->dbp, name, NULL, RETVAL->type, + Flags, mode) ; + /* printf("open returned %d %s\n", status, db_strerror(status)) ; */ + + if (status == 0) + status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor, + 0) ; + /* printf("cursor returned %d %s\n", status, db_strerror(status)) ; */ + + if (status) + RETVAL->dbp = NULL ; + + } + + return (RETVAL) ; + +#endif /* Berkeley DB Version > 2 */ + +} /* ParseOpenInfo */ static double @@ -1279,11 +1525,11 @@ MODULE = DB_File PACKAGE = DB_File PREFIX = db_ BOOT: { - GetVersionInfo(aTHX) ; + __getBerkeleyDBInfo() ; + DBT_clear(empty) ; empty.data = &zero ; empty.size = sizeof(recno_t) ; - DBT_flags(empty) ; } double @@ -1363,7 +1609,7 @@ db_EXISTS(db, key) { DBT value ; - DBT_flags(value) ; + DBT_clear(value) ; CurrentDB = db ; RETVAL = (((db->dbp)->get)(db->dbp, TXN &key, &value, 0) == 0) ; } @@ -1379,7 +1625,7 @@ db_FETCH(db, key, flags=0) { DBT value ; - DBT_flags(value) ; + DBT_clear(value) ; CurrentDB = db ; /* RETVAL = ((db->dbp)->get)(db->dbp, TXN &key, &value, flags) ; */ RETVAL = db_get(db, key, value, flags) ; @@ -1405,8 +1651,8 @@ db_FIRSTKEY(db) DBTKEY key ; DBT value ; - DBT_flags(key) ; - DBT_flags(value) ; + DBT_clear(key) ; + DBT_clear(value) ; CurrentDB = db ; RETVAL = do_SEQ(db, key, value, R_FIRST) ; ST(0) = sv_newmortal(); @@ -1421,7 +1667,7 @@ db_NEXTKEY(db, key) { DBT value ; - DBT_flags(value) ; + DBT_clear(value) ; CurrentDB = db ; RETVAL = do_SEQ(db, key, value, R_NEXT) ; ST(0) = sv_newmortal(); @@ -1445,8 +1691,8 @@ unshift(db, ...) DB * Db = db->dbp ; STRLEN n_a; - DBT_flags(key) ; - DBT_flags(value) ; + DBT_clear(key) ; + DBT_clear(value) ; CurrentDB = db ; #ifdef DB_VERSION_MAJOR /* get the first value */ @@ -1483,8 +1729,8 @@ pop(db) DBTKEY key ; DBT value ; - DBT_flags(key) ; - DBT_flags(value) ; + DBT_clear(key) ; + DBT_clear(value) ; CurrentDB = db ; /* First get the final value */ @@ -1510,8 +1756,8 @@ shift(db) DBT value ; DBTKEY key ; - DBT_flags(key) ; - DBT_flags(value) ; + DBT_clear(key) ; + DBT_clear(value) ; CurrentDB = db ; /* get the first value */ RETVAL = do_SEQ(db, key, value, R_FIRST) ; @@ -1539,45 +1785,37 @@ push(db, ...) DB * Db = db->dbp ; int i ; STRLEN n_a; + int keyval ; DBT_flags(key) ; DBT_flags(value) ; CurrentDB = db ; -#ifdef DB_VERSION_MAJOR - RETVAL = do_SEQ(db, key, value, DB_LAST) ; - RETVAL = 0 ; - key = empty ; - for (i = 1 ; i < items ; ++i) - { - value.data = SvPV(ST(i), n_a) ; - value.size = n_a ; - RETVAL = (Db->put)(Db, NULL, &key, &value, DB_APPEND) ; - if (RETVAL != 0) - break; - } -#else - /* Set the Cursor to the Last element */ RETVAL = do_SEQ(db, key, value, R_LAST) ; +#ifndef DB_VERSION_MAJOR if (RETVAL >= 0) +#endif { - if (RETVAL == 1) - key = empty ; - for (i = items - 1 ; i > 0 ; --i) + if (RETVAL == 0) + keyval = *(int*)key.data ; + else + keyval = 0 ; + for (i = 1 ; i < items ; ++i) { value.data = SvPV(ST(i), n_a) ; value.size = n_a ; - RETVAL = (Db->put)(Db, &key, &value, R_IAFTER) ; + ++ keyval ; + key.data = &keyval ; + key.size = sizeof(int) ; + RETVAL = (Db->put)(Db, TXN &key, &value, 0) ; if (RETVAL != 0) break; } } -#endif } OUTPUT: RETVAL - I32 length(db) DB_File db @@ -1619,7 +1857,7 @@ db_get(db, key, value, flags=0) u_int flags CODE: CurrentDB = db ; - DBT_flags(value) ; + DBT_clear(value) ; RETVAL = db_get(db, key, value, flags) ; #ifdef DB_VERSION_MAJOR if (RETVAL > 0) @@ -1694,7 +1932,7 @@ db_seq(db, key, value, flags) u_int flags CODE: CurrentDB = db ; - DBT_flags(value) ; + DBT_clear(value) ; RETVAL = db_seq(db, key, value, flags); #ifdef DB_VERSION_MAJOR if (RETVAL > 0) diff --git a/ext/DB_File/Makefile.PL b/ext/DB_File/Makefile.PL index 1a13e0bbd8..a247924ec8 100644 --- a/ext/DB_File/Makefile.PL +++ b/ext/DB_File/Makefile.PL @@ -14,7 +14,15 @@ WriteMakefile( MAN3PODS => {}, # Pods will be built by installman. #INC => '-I/usr/local/include', VERSION_FROM => 'DB_File.pm', + OBJECT => 'version$(OBJ_EXT) DB_File$(OBJ_EXT)', XSPROTOARG => '-noprototypes', DEFINE => "$OS2", ); +sub MY::postamble { + ' +version$(OBJ_EXT): version.c + +' ; +} + diff --git a/ext/DB_File/dbinfo b/ext/DB_File/dbinfo index 24a794448f..701ac612b6 100644 --- a/ext/DB_File/dbinfo +++ b/ext/DB_File/dbinfo @@ -4,8 +4,8 @@ # a database file # # Author: Paul Marquess <Paul.Marquess@btinternet.com> -# Version: 1.01 -# Date 16th April 1998 +# Version: 1.02 +# Date 20th August 1999 # # Copyright (c) 1998 Paul Marquess. All rights reserved. # This program is free software; you can redistribute it and/or @@ -19,7 +19,7 @@ use strict ; my %Data = ( 0x053162 => { - Type => "Btree", + Type => "Btree", Versions => { 1 => "Unknown (older than 1.71)", @@ -27,18 +27,27 @@ my %Data = 3 => "1.71 -> 1.85, 1.86", 4 => "Unknown", 5 => "2.0.0 -> 2.3.0", - 6 => "2.3.1 or greater", + 6 => "2.3.1 -> 2.7.7", + 7 => "3.0.0 or greater", } }, 0x061561 => { - Type => "Hash", + Type => "Hash", Versions => { 1 => "Unknown (older than 1.71)", 2 => "1.71 -> 1.85", 3 => "1.86", 4 => "2.0.0 -> 2.1.0", - 5 => "2.2.6 or greater", + 5 => "2.2.6 -> 2.7.7", + 6 => "3.0.0 or greater", + } + }, + 0x042253 => { + Type => "Queue", + Versions => + { + 1 => "3.0.0 or greater", } }, ) ; diff --git a/ext/DB_File/typemap b/ext/DB_File/typemap index a614cc4c29..41a24f4a86 100644 --- a/ext/DB_File/typemap +++ b/ext/DB_File/typemap @@ -1,8 +1,8 @@ # typemap for Perl 5 interface to Berkeley # # written by Paul Marquess <Paul.Marquess@btinternet.com> -# last modified 6th June 1999 -# version 1.67 +# last modified 7th September 1999 +# version 1.71 # #################################### DB SECTION # @@ -16,22 +16,21 @@ DBTKEY T_dbtkeydatum INPUT T_dbtkeydatum ckFilter($arg, filter_store_key, \"filter_store_key\"); + DBT_clear($var) ; if (db->type != DB_RECNO) { $var.data = SvPV($arg, PL_na); $var.size = (int)PL_na; - DBT_flags($var); } else { Value = GetRecnoKey(aTHX_ db, SvIV($arg)) ; $var.data = & Value; $var.size = (int)sizeof(recno_t); - DBT_flags($var); } T_dbtdatum ckFilter($arg, filter_store_value, \"filter_store_value\"); + DBT_clear($var) ; $var.data = SvPV($arg, PL_na); $var.size = (int)PL_na; - DBT_flags($var); OUTPUT diff --git a/ext/DB_File/version.c b/ext/DB_File/version.c new file mode 100644 index 0000000000..23c96a6804 --- /dev/null +++ b/ext/DB_File/version.c @@ -0,0 +1,70 @@ +/* + + version.c -- Perl 5 interface to Berkeley DB + + written by Paul Marquess <Paul.Marquess@btinternet.com> + last modified 7th September 1999 + version 1.71 + + All comments/suggestions/problems are welcome + + Copyright (c) 1995-9 Paul Marquess. All rights reserved. + This program is free software; you can redistribute it and/or + modify it under the same terms as Perl itself. + + Changes: + 1.71 - Support for Berkeley DB version 3. + Support for Berkeley DB 2/3's backward compatability mode. + +*/ + +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +#include <db.h> + +void +__getBerkeleyDBInfo() +{ + SV * version_sv = perl_get_sv("DB_File::db_version", GV_ADD|GV_ADDMULTI) ; + SV * ver_sv = perl_get_sv("DB_File::db_ver", GV_ADD|GV_ADDMULTI) ; + SV * compat_sv = perl_get_sv("DB_File::db_185_compat", GV_ADD|GV_ADDMULTI) ; + +#ifdef DB_VERSION_MAJOR + int Major, Minor, Patch ; + + (void)db_version(&Major, &Minor, &Patch) ; + + /* Check that the versions of db.h and libdb.a are the same */ + if (Major != DB_VERSION_MAJOR || Minor != DB_VERSION_MINOR + || Patch != DB_VERSION_PATCH) + croak("\nDB_File needs compatible versions of libdb & db.h\n\tyou have db.h version %d.%d.%d and libdb version %d.%d.%d\n", + DB_VERSION_MAJOR, DB_VERSION_MINOR, DB_VERSION_PATCH, + Major, Minor, Patch) ; + + /* check that libdb is recent enough -- we need 2.3.4 or greater */ + if (Major == 2 && (Minor < 3 || (Minor == 3 && Patch < 4))) + croak("DB_File needs Berkeley DB 2.3.4 or greater, you have %d.%d.%d\n", + Major, Minor, Patch) ; + + { + char buffer[40] ; + sprintf(buffer, "%d.%d", Major, Minor) ; + sv_setpv(version_sv, buffer) ; + sprintf(buffer, "%d.%03d%03d", Major, Minor, Patch) ; + sv_setpv(ver_sv, buffer) ; + } + +#else /* ! DB_VERSION_MAJOR */ + sv_setiv(version_sv, 1) ; + sv_setiv(ver_sv, 1) ; +#endif /* ! DB_VERSION_MAJOR */ + +#ifdef COMPAT185 + sv_setiv(compat_sv, 1) ; +#else /* ! COMPAT185 */ + sv_setiv(compat_sv, 0) ; +#endif /* ! COMPAT185 */ + +} diff --git a/ext/Devel/DProf/DProf.xs b/ext/Devel/DProf/DProf.xs index 62a0c9ec1c..69f0b899a3 100644 --- a/ext/Devel/DProf/DProf.xs +++ b/ext/Devel/DProf/DProf.xs @@ -292,7 +292,7 @@ prof_mark( opcode ptype ) static U32 lastid; CV *cv; - cv = (CV*)PTR_CAST SvIVX(Sub); + cv = INT2PTR(CV*,SvIVX(Sub)); svp = hv_fetch(cv_hash, (char*)&cv, sizeof(CV*), TRUE); if (!SvOK(*svp)) { GV *gv = CvGV(cv); @@ -568,7 +568,7 @@ XS(XS_DB_sub) PUSHMARK( ORIGMARK ); #ifdef G_NODEBUG - perl_call_sv( (SV*)PTR_CAST SvIV(Sub), GIMME | G_NODEBUG); + perl_call_sv( INT2PTR(SV*,SvIV(Sub)), GIMME | G_NODEBUG); #else curstash = debstash; /* To disable debugging of perl_call_sv */ #ifdef PERLDBf_NONAME diff --git a/ext/DynaLoader/DynaLoader_pm.PL b/ext/DynaLoader/DynaLoader_pm.PL index 3e30698f87..3ce720b1cb 100644 --- a/ext/DynaLoader/DynaLoader_pm.PL +++ b/ext/DynaLoader/DynaLoader_pm.PL @@ -179,7 +179,7 @@ sub bootstrap { # The .bs file can be used to configure @dl_resolve_using etc to # match the needs of the individual module on this architecture. my $bs = $file; - $bs =~ s/(\.\w+)?$/\.bs/; # look for .bs 'beside' the library + $bs =~ s/(\.\w+)?(;\d*)?$/\.bs/; # look for .bs 'beside' the library if (-s $bs) { # only read file if it's not empty print STDERR "BS: $bs ($^O, $dlsrc)\n" if $dl_debug; eval { do $bs; }; diff --git a/ext/DynaLoader/dl_aix.xs b/ext/DynaLoader/dl_aix.xs index 877b28543a..96bce4e1d4 100644 --- a/ext/DynaLoader/dl_aix.xs +++ b/ext/DynaLoader/dl_aix.xs @@ -590,7 +590,7 @@ dl_load_file(filename, flags=0) if (RETVAL == NULL) SaveError(aTHX_ "%s",dlerror()) ; else - sv_setiv( ST(0), (IV)RETVAL); + sv_setiv( ST(0), PTR2IV(RETVAL) ); void * @@ -606,7 +606,7 @@ dl_find_symbol(libhandle, symbolname) if (RETVAL == NULL) SaveError(aTHX_ "%s",dlerror()) ; else - sv_setiv( ST(0), (IV)RETVAL); + sv_setiv( ST(0), PTR2IV(RETVAL)); void diff --git a/ext/DynaLoader/dl_beos.xs b/ext/DynaLoader/dl_beos.xs index 1bd16a69a1..c26824e34e 100644 --- a/ext/DynaLoader/dl_beos.xs +++ b/ext/DynaLoader/dl_beos.xs @@ -54,7 +54,7 @@ dl_load_file(filename, flags=0) PerlIO_printf(PerlIO_stderr(), "load_add_on(%s) : %d (%s)\n", path, bogo, strerror(bogo)); } else { RETVAL = (void *) bogo; - sv_setiv( ST(0), (IV)RETVAL); + sv_setiv( ST(0), PTR2IV(RETVAL) ); } free(path); } @@ -83,7 +83,7 @@ dl_find_symbol(libhandle, symbolname) SaveError(aTHX_ "%s", strerror(retcode)) ; PerlIO_printf(PerlIO_stderr(), "retcode = %p (%s)\n", retcode, strerror(retcode)); } else - sv_setiv( ST(0), (IV)RETVAL); + sv_setiv( ST(0), PTR2IV(RETVAL)); void diff --git a/ext/DynaLoader/dl_cygwin.xs b/ext/DynaLoader/dl_cygwin.xs index 0054afaae7..7f74cdd83f 100644 --- a/ext/DynaLoader/dl_cygwin.xs +++ b/ext/DynaLoader/dl_cygwin.xs @@ -95,7 +95,7 @@ dl_load_file(filename,flags=0) if (RETVAL == NULL){ SaveError(aTHX_ "%d",GetLastError()) ; } else { - sv_setiv( ST(0), (IV)RETVAL); + sv_setiv( ST(0), PTR2IV(RETVAL) ); } } @@ -114,7 +114,7 @@ dl_find_symbol(libhandle, symbolname) if (RETVAL == NULL) SaveError(aTHX_ "%d",GetLastError()) ; else - sv_setiv( ST(0), (IV)RETVAL); + sv_setiv( ST(0), PTR2IV(RETVAL)); void diff --git a/ext/DynaLoader/dl_dld.xs b/ext/DynaLoader/dl_dld.xs index 1ddc443cfa..d427efa1d0 100644 --- a/ext/DynaLoader/dl_dld.xs +++ b/ext/DynaLoader/dl_dld.xs @@ -118,7 +118,7 @@ dl_load_file(filename, flags=0) haverror: ST(0) = sv_newmortal() ; if (dlderr == 0) - sv_setiv(ST(0), (IV)RETVAL); + sv_setiv(ST(0), PTR2IV(RETVAL)); void * @@ -135,7 +135,7 @@ dl_find_symbol(libhandle, symbolname) if (RETVAL == NULL) SaveError(aTHX_ "dl_find_symbol: Unable to find '%s' symbol", symbolname) ; else - sv_setiv(ST(0), (IV)RETVAL); + sv_setiv(ST(0), PTR2IV(RETVAL)); void diff --git a/ext/DynaLoader/dl_dlopen.xs b/ext/DynaLoader/dl_dlopen.xs index a4dcfb4fbe..641db33514 100644 --- a/ext/DynaLoader/dl_dlopen.xs +++ b/ext/DynaLoader/dl_dlopen.xs @@ -166,7 +166,7 @@ dl_load_file(filename, flags=0) if (RETVAL == NULL) SaveError(aTHX_ "%s",dlerror()) ; else - sv_setiv( ST(0), (IV)PTR_CAST RETVAL); + sv_setiv( ST(0), PTR2IV(RETVAL)); void * @@ -187,7 +187,7 @@ dl_find_symbol(libhandle, symbolname) if (RETVAL == NULL) SaveError(aTHX_ "%s",dlerror()) ; else - sv_setiv( ST(0), (IV)PTR_CAST RETVAL); + sv_setiv( ST(0), PTR2IV(RETVAL)); void diff --git a/ext/DynaLoader/dl_hpux.xs b/ext/DynaLoader/dl_hpux.xs index ce454598c0..180679fb71 100644 --- a/ext/DynaLoader/dl_hpux.xs +++ b/ext/DynaLoader/dl_hpux.xs @@ -92,7 +92,7 @@ end: if (obj == NULL) SaveError(aTHX_ "%s",Strerror(errno)); else - sv_setiv( ST(0), (IV)obj); + sv_setiv( ST(0), PTR2IV(obj) ); void * @@ -124,7 +124,7 @@ dl_find_symbol(libhandle, symbolname) if (status == -1) { SaveError(aTHX_ "%s",(errno) ? Strerror(errno) : "Symbol not found") ; } else { - sv_setiv( ST(0), (IV)symaddr); + sv_setiv( ST(0), PTR2IV(symaddr) ); } diff --git a/ext/DynaLoader/dl_mpeix.xs b/ext/DynaLoader/dl_mpeix.xs index 4c5d17635a..913e259cd9 100644 --- a/ext/DynaLoader/dl_mpeix.xs +++ b/ext/DynaLoader/dl_mpeix.xs @@ -74,7 +74,7 @@ flags)); if (obj == NULL) SaveError(aTHX_"%s",Strerror(errno)); else - sv_setiv( ST(0), (IV)obj); + sv_setiv( ST(0), PTR2IV(obj) ); void * dl_find_symbol(libhandle, symbolname) @@ -100,7 +100,7 @@ dl_find_symbol(libhandle, symbolname) if (status != 0) { SaveError(aTHX_"%s",(errno) ? Strerror(errno) : "Symbol not found") ; } else { - sv_setiv( ST(0), (IV)symaddr); + sv_setiv( ST(0), PTR2IV(symaddr) ); } void diff --git a/ext/DynaLoader/dl_next.xs b/ext/DynaLoader/dl_next.xs index ec01d608f4..54d4be07ab 100644 --- a/ext/DynaLoader/dl_next.xs +++ b/ext/DynaLoader/dl_next.xs @@ -252,7 +252,7 @@ dl_load_file(filename, flags=0) if (RETVAL == NULL) SaveError(aTHX_ "%s",dlerror()) ; else - sv_setiv( ST(0), (IV)RETVAL); + sv_setiv( ST(0), PTR2IV(RETVAL) ); void * @@ -273,7 +273,7 @@ dl_find_symbol(libhandle, symbolname) if (RETVAL == NULL) SaveError(aTHX_ "%s",dlerror()) ; else - sv_setiv( ST(0), (IV)RETVAL); + sv_setiv( ST(0), PTR2IV(RETVAL) ); void diff --git a/ext/DynaLoader/dl_rhapsody.xs b/ext/DynaLoader/dl_rhapsody.xs index 223d7f68b5..a56452ed7d 100644 --- a/ext/DynaLoader/dl_rhapsody.xs +++ b/ext/DynaLoader/dl_rhapsody.xs @@ -166,7 +166,7 @@ dl_load_file(filename, flags=0) if (RETVAL == NULL) SaveError(aTHX_ "%s",dlerror()) ; else - sv_setiv( ST(0), (IV)RETVAL); + sv_setiv( ST(0), PTR2IV(RETVAL) ); void * @@ -185,7 +185,7 @@ dl_find_symbol(libhandle, symbolname) if (RETVAL == NULL) SaveError(aTHX_ "%s",dlerror()) ; else - sv_setiv( ST(0), (IV)RETVAL); + sv_setiv( ST(0), PTR2IV(RETVAL) ); void diff --git a/ext/DynaLoader/dl_vmesa.xs b/ext/DynaLoader/dl_vmesa.xs index ff1b60bedf..9e4908cecd 100644 --- a/ext/DynaLoader/dl_vmesa.xs +++ b/ext/DynaLoader/dl_vmesa.xs @@ -123,7 +123,7 @@ dl_load_file(filename, flags=0) if (RETVAL == NULL) SaveError(aTHX_ "%s",dlerror()) ; else - sv_setiv( ST(0), (IV)RETVAL); + sv_setiv( ST(0), PTR2IV(RETVAL) ); void * @@ -141,7 +141,7 @@ dl_find_symbol(libhandle, symbolname) if (RETVAL == NULL) SaveError(aTHX_ "%s",dlerror()) ; else - sv_setiv( ST(0), (IV)RETVAL); + sv_setiv( ST(0), PTR2IV(RETVAL) ); void diff --git a/ext/DynaLoader/dl_vms.xs b/ext/DynaLoader/dl_vms.xs index 1024c41f96..409d586ae7 100644 --- a/ext/DynaLoader/dl_vms.xs +++ b/ext/DynaLoader/dl_vms.xs @@ -301,7 +301,7 @@ dl_load_file(filespec, flags) ST(0) = &PL_sv_undef; } else { - ST(0) = sv_2mortal(newSViv((IV) dlptr)); + ST(0) = sv_2mortal(newSViv(PTR2IV(dlptr))); } @@ -328,7 +328,7 @@ dl_find_symbol(librefptr,symname) /* error message already saved by findsym_handler */ ST(0) = &PL_sv_undef; } - else ST(0) = sv_2mortal(newSViv((IV) entry)); + else ST(0) = sv_2mortal(newSViv(PTR2IV(entry))); void diff --git a/ext/ODBM_File/ODBM_File.xs b/ext/ODBM_File/ODBM_File.xs index bb2eb4714a..7601c3433b 100644 --- a/ext/ODBM_File/ODBM_File.xs +++ b/ext/ODBM_File/ODBM_File.xs @@ -111,7 +111,7 @@ odbm_TIEHASH(dbtype, filename, flags, mode) Zero(RETVAL, 1, ODBM_File_type) ; RETVAL->dbp = dbp ; ST(0) = sv_mortalcopy(&PL_sv_undef); - sv_setptrobj(ST(0), PTR_CAST RETVAL, dbtype); + sv_setptrobj(ST(0), RETVAL, dbtype); } void diff --git a/ext/Opcode/Safe.pm b/ext/Opcode/Safe.pm index 2d09c2e5c7..00ee85dbeb 100644 --- a/ext/Opcode/Safe.pm +++ b/ext/Opcode/Safe.pm @@ -235,7 +235,7 @@ sub rdo { 1; -__DATA__ +__END__ =head1 NAME diff --git a/ext/POSIX/POSIX.xs b/ext/POSIX/POSIX.xs index 0f09aace1a..16217f0936 100644 --- a/ext/POSIX/POSIX.xs +++ b/ext/POSIX/POSIX.xs @@ -3246,7 +3246,7 @@ sigaction(sig, action, oldaction = 0) } else { New(0, sigset, 1, sigset_t); - sv_setptrobj(*svp, PTR_CAST sigset, "POSIX::SigSet"); + sv_setptrobj(*svp, sigset, "POSIX::SigSet"); } *sigset = oact.sa_mask; @@ -3274,7 +3274,7 @@ INIT: } else if (sv_derived_from(ST(2), "POSIX::SigSet")) { IV tmp = SvIV((SV*)SvRV(ST(2))); - oldsigset = (POSIX__SigSet)PTR_CAST tmp; + oldsigset = INT2PTR(POSIX__SigSet,tmp); } else { New(0, oldsigset, 1, sigset_t); |