#undef dXSARGS
#define dXSARGS \
dSP; dMARK; \
- I32 ax = mark - stack_base + 1; \
+ I32 ax = mark - PL_stack_base + 1; \
I32 items = sp - mark; \
XSLock localLock; \
::pPerl = pPerl
#define XS(name) void name(cv) CV* cv;
#endif
-#define na PL_na
-#define sv_undef PL_sv_undef
-#define sv_yes PL_sv_yes
-#define sv_no PL_sv_no
-
#define dXSARGS \
dSP; dMARK; \
I32 ax = mark - PL_stack_base + 1; \
#ifdef XS_VERSION
# define XS_VERSION_BOOTCHECK \
STMT_START { \
- SV *Sv; \
- char *vn = Nullch, *module = SvPV(ST(0),na); \
+ SV *tmpsv; \
+ char *vn = Nullch, *module = SvPV(ST(0),PL_na); \
if (items >= 2) /* version supplied as bootstrap arg */ \
- Sv = ST(1); \
+ tmpsv = ST(1); \
else { \
/* XXX GV_ADDWARN */ \
- Sv = perl_get_sv(form("%s::%s", module, \
+ tmpsv = perl_get_sv(form("%s::%s", module, \
vn = "XS_VERSION"), FALSE); \
- if (!Sv || !SvOK(Sv)) \
- Sv = perl_get_sv(form("%s::%s", module, \
+ if (!tmpsv || !SvOK(tmpsv)) \
+ tmpsv = perl_get_sv(form("%s::%s", module, \
vn = "VERSION"), FALSE); \
} \
- if (Sv && (!SvOK(Sv) || strNE(XS_VERSION, SvPV(Sv, na)))) \
+ if (tmpsv && (!SvOK(tmpsv) || strNE(XS_VERSION, SvPV(tmpsv, PL_na)))) \
croak("%s object version %s does not match %s%s%s%s %_", \
module, XS_VERSION, \
vn ? "$" : "", vn ? module : "", vn ? "::" : "", \
- vn ? vn : "bootstrap parameter", Sv); \
+ vn ? vn : "bootstrap parameter", tmpsv); \
} STMT_END
#else
# define XS_VERSION_BOOTCHECK
EXT SV *sv;
#ifndef USE_THREADS
-EXT OP *op;
+EXT OP *PL_op;
#endif
EXT XPV pv;
# Nullsv *must* come first in the following so that the condition
# ($$sv == 0) can continue to be used to test (sv == Nullsv).
-my @specialsv = qw(Nullsv &sv_undef &sv_yes &sv_no);
+my @specialsv = qw(Nullsv &PL_sv_undef &PL_sv_yes &PL_sv_no);
my (%alias_from, $from, $tos);
while (($from, $tos) = each %alias_to) {
#define INIT_SPECIALSV_LIST STMT_START { \
EOT
for ($i = 0; $i < @specialsv; $i++) {
- print BYTERUN_H "\tspecialsv_list[$i] = $specialsv[$i]; \\\n";
+ print BYTERUN_H "\tPL_specialsv_list[$i] = $specialsv[$i]; \\\n";
}
print BYTERUN_H <<'EOT';
} STMT_END
#
ret none none x
ldsv sv svindex
-ldop op opindex
+ldop PL_op opindex
stsv sv U32 s
-stop op U32 s
+stop PL_op U32 s
ldspecsv sv U8 x
newsv sv U8 x
-newop op U8 x
-newopn op U8 x
+newop PL_op U8 x
+newopn PL_op U8 x
newpv none PV
pv_cur pv.xpv_cur STRLEN
pv_free pv none x
gp_line GvLINE(sv) line_t
gp_share sv svindex x
xgv_flags GvFLAGS(sv) U8
-op_next op->op_next opindex
-op_sibling op->op_sibling opindex
-op_ppaddr op->op_ppaddr strconst x
-op_targ op->op_targ PADOFFSET
-op_type op OPCODE x
-op_seq op->op_seq U16
-op_flags op->op_flags U8
-op_private op->op_private U8
+op_next PL_op->op_next opindex
+op_sibling PL_op->op_sibling opindex
+op_ppaddr PL_op->op_ppaddr strconst x
+op_targ PL_op->op_targ PADOFFSET
+op_type PL_op OPCODE x
+op_seq PL_op->op_seq U16
+op_flags PL_op->op_flags U8
+op_private PL_op->op_private U8
op_first cUNOP->op_first opindex
op_last cBINOP->op_last opindex
op_other cLOGOP->op_other opindex
op_pmreplrootgv *(SV**)&cPMOP->op_pmreplroot svindex
op_pmreplstart cPMOP->op_pmreplstart opindex
op_pmnext *(OP**)&cPMOP->op_pmnext opindex
-pregcomp op pvcontents x
+pregcomp PL_op pvcontents x
op_pmflags cPMOP->op_pmflags U16
op_pmpermflags cPMOP->op_pmpermflags U16
op_sv cSVOP->op_sv svindex
cop_seq cCOP->cop_seq U32
cop_arybase cCOP->cop_arybase I32
cop_line cCOP->cop_line line_t
-main_start main_start opindex
-main_root main_root opindex
-curpad curpad svindex x
+main_start PL_main_start opindex
+main_root PL_main_root opindex
+curpad PL_curpad svindex x
{
strconst arg;
BGET_strconst(arg);
- BSET_op_ppaddr(op->op_ppaddr, arg);
+ BSET_op_ppaddr(PL_op->op_ppaddr, arg);
break;
}
case INSN_OP_TARG: /* 85 */
-#define DOOP(ppname) PUTBACK; op = ppname(ARGS); SPAGAIN
+#define DOOP(ppname) PUTBACK; PL_op = ppname(ARGS); SPAGAIN
#define PP_LIST(g) do { \
dMARK; \
if (++MARK <= SP) \
*MARK = *SP; \
else \
- *MARK = &sv_undef; \
+ *MARK = &PL_sv_undef; \
SP = MARK; \
} \
} while (0)
#define MAYBE_TAINT_SASSIGN_SRC(sv) \
- if (tainting && tainted && (!SvGMAGICAL(left) || !SvSMAGICAL(left) || \
+ if (PL_tainting && PL_tainted && (!SvGMAGICAL(left) || !SvSMAGICAL(left) || \
!((mg=mg_find(left, 't')) && mg->mg_len & 1)))\
TAINT_NOT
#define PP_UNSTACK do { \
TAINT_NOT; \
- stack_sp = stack_base + cxstack[cxstack_ix].blk_oldsp; \
+ PL_stack_sp = PL_stack_base + cxstack[cxstack_ix].blk_oldsp; \
FREETMPS; \
- oldsave = scopestack[scopestack_ix - 1]; \
+ oldsave = PL_scopestack[PL_scopestack_ix - 1]; \
LEAVE_SCOPE(oldsave); \
SPAGAIN; \
} while(0)
JMPENV_PUSH(ret); \
switch (ret) { \
case 0: \
- op = ppaddr(ARGS); \
- retstack[retstack_ix - 1] = Nullop; \
- if (op != nxt) runops(); \
+ PL_op = ppaddr(ARGS); \
+ PL_retstack[PL_retstack_ix - 1] = Nullop; \
+ if (PL_op != nxt) runops(); \
JMPENV_POP; \
break; \
case 1: JMPENV_POP; JMPENV_JUMP(1); \
case 2: JMPENV_POP; JMPENV_JUMP(2); \
case 3: \
JMPENV_POP; \
- if (restartop != nxt) \
+ if (PL_restartop != nxt) \
JMPENV_JUMP(3); \
} \
- op = nxt; \
+ PL_op = nxt; \
SPAGAIN; \
} while (0)
static int
convretcode (int rc,char *prog,int fl)
{
- if (rc < 0 && dowarn)
+ if (rc < 0 && PL_dowarn)
warn ("Can't %s \"%s\": %s",fl ? "exec" : "spawn",prog,Strerror (errno));
if (rc > 0)
return rc <<= 8;
while (++mark <= sp)
if (*mark)
- *a++ = SvPVx(*mark, na);
+ *a++ = SvPVx(*mark, PL_na);
else
*a++ = "";
*a = Nullch;
) /* will swawnvp use PATH? */
TAINT_ENV(); /* testing IFS here is overkill, probably */
- if (really && *(tmps = SvPV(really, na)))
+ if (really && *(tmps = SvPV(really, PL_na)))
rc=spawnvp (P_WAIT,tmps,argv);
else
rc=spawnvp (P_WAIT,argv[0],argv);
return convretcode (system (cmd),cmd,execf);
}
- New (1303,Argv,(s-cmd)/2+2,char*);
- Cmd=savepvn (cmd,s-cmd);
- a=Argv;
- for (s=Cmd; *s;) {
+ New (1303,PL_Argv,(s-cmd)/2+2,char*);
+ PL_Cmd=savepvn (cmd,s-cmd);
+ a=PL_Argv;
+ for (s=PL_Cmd; *s;) {
while (*s && isSPACE (*s)) s++;
if (*s)
*(a++)=s;
*s++='\0';
}
*a=Nullch;
- if (!Argv[0])
+ if (!PL_Argv[0])
return -1;
if (execf==EXECF_EXEC)
- rc=execvp (Argv[0],Argv);
+ rc=execvp (PL_Argv[0],PL_Argv);
else
- rc=spawnvp (P_WAIT,Argv[0],Argv);
- return convretcode (rc,Argv[0],execf);
+ rc=spawnvp (P_WAIT,PL_Argv[0],PL_Argv);
+ return convretcode (rc,PL_Argv[0],execf);
}
int
curstash DBsub DBsingle debstash
rsfp
stdingv
+ defgv
+ errgv
);
sub readsyms (\%$) {
cchar(SV *sv)
{
SV *sstr = newSVpv("'", 0);
- char *s = SvPV(sv, na);
+ char *s = SvPV(sv, PL_na);
if (*s == '\'')
sv_catpv(sstr, "\\'");
use vars qw(%insn_data @insn_name @optype @specialsv_name);
@optype = qw(OP UNOP BINOP LOGOP CONDOP LISTOP PMOP SVOP GVOP PVOP LOOP COP);
-@specialsv_name = qw(Nullsv &sv_undef &sv_yes &sv_no);
+@specialsv_name = qw(Nullsv &PL_sv_undef &PL_sv_yes &PL_sv_no);
# XXX insn_data is initialised this way because with a large
# %insn_data = (foo => [...], bar => [...], ...) initialiser
@insn_name = map($_ || "unused", @insn_name);
1;
-
-__END__
-
-=head1 NAME
-
-B::Asmdata - Autogenerated data about Perl ops, used to generate bytecode
-
-=head1 SYNOPSIS
-
- use Asmdata;
-
-=head1 DESCRIPTION
-
-See F<ext/B/B/Asmdata.pm>.
-
-=head1 AUTHOR
-
-Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>
-
-=cut
perl_init_i18nl14n(1);
#endif
- if (!do_undump) {
+ if (!PL_do_undump) {
my_perl = perl_alloc();
if (!my_perl)
#ifdef VMS
}
#ifdef CSH
- if (!cshlen)
- cshlen = strlen(cshname);
+ if (!PL_cshlen)
+ PL_cshlen = strlen(PL_cshname);
#endif
if (argc < 2)
exit( exitstatus );
sv_setpv(GvSV(gv_fetchpv("0", TRUE, SVt_PV)), argv[0]);
- main_cv = compcv;
- compcv = 0;
+ PL_main_cv = PL_compcv;
+ PL_compcv = 0;
#ifdef INDIRECT_BGET_MACROS
bs.data = fp;
#endif
svp = hv_fetch(action, "bfname", 6, FALSE);
if (svp && SvOK(*svp)) {
- char * ptr = SvPV(*svp,na) ;
+ char * ptr = SvPV(*svp,PL_na) ;
#ifdef DB_VERSION_MAJOR
- name = (char*) na ? ptr : NULL ;
+ name = (char*) PL_na ? ptr : NULL ;
#else
- info->db_RE_bfname = (char*) (na ? ptr : NULL) ;
+ info->db_RE_bfname = (char*) (PL_na ? ptr : NULL) ;
#endif
}
else
{
int value ;
if (SvPOK(*svp))
- value = (int)*SvPV(*svp, na) ;
+ value = (int)*SvPV(*svp, PL_na) ;
else
value = SvIV(*svp) ;
if (svp && SvOK(*svp))
{
if (SvPOK(*svp))
- info->db_RE_bval = (u_char)*SvPV(*svp, na) ;
+ info->db_RE_bval = (u_char)*SvPV(*svp, PL_na) ;
else
info->db_RE_bval = (u_char)(unsigned long) SvIV(*svp) ;
DB_flags(info->flags, DB_DELIMITER) ;
SV * sv = (SV *) NULL ;
if (items >= 3 && SvOK(ST(2)))
- name = (char*) SvPV(ST(2), na) ;
+ name = (char*) SvPV(ST(2), PL_na) ;
if (items == 6)
sv = ST(5) ;
#endif
for (i = items-1 ; i > 0 ; --i)
{
- value.data = SvPV(ST(i), na) ;
- value.size = na ;
+ value.data = SvPV(ST(i), PL_na) ;
+ value.size = PL_na ;
One = 1 ;
key.data = &One ;
key.size = sizeof(int) ;
OutputValue(ST(0), value) ;
RETVAL = db_del(db, key, R_CURSOR) ;
if (RETVAL != 0)
- sv_setsv(ST(0), &sv_undef);
+ sv_setsv(ST(0), &PL_sv_undef);
}
}
OutputValue(ST(0), value) ;
RETVAL = db_del(db, key, R_CURSOR) ;
if (RETVAL != 0)
- sv_setsv (ST(0), &sv_undef) ;
+ sv_setsv (ST(0), &PL_sv_undef) ;
}
}
{
++ (* (int*)key.data) ;
- value.data = SvPV(ST(i), na) ;
- value.size = na ;
+ value.data = SvPV(ST(i), PL_na) ;
+ value.size = PL_na ;
RETVAL = (Db->put)(Db, NULL, &key, &value, 0) ;
if (RETVAL != 0)
break;
#else
for (i = items - 1 ; i > 0 ; --i)
{
- value.data = SvPV(ST(i), na) ;
- value.size = na ;
+ value.data = SvPV(ST(i), PL_na) ;
+ value.size = PL_na ;
RETVAL = (Db->put)(Db, keyptr, &value, R_IAFTER) ;
if (RETVAL != 0)
break;
INPUT
T_dbtkeydatum
if (db->type != DB_RECNO) {
- $var.data = SvPV($arg, na);
- $var.size = (int)na;
+ $var.data = SvPV($arg, PL_na);
+ $var.size = (int)PL_na;
DBT_flags($var);
}
else {
DBT_flags($var);
}
T_dbtdatum
- $var.data = SvPV($arg, na);
- $var.size = (int)na;
+ $var.data = SvPV($arg, PL_na);
+ $var.size = (int)PL_na;
DBT_flags($var);
OUTPUT
dlderr = dld_init("/proc/self/exe");
if (dlderr) {
#endif
- dlderr = dld_init(dld_find_executable(origargv[0]));
+ dlderr = dld_init(dld_find_executable(PL_origargv[0]));
if (dlderr) {
char *msg = dld_strerror(dlderr);
- SaveError("dld_init(%s) failed: %s", origargv[0], msg);
+ SaveError("dld_init(%s) failed: %s", PL_origargv[0], msg);
DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "%s", LastError));
}
#ifdef __linux__
p = (char **) safemalloc(psize * sizeof(char*));
p[0] = path;
for(i=1; i<psize-1; i++) {
- p[i] = SvPVx(*av_fetch(dl_resolve_using, i-1, TRUE), na);
+ p[i] = SvPVx(*av_fetch(dl_resolve_using, i-1, TRUE), PL_na);
}
p[psize-1] = 0;
rld_success = rld_load(nxerr, (struct mach_header **)0, p,
DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "\tSYNCHK sys$parse = %d\n",sts));
if (!(sts & 1)) {
dl_set_error(dlfab.fab$l_sts,dlfab.fab$l_stv);
- ST(0) = &sv_undef;
+ ST(0) = &PL_sv_undef;
}
else {
/* Now set up a default spec - everything but the name */
DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "\tname/default sys$parse = %d\n",sts));
if (!(sts & 1)) {
dl_set_error(dlfab.fab$l_sts,dlfab.fab$l_stv);
- ST(0) = &sv_undef;
+ ST(0) = &PL_sv_undef;
}
else {
/* Now find the actual file */
DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "\tsys$search = %d\n",sts));
if (!(sts & 1)) {
dl_set_error(dlfab.fab$l_sts,dlfab.fab$l_stv);
- ST(0) = &sv_undef;
+ ST(0) = &PL_sv_undef;
}
else {
ST(0) = sv_2mortal(newSVpv(dlnam.nam$l_rsa,dlnam.nam$b_rsl));
Safefree(dlptr->name.dsc$a_pointer);
Safefree(dlptr->defspec.dsc$a_pointer);
Safefree(dlptr);
- ST(0) = &sv_undef;
+ ST(0) = &PL_sv_undef;
}
else {
ST(0) = sv_2mortal(newSViv((IV) dlptr));
(unsigned long int) entry));
if (!(sts & 1)) {
/* error message already saved by findsym_handler */
- ST(0) = &sv_undef;
+ ST(0) = &PL_sv_undef;
}
else ST(0) = sv_2mortal(newSViv((IV) entry));
INPUT
T_DATUM
- $var.dptr = SvPV($arg, na);
- $var.dsize = (int)na;
+ $var.dptr = SvPV($arg, PL_na);
+ $var.dsize = (int)PL_na;
T_GDATUM
UNIMPLEMENTED
OUTPUT
ST(0) = sv_2mortal(newSVpv((char*)&pos, sizeof(Fpos_t)));
}
else {
- ST(0) = &sv_undef;
+ ST(0) = &PL_sv_undef;
errno = EINVAL;
}
SV * pos
CODE:
char *p;
- if (handle && (p = SvPVx(pos, na)) && na == sizeof(Fpos_t))
+ if (handle && (p = SvPVx(pos, PL_na)) && PL_na == sizeof(Fpos_t))
#ifdef PerlIO
RETVAL = PerlIO_setpos(handle, (Fpos_t*)p);
#else
SvREFCNT_dec(gv); /* undo increment in newRV() */
}
else {
- ST(0) = &sv_undef;
+ ST(0) = &PL_sv_undef;
SvREFCNT_dec(gv);
}
if (constant(name, &i))
ST(0) = sv_2mortal(newSViv(i));
else
- ST(0) = &sv_undef;
+ ST(0) = &PL_sv_undef;
int
ungetc(handle, c)
# include <vm/vm_param.h>
#endif
-#ifndef newCONSTSUB
-static void
-newCONSTSUB(stash,name,sv)
- HV *stash;
- char *name;
- SV *sv;
-{
-#ifdef dTHR
- dTHR;
-#endif
- U32 oldhints = hints;
- HV *old_cop_stash = curcop->cop_stash;
- HV *old_curstash = curstash;
- line_t oldline = curcop->cop_line;
- curcop->cop_line = copline;
-
- hints &= ~HINT_BLOCK_SCOPE;
- if(stash)
- curstash = curcop->cop_stash = stash;
-
- newSUB(
- start_subparse(FALSE, 0),
- newSVOP(OP_CONST, 0, newSVpv(name,0)),
- newSVOP(OP_CONST, 0, &sv_no), /* SvPV(&sv_no) == "" -- GMB */
- newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv))
- );
-
- hints = oldhints;
- curcop->cop_stash = old_cop_stash;
- curstash = old_curstash;
- curcop->cop_line = oldline;
-}
-#endif
-
MODULE=IPC::SysV PACKAGE=IPC::Msg::stat
PROTOTYPES: ENABLE
CODE:
#if defined(HAS_SEM) || defined(HAS_SHM)
key_t k = ftok(path, id);
- ST(0) = k == (key_t) -1 ? &sv_undef : sv_2mortal(newSViv(k));
+ ST(0) = k == (key_t) -1 ? &PL_sv_undef : sv_2mortal(newSViv(k));
#else
DIE(no_func, "ftok");
#endif
INPUT
T_DATUM
- $var.dptr = SvPV($arg, na);
- $var.dsize = (int)na;
+ $var.dptr = SvPV($arg, PL_na);
+ $var.dsize = (int)PL_na;
T_GDATUM
UNIMPLEMENTED
OUTPUT
croak("ODBM_FILE: Can't open %s", filename);
}
RETVAL = (void*)(dbminit(filename) >= 0 ? &dbmrefcnt : 0);
- ST(0) = sv_mortalcopy(&sv_undef);
+ ST(0) = sv_mortalcopy(&PL_sv_undef);
sv_setptrobj(ST(0), RETVAL, dbtype);
}
INPUT
T_DATUM
- $var.dptr = SvPV($arg, na);
- $var.dsize = (int)na;
+ $var.dptr = SvPV($arg, PL_na);
+ $var.dsize = (int)PL_na;
T_GDATUM
UNIMPLEMENTED
OUTPUT
}
set_opset_bits(bitmap, bitspec, on, opname);
}
- ST(0) = &sv_yes;
+ ST(0) = &PL_sv_yes;
}
else if (SvPOK(bitspec) && SvCUR(bitspec) == opset_len) {
int b, j;
- char *bitmap = SvPV(bitspec,na);
+ char *bitmap = SvPV(bitspec,PL_na);
myopcode = 0;
for (b=0; b < opset_len; b++) {
U16 bits = bitmap[b];
STRLEN len;
char *optag = SvPV(optagsv, len);
put_op_bitspec(optag, len, mask); /* croaks */
- ST(0) = &sv_yes;
+ ST(0) = &PL_sv_yes;
void
/* The non-POSIX CRTL times() has void return type, so we just get the
current time directly */
- clock_t vms_times(struct tms *bufptr) {
+ clock_t vms_times(struct tms *PL_bufptr) {
clock_t retval;
/* Get wall time and convert to 10 ms intervals to
* produce the return value that the POSIX standard expects */
_ckvmssts(lib$ediv(&divisor,vmstime,(long int *)&retval,&remainder));
# endif
/* Fill in the struct tms using the CRTL routine . . .*/
- times((tbuffer_t *)bufptr);
+ times((tbuffer_t *)PL_bufptr);
return (clock_t) retval;
}
# define times(t) vms_times(t)
unsigned char * charstring
CODE:
unsigned char *s = charstring;
- unsigned char *e = s + na; /* "na" set by typemap side effect */
+ unsigned char *e = s + PL_na; /* "PL_na" set by typemap side effect */
for (RETVAL = 1; RETVAL && s < e; s++)
if (!isalnum(*s))
RETVAL = 0;
unsigned char * charstring
CODE:
unsigned char *s = charstring;
- unsigned char *e = s + na; /* "na" set by typemap side effect */
+ unsigned char *e = s + PL_na; /* "PL_na" set by typemap side effect */
for (RETVAL = 1; RETVAL && s < e; s++)
if (!isalpha(*s))
RETVAL = 0;
unsigned char * charstring
CODE:
unsigned char *s = charstring;
- unsigned char *e = s + na; /* "na" set by typemap side effect */
+ unsigned char *e = s + PL_na; /* "PL_na" set by typemap side effect */
for (RETVAL = 1; RETVAL && s < e; s++)
if (!iscntrl(*s))
RETVAL = 0;
unsigned char * charstring
CODE:
unsigned char *s = charstring;
- unsigned char *e = s + na; /* "na" set by typemap side effect */
+ unsigned char *e = s + PL_na; /* "PL_na" set by typemap side effect */
for (RETVAL = 1; RETVAL && s < e; s++)
if (!isdigit(*s))
RETVAL = 0;
unsigned char * charstring
CODE:
unsigned char *s = charstring;
- unsigned char *e = s + na; /* "na" set by typemap side effect */
+ unsigned char *e = s + PL_na; /* "PL_na" set by typemap side effect */
for (RETVAL = 1; RETVAL && s < e; s++)
if (!isgraph(*s))
RETVAL = 0;
unsigned char * charstring
CODE:
unsigned char *s = charstring;
- unsigned char *e = s + na; /* "na" set by typemap side effect */
+ unsigned char *e = s + PL_na; /* "PL_na" set by typemap side effect */
for (RETVAL = 1; RETVAL && s < e; s++)
if (!islower(*s))
RETVAL = 0;
unsigned char * charstring
CODE:
unsigned char *s = charstring;
- unsigned char *e = s + na; /* "na" set by typemap side effect */
+ unsigned char *e = s + PL_na; /* "PL_na" set by typemap side effect */
for (RETVAL = 1; RETVAL && s < e; s++)
if (!isprint(*s))
RETVAL = 0;
unsigned char * charstring
CODE:
unsigned char *s = charstring;
- unsigned char *e = s + na; /* "na" set by typemap side effect */
+ unsigned char *e = s + PL_na; /* "PL_na" set by typemap side effect */
for (RETVAL = 1; RETVAL && s < e; s++)
if (!ispunct(*s))
RETVAL = 0;
unsigned char * charstring
CODE:
unsigned char *s = charstring;
- unsigned char *e = s + na; /* "na" set by typemap side effect */
+ unsigned char *e = s + PL_na; /* "PL_na" set by typemap side effect */
for (RETVAL = 1; RETVAL && s < e; s++)
if (!isspace(*s))
RETVAL = 0;
unsigned char * charstring
CODE:
unsigned char *s = charstring;
- unsigned char *e = s + na; /* "na" set by typemap side effect */
+ unsigned char *e = s + PL_na; /* "PL_na" set by typemap side effect */
for (RETVAL = 1; RETVAL && s < e; s++)
if (!isupper(*s))
RETVAL = 0;
unsigned char * charstring
CODE:
unsigned char *s = charstring;
- unsigned char *e = s + na; /* "na" set by typemap side effect */
+ unsigned char *e = s + PL_na; /* "PL_na" set by typemap side effect */
for (RETVAL = 1; RETVAL && s < e; s++)
if (!isxdigit(*s))
RETVAL = 0;
/* Remember old handler name if desired. */
if (oldaction) {
- char *hand = SvPVx(*sigsvp, na);
+ char *hand = SvPVx(*sigsvp, PL_na);
svp = hv_fetch(oldaction, "HANDLER", 7, TRUE);
sv_setpv(*svp, *hand ? hand : "DEFAULT");
}
svp = hv_fetch(action, "HANDLER", 7, FALSE);
if (!svp)
croak("Can't supply an action without a HANDLER");
- sv_setpv(*sigsvp, SvPV(*svp, na));
+ sv_setpv(*sigsvp, SvPV(*svp, PL_na));
mg_set(*sigsvp); /* handles DEFAULT and IGNORE */
act.sa_handler = sighandler;
if (unparsed)
PUSHs(sv_2mortal(newSViv(strlen(unparsed))));
else
- PUSHs(&sv_undef);
+ PUSHs(&PL_sv_undef);
}
void
if (unparsed)
PUSHs(sv_2mortal(newSViv(strlen(unparsed))));
else
- PUSHs(&sv_undef);
+ PUSHs(&PL_sv_undef);
}
void
if (unparsed)
PUSHs(sv_2mortal(newSViv(strlen(unparsed))));
else
- PUSHs(&sv_undef);
+ PUSHs(&PL_sv_undef);
}
SV *
INPUT
T_DATUM
- $var.dptr = SvPV($arg, na);
- $var.dsize = (int)na;
+ $var.dptr = SvPV($arg, PL_na);
+ $var.dsize = (int)PL_na;
T_GDATUM
UNIMPLEMENTED
OUTPUT
Thread savethread = thr;
LOGOP myop;
dSP;
- I32 oldscope = scopestack_ix;
+ I32 oldscope = PL_scopestack_ix;
I32 retval;
AV *av;
int i;
thr->private = 0;
/* Now duplicate most of perl_call_sv but with a few twists */
- op = (OP*)&myop;
- Zero(op, 1, LOGOP);
+ PL_op = (OP*)&myop;
+ Zero(PL_op, 1, LOGOP);
myop.op_flags = OPf_STACKED;
myop.op_next = Nullop;
myop.op_flags |= OPf_KNOW;
myop.op_flags |= OPf_WANT_LIST;
- op = pp_entersub(ARGS);
- DEBUG_L(if (!op)
+ PL_op = pp_entersub(ARGS);
+ DEBUG_L(if (!PL_op)
PerlIO_printf(PerlIO_stderr(), "thread starts at Nullop\n"));
/*
* When this thread is next scheduled, we start in the right
MUTEX_LOCK(&thr->mutex);
thr->flags |= THRf_DID_DIE;
MUTEX_UNLOCK(&thr->mutex);
- av_store(av, 0, &sv_no);
+ av_store(av, 0, &PL_sv_no);
av_store(av, 1, newSVsv(thr->errsv));
DEBUG_L(PerlIO_printf(PerlIO_stderr(), "%p died: %s\n",
- thr, SvPV(thr->errsv, na)));
+ thr, SvPV(thr->errsv, PL_na)));
} else {
DEBUG_L(STMT_START {
for (i = 1; i <= retval; i++) {
thr, i, SvPEEK(SP[i - 1]));
}
} STMT_END);
- av_store(av, 0, &sv_yes);
+ av_store(av, 0, &PL_sv_yes);
for (i = 1; i <= retval; i++, SP++)
sv_setsv(*av_fetch(av, i, TRUE), SvREFCNT_inc(*SP));
}
finishoff:
#if 0
/* removed for debug */
- SvREFCNT_dec(curstack);
+ SvREFCNT_dec(PL_curstack);
#endif
SvREFCNT_dec(thr->cvcache);
SvREFCNT_dec(thr->threadsv);
Safefree(PL_screamnext);
Safefree(PL_reg_start_tmp);
SvREFCNT_dec(PL_lastscream);
- /*SvREFCNT_dec(defoutgv);*/
+ /*SvREFCNT_dec(PL_defoutgv);*/
MUTEX_LOCK(&thr->mutex);
DEBUG_L(PerlIO_printf(PerlIO_stderr(),
return sv_bless(newRV_noinc(sv), gv_stashpv(classname, TRUE));
#else
croak("No threads in this perl");
- return &sv_undef;
+ return &PL_sv_undef;
#endif
}
for (i = 1; i <= AvFILL(av); i++)
XPUSHs(sv_2mortal(*av_fetch(av, i, FALSE)));
} else {
- char *mess = SvPV(*av_fetch(av, 1, FALSE), na);
+ char *mess = SvPV(*av_fetch(av, 1, FALSE), PL_na);
DEBUG_L(PerlIO_printf(PerlIO_stderr(),
"%p: join propagating die message: %s\n",
thr, mess));
Thread t1
Thread t2
PPCODE:
- PUSHs((t1 == t2) ? &sv_yes : &sv_no);
+ PUSHs((t1 == t2) ? &PL_sv_yes : &PL_sv_no);
void
flags(t)
DESTROY(t)
SV * t
PPCODE:
- PUSHs(&sv_yes);
+ PUSHs(&PL_sv_yes);
void
yield()
kill_sighandler_thread()
PPCODE:
write(sig_pipe[1], "\0", 1);
- PUSHs(&sv_yes);
+ PUSHs(&PL_sv_yes);
void
init_thread_signals()
PL_sighandlerp = handle_thread_signal;
if (pipe(sig_pipe) == -1)
XSRETURN_UNDEF;
- PUSHs(&sv_yes);
+ PUSHs(&PL_sv_yes);
void
await_signal()
croak("panic: await_signal");
ST(0) = sv_newmortal();
if (ret)
- sv_setsv(ST(0), c ? psig_ptr[c] : &sv_no);
+ sv_setsv(ST(0), c ? psig_ptr[c] : &PL_sv_no);
DEBUG_L(PerlIO_printf(PerlIO_stderr(),
"await_signal returning %s\n", SvPEEK(ST(0))););
if (!PL_compcv || !(cv = CvOUTSIDE(PL_compcv)))
croak("can't set attributes outside a subroutine scope");
for (i = 1; i < items; i++) {
- char *attr = SvPV(ST(i), na);
+ char *attr = SvPV(ST(i), PL_na);
cv_flags_t flag = get_flag(attr);
if (!flag)
croak("invalid attribute name %s", attr);
sub = Nullsv;
}
else {
- char *name = SvPV(sub, na);
+ char *name = SvPV(sub, PL_na);
sub = (SV*)perl_get_cv(name, FALSE);
}
if (!sub)
* something a bit different for XS code.
*/
-#define SCHEDULE() return schedule(), op
+#define SCHEDULE() return schedule(), PL_op
#define MUTEX_LOCK(m)
#define MUTEX_UNLOCK(m)
default:
if (!SvROK(sv)) {
if (!SvOK(sv)) break;
- gv = gv_fetchmethod(stash, SvPV(sv, na));
+ gv = gv_fetchmethod(stash, SvPV(sv, PL_na));
if (gv) cv = GvCV(gv);
break;
}
I32 found = 0;
/* what follows is the moral equivalent of:
- if ((Svp = hv_fetch(strtab, tmpsv, FALSE, hash))) {
+ if ((Svp = hv_fetch(PL_strtab, tmpsv, FALSE, hash))) {
if (--*Svp == Nullsv)
- hv_delete(strtab, str, len, G_DISCARD, hash);
+ hv_delete(PL_strtab, str, len, G_DISCARD, hash);
} */
xhv = (XPVHV*)SvANY(PL_strtab);
/* assert(xhv_array != 0) */
/* what follows is the moral equivalent of:
- if (!(Svp = hv_fetch(strtab, str, len, FALSE)))
- hv_store(strtab, str, len, Nullsv, hash);
+ if (!(Svp = hv_fetch(PL_strtab, str, len, FALSE)))
+ hv_store(PL_strtab, str, len, Nullsv, hash);
*/
xhv = (XPVHV*)SvANY(PL_strtab);
/* assert(xhv_array != 0) */
if ( do_open(gv, "<&", 2, FALSE, 0, 0, $var) )
sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1)));
else
- $arg = &sv_undef;
+ $arg = &PL_sv_undef;
}
T_INOUT
{
if ( do_open(gv, "+<&", 3, FALSE, 0, 0, $var) )
sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1)));
else
- $arg = &sv_undef;
+ $arg = &PL_sv_undef;
}
T_OUT
{
if ( do_open(gv, "+>&", 3, FALSE, 0, 0, $var) )
sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1)));
else
- $arg = &sv_undef;
+ $arg = &PL_sv_undef;
}
return (char *)-1; /* Now die die die... */
/* Got it, now detach SvPV: */
- pv = SvPV(sv, na);
+ pv = SvPV(sv, PL_na);
/* Check alignment: */
if (((u_bigint)(pv - M_OVERHEAD)) & ((1<<LOG_OF_MIN_ARENA) - 1)) {
PerlIO_puts(PerlIO_stderr(),"Bad alignment of $^M!\n");
break;
case '\024': /* ^T */
#ifdef BIG_TIME
- sv_setnv(sv, basetime);
+ sv_setnv(sv, PL_basetime);
#else
sv_setiv(sv, (IV)PL_basetime);
#endif
dTHR;
sv_setiv(sv, (IV)STATUS_CURRENT);
#ifdef COMPLEX_STATUS
- LvTARGOFF(sv) = statusvalue;
- LvTARGLEN(sv) = statusvalue_vms;
+ LvTARGOFF(sv) = PL_statusvalue;
+ LvTARGLEN(sv) = PL_statusvalue_vms;
#endif
}
break;
/* waiting in the wings? */
if (!len) {
SV **valp;
- if ((valp = hv_fetch(GvHVn(envgv), ptr, klen, FALSE)))
+ if ((valp = hv_fetch(GvHVn(PL_envgv), ptr, klen, FALSE)))
s = SvPV(*valp, len);
}
#endif
break;
case '\024': /* ^T */
#ifdef BIG_TIME
- basetime = (Time_t)(SvNOK(sv) ? SvNVX(sv) : sv_2nv(sv));
+ PL_basetime = (Time_t)(SvNOK(sv) ? SvNVX(sv) : sv_2nv(sv));
#else
PL_basetime = (Time_t)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
#endif
break;
case '?':
#ifdef COMPLEX_STATUS
- if (localizing == 2) {
- statusvalue = LvTARGOFF(sv);
- statusvalue_vms = LvTARGLEN(sv);
+ if (PL_localizing == 2) {
+ PL_statusvalue = LvTARGOFF(sv);
+ PL_statusvalue_vms = LvTARGLEN(sv);
}
else
#endif
(void)setreuid((Uid_t)-1, (Uid_t)PL_euid);
#else
#ifdef HAS_SETRESUID
- (void)setresuid((Uid_t)-1, (Uid_t)euid, (Uid_t)-1);
+ (void)setresuid((Uid_t)-1, (Uid_t)PL_euid, (Uid_t)-1);
#else
if (PL_euid == PL_uid) /* special case $> = $< */
PerlProc_setuid(PL_euid);
for (i = 1; i < PL_origargc; i++) {
if (PL_origargv[i] == s + 1
#ifdef OS2
- || origargv[i] == s + 2
+ || PL_origargv[i] == s + 2
#endif
)
s += strlen(++s); /* this one is ok too */
/* can grab env area too? */
if (PL_origenviron && (PL_origenviron[0] == s + 1
#ifdef OS2
- || (origenviron[0] == s + 9 && (s += 8))
+ || (PL_origenviron[0] == s + 9 && (s += 8))
#endif
)) {
my_setenv("NoNe SuCh", Nullch);
dTHR;
register I32 po;
- if (AvARRAY(comppad) != curpad)
+ if (AvARRAY(PL_comppad) != PL_curpad)
croak("panic: pad_reset curpad");
#ifdef USE_THREADS
DEBUG_X(PerlIO_printf(Perl_debug_log, "0x%lx Pad 0x%lx reset\n",
- (unsigned long) thr, (unsigned long) curpad));
+ (unsigned long) thr, (unsigned long) PL_curpad));
#else
DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%lx reset\n",
- (unsigned long) curpad));
+ (unsigned long) PL_curpad));
#endif /* USE_THREADS */
- if (!tainting) { /* Can't mix tainted and non-tainted temporaries. */
- for (po = AvMAX(comppad); po > padix_floor; po--) {
- if (curpad[po] && !SvIMMORTAL(curpad[po]))
- SvPADTMP_off(curpad[po]);
+ if (!PL_tainting) { /* Can't mix tainted and non-tainted temporaries. */
+ for (po = AvMAX(PL_comppad); po > PL_padix_floor; po--) {
+ if (PL_curpad[po] && !SvIMMORTAL(PL_curpad[po]))
+ SvPADTMP_off(PL_curpad[po]);
}
- padix = padix_floor;
+ PL_padix = PL_padix_floor;
}
#endif
PL_pad_reset_pending = FALSE;
PerlIO_printf(Perl_debug_log, "\tCV=0x%lx (%s), OUTSIDE=0x%lx (%s)\n",
cv,
(CvANON(cv) ? "ANON"
- : (cv == main_cv) ? "MAIN"
+ : (cv == PL_main_cv) ? "MAIN"
: CvUNIQUE(outside) ? "UNIQUE"
: CvGV(cv) ? GvNAME(CvGV(cv)) : "UNDEFINED"),
outside,
(!outside ? "null"
: CvANON(outside) ? "ANON"
- : (outside == main_cv) ? "MAIN"
+ : (outside == PL_main_cv) ? "MAIN"
: CvUNIQUE(outside) ? "UNIQUE"
: CvGV(outside) ? GvNAME(CvGV(outside)) : "UNDEFINED"));
newSUB(
start_subparse(FALSE, 0),
newSVOP(OP_CONST, 0, newSVpv(name,0)),
- newSVOP(OP_CONST, 0, &PL_sv_no), /* SvPV(&sv_no) == "" -- GMB */
+ newSVOP(OP_CONST, 0, &PL_sv_no), /* SvPV(&PL_sv_no) == "" -- GMB */
newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv))
);
#ifdef USE_THREADS
if (!CvUNIQUE(PL_compcv)) {
argop = newOP(OP_PADAV, OPf_REF);
- argop->op_targ = 0; /* curpad[0] is @_ */
+ argop->op_targ = 0; /* PL_curpad[0] is @_ */
}
else {
argop = newUNOP(OP_RV2AV, 0,
BOOL rc;
SV *sv;
- if (CheckWinError(PrfQueryProfileSize(hini, app, key, &len))) return &sv_undef;
+ if (CheckWinError(PrfQueryProfileSize(hini, app, key, &len))) return &PL_sv_undef;
sv = newSVpv("", 0);
SvGROW(sv, len + 1);
if (CheckWinError(PrfQueryProfileData(hini, app, key, SvPVX(sv), &len))
|| (len == 0 && (app == NULL || key == NULL))) { /* Somewhy needed. */
SvREFCNT_dec(sv);
- return &sv_undef;
+ return &PL_sv_undef;
}
SvCUR_set(sv, len);
*SvEND(sv) = 0;
char system[257];
PRFPROFILE info = { 257, user, 257, system};
- if (CheckWinError(PrfQueryProfile(Perl_hab, &info))) return &sv_undef;
+ if (CheckWinError(PrfQueryProfile(Perl_hab, &info))) return &PL_sv_undef;
if (info.cchUserName > 257 || info.cchSysName > 257)
die("Panic: Profile names too long");
av_push(av, newSVpv(user, info.cchUserName - 1));
#############################################################################
INPUT
T_PVNULL
- $var = ( SvOK($arg) ? ($type)SvPV($arg,na) : NULL )
+ $var = ( SvOK($arg) ? ($type)SvPV($arg,PL_na) : NULL )
#############################################################################
OUTPUT
T_PVNULL
} else {
res = NEWSV(729,0);
}
- if (rc || SvTRUE(GvSV(errgv))) {
- if (SvTRUE(GvSV(errgv))) {
- die ("Error inside perl function called from REXX compartment.\n%s", SvPV(GvSV(errgv), na)) ;
+ if (rc || SvTRUE(GvSV(PL_errgv))) {
+ if (SvTRUE(GvSV(PL_errgv))) {
+ die ("Error inside perl function called from REXX compartment.\n%s", SvPV(GvSV(PL_errgv), PL_na)) ;
}
die ("REXX compartment returned non-zero status %li", rc);
}
var->shvname.strlength, var->shvname.strptr,
namelen, var->shvvalue.strptr);
if (var->shvret & RXSHV_NEWV || !var->shvvalue.strptr)
- PUSHs(&sv_undef);
+ PUSHs(&PL_sv_undef);
else
PUSHs(sv_2mortal(newSVpv(var->shvvalue.strptr,
namelen)));
PUSHs(sv_2mortal(newSVpv(sv.shvvalue.strptr, valuelen)));
DosFreeMem(sv.shvvalue.strptr);
} else
- PUSHs(&sv_undef);
+ PUSHs(&PL_sv_undef);
} else if (rc != RXSHV_LVAR) {
die("Error %i when in _next", rc);
} else {
os2_cond_wait(perl_cond *c, perl_mutex *m)
{
int rc;
- if ((rc = DosResetEventSem(*c,&na)) && (rc != ERROR_ALREADY_RESET))
+ if ((rc = DosResetEventSem(*c,&PL_na)) && (rc != ERROR_ALREADY_RESET))
croak("panic: COND_WAIT-reset: rc=%i", rc);
if (m) MUTEX_UNLOCK(m);
if (CheckOSError(DosWaitEventSem(*c,SEM_INDEFINITE_WAIT))
rsignal(SIGINT, ihand);
rsignal(SIGQUIT, qhand);
- statusvalue = (U16)status;
+ PL_statusvalue = (U16)status;
if (r < 0)
return -1;
return status & 0xFFFF;
ihand = rsignal(SIGINT, SIG_IGN);
r = DosWaitChild(DCWA_PROCESS, DCWW_WAIT, &res, &rpid, pid);
rsignal(SIGINT, ihand);
- statusvalue = res.codeResult << 8 | res.codeTerminate;
+ PL_statusvalue = res.codeResult << 8 | res.codeTerminate;
if (r)
return -1;
- return statusvalue;
+ return PL_statusvalue;
#endif
}
#define EXECF_SPAWN_NOWAIT 3
/* Spawn/exec a program, revert to shell if needed. */
-/* global Argv[] contains arguments. */
+/* global PL_Argv[] contains arguments. */
int
do_spawn_ve(really, flag, execf, inicmd)
flag = P_NOWAIT;
retry:
- if (strEQ(Argv[0],"/bin/sh"))
- Argv[0] = sh_path;
+ if (strEQ(PL_Argv[0],"/bin/sh"))
+ PL_Argv[0] = PL_sh_path;
- if (Argv[0][0] != '/' && Argv[0][0] != '\\'
- && !(Argv[0][0] && Argv[0][1] == ':'
- && (Argv[0][2] == '/' || Argv[0][2] != '\\'))
+ if (PL_Argv[0][0] != '/' && PL_Argv[0][0] != '\\'
+ && !(PL_Argv[0][0] && PL_Argv[0][1] == ':'
+ && (PL_Argv[0][2] == '/' || PL_Argv[0][2] != '\\'))
) /* will spawnvp use PATH? */
TAINT_ENV(); /* testing IFS here is overkill, probably */
/* We should check PERL_SH* and PERLLIB_* as well? */
- if (!really || !*(tmps = SvPV(really, na)))
- tmps = Argv[0];
+ if (!really || !*(tmps = SvPV(really, PL_na)))
+ tmps = PL_Argv[0];
#if 0
- rc = result(trueflag, spawnvp(flag,tmps,Argv));
+ rc = result(trueflag, spawnvp(flag,tmps,PL_Argv));
#else
if (execf == EXECF_TRUEEXEC)
- rc = execvp(tmps,Argv);
+ rc = execvp(tmps,PL_Argv);
else if (execf == EXECF_EXEC)
- rc = spawnvp(trueflag | P_OVERLAY,tmps,Argv);
+ rc = spawnvp(trueflag | P_OVERLAY,tmps,PL_Argv);
else if (execf == EXECF_SPAWN_NOWAIT)
- rc = spawnvp(trueflag | P_NOWAIT,tmps,Argv);
+ rc = spawnvp(trueflag | P_NOWAIT,tmps,PL_Argv);
else /* EXECF_SPAWN */
rc = result(trueflag,
- spawnvp(trueflag | P_NOWAIT,tmps,Argv));
+ spawnvp(trueflag | P_NOWAIT,tmps,PL_Argv));
#endif
if (rc < 0 && pass == 1
- && (tmps == Argv[0])) { /* Cannot transfer `really' via shell. */
+ && (tmps == PL_Argv[0])) { /* Cannot transfer `really' via shell. */
err = errno;
if (err == ENOENT || err == ENOEXEC) {
/* No such file, or is a script. */
/* Try adding script extensions to the file name, and
search on PATH. */
- char *scr = find_script(Argv[0], TRUE, NULL, 0);
+ char *scr = find_script(PL_Argv[0], TRUE, NULL, 0);
if (scr) {
FILE *file = fopen(scr, "r");
char *s = 0, *s1;
- Argv[0] = scr;
+ PL_Argv[0] = scr;
if (!file)
goto panic_file;
if (!fgets(buf, sizeof buf, file)) {
}
doshell_args:
{
- char **a = Argv;
+ char **a = PL_Argv;
char *exec_args[2];
if (!buf[0] && file) { /* File without magic */
}
}
if (!inicmd) {
- s = Argv[0];
+ s = PL_Argv[0];
while (*s) {
/* Dosish shells will choke on slashes
in paths, fortunately, this is
/* Use the original cmd line */
/* XXXX This is good only until we refuse
quoted arguments... */
- Argv[0] = inicmd;
- Argv[1] = Nullch;
+ PL_Argv[0] = inicmd;
+ PL_Argv[1] = Nullch;
}
} else if (!buf[0] && inicmd) { /* No file */
/* Start with the original cmdline. */
/* XXXX This is good only until we refuse
quoted arguments... */
- Argv[0] = inicmd;
- Argv[1] = Nullch;
+ PL_Argv[0] = inicmd;
+ PL_Argv[1] = Nullch;
nargs = 2; /* shell -c */
}
while (a[1]) /* Get to the end */
a++;
a++; /* Copy finil NULL too */
- while (a >= Argv) {
- *(a + nargs) = *a; /* Argv was preallocated to be
+ while (a >= PL_Argv) {
+ *(a + nargs) = *a; /* PL_Argv was preallocated to be
long enough. */
a--;
}
while (nargs-- >= 0)
- Argv[nargs] = argsp[nargs];
+ PL_Argv[nargs] = argsp[nargs];
/* Enable pathless exec if #! (as pdksh). */
pass = (buf[0] == '#' ? 2 : 3);
goto retry;
errno = err;
}
} else if (rc < 0 && pass == 2 && err == ENOENT) { /* File not found */
- char *no_dir = strrchr(Argv[0], '/');
+ char *no_dir = strrchr(PL_Argv[0], '/');
/* Do as pdksh port does: if not found with /, try without
path. */
if (no_dir) {
- Argv[0] = no_dir + 1;
+ PL_Argv[0] = no_dir + 1;
pass++;
goto retry;
}
}
- if (rc < 0 && dowarn)
+ if (rc < 0 && PL_dowarn)
warn("Can't %s \"%s\": %s\n",
((execf != EXECF_EXEC && execf != EXECF_TRUEEXEC)
? "spawn" : "exec"),
- Argv[0], Strerror(err));
+ PL_Argv[0], Strerror(err));
if (rc < 0 && (execf != EXECF_SPAWN_NOWAIT)
&& ((trueflag & 0xFF) == P_WAIT))
rc = 255 << 8; /* Emulate the fork(). */
int flag = P_WAIT, trueflag, err, secondtry = 0;
if (sp > mark) {
- New(1301,Argv, sp - mark + 3, char*);
- a = Argv;
+ New(1301,PL_Argv, sp - mark + 3, char*);
+ a = PL_Argv;
if (mark < sp && SvNIOKp(*(mark+1)) && !SvPOKp(*(mark+1))) {
++mark;
while (++mark <= sp) {
if (*mark)
- *a++ = SvPVx(*mark, na);
+ *a++ = SvPVx(*mark, PL_na);
else
*a++ = "";
}
have a shell which will not change between computers with the
same architecture, to avoid "action on a distance".
And to have simple build, this shell should be sh. */
- shell = sh_path;
+ shell = PL_sh_path;
copt = "-c";
#endif
cmd++;
if (strnEQ(cmd,"/bin/sh",7) && isSPACE(cmd[7])) {
- STRLEN l = strlen(sh_path);
+ STRLEN l = strlen(PL_sh_path);
New(1302, news, strlen(cmd) - 7 + l + 1, char);
- strcpy(news, sh_path);
+ strcpy(news, PL_sh_path);
strcpy(news + l, cmd + 7);
cmd = news;
}
/* In the ak code internal P_NOWAIT is P_WAIT ??? */
rc = result(P_WAIT,
spawnl(P_NOWAIT,shell,shell,copt,cmd,(char*)0));
- if (rc < 0 && dowarn)
+ if (rc < 0 && PL_dowarn)
warn("Can't %s \"%s\": %s",
(execf == EXECF_SPAWN ? "spawn" : "exec"),
shell, Strerror(errno));
}
/* cmd="a" may lead to "sh", "-c", "\"$@\"", "a", "a.cmd", NULL */
- New(1303,Argv, (s - cmd + 11) / 2, char*);
- Cmd = savepvn(cmd, s-cmd);
- a = Argv;
- for (s = Cmd; *s;) {
+ New(1303,PL_Argv, (s - cmd + 11) / 2, char*);
+ PL_Cmd = savepvn(cmd, s-cmd);
+ a = PL_Argv;
+ for (s = PL_Cmd; *s;) {
while (*s && isSPACE(*s)) s++;
if (*s)
*(a++) = s;
*s++ = '\0';
}
*a = Nullch;
- if (Argv[0])
+ if (PL_Argv[0])
rc = do_spawn_ve(NULL, 0, execf, cmd);
else
rc = -1;
/* `this' is what we use in the parent, `that' in the child. */
this = (*mode == 'w');
that = !this;
- if (tainting) {
+ if (PL_tainting) {
taint_env();
taint_proper("Insecure %s%s", "EXEC");
}
close(p[this]);
p[this] = p[that];
}
- sv = *av_fetch(fdpid,p[this],TRUE);
+ sv = *av_fetch(PL_fdpid,p[this],TRUE);
(void)SvUPGRADE(sv,SVt_IV);
SvIVX(sv) = pid;
- forkprocess = pid;
+ PL_forkprocess = pid;
return PerlIO_fdopen(p[this], mode);
#else /* USE_POPEN */
# else
char *shell = getenv("EMXSHELL");
- my_setenv("EMXSHELL", sh_path);
+ my_setenv("EMXSHELL", PL_sh_path);
res = popen(cmd, mode);
my_setenv("EMXSHELL", shell);
# endif
- sv = *av_fetch(fdpid, PerlIO_fileno(res), TRUE);
+ sv = *av_fetch(PL_fdpid, PerlIO_fileno(res), TRUE);
(void)SvUPGRADE(sv,SVt_IV);
SvIVX(sv) = -1; /* A cooky. */
return res;
if (items < 2 || items > 3)
croak("Usage: File::Copy::syscopy(src,dst,flag=0)");
{
- char * src = (char *)SvPV(ST(0),na);
- char * dst = (char *)SvPV(ST(1),na);
+ char * src = (char *)SvPV(ST(0),PL_na);
+ char * dst = (char *)SvPV(ST(1),PL_na);
U32 flag;
int RETVAL, rc;
if (avlen < 0)
croak("Empty array reference given to mod2fname");
- s = SvPV(*av_fetch((AV*)sv, avlen, FALSE), na);
+ s = SvPV(*av_fetch((AV*)sv, avlen, FALSE), PL_na);
strncpy(fname, s, 8);
len = strlen(s);
if (len < 6) pos = len;
}
avlen --;
while (avlen >= 0) {
- s = SvPV(*av_fetch((AV*)sv, avlen, FALSE), na);
+ s = SvPV(*av_fetch((AV*)sv, avlen, FALSE), PL_na);
while (*s) {
sum = 33 * sum + *(s++); /* 7 is primitive mod 13. */
}
if (items != 1)
croak("Usage: Cwd::sys_chdir(path)");
{
- char * path = (char *)SvPV(ST(0),na);
+ char * path = (char *)SvPV(ST(0),PL_na);
bool RETVAL;
RETVAL = sys_chdir(path);
if (items != 1)
croak("Usage: Cwd::change_drive(d)");
{
- char d = (char)*SvPV(ST(0),na);
+ char d = (char)*SvPV(ST(0),PL_na);
bool RETVAL;
RETVAL = change_drive(d);
if (items != 1)
croak("Usage: Cwd::sys_is_absolute(path)");
{
- char * path = (char *)SvPV(ST(0),na);
+ char * path = (char *)SvPV(ST(0),PL_na);
bool RETVAL;
RETVAL = sys_is_absolute(path);
if (items != 1)
croak("Usage: Cwd::sys_is_rooted(path)");
{
- char * path = (char *)SvPV(ST(0),na);
+ char * path = (char *)SvPV(ST(0),PL_na);
bool RETVAL;
RETVAL = sys_is_rooted(path);
if (items != 1)
croak("Usage: Cwd::sys_is_relative(path)");
{
- char * path = (char *)SvPV(ST(0),na);
+ char * path = (char *)SvPV(ST(0),PL_na);
bool RETVAL;
RETVAL = sys_is_relative(path);
if (items < 1 || items > 2)
croak("Usage: Cwd::sys_abspath(path, dir = NULL)");
{
- char * path = (char *)SvPV(ST(0),na);
+ char * path = (char *)SvPV(ST(0),PL_na);
char * dir;
char p[MAXPATHLEN];
char * RETVAL;
if (items < 2)
dir = NULL;
else {
- dir = (char *)SvPV(ST(1),na);
+ dir = (char *)SvPV(ST(1),PL_na);
}
if (path[0] == '.' && (path[1] == '/' || path[1] == '\\')) {
path += 2;
if (items < 1 || items > 2)
croak("Usage: Cwd::extLibpath_set(s, type = 0)");
{
- char * s = (char *)SvPV(ST(0),na);
+ char * s = (char *)SvPV(ST(0),PL_na);
bool type;
U32 rc;
bool RETVAL;
environ = env;
}
if ( (shell = getenv("PERL_SH_DRIVE")) ) {
- New(1304, sh_path, strlen(SH_PATH) + 1, char);
- strcpy(sh_path, SH_PATH);
- sh_path[0] = shell[0];
+ New(1304, PL_sh_path, strlen(SH_PATH) + 1, char);
+ strcpy(PL_sh_path, SH_PATH);
+ PL_sh_path[0] = shell[0];
} else if ( (shell = getenv("PERL_SH_DIR")) ) {
int l = strlen(shell), i;
if (shell[l-1] == '/' || shell[l-1] == '\\') {
l--;
}
- New(1304, sh_path, l + 8, char);
- strncpy(sh_path, shell, l);
- strcpy(sh_path + l, "/sh.exe");
+ New(1304, PL_sh_path, l + 8, char);
+ strncpy(PL_sh_path, shell, l);
+ strcpy(PL_sh_path + l, "/sh.exe");
for (i = 0; i < l; i++) {
- if (sh_path[i] == '\\') sh_path[i] = '/';
+ if (PL_sh_path[i] == '\\') PL_sh_path[i] = '/';
}
}
MUTEX_INIT(&start_thread_mutex);
if ((rc = DosCloseEventSem(*(c)))) \
croak("panic: COND_DESTROY, rc=%i", rc); \
} STMT_END
-/*#define THR ((struct thread *) TlsGetValue(thr_key))
+/*#define THR ((struct thread *) TlsGetValue(PL_thr_key))
#define dTHR struct thread *thr = THR
*/
#ifdef PERL_OBJECT
/* TODO: */
- /* sighandlerp = sighandler; */
+ /* PL_sighandlerp = sighandler; */
#else
PL_sighandlerp = sighandler;
#endif
+ ((double) PATCHLEVEL / (double) 1000)
+ ((double) SUBVERSION / (double) 100000));
#else
- sprintf(patchlevel, "%5.3f", (double) 5 +
+ sprintf(PL_patchlevel, "%5.3f", (double) 5 +
((double) PATCHLEVEL / (double) 1000));
#endif
if (*++s != ':') {
PL_Sv = newSVpv("print myconfig();",0);
#ifdef VMS
- sv_catpv(Sv,"print \"\\nCharacteristics of this PERLSHR image: \\n\",");
+ sv_catpv(PL_Sv,"print \"\\nCharacteristics of this PERLSHR image: \\n\",");
#else
sv_catpv(PL_Sv,"print \"\\nCharacteristics of this binary (from libperl): \\n\",");
#endif
sv_catpv(PL_Sv," DEBUGGING");
# endif
# ifdef NO_EMBED
- sv_catpv(Sv," NO_EMBED");
+ sv_catpv(PL_Sv," NO_EMBED");
# endif
# ifdef MULTIPLICITY
sv_catpv(PL_Sv," MULTIPLICITY");
# ifdef __TIME__
sv_catpvf(PL_Sv,",\" Compiled at %s %s\\n\"",__DATE__,__TIME__);
# else
- sv_catpvf(Sv,",\" Compiled on %s\\n\"",__DATE__);
+ sv_catpvf(PL_Sv,",\" Compiled on %s\\n\"",__DATE__);
# endif
#endif
sv_catpv(PL_Sv, "; \
PATCHLEVEL, SUBVERSION, ARCHNAME);
#else
printf("\nThis is perl, version %s built for %s",
- patchlevel, ARCHNAME);
+ PL_patchlevel, ARCHNAME);
#endif
#if defined(LOCAL_PATCH_COUNT)
if (LOCAL_PATCH_COUNT > 0)
prog = newSVpv(BIN_EXP, 0);
sv_catpv(prog, "/perl");
- file = newSVpv(origfilename, 0);
+ file = newSVpv(PL_origfilename, 0);
sv_catpv(file, ".perldump");
unexec(SvPVX(file), SvPVX(prog), &etext, sbrk(0), 0);
#ifdef PERL_OBJECT /* XXX kludge */
#define I_REINIT \
- STMT_START { \
- chopset = " \n-"; \
- copline = NOLINE; \
- curcop = &compiling; \
- curcopdb = NULL; \
- dbargs = 0; \
- dlmax = 128; \
- laststatval = -1; \
- laststype = OP_STAT; \
- maxscream = -1; \
- maxsysfd = MAXSYSFD; \
- statname = Nullsv; \
- tmps_floor = -1; \
- tmps_ix = -1; \
- op_mask = NULL; \
- dlmax = 128; \
- laststatval = -1; \
- laststype = OP_STAT; \
- mess_sv = Nullsv; \
- splitstr = " "; \
- generation = 100; \
- exitlist = NULL; \
- exitlistlen = 0; \
- regindent = 0; \
- in_clean_objs = FALSE; \
- in_clean_all= FALSE; \
- profiledata = NULL; \
- rsfp = Nullfp; \
- rsfp_filters= Nullav; \
+ STMT_START { \
+ PL_chopset = " \n-"; \
+ PL_copline = NOLINE; \
+ PL_curcop = &PL_compiling;\
+ PL_curcopdb = NULL; \
+ PL_dbargs = 0; \
+ PL_dlmax = 128; \
+ PL_laststatval = -1; \
+ PL_laststype = OP_STAT; \
+ PL_maxscream = -1; \
+ PL_maxsysfd = MAXSYSFD; \
+ PL_statname = Nullsv; \
+ PL_tmps_floor = -1; \
+ PL_tmps_ix = -1; \
+ PL_op_mask = NULL; \
+ PL_dlmax = 128; \
+ PL_laststatval = -1; \
+ PL_laststype = OP_STAT; \
+ PL_mess_sv = Nullsv; \
+ PL_splitstr = " "; \
+ PL_generation = 100; \
+ PL_exitlist = NULL; \
+ PL_exitlistlen = 0; \
+ PL_regindent = 0; \
+ PL_in_clean_objs = FALSE; \
+ PL_in_clean_all = FALSE; \
+ PL_profiledata = NULL; \
+ PL_rsfp = Nullfp; \
+ PL_rsfp_filters = Nullav; \
} STMT_END
I_REINIT;
#else
-e \"/^#[ ]*endif/b\" \
-e \"s/^#.*//\" \
%s | %_ -C %_ %s",
- (doextract ? "-e \"1,/^#/d\n\"" : ""),
+ (PL_doextract ? "-e \"1,/^#/d\n\"" : ""),
#else
sv_setpvf(cmd, "\
%s %s -e '/^[^#]/b' \
if (!PL_rsfp) {
#ifdef DOSUID
#ifndef IAMSUID /* in case script is not readable before setuid */
- if (PL_euid && PerlLIO_stat(SvPVX(GvSV(curcop->cop_filegv)),&PL_statbuf) >= 0 &&
- PL_statbuf.st_mode & (S_ISUID|S_ISGID)) {
+ if (PL_euid &&
+ PerlLIO_stat(SvPVX(GvSV(PL_curcop->cop_filegv)),&PL_statbuf) >= 0 &&
+ PL_statbuf.st_mode & (S_ISUID|S_ISGID))
+ {
/* try again */
- PerlProc_execv(form("%s/sperl%s", BIN_EXP, patchlevel), origargv);
+ PerlProc_execv(form("%s/sperl%s", BIN_EXP, PL_patchlevel), PL_origargv);
croak("Can't do setuid\n");
}
#endif
char *s, *s2;
if (PerlLIO_fstat(PerlIO_fileno(PL_rsfp),&PL_statbuf) < 0) /* normal stat is insecure */
- croak("Can't stat script \"%s\"",origfilename);
+ croak("Can't stat script \"%s\"",PL_origfilename);
if (fdscript < 0 && PL_statbuf.st_mode & (S_ISUID|S_ISGID)) {
I32 len;
* But I don't think it's too important. The manual lies when
* it says access() is useful in setuid programs.
*/
- if (PerlLIO_access(SvPVX(GvSV(curcop->cop_filegv)),1)) /*double check*/
+ if (PerlLIO_access(SvPVX(GvSV(PL_curcop->cop_filegv)),1)) /*double check*/
croak("Permission denied");
#else
/* If we can swap euid and uid, then we can determine access rights
#endif
|| PerlProc_getuid() != PL_euid || PerlProc_geteuid() != PL_uid)
croak("Can't swap uid and euid"); /* really paranoid */
- if (PerlLIO_stat(SvPVX(GvSV(curcop->cop_filegv)),&tmpstatbuf) < 0)
+ if (PerlLIO_stat(SvPVX(GvSV(PL_curcop->cop_filegv)),&tmpstatbuf) < 0)
croak("Permission denied"); /* testing full pathname here */
if (tmpstatbuf.st_dev != PL_statbuf.st_dev ||
tmpstatbuf.st_ino != PL_statbuf.st_ino) {
(Filename of set-id script was %s, uid %ld gid %ld.)\n\nSincerely,\nperl\n",
(long)PL_uid,(long)tmpstatbuf.st_dev, (long)tmpstatbuf.st_ino,
(long)PL_statbuf.st_dev, (long)PL_statbuf.st_ino,
- SvPVX(GvSV(curcop->cop_filegv)),
+ SvPVX(GvSV(PL_curcop->cop_filegv)),
(long)PL_statbuf.st_uid, (long)PL_statbuf.st_gid);
(void)PerlProc_pclose(PL_rsfp);
}
croak("Permission denied");
if (PL_statbuf.st_mode & S_IWOTH)
croak("Setuid/gid script is writable by world");
- doswitches = FALSE; /* -s is insecure in suid */
- curcop->cop_line++;
- if (sv_gets(linestr, PL_rsfp, 0) == Nullch ||
- strnNE(SvPV(linestr,na),"#!",2) ) /* required even on Sys V */
+ PL_doswitches = FALSE; /* -s is insecure in suid */
+ PL_curcop->cop_line++;
+ if (sv_gets(PL_linestr, PL_rsfp, 0) == Nullch ||
+ strnNE(SvPV(PL_linestr,PL_na),"#!",2) ) /* required even on Sys V */
croak("No #! line");
- s = SvPV(linestr,na)+2;
+ s = SvPV(PL_linestr,PL_na)+2;
if (*s == ' ') s++;
while (!isSPACE(*s)) s++;
- for (s2 = s; (s2 > SvPV(linestr,na)+2 &&
+ for (s2 = s; (s2 > SvPV(PL_linestr,PL_na)+2 &&
(isDIGIT(s2[-1]) || strchr("._-", s2[-1]))); s2--) ;
if (strnNE(s2-4,"perl",4) && strnNE(s-9,"perl",4)) /* sanity check */
croak("Not a perl script");
(void)PerlIO_close(PL_rsfp);
#ifndef IAMSUID
/* try again */
- PerlProc_execv(form("%s/sperl%s", BIN_EXP, patchlevel), origargv);
+ PerlProc_execv(form("%s/sperl%s", BIN_EXP, PL_patchlevel), PL_origargv);
#endif
croak("Can't do setuid\n");
}
croak("Permission denied\n"); /* they can't do this */
}
#ifdef IAMSUID
- else if (preprocess)
+ else if (PL_preprocess)
croak("-P not allowed for setuid/setgid script\n");
else if (fdscript >= 0)
croak("fd script not allowed in suidperl\n");
/* (We pass script name as "subdir" of fd, which perl will grok.) */
PerlIO_rewind(PL_rsfp);
PerlLIO_lseek(PerlIO_fileno(PL_rsfp),(Off_t)0,0); /* just in case rewind didn't */
- for (which = 1; origargv[which] && origargv[which] != scriptname; which++) ;
- if (!origargv[which])
+ for (which = 1; PL_origargv[which] && PL_origargv[which] != scriptname; which++) ;
+ if (!PL_origargv[which])
croak("Permission denied");
- origargv[which] = savepv(form("/dev/fd/%d/%s",
- PerlIO_fileno(PL_rsfp), origargv[which]));
+ PL_origargv[which] = savepv(form("/dev/fd/%d/%s",
+ PerlIO_fileno(PL_rsfp), PL_origargv[which]));
#if defined(HAS_FCNTL) && defined(F_SETFD)
fcntl(PerlIO_fileno(PL_rsfp),F_SETFD,0); /* ensure no close-on-exec */
#endif
- PerlProc_execv(form("%s/perl%s", BIN_EXP, patchlevel), origargv); /* try again */
+ PerlProc_execv(form("%s/perl%s", BIN_EXP, PL_patchlevel), PL_origargv);/* try again */
croak("Can't do setuid\n");
#endif /* IAMSUID */
#else /* !DOSUID */
sprintf(PL_archpat_auto, "/%s/%s/auto", ARCHNAME, PL_patchlevel);
#ifdef VMS
for (len = sizeof(ARCHNAME) + 2;
- archpat_auto[len] != '\0' && archpat_auto[len] != '/'; len++)
- if (archpat_auto[len] == '.') archpat_auto[len] = '_';
+ PL_archpat_auto[len] != '\0' && PL_archpat_auto[len] != '/'; len++)
+ if (PL_archpat_auto[len] == '.') PL_archpat_auto[len] = '_';
#endif
}
}
/* skip any consecutive separators */
while ( *p == PERLLIB_SEP ) {
/* Uncomment the next line for PATH semantics */
- /* av_push(GvAVn(incgv), newSVpv(".", 1)); */
+ /* av_push(GvAVn(PL_incgv), newSVpv(".", 1)); */
p++;
}
char *unix;
STRLEN len;
- if ((unix = tounixspec_ts(SvPV(libdir,na),Nullch)) != Nullch) {
+ if ((unix = tounixspec_ts(SvPV(libdir,PL_na),Nullch)) != Nullch) {
len = strlen(unix);
while (unix[len-1] == '/') len--; /* Cosmetic */
sv_usepvn(libdir,unix,len);
else
PerlIO_printf(PerlIO_stderr(),
"Failed to unixify @INC element \"%s\"\n",
- SvPV(libdir,na));
+ SvPV(libdir,PL_na));
#endif
/* .../archname/version if -d .../archname/version/auto */
sv_setsv(subdir, libdir);
#ifdef VMS
-# define STATUS_NATIVE statusvalue_vms
+# define STATUS_NATIVE PL_statusvalue_vms
# define STATUS_NATIVE_EXPORT \
- ((I32)statusvalue_vms == -1 ? 44 : statusvalue_vms)
+ ((I32)PL_statusvalue_vms == -1 ? 44 : PL_statusvalue_vms)
# define STATUS_NATIVE_SET(n) \
STMT_START { \
- statusvalue_vms = (n); \
- if ((I32)statusvalue_vms == -1) \
+ PL_statusvalue_vms = (n); \
+ if ((I32)PL_statusvalue_vms == -1) \
PL_statusvalue = -1; \
- else if (statusvalue_vms & STS$M_SUCCESS) \
+ else if (PL_statusvalue_vms & STS$M_SUCCESS) \
PL_statusvalue = 0; \
- else if ((statusvalue_vms & STS$M_SEVERITY) == 0) \
- PL_statusvalue = 1 << 8; \
+ else if ((PL_statusvalue_vms & STS$M_SEVERITY) == 0) \
+ PL_statusvalue = 1 << 8; \
else \
- PL_statusvalue = (statusvalue_vms & STS$M_SEVERITY) << 8; \
+ PL_statusvalue = (PL_statusvalue_vms & STS$M_SEVERITY) << 8; \
} STMT_END
# define STATUS_POSIX PL_statusvalue
# ifdef VMSISH_STATUS
PL_statusvalue = (n); \
if (PL_statusvalue != -1) { \
PL_statusvalue &= 0xFFFF; \
- statusvalue_vms = PL_statusvalue ? 44 : 1; \
+ PL_statusvalue_vms = PL_statusvalue ? 44 : 1; \
} \
- else statusvalue_vms = -1; \
+ else PL_statusvalue_vms = -1; \
} STMT_END
-# define STATUS_ALL_SUCCESS (PL_statusvalue = 0, statusvalue_vms = 1)
-# define STATUS_ALL_FAILURE (PL_statusvalue = 1, statusvalue_vms = 44)
+# define STATUS_ALL_SUCCESS (PL_statusvalue = 0, PL_statusvalue_vms = 1)
+# define STATUS_ALL_FAILURE (PL_statusvalue = 1, PL_statusvalue_vms = 44)
#else
# define STATUS_NATIVE STATUS_POSIX
# define STATUS_NATIVE_EXPORT STATUS_POSIX
# define PAD_SV(po) pad_sv(po)
# define RUNOPS_DEFAULT runops_debug
#else
-# define PAD_SV(po) curpad[po]
+# define PAD_SV(po) PL_curpad[po]
# define RUNOPS_DEFAULT runops_standard
#endif
#ifdef HAS_CRYPT
char *tmps = SvPV(left, PL_na);
#ifdef FCRYPT
- sv_setpv(TARG, fcrypt(tmps, SvPV(right, na)));
+ sv_setpv(TARG, fcrypt(tmps, SvPV(right, PL_na)));
#else
sv_setpv(TARG, crypt(tmps, SvPV(right, PL_na)));
#endif
char *tmps = SvPV(final, len);
sv = sv_mortalcopy(left);
- SvPV_force(sv,na);
+ SvPV_force(sv,PL_na);
while (!SvNIOKp(sv) && SvCUR(sv) <= len) {
XPUSHs(sv);
if (strEQ(SvPVX(sv),tmps))
if (do_dump) {
#ifdef VMS
- if (!retop) retop = main_start;
+ if (!retop) retop = PL_main_start;
#endif
PL_restartop = retop;
PL_do_undump = TRUE;
match = 0;
else if (match > cCOP->uop.scop.scop_max)
match = cCOP->uop.scop.scop_max;
- op = cCOP->uop.scop.scop_next[match];
- RETURNOP(op);
+ PL_op = cCOP->uop.scop.scop_next[match];
+ RETURNOP(PL_op);
}
PP(pp_cswitch)
djSP;
register I32 match;
- if (multiline)
- op = op->op_next; /* can't assume anything */
+ if (PL_multiline)
+ PL_op = PL_op->op_next; /* can't assume anything */
else {
- match = *(SvPVx(GvSV(cCOP->cop_gv), na)) & 255;
+ match = *(SvPVx(GvSV(cCOP->cop_gv), PL_na)) & 255;
match -= cCOP->uop.scop.scop_offset;
if (match < 0)
match = 0;
else if (match > cCOP->uop.scop.scop_max)
match = cCOP->uop.scop.scop_max;
- op = cCOP->uop.scop.scop_next[match];
+ PL_op = cCOP->uop.scop.scop_next[match];
}
- RETURNOP(op);
+ RETURNOP(PL_op);
}
#endif
SAVEDELETE(PL_defstash, safestr, strlen(safestr));
SAVEHINTS();
#ifdef OP_IN_REGISTER
- opsave = op;
+ PL_opsave = op;
#else
SAVEPPTR(PL_op);
#endif
PL_op->op_type = 0; /* Avoid uninit warning. */
PL_op->op_flags = 0; /* Avoid uninit warning. */
PUSHBLOCK(cx, CXt_EVAL, SP);
- PUSHEVAL(cx, 0, compiling.cop_filegv);
+ PUSHEVAL(cx, 0, PL_compiling.cop_filegv);
rop = doeval(G_SCALAR, startop);
POPBLOCK(cx,PL_curpm);
POPEVAL(cx);
*avp = (AV*)SvREFCNT_inc(PL_comppad);
LEAVE;
#ifdef OP_IN_REGISTER
- op = opsave;
+ op = PL_opsave;
#endif
return rop;
}
push_return(PL_op->op_next);
PUSHBLOCK(cx, CXt_EVAL, SP);
- PUSHEVAL(cx, name, compiling.cop_filegv);
+ PUSHEVAL(cx, name, PL_compiling.cop_filegv);
PL_compiling.cop_line = 0;
push_return(PL_op->op_next);
PUSHBLOCK(cx, CXt_EVAL, SP);
- PUSHEVAL(cx, 0, compiling.cop_filegv);
+ PUSHEVAL(cx, 0, PL_compiling.cop_filegv);
/* prepare to compile string */
Copy(&PL_op, &LvTARGOFF(sv), 1, OP*);
XPUSHs(sv);
#else
- XPUSHs((SV*)op);
+ XPUSHs((SV*)PL_op);
#endif
RETURN;
}
PL_rs = sv_2mortal(newSVpv("", 1));
#ifndef DOSISH
#ifndef CSH
- *SvPVX(rs) = '\n';
+ *SvPVX(PL_rs) = '\n';
#endif /* !CSH */
#endif /* !DOSISH */
#if 0 /* XXX never used! */
PP(pp_indread)
{
- last_in_gv = gv_fetchpv(SvPVx(GvSV((GV*)(*stack_sp--)), PL_na), TRUE,SVt_PVIO);
+ PL_last_in_gv = gv_fetchpv(SvPVx(GvSV((GV*)(*PL_stack_sp--)), PL_na), TRUE,SVt_PVIO);
return do_readline();
}
#endif
* since 'group' and 'other' concepts probably don't exist here. */
if (MAXARG >= 1 && (POPi & 0700))
DIE("umask not implemented");
- XPUSHs(&sv_undef);
+ XPUSHs(&PL_sv_undef);
#endif
RETURN;
}
#endif
PUSHs(sv_2mortal(newSViv((I32)PL_statcache.st_size)));
#ifdef BIG_TIME
- PUSHs(sv_2mortal(newSVnv((U32)statcache.st_atime)));
- PUSHs(sv_2mortal(newSVnv((U32)statcache.st_mtime)));
- PUSHs(sv_2mortal(newSVnv((U32)statcache.st_ctime)));
+ PUSHs(sv_2mortal(newSVnv((U32)PL_statcache.st_atime)));
+ PUSHs(sv_2mortal(newSVnv((U32)PL_statcache.st_mtime)));
+ PUSHs(sv_2mortal(newSVnv((U32)PL_statcache.st_ctime)));
#else
PUSHs(sv_2mortal(newSViv((I32)PL_statcache.st_atime)));
PUSHs(sv_2mortal(newSViv((I32)PL_statcache.st_mtime)));
}
#ifdef VMS
if (!tmps || !*tmps) {
- svp = hv_fetch(GvHVn(envgv), "SYS$LOGIN", 9, FALSE);
+ svp = hv_fetch(GvHVn(PL_envgv), "SYS$LOGIN", 9, FALSE);
if (svp)
tmps = SvPV(*svp, PL_na);
}
#ifdef VMS
/* Clear the DEFAULT element of ENV so we'll get the new value
* in the future. */
- hv_delete(GvHVn(envgv),"DEFAULT",7,G_DISCARD);
+ hv_delete(GvHVn(PL_envgv),"DEFAULT",7,G_DISCARD);
#endif
RETURN;
}
#ifdef HAS_RENAME
anum = PerlLIO_rename(tmps, tmps2);
#else
- if (!(anum = PerlLIO_stat(tmps, &statbuf))) {
+ if (!(anum = PerlLIO_stat(tmps, &PL_statbuf))) {
if (same_dirent(tmps2, tmps)) /* can always rename to same name */
anum = 1;
else {
- if (euid || PerlLIO_stat(tmps2, &statbuf) < 0 || !S_ISDIR(statbuf.st_mode))
+ if (euid || PerlLIO_stat(tmps2, &PL_statbuf) < 0 || !S_ISDIR(PL_statbuf.st_mode))
(void)UNLINK(tmps2);
if (!(anum = link(tmps, tmps2)))
anum = UNLINK(tmps);
if (myfp) {
SV *tmpsv = sv_newmortal();
- /* Need to save/restore 'rs' ?? */
+ /* Need to save/restore 'PL_rs' ?? */
s = sv_gets(tmpsv, myfp, 0);
(void)PerlProc_pclose(myfp);
if (s != Nullch) {
return 0;
}
else { /* some mkdirs return no failure indication */
- anum = (PerlLIO_stat(save_filename, &statbuf) >= 0);
+ anum = (PerlLIO_stat(save_filename, &PL_statbuf) >= 0);
if (PL_op->op_type == OP_RMDIR)
anum = !anum;
if (anum)
#ifndef VMS
(void)PerlProc_times(&PL_timesbuf);
#else
- (void)PerlProc_times((tbuffer_t *)×buf); /* time.h uses different name for */
+ (void)PerlProc_times((tbuffer_t *)&PL_timesbuf); /* time.h uses different name for */
/* struct tms, though same data */
/* is returned. */
#endif
sv_setpvn(sv, *elem, len);
}
#else
- PUSHs(sv = sv_mortalcopy(&sv_no));
+ PUSHs(sv = sv_mortalcopy(&PL_sv_no));
if (hent->h_addr)
sv_setpvn(sv, hent->h_addr, len);
#endif /* h_addr */
sv_setpv(sv, pwent->pw_shell);
#ifdef PWEXPIRE
- PUSHs(sv = sv_mortalcopy(&sv_no));
+ PUSHs(sv = sv_mortalcopy(&PL_sv_no));
sv_setiv(sv, (IV)pwent->pw_expire);
#endif
}
ret = PL_regcode;
if (SIZE_ONLY) {
- SIZE_ALIGN(regsize);
+ SIZE_ALIGN(PL_regsize);
PL_regsize += 1;
return(ret);
}
ret = PL_regcode;
if (SIZE_ONLY) {
- SIZE_ALIGN(regsize);
+ SIZE_ALIGN(PL_regsize);
PL_regsize += 2;
return(ret);
}
#define UCHARAT(p) ((int)*(p)&CHARMASK)
#endif
#else /* lint */
-#define UCHARAT(p) regdummy
+#define UCHARAT(p) PL_regdummy
#endif /* lint */
#define FAIL(m) croak ("/%.127s/: %s", PL_regprecomp,m)
: (PL_multiline &&
(nextchr || locinput < PL_regeol) && locinput[-1] == '\n') )
{
- /* regtill = regbol; */
+ /* PL_regtill = PL_regbol; */
break;
}
sayNO;
#ifndef STRESS_REALLOC
av_extend(PL_curstack, (p - PL_stack_base) + (n) + 128);
#else
- av_extend(curstack, (p - stack_base) + (n) + 1);
+ av_extend(PL_curstack, (p - PL_stack_base) + (n) + 1);
#endif
#if defined(DEBUGGING) && !defined(USE_THREADS)
growing--;
typedef struct jmpenv JMPENV;
#ifdef OP_IN_REGISTER
-#define OP_REG_TO_MEM opsave = op
-#define OP_MEM_TO_REG op = opsave
+#define OP_REG_TO_MEM PL_opsave = op
+#define OP_MEM_TO_REG op = PL_opsave
#else
#define OP_REG_TO_MEM NOOP
#define OP_MEM_TO_REG NOOP
# define SvREFCNT_inc(sv) sv_newref((SV*)sv)
# else
# define SvREFCNT_inc(sv) \
- ((Sv=(SV*)(sv)), (Sv && ATOMIC_INC(SvREFCNT(Sv))), (SV*)Sv)
+ ((PL_Sv=(SV*)(sv)), (PL_Sv && ATOMIC_INC(SvREFCNT(PL_Sv))), (SV*)PL_Sv)
# endif
#endif
#define SvLEN(sv) ((XPV*) SvANY(sv))->xpv_len
#define SvLENx(sv) SvLEN(sv)
#define SvEND(sv)(((XPV*) SvANY(sv))->xpv_pv + ((XPV*)SvANY(sv))->xpv_cur)
-#define SvENDx(sv) ((Sv = (sv)), SvEND(Sv))
+#define SvENDx(sv) ((PL_Sv = (sv)), SvEND(PL_Sv))
#define SvMAGIC(sv) ((XPVMG*) SvANY(sv))->xmg_magic
#define SvSTASH(sv) ((XPVMG*) SvANY(sv))->xmg_stash
# undef SvPVx
# undef SvTRUE
# undef SvTRUEx
-# define SvIVx(sv) ((Sv = (sv)), SvIV(Sv))
-# define SvUVx(sv) ((Sv = (sv)), SvUV(Sv))
-# define SvNVx(sv) ((Sv = (sv)), SvNV(Sv))
-# define SvPVx(sv, lp) ((Sv = (sv)), SvPV(Sv, lp))
+# define SvIVx(sv) ((PL_Sv = (sv)), SvIV(PL_Sv))
+# define SvUVx(sv) ((PL_Sv = (sv)), SvUV(PL_Sv))
+# define SvNVx(sv) ((PL_Sv = (sv)), SvNV(PL_Sv))
+# define SvPVx(sv, lp) ((PL_Sv = (sv)), SvPV(PL_Sv, lp))
# define SvTRUE(sv) ( \
!sv \
? 0 \
: SvPOK(sv) \
- ? ((Xpv = (XPV*)SvANY(sv)) && \
- (*Xpv->xpv_pv > '0' || \
- Xpv->xpv_cur > 1 || \
- (Xpv->xpv_cur && *Xpv->xpv_pv != '0')) \
+ ? ((PL_Xpv = (XPV*)SvANY(sv)) && \
+ (*PL_Xpv->xpv_pv > '0' || \
+ PL_Xpv->xpv_cur > 1 || \
+ (PL_Xpv->xpv_cur && *PL_Xpv->xpv_pv != '0')) \
? 1 \
: 0) \
: \
: SvNOK(sv) \
? SvNVX(sv) != 0.0 \
: sv_2bool(sv) )
-# define SvTRUEx(sv) ((Sv = (sv)), SvTRUE(Sv))
+# define SvTRUEx(sv) ((PL_Sv = (sv)), SvTRUE(PL_Sv))
#endif /* !USE_THREADS */
#endif /* !__GNU__ */
#endif /* !CRIPPLED_CC */
while (1) {
if (i)
(void)sprintf(name,"DCL$PATH;%d", i);
- svp = hv_fetch(GvHVn(envgv), name, strlen(name), FALSE);
- if (!svp || *svp == &sv_undef)
+ svp = hv_fetch(GvHVn(PL_envgv), name, strlen(name), FALSE);
+ if (!svp || *svp == &PL_sv_undef)
break;
if (SvTAINTED(*svp)) {
dTHR;
*/
SV *x = GvSV(gv_fetchpv("\030", TRUE, SVt_PV));
assert(SvPOK(x) || SvGMAGICAL(x));
- if (sv_eq(x, GvSV(curcop->cop_filegv))) {
+ if (sv_eq(x, GvSV(PL_curcop->cop_filegv))) {
sv_setpvn(x, ipath, ipathend - ipath);
SvSETMAGIC(x);
}
case KEY_crypt:
#ifdef FCRYPT
- if (!cryptseen++)
+ if (!PL_cryptseen++)
init_des();
#endif
LOP(OP_CRYPT,XTERM);
#if !(defined(I286) || defined(atarist))
DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%x: (%05d) malloc %ld bytes\n",ptr,PL_an++,(long)size));
#else
- DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%lx: (%05d) malloc %ld bytes\n",ptr,an++,(long)size));
+ DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%lx: (%05d) malloc %ld bytes\n",ptr,PL_an++,(long)size));
#endif
if (ptr != Nullch)
return ptr;
} )
#else
DEBUG_m( {
- PerlIO_printf(Perl_debug_log, "0x%lx: (%05d) rfree\n",where,an++);
- PerlIO_printf(Perl_debug_log, "0x%lx: (%05d) realloc %ld bytes\n",ptr,an++,(long)size);
+ PerlIO_printf(Perl_debug_log, "0x%lx: (%05d) rfree\n",where,PL_an++);
+ PerlIO_printf(Perl_debug_log, "0x%lx: (%05d) realloc %ld bytes\n",ptr,PL_an++,(long)size);
} )
#endif
#if !(defined(I286) || defined(atarist))
DEBUG_m( PerlIO_printf(Perl_debug_log, "0x%x: (%05d) free\n",(char *) where,PL_an++));
#else
- DEBUG_m( PerlIO_printf(Perl_debug_log, "0x%lx: (%05d) free\n",(char *) where,an++));
+ DEBUG_m( PerlIO_printf(Perl_debug_log, "0x%lx: (%05d) free\n",(char *) where,PL_an++));
#endif
if (where) {
/*SUPPRESS 701*/
#if !(defined(I286) || defined(atarist))
DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%x: (%05d) calloc %ld x %ld bytes\n",ptr,PL_an++,(long)count,(long)size));
#else
- DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%lx: (%05d) calloc %ld x %ld bytes\n",ptr,an++,(long)count,(long)size));
+ DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%lx: (%05d) calloc %ld x %ld bytes\n",ptr,PL_an++,(long)count,(long)size));
#endif
if (ptr != Nullch) {
memset((void*)ptr, 0, size);
if (!last) return (char *)(big+pos-previous);
found = 1;
}
- } while ( pos += screamnext[pos] );
+ } while ( pos += PL_screamnext[pos] );
return (last && found) ? (char *)(big+(*old_posp)-previous) : Nullch;
#else /* !POINTERRIGOR */
big -= previous;
#ifndef NOFILE
#define NOFILE 20
#endif
- for (fd = maxsysfd + 1; fd < NOFILE; fd++)
+ for (fd = PL_maxsysfd + 1; fd < NOFILE; fd++)
PerlLIO_close(fd);
#endif
do_exec(cmd); /* may or may not use the shell */
{
pthread_addr_t t;
- if (pthread_getspecific(thr_key, &t))
+ if (pthread_getspecific(PL_thr_key, &t))
croak("panic: pthread_getspecific");
return (struct perl_thread *) t;
}
PL_in_eval = FALSE;
PL_restartop = 0;
- tainted = t->Ttainted;
+ PL_tainted = t->Ttainted;
PL_curpm = t->Tcurpm; /* XXX No PMOP ref count */
PL_nrs = newSVsv(t->Tnrs);
PL_rs = SvREFCNT_inc(PL_nrs);
_ckvmssts(lib$sfree1_dd(&valdsc));
}
else {
- ST(0) = &sv_undef; /* error - we're returning undef, if anything */
+ ST(0) = &PL_sv_undef; /* error - we're returning undef, if anything */
switch (retsts) {
case LIB$_NOSUCHSYM:
break; /* nobody home */;
* symbol tables. This code (through io = ...) is really
* equivalent to gv_fetchpv("VMS::Stdio::__FH__",TRUE,SVt_PVIO),
* with a little less overhead, and good exercise for me. :-) */
- stashp = (GV **)hv_fetch(defstash,"VMS::",5,TRUE);
- if (!stashp || *stashp == (GV *)&sv_undef) return Nullsv;
+ stashp = (GV **)hv_fetch(PL_defstash,"VMS::",5,TRUE);
+ if (!stashp || *stashp == (GV *)&PL_sv_undef) return Nullsv;
if (!(stash = GvHV(*stashp))) stash = GvHV(*stashp) = newHV();
stashp = (GV **)hv_fetch(GvHV(*stashp),"Stdio::",7,TRUE);
- if (!stashp || *stashp == (GV *)&sv_undef) return Nullsv;
+ if (!stashp || *stashp == (GV *)&PL_sv_undef) return Nullsv;
if (!(stash = GvHV(*stashp))) stash = GvHV(*stashp) = newHV();
/* Set up GV to point to IO, and then take reference */
if (constant(name, &i))
ST(0) = sv_2mortal(newSViv(i));
else
- ST(0) = &sv_undef;
+ ST(0) = &PL_sv_undef;
void
flush(fp)
FILE * fp
PROTOTYPE: $
CODE:
- if (fflush(fp)) { ST(0) = &sv_undef; }
- else { clearerr(fp); ST(0) = &sv_yes; }
+ if (fflush(fp)) { ST(0) = &PL_sv_undef; }
+ else { clearerr(fp); ST(0) = &PL_sv_yes; }
char *
getname(fp)
FILE * fp
PROTOTYPE: $
CODE:
- ST(0) = rewind(fp) ? &sv_undef : &sv_yes;
+ ST(0) = rewind(fp) ? &PL_sv_undef : &PL_sv_yes;
void
remove(name)
char *name
PROTOTYPE: $
CODE:
- ST(0) = remove(name) ? &sv_undef : &sv_yes;
+ ST(0) = remove(name) ? &PL_sv_undef : &PL_sv_yes;
void
setdef(...)
struct dsc$descriptor_s dirdsc = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0};
if (items) {
SV *defsv = ST(items-1); /* mimic chdir() */
- ST(0) = &sv_undef;
+ ST(0) = &PL_sv_undef;
if (!SvPOK(defsv)) { SETERRNO(EINVAL,LIB$_INVARG); XSRETURN(1); }
- if (tovmsspec(SvPV(defsv,na),vmsdef) == NULL) { XSRETURN(1); }
+ if (tovmsspec(SvPV(defsv,PL_na),vmsdef) == NULL) { XSRETURN(1); }
deffab.fab$l_fna = vmsdef; deffab.fab$b_fns = strlen(vmsdef);
}
else {
deffab.fab$l_fna = "SYS$LOGIN"; deffab.fab$b_fns = 9;
- EXTEND(sp,1); ST(0) = &sv_undef;
+ EXTEND(sp,1); ST(0) = &PL_sv_undef;
}
defnam.nam$l_esa = es; defnam.nam$b_ess = sizeof es;
deffab.fab$l_nam = &defnam;
my_setenv("SYS$DISK",defnam.nam$b_node ? defnam.nam$l_node : defnam.nam$l_dev);
*defnam.nam$l_dir = sep;
dirdsc.dsc$a_pointer = defnam.nam$l_dir; dirdsc.dsc$w_length = defnam.nam$b_dir;
- if ((retsts = sys$setddir(&dirdsc,0,0)) & 1) ST(0) = &sv_yes;
+ if ((retsts = sys$setddir(&dirdsc,0,0)) & 1) ST(0) = &PL_sv_yes;
else { set_errno(EVMSERR); set_vaxc_errno(retsts); }
(void) sys$parse(&deffab,0,0); /* free up context */
FILE * fp
PROTOTYPE: $
CODE:
- if (fsync(fileno(fp))) { ST(0) = &sv_undef; }
- else { clearerr(fp); ST(0) = &sv_yes; }
+ if (fsync(fileno(fp))) { ST(0) = &PL_sv_undef; }
+ else { clearerr(fp); ST(0) = &PL_sv_yes; }
char *
tmpnam()
}
else if (*spec == '<') spec++;
myargc = items - 1;
- for (i = 0; i < myargc; i++) args[i] = SvPV(ST(i+1),na);
+ for (i = 0; i < myargc; i++) args[i] = SvPV(ST(i+1),PL_na);
/* This hack brought to you by C's opaque arglist management */
switch (myargc) {
case 0:
}
if (fp != Nullfp) {
SV *fh = newFH(fp,(mode[1] ? '+' : (mode[0] == 'r' ? '<' : (mode[0] == 'a' ? 'a' : '>'))));
- ST(0) = (fh ? sv_2mortal(fh) : &sv_undef);
+ ST(0) = (fh ? sv_2mortal(fh) : &PL_sv_undef);
}
- else { ST(0) = &sv_undef; }
+ else { ST(0) = &PL_sv_undef; }
void
vmssysopen(spec,mode,perm,...)
}
if (items > 11) croak("too many args");
myargc = items - 3;
- for (i = 0; i < myargc; i++) args[i] = SvPV(ST(i+3),na);
+ for (i = 0; i < myargc; i++) args[i] = SvPV(ST(i+3),PL_na);
/* More fun with C calls; can't combine with above because
args 2,3 of different types in fopen() and open() */
switch (myargc) {
if (fd >= 0 &&
((fp = fdopen(fd, &("r\000w\000r+"[2*i]))) != Nullfp)) {
SV *fh = newFH(fp,"<>++"[i]);
- ST(0) = (fh ? sv_2mortal(fh) : &sv_undef);
+ ST(0) = (fh ? sv_2mortal(fh) : &PL_sv_undef);
}
- else { ST(0) = &sv_undef; }
+ else { ST(0) = &PL_sv_undef; }
void
waitfh(fp)
FILE * fp
PROTOTYPE: $
CODE:
- ST(0) = fwait(fp) ? &sv_undef : &sv_yes;
+ ST(0) = fwait(fp) ? &PL_sv_undef : &PL_sv_yes;
void
writeof(mysv)
FILE *fp = io ? IoOFP(io) : NULL;
if (fp == NULL || strchr(">was+-|",IoTYPE(io)) == Nullch) {
set_errno(EBADF); set_vaxc_errno(SS$_IVCHAN);
- ST(0) = &sv_undef; XSRETURN(1);
+ ST(0) = &PL_sv_undef; XSRETURN(1);
}
- if (fgetname(fp,devnam) == Nullch) { ST(0) = &sv_undef; XSRETURN(1); }
+ if (fgetname(fp,devnam) == Nullch) { ST(0) = &PL_sv_undef; XSRETURN(1); }
if ((cp = strrchr(devnam,':')) != NULL) *(cp+1) = '\0';
devdsc.dsc$w_length = strlen(devnam);
retsts = sys$assign(&devdsc,&chan,0,0);
if (retsts & 1) retsts = iosb[0];
retsts2 = sys$dassgn(chan); /* Be sure to deassign the channel */
if (retsts & 1) retsts = retsts2;
- if (retsts & 1) { ST(0) = &sv_yes; }
+ if (retsts & 1) { ST(0) = &PL_sv_yes; }
else {
set_vaxc_errno(retsts);
switch (retsts) {
default: /* Includes "shouldn't happen" cases that might map */
set_errno(EVMSERR); break; /* to other errno values */
}
- ST(0) = &sv_undef;
+ ST(0) = &PL_sv_undef;
}
int trnsuccess;
SV *tmpsv;
- if (curinterp) { /* Perl interpreter running -- may be threaded */
+ if (PL_curinterp) { /* Perl interpreter running -- may be threaded */
/* Set up a temporary buffer for the return value; Perl will
* clean it up at the next statement transition */
tmpsv = sv_2mortal(newSVpv("",LNM$C_NAMLENGTH+1));
{
dTHR;
static int primed = 0;
- HV *envhv = GvHVn(envgv);
+ HV *envhv = GvHVn(PL_envgv);
PerlIO *sholog;
char eqv[LNM$C_NAMLENGTH+1],mbxnam[LNM$C_NAMLENGTH+1],*start,*end;
unsigned short int chan;
}
/* We use Perl's sv_gets to read from the pipe, since PerlIO_open is
* tied to Perl's I/O layer, so it may not return a simple FILE * */
- oldrs = rs;
- rs = newSVpv("\n",1);
+ oldrs = PL_rs;
+ PL_rs = newSVpv("\n",1);
linesv = newSVpv("",0);
while (1) {
if ((start = sv_gets(linesv,sholog,0)) == Nullch) {
PerlIO_close(sholog);
- SvREFCNT_dec(linesv); SvREFCNT_dec(rs); rs = oldrs;
+ SvREFCNT_dec(linesv); SvREFCNT_dec(PL_rs); PL_rs = oldrs;
primed = 1;
/* Wait for subprocess to clean up (we know subproc won't return 0) */
while (substs == 0) { sys$hiber(); wakect++;}
else end = Nullch;
if ((eqvlen = my_trnlnm(start,eqv,0)) == 0) {
if (vaxc$errno == SS$_NOLOGNAM || vaxc$errno == SS$_IVLOGNAM) {
- if (dowarn)
+ if (PL_dowarn)
warn("Ill-formed logical name |%s| in prime_env_iter",start);
continue;
}
info->next=open_pipes; /* prepend to list */
open_pipes=info;
- forkprocess = info->pid;
+ PL_forkprocess = info->pid;
return info->fp;
} /* end of safe_popen */
unsigned long int ownercode = JPI$_OWNER, ownerpid, mypid;
unsigned long int interval[2],sts;
- if (dowarn) {
+ if (PL_dowarn) {
_ckvmssts(lib$getjpi(&ownercode,&pid,0,&ownerpid,0,0));
_ckvmssts(lib$getjpi(&ownercode,0,0,&mypid,0,0));
if (ownerpid != mypid)
if (mask != rlst) Safefree(mask);
}
/* We need to use this hack to tell Perl it should run with tainting,
- * since its tainting flag may be part of the curinterp struct, which
+ * since its tainting flag may be part of the PL_curinterp struct, which
* hasn't been allocated when vms_image_init() is called.
*/
if (add_taint) {
static void
vms_execfree() {
- if (Cmd) {
- Safefree(Cmd);
- Cmd = Nullch;
+ if (PL_Cmd) {
+ Safefree(PL_Cmd);
+ PL_Cmd = Nullch;
}
if (VMScmd.dsc$a_pointer) {
Safefree(VMScmd.dsc$a_pointer);
cmdlen += rlen ? rlen + 1 : 0;
}
}
- New(401,Cmd,cmdlen+1,char);
+ New(401,PL_Cmd,cmdlen+1,char);
if (tmps && *tmps) {
- strcpy(Cmd,tmps);
+ strcpy(PL_Cmd,tmps);
mark++;
}
- else *Cmd = '\0';
+ else *PL_Cmd = '\0';
while (++mark <= sp) {
if (*mark) {
- strcat(Cmd," ");
- strcat(Cmd,SvPVx(*mark,na));
+ strcat(PL_Cmd," ");
+ strcat(PL_Cmd,SvPVx(*mark,PL_na));
}
}
- return Cmd;
+ return PL_Cmd;
} /* end of setup_argstr() */
else isdcl = 1;
if (isdcl) { /* It's a DCL command, just do it. */
VMScmd.dsc$w_length = strlen(cmd);
- if (cmd == Cmd) {
- VMScmd.dsc$a_pointer = Cmd;
- Cmd = Nullch; /* Don't try to free twice in vms_execfree() */
+ if (cmd == PL_Cmd) {
+ VMScmd.dsc$a_pointer = PL_Cmd;
+ PL_Cmd = Nullch; /* Don't try to free twice in vms_execfree() */
}
else VMScmd.dsc$a_pointer = savepvn(cmd,VMScmd.dsc$w_length);
}
set_errno(EVMSERR);
}
set_vaxc_errno(retsts);
- if (dowarn)
+ if (PL_dowarn)
warn("Can't exec \"%s\": %s", VMScmd.dsc$a_pointer, Strerror(errno));
vms_execfree();
}
set_errno(EVMSERR);
}
set_vaxc_errno(sts);
- if (dowarn)
+ if (PL_dowarn)
warn("Can't spawn \"%s\": %s",
hadcmd ? VMScmd.dsc$a_pointer : "", Strerror(errno));
}
return (*name++ == ':') && (*name != ':');
}
-/* Do the permissions allow some operation? Assumes statcache already set. */
+/* Do the permissions allow some operation? Assumes PL_statcache already set. */
/* Do this via $Check_Access on VMS, since the CRTL stat() returns only a
* subset of the applicable information.
*/
cando(I32 bit, I32 effective, Stat_t *statbufp)
{
dTHR;
- if (statbufp == &statcache) return cando_by_name(bit,effective,namecache);
+ if (statbufp == &PL_statcache) return cando_by_name(bit,effective,namecache);
else {
char fname[NAM$C_MAXRSS+1];
unsigned long int retsts;
{
dTHR;
if (!fstat(fd,(stat_t *) statbufp)) {
- if (statbufp == (Stat_t *) &statcache) *namecache == '\0';
+ if (statbufp == (Stat_t *) &PL_statcache) *namecache == '\0';
statbufp->st_dev = encode_dev(statbufp->st_devnam);
# ifdef RTL_USES_UTC
# ifdef VMSISH_TIME
char fileified[NAM$C_MAXRSS+1];
int retval = -1;
- if (statbufp == (Stat_t *) &statcache)
+ if (statbufp == (Stat_t *) &PL_statcache)
do_tovmsspec(fspec,namecache,0);
if (is_null_device(fspec)) { /* Fake a stat() for the null device */
memset(statbufp,0,sizeof *statbufp);
*/
if (do_fileify_dirspec(fspec,fileified,0) != NULL) {
retval = stat(fileified,(stat_t *) statbufp);
- if (!retval && statbufp == (Stat_t *) &statcache)
+ if (!retval && statbufp == (Stat_t *) &PL_statcache)
strcpy(namecache,fileified);
}
if (retval) retval = stat(fspec,(stat_t *) statbufp);
if (!items || items > 2)
croak("Usage: VMS::Filespec::rmsexpand(spec[,defspec])");
- fspec = SvPV(ST(0),na);
+ fspec = SvPV(ST(0),PL_na);
if (!fspec || !*fspec) XSRETURN_UNDEF;
- if (items == 2) defspec = SvPV(ST(1),na);
+ if (items == 2) defspec = SvPV(ST(1),PL_na);
rslt = do_rmsexpand(fspec,NULL,1,defspec,0);
ST(0) = sv_newmortal();
char *vmsified;
if (items != 1) croak("Usage: VMS::Filespec::vmsify(spec)");
- vmsified = do_tovmsspec(SvPV(ST(0),na),NULL,1);
+ vmsified = do_tovmsspec(SvPV(ST(0),PL_na),NULL,1);
ST(0) = sv_newmortal();
if (vmsified != NULL) sv_usepvn(ST(0),vmsified,strlen(vmsified));
XSRETURN(1);
char *unixified;
if (items != 1) croak("Usage: VMS::Filespec::unixify(spec)");
- unixified = do_tounixspec(SvPV(ST(0),na),NULL,1);
+ unixified = do_tounixspec(SvPV(ST(0),PL_na),NULL,1);
ST(0) = sv_newmortal();
if (unixified != NULL) sv_usepvn(ST(0),unixified,strlen(unixified));
XSRETURN(1);
char *fileified;
if (items != 1) croak("Usage: VMS::Filespec::fileify(spec)");
- fileified = do_fileify_dirspec(SvPV(ST(0),na),NULL,1);
+ fileified = do_fileify_dirspec(SvPV(ST(0),PL_na),NULL,1);
ST(0) = sv_newmortal();
if (fileified != NULL) sv_usepvn(ST(0),fileified,strlen(fileified));
XSRETURN(1);
char *pathified;
if (items != 1) croak("Usage: VMS::Filespec::pathify(spec)");
- pathified = do_pathify_dirspec(SvPV(ST(0),na),NULL,1);
+ pathified = do_pathify_dirspec(SvPV(ST(0),PL_na),NULL,1);
ST(0) = sv_newmortal();
if (pathified != NULL) sv_usepvn(ST(0),pathified,strlen(pathified));
XSRETURN(1);
char *vmspath;
if (items != 1) croak("Usage: VMS::Filespec::vmspath(spec)");
- vmspath = do_tovmspath(SvPV(ST(0),na),NULL,1);
+ vmspath = do_tovmspath(SvPV(ST(0),PL_na),NULL,1);
ST(0) = sv_newmortal();
if (vmspath != NULL) sv_usepvn(ST(0),vmspath,strlen(vmspath));
XSRETURN(1);
char *unixpath;
if (items != 1) croak("Usage: VMS::Filespec::unixpath(spec)");
- unixpath = do_tounixpath(SvPV(ST(0),na),NULL,1);
+ unixpath = do_tounixpath(SvPV(ST(0),PL_na),NULL,1);
ST(0) = sv_newmortal();
if (unixpath != NULL) sv_usepvn(ST(0),unixpath,strlen(unixpath));
XSRETURN(1);
if (SvTYPE(mysv) == SVt_PVGV) {
if (!(io = GvIOp(mysv)) || !fgetname(IoIFP(io),fspec)) {
set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG);
- ST(0) = &sv_no;
+ ST(0) = &PL_sv_no;
XSRETURN(1);
}
fsp = fspec;
}
else {
- if (mysv != ST(0) || !(fsp = SvPV(mysv,na)) || !*fsp) {
+ if (mysv != ST(0) || !(fsp = SvPV(mysv,PL_na)) || !*fsp) {
set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG);
- ST(0) = &sv_no;
+ ST(0) = &PL_sv_no;
XSRETURN(1);
}
}
if (SvTYPE(mysv) == SVt_PVGV) {
if (!(io = GvIOp(mysv)) || !fgetname(IoIFP(io),inspec)) {
set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG);
- ST(0) = &sv_no;
+ ST(0) = &PL_sv_no;
XSRETURN(1);
}
inp = inspec;
}
else {
- if (mysv != ST(0) || !(inp = SvPV(mysv,na)) || !*inp) {
+ if (mysv != ST(0) || !(inp = SvPV(mysv,PL_na)) || !*inp) {
set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG);
- ST(0) = &sv_no;
+ ST(0) = &PL_sv_no;
XSRETURN(1);
}
}
if (SvTYPE(mysv) == SVt_PVGV) {
if (!(io = GvIOp(mysv)) || !fgetname(IoIFP(io),outspec)) {
set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG);
- ST(0) = &sv_no;
+ ST(0) = &PL_sv_no;
XSRETURN(1);
}
outp = outspec;
}
else {
- if (mysv != ST(1) || !(outp = SvPV(mysv,na)) || !*outp) {
+ if (mysv != ST(1) || !(outp = SvPV(mysv,PL_na)) || !*outp) {
set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG);
- ST(0) = &sv_no;
+ ST(0) = &PL_sv_no;
XSRETURN(1);
}
}
#define HINT_M_VMSISH_STATUS 0x01000000 /* system, $? return VMS status */
#define HINT_M_VMSISH_EXIT 0x02000000 /* exit(1) ==> SS$_NORMAL */
#define HINT_M_VMSISH_TIME 0x04000000 /* times are local, not UTC */
-#define NATIVE_HINTS (hints >> HINT_V_VMSISH) /* used in op.c */
+#define NATIVE_HINTS (PL_hints >> HINT_V_VMSISH) /* used in op.c */
-#define TEST_VMSISH(h) (curcop->op_private & ((h) >> HINT_V_VMSISH))
+#define TEST_VMSISH(h) (PL_curcop->op_private & ((h) >> HINT_V_VMSISH))
#define VMSISH_STATUS TEST_VMSISH(HINT_M_VMSISH_STATUS)
#define VMSISH_EXIT TEST_VMSISH(HINT_M_VMSISH_EXIT)
#define VMSISH_TIME TEST_VMSISH(HINT_M_VMSISH_TIME)
}
while (++mark <= sp) {
- if (*mark && (str = SvPV(*mark, na)))
+ if (*mark && (str = SvPV(*mark, PL_na)))
argv[index++] = str;
else
argv[index++] = "";
argv[index++] = 0;
status = win32_spawnvp(flag,
- (const char*)(really ? SvPV(really,na) : argv[0]),
+ (const char*)(really ? SvPV(really,PL_na) : argv[0]),
(const char* const*)argv);
if (status < 0 && errno == ENOEXEC) {
argv[sh_items] = w32_perlshell_vec[sh_items];
status = win32_spawnvp(flag,
- (const char*)(really ? SvPV(really,na) : argv[0]),
+ (const char*)(really ? SvPV(really,PL_na) : argv[0]),
(const char* const*)argv);
}
dXSARGS;
if (items != 1)
croak("usage: Win32::SetCurrentDirectory($cwd)");
- if (SetCurrentDirectory(SvPV(ST(0),na)))
+ if (SetCurrentDirectory(SvPV(ST(0),PL_na)))
XSRETURN_YES;
XSRETURN_NO;
if (items != 3)
croak("usage: Win32::Spawn($cmdName, $args, $PID)");
- cmd = SvPV(ST(0),na);
- args = SvPV(ST(1), na);
+ cmd = SvPV(ST(0),PL_na);
+ args = SvPV(ST(1), PL_na);
memset(&stStartInfo, 0, sizeof(stStartInfo)); /* Clear the block */
stStartInfo.cb = sizeof(stStartInfo); /* Set the structure size */
ST(0) = shortpath;
}
else
- ST(0) = &sv_undef;
+ ST(0) = &PL_sv_undef;
XSRETURN(1);
}
#ifdef USE_DECLSPEC_THREAD
Perl_current_thread = t;
#else
- TlsSetValue(thr_key,t);
+ TlsSetValue(PL_thr_key,t);
#endif
#endif
}
#ifdef USE_DECLSPEC_THREAD
return Perl_current_thread;
#else
- return (struct perl_thread *) TlsGetValue(thr_key);
+ return (struct perl_thread *) TlsGetValue(PL_thr_key);
#endif
#else
return NULL;
#ifdef USE_THREADS
static int key_allocated = 0;
if (!key_allocated) {
- if ((thr_key = TlsAlloc()) == TLS_OUT_OF_INDEXES)
+ if ((PL_thr_key = TlsAlloc()) == TLS_OUT_OF_INDEXES)
croak("panic: TlsAlloc");
key_allocated = 1;
}
projects / p5sagit/p5-mst-13.2.git / commitdiff