vmsish fix, ieee rand() cleanup

Message-Id: <011019174427.d749b@DUPHY4.Physics.Drexel.Edu>

p4raw-id: //depot/perl@12513

18 files changed, 198 insertions, 90 deletions

diff --git a/configure.com b/configure.com
index 82fa3ed4a0..2c4f1be9d2 100644
--- a/configure.com
+++ b/configure.com
@@ -4514,7 +4514,6 @@ $!
 $! 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>"
@@ -4555,10 +4554,9 @@ $   IF compile_status .EQ. good_compile .AND. link_status .EQ. good_link
 $   THEN
 $     echo4 "OK, found random()."
 $   ELSE
-$     drand01="(((float)rand())*PL_my_inv_rand_max)"
+$     drand01="(((float)rand())*MY_INV_RAND_MAX)"
 $     randseedtype = "unsigned"
 $     seedfunc = "srand"
-$     d_use_rand = "define"
 $     echo4 "Yick, looks like I have to use rand()."
 $   ENDIF
 $ ENDIF
@@ -5732,7 +5730,6 @@ $ 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/dump.c b/dump.c
index 59bd5326a5..07ef295480 100644
--- a/dump.c
+++ b/dump.c
@@ -616,7 +616,13 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, OP *o)
 	}
 	else if (o->op_type == OP_EXIT) {
 	    if (o->op_private & OPpEXIT_VMSISH)
-		sv_catpv(tmpsv, ",EXIST_VMSISH");
+		sv_catpv(tmpsv, ",EXIT_VMSISH");
+	    if (o->op_private & OPpHUSH_VMSISH)
+		sv_catpv(tmpsv, ",HUSH_VMSISH");
+	}
+	else if (o->op_type == OP_DIE) {
+	    if (o->op_private & OPpHUSH_VMSISH)
+		sv_catpv(tmpsv, ",HUSH_VMSISH");
 	}
 	if (o->op_flags & OPf_MOD && o->op_private & OPpLVAL_INTRO)
 	    sv_catpv(tmpsv, ",INTRO");
diff --git a/ext/B/t/stash.t b/ext/B/t/stash.t
index b83493fe34..88e4ca2492 100755
--- a/ext/B/t/stash.t
+++ b/ext/B/t/stash.t
@@ -42,6 +42,7 @@ $a =~ s/-uCwd,// if $^O eq 'cygwin';
 if ($Is_VMS) {
     $a =~ s/-uFile,-uFile::Copy,//;
     $a =~ s/-uVMS,-uVMS::Filespec,//;
+    $a =~ s/-uvmsish,//;
     $a =~ s/-uSocket,//; # Socket is optional/compiler version dependent
 }
 
diff --git a/op.c b/op.c
index 282b3b4c25..86af481158 100644
--- a/op.c
+++ b/op.c
@@ -5432,6 +5432,15 @@ Perl_ck_delete(pTHX_ OP *o)
 }
 
 OP *
+Perl_ck_die(pTHX_ OP *o)
+{
+#ifdef VMS
+    if (VMSISH_HUSHED) o->op_private |= OPpHUSH_VMSISH;
+#endif
+    return ck_fun(o);
+}
+
+OP *
 Perl_ck_eof(pTHX_ OP *o)
 {
     I32 type = o->op_type;
@@ -5500,6 +5509,7 @@ Perl_ck_exit(pTHX_ OP *o)
        if (svp && *svp && SvTRUE(*svp))
            o->op_private |= OPpEXIT_VMSISH;
     }
+    if (VMSISH_HUSHED) o->op_private |= OPpHUSH_VMSISH;
 #endif
     return ck_fun(o);
 }
diff --git a/op.h b/op.h
index 7896b8fca7..fcb24a5f41 100644
--- a/op.h
+++ b/op.h
@@ -197,7 +197,8 @@ Deprecated.  Use C<GIMME_V> instead.
 #define OPpOPEN_OUT_RAW		64	/* binmode(F,":raw") on output fh */
 #define OPpOPEN_OUT_CRLF	128	/* binmode(F,":crlf") on output fh */
 
-/* Private for OP_EXIT */
+/* Private for OP_EXIT, HUSH also for OP_DIE */
+#define OPpHUSH_VMSISH		64	/* hush DCL exit msg vmsish mode*/
 #define OPpEXIT_VMSISH		128	/* exit(0) vs. exit(1) vmsish mode*/
 
 struct op {
diff --git a/opcode.h b/opcode.h
index 7b908656e7..b3da7c3651 100644
--- a/opcode.h
+++ b/opcode.h
@@ -1273,7 +1273,7 @@ EXT OP * (CPERLscope(*PL_check)[]) (pTHX_ OP *op) = {
 	MEMBER_TO_FPTR(Perl_ck_null),	/* leavesublv */
 	MEMBER_TO_FPTR(Perl_ck_fun),	/* caller */
 	MEMBER_TO_FPTR(Perl_ck_fun),	/* warn */
-	MEMBER_TO_FPTR(Perl_ck_fun),	/* die */
+	MEMBER_TO_FPTR(Perl_ck_die),	/* die */
 	MEMBER_TO_FPTR(Perl_ck_fun),	/* reset */
 	MEMBER_TO_FPTR(Perl_ck_null),	/* lineseq */
 	MEMBER_TO_FPTR(Perl_ck_null),	/* nextstate */
diff --git a/opcode.pl b/opcode.pl
index abfa256731..bfafce70ab 100755
--- a/opcode.pl
+++ b/opcode.pl
@@ -652,7 +652,7 @@ leavesub	subroutine exit		ck_null		1
 leavesublv	lvalue subroutine return	ck_null		1	
 caller		caller			ck_fun		t%	S?
 warn		warn			ck_fun		imst@	L
-die		die			ck_fun		dimst@	L
+die		die			ck_die		dimst@	L
 reset		symbol reset		ck_fun		is%	S?
 
 lineseq		line sequence		ck_null		@	
diff --git a/perl.c b/perl.c
index bd68c411b0..9eaa7b7b1f 100644
--- a/perl.c
+++ b/perl.c
@@ -1492,6 +1492,9 @@ perl_run(pTHXx)
 #endif
 
     oldscope = PL_scopestack_ix;
+#ifdef VMS
+    VMSISH_HUSHED = 0;
+#endif
 
 #ifdef PERL_FLEXIBLE_EXCEPTIONS
  redo_body:
diff --git a/perl.h b/perl.h
index 5e2eede467..a7e7461e92 100644
--- a/perl.h
+++ b/perl.h
@@ -425,7 +425,7 @@ int usleep(unsigned int);
 #  define MYSWAP
 #endif
 
-#if !defined(PERL_FOR_X2P) && !defined(WIN32)
+#if !defined(PERL_FOR_X2P) && !(defined(WIN32)||defined(VMS))
 #  include "embed.h"
 #endif
 
@@ -1754,6 +1754,7 @@ typedef struct clone_params CLONE_PARAMS;
 #else
 # if defined(VMS)
 #   include "vmsish.h"
+#   include "embed.h"
 # else
 #   if defined(PLAN9)
 #     include "./plan9/plan9ish.h"
diff --git a/perlvars.h b/perlvars.h
index e70dd7f772..704192422a 100644
--- a/perlvars.h
+++ b/perlvars.h
@@ -40,7 +40,3 @@ 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/pp.sym b/pp.sym
index 151b7c3983..909e95ee15 100644
--- a/pp.sym
+++ b/pp.sym
@@ -9,6 +9,7 @@ Perl_ck_bitop
 Perl_ck_concat
 Perl_ck_defined
 Perl_ck_delete
+Perl_ck_die
 Perl_ck_eof
 Perl_ck_eval
 Perl_ck_exec
diff --git a/pp_ctl.c b/pp_ctl.c
index 09c1a190c6..567370be8b 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -2593,6 +2593,7 @@ PP(pp_exit)
 #ifdef VMS
         if (anum == 1 && (PL_op->op_private & OPpEXIT_VMSISH))
 	    anum = 0;
+        VMSISH_HUSHED  = VMSISH_HUSHED || (PL_op->op_private & OPpHUSH_VMSISH);
 #endif
     }
     PL_exit_flags |= PERL_EXIT_EXPECTED;
diff --git a/pp_proto.h b/pp_proto.h
index 86ab4c2550..566074e0f2 100644
--- a/pp_proto.h
+++ b/pp_proto.h
@@ -8,6 +8,7 @@ PERL_CKDEF(Perl_ck_bitop)
 PERL_CKDEF(Perl_ck_concat)
 PERL_CKDEF(Perl_ck_defined)
 PERL_CKDEF(Perl_ck_delete)
+PERL_CKDEF(Perl_ck_die)
 PERL_CKDEF(Perl_ck_eof)
 PERL_CKDEF(Perl_ck_eval)
 PERL_CKDEF(Perl_ck_exec)
diff --git a/pp_sys.c b/pp_sys.c
index 155872846d..ea35136f8e 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -433,6 +433,9 @@ PP(pp_die)
     SV *tmpsv;
     STRLEN len;
     bool multiarg = 0;
+#ifdef VMS
+    VMSISH_HUSHED  = VMSISH_HUSHED || (PL_op->op_private & OPpHUSH_VMSISH);
+#endif
     if (SP - MARK != 1) {
 	dTARGET;
 	do_join(TARG, &PL_sv_no, MARK, SP);
diff --git a/vms/ext/vmsish.pm b/vms/ext/vmsish.pm
index c51863a4f3..89ec72c28c 100644
--- a/vms/ext/vmsish.pm
+++ b/vms/ext/vmsish.pm
@@ -11,7 +11,10 @@ vmsish - Perl pragma to control VMS-specific language features
     use vmsish 'status';	# or '$?'
     use vmsish 'exit';
     use vmsish 'time';
+
     use vmsish 'hushed';
+    no vmsish 'hushed';
+    vmsish::hushed($hush);
 
     use vmsish;
     no vmsish 'time';
@@ -44,13 +47,59 @@ default of Universal Time (a.k.a Greenwich Mean Time, or GMT).
 
 =item C<vmsish hushed>
 
-This suppresses printing of VMS status messages to SYS$OUTPUT and SYS$ERROR
-if Perl terminates with an error status.  This primarily effects error
-exits from things like Perl compiler errors or "standard Perl" runtime errors,
-where text error messages are also generated by Perl.
-
-The error exits from inside the core are generally more serious, and are
-not supressed.
+This suppresses printing of VMS status messages to SYS$OUTPUT and
+SYS$ERROR if Perl terminates with an error status.  and allows
+programs that are expecting "unix-style" Perl to avoid having to parse
+VMS error messages.  It does not supress any messages from Perl
+itself, just the messages generated by DCL after Perl exits.  The DCL
+symbol $STATUS will still have the termination status, but with a
+high-order bit set:
+
+EXAMPLE:
+    $ perl -e"exit 44;"                             Non-hushed error exit
+    %SYSTEM-F-ABORT, abort                          DCL message
+    $ show sym $STATUS
+      $STATUS == "%X0000002C"
+
+    $ perl -e"use vmsish qw(hushed); exit 44;"      Hushed error exit
+    $ show sym $STATUS
+      $STATUS == "%X1000002C"
+
+The 'hushed' flag has a global scope during compilation: the exit() or
+die() commands that are compiled after 'vmsish hushed' will be hushed
+when they are executed.  Doing a "no vmsish 'hushed'" turns off the
+hushed flag.
+
+The status of the hushed flag also affects output of VMS error
+messages from compilation errors.   Again, you still get the Perl
+error message (and the code in $STATUS)
+
+EXAMPLE:
+    use vmsish 'hushed';    # turn on hushed flag
+    use Carp;          # Carp compiled hushed
+    exit 44;           # will be hushed
+    croak('I die');    # will be hushed
+    no vmsish 'hushed';     # turn off hushed flag
+    exit 44;           # will not be hushed
+    croak('I die2'):   # WILL be hushed, croak was compiled hushed
+
+You can also control the 'hushed' flag at run-time, using the built-in
+routine vmsish::hushed().  Without argument, it returns the hushed status.
+Since vmsish::hushed is built-in, you do not need to "use vmsish" to call
+it.
+
+EXAMPLE:
+    if ($quiet_exit) {
+        vmsish::hushed(1);
+    } 
+    print "Sssshhhh...I'm hushed...\n" if vmsish::hushed();
+    exit 44;
+
+Note that an exit() or die() that is compiled 'hushed' because of "use
+vmsish" is not un-hushed by calling vmsish::hushed(0) at runtime.
+
+The messages from error exits from inside the Perl core are generally
+more serious, and are not supressed.
 
 =back
 
@@ -67,7 +116,6 @@ sub bits {
     my $bits = 0;
     my $sememe;
     foreach $sememe (@_) {
-        $bits |= 0x20000000, next if $sememe eq 'hushed';
         $bits |= 0x40000000, next if $sememe eq 'status' || $sememe eq '$?';
 	$bits |= 0x80000000, next if $sememe eq 'time';
     }
@@ -76,21 +124,23 @@ sub bits {
 
 sub import {
     shift;
-    $^H |= bits(@_ ? @_ : qw(status time hushed));
+    $^H |= bits(@_ ? @_ : qw(status time));
     my $sememe;
 
-    foreach $sememe (@_ ? @_ : qw(exit)) {
+    foreach $sememe (@_ ? @_ : qw(exit hushed)) {
         $^H{'vmsish_exit'}   = 1 if $sememe eq 'exit';
+        vmsish::hushed(1) if $sememe eq 'hushed';
     }
 }
 
 sub unimport {
     shift;
-    $^H &= ~ bits(@_ ? @_ : qw(status time hushed));
+    $^H &= ~ bits(@_ ? @_ : qw(status time));
     my $sememe;
 
-    foreach $sememe (@_ ? @_ : qw(exit)) {
+    foreach $sememe (@_ ? @_ : qw(exit hushed)) {
         $^H{'vmsish_exit'}   = 0 if $sememe eq 'exit';
+        vmsish::hushed(0) if $sememe eq 'hushed';
     }
 }
 
diff --git a/vms/ext/vmsish.t b/vms/ext/vmsish.t
index d63da57235..0f3c0ec1eb 100644
--- a/vms/ext/vmsish.t
+++ b/vms/ext/vmsish.t
@@ -3,31 +3,27 @@ BEGIN { unshift @INC, '[-.lib]'; }
 
 my $Invoke_Perl = qq(MCR $^X "-I[-.lib]");
 
-print "1..17\n";
+require "test.pl";
+plan(tests => 24);
 
 #========== vmsish status ==========
 `$Invoke_Perl -e 1`;  # Avoid system() from a pipe from harness.  Mutter.
-if ($?) { print "not ok 1 # POSIX status is $?\n"; }
-else    { print "ok 1\n"; }
+is($?,0,"simple Perl invokation: POSIX success status");
 {
   use vmsish qw(status);
-  if (not ($? & 1)) { print "not ok 2 # vmsish status is $?\n"; }
-  else              { print "ok 2\n"; }
+  is(($? & 1),1, "importing vmsish [vmsish status]");
   {
-    no vmsish '$?'; # check unimport function
-    if ($?) { print "not ok 3 # POSIX status is $?\n"; }
-    else    { print "ok 3\n"; }
+    no vmsish qw(status); # check unimport function
+    is($?,0, "unimport vmsish [POSIX STATUS]");
   }
   # and lexical scoping
-  if (not ($? & 1)) { print "not ok 4 # vmsish status is $?\n"; }
-  else              { print "ok 4\n"; }
+  is(($? & 1),1,"lex scope of vmsish [vmsish status]");
 }
-if ($?) { print "not ok 5 # POSIX status is $?\n"; }
-else    { print "ok 5\n";                          }
+is($?,0,"outer lex scope of vmsish [POSIX status]");
+
 {
   use vmsish qw(exit);  # check import function
-  if ($?) { print "not ok 6 # POSIX status is $?\n"; }
-  else    { print "ok 6\n"; }
+  is($?,0,"importing vmsish exit [POSIX status]");
 }
 
 #========== vmsish exit, messages ==========
@@ -35,39 +31,54 @@ else    { print "ok 5\n";                          }
   use vmsish qw(status);
 
   $msg = do_a_perl('-e "exit 1"');
-  if ($msg !~ /ABORT/) {
     $msg =~ s/\n/\\n/g; # keep output on one line
-    print "not ok 7 # subprocess output: |$msg|\n";
-  }
-  else { print "ok 7\n"; }
-  if ($? & 1) { print "not ok 8 # subprocess VMS status: $?\n"; }
-  else        { print "ok 8\n"; }
+  like($msg,'ABORT', "POSIX ERR exit, DCL error message check");
+  is($?&1,0,"vmsish status check, POSIX ERR exit");
 
   $msg = do_a_perl('-e "use vmsish qw(exit); exit 1"');
-  if (length $msg) {
     $msg =~ s/\n/\\n/g; # keep output on one line
-    print "not ok 9 # subprocess output: |$msg|\n";
-  }
-  else { print "ok 9\n"; }
-  if (not ($? & 1)) { print "not ok 10 # subprocess VMS status: $?\n"; }
-  else              { print "ok 10\n"; }
+  ok(length($msg)==0,"vmsish OK exit, DCL error message check");
+  is($?&1,1, "vmsish status check, vmsish OK exit");
 
   $msg = do_a_perl('-e "use vmsish qw(exit); exit 44"');
-  if ($msg !~ /ABORT/) {
     $msg =~ s/\n/\\n/g; # keep output on one line
-    print "not ok 11 # subprocess output: |$msg|\n";
-  }
-  else { print "ok 11\n"; }
-  if ($? & 1) { print "not ok 12 # subprocess VMS status: $?\n"; }
-  else        { print "ok 12\n"; }
+  like($msg, 'ABORT', "vmsish ERR exit, DCL error message check");
+  is($?&1,0,"vmsish ERR exit, vmsish status check");
+
+  $msg = do_a_perl('-e "use vmsish qw(hushed); exit 1"');
+  $msg =~ s/\n/\\n/g; # keep output on one line
+  ok(($msg !~ /ABORT/),"POSIX ERR exit, vmsish hushed, DCL error message check");
 
   $msg = do_a_perl('-e "use vmsish qw(exit hushed); exit 44"');
-  if ($msg =~ /ABORT/) {
     $msg =~ s/\n/\\n/g; # keep output on one line
-    print "not ok 13 # subprocess output: |$msg|\n";
-  }
-  else { print "ok 13\n"; }
-
+  ok(($msg !~ /ABORT/),"vmsish ERR exit, vmsish hushed, DCL error message check");
+
+  $msg = do_a_perl('-e "use vmsish qw(exit hushed); no vmsish qw(hushed); exit 44"');
+  $msg =~ s/\n/\\n/g; # keep output on one line
+  like($msg,'ABORT',"vmsish ERR exit, no vmsish hushed, DCL error message check");
+
+  $msg = do_a_perl('-e "use vmsish qw(hushed); die(qw(blah));"');
+  $msg =~ s/\n/\\n/g; # keep output on one line
+  ok(($msg !~ /ABORT/),"die, vmsish hushed, DCL error message check");
+
+  $msg = do_a_perl('-e "use vmsish qw(hushed); use Carp; croak(qw(blah));"');
+  $msg =~ s/\n/\\n/g; # keep output on one line
+  ok(($msg !~ /ABORT/),"croak, vmsish hushed, DCL error message check");
+
+  $msg = do_a_perl('-e "use vmsish qw(exit); vmsish::hushed(1); exit 44;"');
+  $msg =~ s/\n/\\n/g; # keep output on one line
+  ok(($msg !~ /ABORT/),"vmsish ERR exit, vmsish hushed at runtime, DCL error message check");
+
+  local *TEST;
+  open(TEST,'>vmsish_test.pl') || die('not ok ?? : unable to open "vmsish_test.pl" for writing');  
+  print TEST "#! perl\n";
+  print TEST "use vmsish qw(hushed);\n";
+  print TEST "\$obvious = (\$compile(\$error;\n";
+  close TEST;
+  $msg = do_a_perl('vmsish_test.pl');
+  $msg =~ s/\n/\\n/g; # keep output on one line
+  ok(($msg !~ /ABORT/),"compile ERR exit, vmsish hushed, DCL error message check");
+  unlink 'vmsish_test.pl';
 }
 
 
@@ -84,7 +95,7 @@ else    { print "ok 5\n";                          }
     gmtime(0); # Force reset of tz offset
   }
   {
-     use vmsish qw(time);
+     use_ok('vmsish qw(time)');
      $vmstime   = time;
      @vmslocal  = localtime($vmstime);
      @vmsgmtime = gmtime($vmstime);
@@ -101,33 +112,21 @@ else    { print "ok 5\n";                          }
   # since it's unlikely local time will differ from UTC by so small
   # an amount, and it renders the test resistant to delays from
   # things like stat() on a file mounted over a slow network link.
-  if ($utctime - $vmstime + $offset > 10) {
-    print "not ok 14  # (time) UTC: $utctime  VMS: $vmstime\n";
-  }
-  else { print "ok 14\n"; }
+  ok($utctime - $vmstime +$offset <= 10,"(time) UTC:$utctime VMS:$vmstime");
 
   $utcval = $utclocal[5] * 31536000 + $utclocal[7] * 86400 +
             $utclocal[2] * 3600     + $utclocal[1] * 60 + $utclocal[0];
   $vmsval = $vmslocal[5] * 31536000 + $vmslocal[7] * 86400 +
             $vmslocal[2] * 3600     + $vmslocal[1] * 60 + $vmslocal[0];
-  if ($vmsval - $utcval + $offset > 10) {
-    print "not ok 15  # (localtime)\n# UTC: @utclocal\n# VMS: @vmslocal\n";
-  }
-  else { print "ok 15\n"; }
+  ok($vmsval - $utcval + $offset <= 10, "(localtime)\n# UTC: @utclocal\n# VMS: @vmslocal");
 
   $utcval = $utcgmtime[5] * 31536000 + $utcgmtime[7] * 86400 +
             $utcgmtime[2] * 3600     + $utcgmtime[1] * 60 + $utcgmtime[0];
   $vmsval = $vmsgmtime[5] * 31536000 + $vmsgmtime[7] * 86400 +
             $vmsgmtime[2] * 3600     + $vmsgmtime[1] * 60 + $vmsgmtime[0];
-  if ($vmsval - $utcval + $offset > 10) {
-    print "not ok 16  # (gmtime)\n# UTC: @utcgmtime\n# VMS: @vmsgmtime\n";
-  }
-  else { print "ok 16\n"; }
+  ok($vmsval - $utcval + $offset <= 10, "(gmtime)\n# UTC: @utcgmtime\n# VMS: @vmsgmtime");
 
-  if ($vmsmtime - $utcmtime + $offset > 10) {
-    print "not ok 17  # (stat) UTC: $utcmtime  VMS: $vmsmtime\n";
-  }
-  else { print "ok 17\n"; }
+  ok($vmsmtime - $utcmtime + $offset <= 10,"(stat) UTC: $utcmtime  VMS: $vmsmtime");
 }
 
 #====== need this to make sure error messages come out, even if
diff --git a/vms/vms.c b/vms/vms.c
index bd9ed125b4..1150ea3859 100644
--- a/vms/vms.c
+++ b/vms/vms.c
@@ -6911,6 +6911,44 @@ mod2fname(pTHX_ CV *cv)
 }
 
 void
+hushexit_fromperl(pTHX_ CV *cv)
+{
+    dXSARGS;
+
+    if (items > 0) {
+        VMSISH_HUSHED = SvTRUE(ST(0));
+    }
+    ST(0) = boolSV(VMSISH_HUSHED);
+    XSRETURN(1);
+}
+
+void  
+Perl_sys_intern_dup(pTHX_ struct interp_intern *src, 
+                          struct interp_intern *dst)
+{
+    memcpy(dst,src,sizeof(struct interp_intern));
+}
+
+void  
+Perl_sys_intern_clear(pTHX)
+{
+}
+
+void  
+Perl_sys_intern_init(pTHX)
+{
+    int ix = RAND_MAX;
+    float x;
+
+    VMSISH_HUSHED = 0;
+
+    x = (float)ix;
+    MY_INV_RAND_MAX = 1./x;
+}
+
+
+
+void
 init_os_extras()
 {
   dTHX;
@@ -6932,18 +6970,10 @@ init_os_extras()
   newXSproto("VMS::Filespec::candelete",candelete_fromperl,file,"$");
   newXSproto("DynaLoader::mod2fname", mod2fname, file, "$");
   newXS("File::Copy::rmscopy",rmscopy_fromperl,file);
+  newXSproto("vmsish::hushed",hushexit_fromperl,file,";$");
 
   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;
 }
   
diff --git a/vms/vmsish.h b/vms/vmsish.h
index 93af772415..34062b7a07 100644
--- a/vms/vmsish.h
+++ b/vms/vmsish.h
@@ -285,16 +285,24 @@
 #define COMPLEX_STATUS	1	/* We track both "POSIX" and VMS values */
 
 #define HINT_V_VMSISH		24
-#define HINT_M_VMSISH_HUSHED	0x20000000 /* stifle error msgs on exit */
 #define HINT_M_VMSISH_STATUS	0x40000000 /* system, $? return VMS status */
 #define HINT_M_VMSISH_TIME	0x80000000 /* times are local, not UTC */
 #define NATIVE_HINTS		(PL_hints >> HINT_V_VMSISH)  /* used in op.c */
 
 #define TEST_VMSISH(h)	(PL_curcop->op_private & ((h) >> HINT_V_VMSISH))
-#define VMSISH_HUSHED	TEST_VMSISH(HINT_M_VMSISH_HUSHED)
 #define VMSISH_STATUS	TEST_VMSISH(HINT_M_VMSISH_STATUS)
 #define VMSISH_TIME	TEST_VMSISH(HINT_M_VMSISH_TIME)
 
+/* VMS-specific data storage */
+
+#define HAVE_INTERP_INTERN
+struct interp_intern {
+    int    hushed;
+    float  inv_rand_max;
+};
+#define VMSISH_HUSHED     (PL_sys_intern.hushed)
+#define MY_INV_RAND_MAX   (PL_sys_intern.inv_rand_max)
+
 /* Flags for vmstrnenv() */
 #define PERL__TRNENV_SECURE 0x01