static void init_predump_symbols _((void));
static void init_stacks _((void));
static void open_script _((char *, bool, SV *));
+static void usage _((char *));
static void validate_suid _((char *));
PerlInterpreter *
#endif
init_ids();
+
+#if defined(SUBVERSION) && SUBVERSION > 0
+ sprintf(patchlevel, "%7.5f", 5.0 + (PATCHLEVEL / 1000.0)
+ + (SUBVERSION / 100000.0));
+#else
sprintf(patchlevel, "%5.3f", 5.0 + (PATCHLEVEL / 1000.0));
+#endif
+
+#if defined(LOCAL_PATCH_COUNT)
+ Ilocalpatches = local_patches; /* For possible -v */
+#endif
fdpid = newAV(); /* for remembering popen pids by fd */
pidstatus = newHV();/* for remembering status of dead pids */
#ifndef VMS /* VMS doesn't have environ array */
origenviron = environ;
#endif
+ e_tmpname = Nullch;
if (do_undump) {
op_free(main_root);
main_root = 0;
- switch (setjmp(top_env)) {
+ switch (Sigsetjmp(top_env,1)) {
case 1:
#ifdef VMS
statusvalue = 255;
if (!scriptname)
scriptname = argv[0];
if (e_fp) {
- if (fflush(e_fp) || ferror(e_fp) || fclose(e_fp))
+ if (Fflush(e_fp) || ferror(e_fp) || fclose(e_fp))
croak("Can't write to temp file for -e: %s", Strerror(errno));
+ e_fp = Nullfp;
argc++,argv--;
scriptname = e_tmpname;
}
curcop->cop_line = 0;
curstash = defstash;
preprocess = FALSE;
- if (e_fp) {
- e_fp = Nullfp;
+ if (e_tmpname) {
(void)UNLINK(e_tmpname);
+ Safefree(e_tmpname);
+ e_tmpname = Nullch;
}
/* now that script is parsed, we can modify record separator */
{
if (!(curinterp = sv_interp))
return 255;
- switch (setjmp(top_env)) {
+ switch (Sigsetjmp(top_env,1)) {
case 1:
cxstack_ix = -1; /* start context stack again */
break;
if (restartop) {
op = restartop;
restartop = 0;
- run();
+ runops();
}
else if (main_start) {
op = main_start;
- run();
+ runops();
}
my_exit(0);
POPBLOCK(cx,curpm);
LEAVE;
}
- longjmp(top_env, 2);
+ Siglongjmp(top_env, 2);
}
SV*
SV** sp = stack_sp;
I32 oldmark = TOPMARK;
I32 retval;
- jmp_buf oldtop;
+ Sigjmp_buf oldtop;
I32 oldscope;
if (flags & G_DISCARD) {
myop.op_flags |= OPf_LIST;
if (flags & G_EVAL) {
- Copy(top_env, oldtop, 1, jmp_buf);
+ Copy(top_env, oldtop, 1, Sigjmp_buf);
cLOGOP->op_other = op;
markstack_ptr--;
markstack_ptr++;
restart:
- switch (setjmp(top_env)) {
+ switch (Sigsetjmp(top_env,1)) {
case 0:
break;
case 1:
/* my_exit() was called */
curstash = defstash;
FREETMPS;
- Copy(oldtop, top_env, 1, jmp_buf);
+ Copy(oldtop, top_env, 1, Sigjmp_buf);
if (statusvalue)
croak("Callback called exit");
my_exit(statusvalue);
if (op == (OP*)&myop)
op = pp_entersub();
if (op)
- run();
+ runops();
retval = stack_sp - (stack_base + oldmark);
if ((flags & G_EVAL) && !(flags & G_KEEPERR))
sv_setpv(GvSV(errgv),"");
curpm = newpm;
LEAVE;
}
- Copy(oldtop, top_env, 1, jmp_buf);
+ Copy(oldtop, top_env, 1, Sigjmp_buf);
}
if (flags & G_DISCARD) {
stack_sp = stack_base + oldmark;
SV** sp = stack_sp;
I32 oldmark = sp - stack_base;
I32 retval;
- jmp_buf oldtop;
+ Sigjmp_buf oldtop;
I32 oldscope;
if (flags & G_DISCARD) {
if (flags & G_ARRAY)
myop.op_flags |= OPf_LIST;
- Copy(top_env, oldtop, 1, jmp_buf);
+ Copy(top_env, oldtop, 1, Sigjmp_buf);
restart:
- switch (setjmp(top_env)) {
+ switch (Sigsetjmp(top_env,1)) {
case 0:
break;
case 1:
/* my_exit() was called */
curstash = defstash;
FREETMPS;
- Copy(oldtop, top_env, 1, jmp_buf);
+ Copy(oldtop, top_env, 1, Sigjmp_buf);
if (statusvalue)
croak("Callback called exit");
my_exit(statusvalue);
if (op == (OP*)&myop)
op = pp_entereval();
if (op)
- run();
+ runops();
retval = stack_sp - (stack_base + oldmark);
if ((flags & G_EVAL) && !(flags & G_KEEPERR))
sv_setpv(GvSV(errgv),"");
cleanup:
- Copy(oldtop, top_env, 1, jmp_buf);
+ Copy(oldtop, top_env, 1, Sigjmp_buf);
if (flags & G_DISCARD) {
stack_sp = stack_base + oldmark;
retval = 0;
}
}
-void
+static void
usage(name) /* XXX move this out into a module ? */
char *name;
{
- printf("\nUsage: %s [switches] [filename] [arguments]\n",name);
+ /* This message really ought to be max 23 lines.
+ * Removed -h because the user already knows that opton. Others? */
+ printf("\nUsage: %s [switches] [--] [programfile] [arguments]", name);
printf("\n -0[octal] specify record separator (\\0, if no argument)");
- printf("\n -a autosplit mode with -n or -p");
+ printf("\n -a autosplit mode with -n or -p (splits $_ into @F)");
printf("\n -c check syntax only (runs BEGIN and END blocks)");
printf("\n -d[:debugger] run scripts under debugger");
printf("\n -D[number/list] set debugging flags (argument is a bit mask or flags)");
- printf("\n -e command one line of script, multiple -e options are allowed");
- printf("\n [filename] can be ommitted when -e is used");
- printf("\n -F regexp regular expression for autosplit (-a)");
+ printf("\n -e 'command' one line of script. Several -e's allowed. Omit [programfile].");
+ printf("\n -F/pattern/ split() pattern for autosplit (-a). The //'s are optional.");
printf("\n -i[extension] edit <> files in place (make backup if extension supplied)");
- printf("\n -Idirectory specify include directory (may be used more then once)");
+ printf("\n -Idirectory specify @INC/#include directory (may be used more then once)");
printf("\n -l[octal] enable line ending processing, specifies line teminator");
+ printf("\n -[mM][-]module.. executes `use/no module...' before executing your script.");
printf("\n -n assume 'while (<>) { ... }' loop arround your script");
printf("\n -p assume loop like -n but print line also like sed");
printf("\n -P run script through C preprocessor before compilation");
printf("\n -U allow unsafe operations");
printf("\n -v print version number and patchlevel of perl");
printf("\n -V[:variable] print perl configuration information");
- printf("\n -w turn warnings on for compilation of your script");
+ printf("\n -w TURN WARNINGS ON FOR COMPILATION OF YOUR SCRIPT.");
printf("\n -x[directory] strip off text before #!perl line and perhaps cd to directory\n");
}
case 'm':
taint_not("-m"); /* XXX ? */
if (*++s) {
- char *start = s;
- Sv = newSVpv("use ",4);
+ char *start;
+ char *use = "use ";
+ /* -M-foo == 'no foo' */
+ if (*s == '-') { use = "no "; ++s; }
+ Sv = newSVpv(use,0);
+ start = s;
/* We allow -M'Module qw(Foo Bar)' */
while(isALNUM(*s) || *s==':') ++s;
if (*s != '=') {
}
} else {
sv_catpvn(Sv, start, s-start);
- sv_catpv(Sv, " qw(");
+ sv_catpv(Sv, " split(/,/,q{");
sv_catpv(Sv, ++s);
- sv_catpv(Sv, ")");
+ sv_catpv(Sv, "})");
}
s += strlen(s);
if (preambleav == NULL)
s++;
return s;
case 'v':
- printf("\nThis is perl, version %s gamma",patchlevel);
+#if defined(SUBVERSION) && SUBVERSION > 0
+ printf("\nThis is perl, version 5.%03d_%02d", PATCHLEVEL, SUBVERSION);
+#else
+ printf("\nThis is perl, version %s",patchlevel);
+#endif
#if defined(DEBUGGING) || defined(EMBED) || defined(MULTIPLICITY)
fputs(" with", stdout);
#endif
#endif
+#if defined(LOCAL_PATCH_COUNT)
+ if (LOCAL_PATCH_COUNT > 0)
+ { int i;
+ fputs("\n\tLocally applied patches:\n", stdout);
+ for (i = 1; i <= LOCAL_PATCH_COUNT; i++) {
+ if (Ilocalpatches[i])
+ fprintf(stdout, "\t %s\n", Ilocalpatches[i]);
+ }
+ }
+#endif
+ printf("\n\tbuilt under %s",OSNAME);
+#ifdef __DATE__
+# ifdef __TIME__
+ printf(" at %s %s",__DATE__,__TIME__);
+# else
+ printf(" on %s",__DATE__);
+# endif
+#endif
fputs("\n\nCopyright 1987-1996, Larry Wall\n",stdout);
#ifdef MSDOS
fputs("MS-DOS port Copyright (c) 1989, 1990, Diomidis Spinellis\n",
fprintf(stderr, "unexec of %s into %s failed!\n", tokenbuf, buf);
exit(status);
#else
+# ifdef VMS
+# include <lib$routines.h>
+ lib$signal(SS$_DEBUG); /* ssdef.h #included from vmsish.h */
+#else
ABORT(); /* for use with undump */
#endif
+#endif
}
static void
SvREADONLY_on(gv);
HvNAME(defstash) = savepv("main");
incgv = gv_HVadd(gv_AVadd(gv_fetchpv("INC",TRUE, SVt_PVAV)));
- SvMULTI_on(incgv);
+ GvMULTI_on(incgv);
defgv = gv_fetchpv("_",TRUE, SVt_PVAV);
errgv = gv_HVadd(gv_fetchpv("@", TRUE, SVt_PV));
- SvMULTI_on(errgv);
+ GvMULTI_on(errgv);
curstash = defstash;
compiling.cop_stash = defstash;
debstash = GvHV(gv_fetchpv("DB::", GV_ADDMULTI, SVt_PVHV));
#if defined(DOSISH) && !defined(OS2) && !defined(atarist)
#define SEARCH_EXTS ".bat", ".cmd", NULL
#endif
+#ifdef VMS
+# define SEARCH_EXTS ".pl", ".com", NULL
+#endif
/* additional extensions to try in each dir if scriptname not found */
#ifdef SEARCH_EXTS
char *ext[] = { SEARCH_EXTS };
scriptname = xfound;
}
- origfilename = savepv(e_fp ? "-e" : scriptname);
+ origfilename = savepv(e_tmpname ? "-e" : scriptname);
curcop->cop_filegv = gv_fetchfile(origfilename);
if (strEQ(origfilename,"-"))
scriptname = "";
retstack_ix = 0;
retstack_max = 16;
- New(50,cxstack,129,CONTEXT); /* XXX should fix CXINC macro */
+ cxstack_max = 8192 / sizeof(CONTEXT) - 2; /* Use most of 8K. */
+ New(50,cxstack,cxstack_max + 1,CONTEXT);
cxstack_ix = -1;
- cxstack_max = 128;
New(50,tmps_stack,128,SV*);
tmps_ix = -1;
sv_setpvn(GvSV(gv_fetchpv("\"", TRUE, SVt_PV)), " ", 1);
stdingv = gv_fetchpv("STDIN",TRUE, SVt_PVIO);
- SvMULTI_on(stdingv);
+ GvMULTI_on(stdingv);
IoIFP(GvIOp(stdingv)) = stdin;
tmpgv = gv_fetchpv("stdin",TRUE, SVt_PV);
+ GvMULTI_on(tmpgv);
GvIOp(tmpgv) = (IO*)SvREFCNT_inc(GvIOp(stdingv));
- SvMULTI_on(tmpgv);
tmpgv = gv_fetchpv("STDOUT",TRUE, SVt_PVIO);
- SvMULTI_on(tmpgv);
+ GvMULTI_on(tmpgv);
IoOFP(GvIOp(tmpgv)) = IoIFP(GvIOp(tmpgv)) = stdout;
setdefout(tmpgv);
tmpgv = gv_fetchpv("stdout",TRUE, SVt_PV);
+ GvMULTI_on(tmpgv);
GvIOp(tmpgv) = (IO*)SvREFCNT_inc(GvIOp(defoutgv));
- SvMULTI_on(tmpgv);
othergv = gv_fetchpv("STDERR",TRUE, SVt_PVIO);
- SvMULTI_on(othergv);
+ GvMULTI_on(othergv);
IoOFP(GvIOp(othergv)) = IoIFP(GvIOp(othergv)) = stderr;
tmpgv = gv_fetchpv("stderr",TRUE, SVt_PV);
+ GvMULTI_on(tmpgv);
GvIOp(tmpgv) = (IO*)SvREFCNT_inc(GvIOp(othergv));
- SvMULTI_on(tmpgv);
statname = NEWSV(66,0); /* last filename we did stat on */
+
+ osname = savepv(OSNAME);
}
static void
if (tmpgv = gv_fetchpv("\030",TRUE, SVt_PV))
sv_setpv(GvSV(tmpgv),origargv[0]);
if (argvgv = gv_fetchpv("ARGV",TRUE, SVt_PVAV)) {
- SvMULTI_on(argvgv);
+ GvMULTI_on(argvgv);
(void)gv_AVadd(argvgv);
av_clear(GvAVn(argvgv));
for (; argc > 0; argc--,argv++) {
}
if (envgv = gv_fetchpv("ENV",TRUE, SVt_PVHV)) {
HV *hv;
- SvMULTI_on(envgv);
+ GvMULTI_on(envgv);
hv = GvHVn(envgv);
hv_clear(hv);
#ifndef VMS /* VMS doesn't have environ array */
calllist(list)
AV* list;
{
- jmp_buf oldtop;
+ Sigjmp_buf oldtop;
STRLEN len;
line_t oldline = curcop->cop_line;
- Copy(top_env, oldtop, 1, jmp_buf);
+ Copy(top_env, oldtop, 1, Sigjmp_buf);
while (AvFILL(list) >= 0) {
CV *cv = (CV*)av_shift(list);
SAVEFREESV(cv);
- switch (setjmp(top_env)) {
+ switch (Sigsetjmp(top_env,1)) {
case 0: {
SV* atsv = GvSV(errgv);
PUSHMARK(stack_sp);
perl_call_sv((SV*)cv, G_EVAL|G_DISCARD);
(void)SvPV(atsv, len);
if (len) {
- Copy(oldtop, top_env, 1, jmp_buf);
+ Copy(oldtop, top_env, 1, Sigjmp_buf);
curcop = &compiling;
curcop->cop_line = oldline;
if (list == beginav)
if (endav)
calllist(endav);
FREETMPS;
- Copy(oldtop, top_env, 1, jmp_buf);
+ Copy(oldtop, top_env, 1, Sigjmp_buf);
curcop = &compiling;
curcop->cop_line = oldline;
if (statusvalue) {
FREETMPS;
break;
}
- Copy(oldtop, top_env, 1, jmp_buf);
+ Copy(oldtop, top_env, 1, Sigjmp_buf);
curcop = &compiling;
curcop->cop_line = oldline;
- longjmp(top_env, 3);
+ Siglongjmp(top_env, 3);
}
}
- Copy(oldtop, top_env, 1, jmp_buf);
+ Copy(oldtop, top_env, 1, Sigjmp_buf);
}
projects / p5sagit/p5-mst-13.2.git / blobdiff