diff options
| -rw-r--r-- | doio.c | 15 | ||||
| -rw-r--r-- | embed.h | 4 | ||||
| -rwxr-xr-x | embed.pl | 3 | ||||
| -rw-r--r-- | objXSUB.h | 4 | ||||
| -rw-r--r-- | opcode.h | 4 | ||||
| -rwxr-xr-x | opcode.pl | 12 | ||||
| -rw-r--r-- | opnames.h | 2 | ||||
| -rw-r--r-- | perlapi.c | 7 | ||||
| -rw-r--r-- | pp_proto.h | 2 | ||||
| -rw-r--r-- | pp_sys.c | 39 | ||||
| -rw-r--r-- | proto.h | 1 |
11 files changed, 62 insertions, 31 deletions
@@ -55,8 +55,8 @@ bool Perl_do_open(pTHX_ GV *gv, register char *name, I32 len, int as_raw, int rawmode, int rawperm, PerlIO *supplied_fp) { - return do_open9(gv, name, len, as_raw, rawmode, rawperm, - supplied_fp, Nullsv, 0); + return do_openn(gv, name, len, as_raw, rawmode, rawperm, + supplied_fp, (SV **) NULL, 0); } bool @@ -64,6 +64,15 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw, int rawmode, int rawperm, PerlIO *supplied_fp, SV *svs, I32 num_svs) { + return do_openn(gv, name, len, as_raw, rawmode, rawperm, + supplied_fp, &svs, 1); +} + +bool +Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw, + int rawmode, int rawperm, PerlIO *supplied_fp, SV **svp, + I32 num_svs) +{ register IO *io = GvIOn(gv); PerlIO *saveifp = Nullfp; PerlIO *saveofp = Nullfp; @@ -77,6 +86,7 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw, char *type = NULL; char *deftype = NULL; char mode[4]; /* stdio file mode ("r\0", "rb\0", "r+b\0" etc.) */ + SV *svs = (num_svs) ? *svp : Nullsv; Zero(mode,sizeof(mode),char); PL_forkprocess = 1; /* assume true if no fork */ @@ -529,6 +539,7 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw, if (type) { while (isSPACE(*type)) type++; if (*type) { + errno = 0; if (PerlIO_apply_layers(aTHX_ IoIFP(io),mode,type) != 0) { goto say_false; } @@ -182,6 +182,7 @@ #define do_kv Perl_do_kv #define do_open Perl_do_open #define do_open9 Perl_do_open9 +#define do_openn Perl_do_openn #define do_pipe Perl_do_pipe #define do_print Perl_do_print #define do_readline Perl_do_readline @@ -1664,6 +1665,7 @@ #define do_kv() Perl_do_kv(aTHX) #define do_open(a,b,c,d,e,f,g) Perl_do_open(aTHX_ a,b,c,d,e,f,g) #define do_open9(a,b,c,d,e,f,g,h,i) Perl_do_open9(aTHX_ a,b,c,d,e,f,g,h,i) +#define do_openn(a,b,c,d,e,f,g,h,i) Perl_do_openn(aTHX_ a,b,c,d,e,f,g,h,i) #define do_pipe(a,b,c) Perl_do_pipe(aTHX_ a,b,c) #define do_print(a,b) Perl_do_print(aTHX_ a,b) #define do_readline() Perl_do_readline(aTHX) @@ -3261,6 +3263,8 @@ #define do_open Perl_do_open #define Perl_do_open9 CPerlObj::Perl_do_open9 #define do_open9 Perl_do_open9 +#define Perl_do_openn CPerlObj::Perl_do_openn +#define do_openn Perl_do_openn #define Perl_do_pipe CPerlObj::Perl_do_pipe #define do_pipe Perl_do_pipe #define Perl_do_print CPerlObj::Perl_do_print @@ -1494,6 +1494,9 @@ Ap |bool |do_open |GV* gv|char* name|I32 len|int as_raw \ Ap |bool |do_open9 |GV *gv|char *name|I32 len|int as_raw \ |int rawmode|int rawperm|PerlIO *supplied_fp \ |SV *svs|I32 num +Ap |bool |do_openn |GV *gv|char *name|I32 len|int as_raw \ + |int rawmode|int rawperm|PerlIO *supplied_fp \ + |SV **svp|I32 num p |void |do_pipe |SV* sv|GV* rgv|GV* wgv p |bool |do_print |SV* sv|PerlIO* fp p |OP* |do_readline @@ -325,6 +325,10 @@ #define Perl_do_open9 pPerl->Perl_do_open9 #undef do_open9 #define do_open9 Perl_do_open9 +#undef Perl_do_openn +#define Perl_do_openn pPerl->Perl_do_openn +#undef do_openn +#define do_openn Perl_do_openn #undef Perl_dowantarray #define Perl_dowantarray pPerl->Perl_dowantarray #undef dowantarray @@ -1,4 +1,4 @@ -/* !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +/* !!!!!!! DO NOT EDIT THIS FILE !!!!!!! This file is built by opcode.pl from its data. Any changes made here will be lost! */ @@ -1643,7 +1643,7 @@ EXT U32 PL_opargs[] = { 0x00001a44, /* dump */ 0x00001a44, /* goto */ 0x00013644, /* exit */ - 0x0052c81c, /* open */ + 0x0052c81d, /* open */ 0x0001d614, /* close */ 0x000cc814, /* pipe_op */ 0x0000d61c, /* fileno */ @@ -31,7 +31,7 @@ while (<DATA>) { $i = 0; print <<"END"; -/* !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +/* !!!!!!! DO NOT EDIT THIS FILE !!!!!!! This file is built by opcode.pl from its data. Any changes made here will be lost! */ @@ -44,7 +44,7 @@ print <<"END"; END print ON <<"END"; -/* !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +/* !!!!!!! DO NOT EDIT THIS FILE !!!!!!! This file is built by opcode.pl from its data. Any changes made here will be lost! */ @@ -93,7 +93,7 @@ END for (@ops) { my($safe_desc) = $desc{$_}; - # Have to escape double quotes and escape characters. + # Have to escape double quotes and escape characters. $safe_desc =~ s/(^|[^\\])([\\"])/$1\\$2/g; print qq(\t"$safe_desc",\n); @@ -262,7 +262,7 @@ open PP, '>pp_proto.h' or die "Error creating pp_proto.h: $!"; open PPSYM, '>pp.sym' or die "Error creating pp.sym: $!"; print PP <<"END"; -/* !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +/* !!!!!!! DO NOT EDIT THIS FILE !!!!!!! This file is built by opcode.pl from its data. Any changes made here will be lost! */ @@ -271,7 +271,7 @@ END print PPSYM <<"END"; # -# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! # This file is built by opcode.pl from its data. Any changes made here # will be lost! # @@ -630,7 +630,7 @@ exit exit ck_exit ds% S? # I/O. -open open ck_open ist@ F S? L +open open ck_open ismt@ F S? L close close ck_fun is% F? pipe_op pipe ck_fun is@ F F @@ -1,4 +1,4 @@ -/* !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +/* !!!!!!! DO NOT EDIT THIS FILE !!!!!!! This file is built by opcode.pl from its data. Any changes made here will be lost! */ @@ -656,6 +656,13 @@ Perl_do_open9(pTHXo_ GV *gv, char *name, I32 len, int as_raw, int rawmode, int r return ((CPerlObj*)pPerl)->Perl_do_open9(gv, name, len, as_raw, rawmode, rawperm, supplied_fp, svs, num); } +#undef Perl_do_openn +bool +Perl_do_openn(pTHXo_ GV *gv, char *name, I32 len, int as_raw, int rawmode, int rawperm, PerlIO *supplied_fp, SV **svp, I32 num) +{ + return ((CPerlObj*)pPerl)->Perl_do_openn(gv, name, len, as_raw, rawmode, rawperm, supplied_fp, svp, num); +} + #undef Perl_dowantarray I32 Perl_dowantarray(pTHXo) diff --git a/pp_proto.h b/pp_proto.h index c3b24e864b..d6d626fc89 100644 --- a/pp_proto.h +++ b/pp_proto.h @@ -1,4 +1,4 @@ -/* !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +/* !!!!!!! DO NOT EDIT THIS FILE !!!!!!! This file is built by opcode.pl from its data. Any changes made here will be lost! */ @@ -492,7 +492,9 @@ PP(pp_die) PP(pp_open) { - djSP; dTARGET; + djSP; + dMARK; dORIGMARK; + dTARGET; GV *gv; SV *sv; SV *name = Nullsv; @@ -500,29 +502,19 @@ PP(pp_open) char *tmps; STRLEN len; MAGIC *mg; + bool ok; - if (MAXARG > 2) { - name = POPs; - have_name = 1; - } - if (MAXARG > 1) - sv = POPs; - if (!isGV(TOPs)) - DIE(aTHX_ PL_no_usym, "filehandle"); - if (MAXARG <= 1) - sv = GvSV(TOPs); - gv = (GV*)POPs; + gv = (GV *)*++MARK; if (!isGV(gv)) DIE(aTHX_ PL_no_usym, "filehandle"); if (GvIOp(gv)) IoFLAGS(GvIOp(gv)) &= ~IOf_UNTAINT; if ((mg = SvTIED_mg((SV*)gv, 'q'))) { - PUSHMARK(SP); - XPUSHs(SvTIED_obj((SV*)gv, mg)); - XPUSHs(sv); - if (have_name) - XPUSHs(name); + /* Method's args are same as ours ... */ + /* ... except handle is replaced by the object */ + *MARK-- = SvTIED_obj((SV*)gv, mg); + PUSHMARK(MARK); PUTBACK; ENTER; call_method("OPEN", G_SCALAR); @@ -531,8 +523,17 @@ PP(pp_open) RETURN; } + if (MARK < SP) { + sv = *++MARK; + } + else { + sv = GvSV(gv); + } + tmps = SvPV(sv, len); - if (do_open9(gv, tmps, len, FALSE, O_RDONLY, 0, Nullfp, name, have_name)) + ok = do_openn(gv, tmps, len, FALSE, O_RDONLY, 0, Nullfp, MARK+1, (SP-MARK)); + SP = ORIGMARK; + if (ok) PUSHi( (I32)PL_forkprocess ); else if (PL_forkprocess == 0) /* we are a new child */ PUSHi(0); @@ -3602,7 +3603,7 @@ PP(pp_mkdir) * trailing slashes. To err on the side of portability, we * snip away one trailing slash. */ if (tmps[len-1] == '/') { - tmps = savepvn(tmps, len - 1); + tmps = savepvn(tmps, len - 1); copy = TRUE; } @@ -236,6 +236,7 @@ PERL_CALLCONV void Perl_do_join(pTHX_ SV* sv, SV* del, SV** mark, SV** sp); PERL_CALLCONV OP* Perl_do_kv(pTHX); PERL_CALLCONV bool Perl_do_open(pTHX_ GV* gv, char* name, I32 len, int as_raw, int rawmode, int rawperm, PerlIO* supplied_fp); PERL_CALLCONV bool Perl_do_open9(pTHX_ GV *gv, char *name, I32 len, int as_raw, int rawmode, int rawperm, PerlIO *supplied_fp, SV *svs, I32 num); +PERL_CALLCONV bool Perl_do_openn(pTHX_ GV *gv, char *name, I32 len, int as_raw, int rawmode, int rawperm, PerlIO *supplied_fp, SV **svp, I32 num); PERL_CALLCONV void Perl_do_pipe(pTHX_ SV* sv, GV* rgv, GV* wgv); PERL_CALLCONV bool Perl_do_print(pTHX_ SV* sv, PerlIO* fp); PERL_CALLCONV OP* Perl_do_readline(pTHX); |