From: Jarkko Hietaniemi Date: Sun, 1 Aug 1999 22:22:51 +0000 (+0000) Subject: 64-bit work. Now 32-bit platforms get a 100% make test X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=cf2093f6405d08be483e037b6052608c46952a75;p=p5sagit%2Fp5-mst-13.2.git 64-bit work. Now 32-bit platforms get a 100% make test with -Duse64bits (using long long). Tested in Solaris 2.6 sparc RH Linux 6.0 x86 (and Digital IX 4.0D, to get a true 64-bit opinion). Now e.g. 'print unpack "q", pack "q", 12345678901' should work on such 32-bit platforms. Still a lot of printf()s behind -D which wrongly assume that %ld/%lx and (long) are a good combination. Introducing a slew of new macros intended to be used in printf() format strings: e. g. PERL_PRId64 is the string to be used when printing an IV, printf("%" PERL_PRId64 "\n", iv). The PRI... naming follows the C9X naming of macros. p4raw-id: //depot/cfgperl@3861 --- diff --git a/Configure b/Configure index 65afbb4..8e1ebcd 100755 --- a/Configure +++ b/Configure @@ -20,7 +20,7 @@ # $Id: Head.U,v 3.0.1.9 1997/02/28 15:02:09 ram Exp $ # -# Generated on Sun Aug 1 00:18:49 EET DST 1999 [metaconfig 3.0 PL70] +# Generated on Mon Aug 2 01:12:47 EET DST 1999 [metaconfig 3.0 PL70] # (with additional metaconfig patches by perlbug@perl.com) cat >/tmp/c1$$ <try.c < +int main() { + static int32_t foo32 = 0x12345678; +} +EOCP +set try +if eval $compile; then + echo " found." >&4 + val="$define" +else + echo " NOT found." >&4 + val="$undef" +fi +$rm -f try.c try +set i_inttypes +eval $setvar + +: check for int64_t +case "$use64bits" in +"$define" ) + echo " " + echo $n "Checking to see if your system supports int64_t...$c" >&4 + $cat >try.c < +#$i_inttypes I_INTTYPES +#ifdef I_INTTYPES +#include +#endif +int64_t foo() { int64_t x; x = 7; return x; } +EOCP + if $cc $optimize $ccflags -c try.c >/dev/null 2>&1; then + val="$define" + echo " Yup, it does." >&4 + else + val="$undef" + echo " Nope, it doesn't." >&4 + fi + $rm -f try.* + ;; +*) val="$undef" + ;; +esac +set d_int64t +eval $setvar + + +: check for lengths of integral types +echo " " +case "$intsize" in +'') + echo "Checking to see how big your integers are..." >&4 + $cat >intsize.c <<'EOCP' +#include +int main() +{ + printf("intsize=%d;\n", sizeof(int)); + printf("longsize=%d;\n", sizeof(long)); + printf("shortsize=%d;\n", sizeof(short)); + exit(0); +} +EOCP + set intsize + if eval $compile_ok && ./intsize > /dev/null; then + eval `./intsize` + echo "Your integers are $intsize bytes long." + echo "Your long integers are $longsize bytes long." + echo "Your short integers are $shortsize bytes long." + else + $cat >&4 <&4 +echo 'long long foo() { long long x; x = 7; return x; }' > try.c +if $cc $optimize $ccflags -c try.c >/dev/null 2>&1; then + val="$define" + echo " Yup, it does." >&4 +else + val="$undef" + echo " Nope, it doesn't." >&4 +fi +$rm try.* +set d_longlong +eval $setvar + +: check for length of long long +case "${d_longlong}${longlongsize}" in +$define) + echo " " + $echo $n "Checking to see how big your long longs are...$c" >&4 + $cat >try.c <<'EOCP' +#include +int main() +{ + printf("%d\n", sizeof(long long)); +} +EOCP + set try + if eval $compile_ok; then + longlongsize=`./try` + $echo " $longlongsize bytes." >&4 + else + dflt='8' + echo " " + echo "(I can't seem to compile the test program. Guessing...)" + rp="What is the size of a long long (in bytes)?" + . ./myread + longlongsize="$ans" + fi + if $test "X$longsize" = "X$longlongsize"; then + echo "(That isn't any different from an ordinary long.)" + fi + ;; +esac +$rm -f try.c try + +echo " " + +case "$d_longlong" in +$define) + +echo "Checking how to print 64-bit integers..." >&4 + +if $test X"$sPRId64" = X -a X"$intsize" = X8; then + quad=int + $cat >try.c <<'EOCP' +#include +#include +int main() { + int q = 12345678901; + printf("%ld\n", q); +} +EOCP + set try + if eval $compile; then + yyy=`./try$exe_ext` + case "$yyy" in + 12345678901) + sPRId64='"d"'; sPRIi64='"i"'; sPRIu64='"u"'; + sPRIo64='"o"'; sPRIx64='"x"'; sPRIX64='"X"'; + echo "We will use %d." + ;; + esac + fi +fi + +if $test X"$sPRId64" = X -a X"$longsize" = X8; then + quad=long + $cat >try.c <<'EOCP' +#include +#include +int main() { + long q = 12345678901; + printf("%ld\n", q); +} +EOCP + set try + if eval $compile; then + yyy=`./try$exe_ext` + case "$yyy" in + 12345678901) + sPRId64='"ld"'; sPRIi64='"li"'; sPRIu64='"lu"'; + sPRIo64='"lo"'; sPRIx64='"lx"'; sPRIX64='"lX"'; + echo "We will use %ld." + ;; + esac + fi +fi + +if $test X"$sPRId64" = X -a X"$i_inttypes.h" = X"$define" -a X"$d_int64t" = X"$define"; then + quad=int64_t + $cat >try.c <<'EOCP' +#include +#include +#include +int main() { + int64_t q = 12345678901; + printf("%" PRId64 "\n", q); +} +EOCP + set try + if eval $compile; then + yyy=`./try$exe_ext` + case "$yyy" in + 12345678901) + sPRId64=PRId64; sPRIi64=PRIi64; sPRIu64=PRIu64; + sPRIo64=PRIo64; sPRIx64=PRIx64; sPRIX64=PRIX64; + echo "We will use the C9X style." + ;; + esac + fi +fi + +if $test X"$sPRId64" = X -a X"$d_longlong" = X"$define" -a X"$longlongsize" = X8; then + quad="long long" + $cat >try.c <<'EOCP' +#include +#include +int main() { + long long q = 12345678901; + printf("%lld\n", q); +} +EOCP + set try + if eval $compile; then + yyy=`./try$exe_ext` + case "$yyy" in + 12345678901) + sPRId64='"lld"'; sPRIi64='"lli"'; sPRIu64='"llu"'; + sPRIo64='"llo"'; sPRIx64='"llx"'; sPRIX64='"llX"'; + echo "We will use the %lld style." + ;; + esac + fi +fi + +if $test X"$sPRId64" = X -a X"$quad" != X; then + $cat >try.c < +#include +int main() { + $quad q = 12345678901; + printf("%Ld\n", q); +} +EOCP + set try + if eval $compile; then + yyy=`./try$exe_ext` + case "$yyy" in + 12345678901) + sPRId64='"Ld"'; sPRIi64='"Li"'; sPRIu64='"Lu"'; + sPRIo64='"Lo"'; sPRIx64='"Lx"'; sPRIX64='"LX"'; + echo "We will use %lld." + ;; + esac + fi +fi + +if $test X"$sPRId64" = X -a X"$quad" != X; then + $cat >try.c < +#include +int main() { + $quad q = 12345678901; + printf("%qd\n", q); +} +EOCP + set try + if eval $compile; then + yyy=`./try$exe_ext` + case "$yyy" in + 12345678901) + sPRId64='"qd"'; sPRIi64='"qi"'; sPRIu64='"qu"'; + sPRIo64='"qo"'; sPRIx64='"qx"'; sPRIX64='"qX"'; + echo "We will use %qd." + ;; + esac + fi +fi + +if $test X"$sPRId64" = X; then + echo "Cannot figure out how to print 64-bit integers." >&4 +fi + +;; +esac # case "$d_longlong" + +case "$sPRId64" in +'') d_PRId64="$undef"; d_PRIi64="$undef"; d_PRIu64="$undef"; + d_PRIo64="$undef"; d_PRIx64="$undef"; d_PRIX64="$undef"; + ;; +*) d_PRId64="$define"; d_PRIi64="$define"; d_PRIu64="$define"; + d_PRIo64="$define"; d_PRIx64="$define"; d_PRIX64="$define"; + ;; +esac + +$rm -f try try.* + +: check for length of double +echo " " +case "$doublesize" in +'') + $echo $n "Checking to see how big your double precision numbers are...$c" >&4 + $cat >try.c <<'EOCP' +#include +int main() +{ + printf("%d\n", sizeof(double)); +} +EOCP + set try + if eval $compile_ok; then + doublesize=`./try` + $echo " $doublesize bytes." >&4 + else + dflt='8' + echo "(I can't seem to compile the test program. Guessing...)" + rp="What is the size of a double precision number (in bytes)?" + . ./myread + doublesize="$ans" + fi + ;; +esac +$rm -f try.c try + +: check for long doubles +echo " " +echo $n "Checking to see if your system supports long doubles...$c" >&4 +echo 'long double foo() { long double x; x = 7.0; return x; }' > try.c +if $cc $optimize $ccflags -c try.c >/dev/null 2>&1; then + val="$define" + echo " Yup, it does." >&4 +else + val="$undef" + echo " Nope, it doesn't." >&4 +fi +$rm try.* +set d_longdbl +eval $setvar + +: check for length of long double +case "${d_longdbl}${longdblsize}" in +$define) + echo " " + $echo $n "Checking to see how big your long doubles are...$c" >&4 + $cat >try.c <<'EOCP' +#include +int main() +{ + printf("%d\n", sizeof(long double)); +} +EOCP + set try + if eval $compile; then + longdblsize=`./try` + $echo " $longdblsize bytes." >&4 + else + dflt='8' + echo " " + echo "(I can't seem to compile the test program. Guessing...)" >&4 + rp="What is the size of a long double (in bytes)?" + . ./myread + longdblsize="$ans" + fi + if $test "X$doublesize" = "X$longdblsize"; then + echo "(That isn't any different from an ordinary double.)" + fi + ;; +esac +$rm -f try.c try + +echo " " + +case "$d_longdbl" in +$define) + +echo "Checking how to print long doubles..." >&4 + +if $test X"$sPRIfldbl" = X -a X"$doublesize" = X"$longdblsize"; then + $cat >try.c <<'EOCP' +#include +#include +int main() { + double d = 123.456; + printf("%.3f\n", d); +} +EOCP + set try + if eval $compile; then + yyy=`./try$exe_ext` + case "$yyy" in + 123.456) + sPRIfldbl='"f"'; sPRIgldbl='"g"'; sPRIeldbl='"e"'; + sPRIFldbl='"F"'; sPRIGldbl='"G"'; sPRIEldbl='"E"'; + echo "We will use %f." + ;; + esac + fi +fi + +if $test X"$sPRIfldbl" = X; then + $cat >try.c <<'EOCP' +#include +#include +int main() { + long double d = 123.456; + printf("%.3Lf\n", d); +} +EOCP + set try + if eval $compile; then + yyy=`./try$exe_ext` + case "$yyy" in + 123.456) + sPRIfldbl='"Lf"'; sPRIgldbl='"Lg"'; sPRIeldbl='"Le"'; + sPRIFldbl='"LF"'; sPRIGldbl='"LG"'; sPRIEldbl='"LE"'; + echo "We will use %Lf." + ;; + esac + fi +fi + +if $test X"$sPRIfldbl" = X; then + $cat >try.c <<'EOCP' +#include +#include +int main() { + long double d = 123.456; + printf("%.3lf\n", d); +} +EOCP + set try + if eval $compile; then + yyy=`./try$exe_ext` + case "$yyy" in + 123.456) + sPRIfldbl='"lf"'; sPRIgldbl='"lg"'; sPRIeldbl='"le"'; + sPRIFldbl='"lF"'; sPRIGldbl='"lG"'; sPRIEldbl='"lE"'; + echo "We will use %lf." + ;; + esac + fi +fi + +if $test X"$sPRIfldbl" = X -a; then + $cat >try.c <<'EOCP' +#include +#include +int main() { + long double d = 123.456; + printf("%.3llf\n", d); +} +EOCP + set try + if eval $compile; then + yyy=`./try$exe_ext` + case "$yyy" in + 123.456) + sPRIfldbl='"llf"'; sPRIgldbl='"llg"'; sPRIeldbl='"lle"'; + sPRIFldbl='"llF"'; sPRIGldbl='"llG"'; sPRIEldbl='"llE"'; + echo "We will use %llf." + ;; + esac + fi +fi + +if $test X"$sPRIfldbl" = X; then + echo "Cannot figure out how to print long doubles." >&4 +fi + +;; +esac # case "$d_longdbl" + +case "$sPRIfldbl" in +'') d_PRIfldbl="$undef"; d_PRIgldbl="$undef"; d_PRIeldbl="$undef"; + d_PRIFldbl="$undef"; d_PRIGldbl="$undef"; d_PRIEldbl="$undef"; + ;; +*) d_PRIfldbl="$define"; d_PRIgldbl="$define"; d_PRIeldbl="$define"; + d_PRIFldbl="$define"; d_PRIGldbl="$define"; d_PRIEldbl="$define"; + ;; +esac + +$rm -f try try.* + : Initialize h_fcntl h_fcntl=false @@ -6586,6 +7104,14 @@ eval $inlibc set alarm d_alarm eval $inlibc +: see if atolf exists +set atolf d_atolf +eval $inlibc + +: see if atoll exists +set atoll d_atoll +eval $inlibc + : Look for GNU-cc style attribute checking echo " " echo "Checking whether your compiler can handle __attribute__ ..." >&4 @@ -6748,52 +7274,6 @@ $rm -f set set.c set bzero d_bzero eval $inlibc -: check for lengths of integral types -echo " " -case "$intsize" in -'') - echo "Checking to see how big your integers are..." >&4 - $cat >intsize.c <<'EOCP' -#include -int main() -{ - printf("intsize=%d;\n", sizeof(int)); - printf("longsize=%d;\n", sizeof(long)); - printf("shortsize=%d;\n", sizeof(short)); - exit(0); -} -EOCP - set intsize - if eval $compile_ok && ./intsize > /dev/null; then - eval `./intsize` - echo "Your integers are $intsize bytes long." - echo "Your long integers are $longsize bytes long." - echo "Your short integers are $shortsize bytes long." - else - $cat >&4 <try.c < -int main() { - static int32_t foo32 = 0x12345678; -} -EOCP -set try -if eval $compile; then - echo " found." >&4 - val="$define" -else - echo " NOT found." >&4 - val="$undef" -fi -$rm -f try.c try -set i_inttypes -eval $setvar - -: check for int64_t -case "$use64bits" in -"$define" ) - echo " " - echo $n "Checking to see if your system supports int64_t...$c" >&4 - $cat >try.c < -#$i_inttypes I_INTTYPES -#ifdef I_INTTYPES -#include -#endif -int64_t foo() { int64_t x; x = 7; return x; } -EOCP - if $cc $optimize $ccflags -c try.c >/dev/null 2>&1; then - val="$define" - echo " Yup, it does." >&4 - else - val="$undef" - echo " Nope, it doesn't." >&4 - fi - $rm -f try.* - ;; -*) val="$undef" - ;; -esac -set d_int64t -eval $setvar - - : Look for isascii echo " " $cat >isascii.c <<'EOCP' @@ -8722,125 +9151,6 @@ eval $inlibc set lockf d_lockf eval $inlibc -: check for length of double -echo " " -case "$doublesize" in -'') - $echo $n "Checking to see how big your double precision numbers are...$c" >&4 - $cat >try.c <<'EOCP' -#include -int main() -{ - printf("%d\n", sizeof(double)); -} -EOCP - set try - if eval $compile_ok; then - doublesize=`./try` - $echo " $doublesize bytes." >&4 - else - dflt='8' - echo "(I can't seem to compile the test program. Guessing...)" - rp="What is the size of a double precision number (in bytes)?" - . ./myread - doublesize="$ans" - fi - ;; -esac -$rm -f try.c try - -: check for long doubles -echo " " -echo $n "Checking to see if your system supports long doubles...$c" >&4 -echo 'long double foo() { long double x; x = 7.0; return x; }' > try.c -if $cc $optimize $ccflags -c try.c >/dev/null 2>&1; then - val="$define" - echo " Yup, it does." >&4 -else - val="$undef" - echo " Nope, it doesn't." >&4 -fi -$rm try.* -set d_longdbl -eval $setvar - -: check for length of long double -case "${d_longdbl}${longdblsize}" in -$define) - echo " " - $echo $n "Checking to see how big your long doubles are...$c" >&4 - $cat >try.c <<'EOCP' -#include -int main() -{ - printf("%d\n", sizeof(long double)); -} -EOCP - set try - if eval $compile; then - longdblsize=`./try` - $echo " $longdblsize bytes." >&4 - else - dflt='8' - echo " " - echo "(I can't seem to compile the test program. Guessing...)" >&4 - rp="What is the size of a long double (in bytes)?" - . ./myread - longdblsize="$ans" - fi - if $test "X$doublesize" = "X$longdblsize"; then - echo "(That isn't any different from an ordinary double.)" - fi - ;; -esac -$rm -f try.c try - -: check for long long -echo " " -echo $n "Checking to see if your system supports long long...$c" >&4 -echo 'long long foo() { long long x; x = 7; return x; }' > try.c -if $cc $optimize $ccflags -c try.c >/dev/null 2>&1; then - val="$define" - echo " Yup, it does." >&4 -else - val="$undef" - echo " Nope, it doesn't." >&4 -fi -$rm try.* -set d_longlong -eval $setvar - -: check for length of long long -case "${d_longlong}${longlongsize}" in -$define) - echo " " - $echo $n "Checking to see how big your long longs are...$c" >&4 - $cat >try.c <<'EOCP' -#include -int main() -{ - printf("%d\n", sizeof(long long)); -} -EOCP - set try - if eval $compile_ok; then - longlongsize=`./try` - $echo " $longlongsize bytes." >&4 - else - dflt='8' - echo " " - echo "(I can't seem to compile the test program. Guessing...)" - rp="What is the size of a long long (in bytes)?" - . ./myread - longlongsize="$ans" - fi - if $test "X$longsize" = "X$longlongsize"; then - echo "(That isn't any different from an ordinary long.)" - fi - ;; -esac -$rm -f try.c try - : see if lstat exists set lstat d_lstat eval $inlibc @@ -10257,6 +10567,10 @@ eval $inlibc set strtoul d_strtoul eval $inlibc +: see if strtoull exists +set strtoull d_strtoull +eval $inlibc + : see if strxfrm exists set strxfrm d_strxfrm eval $inlibc @@ -13136,10 +13450,24 @@ crosscompile='$crosscompile' cryptlib='$cryptlib' csh='$csh' d_Gconvert='$d_Gconvert' +d_PRIEldbl='$d_PRIEldbl' +d_PRIFldbl='$d_PRIFldbl' +d_PRIGldbl='$d_PRIGldbl' +d_PRIX64='$d_PRIX64' +d_PRId64='$d_PRId64' +d_PRIeldbl='$d_PRIeldbl' +d_PRIfldbl='$d_PRIfldbl' +d_PRIgldbl='$d_PRIgldbl' +d_PRIi64='$d_PRIi64' +d_PRIo64='$d_PRIo64' +d_PRIu64='$d_PRIu64' +d_PRIx64='$d_PRIx64' d_access='$d_access' d_accessx='$d_accessx' d_alarm='$d_alarm' d_archlib='$d_archlib' +d_atolf='$d_atolf' +d_atoll='$d_atoll' d_attribut='$d_attribut' d_bcmp='$d_bcmp' d_bcopy='$d_bcopy' @@ -13395,6 +13723,7 @@ d_strerror='$d_strerror' d_strtod='$d_strtod' d_strtol='$d_strtol' d_strtoul='$d_strtoul' +d_strtoull='$d_strtoull' d_strxfrm='$d_strxfrm' d_suidsafe='$d_suidsafe' d_symlink='$d_symlink' @@ -13657,6 +13986,18 @@ rd_nodata='$rd_nodata' rm='$rm' rmail='$rmail' runnm='$runnm' +sPRIEldbl='$sPRIEldbl' +sPRIFldbl='$sPRIFldbl' +sPRIGldbl='$sPRIGldbl' +sPRIX64='$sPRIX64' +sPRId64='$sPRId64' +sPRIeldbl='$sPRIeldbl' +sPRIfldbl='$sPRIfldbl' +sPRIgldbl='$sPRIgldbl' +sPRIi64='$sPRIi64' +sPRIo64='$sPRIo64' +sPRIu64='$sPRIu64' +sPRIx64='$sPRIx64' sched_yield='$sched_yield' scriptdir='$scriptdir' scriptdirexp='$scriptdirexp' diff --git a/config_h.SH b/config_h.SH index 5019560..b022aa6 100644 --- a/config_h.SH +++ b/config_h.SH @@ -2143,6 +2143,18 @@ sed <config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- #define M_VOID /* Xenix strikes again */ #endif +/* HAS_ATOLF: + * This symbol, if defined, indicates that the atolf routine is + * available to convert strings into long doubles. + */ +#$d_atolf HAS_ATOLF /**/ + +/* HAS_ATOLL: + * This symbol, if defined, indicates that the atoll routine is + * available to convert strings into long longs. + */ +#$d_atoll HAS_ATOLL /**/ + /* PERL_BINCOMPAT_5005: * This symbol, if defined, indicates that Perl 5.006 should be * binary-compatible with Perl 5.005. This is impossible for builds @@ -2459,6 +2471,33 @@ sed <config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- #$d_off64_t HAS_OFF64_T /**/ #$d_dirent64_s HAS_STRUCT_DIRENT64 /**/ +/* PERL_PRIfldbl: + * This symbol, if defined, contains the string used by stdio to + * format long doubles (format 'f') for output. + */ +/* PERL_PRIgldbl: + * This symbol, if defined, contains the string used by stdio to + * format long doubles (format 'g') for output. + */ +#$d_PRIfldbl PERL_PRIfldbl $sPRIfldbl /**/ +#$d_PRIgldbl PERL_PRIgldbl $sPRIgldbl /**/ + +/* PERL_PRId64: + * This symbol, if defined, contains the string used by stdio to + * format 64-bit decimal numbers (format 'd') for output. + */ +/* PERL_PRIu64: + * This symbol, if defined, contains the string used by stdio to + * format 64-bit unsigned decimal numbers (format 'u') for output. + */ +/* PERL_PRIx64: + * This symbol, if defined, contains the string used by stdio to + * format 64-bit hexadecimal numbers (format 'x') for output. + */ +#$d_PRId64 PERL_PRId64 $sPRId64 /**/ +#$d_PRIu64 PERL_PRIu64 $sPRIu64 /**/ +#$d_PRIx64 PERL_PRIx64 $sPRIx64 /**/ + /* SELECT_MIN_BITS: * This symbol holds the minimum number of bits operated by select. * That is, if you do select(n, ...), how many bits at least will be @@ -2532,6 +2571,12 @@ sed <config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- #$d_stdio_stream_array HAS_STDIO_STREAM_ARRAY /**/ #define STDIO_STREAM_ARRAY $stdio_stream_array +/* HAS_STRTOULL: + * This symbol, if defined, indicates that the strtoull routine is + * available to convert strings into unsigned long longs. + */ +#$d_strtoull HAS_STRTOULL /**/ + /* USE_64_BITS: * This symbol, if defined, indicates that 64-bit interfaces should * be used when available. If not defined, the native default interfaces diff --git a/doio.c b/doio.c index 32c3a04..47d70cd 100644 --- a/doio.c +++ b/doio.c @@ -1001,10 +1001,17 @@ Perl_do_print(pTHX_ register SV *sv, PerlIO *fp) if (SvIOK(sv)) { if (SvGMAGICAL(sv)) mg_get(sv); - if (SvIsUV(sv)) /* XXXX 64-bit? */ +#ifdef IV_IS_QUAD + if (SvIsUV(sv)) + PerlIO_printf(fp, "%" PERL_PRIu64, (UV)SvUVX(sv)); + else + PerlIO_printf(fp, "%" PERL_PRId64, (IV)SvIVX(sv)); +#else + if (SvIsUV(sv)) PerlIO_printf(fp, "%lu", (unsigned long)SvUVX(sv)); else PerlIO_printf(fp, "%ld", (long)SvIVX(sv)); +#endif return !PerlIO_error(fp); } /* FALL THROUGH */ diff --git a/dump.c b/dump.c index dced246..f49c8c2 100644 --- a/dump.c +++ b/dump.c @@ -288,10 +288,17 @@ Perl_sv_peek(pTHX_ SV *sv) RESTORE_NUMERIC_LOCAL(); } else if (SvIOKp(sv)) { /* XXXX: IV, UV? */ +#ifdef IV_IS_QUAD + if (SvIsUV(sv)) + Perl_sv_catpvf(aTHX_ t, "(%" PERL_PRIu64 ")",(UV)SvUVX(sv)); + else + Perl_sv_catpvf(aTHX_ t, "(%" PERL_PRId64 ")",(IV)SvIVX(sv)); +#else if (SvIsUV(sv)) Perl_sv_catpvf(aTHX_ t, "(%lu)",(unsigned long)SvUVX(sv)); else Perl_sv_catpvf(aTHX_ t, "(%ld)",(long)SvIVX(sv)); +#endif } else sv_catpv(t, "()"); @@ -397,7 +404,11 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, OP *o) Perl_dump_indent(aTHX_ level, file, "TARG = %d\n", o->op_targ); } #ifdef DUMPADDR - Perl_dump_indent(aTHX_ level, file, "ADDR = 0x%lx => 0x%lx\n",o, o->op_next); +#ifdef IV_IS_QUAD + Perl_dump_indent(aTHX_ level, file, "ADDR = 0x%" PERL_PRIx64 " => 0x%" PERL_PRIx64 "\n", (IV)o, (IV)o->op_next); +#else + Perl_dump_indent(aTHX_ level, file, "ADDR = 0x%lx => 0x%lx\n", (long)o, (long)o->op_next); +#endif #endif if (o->op_flags) { SV *tmpsv = newSVpvn("", 0); @@ -752,10 +763,19 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo flags = SvFLAGS(sv); type = SvTYPE(sv); - Perl_sv_setpvf(aTHX_ d, "(0x%lx) at 0x%lx\n%*s REFCNT = %ld\n%*s FLAGS = (", - (unsigned long)SvANY(sv), (unsigned long)sv, - PL_dumpindent*level, "", (long)SvREFCNT(sv), - PL_dumpindent*level, ""); +#ifdef IV_IS_QUAD + Perl_sv_setpvf(aTHX_ d, + "(0x%" PERL_PRIx64") at 0x%" PERL_PRIx64 "\n%*s REFCNT = %" PERL_PRId64 "\n%*s FLAGS = (", + (UV)SvANY(sv), (UV)sv, + PL_dumpindent*level, "", (IV)SvREFCNT(sv), + PL_dumpindent*level, ""); +#else + Perl_sv_setpvf(aTHX_ d, + "(0x%lx) at 0x%lx\n%*s REFCNT = %ld\n%*s FLAGS = (", + (unsigned long)SvANY(sv), (unsigned long)sv, + PL_dumpindent*level, "", (long)SvREFCNT(sv), + PL_dumpindent*level, ""); +#endif if (flags & SVs_PADBUSY) sv_catpv(d, "PADBUSY,"); if (flags & SVs_PADTMP) sv_catpv(d, "PADTMP,"); @@ -885,21 +905,36 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo return; } if (type >= SVt_PVIV || type == SVt_IV) { +#ifdef IV_IS_QUAD + if (SvIsUV(sv)) + Perl_dump_indent(aTHX_ level, file, " UV = %" PERL_PRIu64, (UV)SvUVX(sv)); + else + Perl_dump_indent(aTHX_ level, file, " IV = %" PERL_PRId64, (IV)SvIVX(sv)); +#else if (SvIsUV(sv)) Perl_dump_indent(aTHX_ level, file, " UV = %lu", (unsigned long)SvUVX(sv)); else Perl_dump_indent(aTHX_ level, file, " IV = %ld", (long)SvIVX(sv)); +#endif if (SvOOK(sv)) PerlIO_printf(file, " (OFFSET)"); PerlIO_putc(file, '\n'); } if (type >= SVt_PVNV || type == SVt_NV) { RESTORE_NUMERIC_STANDARD(); +#ifdef USE_LONG_DOUBLE + Perl_dump_indent(aTHX_ level, file, " NV = %.*" PERL_PRIgldbl "\n", DBL_DIG, SvNVX(sv)); +#else Perl_dump_indent(aTHX_ level, file, " NV = %.*g\n", DBL_DIG, SvNVX(sv)); +#endif RESTORE_NUMERIC_LOCAL(); } if (SvROK(sv)) { +#ifdef IV_IS_QUAD + Perl_dump_indent(aTHX_ level, file, " RV = 0x%" PERL_PRIx64 "\n", (IV)SvRV(sv)); +#else Perl_dump_indent(aTHX_ level, file, " RV = 0x%lx\n", (long)SvRV(sv)); +#endif if (nest < maxnest) do_sv_dump(level+1, file, SvRV(sv), nest+1, maxnest, dumpops, pvlim); return; @@ -908,12 +943,21 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo return; if (type <= SVt_PVLV) { if (SvPVX(sv)) { +#ifdef IV_IS_QUAD + Perl_dump_indent(aTHX_ level, file," PV = 0x%" PERL_PRIx64 " ", (IV)SvPVX(sv)); +#else Perl_dump_indent(aTHX_ level, file," PV = 0x%lx ", (long)SvPVX(sv)); +#endif if (SvOOK(sv)) PerlIO_printf(file, "( %s . ) ", pv_display(d, SvPVX(sv)-SvIVX(sv), SvIVX(sv), 0, pvlim)); PerlIO_printf(file, "%s\n", pv_display(d, SvPVX(sv), SvCUR(sv), SvLEN(sv), pvlim)); +#ifdef IV_IS_QUAD + Perl_dump_indent(aTHX_ level, file, " CUR = %" PERL_PRId64 "\n", (IV)SvCUR(sv)); + Perl_dump_indent(aTHX_ level, file, " LEN = %" PERL_PRId64 "\n", (IV)SvLEN(sv)); +#else Perl_dump_indent(aTHX_ level, file, " CUR = %ld\n", (long)SvCUR(sv)); Perl_dump_indent(aTHX_ level, file, " LEN = %ld\n", (long)SvLEN(sv)); +#endif } else Perl_dump_indent(aTHX_ level, file, " PV = 0\n"); @@ -927,23 +971,43 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo switch (type) { case SVt_PVLV: Perl_dump_indent(aTHX_ level, file, " TYPE = %c\n", LvTYPE(sv)); +#ifdef IV_IS_QUAD + Perl_dump_indent(aTHX_ level, file, " TARGOFF = %" PERL_PRId64 "\n", (IV)LvTARGOFF(sv)); + Perl_dump_indent(aTHX_ level, file, " TARGLEN = %" PERL_PRId64 "\n", (IV)LvTARGLEN(sv)); + Perl_dump_indent(aTHX_ level, file, " TARG = 0x%" PERL_PRIx64 "\n", (IV)LvTARG(sv)); +#else Perl_dump_indent(aTHX_ level, file, " TARGOFF = %ld\n", (long)LvTARGOFF(sv)); Perl_dump_indent(aTHX_ level, file, " TARGLEN = %ld\n", (long)LvTARGLEN(sv)); Perl_dump_indent(aTHX_ level, file, " TARG = 0x%lx\n", (long)LvTARG(sv)); +#endif /* XXX level+1 ??? */ do_sv_dump(level, file, LvTARG(sv), nest+1, maxnest, dumpops, pvlim); break; case SVt_PVAV: +#ifdef IV_IS_QUAD + Perl_dump_indent(aTHX_ level, file, " ARRAY = 0x%" PERL_PRIx64 , (IV)AvARRAY(sv)); +#else Perl_dump_indent(aTHX_ level, file, " ARRAY = 0x%lx", (long)AvARRAY(sv)); +#endif if (AvARRAY(sv) != AvALLOC(sv)) { PerlIO_printf(file, " (offset=%d)\n", (AvARRAY(sv) - AvALLOC(sv))); +#ifdef IV_IS_QUAD + Perl_dump_indent(aTHX_ level, file, " ALLOC = 0x%" PERL_PRIx64 "\n", (IV)AvALLOC(sv)); +#else Perl_dump_indent(aTHX_ level, file, " ALLOC = 0x%lx\n", (long)AvALLOC(sv)); +#endif } else PerlIO_putc(file, '\n'); +#ifdef IV_IS_QUAD + Perl_dump_indent(aTHX_ level, file, " FILL = %" PERL_PRId64 "\n", (IV)AvFILLp(sv)); + Perl_dump_indent(aTHX_ level, file, " MAX = %" PERL_PRId64 "\n", (IV)AvMAX(sv)); + Perl_dump_indent(aTHX_ level, file, " ARYLEN = 0x%" PERL_PRIx64 "\n", (IV)AvARYLEN(sv)); +#else Perl_dump_indent(aTHX_ level, file, " FILL = %ld\n", (long)AvFILLp(sv)); Perl_dump_indent(aTHX_ level, file, " MAX = %ld\n", (long)AvMAX(sv)); Perl_dump_indent(aTHX_ level, file, " ARYLEN = 0x%lx\n", (long)AvARYLEN(sv)); +#endif flags = AvFLAGS(sv); sv_setpv(d, ""); if (flags & AVf_REAL) sv_catpv(d, ",REAL"); @@ -955,14 +1019,22 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo for (count = 0; count <= av_len((AV*)sv) && count < maxnest; count++) { SV** elt = av_fetch((AV*)sv,count,0); +#ifdef IV_IS_QUAD + Perl_dump_indent(aTHX_ level + 1, file, "Elt No. %" PERL_PRId64 "\n", (IV)count); +#else Perl_dump_indent(aTHX_ level + 1, file, "Elt No. %ld\n", (long)count); +#endif if (elt) do_sv_dump(level+1, file, *elt, nest+1, maxnest, dumpops, pvlim); } } break; case SVt_PVHV: +#ifdef IV_IS_QUAD + Perl_dump_indent(aTHX_ level, file, " ARRAY = 0x%" PERL_PRIx64,(IV)HvARRAY(sv)); +#else Perl_dump_indent(aTHX_ level, file, " ARRAY = 0x%lx",(long)HvARRAY(sv)); +#endif if (HvARRAY(sv) && HvKEYS(sv)) { /* Show distribution of HEs in the ARRAY */ int freq[200]; @@ -1007,13 +1079,25 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo Perl_dump_indent(aTHX_ level, file, " hash quality = %.1f%%", theoret/sum*100); } PerlIO_putc(file, '\n'); +#ifdef IV_IS_QUAD + Perl_dump_indent(aTHX_ level, file, " KEYS = %" PERL_PRId64 "\n", (IV)HvKEYS(sv)); + Perl_dump_indent(aTHX_ level, file, " FILL = %" PERL_PRId64 "\n", (IV)HvFILL(sv)); + Perl_dump_indent(aTHX_ level, file, " MAX = %" PERL_PRId64 "\n", (IV)HvMAX(sv)); + Perl_dump_indent(aTHX_ level, file, " RITER = %" PERL_PRId64 "\n", (IV)HvRITER(sv)); + Perl_dump_indent(aTHX_ level, file, " EITER = 0x%" PERL_PRIx64 "\n",(IV) HvEITER(sv)); +#else Perl_dump_indent(aTHX_ level, file, " KEYS = %ld\n", (long)HvKEYS(sv)); Perl_dump_indent(aTHX_ level, file, " FILL = %ld\n", (long)HvFILL(sv)); Perl_dump_indent(aTHX_ level, file, " MAX = %ld\n", (long)HvMAX(sv)); Perl_dump_indent(aTHX_ level, file, " RITER = %ld\n", (long)HvRITER(sv)); Perl_dump_indent(aTHX_ level, file, " EITER = 0x%lx\n",(long) HvEITER(sv)); +#endif if (HvPMROOT(sv)) +#ifdef IV_IS_QUAD + Perl_dump_indent(aTHX_ level, file, " PMROOT = 0x%" PERL_PRIx64 "\n",(IV)HvPMROOT(sv)); +#else Perl_dump_indent(aTHX_ level, file, " PMROOT = 0x%lx\n",(long)HvPMROOT(sv)); +#endif if (HvNAME(sv)) Perl_dump_indent(aTHX_ level, file, " NAME = \"%s\"\n", HvNAME(sv)); if (nest < maxnest && !HvEITER(sv)) { /* Try to preserve iterator */ @@ -1030,7 +1114,11 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo key = hv_iterkey(he, &len); elt = hv_iterval(hv, he); +#ifdef IV_IS_QUAD + Perl_dump_indent(aTHX_ level+1, file, "Elt %s HASH = 0x%" PERL_PRIx64 "\n", pv_display(d, key, len, 0, pvlim), hash); +#else Perl_dump_indent(aTHX_ level+1, file, "Elt %s HASH = 0x%lx\n", pv_display(d, key, len, 0, pvlim), hash); +#endif do_sv_dump(level+1, file, elt, nest+1, maxnest, dumpops, pvlim); } hv_iterinit(hv); /* Return to status quo */ @@ -1043,23 +1131,54 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo case SVt_PVFM: do_hv_dump(level, file, " COMP_STASH", CvSTASH(sv)); if (CvSTART(sv)) +#ifdef IV_IS_QAUD + Perl_dump_indent(aTHX_ level, file, " START = 0x%" PERL_PRIx64 " ===> %d\n", (IV)CvSTART(sv), CvSTART(sv)->op_seq); + Perl_dump_indent(aTHX_ level, file, " ROOT = 0x%" PERL_PRIx64 "\n", (IV)CvROOT(sv)); +#else Perl_dump_indent(aTHX_ level, file, " START = 0x%lx ===> %d\n", (long)CvSTART(sv), CvSTART(sv)->op_seq); Perl_dump_indent(aTHX_ level, file, " ROOT = 0x%lx\n", (long)CvROOT(sv)); +#endif if (CvROOT(sv) && dumpops) do_op_dump(level+1, file, CvROOT(sv)); +#ifdef IV_IS_QUAD + Perl_dump_indent(aTHX_ level, file, " XSUB = 0x%" PERL_PRIx64 "\n", (IV)CvXSUB(sv)); + Perl_dump_indent(aTHX_ level, file, " XSUBANY = %" PERL_PRId64 "\n", (IV)CvXSUBANY(sv).any_i32); +#else Perl_dump_indent(aTHX_ level, file, " XSUB = 0x%lx\n", (long)CvXSUB(sv)); Perl_dump_indent(aTHX_ level, file, " XSUBANY = %ld\n", (long)CvXSUBANY(sv).any_i32); +#endif do_gvgv_dump(level, file, " GVGV::GV", CvGV(sv)); do_gv_dump(level, file, " FILEGV", CvFILEGV(sv)); +#ifdef IV_IS_QUAD + Perl_dump_indent(aTHX_ level, file, " DEPTH = %" PERL_PRId64 "\n", (IV)CvDEPTH(sv)); +#else Perl_dump_indent(aTHX_ level, file, " DEPTH = %ld\n", (long)CvDEPTH(sv)); +#endif #ifdef USE_THREADS +#ifdef IV_IS_QUAD + Perl_dump_indent(aTHX_ level, file, " MUTEXP = 0x%" PERL_PRIx64 "\n", (IV)CvMUTEXP(sv)); + Perl_dump_indent(aTHX_ level, file, " OWNER = 0x%" PERL_PRIx64 "\n", (IV)CvOWNER(sv)); +#else Perl_dump_indent(aTHX_ level, file, " MUTEXP = 0x%lx\n", (long)CvMUTEXP(sv)); Perl_dump_indent(aTHX_ level, file, " OWNER = 0x%lx\n", (long)CvOWNER(sv)); +#endif /* IV_IS_QUAD */ #endif /* USE_THREADS */ +#ifdef IV_IS_QUAD + Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%" PERL_PRIx64 "\n", (UV)CvFLAGS(sv)); +#else Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%lx\n", (unsigned long)CvFLAGS(sv)); +#endif if (type == SVt_PVFM) +#ifdef IV_IS_QUAD + Perl_dump_indent(aTHX_ level, file, " LINES = %" PERL_PRId64 "\n", (IV)FmLINES(sv)); +#else Perl_dump_indent(aTHX_ level, file, " LINES = %ld\n", (long)FmLINES(sv)); +#endif +#ifdef IV_IS_QUAD + Perl_dump_indent(aTHX_ level, file, " PADLIST = 0x%" PERL_PRIx64 "\n", (IV)CvPADLIST(sv)); +#else Perl_dump_indent(aTHX_ level, file, " PADLIST = 0x%lx\n", (long)CvPADLIST(sv)); +#endif if (nest < maxnest && CvPADLIST(sv)) { AV* padlist = CvPADLIST(sv); AV* pad_name = (AV*)*av_fetch(padlist, 0, FALSE); @@ -1070,6 +1189,16 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo for (ix = 1; ix <= AvFILL(pad_name); ix++) { if (SvPOK(pname[ix])) +#ifdef IV_IS_QUAD + Perl_dump_indent(aTHX_ level, /* %5d below is enough whitespace. */ + file, + "%5d. 0x%" PERL_PRIx64 " (%s\"%s\" %" PERL_PRId64 "-%" PERL_PRId64 ")\n", + ix, ppad[ix], + SvFAKE(pname[ix]) ? "FAKE " : "", + SvPVX(pname[ix]), + (IV)SvNVX(pname[ix]), + (IV)SvIVX(pname[ix])); +#else Perl_dump_indent(aTHX_ level, /* %5d below is enough whitespace. */ file, "%5d. 0x%lx (%s\"%s\" %ld-%ld)\n", @@ -1078,10 +1207,20 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo SvPVX(pname[ix]), (long)I_32(SvNVX(pname[ix])), (long)SvIVX(pname[ix])); +#endif } } { CV *outside = CvOUTSIDE(sv); +#ifdef IV_IS_QUAD + Perl_dump_indent(aTHX_ level, file, " OUTSIDE = 0x%" PERL_PRIx64 " (%s)\n", + (IV)outside, + (!outside ? "null" + : CvANON(outside) ? "ANON" + : (outside == PL_main_cv) ? "MAIN" + : CvUNIQUE(outside) ? "UNIQUE" + : CvGV(outside) ? GvNAME(CvGV(outside)) : "UNDEFINED")); +#else Perl_dump_indent(aTHX_ level, file, " OUTSIDE = 0x%lx (%s)\n", (long)outside, (!outside ? "null" @@ -1089,14 +1228,32 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo : (outside == PL_main_cv) ? "MAIN" : CvUNIQUE(outside) ? "UNIQUE" : CvGV(outside) ? GvNAME(CvGV(outside)) : "UNDEFINED")); +#endif } if (nest < maxnest && (CvCLONE(sv) || CvCLONED(sv))) do_sv_dump(level+1, file, (SV*)CvOUTSIDE(sv), nest+1, maxnest, dumpops, pvlim); break; case SVt_PVGV: Perl_dump_indent(aTHX_ level, file, " NAME = \"%s\"\n", GvNAME(sv)); +#ifdef IV_IS_QUAD + Perl_dump_indent(aTHX_ level, file, " NAMELEN = %" PERL_PRId64 "\n", (IV)GvNAMELEN(sv)); +#else Perl_dump_indent(aTHX_ level, file, " NAMELEN = %ld\n", (long)GvNAMELEN(sv)); +#endif do_hv_dump (level, file, " GvSTASH", GvSTASH(sv)); +#ifdef IV_IS_QUAD + Perl_dump_indent(aTHX_ level, file, " GP = 0x%" PERL_PRIx64 "\n", (IV)GvGP(sv)); + Perl_dump_indent(aTHX_ level, file, " SV = 0x%" PERL_PRIx64 "\n", (IV)GvSV(sv)); + Perl_dump_indent(aTHX_ level, file, " REFCNT = %" PERL_PRId64 "\n", (IV)GvREFCNT(sv)); + Perl_dump_indent(aTHX_ level, file, " IO = 0x%" PERL_PRIx64 "\n", (IV)GvIOp(sv)); + Perl_dump_indent(aTHX_ level, file, " FORM = 0x%" PERL_PRIx64 " \n", (IV)GvFORM(sv)); + Perl_dump_indent(aTHX_ level, file, " AV = 0x%" PERL_PRIx64 "\n", (IV)GvAV(sv)); + Perl_dump_indent(aTHX_ level, file, " HV = 0x%" PERL_PRIx64 "\n", (IV)GvHV(sv)); + Perl_dump_indent(aTHX_ level, file, " CV = 0x%" PERL_PRIx64 "\n", (IV)GvCV(sv)); + Perl_dump_indent(aTHX_ level, file, " CVGEN = 0x%" PERL_PRIx64 "\n", (IV)GvCVGEN(sv)); + Perl_dump_indent(aTHX_ level, file, " LASTEXPR = %" PERL_PRId64 "\n", (IV)GvLASTEXPR(sv)); + Perl_dump_indent(aTHX_ level, file, " LINE = %" PERL_PRId64 "\n", (IV)GvLINE(sv)); +#else Perl_dump_indent(aTHX_ level, file, " GP = 0x%lx\n", (long)GvGP(sv)); Perl_dump_indent(aTHX_ level, file, " SV = 0x%lx\n", (long)GvSV(sv)); Perl_dump_indent(aTHX_ level, file, " REFCNT = %ld\n", (long)GvREFCNT(sv)); @@ -1108,11 +1265,21 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo Perl_dump_indent(aTHX_ level, file, " CVGEN = 0x%lx\n", (long)GvCVGEN(sv)); Perl_dump_indent(aTHX_ level, file, " LASTEXPR = %ld\n", (long)GvLASTEXPR(sv)); Perl_dump_indent(aTHX_ level, file, " LINE = %ld\n", (long)GvLINE(sv)); +#endif Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%x\n", (int)GvFLAGS(sv)); do_gv_dump (level, file, " FILEGV", GvFILEGV(sv)); do_gv_dump (level, file, " EGV", GvEGV(sv)); break; case SVt_PVIO: +#ifdef IV_IS_QUAD + Perl_dump_indent(aTHX_ level, file, " IFP = 0x%" PERL_PRIx64 "\n", (IV)IoIFP(sv)); + Perl_dump_indent(aTHX_ level, file, " OFP = 0x%" PERL_PRIx64 "\n", (IV)IoOFP(sv)); + Perl_dump_indent(aTHX_ level, file, " DIRP = 0x%" PERL_PRIx64 "\n", (IV)IoDIRP(sv)); + Perl_dump_indent(aTHX_ level, file, " LINES = %" PERL_PRId64 "\n", (IV)IoLINES(sv)); + Perl_dump_indent(aTHX_ level, file, " PAGE = %" PERL_PRId64 "\n", (IV)IoPAGE(sv)); + Perl_dump_indent(aTHX_ level, file, " PAGE_LEN = %" PERL_PRId64 "\n", (IV)IoPAGE_LEN(sv)); + Perl_dump_indent(aTHX_ level, file, " LINES_LEFT = %" PERL_PRId64 "\n", (IV)IoLINES_LEFT(sv)); +#else Perl_dump_indent(aTHX_ level, file, " IFP = 0x%lx\n", (long)IoIFP(sv)); Perl_dump_indent(aTHX_ level, file, " OFP = 0x%lx\n", (long)IoOFP(sv)); Perl_dump_indent(aTHX_ level, file, " DIRP = 0x%lx\n", (long)IoDIRP(sv)); @@ -1120,6 +1287,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo Perl_dump_indent(aTHX_ level, file, " PAGE = %ld\n", (long)IoPAGE(sv)); Perl_dump_indent(aTHX_ level, file, " PAGE_LEN = %ld\n", (long)IoPAGE_LEN(sv)); Perl_dump_indent(aTHX_ level, file, " LINES_LEFT = %ld\n", (long)IoLINES_LEFT(sv)); +#endif if (IoTOP_NAME(sv)) Perl_dump_indent(aTHX_ level, file, " TOP_NAME = \"%s\"\n", IoTOP_NAME(sv)); do_gv_dump (level, file, " TOP_GV", IoTOP_GV(sv)); @@ -1129,12 +1297,20 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo if (IoBOTTOM_NAME(sv)) Perl_dump_indent(aTHX_ level, file, " BOTTOM_NAME = \"%s\"\n", IoBOTTOM_NAME(sv)); do_gv_dump (level, file, " BOTTOM_GV", IoBOTTOM_GV(sv)); +#ifdef IV_IS_QUAD + Perl_dump_indent(aTHX_ level, file, " SUBPROCESS = %" PERL_PRId64 "\n", (IV)IoSUBPROCESS(sv)); +#else Perl_dump_indent(aTHX_ level, file, " SUBPROCESS = %ld\n", (long)IoSUBPROCESS(sv)); +#endif if (isPRINT(IoTYPE(sv))) Perl_dump_indent(aTHX_ level, file, " TYPE = '%c'\n", IoTYPE(sv)); else Perl_dump_indent(aTHX_ level, file, " TYPE = '\\%o'\n", IoTYPE(sv)); +#ifdef IV_IS_QUAD + Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%" PERL_PRIx64 "\n", (IV)IoFLAGS(sv)); +#else Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%lx\n", (long)IoFLAGS(sv)); +#endif break; } } diff --git a/mg.c b/mg.c index 695272d..9127137 100644 --- a/mg.c +++ b/mg.c @@ -1878,7 +1878,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) while (isSPACE(*p)) ++p; - PL_egid = I_V(atol(p)); + PL_egid = I_V(Atol(p)); for (i = 0; i < NGROUPS; ++i) { while (*p && !isSPACE(*p)) ++p; @@ -1886,7 +1886,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) ++p; if (!*p) break; - gary[i] = I_V(atol(p)); + gary[i] = I_V(Atol(p)); } if (i) (void)setgroups(i, gary); diff --git a/op.c b/op.c index 8b47448..d5a343d 100644 --- a/op.c +++ b/op.c @@ -4799,9 +4799,15 @@ Perl_ck_fun(pTHX_ OP *o) OP *newop = newAVREF(newGVOP(OP_GV, 0, gv_fetchpv(name, TRUE, SVt_PVAV) )); if (ckWARN(WARN_SYNTAX)) +#ifdef IV_IS_QUAD + Perl_warner(aTHX_ WARN_SYNTAX, + "Array @%s missing the @ in argument %" PERL_PRId64 " of %s()", + name, (IV)numargs, PL_op_desc[type]); +#else Perl_warner(aTHX_ WARN_SYNTAX, "Array @%s missing the @ in argument %ld of %s()", name, (long)numargs, PL_op_desc[type]); +#endif op_free(kid); kid = newop; kid->op_sibling = sibl; @@ -4819,9 +4825,15 @@ Perl_ck_fun(pTHX_ OP *o) OP *newop = newHVREF(newGVOP(OP_GV, 0, gv_fetchpv(name, TRUE, SVt_PVHV) )); if (ckWARN(WARN_SYNTAX)) +#ifdef IV_IS_QUAD + Perl_warner(aTHX_ WARN_SYNTAX, + "Hash %%%s missing the %% in argument %" PERL_PRId64 " of %s()", + name, (IV)numargs, PL_op_desc[type]); +#else Perl_warner(aTHX_ WARN_SYNTAX, "Hash %%%s missing the %% in argument %ld of %s()", name, (long)numargs, PL_op_desc[type]); +#endif op_free(kid); kid = newop; kid->op_sibling = sibl; diff --git a/perl.h b/perl.h index 8928ffd..1e4b2e0 100644 --- a/perl.h +++ b/perl.h @@ -1024,6 +1024,8 @@ Free_t Perl_mfree (Malloc_t where); # endif # define IV_SIZEOF 8 # define UV_SIZEOF 8 +# define IV_IS_QUAD +# define UV_IS_QUAD #else typedef long IV; typedef unsigned long UV; @@ -1040,6 +1042,13 @@ Free_t Perl_mfree (Malloc_t where); # endif # define UV_SIZEOF LONGSIZE # define IV_SIZEOF LONGSIZE +# if LONGSIZE == 8 +# define IV_IS_QUAD +# define UV_IS_QUAD +# else +# undef IV_IS_QUAD +# undef UV_IS_QUAD +# endif #endif #ifdef USE_LONG_DOUBLE @@ -1061,7 +1070,6 @@ Free_t Perl_mfree (Malloc_t where); # define Perl_atan2 atan2l # define Perl_pow powl # define Perl_floor floorl -# define Perl_atof atof # define Perl_fmod fmodl #else typedef double NV; @@ -1075,10 +1083,15 @@ Free_t Perl_mfree (Malloc_t where); # define Perl_atan2 atan2 # define Perl_pow pow # define Perl_floor floor -# define Perl_atof atof /* At some point there may be an atolf */ # define Perl_fmod fmod #endif +#if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) && defined(HAS_ATOLF) +# define Perl_atof atolf +#else +# define Perl_atof atof +#endif + /* Previously these definitions used hardcoded figures. * It is hoped these formula are more portable, although * no data one way or another is presently known to me. @@ -2978,6 +2991,18 @@ typedef struct am_table_short AMTS; #endif /* !USE_LOCALE_NUMERIC */ +#if defined(USE_LONG_LONG) && defined(HAS_LONG_LONG) && defined(HAS_ATOLL) +#define Atol atoll +#else +#define Atol atol +#endif + +#if defined(USE_LONG_LONG) && defined(HAS_LONG_LONG) && defined(HAS_STRTOULL) +#define Strtoul strtoull +#else +#define Strtoul strtoul +#endif + #if !defined(PERLIO_IS_STDIO) && defined(HASATTRIBUTE) /* * Now we have __attribute__ out of the way diff --git a/pp_ctl.c b/pp_ctl.c index 9514168..d88399e 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -588,10 +588,10 @@ PP(pp_formline) RESTORE_NUMERIC_LOCAL(); #if defined(USE_LONG_DOUBLE) if (arg & 256) { - sprintf(t, "%#*.*Lf", + sprintf(t, "%#*.*" PERL_PRIfldbl, (int) fieldsize, (int) arg & 255, value); } else { - sprintf(t, "%*.0Lf", (int) fieldsize, value); + sprintf(t, "%*.0" PERL_PRIfldbl, (int) fieldsize, value); } #else if (arg & 256) { diff --git a/pp_hot.c b/pp_hot.c index 1956d76..c5df5e0 100644 --- a/pp_hot.c +++ b/pp_hot.c @@ -589,8 +589,13 @@ PP(pp_rv2hv) if (SvTYPE(hv) == SVt_PVAV) hv = avhv_keys((AV*)hv); if (HvFILL(hv)) - Perl_sv_setpvf(aTHX_ TARG, "%ld/%ld", - (long)HvFILL(hv), (long)HvMAX(hv) + 1); +#ifdef IV_IS_QUAD + Perl_sv_setpvf(aTHX_ TARG, "%" PERL_PRId64 "/%" PERL_PRId64, + (Quad_t)HvFILL(hv), (Quad_t)HvMAX(hv) + 1); +#else + Perl_sv_setpvf(aTHX_ TARG, "%ld/%ld", + (long)HvFILL(hv), (long)HvMAX(hv) + 1); +#endif else sv_setiv(TARG, 0); diff --git a/pp_sys.c b/pp_sys.c index 5b421db..82dfa36 100644 --- a/pp_sys.c +++ b/pp_sys.c @@ -817,9 +817,15 @@ PP(pp_untie) MAGIC * mg ; if (mg = SvTIED_mg(sv, how)) { if (mg && SvREFCNT(SvRV(mg->mg_obj)) > 1) +#ifdef IV_IS_QUAD + Perl_warner(aTHX_ WARN_UNTIE, + "untie attempted while %" PERL_PRIu64 " inner references still exist", + (UV)SvREFCNT(SvRV(mg->mg_obj)) - 1 ) ; +#else Perl_warner(aTHX_ WARN_UNTIE, "untie attempted while %lu inner references still exist", (unsigned long)SvREFCNT(SvRV(mg->mg_obj)) - 1 ) ; +#endif } } diff --git a/sv.c b/sv.c index 4bdf847..ef46563 100644 --- a/sv.c +++ b/sv.c @@ -1068,7 +1068,7 @@ S_not_a_number(pTHX_ SV *sv) Perl_warner(aTHX_ WARN_NUMERIC, "Argument \"%s\" isn't numeric", tmpbuf); } -/* the number can be converted to _integer_ with atol() */ +/* the number can be converted to integer with atol() or atoll() */ #define IS_NUMBER_TO_INT_BY_ATOL 0x01 #define IS_NUMBER_TO_INT_BY_ATOF 0x02 /* atol() may be != atof() */ #define IS_NUMBER_NOT_IV 0x04 /* (IV)atof() may be != atof() */ @@ -1125,7 +1125,7 @@ Perl_sv_2iv(pTHX_ register SV *sv) if (SvNOKp(sv)) { /* We can cache the IV/UV value even if it not good enough * to reconstruct NV, since the conversion to PV will prefer - * NV over IV/UV. XXXX 64-bit? + * NV over IV/UV. */ if (SvTYPE(sv) == SVt_NV) @@ -1138,10 +1138,17 @@ Perl_sv_2iv(pTHX_ register SV *sv) SvUVX(sv) = U_V(SvNVX(sv)); SvIsUV_on(sv); ret_iv_max: +#ifdef IV_IS_QUAD + DEBUG_c(PerlIO_printf(Perl_debug_log, + "0x%" PERL_PRIx64 " 2iv(%" PERL_PRIu64 " => %" PERL_PRId64 ") (as unsigned)\n", + (UV)sv, + (UV)SvUVX(sv), (IV)SvUVX(sv))); +#else DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%lx 2iv(%lu => %ld) (as unsigned)\n", (unsigned long)sv, (unsigned long)SvUVX(sv), (long)(IV)SvUVX(sv))); +#endif return (IV)SvUVX(sv); } } @@ -1169,7 +1176,7 @@ Perl_sv_2iv(pTHX_ register SV *sv) (void)SvNOK_on(sv); (void)SvIOK_on(sv); #if defined(USE_LONG_DOUBLE) - DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%lx 2nv(%Lg)\n", + DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%lx 2nv(%" PERL_PRIgldbl ")\n", (unsigned long)sv, SvNVX(sv))); #else DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%lx 2nv(%g)\n", @@ -1189,7 +1196,7 @@ Perl_sv_2iv(pTHX_ register SV *sv) if (SvTYPE(sv) == SVt_PV) sv_upgrade(sv, SVt_PVIV); (void)SvIOK_on(sv); - SvIVX(sv) = atol(SvPVX(sv)); /* XXXX 64-bit? */ + SvIVX(sv) = Atol(SvPVX(sv)); } else { /* Not a number. Cache 0. */ dTHR; @@ -1263,7 +1270,7 @@ Perl_sv_2uv(pTHX_ register SV *sv) if (SvNOKp(sv)) { /* We can cache the IV/UV value even if it not good enough * to reconstruct NV, since the conversion to PV will prefer - * NV over IV/UV. XXXX 64-bit? + * NV over IV/UV. */ if (SvTYPE(sv) == SVt_NV) sv_upgrade(sv, SVt_PVNV); @@ -1275,10 +1282,17 @@ Perl_sv_2uv(pTHX_ register SV *sv) else { SvIVX(sv) = I_V(SvNVX(sv)); ret_zero: +#ifdef IV_IS_QUAD + DEBUG_c(PerlIO_printf(Perl_debug_log, + "0x%" PERL_PRIx64 " 2uv(%" PERL_PRId64 " => %" PERL_PRIu64 ") (as signed)\n", + (unsigned long)sv,(long)SvIVX(sv), + (long)(UV)SvIVX(sv))); +#else DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%lx 2uv(%ld => %lu) (as signed)\n", (unsigned long)sv,(long)SvIVX(sv), (long)(UV)SvIVX(sv))); +#endif return (UV)SvIVX(sv); } } @@ -1298,7 +1312,7 @@ Perl_sv_2uv(pTHX_ register SV *sv) * - otherwise future conversion to NV will be wrong. */ NV d; - d = Atof(SvPVX(sv)); /* XXXX 64-bit? */ + d = Atof(SvPVX(sv)); if (SvTYPE(sv) < SVt_PVNV) sv_upgrade(sv, SVt_PVNV); @@ -1306,7 +1320,7 @@ Perl_sv_2uv(pTHX_ register SV *sv) (void)SvNOK_on(sv); (void)SvIOK_on(sv); #if defined(USE_LONG_DOUBLE) - DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%lx 2nv(%Lg)\n", + DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%lx 2nv(%" PERL_PRIg64 ")\n", (unsigned long)sv, SvNVX(sv))); #else DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%lx 2nv(%g)\n", @@ -1326,7 +1340,7 @@ Perl_sv_2uv(pTHX_ register SV *sv) if (SvTYPE(sv) == SVt_PV) sv_upgrade(sv, SVt_PVIV); (void)SvIOK_on(sv); - SvIVX(sv) = (IV)atol(SvPVX(sv)); /* XXXX 64-bit? */ + SvIVX(sv) = (IV)Atol(SvPVX(sv)); } else if (numtype) { /* Non-negative */ /* The NV may be reconstructed from UV - safe to cache UV, @@ -1336,10 +1350,10 @@ Perl_sv_2uv(pTHX_ register SV *sv) (void)SvIOK_on(sv); (void)SvIsUV_on(sv); #ifdef HAS_STRTOUL - SvUVX(sv) = strtoul(SvPVX(sv), Null(char**), 10); /* XXXX 64-bit? */ + SvUVX(sv) = Strtoul(SvPVX(sv), Null(char**), 10); #else /* no atou(), but we know the number fits into IV... */ /* The only problem may be if it is negative... */ - SvUVX(sv) = (UV)atol(SvPVX(sv)); /* XXXX 64-bit? */ + SvUVX(sv) = (UV)Atol(SvPVX(sv)); #endif } else { /* Not a number. Cache 0. */ @@ -1424,7 +1438,7 @@ Perl_sv_2nv(pTHX_ register SV *sv) #if defined(USE_LONG_DOUBLE) DEBUG_c({ RESTORE_NUMERIC_STANDARD(); - PerlIO_printf(Perl_debug_log, "0x%lx num(%Lg)\n", + PerlIO_printf(Perl_debug_log, "0x%lx num(%" PERL_PRIg64 ")\n", (unsigned long)sv, SvNVX(sv)); RESTORE_NUMERIC_LOCAL(); }); @@ -1463,7 +1477,7 @@ Perl_sv_2nv(pTHX_ register SV *sv) #if defined(USE_LONG_DOUBLE) DEBUG_c({ RESTORE_NUMERIC_STANDARD(); - PerlIO_printf(Perl_debug_log, "0x%lx 2nv(%Lg)\n", + PerlIO_printf(Perl_debug_log, "0x%lx 2nv(%" PERL_PRIg64 ")\n", (unsigned long)sv, SvNVX(sv)); RESTORE_NUMERIC_LOCAL(); }); @@ -1485,7 +1499,7 @@ S_asIV(pTHX_ SV *sv) NV d; if (numtype & IS_NUMBER_TO_INT_BY_ATOL) - return atol(SvPVX(sv)); /* XXXX 64-bit? */ + return Atol(SvPVX(sv)); if (!numtype) { dTHR; if (ckWARN(WARN_NUMERIC)) @@ -1502,7 +1516,7 @@ S_asUV(pTHX_ SV *sv) #ifdef HAS_STRTOUL if (numtype & IS_NUMBER_TO_INT_BY_ATOL) - return strtoul(SvPVX(sv), Null(char**), 10); + return Strtoul(SvPVX(sv), Null(char**), 10); #endif if (!numtype) { dTHR; @@ -1528,8 +1542,6 @@ S_asUV(pTHX_ SV *sv) I32 Perl_looks_like_number(pTHX_ SV *sv) { - /* XXXX 64-bit? It may be not IS_NUMBER_TO_INT_BY_ATOL, but - * using atof() may lose precision. */ register char *s; register char *send; register char *sbegin; @@ -1683,11 +1695,18 @@ Perl_sv_2pv(pTHX_ register SV *sv, STRLEN *lp) *lp = SvCUR(sv); return SvPVX(sv); } - if (SvIOKp(sv)) { /* XXXX 64-bit? */ + if (SvIOKp(sv)) { +#ifdef IV_IS_QUAD + if (SvIsUV(sv)) + (void)sprintf(tmpbuf,"%" PERL_PRIu64,(UV)SvUVX(sv)); + else + (void)sprintf(tmpbuf,"%" PERL_PRId64,(IV)SvIVX(sv)); +#else if (SvIsUV(sv)) (void)sprintf(tmpbuf,"%lu",(unsigned long)SvUVX(sv)); else (void)sprintf(tmpbuf,"%ld",(long)SvIVX(sv)); +#endif tsv = Nullsv; goto tokensave; } @@ -1785,8 +1804,11 @@ Perl_sv_2pv(pTHX_ register SV *sv, STRLEN *lp) Perl_sv_setpvf(aTHX_ tsv, "%s=%s", HvNAME(SvSTASH(sv)), s); else sv_setpv(tsv, s); - /* XXXX 64-bit? */ +#ifdef IV_IS_QUAD + Perl_sv_catpvf(aTHX_ tsv, "(0x%" PERL_PRIx64")", (UV)sv); +#else Perl_sv_catpvf(aTHX_ tsv, "(0x%lx)", (unsigned long)sv); +#endif goto tokensaveref; } *lp = strlen(s); @@ -4803,15 +4825,20 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV switch (*q) { case 'l': -#if 0 /* when quads have better support within Perl */ - if (*(q + 1) == 'l') { +#ifdef HAS_QUAD + if (*(q + 1) == 'l') { /* lld */ intsize = 'q'; q += 2; break; - } + } + case 'L': /* Ld */ + case 'q': /* qd */ + intsize = 'q'; + q++; + break; #endif - /* FALL THROUGH */ case 'h': + /* FALL THROUGH */ case 'V': intsize = *q++; break; @@ -4908,6 +4935,9 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV default: iv = va_arg(*args, int); break; case 'l': iv = va_arg(*args, long); break; case 'V': iv = va_arg(*args, IV); break; +#ifdef HAS_QUAD + case 'q': iv = va_arg(*args, Quad_t); break; +#endif } } else { @@ -4917,6 +4947,9 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV default: iv = (int)iv; break; case 'l': iv = (long)iv; break; case 'V': break; +#ifdef HAS_QUAD + case 'q': iv = (Quad_t)iv; break; +#endif } } if (iv >= 0) { @@ -4960,6 +4993,9 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV default: uv = va_arg(*args, unsigned); break; case 'l': uv = va_arg(*args, unsigned long); break; case 'V': uv = va_arg(*args, UV); break; +#ifdef HAS_QUAD + case 'q': uv = va_arg(*args, Quad_t); break; +#endif } } else { @@ -4969,6 +5005,9 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV default: uv = (unsigned)uv; break; case 'l': uv = (unsigned long)uv; break; case 'V': break; +#ifdef HAS_QUAD + case 'q': uv = (Quad_t)uv; break; +#endif } } @@ -5061,7 +5100,10 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV *--eptr = '\0'; *--eptr = c; #ifdef USE_LONG_DOUBLE - *--eptr = 'L'; + { + char* p = PRIfldbl + sizeof(PRIfldbl) - 3; + while (p >= PRIfldbl) { *--eptr = *p-- } + } #endif if (has_precis) { base = precis; @@ -5113,6 +5155,9 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV default: *(va_arg(*args, int*)) = i; break; case 'l': *(va_arg(*args, long*)) = i; break; case 'V': *(va_arg(*args, IV*)) = i; break; +#ifdef HAS_QUAD + case 'q': *(va_arg(*args, Quad_t*)) = i; break; +#endif } } else if (svix < svmax) diff --git a/t/pragma/warn/sv b/t/pragma/warn/sv index 0421192..b6c91c9 100644 --- a/t/pragma/warn/sv +++ b/t/pragma/warn/sv @@ -235,24 +235,24 @@ Subroutine fred redefined at - line 5. # sv.c use warning 'printf' ; open F, ">".($^O eq 'VMS'? 'NL:' : '/dev/null') ; -printf F "%q\n" ; -my $a = sprintf "%q" ; +printf F "%z\n" ; +my $a = sprintf "%z" ; printf F "%" ; $a = sprintf "%" ; printf F "%\x02" ; $a = sprintf "%\x02" ; no warning 'printf' ; -printf F "%q\n" ; -$a = sprintf "%q" ; +printf F "%z\n" ; +$a = sprintf "%z" ; printf F "%" ; $a = sprintf "%" ; printf F "%\x02" ; $a = sprintf "%\x02" ; EXPECT -Invalid conversion in sprintf: "%q" at - line 5. +Invalid conversion in sprintf: "%z" at - line 5. Invalid conversion in sprintf: end of string at - line 7. Invalid conversion in sprintf: "%\002" at - line 9. -Invalid conversion in printf: "%q" at - line 4. +Invalid conversion in printf: "%z" at - line 4. Invalid conversion in printf: end of string at - line 6. Invalid conversion in printf: "%\002" at - line 8. ######## diff --git a/toke.c b/toke.c index c4521c5..64485ac 100644 --- a/toke.c +++ b/toke.c @@ -3562,8 +3562,13 @@ Perl_yylex(pTHX) TERM(THING); case KEY___LINE__: - yylval.opval = (OP*)newSVOP(OP_CONST, 0, - Perl_newSVpvf(aTHX_ "%ld", (long)PL_curcop->cop_line)); +#ifdef IV_IS_QUAD + yylval.opval = (OP*)newSVOP(OP_CONST, 0, + Perl_newSVpvf(aTHX_ "%" PERL_PRId64, (IV)PL_curcop->cop_line)); +#else + yylval.opval = (OP*)newSVOP(OP_CONST, 0, + Perl_newSVpvf(aTHX_ "%ld", (long)PL_curcop->cop_line)); +#endif TERM(THING); case KEY___PACKAGE__: @@ -6745,16 +6750,28 @@ Perl_yyerror(pTHX_ char *s) where = SvPVX(where_sv); } msg = sv_2mortal(newSVpv(s, 0)); +#ifdef IV_IS_QUAD + Perl_sv_catpvf(aTHX_ msg, " at %_ line %" PERL_PRId64 ", ", + GvSV(PL_curcop->cop_filegv), (IV)PL_curcop->cop_line); +#else Perl_sv_catpvf(aTHX_ msg, " at %_ line %ld, ", - GvSV(PL_curcop->cop_filegv), (long)PL_curcop->cop_line); + GvSV(PL_curcop->cop_filegv), (long)PL_curcop->cop_line); +#endif if (context) Perl_sv_catpvf(aTHX_ msg, "near \"%.*s\"\n", contlen, context); else Perl_sv_catpvf(aTHX_ msg, "%s\n", where); if (PL_multi_start < PL_multi_end && (U32)(PL_curcop->cop_line - PL_multi_end) <= 1) { - Perl_sv_catpvf(aTHX_ msg, - " (Might be a runaway multi-line %c%c string starting on line %ld)\n", - (int)PL_multi_open,(int)PL_multi_close,(long)PL_multi_start); +#ifdef IV_IS_QUAD + Perl_sv_catpvf(aTHX_ msg, + " (Might be a runaway multi-line %c%c string starting on line %" PERL_\ +PRId64 ")\n", + (int)PL_multi_open,(int)PL_multi_close,(IV)PL_multi_start); +#else + Perl_sv_catpvf(aTHX_ msg, + " (Might be a runaway multi-line %c%c string starting on line %ld)\n", + (int)PL_multi_open,(int)PL_multi_close,(long)PL_multi_start); +#endif PL_multi_end = 0; } if (PL_in_eval & EVAL_WARNONLY) diff --git a/util.c b/util.c index 918f37b..45d6a6f 100644 --- a/util.c +++ b/util.c @@ -1406,15 +1406,27 @@ Perl_mess(pTHX_ const char *pat, va_list *args) if (!SvCUR(sv) || *(SvEND(sv) - 1) != '\n') { dTHR; if (PL_curcop->cop_line) +#ifdef IV_IS_QUAD + Perl_sv_catpvf(aTHX_ sv, " at %_ line %" PERL_PRId64, + GvSV(PL_curcop->cop_filegv), (IV)PL_curcop->cop_line); +#else Perl_sv_catpvf(aTHX_ sv, " at %_ line %ld", GvSV(PL_curcop->cop_filegv), (long)PL_curcop->cop_line); +#endif if (GvIO(PL_last_in_gv) && IoLINES(GvIOp(PL_last_in_gv))) { bool line_mode = (RsSIMPLE(PL_rs) && SvCUR(PL_rs) == 1 && *SvPVX(PL_rs) == '\n'); +#ifdef IV_IS_QUAD + Perl_sv_catpvf(aTHX_ sv, ", <%s> %s %" PERL_PRId64, + PL_last_in_gv == PL_argvgv ? "" : GvNAME(PL_last_in_gv), + line_mode ? "line" : "chunk", + (IV)IoLINES(GvIOp(PL_last_in_gv))); +#else Perl_sv_catpvf(aTHX_ sv, ", <%s> %s %ld", PL_last_in_gv == PL_argvgv ? "" : GvNAME(PL_last_in_gv), line_mode ? "line" : "chunk", (long)IoLINES(GvIOp(PL_last_in_gv))); +#endif } #ifdef USE_THREADS if (thr->tid)