From: Charles Lane Date: Wed, 5 Dec 2001 22:34:53 +0000 (-0500) Subject: MULTIPLICITY fixups X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=218fdd94f8d5c3dbbf5dc8db8ab55a53057164a1;p=p5sagit%2Fp5-mst-13.2.git MULTIPLICITY fixups Message-Id: <011205223453.8122e@DUPHY4.Physics.Drexel.Edu> p4raw-id: //depot/perl@13484 --- diff --git a/mg.c b/mg.c index d14625e..4369e4a 100644 --- a/mg.c +++ b/mg.c @@ -1102,6 +1102,7 @@ Perl_csighandler_init(void) for (sig = 1; sig < SIG_SIZE; sig++) { #ifdef FAKE_DEFAULT_SIGNAL_HANDLERS + dTHX; sig_defaulting[sig] = 1; (void) rsignal(sig, &Perl_csighandler); #endif diff --git a/vms/vms.c b/vms/vms.c index fc2ae30..4eaa470 100644 --- a/vms/vms.c +++ b/vms/vms.c @@ -1172,6 +1172,7 @@ Perl_sig_to_vmscondition(int sig) int Perl_my_kill(int pid, int sig) { + dTHX; int iss; unsigned int code; int sys$sigprc(unsigned int *pidadr, @@ -1522,8 +1523,8 @@ popen_completion_ast(pInfo info) } -static unsigned long int setup_cmddsc(pTHX_ char *cmd, int check_img, int *suggest_quote); -static void vms_execfree(pTHX); +static unsigned long int setup_cmddsc(pTHX_ char *cmd, int check_img, int *suggest_quote, struct dsc$descriptor_s **pvmscmd); +static void vms_execfree(struct dsc$descriptor_s *vmscmd); /* we actually differ from vmstrnenv since we use this to @@ -1995,7 +1996,7 @@ store_pipelocs(pTHX) STRLEN n_a; if (head_PLOC) - free_pipelocs(&head_PLOC); + free_pipelocs(aTHX_ &head_PLOC); /* the . directory from @INC comes last */ @@ -2006,7 +2007,11 @@ store_pipelocs(pTHX) /* get the directory from $^X */ +#ifdef PERL_IMPLICIT_CONTEXT + if (aTHX && PL_origargv && PL_origargv[0]) { /* maybe nul if embedded Perl */ +#else if (PL_origargv && PL_origargv[0]) { /* maybe nul if embedded Perl */ +#endif strcpy(temp, PL_origargv[0]); x = strrchr(temp,']'); if (x) x[1] = '\0'; @@ -2022,6 +2027,9 @@ store_pipelocs(pTHX) /* reverse order of @INC entries, skip "." since entered above */ +#ifdef PERL_IMPLICIT_CONTEXT + if (aTHX) +#endif if (PL_incgv) av = GvAVn(PL_incgv); for (i = 0; av && i <= AvFILL(av); i++) { @@ -2051,7 +2059,6 @@ store_pipelocs(pTHX) p->dir[NAM$C_MAXRSS] = '\0'; } #endif - Perl_call_atexit(aTHX_ &free_pipelocs, &head_PLOC); } @@ -2203,6 +2210,7 @@ safe_popen(pTHX_ char *cmd, char *in_mode, int *psts) DSC$K_CLASS_S, 0}; struct dsc$descriptor_s d_sym_cmd = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, cmd_sym_name}; + struct dsc$descriptor_s *vmscmd; $DESCRIPTOR(d_sym_in ,"PERL_POPEN_IN"); $DESCRIPTOR(d_sym_out,"PERL_POPEN_OUT"); $DESCRIPTOR(d_sym_err,"PERL_POPEN_ERR"); @@ -2254,7 +2262,7 @@ safe_popen(pTHX_ char *cmd, char *in_mode, int *psts) vmspipedsc.dsc$a_pointer = tfilebuf; vmspipedsc.dsc$w_length = strlen(tfilebuf); - sts = setup_cmddsc(aTHX_ cmd,0,0); + sts = setup_cmddsc(aTHX_ cmd,0,0,&vmscmd); if (!(sts & 1)) { switch (sts) { case RMS$_FNF: case RMS$_DNF: @@ -2432,10 +2440,10 @@ safe_popen(pTHX_ char *cmd, char *in_mode, int *psts) d_symbol.dsc$w_length = strlen(symbol); _ckvmssts(lib$set_symbol(&d_sym_out, &d_symbol, &table)); - p = VMSCMD.dsc$a_pointer; + p = vmscmd->dsc$a_pointer; while (*p && *p != '\n') p++; *p = '\0'; /* truncate on \n */ - p = VMSCMD.dsc$a_pointer; + p = vmscmd->dsc$a_pointer; while (*p == ' ' || *p == '\t') p++; /* remove leading whitespace */ if (*p == '$') p++; /* remove leading $ */ while (*p == ' ' || *p == '\t') p++; @@ -2477,9 +2485,13 @@ safe_popen(pTHX_ char *cmd, char *in_mode, int *psts) _ckvmssts(lib$delete_symbol(&d_sym_in, &table)); _ckvmssts(lib$delete_symbol(&d_sym_err, &table)); _ckvmssts(lib$delete_symbol(&d_sym_out, &table)); - vms_execfree(aTHX); + vms_execfree(vmscmd); +#ifdef PERL_IMPLICIT_CONTEXT + if (aTHX) +#endif PL_forkprocess = info->pid; + if (wait) { int done = 0; while (!done) { @@ -4285,10 +4297,12 @@ static void pipe_and_fork(pTHX_ char **cmargv) { PerlIO *fp; + struct dsc$descriptor_s *vmscmd; char subcmd[2*MAX_DCL_LINE_LENGTH], *p, *q; int sts, j, l, ismcr, quote, tquote = 0; - sts = setup_cmddsc(cmargv[0],0,"e); + sts = setup_cmddsc(aTHX_ cmargv[0],0,"e,&vmscmd); + vms_execfree(vmscmd); j = l = 0; p = subcmd; @@ -4324,7 +4338,7 @@ pipe_and_fork(pTHX_ char **cmargv) } *p = '\0'; - fp = safe_popen(subcmd,"wbF",&sts); + fp = safe_popen(aTHX_ subcmd,"wbF",&sts); if (fp == Nullfp) { PerlIO_printf(Perl_debug_log,"Can't open output pipe (status %d)",sts); } @@ -4933,15 +4947,13 @@ my_vfork() static void -vms_execfree(pTHX) { - if (PL_Cmd) { - if (PL_Cmd != VMSCMD.dsc$a_pointer) Safefree(PL_Cmd); - PL_Cmd = Nullch; - } - if (VMSCMD.dsc$a_pointer) { - Safefree(VMSCMD.dsc$a_pointer); - VMSCMD.dsc$w_length = 0; - VMSCMD.dsc$a_pointer = Nullch; +vms_execfree(struct dsc$descriptor_s *vmscmd) +{ + if (vmscmd) { + if (vmscmd->dsc$a_pointer) { + Safefree(vmscmd->dsc$a_pointer); + } + Safefree(vmscmd); } } @@ -4990,17 +5002,26 @@ setup_argstr(pTHX_ SV *really, SV **mark, SV **sp) static unsigned long int -setup_cmddsc(pTHX_ char *cmd, int check_img, int *suggest_quote) +setup_cmddsc(pTHX_ char *cmd, int check_img, int *suggest_quote, + struct dsc$descriptor_s **pvmscmd) { char vmsspec[NAM$C_MAXRSS+1], resspec[NAM$C_MAXRSS+1]; $DESCRIPTOR(defdsc,".EXE"); $DESCRIPTOR(defdsc2,"."); $DESCRIPTOR(resdsc,resspec); + struct dsc$descriptor_s *vmscmd; struct dsc$descriptor_s imgdsc = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0}; unsigned long int cxt = 0, flags = 1, retsts = SS$_NORMAL; register char *s, *rest, *cp, *wordbreak; register int isdcl; + New(402,vmscmd,sizeof(struct dsc$descriptor_s),struct dsc$descriptor_s); + vmscmd->dsc$a_pointer = NULL; + vmscmd->dsc$b_dtype = DSC$K_DTYPE_T; + vmscmd->dsc$b_class = DSC$K_CLASS_S; + vmscmd->dsc$w_length = 0; + if (pvmscmd) *pvmscmd = vmscmd; + if (suggest_quote) *suggest_quote = 0; if (strlen(cmd) > MAX_DCL_LINE_LENGTH) @@ -5084,29 +5105,30 @@ setup_cmddsc(pTHX_ char *cmd, int check_img, int *suggest_quote) if (check_img && isdcl) return RMS$_FNF; if (cando_by_name(S_IXUSR,0,resspec)) { - New(402,VMSCMD.dsc$a_pointer,7 + s - resspec + (rest ? strlen(rest) : 0),char); + New(402,vmscmd->dsc$a_pointer,7 + s - resspec + (rest ? strlen(rest) : 0),char); if (!isdcl) { - strcpy(VMSCMD.dsc$a_pointer,"$ MCR "); + strcpy(vmscmd->dsc$a_pointer,"$ MCR "); if (suggest_quote) *suggest_quote = 1; } else { - strcpy(VMSCMD.dsc$a_pointer,"@"); + strcpy(vmscmd->dsc$a_pointer,"@"); if (suggest_quote) *suggest_quote = 1; } - strcat(VMSCMD.dsc$a_pointer,resspec); - if (rest) strcat(VMSCMD.dsc$a_pointer,rest); - VMSCMD.dsc$w_length = strlen(VMSCMD.dsc$a_pointer); - return (VMSCMD.dsc$w_length > MAX_DCL_LINE_LENGTH ? CLI$_BUFOVF : retsts); + strcat(vmscmd->dsc$a_pointer,resspec); + if (rest) strcat(vmscmd->dsc$a_pointer,rest); + vmscmd->dsc$w_length = strlen(vmscmd->dsc$a_pointer); + return (vmscmd->dsc$w_length > MAX_DCL_LINE_LENGTH ? CLI$_BUFOVF : retsts); } else retsts = RMS$_PRV; } } /* It's either a DCL command or we couldn't find a suitable image */ - VMSCMD.dsc$w_length = strlen(cmd); - if (cmd == PL_Cmd) { - VMSCMD.dsc$a_pointer = PL_Cmd; + vmscmd->dsc$w_length = strlen(cmd); +/* if (cmd == PL_Cmd) { + vmscmd->dsc$a_pointer = PL_Cmd; if (suggest_quote) *suggest_quote = 1; } - else VMSCMD.dsc$a_pointer = savepvn(cmd,VMSCMD.dsc$w_length); + else */ + vmscmd->dsc$a_pointer = savepvn(cmd,vmscmd->dsc$w_length); /* check if it's a symbol (for quoting purposes) */ if (suggest_quote && !*suggest_quote) { @@ -5115,7 +5137,7 @@ setup_cmddsc(pTHX_ char *cmd, int check_img, int *suggest_quote) struct dsc$descriptor_s eqvdsc = {sizeof(equiv), DSC$K_DTYPE_T, DSC$K_CLASS_S, 0}; eqvdsc.dsc$a_pointer = equiv; - iss = lib$get_symbol(&VMSCMD,&eqvdsc); + iss = lib$get_symbol(vmscmd,&eqvdsc); if (iss&1 && (*equiv == '$' || *equiv == '@')) *suggest_quote = 1; } if (!(retsts & 1)) { @@ -5126,7 +5148,7 @@ setup_cmddsc(pTHX_ char *cmd, int check_img, int *suggest_quote) else { _ckvmssts(retsts); } } - return (VMSCMD.dsc$w_length > MAX_DCL_LINE_LENGTH ? CLI$_BUFOVF : retsts); + return (vmscmd->dsc$w_length > MAX_DCL_LINE_LENGTH ? CLI$_BUFOVF : retsts); } /* end of setup_cmddsc() */ @@ -5157,6 +5179,7 @@ Perl_vms_do_aexec(pTHX_ SV *really,SV **mark,SV **sp) bool Perl_vms_do_exec(pTHX_ char *cmd) { + struct dsc$descriptor_s *vmscmd; if (vfork_called) { /* this follows a vfork - act Unixish */ vfork_called--; @@ -5172,8 +5195,8 @@ Perl_vms_do_exec(pTHX_ char *cmd) TAINT_ENV(); TAINT_PROPER("exec"); - if ((retsts = setup_cmddsc(aTHX_ cmd,1,0)) & 1) - retsts = lib$do_command(&VMSCMD); + if ((retsts = setup_cmddsc(aTHX_ cmd,1,0,&vmscmd)) & 1) + retsts = lib$do_command(vmscmd); switch (retsts) { case RMS$_FNF: case RMS$_DNF: @@ -5196,9 +5219,9 @@ Perl_vms_do_exec(pTHX_ char *cmd) set_vaxc_errno(retsts); if (ckWARN(WARN_EXEC)) { Perl_warner(aTHX_ WARN_EXEC,"Can't exec \"%*s\": %s", - VMSCMD.dsc$w_length, VMSCMD.dsc$a_pointer, Strerror(errno)); + vmscmd->dsc$w_length, vmscmd->dsc$a_pointer, Strerror(errno)); } - vms_execfree(aTHX); + vms_execfree(vmscmd); } return FALSE; @@ -5256,7 +5279,7 @@ Perl_do_spawn(pTHX_ char *cmd) sts = substs; } else { - (void) safe_popen(cmd, "nW", (int *)&sts); + (void) safe_popen(aTHX_ cmd, "nW", (int *)&sts); } return sts; } /* end of do_spawn() */ @@ -7235,11 +7258,6 @@ Perl_sys_intern_init(pTHX) x = (float)ix; MY_INV_RAND_MAX = 1./x; - - VMSCMD.dsc$a_pointer = NULL; - VMSCMD.dsc$w_length = 0; - VMSCMD.dsc$b_dtype = DSC$K_DTYPE_T; - VMSCMD.dsc$b_class = DSC$K_CLASS_S; } void diff --git a/vms/vmsish.h b/vms/vmsish.h index 573f254..093ea69 100644 --- a/vms/vmsish.h +++ b/vms/vmsish.h @@ -299,11 +299,9 @@ struct interp_intern { int hushed; float inv_rand_max; - struct dsc$descriptor_s VMScmd; }; #define VMSISH_HUSHED (PL_sys_intern.hushed) #define MY_INV_RAND_MAX (PL_sys_intern.inv_rand_max) -#define VMSCMD (PL_sys_intern.VMScmd) /* Flags for vmstrnenv() */ #define PERL__TRNENV_SECURE 0x01