Permalink
Browse files

vmsish fix, ieee rand() cleanup

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

p4raw-id: //depot/perl@12513
  • Loading branch information...
1 parent b8d190f commit 96e176bf068724d05d4927c116d41d2f78a2560d @celane celane committed with jhi Oct 19, 2001
Showing with 198 additions and 90 deletions.
  1. +1 −4 configure.com
  2. +7 −1 dump.c
  3. +1 −0 ext/B/t/stash.t
  4. +10 −0 op.c
  5. +2 −1 op.h
  6. +1 −1 opcode.h
  7. +1 −1 opcode.pl
  8. +3 −0 perl.c
  9. +2 −1 perl.h
  10. +0 −4 perlvars.h
  11. +1 −0 pp.sym
  12. +1 −0 pp_ctl.c
  13. +1 −0 pp_proto.h
  14. +3 −0 pp_sys.c
  15. +62 −12 vms/ext/vmsish.pm
  16. +53 −54 vms/ext/vmsish.t
  17. +39 −9 vms/vms.c
  18. +10 −2 vms/vmsish.h
View
@@ -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..."
View
8 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");
View
@@ -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
}
View
10 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);
}
View
3 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 {
View
@@ -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 */
View
@@ -652,7 +652,7 @@ sub tab {
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 @
View
3 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:
View
3 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"
View
@@ -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
View
1 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
View
@@ -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;
View
@@ -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)
View
@@ -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);
View
@@ -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';
}
}
Oops, something went wrong.

0 comments on commit 96e176b

Please sign in to comment.