Okay, at last a fix to the "use vmsish 'hushed';"
First off, a bit of background:
o When Perl exits with an error status, you typically get (on VMS)
an error message
"%SYSTEM-F-ABORT,..."
or the like. This causes plenty of problems in cases where a more
unix-like behavior is expected.
o The error message is printed by DCL to SYS$OUTPUT (and SYS$ERROR if
it is different than SYS$OUTPUT) after the Perl image exits. Messing
around with things like user-mode logicals doesn't help supress the
messages, and non-user-mode logicals have too broad an effect.
o The preferred/standard way of supressing the DCL messages is to
set a high-order bit in the error code that is returned at image
exit. Easy enough....this is the desired behavior when vmsish
exits are "hushed".
Here's where the discussion/argument starts, I think:
o Error & abort exits can occur in a number of places in Perl, not
just with the "exit" op, so one shouldn't just tie the "hushed"
status to an op. Ugly as it is, a global flag is really what
is needed.
(The 'hushed' flag is used in the STATUS_NATIVE_EXPORT, which
is certainly used in exit context...but also by the JMPENV_JUMP
macro, used in a number of places, possibly by XS code?)
Anyway, this patch is an attempt to use a bit of PL_exit_flags for
'hushed' behavior...setting the bit is a bit trickier, there's (AFAIK)
nothing as simple as $^H for setting bits in PL_exit_flags. So I
cooked up a "built in" routine (called VMS::ISH::hushexit ... suggestions
on alternate names most welcome!) that sets/returns the hushed bit.
Passes the [.lib]vmsish test, but I haven't figured out yet how to trigger
exits via the JMPENV_JUMP macros.
Here's the patch:
diff -uBb lib/vmsish.pm-orig lib/vmsish.pm
--- lib/vmsish.pm-orig Sat Oct 6 22:43:06 2001
+++ lib/vmsish.pm Mon Oct 8 10:18:22 2001
@@ -67,7 +67,6 @@
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 +75,23 @@
sub import {
shift;
- $^H |= bits(@_ ? @_ : qw(status time hushed));
+ $^H |= bits(@_ ? @_ : qw(status time));
my $sememe;
foreach $sememe (@_ ? @_ : qw(exit)) {
$^H{'vmsish_exit'} = 1 if $sememe eq 'exit';
+ VMS::ISH::hushexit(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)) {
$^H{'vmsish_exit'} = 0 if $sememe eq 'exit';
+ VMS::ISH::hushexit(0) if $sememe eq 'hushed';
}
}
diff -uBb vms/vms.c-orig vms/vms.c
--- vms/vms.c-orig Fri Oct 5 10:48:32 2001
+++ vms/vms.c Mon Oct 8 11:58:52 2001
@@ -6904,6 +6911,26 @@
}
void
+hushedexit_fromperl(pTHX_ CV *cv)
+{
+ dXSARGS;
+
+ if (items > 0) {
+ if (SvTRUE(ST(0))) {
+ PL_exit_flags |= PERL_EXIT_VMSHUSHED;
+ } else {
+ PL_exit_flags &= ~PERL_EXIT_VMSHUSHED;
+ }
+ }
+ ST(0) = boolSV(VMSISH_HUSHED);
+ XSRETURN(1);
+}
+
+
+
+
+
+void
init_os_extras()
{
dTHX;
@@ -6925,6 +6952,7 @@
newXSproto("VMS::Filespec::candelete",candelete_fromperl,file,"$");
newXSproto("DynaLoader::mod2fname", mod2fname, file, "$");
newXS("File::Copy::rmscopy",rmscopy_fromperl,file);
+ newXSproto("VMS::ISH::hushexit",hushedexit_fromperl,file,";$");
store_pipelocs(aTHX);
diff -uBb vms/vmsish.h-orig vms/vmsish.h
--- vms/vmsish.h-orig Sat Oct 6 22:39:40 2001
+++ vms/vmsish.h Mon Oct 8 13:22:06 2001
@@ -285,15 +285,14 @@
#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)
+#define VMSISH_HUSHED (PL_exit_flags&PERL_EXIT_VMSHUSHED)
/* Flags for vmstrnenv() */
#define PERL__TRNENV_SECURE 0x01
diff -uBb perl.h-orig perl.h
--- perl.h-orig Mon Oct 8 13:23:17 2001
+++ perl.h Mon Oct 8 09:19:46 2001
@@ -1948,6 +1948,9 @@
/* flags in PL_exit_flags for nature of exit() */
#define PERL_EXIT_EXPECTED 0x01
#define PERL_EXIT_DESTRUCT_END 0x02 /* Run END in perl_destruct */
+#ifdef VMS
+#define PERL_EXIT_VMSHUSHED 0x04 /* no VMS message when err exit */
+#endif
#ifndef MEMBER_TO_FPTR
# define MEMBER_TO_FPTR(name) name
--
Drexel University \V --Chuck Lane
======]---------->--------*------------<-------[===========
(215) 895-1545 _/ \ Particle Physics
FAX: (215) 895-5934 /\ /~~~~~~~~~~~ [EMAIL PROTECTED]
