From: John E. Malmberg Date: Thu, 26 Jul 2007 00:28:04 +0000 (-0500) Subject: [patch@31658] Dynamically load dbg xterm on VMS X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=8cb5d3d514e985ef6a9641779aa443d9073a96ef;p=p5sagit%2Fp5-mst-13.2.git [patch@31658] Dynamically load dbg xterm on VMS From: "John E. Malmberg" Message-ID: <46A830E4.1040708@qsl.net> p4raw-id: //depot/perl@31661 --- diff --git a/configure.com b/configure.com index 1d270a8..93e28c8 100644 --- a/configure.com +++ b/configure.com @@ -52,7 +52,6 @@ $ use64bitint = "n" $ uselongdouble = "n" $ uselargefiles = "n" $ usestdstat = "n" -$ usedecterm = "n" $ usesitecustomize = "n" $ C_Compiler_Replace = "CC=" $ thread_upcalls = "MTU=" @@ -907,7 +906,7 @@ $ config_symbols1 ="|installprivlib|installscript|installsitearch|installsitel $ 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 @@ $ ELSE $ 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 @@ $! Alas this does not help to build Fcntl $! 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 @@ $ ENDIF $ 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 "''THREAD_KERNEL'" $ WC "PV=''version'" $ WC "FLAGS=FLAGS=''extra_flags'" $ WC "''LARGEFILE_REPLACE'" -$ WC "''DECTERM_REPLACE'" $ close CONFIG $! $ echo4 "Extracting ''defmakefile' (with variable substitutions)" diff --git a/vms/descrip_mms.template b/vms/descrip_mms.template index 6772a27..9bb17a1 100644 --- a/vms/descrip_mms.template +++ b/vms/descrip_mms.template @@ -33,7 +33,6 @@ ~MTU~ ~FLAGS~ ~LARGEFILE~ -~DECTERMLIB~ #: >>>>> Architecture-specific options <<<<< .ifdef IXE @@ -1731,7 +1730,7 @@ vms.c : [.vms]vms.c 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)" diff --git a/vms/vms.c b/vms/vms.c index 27214f7..026a47d 100644 --- a/vms/vms.c +++ b/vms/vms.c @@ -91,6 +91,17 @@ int sys$getdviw 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 @@ return 0; # 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 @@ int decw$term_port 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 @@ vmspipe_tempfile(pTHX) } -#ifdef USE_VMS_DECTERM - static int vms_is_syscommand_xterm(void) { const static struct dsc$descriptor_s syscommand_dsc = @@ -3861,6 +3867,12 @@ static PerlIO * create_forked_xterm(pTHX_ const char *cmd, const char *mode) 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 @@ static PerlIO * create_forked_xterm(pTHX_ const char *cmd, const char *mode) 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 @@ static PerlIO * create_forked_xterm(pTHX_ const char *cmd, const char *mode) 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 @@ static PerlIO * create_forked_xterm(pTHX_ const char *cmd, const char *mode) /* All done */ return info->fp; } -#endif static PerlIO * safe_popen(pTHX_ const char *cmd, const char *in_mode, int *psts) @@ -4026,7 +4068,6 @@ safe_popen(pTHX_ const char *cmd, const char *in_mode, int *psts) $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 @@ safe_popen(pTHX_ const char *cmd, const char *in_mode, int *psts) if (xterm_fd != Nullfp) return xterm_fd; } -#endif if (!head_PLOC) store_pipelocs(aTHX); /* at least TRY to use a static vmspipe file */