X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl.c;h=8f4525e48c994dcdcf26f1a9cf06ac4f8f406469;hb=565764a853a177193a027e73655fad354d57fc10;hp=d5811e0b3569662fd160e439599fd55c7c6cab94;hpb=39e571d41067215a80f26089b260f1418caeb36b;p=p5sagit%2Fp5-mst-13.2.git diff --git a/perl.c b/perl.c index d5811e0..8f4525e 100644 --- a/perl.c +++ b/perl.c @@ -62,6 +62,7 @@ dEXTCONST char rcsid[] = "perl.c\nPatch level: ###\n"; mess_sv = Nullsv; \ } STMT_END +#ifndef PERL_OBJECT static void find_beginning _((void)); static void forbid_setid _((char *)); static void incpush _((char *, int)); @@ -80,15 +81,16 @@ static void nuke_stacks _((void)); static void open_script _((char *, bool, SV *)); static void usage _((char *)); static void validate_suid _((char *, char*)); +#endif static int fdscript = -1; #if defined(DEBUGGING) && defined(USE_THREADS) && defined(__linux__) #include -static void +STATIC void catch_sigsegv(int signo, struct sigcontext_struct sc) { - signal(SIGSEGV, SIG_DFL); + PerlProc_signal(SIGSEGV, SIG_DFL); fprintf(stderr, "Segmentation fault dereferencing 0x%lx\n" "return_address = 0x%lx, eip = 0x%lx\n", sc.cr2, __builtin_return_address(0), sc.eip); @@ -96,6 +98,17 @@ catch_sigsegv(int signo, struct sigcontext_struct sc) } #endif +#ifdef PERL_OBJECT +CPerlObj* perl_alloc(IPerlMem* ipM, IPerlEnv* ipE, IPerlStdIO* ipStd, + IPerlLIO* ipLIO, IPerlDir* ipD, IPerlSock* ipS, IPerlProc* ipP) +{ + CPerlObj* pPerl = new(ipM) CPerlObj(ipM, ipE, ipStd, ipLIO, ipD, ipS, ipP); + if(pPerl != NULL) + pPerl->Init(); + + return pPerl; +} +#else PerlInterpreter * perl_alloc(void) { @@ -105,9 +118,14 @@ perl_alloc(void) New(53, sv_interp, 1, PerlInterpreter); return sv_interp; } +#endif void +#ifdef PERL_OBJECT +CPerlObj::perl_construct(void) +#else perl_construct(register PerlInterpreter *sv_interp) +#endif { #ifdef USE_THREADS int i; @@ -116,8 +134,10 @@ perl_construct(register PerlInterpreter *sv_interp) #endif /* FAKE_THREADS */ #endif /* USE_THREADS */ +#ifndef PERL_OBJECT if (!(curinterp = sv_interp)) return; +#endif #ifdef MULTIPLICITY Zero(sv_interp, 1, PerlInterpreter); @@ -143,7 +163,7 @@ perl_construct(register PerlInterpreter *sv_interp) COND_INIT(&eval_cond); MUTEX_INIT(&threads_mutex); COND_INIT(&nthreads_cond); - + thr = init_main_thread(); #endif /* USE_THREADS */ @@ -165,7 +185,12 @@ perl_construct(register PerlInterpreter *sv_interp) nrs = newSVpv("\n", 1); rs = SvREFCNT_inc(nrs); +#ifdef PERL_OBJECT + /* TODO: */ + /* sighandlerp = sighandler; */ +#else sighandlerp = sighandler; +#endif pidstatus = newHV(); #ifdef MSDOS @@ -224,7 +249,11 @@ perl_construct(register PerlInterpreter *sv_interp) } void +#ifdef PERL_OBJECT +CPerlObj::perl_destruct(void) +#else perl_destruct(register PerlInterpreter *sv_interp) +#endif { dTHR; int destruct_level; /* 0=none, 1=full, 2=full with checks */ @@ -234,8 +263,10 @@ perl_destruct(register PerlInterpreter *sv_interp) Thread t; #endif /* USE_THREADS */ +#ifndef PERL_OBJECT if (!(curinterp = sv_interp)) return; +#endif #ifdef USE_THREADS #ifndef FAKE_THREADS @@ -311,7 +342,7 @@ perl_destruct(register PerlInterpreter *sv_interp) #ifdef DEBUGGING { char *s; - if (s = getenv("PERL_DESTRUCT_LEVEL")) { + if (s = PerlEnv_getenv("PERL_DESTRUCT_LEVEL")) { int i = atoi(s); if (destruct_level < i) destruct_level = i; @@ -551,15 +582,27 @@ perl_destruct(register PerlInterpreter *sv_interp) } void +#ifdef PERL_OBJECT +CPerlObj::perl_free(void) +#else perl_free(PerlInterpreter *sv_interp) +#endif { +#ifdef PERL_OBJECT + Safefree(this); +#else if (!(curinterp = sv_interp)) return; Safefree(sv_interp); +#endif } int +#ifdef PERL_OBJECT +CPerlObj::perl_parse(void (*xsinit) (CPerlObj*), int argc, char **argv, char **env) +#else perl_parse(PerlInterpreter *sv_interp, void (*xsinit) (void), int argc, char **argv, char **env) +#endif { dTHR; register SV *sv; @@ -580,8 +623,10 @@ setuid perl scripts securely.\n"); #endif #endif +#ifndef PERL_OBJECT if (!(curinterp = sv_interp)) return 255; +#endif #if defined(NeXT) && defined(__DYNAMIC__) _dyld_lookup_and_bind @@ -689,7 +734,7 @@ setuid perl scripts securely.\n"); croak("No -e allowed in setuid scripts"); if (!e_fp) { e_tmpname = savepv(TMPPATH); - (void)mktemp(e_tmpname); + (void)PerlLIO_mktemp(e_tmpname); if (!*e_tmpname) croak("Can't mktemp()"); e_fp = PerlIO_open(e_tmpname,"w"); @@ -821,7 +866,7 @@ print \" \\@INC:\\n @INC\\n\";"); } switch_end: - if (!tainting && (s = getenv("PERL5OPT"))) { + if (!tainting && (s = PerlEnv_getenv("PERL5OPT"))) { while (s && *s) { while (isSPACE(*s)) s++; @@ -853,7 +898,7 @@ print \" \\@INC:\\n @INC\\n\";"); } else if (scriptname == Nullch) { #ifdef MSDOS - if ( isatty(PerlIO_fileno(PerlIO_stdin())) ) + if ( PerlLIO_isatty(PerlIO_fileno(PerlIO_stdin())) ) moreswitches("h"); #endif scriptname = "-"; @@ -895,14 +940,17 @@ print \" \\@INC:\\n @INC\\n\";"); CvPADLIST(compcv) = comppadlist; boot_core_UNIVERSAL(); +#if defined(WIN32) && defined(PERL_OBJECT) + BootDynaLoader(); +#endif if (xsinit) - (*xsinit)(); /* in case linked C routines want magical variables */ + (*xsinit)(THIS); /* in case linked C routines want magical variables */ #if defined(VMS) || defined(WIN32) || defined(DJGPP) init_os_extras(); #endif #if defined(DEBUGGING) && defined(USE_THREADS) && defined(__linux__) - DEBUG_L(signal(SIGSEGV, (void(*)(int))catch_sigsegv);); + DEBUG_L(PerlProc_signal(SIGSEGV, (void(*)(int))catch_sigsegv);); #endif init_predump_symbols(); @@ -913,6 +961,7 @@ print \" \\@INC:\\n @INC\\n\";"); /* now parse the script */ + SETERRNO(0,SS$_NORMAL); error_count = 0; if (yyparse() || error_count) { if (minus_c) @@ -949,7 +998,7 @@ print \" \\@INC:\\n @INC\\n\";"); FREETMPS; #ifdef MYMALLOC - if ((s=getenv("PERL_DEBUG_MSTATS")) && atoi(s) >= 2) + if ((s=PerlEnv_getenv("PERL_DEBUG_MSTATS")) && atoi(s) >= 2) dump_mstats("after compilation:"); #endif @@ -960,15 +1009,21 @@ print \" \\@INC:\\n @INC\\n\";"); } int +#ifdef PERL_OBJECT +CPerlObj::perl_run(void) +#else perl_run(PerlInterpreter *sv_interp) +#endif { dTHR; I32 oldscope; dJMPENV; int ret; +#ifndef PERL_OBJECT if (!(curinterp = sv_interp)) return 255; +#endif oldscope = scopestack_ix; @@ -986,7 +1041,7 @@ perl_run(PerlInterpreter *sv_interp) if (endav) call_list(oldscope, endav); #ifdef MYMALLOC - if (getenv("PERL_DEBUG_MSTATS")) + if (PerlEnv_getenv("PERL_DEBUG_MSTATS")) dump_mstats("after execution: "); #endif JMPENV_POP; @@ -1031,12 +1086,12 @@ perl_run(PerlInterpreter *sv_interp) if (restartop) { op = restartop; restartop = 0; - runops(); + CALLRUNOPS(); } else if (main_start) { CvDEPTH(main_cv) = 1; op = main_start; - runops(); + CALLRUNOPS(); } my_exit(0); @@ -1251,7 +1306,7 @@ perl_call_sv(SV *sv, I32 flags) if (op == (OP*)&myop) op = pp_entersub(ARGS); if (op) - runops(); + CALLRUNOPS(); retval = stack_sp - (stack_base + oldmark); if ((flags & G_EVAL) && !(flags & G_KEEPERR)) sv_setpv(ERRSV,""); @@ -1360,7 +1415,7 @@ perl_eval_sv(SV *sv, I32 flags) if (op == (OP*)&myop) op = pp_entereval(ARGS); if (op) - runops(); + CALLRUNOPS(); retval = stack_sp - (stack_base + oldmark); if (!(flags & G_KEEPERR)) sv_setpv(ERRSV,""); @@ -1418,14 +1473,14 @@ magicname(char *sym, char *name, I32 namlen) sv_magic(GvSV(gv), (SV*)gv, 0, name, namlen); } -static void +STATIC void usage(char *name) /* XXX move this out into a module ? */ { /* This message really ought to be max 23 lines. * Removed -h because the user already knows that opton. Others? */ - static char *usage[] = { + static char *usage_msg[] = { "-0[octal] specify record separator (\\0, if no argument)", "-a autosplit mode with -n or -p (splits $_ into @F)", "-c check syntax only (runs BEGIN and END blocks)", @@ -1452,7 +1507,7 @@ usage(char *name) /* XXX move this out into a module ? */ "\n", NULL }; - char **p = usage; + char **p = usage_msg; printf("\nUsage: %s [switches] [--] [programfile] [arguments]", name); while (*p) @@ -1531,7 +1586,7 @@ moreswitches(char *s) return s; case 'h': usage(origargv[0]); - exit(0); + PerlProc_exit(0); case 'i': if (inplace) Safefree(inplace); @@ -1673,7 +1728,7 @@ moreswitches(char *s) printf("\n\ Perl may be copied only under the terms of either the Artistic License or the\n\ GNU General Public License, which may be found in the Perl 5.0 source kit.\n\n"); - exit(0); + PerlProc_exit(0); case 'w': dowarn = TRUE; s++; @@ -1727,7 +1782,7 @@ my_unexec(void) if (status) PerlIO_printf(PerlIO_stderr(), "unexec of %s into %s failed!\n", SvPVX(prog), SvPVX(file)); - exit(status); + PerlProc_exit(status); #else # ifdef VMS # include @@ -1738,7 +1793,7 @@ my_unexec(void) #endif } -static void +STATIC void init_main_stash(void) { dTHR; @@ -1776,10 +1831,10 @@ init_main_stash(void) } #ifdef CAN_PROTOTYPE -static void +STATIC void open_script(char *scriptname, bool dosearch, SV *sv) #else -static void +STATIC void open_script(scriptname,dosearch,sv) char *scriptname; bool dosearch; @@ -1823,7 +1878,7 @@ SV *sv; * * Assuming SEARCH_EXTS is C<".foo",".bar",NULL>, PATH search * proceeds as follows: - * If DOSISH: + * If DOSISH or VMSISH: * + look for ./scriptname{,.foo,.bar} * + search the PATH for scriptname{,.foo,.bar} * @@ -1833,11 +1888,20 @@ SV *sv; */ #ifdef VMS +# ifdef ALWAYS_DEFTYPES + len = strlen(scriptname); + if (!(len == 1 && *scriptname == '-') && scriptname[len-1] != ':') { + int hasdir, idx = 0, deftypes = 1; + bool seen_dot = 1; + + hasdir = !dosearch || (strpbrk(scriptname,":[= 0) { + if (PerlLIO_stat(cur,&statbuf) >= 0) { dosearch = 0; scriptname = cur; #ifdef SEARCH_EXTS @@ -1893,7 +1957,7 @@ SV *sv; #ifdef DOSISH && !strchr(scriptname, '\\') #endif - && (s = getenv("PATH"))) { + && (s = PerlEnv_getenv("PATH"))) { bool seen_dot = 0; bufend = s + strlen(s); @@ -1937,7 +2001,7 @@ SV *sv; do { #endif DEBUG_p(PerlIO_printf(Perl_debug_log, "Looking for %s\n",tokenbuf)); - retval = Stat(tokenbuf,&statbuf); + retval = PerlLIO_stat(tokenbuf,&statbuf); #ifdef SEARCH_EXTS } while ( retval < 0 /* not there */ && extidx>=0 && ext[extidx] /* try an extension? */ @@ -1960,7 +2024,7 @@ SV *sv; xfailed = savepv(tokenbuf); } #ifndef DOSISH - if (!xfound && !seen_dot && !xfailed && (Stat(scriptname,&statbuf) < 0)) + if (!xfound && !seen_dot && !xfailed && (PerlLIO_stat(scriptname,&statbuf) < 0)) #endif seen_dot = 1; /* Disable message. */ if (!xfound) @@ -2056,15 +2120,15 @@ sed %s -e \"/^[^#]/b\" \ #ifdef HAS_SETRESUID (void)setresuid((Uid_t)-1, uid, (Uid_t)-1); #else - setuid(uid); + PerlProc_setuid(uid); #endif #endif #endif - if (geteuid() != uid) + if (PerlProc_geteuid() != uid) croak("Can't do seteuid!\n"); } #endif /* IAMSUID */ - rsfp = my_popen(SvPVX(cmd), "r"); + rsfp = PerlProc_popen(SvPVX(cmd), "r"); SvREFCNT_dec(cmd); SvREFCNT_dec(cpp); } @@ -2085,10 +2149,10 @@ sed %s -e \"/^[^#]/b\" \ if (!rsfp) { #ifdef DOSUID #ifndef IAMSUID /* in case script is not readable before setuid */ - if (euid && Stat(SvPVX(GvSV(curcop->cop_filegv)),&statbuf) >= 0 && + if (euid && PerlLIO_stat(SvPVX(GvSV(curcop->cop_filegv)),&statbuf) >= 0 && statbuf.st_mode & (S_ISUID|S_ISGID)) { /* try again */ - execv(form("%s/sperl%s", BIN_EXP, patchlevel), origargv); + PerlProc_execv(form("%s/sperl%s", BIN_EXP, patchlevel), origargv); croak("Can't do setuid\n"); } #endif @@ -2098,7 +2162,7 @@ sed %s -e \"/^[^#]/b\" \ } } -static void +STATIC void validate_suid(char *validarg, char *scriptname) { int which; @@ -2127,7 +2191,7 @@ validate_suid(char *validarg, char *scriptname) dTHR; char *s, *s2; - if (Fstat(PerlIO_fileno(rsfp),&statbuf) < 0) /* normal stat is insecure */ + if (PerlLIO_fstat(PerlIO_fileno(rsfp),&statbuf) < 0) /* normal stat is insecure */ croak("Can't stat script \"%s\"",origfilename); if (fdscript < 0 && statbuf.st_mode & (S_ISUID|S_ISGID)) { I32 len; @@ -2142,7 +2206,7 @@ validate_suid(char *validarg, char *scriptname) * But I don't think it's too important. The manual lies when * it says access() is useful in setuid programs. */ - if (access(SvPVX(GvSV(curcop->cop_filegv)),1)) /*double check*/ + if (PerlLIO_access(SvPVX(GvSV(curcop->cop_filegv)),1)) /*double check*/ croak("Permission denied"); #else /* If we can swap euid and uid, then we can determine access rights @@ -2161,14 +2225,14 @@ validate_suid(char *validarg, char *scriptname) setresuid(euid,uid,(Uid_t)-1) < 0 # endif #endif - || getuid() != euid || geteuid() != uid) + || PerlProc_getuid() != euid || PerlProc_geteuid() != uid) croak("Can't swap uid and euid"); /* really paranoid */ - if (Stat(SvPVX(GvSV(curcop->cop_filegv)),&tmpstatbuf) < 0) + if (PerlLIO_stat(SvPVX(GvSV(curcop->cop_filegv)),&tmpstatbuf) < 0) croak("Permission denied"); /* testing full pathname here */ if (tmpstatbuf.st_dev != statbuf.st_dev || tmpstatbuf.st_ino != statbuf.st_ino) { (void)PerlIO_close(rsfp); - if (rsfp = my_popen("/bin/mail root","w")) { /* heh, heh */ + if (rsfp = PerlProc_popen("/bin/mail root","w")) { /* heh, heh */ PerlIO_printf(rsfp, "User %ld tried to run dev %ld ino %ld in place of dev %ld ino %ld!\n\ (Filename of set-id script was %s, uid %ld gid %ld.)\n\nSincerely,\nperl\n", @@ -2176,7 +2240,7 @@ validate_suid(char *validarg, char *scriptname) (long)statbuf.st_dev, (long)statbuf.st_ino, SvPVX(GvSV(curcop->cop_filegv)), (long)statbuf.st_uid, (long)statbuf.st_gid); - (void)my_pclose(rsfp); + (void)PerlProc_pclose(rsfp); } croak("Permission denied\n"); } @@ -2188,7 +2252,7 @@ validate_suid(char *validarg, char *scriptname) setresuid(uid,euid,(Uid_t)-1) < 0 # endif #endif - || getuid() != uid || geteuid() != euid) + || PerlProc_getuid() != uid || PerlProc_geteuid() != euid) croak("Can't reswap uid and euid"); if (!cando(S_IXUSR,FALSE,&statbuf)) /* can real uid exec? */ croak("Permission denied\n"); @@ -2235,7 +2299,7 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n"); (void)PerlIO_close(rsfp); #ifndef IAMSUID /* try again */ - execv(form("%s/sperl%s", BIN_EXP, patchlevel), origargv); + PerlProc_execv(form("%s/sperl%s", BIN_EXP, patchlevel), origargv); #endif croak("Can't do setuid\n"); } @@ -2250,11 +2314,11 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n"); #ifdef HAS_SETRESGID (void)setresgid((Gid_t)-1,statbuf.st_gid,(Gid_t)-1); #else - setgid(statbuf.st_gid); + PerlProc_setgid(statbuf.st_gid); #endif #endif #endif - if (getegid() != statbuf.st_gid) + if (PerlProc_getegid() != statbuf.st_gid) croak("Can't do setegid!\n"); } if (statbuf.st_mode & S_ISUID) { @@ -2268,11 +2332,11 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n"); #ifdef HAS_SETRESUID (void)setresuid((Uid_t)-1,statbuf.st_uid,(Uid_t)-1); #else - setuid(statbuf.st_uid); + PerlProc_setuid(statbuf.st_uid); #endif #endif #endif - if (geteuid() != statbuf.st_uid) + if (PerlProc_geteuid() != statbuf.st_uid) croak("Can't do seteuid!\n"); } else if (uid) { /* oops, mustn't run as root */ @@ -2285,11 +2349,11 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n"); #ifdef HAS_SETRESUID (void)setresuid((Uid_t)-1,(Uid_t)uid,(Uid_t)-1); #else - setuid((Uid_t)uid); + PerlProc_setuid((Uid_t)uid); #endif #endif #endif - if (geteuid() != uid) + if (PerlProc_geteuid() != uid) croak("Can't do seteuid!\n"); } init_ids(); @@ -2308,7 +2372,7 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n"); /* exec the real perl, substituting fd script for scriptname. */ /* (We pass script name as "subdir" of fd, which perl will grok.) */ PerlIO_rewind(rsfp); - lseek(PerlIO_fileno(rsfp),(Off_t)0,0); /* just in case rewind didn't */ + PerlLIO_lseek(PerlIO_fileno(rsfp),(Off_t)0,0); /* just in case rewind didn't */ for (which = 1; origargv[which] && origargv[which] != scriptname; which++) ; if (!origargv[which]) croak("Permission denied"); @@ -2317,14 +2381,14 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n"); #if defined(HAS_FCNTL) && defined(F_SETFD) fcntl(PerlIO_fileno(rsfp),F_SETFD,0); /* ensure no close-on-exec */ #endif - execv(form("%s/perl%s", BIN_EXP, patchlevel), origargv); /* try again */ + PerlProc_execv(form("%s/perl%s", BIN_EXP, patchlevel), origargv); /* try again */ croak("Can't do setuid\n"); #endif /* IAMSUID */ #else /* !DOSUID */ if (euid != uid || egid != gid) { /* (suidperl doesn't exist, in fact) */ #ifndef SETUID_SCRIPTS_ARE_SECURE_NOW dTHR; - Fstat(PerlIO_fileno(rsfp),&statbuf); /* may be either wrapped or real suid */ + PerlLIO_fstat(PerlIO_fileno(rsfp),&statbuf); /* may be either wrapped or real suid */ if ((euid != uid && euid == statbuf.st_uid && statbuf.st_mode & S_ISUID) || (egid != gid && egid == statbuf.st_gid && statbuf.st_mode & S_ISGID) @@ -2338,7 +2402,7 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n"); #endif /* DOSUID */ } -static void +STATIC void find_beginning(void) { register char *s, *s2; @@ -2361,19 +2425,19 @@ find_beginning(void) /*SUPPRESS 530*/ while (s = moreswitches(s)) ; } - if (cddir && chdir(cddir) < 0) + if (cddir && PerlDir_chdir(cddir) < 0) croak("Can't chdir to %s",cddir); } } } -static void +STATIC void init_ids(void) { - uid = (int)getuid(); - euid = (int)geteuid(); - gid = (int)getgid(); - egid = (int)getegid(); + uid = (int)PerlProc_getuid(); + euid = (int)PerlProc_geteuid(); + gid = (int)PerlProc_getgid(); + egid = (int)PerlProc_getegid(); #ifdef VMS uid |= gid << 16; euid |= egid << 16; @@ -2381,7 +2445,7 @@ init_ids(void) tainting |= (uid && (euid != uid || egid != gid)); } -static void +STATIC void forbid_setid(char *s) { if (euid != uid) @@ -2390,7 +2454,7 @@ forbid_setid(char *s) croak("No %s allowed while running setgid", s); } -static void +STATIC void init_debugger(void) { dTHR; @@ -2468,7 +2532,7 @@ init_stacks(ARGSproto) } } -static void +STATIC void nuke_stacks(void) { dTHR; @@ -2480,11 +2544,16 @@ nuke_stacks(void) } ) } +#ifndef PERL_OBJECT static PerlIO *tmpfp; /* moved outside init_lexer() because of UNICOS bug */ +#endif -static void +STATIC void init_lexer(void) { +#ifdef PERL_OBJECT + PerlIO *tmpfp; +#endif tmpfp = rsfp; rsfp = Nullfp; lex_start(linestr); @@ -2492,7 +2561,7 @@ init_lexer(void) subname = newSVpv("main",4); } -static void +STATIC void init_predump_symbols(void) { dTHR; @@ -2533,7 +2602,7 @@ init_predump_symbols(void) osname = savepv(OSNAME); } -static void +STATIC void init_postdump_symbols(register int argc, register char **argv, register char **env) { dTHR; @@ -2608,7 +2677,7 @@ init_postdump_symbols(register int argc, register char **argv, register char **e *s = '='; #if defined(__BORLANDC__) && defined(USE_WIN32_RTL_ENV) /* Sins of the RTL. See note in my_setenv(). */ - (void)putenv(savepv(*env)); + (void)PerlEnv_putenv(savepv(*env)); #endif } #endif @@ -2621,17 +2690,17 @@ init_postdump_symbols(register int argc, register char **argv, register char **e sv_setiv(GvSV(tmpgv), (IV)getpid()); } -static void +STATIC void init_perllib(void) { char *s; if (!tainting) { #ifndef VMS - s = getenv("PERL5LIB"); + s = PerlEnv_getenv("PERL5LIB"); if (s) incpush(s, TRUE); else - incpush(getenv("PERLLIB"), FALSE); + incpush(PerlEnv_getenv("PERLLIB"), FALSE); #else /* VMS */ /* Treat PERL5?LIB as a possible search list logical name -- the * "natural" VMS idiom for a Unix path string. We allow each @@ -2688,7 +2757,7 @@ init_perllib(void) # define PERLLIB_MANGLE(s,n) (s) #endif -static void +STATIC void incpush(char *p, int addsubdirs) { SV *subdir = Nullsv; @@ -2757,7 +2826,7 @@ incpush(char *p, int addsubdirs) /* .../archname/version if -d .../archname/version/auto */ sv_setsv(subdir, libdir); sv_catpv(subdir, archpat_auto); - if (Stat(SvPVX(subdir), &tmpstatbuf) >= 0 && + if (PerlLIO_stat(SvPVX(subdir), &tmpstatbuf) >= 0 && S_ISDIR(tmpstatbuf.st_mode)) av_push(GvAVn(incgv), newSVpv(SvPVX(subdir), SvCUR(subdir) - sizeof "auto")); @@ -2765,7 +2834,7 @@ incpush(char *p, int addsubdirs) /* .../archname if -d .../archname/auto */ sv_insert(subdir, SvCUR(libdir) + sizeof(ARCHNAME), strlen(patchlevel) + 1, "", 0); - if (Stat(SvPVX(subdir), &tmpstatbuf) >= 0 && + if (PerlLIO_stat(SvPVX(subdir), &tmpstatbuf) >= 0 && S_ISDIR(tmpstatbuf.st_mode)) av_push(GvAVn(incgv), newSVpv(SvPVX(subdir), SvCUR(subdir) - sizeof "auto")); @@ -2779,7 +2848,7 @@ incpush(char *p, int addsubdirs) } #ifdef USE_THREADS -static struct perl_thread * +STATIC struct perl_thread * init_main_thread() { struct perl_thread *thr; @@ -2842,7 +2911,7 @@ init_main_thread() #endif /* USE_THREADS */ void -call_list(I32 oldscope, AV *list) +call_list(I32 oldscope, AV *paramList) { dTHR; line_t oldline = curcop->cop_line; @@ -2850,8 +2919,8 @@ call_list(I32 oldscope, AV *list) dJMPENV; int ret; - while (AvFILL(list) >= 0) { - CV *cv = (CV*)av_shift(list); + while (AvFILL(paramList) >= 0) { + CV *cv = (CV*)av_shift(paramList); SAVEFREESV(cv); @@ -2866,7 +2935,7 @@ call_list(I32 oldscope, AV *list) JMPENV_POP; curcop = &compiling; curcop->cop_line = oldline; - if (list == beginav) + if (paramList == beginav) sv_catpv(atsv, "BEGIN failed--compilation aborted"); else sv_catpv(atsv, "END failed--cleanup aborted"); @@ -2891,7 +2960,7 @@ call_list(I32 oldscope, AV *list) curcop = &compiling; curcop->cop_line = oldline; if (statusvalue) { - if (list == beginav) + if (paramList == beginav) croak("BEGIN failed--compilation aborted"); else croak("END failed--cleanup aborted"); @@ -2959,7 +3028,7 @@ my_failure_exit(void) my_exit_jump(); } -static void +STATIC void my_exit_jump(void) { dTHR;