Change 12491 by jhi@alpha on 2001/10/18 12:17:16
Subject: try#2: [proposed PATCH Perl@12401] ieee floats, rand() & old systems
From: [EMAIL PROTECTED] (Charles Lane)
Date: Wed, 17 Oct 2001 09:10:53 EDT
Message-Id: <[EMAIL PROTECTED]>
Affected files ...
... //depot/perl/configure.com#119 edit
... //depot/perl/embedvar.h#125 edit
... //depot/perl/opcode.pl#87 edit
... //depot/perl/perlapi.h#47 edit
... //depot/perl/perlvars.h#36 edit
... //depot/perl/pod/perlapi.pod#97 edit
... //depot/perl/vms/vms.c#85 edit
Differences ...
==== //depot/perl/configure.com#119 (text) ====
Index: perl/configure.com
--- perl/configure.com.~1~ Thu Oct 18 06:30:05 2001
+++ perl/configure.com Thu Oct 18 06:30:05 2001
@@ -2374,6 +2374,9 @@
$ 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 @@
$ 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 @@
$! 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..."
==== //depot/perl/embedvar.h#125 (text+w) ====
Index: perl/embedvar.h
--- perl/embedvar.h.~1~ Thu Oct 18 06:30:05 2001
+++ perl/embedvar.h Thu Oct 18 06:30:05 2001
@@ -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
==== //depot/perl/opcode.pl#87 (xtext) ====
Index: perl/opcode.pl
--- perl/opcode.pl.~1~ Thu Oct 18 06:30:05 2001
+++ perl/opcode.pl Thu Oct 18 06:30:05 2001
@@ -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 @@
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";
+
+$pp_proto_new = 'pp_proto.h-new';
+$pp_sym_new = 'pp.sym-new';
-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: $!";
+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 @@
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 {
==== //depot/perl/perlapi.h#47 (text+w) ====
Index: perl/perlapi.h
--- perl/perlapi.h.~1~ Thu Oct 18 06:30:05 2001
+++ perl/perlapi.h Thu Oct 18 06:30:05 2001
@@ -923,6 +923,8 @@
#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
==== //depot/perl/perlvars.h#36 (text) ====
Index: perl/perlvars.h
--- perl/perlvars.h.~1~ Thu Oct 18 06:30:05 2001
+++ perl/perlvars.h Thu Oct 18 06:30:05 2001
@@ -40,3 +40,7 @@
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
==== //depot/perl/pod/perlapi.pod#97 (text+w) ====
Index: perl/pod/perlapi.pod
--- perl/pod/perlapi.pod.~1~ Thu Oct 18 06:30:05 2001
+++ perl/pod/perlapi.pod Thu Oct 18 06:30:05 2001
@@ -2397,22 +2397,22 @@
=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 @@
=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 @@
=for hackers
Found in file sv.h
-=item svtype
+=item SvTYPE
+
+Returns the type of the SV. See C<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.
+ svtype SvTYPE(SV* sv)
=for hackers
Found in file sv.h
-=item SvTYPE
+=item svtype
-Returns the type of the SV. See C<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
==== //depot/perl/vms/vms.c#85 (text) ====
Index: perl/vms/vms.c
--- perl/vms/vms.c.~1~ Thu Oct 18 06:30:05 2001
+++ perl/vms/vms.c Thu Oct 18 06:30:05 2001
@@ -6935,6 +6935,15 @@
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;
}
End of Patch.
