Change 33005 by [EMAIL PROTECTED] on 2008/01/18 19:14:53
Integrate:
[ 31360]
Make pipe shutdown on VMS care about whether PerlIO has already
shut down.
[ 31661]
Subject: [EMAIL PROTECTED] Dynamically load dbg xterm on VMS
From: "John E. Malmberg" <[EMAIL PROTECTED]>
Date: Thu, 26 Jul 2007 00:28:04 -0500
Message-ID: <[EMAIL PROTECTED]>
[ 32106]
Normalize the case of some VMS syscalls so the prototypes are
kosher on a system with older headers.
[ 32577]
Fix missing sharpbang definition in configure.com.
[ 32602]
Tolkien quote for vms/vms.c.
Affected files ...
... //depot/maint-5.8/perl/configure.com#61 integrate
... //depot/maint-5.8/perl/vms/descrip_mms.template#56 integrate
... //depot/maint-5.8/perl/vms/vms.c#32 integrate
Differences ...
==== //depot/maint-5.8/perl/configure.com#61 (text) ====
Index: perl/configure.com
--- perl/configure.com#60~32543~ 2007-11-28 14:15:48.000000000 -0800
+++ perl/configure.com 2008-01-18 11:14:53.000000000 -0800
@@ -51,7 +51,6 @@
$ use64bitint = "n"
$ uselongdouble = "n"
$ uselargefiles = "n"
-$ usedecterm = "n"
$ usesitecustomize = "n"
$ C_Compiler_Replace = "CC="
$ thread_upcalls = "MTU="
@@ -853,7 +852,6 @@
$ ENDIF !(needman .EQS. "true")
$!
$!: see if sh knows # comments !sfn
-$ sharpbang = "$ "
$!: figure out how to guarantee sh startup !sfn
$!: find out where common programs are !sfn
$!loclist="awk/cat/comm/cp/echo/expr/find/grep/ln/ls/mkdir/rm/sed/sort/touch/tr/uniq"
@@ -906,7 +904,7 @@
$ config_symbols2
="|prefix|privlib|privlibexp|scriptdir|sitearch|sitearchexp|sitebin|sitelib|sitelib_stem|sitelibexp|try_cxx|use64bitall|use64bitint|"
$ config_symbols3
="|usecasesensitive|usedefaulttypes|usedevel|useieee|useithreads|uselongdouble|usemultiplicity|usemymalloc|usedebugging_perl|"
$ config_symbols4
="|useperlio|usesecurelog|usethreads|usevmsdebug|usefaststdio|usemallocwrap|unlink_all_versions|uselargefiles|usesitecustomize|"
-$ config_symbols5
="|buildmake|builder|usethreadupcalls|usekernelthreads|usedecterm"
+$ config_symbols5 ="|buildmake|builder|usethreadupcalls|usekernelthread"
$!
$ open/read CONFIG 'config_sh'
$ rd_conf_loop:
@@ -2585,44 +2583,6 @@
$ d_unlink_all_versions = "undef"
$ ENDIF
$!
-$! To avoid 'SYSTEM-F-PROTINSTALL, protected images must be installed'
-$! at run time, we must check that the DECterm image is both present
-$! and installed as a known image.
-$!
-$ decterm_capable = "FALSE"
-$ dflt = "SYS$SHARE:DECW$TERMINALSHR12.EXE"
-$ IF F$SEARCH(dflt) .NES. ""
-$ THEN
-$ decterm_capable = F$FILE_ATTRIBUTES(dflt, "KNOWN")
-$ ELSE
-$ dflt = "SYS$SHARE:DECW$TERMINALSHR.EXE"
-$ IF F$SEARCH(dflt) .NES. "" THEN decterm_capable =
F$FILE_ATTRIBUTES(dflt, "KNOWN")
-$ ENDIF
-$!
-$ IF F$TYPE(usedecterm) .NES. ""
-$ THEN
-$ if usedecterm .or. usedecterm .eqs. "define"
-$ then
-$ bool_dflt="y"
-$ else
-$ bool_dflt="n"
-$ endif
-$ ELSE
-$ bool_dflt="n"
-$ ENDIF
-$ IF .NOT. use_debugging_perl THEN bool_dflt = "n"
-$ echo ""
-$ echo "Perl can be built to support DECterms from the Perl debugger"
-$ echo ""
-$ echo "If this does not make any sense to you, just accept the default '" +
bool_dflt + "'."
-$ rp = "Build with DECterm Perl debugger support, if available? [''bool_dflt']
"
-$ GOSUB myread
-$ usedecterm=ans
-$ IF (usedecterm .OR. usedecterm .EQS. "define") .AND. .NOT. decterm_capable
-$ THEN
-$ echo4 "No installed DECterm image found, disabling..."
-$ usedecterm = "n"
-$ ENDIF
$! CC Flags
$ echo ""
$ echo "Your compiler may want other flags. For this question you should
include"
@@ -6416,6 +6376,7 @@
$ WC "selectminbits='32'"
$ WC "selecttype='" + selecttype + "'"
$ WC "sh='MCR'"
+$ WC "sharpbang='#!'"
$ WC "shmattype='" + " '"
$ WC "shortsize='" + shortsize + "'"
$ IF (f$length(sig_name) .GE. 244)
@@ -6747,7 +6708,6 @@
$! WC "#define PERL_IGNORE_FPUSIG SIGFPE"
$ ENDIF
$ IF kill_by_sigprc .EQS. "define" then WC "#define KILL_BY_SIGPRC"
-$ IF usedecterm .OR. usedecterm .EQS. "define" then WC "#define
USE_VMS_DECTERM"
$ IF unlink_all_versions .OR. unlink_all_versions .EQS. "define" THEN -
WC "#define UNLINK_ALL_VERSIONS"
$ CLOSE CONFIG
@@ -6823,17 +6783,6 @@
$ ELSE
$ LARGEFILE_REPLACE = "LARGEFILE="
$ ENDIF
-$ IF usedecterm .OR. usedecterm .EQS. "define"
-$ THEN
-$ IF F$SEARCH("SYS$SHARE:DECW$TERMINALSHR12.EXE") .nes. ""
-$ THEN
-$ DECTERM_REPLACE = "DECTERMLIB=DECTERMLIB=DECW$TERMINALSHR12/SHARE"
-$ ELSE
-$ DECTERM_REPLACE = "DECTERMLIB=DECTERMLIB=DECW$TERMINALSHR/SHARE"
-$ ENDIF
-$ ELSE
-$ DECTERM_REPLACE = "DECTERMLIB=DECTERMLIB="
-$ ENDIF
$!
$! In order not to stress the tiny command buffer on pre-7.3-2 systems,
$! we put the following substitutions in a file and pass the file to
@@ -6854,7 +6803,6 @@
$ WC "PV=''version'"
$ WC "FLAGS=FLAGS=''extra_flags'"
$ WC "''LARGEFILE_REPLACE'"
-$ WC "''DECTERM_REPLACE'"
$ close CONFIG
$!
$ echo4 "Extracting ''defmakefile' (with variable substitutions)"
==== //depot/maint-5.8/perl/vms/descrip_mms.template#56 (text) ====
Index: perl/vms/descrip_mms.template
--- perl/vms/descrip_mms.template#55~32457~ 2007-11-22 15:19:55.000000000
-0800
+++ perl/vms/descrip_mms.template 2008-01-18 11:14:53.000000000 -0800
@@ -33,7 +33,6 @@
~MTU~
~FLAGS~
~LARGEFILE~
-~DECTERMLIB~
#: >>>>> Architecture-specific options <<<<<
.ifdef IXE
@@ -1672,7 +1671,7 @@
Copy/Log/Noconfirm [.vms]vms.c []
$(CRTL) : $(MAKEFILE)
- @ @[.vms]genopt "$(CRTL)/Write" "|"
"$(LIBS1)|$(FULLLIBS2)|$(SOCKLIB)|$(DECTERMLIB)"
+ @ @[.vms]genopt "$(CRTL)/Write" "|" "$(LIBS1)|$(FULLLIBS2)|$(SOCKLIB)"
ok : $(utils)
$(MINIPERL) lib/perlbug.com -ok -s "(UNINSTALLED)"
==== //depot/maint-5.8/perl/vms/vms.c#32 (text) ====
Index: perl/vms/vms.c
--- perl/vms/vms.c#31~32540~ 2007-11-28 12:56:52.000000000 -0800
+++ perl/vms/vms.c 2008-01-18 11:14:53.000000000 -0800
@@ -11,6 +11,17 @@
* Please see Changes*.* or the Perl Repository Browser for revision
history.
*/
+/*
+ * Yet small as was their hunted band
+ * still fell and fearless was each hand,
+ * and strong deeds they wrought yet oft,
+ * and loved the woods, whose ways more soft
+ * them seemed than thralls of that black throne
+ * to live and languish in halls of stone.
+ *
+ * The Lay of Leithian, 135-40
+ */
+
#include <acedef.h>
#include <acldef.h>
#include <armdef.h>
@@ -79,6 +90,17 @@
#include <unixlib.h>
#endif
+#ifdef lib$find_image_symbol
+#undef lib$find_image_symbol
+int lib$find_image_symbol
+ (const struct dsc$descriptor_s * imgname,
+ const struct dsc$descriptor_s * symname,
+ void * symval,
+ const struct dsc$descriptor_s * defspec,
+ unsigned long flag);
+
+#endif
+
#if __CRTL_VER >= 70300000 && !defined(__VAX)
static int set_feature_default(const char *name, int value)
@@ -128,12 +150,10 @@
# define RTL_USES_UTC 1
#endif
-#ifdef USE_VMS_DECTERM
-
/* Routine to create a decterm for use with the Perl debugger */
/* No headers, this information was found in the Programming Concepts Manual */
-int decw$term_port
+static int (*decw_term_port)
(const struct dsc$descriptor_s * display,
const struct dsc$descriptor_s * setup_file,
const struct dsc$descriptor_s * customization,
@@ -141,8 +161,7 @@
unsigned short * result_device_name_length,
void * controller,
void * char_buffer,
- void * char_change_buffer);
-#endif
+ void * char_change_buffer) = 0;
/* gcc's header files don't #define direct access macros
* corresponding to VAXC's variant structs */
@@ -2112,14 +2131,20 @@
unsigned long int retsts = SS$_NORMAL, abort = SS$_TIMEOUT;
int sts, did_stuff, need_eof, j;
- /*
- flush any pending i/o
+ /*
+ * Flush any pending i/o, but since we are in process run-down, be
+ * careful about referencing PerlIO structures that may already have
+ * been deallocated. We may not even have an interpreter anymore.
*/
info = open_pipes;
while (info) {
if (info->fp) {
- if (!info->useFILE)
- PerlIO_flush(info->fp); /* first, flush data */
+ if (!info->useFILE
+#if defined(USE_ITHREADS)
+ && my_perl
+#endif
+ && PL_perlio_fd_refcnt)
+ PerlIO_flush(info->fp);
else
fflush((FILE *)info->fp);
}
@@ -2953,8 +2978,6 @@
}
-#ifdef USE_VMS_DECTERM
-
static int vms_is_syscommand_xterm(void)
{
const static struct dsc$descriptor_s syscommand_dsc =
@@ -3045,6 +3068,12 @@
struct dsc$descriptor_s d_mbx1 = {sizeof mbx1, DSC$K_DTYPE_T,
DSC$K_CLASS_S, mbx1};
+ /* LIB$FIND_IMAGE_SIGNAL needs a handler */
+ /*---------------------------------------*/
+ VAXC$ESTABLISH((__vms_handler)lib$sig_to_ret);
+
+
+ /* Make sure that this is from the Perl debugger */
ret_char = strstr(cmd," xterm ");
if (ret_char == NULL)
return NULL;
@@ -3056,6 +3085,37 @@
if (ret_char == NULL)
return NULL;
+ if (decw_term_port == 0) {
+ $DESCRIPTOR(filename1_dsc, "DECW$TERMINALSHR12");
+ $DESCRIPTOR(filename2_dsc, "DECW$TERMINALSHR");
+ $DESCRIPTOR(decw_term_port_dsc, "DECW$TERM_PORT");
+
+ status = lib$find_image_symbol
+ (&filename1_dsc,
+ &decw_term_port_dsc,
+ (void *)&decw_term_port,
+ NULL,
+ 0);
+
+ /* Try again with the other image name */
+ if (!$VMS_STATUS_SUCCESS(status)) {
+
+ status = lib$find_image_symbol
+ (&filename2_dsc,
+ &decw_term_port_dsc,
+ (void *)&decw_term_port,
+ NULL,
+ 0);
+
+ }
+
+ }
+
+
+ /* No decw$term_port, give it up */
+ if (!$VMS_STATUS_SUCCESS(status))
+ return NULL;
+
/* Are we on a workstation? */
/* to do: capture the rows / columns and pass their properties */
ret_stat = vms_is_syscommand_xterm();
@@ -3101,7 +3161,7 @@
device_name_len = 0;
/* Try to create the window */
- status = decw$term_port
+ status = (*decw_term_port)
(NULL,
NULL,
&customization_dsc,
@@ -3180,7 +3240,6 @@
/* All done */
return info->fp;
}
-#endif
static PerlIO *
safe_popen(pTHX_ const char *cmd, const char *in_mode, int *psts)
@@ -3210,7 +3269,6 @@
$DESCRIPTOR(d_sym_out,"PERL_POPEN_OUT");
$DESCRIPTOR(d_sym_err,"PERL_POPEN_ERR");
-#ifdef USE_VMS_DECTERM
/* Check here for Xterm create request. This means looking for
* "3>&1 xterm\b" and "\btty 1>&3\b$" in the command, and that it
* is possible to create an xterm.
@@ -3222,7 +3280,6 @@
if (xterm_fd != Nullfp)
return xterm_fd;
}
-#endif
if (!head_PLOC) store_pipelocs(aTHX); /* at least TRY to use a static
vmspipe file */
@@ -3573,8 +3630,12 @@
* the first EOF closing the pipe (and DASSGN'ing the channel)...
*/
if (info->fp) {
- if (!info->useFILE)
- PerlIO_flush(info->fp); /* first, flush data */
+ if (!info->useFILE
+#if defined(USE_ITHREADS)
+ && my_perl
+#endif
+ && PL_perlio_fd_refcnt)
+ PerlIO_flush(info->fp);
else
fflush((FILE *)info->fp);
}
@@ -3596,7 +3657,11 @@
0, 0, 0, 0, 0, 0));
_ckvmssts(sys$setast(1));
if (info->fp) {
- if (!info->useFILE)
+ if (!info->useFILE
+#if defined(USE_ITHREADS)
+ && my_perl
+#endif
+ && PL_perlio_fd_refcnt)
PerlIO_close(info->fp);
else
fclose((FILE *)info->fp);
@@ -3820,6 +3885,7 @@
}
/*}}}*/
+/* One more change from 32106 goes here if the code it refers to is merged. */
/*{{{char *do_rmsexpand(char *fspec, char *out, int ts, char *def, unsigned
opts)*/
/* Shortcut for common case of simple calls to $PARSE and $SEARCH
End of Patch.
