try#2: [proposed PATCH Perl@12401] ieee floats, rand() & old systems

Message-Id: <011017090944.15ad2e@DUPHY4.Physics.Drexel.Edu>

p4raw-id: //depot/perl@12491

diff --git a/configure.com b/configure.com
index 21b46f0..82fa3ed 100644 (file)
--- a/configure.com
+++ b/configure.com
@@ -2374,6 +2374,9 @@ $   rp = "Use IEEE math? [''dflt'] "
 $   GOSUB myread
 $   IF ans .eqs. "" THEN ans = "''dflt'"
 $   use_ieee_math = "''ans'"
+$ ELSE
+$   be_case_sensitive = "n"
+$   use_ieee_math = "n"
 $ ENDIF
 $! CC Flags
 $ echo ""
@@ -4511,6 +4514,7 @@ $!
 $! Check rand48 and its ilk
 $!
 $ echo4 "Looking for a random number function..."
+$ d_use_rand = "undef"
 $ OS
 $ WS "#if defined(__DECC) || defined(__DECCXX)"
 $ WS "#include <stdlib.h>"
@@ -4551,9 +4555,10 @@ $   IF compile_status .EQ. good_compile .AND. link_status .EQ. good_link
 $   THEN
 $     echo4 "OK, found random()."
 $   ELSE
-$     drand01="(((float)rand())/((float)RAND_MAX))"
+$     drand01="(((float)rand())*PL_my_inv_rand_max)"
 $     randseedtype = "unsigned"
 $     seedfunc = "srand"
+$     d_use_rand = "define"
 $     echo4 "Yick, looks like I have to use rand()."
 $   ENDIF
 $ ENDIF
@@ -5727,6 +5732,7 @@ $ THEN
 $! Alas this does not help to build Fcntl
 $!   WC "#define PERL_IGNORE_FPUSIG SIGFPE"
 $ ENDIF
+$ if d_use_rand .EQS. "define" then WC "#define Drand01_is_rand"
 $ CLOSE CONFIG
 $!
 $ echo4 "Doing variable substitutions on .SH files..."

diff --git a/embedvar.h b/embedvar.h
index d2e15a0..26c0eb1 100644 (file)
--- a/embedvar.h
+++ b/embedvar.h
@@ -1321,6 +1321,7 @@
 #define PL_do_undump           (PL_Vars.Gdo_undump)
 #define PL_hexdigit            (PL_Vars.Ghexdigit)
 #define PL_malloc_mutex                (PL_Vars.Gmalloc_mutex)
+#define PL_my_inv_rand_max     (PL_Vars.Gmy_inv_rand_max)
 #define PL_op_mutex            (PL_Vars.Gop_mutex)
 #define PL_patleave            (PL_Vars.Gpatleave)
 #define PL_sharedsv_space      (PL_Vars.Gsharedsv_space)
@@ -1335,6 +1336,7 @@
 #define PL_Gdo_undump          PL_do_undump
 #define PL_Ghexdigit           PL_hexdigit
 #define PL_Gmalloc_mutex       PL_malloc_mutex
+#define PL_Gmy_inv_rand_max    PL_my_inv_rand_max
 #define PL_Gop_mutex           PL_op_mutex
 #define PL_Gpatleave           PL_patleave
 #define PL_Gsharedsv_space     PL_sharedsv_space

diff --git a/opcode.pl b/opcode.pl
index 28630a5..abfa256 100755 (executable)
--- a/opcode.pl
+++ b/opcode.pl
@@ -1,7 +1,9 @@
 #!/usr/bin/perl
 
-open(OC, ">opcode.h.new") || die "Can't create opcode.h.new: $!\n";
-open(ON, ">opnames.h.new") || die "Can't create opnames.h.new: $!\n";
+$opcode_new = 'opcode.h-new';
+$opname_new = 'opnames.h-new';
+open(OC, ">$opcode_new") || die "Can't create $opcode_new: $!\n";
+open(ON, ">$opname_new") || die "Can't create $opname_new: $!\n";
 select OC;
 
 # Read data.
@@ -262,11 +264,14 @@ close ON or die "Error closing opnames.h: $!";
 chmod 0600, 'opcode.h';  # required by dosish filesystems
 chmod 0600, 'opnames.h'; # required by dosish filesystems
 
-rename 'opcode.h.new', 'opcode.h' or die "renaming opcode.h: $!\n";
-rename 'opnames.h.new', 'opnames.h' or die "renaming opnames.h: $!\n";
+rename $opcode_new, 'opcode.h' or die "renaming opcode.h: $!\n";
+rename $opname_new, 'opnames.h' or die "renaming opnames.h: $!\n";
 
-open PP, '>pp_proto.h.new' or die "Error creating pp_proto.h.new: $!";
-open PPSYM, '>pp.sym.new' or die "Error creating pp.sym.new: $!";
+$pp_proto_new = 'pp_proto.h-new';
+$pp_sym_new  = 'pp.sym-new';
+
+open PP, ">$pp_proto_new" or die "Error creating $pp_proto_new: $!";
+open PPSYM, ">$pp_sym_new" or die "Error creating $pp_sym_new: $!";
 
 print PP <<"END";
 /* !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
@@ -307,8 +312,8 @@ close PPSYM or die "Error closing pp.sym: $!";
 chmod 0600, 'pp_proto.h'; # required by dosish filesystems
 chmod 0600, 'pp.sym';     # required by dosish filesystems
 
-rename 'pp_proto.h.new', 'pp_proto.h' or die "rename pp_proto.h: $!\n";
-rename 'pp.sym.new', 'pp.sym' or die "rename pp.sym: $!\n";
+rename $pp_proto_new, 'pp_proto.h' or die "rename pp_proto.h: $!\n";
+rename $pp_sym_new, 'pp.sym' or die "rename pp.sym: $!\n";
 
 ###########################################################################
 sub tab {

diff --git a/perlapi.h b/perlapi.h
index 325b360..4d7a521 100644 (file)
--- a/perlapi.h
+++ b/perlapi.h
@@ -923,6 +923,8 @@ END_EXTERN_C
 #define PL_hexdigit            (*Perl_Ghexdigit_ptr(NULL))
 #undef  PL_malloc_mutex
 #define PL_malloc_mutex                (*Perl_Gmalloc_mutex_ptr(NULL))
+#undef  PL_my_inv_rand_max
+#define PL_my_inv_rand_max     (*Perl_Gmy_inv_rand_max_ptr(NULL))
 #undef  PL_op_mutex
 #define PL_op_mutex            (*Perl_Gop_mutex_ptr(NULL))
 #undef  PL_patleave

diff --git a/perlvars.h b/perlvars.h
index 7041924..e70dd7f 100644 (file)
--- a/perlvars.h
+++ b/perlvars.h
@@ -40,3 +40,7 @@ PERLVAR(Gop_mutex,    perl_mutex)     /* Mutex for op refcounting */
 PERLVAR(Gsharedsv_space, PerlInterpreter*) /* The shared sv space */
 PERLVAR(Gsharedsv_space_mutex, perl_mutex) /* Mutex protecting the shared sv space */
 #endif
+
+#if defined(VMS) && defined(Drand01_is_rand)
+PERLVAR(Gmy_inv_rand_max, float) /* nasty compiler bug workaround */
+#endif

diff --git a/pod/perlapi.pod b/pod/perlapi.pod
index ad4d3e4..0abdc1c 100644 (file)
--- a/pod/perlapi.pod
+++ b/pod/perlapi.pod
@@ -2397,22 +2397,22 @@ which guarantees to evaluate sv only once.
 =for hackers
 Found in file sv.h
 
-=item SvNVx
+=item SvNVX
 
-Coerces the given SV to a double and returns it. Guarantees to evaluate
-sv only once. Use the more efficent C<SvNV> otherwise.
+Returns the raw value in the SV's NV slot, without checks or conversions.
+Only use when you are sure SvNOK is true. See also C<SvNV()>.
 
-       NV      SvNVx(SV* sv)
+       NV      SvNVX(SV* sv)
 
 =for hackers
 Found in file sv.h
 
-=item SvNVX
+=item SvNVx
 
-Returns the raw value in the SV's NV slot, without checks or conversions.
-Only use when you are sure SvNOK is true. See also C<SvNV()>.
+Coerces the given SV to a double and returns it. Guarantees to evaluate
+sv only once. Use the more efficent C<SvNV> otherwise.
 
-       NV      SvNVX(SV* sv)
+       NV      SvNVx(SV* sv)
 
 =for hackers
 Found in file sv.h
@@ -2606,21 +2606,21 @@ Like C<SvPV_nolen>, but converts sv to uft8 first if necessary.
 =for hackers
 Found in file sv.h
 
-=item SvPVX
+=item SvPVx
 
-Returns a pointer to the physical string in the SV.  The SV must contain a
-string.
+A version of C<SvPV> which guarantees to evaluate sv only once.
 
-       char*   SvPVX(SV* sv)
+       char*   SvPVx(SV* sv, STRLEN len)
 
 =for hackers
 Found in file sv.h
 
-=item SvPVx
+=item SvPVX
 
-A version of C<SvPV> which guarantees to evaluate sv only once.
+Returns a pointer to the physical string in the SV.  The SV must contain a
+string.
 
-       char*   SvPVx(SV* sv, STRLEN len)
+       char*   SvPVX(SV* sv)
 
 =for hackers
 Found in file sv.h
@@ -2827,19 +2827,19 @@ false, defined or undefined.  Does not handle 'get' magic.
 =for hackers
 Found in file sv.h
 
-=item svtype
+=item SvTYPE
 
-An enum of flags for Perl types.  These are found in the file B<sv.h>
-in the C<svtype> enum.  Test these flags with the C<SvTYPE> macro.
+Returns the type of the SV.  See C<svtype>.
+
+       svtype  SvTYPE(SV* sv)
 
 =for hackers
 Found in file sv.h
 
-=item SvTYPE
-
-Returns the type of the SV.  See C<svtype>.
+=item svtype
 
-       svtype  SvTYPE(SV* sv)
+An enum of flags for Perl types.  These are found in the file B<sv.h>
+in the C<svtype> enum.  Test these flags with the C<SvTYPE> macro.
 
 =for hackers
 Found in file sv.h

diff --git a/vms/vms.c b/vms/vms.c
index fd02f85..bd9ed12 100644 (file)
--- a/vms/vms.c
+++ b/vms/vms.c
@@ -6935,6 +6935,15 @@ init_os_extras()
 
   store_pipelocs(aTHX);
 
+#ifdef Drand01_is_rand
+/* this hackery brought to you by a bug in DECC for /ieee=denorm */
+  { 
+    int ix = RAND_MAX;
+    float x = (float)ix;
+    PL_my_inv_rand_max = 1./x;
+  }
+#endif
+
   return;
 }