This patch changes VMS to dynamically load the code to create the
DECTerm (xterm) for the forked debug session if it is available on the
system instead of it being a build option.
-John
[EMAIL PROTECTED]
Personal Opinion Only
--- /rsync_root/perl/vms/vms.c Tue Jul 24 08:06:02 2007
+++ vms/vms.c Wed Jul 25 18:52:29 2007
@@ -91,6 +91,17 @@
void * nullarg);
#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)
@@ -144,12 +155,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,
@@ -157,8 +166,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 */
@@ -3769,8 +3777,6 @@
}
-#ifdef USE_VMS_DECTERM
-
static int vms_is_syscommand_xterm(void)
{
const static struct dsc$descriptor_s syscommand_dsc =
@@ -3861,6 +3867,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;
@@ -3872,6 +3884,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();
@@ -3917,7 +3960,7 @@
device_name_len = 0;
/* Try to create the window */
- status = decw$term_port
+ status = (*decw_term_port)
(NULL,
NULL,
&customization_dsc,
@@ -3996,7 +4039,6 @@
/* All done */
return info->fp;
}
-#endif
static PerlIO *
safe_popen(pTHX_ const char *cmd, const char *in_mode, int *psts)
@@ -4026,7 +4068,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.
@@ -4038,7 +4079,6 @@
if (xterm_fd != Nullfp)
return xterm_fd;
}
-#endif
if (!head_PLOC) store_pipelocs(aTHX); /* at least TRY to use a static
vmspipe file */
--- /rsync_root/perl/vms/descrip_mms.template Sat Jul 7 02:51:57 2007
+++ vms/descrip_mms.template Tue Jul 24 21:36:50 2007
@@ -33,7 +33,6 @@
~MTU~
~FLAGS~
~LARGEFILE~
-~DECTERMLIB~
#: >>>>> Architecture-specific options <<<<<
.ifdef IXE
@@ -1731,7 +1730,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)"
--- /rsync_root/perl/configure.com Sun Jul 22 20:48:36 2007
+++ configure.com Tue Jul 24 21:53:06 2007
@@ -52,7 +52,6 @@
$ uselongdouble = "n"
$ uselargefiles = "n"
$ usestdstat = "n"
-$ usedecterm = "n"
$ usesitecustomize = "n"
$ C_Compiler_Replace = "CC="
$ thread_upcalls = "MTU="
@@ -907,7 +906,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:
@@ -2586,44 +2585,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"
@@ -6734,7 +6695,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
@@ -6809,17 +6769,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
@@ -6840,7 +6789,6 @@
$ WC "PV=''version'"
$ WC "FLAGS=FLAGS=''extra_flags'"
$ WC "''LARGEFILE_REPLACE'"
-$ WC "''DECTERM_REPLACE'"
$ close CONFIG
$!
$ echo4 "Extracting ''defmakefile' (with variable substitutions)"
