From: Jarkko Hietaniemi Date: Mon, 16 Aug 1999 18:55:35 +0000 (+0000) Subject: Batch of small 64-bit/long double/large file support tweaks: X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=2d4389e49f01a9fd18e4d854b4d31048551328b6;p=p5sagit%2Fp5-mst-13.2.git Batch of small 64-bit/long double/large file support tweaks: - scan for LDBL_DIG - from DBL_DIG and LDBL_DIG select NV_DIG - introduce IVSIZE, UVSIZE, NVSIZE - introduce IV_DIG - remove stdio64 - AIX uses `oslevel` when others use `uname -r` - already AIX 4.2 goes 64-bit - in HP-UX require the 64-bit libc, just the directory isn't enough - group ids are not NVs - #undef USE_LONG_DOUBLE if long double is no better than double - introduce NV_WITHIN_*() and IV_FITS_IN_IV - mention large file support in perldelta - introduce quad TOPpin' and POPpin' - the svcat... buffer was tiny for printing quads in %b - fix the multiplication test in 64bit.t - try to make VMS to comply with all this removal and "introducal" of symbols p4raw-id: //depot/cfgperl@3995 --- diff --git a/Configure b/Configure index 59d1116..94ea77a 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 Sat Aug 14 02:03:17 EET DST 1999 [metaconfig 3.0 PL70] +# Generated on Mon Aug 16 19:31:58 EET DST 1999 [metaconfig 3.0 PL70] # (with additional metaconfig patches by perlbug@perl.com) cat >/tmp/c1$$ <&4 +echo $n "Checking to see if your system supports long double...$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" @@ -8515,52 +8507,6 @@ eval $inlibc set fsetpos d_fsetpos eval $inlibc - -if $test X"$use64bits" = X"$define"; then - : see if fgetpos64 exists - set fgetpos64 d_fgetpos64 - eval $inlibc - - : see if fopen64 exists - set freopen64 d_fopen64 - eval $inlibc - - : see if freopen64 exists - set freopen64 d_freopen64 - eval $inlibc - - : see if fseek64 exists - set fseek64 d_fseek64 - eval $inlibc - - : see if fseeko64 exists - set fseeko64 d_fseeko64 - eval $inlibc - - : see if fsetpos64 exists - set fsetpos64 d_fsetpos64 - eval $inlibc - - : see if ftell64 exists - set ftell64 d_ftell64 - eval $inlibc - - : see if ftello64 exists - set ftello64 d_ftello64 - eval $inlibc - - : see if tmpfile64 exists - set tmpfile64 d_tmpfile64 - eval $inlibc -else - val="$undef" - for xxx in d_fgetpos64 d_fopen64 d_freopen64 d_fseek64 d_fseeko64 d_fsetpos64 d_ftell64 d_ftello64 d_tmpfile64 - do - set $xxx - eval $setvar - done -fi - : see if this is a sys/param system set sys/param.h i_sysparam eval $inhdr @@ -9009,6 +8955,33 @@ fi set d_lchown eval $setvar +: See if number of significant digits in a double precision number is known +echo " " +$cat >ldbl_dig.c < +#endif +#ifdef I_FLOAT +#include +#endif +#ifdef LDBL_DIG +printf("Contains LDBL_DIG"); +#endif +EOM +$cppstdin $cppflags $cppminus < ldbl_dig.c >ldbl_dig.E 2>/dev/null +if $contains 'LDBL_DIG' ldbl_dig.E >/dev/null 2>&1; then + echo "LDBL_DIG found." >&4 + val="$define" +else + echo "LDBL_DIG NOT found." >&4 + val="$undef" +fi +$rm -f ldbl_dig.? +set d_ldbl_dig +eval $setvar + : see if link exists set link d_link eval $inlibc @@ -13387,24 +13360,16 @@ d_fcntl='$d_fcntl' d_fd_macros='$d_fd_macros' d_fd_set='$d_fd_set' d_fds_bits='$d_fds_bits' -d_fgetpos64='$d_fgetpos64' d_fgetpos='$d_fgetpos' d_flexfnam='$d_flexfnam' d_flock='$d_flock' -d_fopen64='$d_fopen64' d_fork='$d_fork' d_fpathconf='$d_fpathconf' d_fpos64_t='$d_fpos64_t' -d_freopen64='$d_freopen64' -d_fseek64='$d_fseek64' -d_fseeko64='$d_fseeko64' d_fseeko='$d_fseeko' -d_fsetpos64='$d_fsetpos64' d_fsetpos='$d_fsetpos' d_fstatfs='$d_fstatfs' d_fstatvfs='$d_fstatvfs' -d_ftell64='$d_ftell64' -d_ftello64='$d_ftello64' d_ftello='$d_ftello' d_ftime='$d_ftime' d_getgrent='$d_getgrent' @@ -13448,6 +13413,7 @@ d_iovec_s='$d_iovec_s' d_isascii='$d_isascii' d_killpg='$d_killpg' d_lchown='$d_lchown' +d_ldbl_dig='$d_ldbl_dig' d_link='$d_link' d_llseek='$d_llseek' d_locconv='$d_locconv' @@ -13592,7 +13558,6 @@ d_telldir='$d_telldir' d_telldirproto='$d_telldirproto' d_time='$d_time' d_times='$d_times' -d_tmpfile64='$d_tmpfile64' d_truncate='$d_truncate' d_tzname='$d_tzname' d_umask='$d_umask' diff --git a/config_h.SH b/config_h.SH index 2edfb03..e38e455 100644 --- a/config_h.SH +++ b/config_h.SH @@ -2213,6 +2213,14 @@ sed <config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ #$d_hasmntopt HAS_HASMNTOPT /**/ +/* HAS_LDBL_DIG: + * This symbol, if defined, indicates that this system's + * or defines the symbol LDBL_DIG, which is the number + * of significant digits in a long double precision number. Unlike + * for DBL_DIG, there's no good guess for LDBL_DIG if it is undefined. + */ +#$d_ldbl_dig HAS_LDBL_DIG /* */ + /* HAS_MADVISE: * This symbol, if defined, indicates that the madvise system call is * available to map a file into memory. @@ -2428,12 +2436,6 @@ sed <config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ #define STARTPERL "$startperl" /**/ -/* HAS_FSETPOS64: - * This symbol, if defined, indicates that the fsetpos64 routine is - * available to setpos files larger than 2 gigabytes. - */ -#$d_fsetpos64 HAS_FSETPOS64 /**/ - /* HAS_STDIO_STREAM_ARRAY: * This symbol, if defined, tells that there is an array * holding the stdio streams. diff --git a/dump.c b/dump.c index 8735db3..ac6a07e 100644 --- a/dump.c +++ b/dump.c @@ -17,10 +17,6 @@ #include "perl.h" #include "regcomp.h" -#ifndef DBL_DIG -#define DBL_DIG 15 /* A guess that works lots of places */ -#endif - void Perl_dump_indent(pTHX_ I32 level, PerlIO *file, const char* pat, ...) { @@ -923,7 +919,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo 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)); + Perl_dump_indent(aTHX_ level, file, " NV = %.*" PERL_PRIgldbl "\n", LDBL_DIG, SvNVX(sv)); #else Perl_dump_indent(aTHX_ level, file, " NV = %.*g\n", DBL_DIG, SvNVX(sv)); #endif diff --git a/hints/aix.sh b/hints/aix.sh index 0bf75ad..5a027b3 100644 --- a/hints/aix.sh +++ b/hints/aix.sh @@ -174,11 +174,11 @@ EOCBU cat > UU/use64bits.cbu <<'EOCBU' case "$use64bits" in $define|true|[yY]*) - case "`uname -r`" in + case "`oslevel`" in 3.*|4.[012].*) cat >&4 <& "AIX $ldflags mystery" ; exit 1 # Just don't ask me how AIX does it. - # Therefore the line re-evaluating ldflags: it seems to drop the whatever - # AIX managed to break. --jhi + # Therefore the line re-evaluating ldflags: it seems to bypass + # the whatever it was AIX managed to break. --jhi ldflags="`echo $ldflags`" - libswanted="$libswanted `getconf XBS5_LPBIG_OFFBIG_LIBS 2>/dev/null|sed -e 's@^-l@@' -e 's@ -l@ @g'`" + libswanted="$libswanted `getconf XBS5_ILP32_OFFBIG_LIBS 2>/dev/null|sed -e 's@^-l@@' -e 's@ -l@ @g'`" # When a 64-bit cc becomes available $archname64 # may need setting so that $archname gets it attached. ;; @@ -205,7 +207,7 @@ esac EOCBU # This script UU/uselongdouble.cbu will get 'called-back' by Configure -# after it has prompted the user for whether to use 64 bits. +# after it has prompted the user for whether to use long doubles. cat > UU/uselongdouble.cbu <<'EOCBU' case "$uselongdouble" in $define|true|[yY]*) diff --git a/hints/hpux.sh b/hints/hpux.sh index 13b09cf..eb9b685 100644 --- a/hints/hpux.sh +++ b/hints/hpux.sh @@ -268,9 +268,10 @@ Cannot continue, aborting. EOM exit 1 fi - if [ ! -d /lib/pa20_64 ]; then + if [ ! -f /lib/pa20_64/libc.sl ]; then cat <&4 -You do not seem to have the 64-bit libraries, /lib/pa20_64. +You do not seem to have the 64-bit libraries in /lib/pa20_64. +Most importantly, I cannot find /lib/pa20_64/libc.sl. Cannot continue, aborting. EOM exit 1 diff --git a/mg.c b/mg.c index 6418b27..fea5fcf 100644 --- a/mg.c +++ b/mg.c @@ -1884,7 +1884,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) while (isSPACE(*p)) ++p; - PL_egid = I_V(Atol(p)); + PL_egid = Atol(p); for (i = 0; i < NGROUPS; ++i) { while (*p && !isSPACE(*p)) ++p; @@ -1892,7 +1892,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) ++p; if (!*p) break; - gary[i] = I_V(Atol(p)); + gary[i] = Atol(p); } if (i) (void)setgroups(i, gary); diff --git a/perl.h b/perl.h index 5a1c84a..569198e 100644 --- a/perl.h +++ b/perl.h @@ -1027,8 +1027,8 @@ Free_t Perl_mfree (Malloc_t where); # define UV_MAX PERL_UQUAD_MAX # define UV_MIN PERL_UQUAD_MIN # endif -# define IV_SIZEOF 8 -# define UV_SIZEOF 8 +# define IVSIZF 8 +# define UVSIZE 8 # define IV_IS_QUAD # define UV_IS_QUAD #else @@ -1045,8 +1045,6 @@ Free_t Perl_mfree (Malloc_t where); # define UV_MAX PERL_ULONG_MAX # define UV_MIN PERL_ULONG_MIN # endif -# define UV_SIZEOF LONGSIZE -# define IV_SIZEOF LONGSIZE # if LONGSIZE == 8 # define IV_IS_QUAD # define UV_IS_QUAD @@ -1054,19 +1052,79 @@ Free_t Perl_mfree (Malloc_t where); # undef IV_IS_QUAD # undef UV_IS_QUAD # endif -# define UV_SIZEOF LONGSIZE -# define IV_SIZEOF LONGSIZE +# define UVSIZE LONGSIZE +# define IVSIZE LONGSIZE #endif +#define IV_DIG (BIT_DIGITS(IVSIZE * 8) + 1) +#define UV_DIG (BIT_DIGITS(IVSIZE * 8) + 1) #ifdef USE_LONG_DOUBLE # if defined(HAS_LONG_DOUBLE) && (LONG_DOUBLESIZE > DOUBLESIZE) # define LDoub_t long double +# else +# undef USE_LONG_DOUBLE /* Ouch! */ # endif #endif +#ifdef OVR_DBL_DIG +/* Use an overridden DBL_DIG */ +# ifdef DBL_DIG +# undef DBL_DIG +# endif +# define DBL_DIG OVR_DBL_DIG +#else +/* The following is all to get DBL_DIG, in order to pick a nice + default value for printing floating point numbers in Gconvert. + (see config.h) +*/ +#ifdef I_LIMITS +#include +#endif +#ifdef I_FLOAT +#include +#endif +#ifndef HAS_DBL_DIG +#define DBL_DIG 15 /* A guess that works lots of places */ +#endif +#endif + +#ifdef OVR_LDBL_DIG +/* Use an overridden LDBL_DIG */ +# ifdef LDBL_DIG +# undef LDBL_DIG +# endif +# define LDBL_DIG OVR_LDBL_DIG +#else +/* The following is all to get LDBL_DIG, in order to pick a nice + default value for printing floating point numbers in Gconvert. + (see config.h) +*/ +#ifdef I_LIMITS +#include +#endif +#ifdef I_FLOAT +#include +#endif +#ifndef HAS_LDBL_DIG +#if LONG_DOUBLESIZE == 10 +#define LDBL_DIG 18 /* assume IEEE */ +#else +#if LONG_DOUBLESIZE == 16 +#define LDBL_DIG 33 /* assume IEEE */ +#else +#if LONG_DOUBLESIZE == DOUBLESIZE +#define LDBL_DIG DBL_DIG /* bummer */ +#endif +#endif +#endif +#endif +#endif + #ifdef USE_LONG_DOUBLE # define HAS_LDOUB typedef LDoub_t NV; +# define NVSIZE LONG_DOUBLESIZE +# define NV_DIG LDBL_DIG # define Perl_modf modfl # define Perl_frexp frexpl # define Perl_cos cosl @@ -1080,6 +1138,8 @@ Free_t Perl_mfree (Malloc_t where); # define Perl_fmod fmodl #else typedef double NV; +# define NVSIZE DOUBLESIZE +# define NV_DIG DBL_DIG # define Perl_modf modf # define Perl_frexp frexp # define Perl_cos cos @@ -1351,7 +1411,9 @@ typedef union any ANY; # define USE_64_BIT_STDIO #endif -#ifdef __sgi /* UGLY. See below. */ +/* I couldn't find any -Ddefine or -flags in IRIX 6.5 that would + * have done the necessary symbol renaming using cpp. --jhi */ +#ifdef __sgi #define USE_FOPEN64 #define USE_FSEEK64 #define USE_FTELL64 @@ -1802,6 +1864,25 @@ typedef I32 CHECKPOINT; #define U_V(what) (cast_uv((NV)(what))) #endif +/* These do not care about the fractional part, only about the range. */ +#define NV_WITHIN_IV(nv) (I_V(nv) >= IV_MIN && I_V(nv) <= IV_MAX) +#define NV_WITHIN_UV(nv) ((nv)>=0.0&&U_V(nv) >= UV_MIN&&U_V(nv) <= UV_MAX) + +#define IV_FITS_IN_NV +/* Is this strictly correct? */ +#if IVSIZE >= NVSIZE +# undef IV_FITS_IN_NV +#else + /* Greater-than-or-EQUAL because L?DBL_DIG doesn't necessarily + * mean that all the powers of two that are L?DBL_DIG digits long + * can be represented by the (long)? doubles sized L?DBL_DIG digits. */ +# if IV_DIG >= NV_DIG +# undef IV_FITS_IN_NV +# endif +#endif +/* Often there are DBL_MANT_DIG and LDBL_MANT_DIG + * that would give more precise results. */ + /* Used with UV/IV arguments: */ /* XXXX: need to speed it up */ #define CLUMP_2UV(iv) ((iv) < 0 ? 0 : (UV)(iv)) diff --git a/perlio.c b/perlio.c index 5f9ed6b..7a5924a 100644 --- a/perlio.c +++ b/perlio.c @@ -486,7 +486,7 @@ PerlIO_setpos(PerlIO *f, const Fpos_t *pos) int PerlIO_setpos(PerlIO *f, const Fpos_t *pos) { -#if defined(USE_64_BIT_STDIO) && defined(HAS_FSETPOS64) +#if defined(USE_64_BIT_STDIO) && defined(USE_FSETPOS64) return fsetpos64(f, pos); #else return fsetpos(f, pos); @@ -509,7 +509,7 @@ PerlIO_getpos(PerlIO *f, Fpos_t *pos) int PerlIO_getpos(PerlIO *f, Fpos_t *pos) { -#if defined(USE_64_BIT_STDIO) && defined(HAS_FSETPOS64) +#if defined(USE_64_BIT_STDIO) && defined(USE_FSETPOS64) return fgetpos64(f, pos); #else return fgetpos(f, pos); diff --git a/pod/perldelta.pod b/pod/perldelta.pod index 28a786e..90f1729 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -169,11 +169,31 @@ and compile Perl using the -Duse64bits Configure flag. Unfortunately, bit operations (&, <<, ...) and vec() do not work, they are limited to 32 bits. -Last but not least: note that due to Perl's tendency to always use -floating point numbers the quads are not true integers. They may lose -their precision due to rounding errors, and when they get large their -less significant digits will fall off. - +Last but not least: note that due to Perl's habit of always using +floating point numbers the quads are still not true integers. When +quads overflow their limits (18446744073709551615 unsigned, +-9223372036854775808...9223372036854775807 signed), they are silently +promoted to floating point numbers, after which they will +start losing precision (their lower digits). + +=head2 Large file support + +If you have filesystems that support "large files" (files larger than +2 gigabytes), you may now also be able to create and access them from Perl. + +Note that in addition to requiring a proper file system to do this you +may also need to adjust your per-process (or even your per-system) +maximum filesize limits before running Perl scripts that try to handle +large files, especially if you intend to write such files. + +Adjusting your file system/system limits is outside the scope of Perl. +For process limits, you may try to increase the limits using your +shell's limit/ulimit command before running Perl. The BSD::Resource +extension (not included with the standard Perl distribution) may also +be of use. + +(Large file support is also related to 64-bit support, for obvious reasons) + =head2 Better syntax checks on parenthesized unary operators Expressions such as: diff --git a/pp.h b/pp.h index 0e6383c..c35f967 100644 --- a/pp.h +++ b/pp.h @@ -67,6 +67,7 @@ #define POPul ((unsigned long)SvIVx(POPs)) #ifdef HAS_QUAD #define POPq ((Quad_t)SvIVx(POPs)) +#define POPuq ((Uquad_t)SvIVx(POPs)) #endif #define TOPs (*sp) @@ -79,6 +80,7 @@ #define TOPul ((unsigned long)SvIV(TOPs)) #ifdef HAS_QUAD #define TOPq ((Quad_t)SvIV(TOPs)) +#define TOPuq ((Uquad_t)SvIV(TOPs)) #endif /* Go to some pains in the rare event that we must extend the stack. */ @@ -123,6 +125,12 @@ #define dPOPiv IV value = POPi #define dTOPuv UV value = TOPu #define dPOPuv UV value = POPu +#ifdef HAS_QUAD +#define dTOPqv Quad_t value = TOPu +#define dPOPqv Quad_t value = POPu +#define dTOPuqv Uquad_t value = TOPuq +#define dPOPuqv Uquad_t value = POPuq +#endif #define dPOPXssrl(X) SV *right = POPs; SV *left = CAT2(X,s) #define dPOPXnnrl(X) NV right = POPn; NV left = CAT2(X,n) diff --git a/sv.c b/sv.c index 520a3b6..6524446 100644 --- a/sv.c +++ b/sv.c @@ -15,28 +15,6 @@ #define PERL_IN_SV_C #include "perl.h" -#ifdef OVR_DBL_DIG -/* Use an overridden DBL_DIG */ -# ifdef DBL_DIG -# undef DBL_DIG -# endif -# define DBL_DIG OVR_DBL_DIG -#else -/* The following is all to get DBL_DIG, in order to pick a nice - default value for printing floating point numbers in Gconvert. - (see config.h) -*/ -#ifdef I_LIMITS -#include -#endif -#ifdef I_FLOAT -#include -#endif -#ifndef HAS_DBL_DIG -#define DBL_DIG 15 /* A guess that works lots of places */ -#endif -#endif - #ifdef PERL_OBJECT #define VTBL this->*vtbl #else /* !PERL_OBJECT */ @@ -1711,7 +1689,7 @@ Perl_sv_2pv(pTHX_ register SV *sv, STRLEN *lp) goto tokensave; } if (SvNOKp(sv)) { - Gconvert(SvNVX(sv), DBL_DIG, 0, tmpbuf); + Gconvert(SvNVX(sv), NV_DIG, 0, tmpbuf); tsv = Nullsv; goto tokensave; } @@ -1835,7 +1813,7 @@ Perl_sv_2pv(pTHX_ register SV *sv, STRLEN *lp) else #endif /*apollo*/ { - Gconvert(SvNVX(sv), DBL_DIG, 0, s); + Gconvert(SvNVX(sv), NV_DIG, 0, s); } errno = olderrno; #ifdef FIXNEGATIVEZERO @@ -4731,7 +4709,9 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV char *eptr = Nullch; STRLEN elen = 0; - char ebuf[TYPE_DIGITS(int) * 2 + 16]; /* large enough for "%#.#f" */ + char ebuf[TYPE_DIGITS(IV) * 2 + 16]; + /* large enough for "%#.#f" --chip */ + /* what about long double NVs? --jhi */ char c; int i; unsigned base; diff --git a/t/lib/syslfs.t b/t/lib/syslfs.t index 084ec31..c9d7120 100644 --- a/t/lib/syslfs.t +++ b/t/lib/syslfs.t @@ -27,15 +27,16 @@ sub bye { } sub explain { - print STDERR <>, vec) are not 64-bit clean. # See the beginning of pp.c and the explanation next to IBW/UBW. -no warning 'overflow'; # so that using > 0xfffffff constants doesn't whine +# so that using > 0xfffffff constants and 32+ bit +# shifts and vector sizes doesn't cause noise +no warning 'overflow'; -print "1..30\n"; +print "1..36\n"; my $q = 12345678901; my $r = 23456789012; my $f = 0xffffffff; my $x; - +my $y; $x = unpack "q", pack "q", $q; print "not " unless $x == $q && $x > $f; @@ -143,14 +145,48 @@ $x = $q - $r; print "not " unless $x == -11111110111 && -$x > $f; print "ok 27\n"; -$x = $q * $r; -print "not " unless $x == 289589985190657035812 && $x > $f; +$x = $q * 1234567; +print "not " unless $x == 15241567763770867 && $x > $f; print "ok 28\n"; -$x /= $r; +$x /= 1234567; print "not " unless $x == $q && $x > $f; print "ok 29\n"; $x = 98765432109 % 12345678901; print "not " unless $x == 901; print "ok 30\n"; + +# The following six adapted from op/inc. + +$a = 9223372036854775807; +$c = $a++; +print "not " unless $a == 9223372036854775808; +print "ok 31\n"; + +$a = 9223372036854775807; +$c = ++$a; +print "not " unless $a == 9223372036854775808; +print "ok 32\n"; + +$a = 9223372036854775807; +$c = $a + 1; +print "not " unless $a == 9223372036854775808; +print "ok 33\n"; + +$a = -9223372036854775808; +$c = $a--; +print "not " unless $a == -9223372036854775809; +print "ok 34\n"; + +$a = -9223372036854775808; +$c = --$a; +print "not " unless $a == -9223372036854775809; +print "ok 35\n"; + +$a = -9223372036854775808; +$c = $a - 1; +print "not " unless $a == -9223372036854775809; +print "ok 36\n"; + + diff --git a/t/op/lfs.t b/t/op/lfs.t index 96180a1..46d410d 100644 --- a/t/op/lfs.t +++ b/t/op/lfs.t @@ -26,15 +26,16 @@ sub bye { } sub explain { - print STDERR <