diff options
-rw-r--r-- | configure.com | 8 | ||||
-rw-r--r-- | embedvar.h | 2 | ||||
-rwxr-xr-x | opcode.pl | 21 | ||||
-rw-r--r-- | perlapi.h | 2 | ||||
-rw-r--r-- | perlvars.h | 4 | ||||
-rw-r--r-- | pod/perlapi.pod | 44 | ||||
-rw-r--r-- | vms/vms.c | 9 |
7 files changed, 59 insertions, 31 deletions
diff --git a/configure.com b/configure.com index 21b46f0b3f..82fa3ed4a0 100644 --- 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 d2e15a0801..26c0eb12a6 100644 --- 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 @@ -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 { @@ -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 704192422a..e70dd7f772 100644 --- 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 ad4d3e45b2..0abdc1cb03 100644 --- 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 @@ -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; } |