static void init_postdump_symbols();
static void init_perllib();
-Interpreter *
+PerlInterpreter *
perl_alloc()
{
- Interpreter *sv_interp;
- Interpreter junk;
+ PerlInterpreter *sv_interp;
+ PerlInterpreter junk;
curinterp = &junk;
- Zero(&junk, 1, Interpreter);
- New(53, sv_interp, 1, Interpreter);
+ Zero(&junk, 1, PerlInterpreter);
+ New(53, sv_interp, 1, PerlInterpreter);
return sv_interp;
}
void
perl_construct( sv_interp )
-register Interpreter *sv_interp;
+register PerlInterpreter *sv_interp;
{
if (!(curinterp = sv_interp))
return;
- Zero(sv_interp, 1, Interpreter);
+ Zero(sv_interp, 1, PerlInterpreter);
/* Init the real globals? */
if (!linestr) {
euid = (int)geteuid();
gid = (int)getgid();
egid = (int)getegid();
- sprintf(patchlevel,"%3.3s%2.2d", index(rcsid,'4'), PATCHLEVEL);
+ sprintf(patchlevel,"%3.3s%2.2d", strchr(rcsid,'4'), PATCHLEVEL);
- (void)sprintf(index(rcsid,'#'), "%d\n", PATCHLEVEL);
+ (void)sprintf(strchr(rcsid,'#'), "%d\n", PATCHLEVEL);
fdpid = newAV(); /* for remembering popen pids by fd */
pidstatus = newHV(COEFFSIZE);/* for remembering status of dead pids */
void
perl_destruct(sv_interp)
-register Interpreter *sv_interp;
+register PerlInterpreter *sv_interp;
{
if (!(curinterp = sv_interp))
return;
if (main_root)
op_free(main_root);
main_root = 0;
- if (last_root)
- op_free(last_root);
- last_root = 0;
#endif
}
void
perl_free(sv_interp)
-Interpreter *sv_interp;
+PerlInterpreter *sv_interp;
{
if (!(curinterp = sv_interp))
return;
int
perl_parse(sv_interp, argc, argv, env)
-Interpreter *sv_interp;
+PerlInterpreter *sv_interp;
register int argc;
register char **argv;
char **env;
if (main_root)
op_free(main_root);
main_root = 0;
- if (last_root)
- op_free(last_root);
- last_root = 0;
origargv = argv;
origargc = argc;
comppad = pad;
av_push(comppad, Nullsv);
curpad = AvARRAY(comppad);
+ padname = newAV();
+ comppadname = padname;
+ comppadnamefill = -1;
padix = 0;
init_stack();
+ init_context_stack();
+
+ userinit(); /* in case linked C routines want magical variables */
+
+ allgvs = TRUE;
+ init_predump_symbols();
+
init_lexer();
/* now parse the script */
(void)UNLINK(e_tmpname);
}
- init_context_stack();
+ /* now that script is parsed, we can modify record separator */
- init_predump_symbols();
+ rs = nrs;
+ rslen = nrslen;
+ rschar = nrschar;
+ rspara = (nrslen == 2);
+ sv_setpvn(GvSV(gv_fetchpv("/", TRUE)), rs, rslen);
if (do_undump)
my_unexec();
int
perl_run(sv_interp)
-Interpreter *sv_interp;
+PerlInterpreter *sv_interp;
{
if (!(curinterp = sv_interp))
return 255;
+ if (beginav)
+ calllist(beginav);
switch (setjmp(top_env)) {
case 1:
cxstack_ix = -1; /* start context stack again */
break;
case 2:
curstash = defstash;
- {
- GV *gv = gv_fetchpv("END", FALSE);
-
- if (gv && GvCV(gv)) {
- if (!setjmp(top_env))
- perl_callback("END", 0, G_SCALAR, 0, 0);
- }
- return(statusvalue); /* my_exit() was called */
- }
+ if (endav)
+ calllist(endav);
+ return(statusvalue); /* my_exit() was called */
case 3:
if (!restartop) {
fprintf(stderr, "panic: restartop\n");
op = main_start;
run();
}
- else
- fatal("panic: perl_run");
my_exit(0);
}
ENTER;
SAVESPTR(op);
stack_base = AvARRAY(stack);
- stack_sp = stack_base + sp - numargs;
+ stack_sp = stack_base + sp - numargs - 1;
op = (OP*)&myop;
pp_pushmark(); /* doesn't look at op, actually, except to return */
- *stack_sp = (SV*)gv_fetchpv(subname, FALSE);
+ *++stack_sp = (SV*)gv_fetchpv(subname, FALSE);
stack_sp += numargs;
myop.op_last = hasargs ? (OP*)&myop : Nullop;
}
void
-magicalize(list)
-register char *list;
-{
- char sym[2];
-
- sym[1] = '\0';
- while (*sym = *list++)
- magicname(sym, sym, 1);
-}
-
-void
magicname(sym,name,namlen)
char *sym;
char *name;
/* (void)av_push(GvAVn(incgv), newSVpv(".", 1)); */
p++;
}
- if ( (s = index(p, PERLLIB_SEP)) != Nullch ) {
+ if ( (s = strchr(p, PERLLIB_SEP)) != Nullch ) {
(void)av_push(GvAVn(incgv), newSVpv(p, (I32)(s - p)));
p = s + 1;
} else {
static char debopts[] = "psltocPmfrxuLHX";
char *d;
- for (s++; *s && (d = index(debopts,*s)); s++)
+ for (s++; *s && (d = strchr(debopts,*s)); s++)
debug |= 1 << (d - debopts);
}
else {
register char *s;
I32 len;
- if (dosearch && !index(scriptname, '/') && (s = getenv("PATH"))) {
+ if (dosearch && !strchr(scriptname, '/') && (s = getenv("PATH"))) {
bufend = s + strlen(s);
while (*s) {
validate_suid(validarg)
char *validarg;
{
+ char *s;
/* do we need to emulate setuid on scripts? */
/* This code is for those BSD systems that have setuid #! scripts disabled
static void
init_predump_symbols()
{
- SV *sv;
- GV* tmpgv;
-
- /* initialize everything that won't change if we undump */
+ GV *tmpgv;
- if (siggv = gv_fetchpv("SIG",allgvs)) {
- HV *hv;
- SvMULTI_on(siggv);
- hv = GvHVn(siggv);
- hv_magic(hv, siggv, 'S');
-
- /* initialize signal stack */
- signalstack = newAV();
- av_store(signalstack, 32, Nullsv);
- av_clear(signalstack);
- AvREAL_off(signalstack);
- }
-
- magicalize("!#?^~=-%.+&*()<>,\\/[|`':\004\t\020\024\027\006");
- userinit(); /* in case linked C routines want magical variables */
-
- ampergv = gv_fetchpv("&",allgvs);
- leftgv = gv_fetchpv("`",allgvs);
- rightgv = gv_fetchpv("'",allgvs);
- sawampersand = (ampergv || leftgv || rightgv);
- if (tmpgv = gv_fetchpv(":",allgvs))
- sv_setpv(GvSV(tmpgv),chopset);
-
- /* these aren't necessarily magical */
- if (tmpgv = gv_fetchpv("\014",allgvs)) {
- sv_setpv(GvSV(tmpgv),"\f");
- formfeed = GvSV(tmpgv);
- }
- if (tmpgv = gv_fetchpv(";",allgvs))
- sv_setpv(GvSV(tmpgv),"\034");
- if (tmpgv = gv_fetchpv("]",allgvs)) {
- sv = GvSV(tmpgv);
- sv_upgrade(sv, SVt_PVNV);
- sv_setpv(sv,rcsid);
- SvNV(sv) = atof(patchlevel);
- SvNOK_on(sv);
- }
sv_setpvn(GvSV(gv_fetchpv("\"", TRUE)), " ", 1);
stdingv = gv_fetchpv("STDIN",TRUE);
curoutgv = defoutgv; /* switch back to STDOUT */
statname = NEWSV(66,0); /* last filename we did stat on */
-
- /* now that script is parsed, we can modify record separator */
-
- rs = nrs;
- rslen = nrslen;
- rschar = nrschar;
- rspara = (nrslen == 2);
- sv_setpvn(GvSV(gv_fetchpv("/", TRUE)), rs, rslen);
}
static void
argc--,argv++;
break;
}
- if (s = index(argv[0], '=')) {
+ if (s = strchr(argv[0], '=')) {
*s++ = '\0';
sv_setpv(GvSV(gv_fetchpv(argv[0]+1,TRUE)),s);
}
if (env != environ)
environ[0] = Nullch;
for (; *env; env++) {
- if (!(s = index(*env,'=')))
+ if (!(s = strchr(*env,'=')))
continue;
*s++ = '\0';
sv = newSVpv(s--,0);
incpush(PRIVLIB);
(void)av_push(GvAVn(incgv),newSVpv(".",1));
}
+
+void
+calllist(list)
+AV* list;
+{
+ I32 i;
+ I32 fill = AvFILL(list);
+ jmp_buf oldtop;
+ I32 sp = stack_sp - stack_base;
+
+ av_store(stack, ++sp, Nullsv); /* reserve spot for 1st return arg */
+ Copy(top_env, oldtop, 1, jmp_buf);
+
+ for (i = 0; i <= fill; i++)
+ {
+ GV *gv = (GV*)av_shift(list);
+ SV* tmpsv = NEWSV(0,0);
+
+ if (gv && GvCV(gv)) {
+ gv_efullname(tmpsv, gv);
+ if (setjmp(top_env)) {
+ if (list == beginav)
+ exit(1);
+ }
+ else {
+ perl_callback(SvPV(tmpsv), sp, G_SCALAR, 0, 0);
+ }
+ }
+ sv_free(tmpsv);
+ sv_free(gv);
+ }
+
+ Copy(oldtop, top_env, 1, jmp_buf);
+}
+
projects / p5sagit/p5-mst-13.2.git / blobdiff