From: Larry Wall Date: Fri, 18 Mar 1994 00:00:00 +0000 (+0000) Subject: perl 5.0 alpha 6 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=8990e3071044a96302560bbdb5706f3e74cf1bef;p=p5sagit%2Fp5-mst-13.2.git perl 5.0 alpha 6 [editor's note: cleaned up from the September '94 InfoMagic CD, just like the last commit] --- diff --git a/.package b/.package new file mode 100644 index 0000000..a084d4f --- /dev/null +++ b/.package @@ -0,0 +1,16 @@ +: basic variables +package=perl +baserev=4.1 +patchbranch=1 +mydiff='diff -c' +maintname='Larry Wall' +maintloc='lwall@netlabs.com' +ftpsite='' +orgname='NetLabs, Inc.' +newsgroups='comp.lang.perl' +recipients='' +ftpdir='' + +: derivative variables--do not change +revbranch="$baserev.$patchbranch" +packver='1' diff --git a/Bugs/amiga b/Bugs/amiga new file mode 100644 index 0000000..fdf9101 --- /dev/null +++ b/Bugs/amiga @@ -0,0 +1,142 @@ +Article 38050 of comp.sys.amiga.programmer: +Newsgroups: comp.sys.amiga.programmer +Path: netlabs!news.cerf.net!usc!howland.reston.ans.net!pipex!uunet!majipoor.cygnus.com!fnf +From: fnf@cygnus.com (Fred Fish) +Subject: Re: FreshFish-dec93 CD; broken perl thereon +Message-ID: +Organization: Cygnus Support, Mountain View, CA +References: <1994Jan20.095600.8371@philips.oz.au> +Date: Fri, 28 Jan 1994 06:48:29 GMT +Lines: 129 + +In article , +Bruce Albrecht wrote: +>In article <1994Jan20.095600.8371@philips.oz.au> gduncan@philips.oz.au (Gary Duncan) writes: +>Me too. I don't have the December Fresh Fish, so I can't comment on it, +>but I have been wondering what it will take to do a fresh port of it anyway. + +The diffs that I applied to the base FSF distribution are: + +diff -rc perl-4.036-fsf/Configure perl-4.036-amiga/Configure +*** perl-4.036-fsf/Configure Mon Feb 8 20:37:48 1993 +--- perl-4.036-amiga/Configure Mon Sep 27 21:46:16 1993 +*************** +*** 4023,4029 **** + eval $ans;; + esac + chmod +x doSH +! ./doSH + + if $contains '^depend:' [Mm]akefile >/dev/null 2>&1; then + dflt=n +--- 4023,4029 ---- + eval $ans;; + esac + chmod +x doSH +! sh doSH + + if $contains '^depend:' [Mm]akefile >/dev/null 2>&1; then + dflt=n +diff -rc perl-4.036-fsf/Makefile.SH perl-4.036-amiga/Makefile.SH +*** perl-4.036-fsf/Makefile.SH Mon Feb 8 20:35:21 1993 +--- perl-4.036-amiga/Makefile.SH Tue Sep 28 07:16:24 1993 +*************** +*** 349,355 **** + + test: perl + - cd t && chmod +x TEST */*.t +! - cd t && (rm -f perl; $(SLN) ../perl perl) && ./perl TEST .clist +--- 349,355 ---- + + test: perl + - cd t && chmod +x TEST */*.t +! - cd t && (rm -f perl; $(SLN) ../perl perl) && ./perl TEST + + clist: + echo $(c) | tr ' ' '\012' >.clist +*************** +*** 373,376 **** + ln Makefile ../Makefile + ;; + esac +! rm -f makefile +--- 373,377 ---- + ln Makefile ../Makefile + ;; + esac +! #rm -f makefile (AmigaDOS is case-independent) +! +diff -rc perl-4.036-fsf/makedepend.SH perl-4.036-amiga/makedepend.SH +*** perl-4.036-fsf/makedepend.SH Mon Feb 8 20:36:27 1993 +--- perl-4.036-amiga/makedepend.SH Mon Sep 27 22:06:33 1993 +*************** +*** 63,71 **** + $cat /dev/null >.deptmp + $rm -f *.c.c c/*.c.c + if test -f Makefile; then +! cp Makefile makefile + fi +! mf=makefile + if test -f $mf; then + defrule=`<$mf sed -n \ + -e '/^\.c\.o:.*;/{' \ +--- 63,71 ---- + $cat /dev/null >.deptmp + $rm -f *.c.c c/*.c.c + if test -f Makefile; then +! cp Makefile Makefile.bak + fi +! mf=Makefile + if test -f $mf; then + defrule=`<$mf sed -n \ + -e '/^\.c\.o:.*;/{' \ +diff -rc perl-4.036-fsf/perl.h perl-4.036-amiga/perl.h +*** perl-4.036-fsf/perl.h Mon Feb 8 20:36:01 1993 +--- perl-4.036-amiga/perl.h Mon Sep 27 22:06:19 1993 +*************** +*** 79,85 **** +--- 79,87 ---- + */ + #define HAS_ALARM + #define HAS_CHOWN ++ #ifndef amigados + #define HAS_CHROOT ++ #endif + #define HAS_FORK + #define HAS_GETLOGIN + #define HAS_GETPPID +*************** +*** 93,99 **** +--- 95,103 ---- + * password and group functions in general. All Unix systems do. + */ + #define HAS_GROUP ++ #ifndef amigados + #define HAS_PASSWD ++ #endif + + #endif /* !MSDOS */ + +diff -rc perl-4.036-fsf/x2p/Makefile.SH perl-4.036-amiga/x2p/Makefile.SH +*** perl-4.036-fsf/x2p/Makefile.SH Mon Feb 8 20:36:33 1993 +--- perl-4.036-amiga/x2p/Makefile.SH Mon Sep 27 22:07:15 1993 +*************** +*** 157,160 **** + ln Makefile ../Makefile + ;; + esac +! rm -f makefile +--- 157,160 ---- + ln Makefile ../Makefile + ;; + esac +! #rm -f makefile + + + + + + diff --git a/Bugs/delocalglob b/Bugs/delocalglob new file mode 100755 index 0000000..0a97695 --- /dev/null +++ b/Bugs/delocalglob @@ -0,0 +1,8 @@ +#!./perl +$foo = GOOD; +{ + local(*foo) = \$bar; + $bar = BAR; + print $foo; +} +print $foo; diff --git a/Bugs/f2p_prune b/Bugs/f2p_prune new file mode 100644 index 0000000..519003d --- /dev/null +++ b/Bugs/f2p_prune @@ -0,0 +1,37 @@ +Article 18849 of comp.lang.perl: +Path: netlabs!news.cerf.net!usc!howland.reston.ans.net!xlink.net!zib-berlin.de!zrz.TU-Berlin.DE!w204zrz!koen1830 +From: koen1830@w204zrz.zrz.tu-berlin.de (Andreas Koenig) +Newsgroups: comp.lang.perl +Subject: Bug in find2perl +Date: 14 Feb 1994 09:43:16 GMT +Organization: mal franz, mal anna +Lines: 22 +Message-ID: <2jnh3k$hcv@brachio.zrz.TU-Berlin.DE> +Reply-To: k@franz.ww.TU-Berlin.DE +NNTP-Posting-Host: w204zrz.zrz.tu-berlin.de +Cc: + +Hi all, + +I've encountered a bug in find2perl when used with the -prune Option. +As there have been some bugreports recently, *and* also because there +has to be fixed an incompatibility with perl5, I don't try to offer a +fix, sorry. The bug comes and goes like this (verified for SUN and +NeXT): + +%/usr/bin/find foo -print +foo +foo/bar +foo/bar/baz +%/usr/bin/find foo -prune -print +foo +%perl /usr/local/bin/find2perl foo -prune -print | perl +foo +foo/bar +%perl5a5 /usr/local/bin/find2perl foo -prune -print | perl5a5 +Final $ should be \$ or $name at /usr/local/bin/find2perl line 553, at end of string +syntax error at /usr/local/bin/find2perl line 553, near ""^$tmp$"" +Execution of /usr/local/bin/find2perl aborted due to compilation errors. + + + diff --git a/Bugs/mislex b/Bugs/mislex deleted file mode 100644 index 07d972b..0000000 --- a/Bugs/mislex +++ /dev/null @@ -1 +0,0 @@ -print( STDOUT "hello\n" ) diff --git a/Bugs/pagdir b/Bugs/pagdir deleted file mode 100755 index 7cc76f2..0000000 --- a/Bugs/pagdir +++ /dev/null @@ -1,24 +0,0 @@ -Article 433 of comp.os.386bsd.apps: -Path: netlabs!news.cerf.net!usc!howland.reston.ans.net!spool.mu.edu!bloom-beacon.mit.edu!ai-lab!life.ai.mit.edu!mycroft -From: mycroft@trinity.gnu.ai.mit.edu (Charles Hannum) -Newsgroups: comp.os.386bsd.apps -Subject: Re: Perl-4.036? -Date: 06 Sep 1993 19:01:10 GMT -Organization: MIT Artificial Intelligence Lab -Lines: 9 -Message-ID: -References: <26fptu$1q1@terminator.rs.itd.umich.edu> <26fve4$ivf@homer.cs.mcgill.ca> -NNTP-Posting-Host: trinity.gnu.ai.mit.edu -In-reply-to: storm@cs.mcgill.ca's message of 6 Sep 1993 18:27:16 GMT - - - Perl 4.036 comipled without a single hitch under NetBSD 0.9 last - week. It failed the db test, but I suspect that is due to the new - db stuff under NetBSD and the like... - -Yes. The perl test seems to expect the database to be put in -`foo.pag' and `foo.dir', which isn't the case any more. I suspect -lwall will fix this soon. - - - diff --git a/Bugs/shiftref b/Bugs/shiftref deleted file mode 100755 index e4ab0c5..0000000 --- a/Bugs/shiftref +++ /dev/null @@ -1 +0,0 @@ -shift->[0] diff --git a/Changes b/Changes index 4dbcd46..70e9e2b 100644 --- a/Changes +++ b/Changes @@ -60,6 +60,32 @@ New things New functions include: abs(), chr(), uc(), ucfirst(), lc(), lcfirst() + require with a bare word now does an immediate require at compile time. + So "require POSIX" is equivalent to "BEGIN { require 'POSIX.pm' }". + + require with a number checks to see that the version of Perl that is + currently running is at least that number. + + Dynamic loading of external modules is now supported. + + There is a new quote form qw//, which is equivalent to split(' ', q//). + + Assignment of a reference to a glob value now just replaces the + single element of the glob corresponding to the reference type: + *foo = \$bar, *foo = \&bletch; + + Filehandle methods are now supported: + output_autoflush STDOUT 1; + + There is now an "English" module that provides human readable translations + for cryptic variable names. + + Autoload stubs can now call the replacement subroutine with goto &realsub. + + Subroutines can be defined lazily in any package by declaring an AUTOLOAD + routine, which will be called if a non-existent subroutine is called in + that package. + Incompatibilities ----------------- @ now always interpolates an array in double-quotish strings. Some programs @@ -99,4 +125,9 @@ Incompatibilities Symbols starting with _ are no longer forced into package main, except for $_ itself (and @_, etc.). - Double-quoted strings may no longer end with an unescaped $. + Double-quoted strings may no longer end with an unescaped $ or @. + + Negative array subscripts now count from the end of the array. + + The comma operator in a scalar context is now guaranteed to give a + scalar context to its arguments. diff --git a/NDBM_File.c b/NDBM_File.c index 3040534..5f29958 100644 --- a/NDBM_File.c +++ b/NDBM_File.c @@ -8,12 +8,12 @@ typedef DBM* NDBM_File; #define nextkey(db,key) dbm_nextkey(db) static int -XS_NDBM_File_dbm_new(ix, sp, items) +XS_NDBM_File_dbm_new(ix, ax, items) register int ix; -register int sp; +register int ax; register int items; { - if (items < 4 || items > 4) { + if (items != 4) { croak("Usage: NDBM_File::new(dbtype, filename, flags, mode)"); } { @@ -24,40 +24,40 @@ register int items; NDBM_File RETVAL; RETVAL = dbm_new(dbtype, filename, flags, mode); - ST(0) = sv_mortalcopy(&sv_undef); + ST(0) = sv_newmortal(); sv_setptrobj(ST(0), RETVAL, "NDBM_File"); } - return sp; + return ax; } static int -XS_NDBM_File_dbm_DESTROY(ix, sp, items) +XS_NDBM_File_dbm_DESTROY(ix, ax, items) register int ix; -register int sp; +register int ax; register int items; { - if (items < 1 || items > 1) { + if (items != 1) { croak("Usage: NDBM_File::DESTROY(db)"); } { NDBM_File db; - if (sv_isa(ST(1), "NDBM_File")) - db = (NDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1))); + if (SvROK(ST(1))) + db = (NDBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1))); else - croak("db is not of type NDBM_File"); + croak("db is not a reference"); dbm_close(db); } - return sp; + return ax; } static int -XS_NDBM_File_dbm_fetch(ix, sp, items) +XS_NDBM_File_dbm_fetch(ix, ax, items) register int ix; -register int sp; +register int ax; register int items; { - if (items < 2 || items > 2) { + if (items != 2) { croak("Usage: NDBM_File::fetch(db, key)"); } { @@ -66,23 +66,23 @@ register int items; datum RETVAL; if (sv_isa(ST(1), "NDBM_File")) - db = (NDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1))); + db = (NDBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1))); else croak("db is not of type NDBM_File"); key.dptr = SvPV(ST(2), key.dsize);; RETVAL = dbm_fetch(db, key); - ST(0) = sv_mortalcopy(&sv_undef); + ST(0) = sv_newmortal(); sv_setpvn(ST(0), RETVAL.dptr, RETVAL.dsize); } - return sp; + return ax; } static int -XS_NDBM_File_dbm_store(ix, sp, items) +XS_NDBM_File_dbm_store(ix, ax, items) register int ix; -register int sp; +register int ax; register int items; { if (items < 3 || items > 4) { @@ -96,7 +96,7 @@ register int items; int RETVAL; if (sv_isa(ST(1), "NDBM_File")) - db = (NDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1))); + db = (NDBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1))); else croak("db is not of type NDBM_File"); @@ -111,19 +111,19 @@ register int items; } RETVAL = dbm_store(db, key, value, flags); - ST(0) = sv_mortalcopy(&sv_undef); + ST(0) = sv_newmortal(); sv_setiv(ST(0), (I32)RETVAL); } - return sp; + return ax; } static int -XS_NDBM_File_dbm_delete(ix, sp, items) +XS_NDBM_File_dbm_delete(ix, ax, items) register int ix; -register int sp; +register int ax; register int items; { - if (items < 2 || items > 2) { + if (items != 2) { croak("Usage: NDBM_File::delete(db, key)"); } { @@ -132,26 +132,26 @@ register int items; int RETVAL; if (sv_isa(ST(1), "NDBM_File")) - db = (NDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1))); + db = (NDBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1))); else croak("db is not of type NDBM_File"); key.dptr = SvPV(ST(2), key.dsize);; RETVAL = dbm_delete(db, key); - ST(0) = sv_mortalcopy(&sv_undef); + ST(0) = sv_newmortal(); sv_setiv(ST(0), (I32)RETVAL); } - return sp; + return ax; } static int -XS_NDBM_File_dbm_firstkey(ix, sp, items) +XS_NDBM_File_dbm_firstkey(ix, ax, items) register int ix; -register int sp; +register int ax; register int items; { - if (items < 1 || items > 1) { + if (items != 1) { croak("Usage: NDBM_File::firstkey(db)"); } { @@ -159,24 +159,24 @@ register int items; datum RETVAL; if (sv_isa(ST(1), "NDBM_File")) - db = (NDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1))); + db = (NDBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1))); else croak("db is not of type NDBM_File"); RETVAL = dbm_firstkey(db); - ST(0) = sv_mortalcopy(&sv_undef); + ST(0) = sv_newmortal(); sv_setpvn(ST(0), RETVAL.dptr, RETVAL.dsize); } - return sp; + return ax; } static int -XS_NDBM_File_nextkey(ix, sp, items) +XS_NDBM_File_nextkey(ix, ax, items) register int ix; -register int sp; +register int ax; register int items; { - if (items < 2 || items > 2) { + if (items != 2) { croak("Usage: NDBM_File::nextkey(db, key)"); } { @@ -185,26 +185,26 @@ register int items; datum RETVAL; if (sv_isa(ST(1), "NDBM_File")) - db = (NDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1))); + db = (NDBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1))); else croak("db is not of type NDBM_File"); key.dptr = SvPV(ST(2), key.dsize);; RETVAL = nextkey(db, key); - ST(0) = sv_mortalcopy(&sv_undef); + ST(0) = sv_newmortal(); sv_setpvn(ST(0), RETVAL.dptr, RETVAL.dsize); } - return sp; + return ax; } static int -XS_NDBM_File_dbm_error(ix, sp, items) +XS_NDBM_File_dbm_error(ix, ax, items) register int ix; -register int sp; +register int ax; register int items; { - if (items < 1 || items > 1) { + if (items != 1) { croak("Usage: NDBM_File::error(db)"); } { @@ -212,24 +212,24 @@ register int items; int RETVAL; if (sv_isa(ST(1), "NDBM_File")) - db = (NDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1))); + db = (NDBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1))); else croak("db is not of type NDBM_File"); RETVAL = dbm_error(db); - ST(0) = sv_mortalcopy(&sv_undef); + ST(0) = sv_newmortal(); sv_setiv(ST(0), (I32)RETVAL); } - return sp; + return ax; } static int -XS_NDBM_File_dbm_clearerr(ix, sp, items) +XS_NDBM_File_dbm_clearerr(ix, ax, items) register int ix; -register int sp; +register int ax; register int items; { - if (items < 1 || items > 1) { + if (items != 1) { croak("Usage: NDBM_File::clearerr(db)"); } { @@ -237,20 +237,20 @@ register int items; int RETVAL; if (sv_isa(ST(1), "NDBM_File")) - db = (NDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1))); + db = (NDBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1))); else croak("db is not of type NDBM_File"); RETVAL = dbm_clearerr(db); - ST(0) = sv_mortalcopy(&sv_undef); + ST(0) = sv_newmortal(); sv_setiv(ST(0), (I32)RETVAL); } - return sp; + return ax; } -int init_NDBM_File(ix,sp,items) +int boot_NDBM_File(ix,ax,items) int ix; -int sp; +int ax; int items; { char* file = __FILE__; diff --git a/ODBM_File.c b/ODBM_File.c index 7c5f780..27e5dee 100644 --- a/ODBM_File.c +++ b/ODBM_File.c @@ -22,12 +22,12 @@ static int dbmrefcnt; #define DBM_REPLACE 0 static int -XS_ODBM_File_odbm_new(ix, sp, items) +XS_ODBM_File_odbm_new(ix, ax, items) register int ix; -register int sp; +register int ax; register int items; { - if (items < 4 || items > 4) { + if (items != 4) { croak("Usage: ODBM_File::new(dbtype, filename, flags, mode)"); } { @@ -57,38 +57,38 @@ register int items; sv_setptrobj(ST(0), RETVAL, "ODBM_File"); } } - return sp; + return ax; } static int -XS_ODBM_File_DESTROY(ix, sp, items) +XS_ODBM_File_DESTROY(ix, ax, items) register int ix; -register int sp; +register int ax; register int items; { - if (items < 1 || items > 1) { + if (items != 1) { croak("Usage: ODBM_File::DESTROY(db)"); } { ODBM_File db; - if (sv_isa(ST(1), "ODBM_File")) - db = (ODBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1))); + if (SvROK(ST(1))) + db = (ODBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1))); else - croak("db is not of type ODBM_File"); + croak("db is not a reference"); dbmrefcnt--; dbmclose(); } - return sp; + return ax; } static int -XS_ODBM_File_odbm_fetch(ix, sp, items) +XS_ODBM_File_odbm_fetch(ix, ax, items) register int ix; -register int sp; +register int ax; register int items; { - if (items < 2 || items > 2) { + if (items != 2) { croak("Usage: ODBM_File::fetch(db, key)"); } { @@ -97,23 +97,23 @@ register int items; datum RETVAL; if (sv_isa(ST(1), "ODBM_File")) - db = (ODBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1))); + db = (ODBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1))); else croak("db is not of type ODBM_File"); key.dptr = SvPV(ST(2), key.dsize);; RETVAL = odbm_fetch(db, key); - ST(0) = sv_mortalcopy(&sv_undef); + ST(0) = sv_newmortal(); sv_setpvn(ST(0), RETVAL.dptr, RETVAL.dsize); } - return sp; + return ax; } static int -XS_ODBM_File_odbm_store(ix, sp, items) +XS_ODBM_File_odbm_store(ix, ax, items) register int ix; -register int sp; +register int ax; register int items; { if (items < 3 || items > 4) { @@ -127,7 +127,7 @@ register int items; int RETVAL; if (sv_isa(ST(1), "ODBM_File")) - db = (ODBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1))); + db = (ODBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1))); else croak("db is not of type ODBM_File"); @@ -142,19 +142,19 @@ register int items; } RETVAL = odbm_store(db, key, value, flags); - ST(0) = sv_mortalcopy(&sv_undef); + ST(0) = sv_newmortal(); sv_setiv(ST(0), (I32)RETVAL); } - return sp; + return ax; } static int -XS_ODBM_File_odbm_delete(ix, sp, items) +XS_ODBM_File_odbm_delete(ix, ax, items) register int ix; -register int sp; +register int ax; register int items; { - if (items < 2 || items > 2) { + if (items != 2) { croak("Usage: ODBM_File::delete(db, key)"); } { @@ -163,26 +163,26 @@ register int items; int RETVAL; if (sv_isa(ST(1), "ODBM_File")) - db = (ODBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1))); + db = (ODBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1))); else croak("db is not of type ODBM_File"); key.dptr = SvPV(ST(2), key.dsize);; RETVAL = odbm_delete(db, key); - ST(0) = sv_mortalcopy(&sv_undef); + ST(0) = sv_newmortal(); sv_setiv(ST(0), (I32)RETVAL); } - return sp; + return ax; } static int -XS_ODBM_File_odbm_firstkey(ix, sp, items) +XS_ODBM_File_odbm_firstkey(ix, ax, items) register int ix; -register int sp; +register int ax; register int items; { - if (items < 1 || items > 1) { + if (items != 1) { croak("Usage: ODBM_File::firstkey(db)"); } { @@ -190,24 +190,24 @@ register int items; datum RETVAL; if (sv_isa(ST(1), "ODBM_File")) - db = (ODBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1))); + db = (ODBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1))); else croak("db is not of type ODBM_File"); RETVAL = odbm_firstkey(db); - ST(0) = sv_mortalcopy(&sv_undef); + ST(0) = sv_newmortal(); sv_setpvn(ST(0), RETVAL.dptr, RETVAL.dsize); } - return sp; + return ax; } static int -XS_ODBM_File_odbm_nextkey(ix, sp, items) +XS_ODBM_File_odbm_nextkey(ix, ax, items) register int ix; -register int sp; +register int ax; register int items; { - if (items < 2 || items > 2) { + if (items != 2) { croak("Usage: ODBM_File::nextkey(db, key)"); } { @@ -216,22 +216,22 @@ register int items; datum RETVAL; if (sv_isa(ST(1), "ODBM_File")) - db = (ODBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1))); + db = (ODBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1))); else croak("db is not of type ODBM_File"); key.dptr = SvPV(ST(2), key.dsize);; RETVAL = odbm_nextkey(db, key); - ST(0) = sv_mortalcopy(&sv_undef); + ST(0) = sv_newmortal(); sv_setpvn(ST(0), RETVAL.dptr, RETVAL.dsize); } - return sp; + return ax; } -int init_ODBM_File(ix,sp,items) +int boot_ODBM_File(ix,ax,items) int ix; -int sp; +int ax; int items; { char* file = __FILE__; diff --git a/POSIX.c b/POSIX.c new file mode 100644 index 0000000..cf3ada3 --- /dev/null +++ b/POSIX.c @@ -0,0 +1,856 @@ +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" +#include + +#define HAS_UNAME + +#ifndef HAS_GETPGRP +#define getpgrp(a,b) not_here("getpgrp") +#endif +#ifndef HAS_NICE +#define nice(a) not_here("nice") +#endif +#ifndef HAS_READLINK +#define readlink(a,b,c) not_here("readlink") +#endif +#ifndef HAS_SETPGID +#define setpgid(a,b) not_here("setpgid") +#endif +#ifndef HAS_SETPGRP +#define setpgrp(a,b) not_here("setpgrp") +#endif +#ifndef HAS_SETSID +#define setsid() not_here("setsid") +#endif +#ifndef HAS_SYMLINK +#define symlink(a,b) not_here("symlink") +#endif +#ifndef HAS_TCGETPGRP +#define tcgetpgrp(a) not_here("tcgetpgrp") +#endif +#ifndef HAS_TCSETPGRP +#define tcsetpgrp(a,b) not_here("tcsetpgrp") +#endif +#ifndef HAS_TIMES +#define times(a) not_here("times") +#endif +#ifndef HAS_UNAME +#define uname(a) not_here("uname") +#endif +#ifndef HAS_WAITPID +#define waitpid(a,b,c) not_here("waitpid") +#endif + +static int +not_here(s) +char *s; +{ + croak("POSIX::%s not implemented on this architecture", s); + return -1; +} + +static int +XS_POSIX__exit(ix, ax, items) +register int ix; +register int ax; +register int items; +{ + if (items != 1) { + croak("Usage: POSIX::_exit(status)"); + } + { + int status = (int)SvIV(ST(1)); + + _exit(status); + } + return ax; +} + +static int +XS_POSIX_chdir(ix, ax, items) +register int ix; +register int ax; +register int items; +{ + if (items != 1) { + croak("Usage: POSIX::chdir(path)"); + } + { + char * path = SvPV(ST(1),na); + int RETVAL; + + RETVAL = chdir(path); + ST(0) = sv_newmortal(); + sv_setiv(ST(0), (I32)RETVAL); + } + return ax; +} + +static int +XS_POSIX_chmod(ix, ax, items) +register int ix; +register int ax; +register int items; +{ + if (items != 2) { + croak("Usage: POSIX::chmod(path, mode)"); + } + { + char * path = SvPV(ST(1),na); + mode_t mode = (int)SvIV(ST(2)); + int RETVAL; + + RETVAL = chmod(path, mode); + ST(0) = sv_newmortal(); + sv_setiv(ST(0), (I32)RETVAL); + } + return ax; +} + +static int +XS_POSIX_close(ix, ax, items) +register int ix; +register int ax; +register int items; +{ + if (items != 1) { + croak("Usage: POSIX::close(fd)"); + } + { + int fd = (int)SvIV(ST(1)); + int RETVAL; + + RETVAL = close(fd); + ST(0) = sv_newmortal(); + sv_setiv(ST(0), (I32)RETVAL); + } + return ax; +} + +static int +XS_POSIX_dup(ix, ax, items) +register int ix; +register int ax; +register int items; +{ + if (items != 1) { + croak("Usage: POSIX::dup(fd)"); + } + { + int fd = (int)SvIV(ST(1)); + int RETVAL; + + RETVAL = dup(fd); + ST(0) = sv_newmortal(); + sv_setiv(ST(0), (I32)RETVAL); + } + return ax; +} + +static int +XS_POSIX_dup2(ix, ax, items) +register int ix; +register int ax; +register int items; +{ + if (items != 2) { + croak("Usage: POSIX::dup2(fd1, fd2)"); + } + { + int fd1 = (int)SvIV(ST(1)); + int fd2 = (int)SvIV(ST(2)); + int RETVAL; + + RETVAL = dup2(fd1, fd2); + ST(0) = sv_newmortal(); + sv_setiv(ST(0), (I32)RETVAL); + } + return ax; +} + +static int +XS_POSIX_fdopen(ix, ax, items) +register int ix; +register int ax; +register int items; +{ + if (items != 2) { + croak("Usage: POSIX::fdopen(fd, type)"); + } + { + int fd = (int)SvIV(ST(1)); + char * type = SvPV(ST(2),na); + FILE * RETVAL; + + RETVAL = fdopen(fd, type); + ST(0) = sv_newmortal(); + sv_setnv(ST(0), (double)(unsigned long)RETVAL); + } + return ax; +} + +static int +XS_POSIX_fstat(ix, ax, items) +register int ix; +register int ax; +register int items; +{ + if (items != 2) { + croak("Usage: POSIX::fstat(fd, buf)"); + } + { + int fd = (int)SvIV(ST(1)); + struct stat * buf = (struct stat*)sv_grow(ST(2),sizeof(struct stat)); + int RETVAL; + + RETVAL = fstat(fd, buf); + ST(0) = sv_newmortal(); + sv_setiv(ST(0), (I32)RETVAL); + SvCUR(ST(2)) = sizeof(struct stat); + } + return ax; +} + +static int +XS_POSIX_getpgrp(ix, ax, items) +register int ix; +register int ax; +register int items; +{ + if (items != 1) { + croak("Usage: POSIX::getpgrp(pid)"); + } + { + int pid = (int)SvIV(ST(1)); + int RETVAL; + + RETVAL = getpgrp(pid); + ST(0) = sv_newmortal(); + sv_setiv(ST(0), (I32)RETVAL); + } + return ax; +} + +static int +XS_POSIX_link(ix, ax, items) +register int ix; +register int ax; +register int items; +{ + if (items != 0) { + croak("Usage: POSIX::link()"); + } + { + int RETVAL; + + RETVAL = link(); + ST(0) = sv_newmortal(); + sv_setiv(ST(0), (I32)RETVAL); + } + return ax; +} + +static int +XS_POSIX_lseek(ix, ax, items) +register int ix; +register int ax; +register int items; +{ + if (items != 0) { + croak("Usage: POSIX::lseek()"); + } + { + int RETVAL; + + RETVAL = lseek(); + ST(0) = sv_newmortal(); + sv_setiv(ST(0), (I32)RETVAL); + } + return ax; +} + +static int +XS_POSIX_lstat(ix, ax, items) +register int ix; +register int ax; +register int items; +{ + if (items != 0) { + croak("Usage: POSIX::lstat()"); + } + { + int RETVAL; + + RETVAL = lstat(); + ST(0) = sv_newmortal(); + sv_setiv(ST(0), (I32)RETVAL); + } + return ax; +} + +static int +XS_POSIX_mkdir(ix, ax, items) +register int ix; +register int ax; +register int items; +{ + if (items != 0) { + croak("Usage: POSIX::mkdir()"); + } + { + int RETVAL; + + RETVAL = mkdir(); + ST(0) = sv_newmortal(); + sv_setiv(ST(0), (I32)RETVAL); + } + return ax; +} + +static int +XS_POSIX_nice(ix, ax, items) +register int ix; +register int ax; +register int items; +{ + if (items != 1) { + croak("Usage: POSIX::nice(incr)"); + } + { + int incr = (int)SvIV(ST(1)); + int RETVAL; + + RETVAL = nice(incr); + ST(0) = sv_newmortal(); + sv_setiv(ST(0), (I32)RETVAL); + } + return ax; +} + +static int +XS_POSIX_open(ix, ax, items) +register int ix; +register int ax; +register int items; +{ + if (items != 0) { + croak("Usage: POSIX::open()"); + } + { + int RETVAL; + + RETVAL = open(); + ST(0) = sv_newmortal(); + sv_setiv(ST(0), (I32)RETVAL); + } + return ax; +} + +static int +XS_POSIX_pipe(ix, ax, items) +register int ix; +register int ax; +register int items; +{ + if (items != 0) { + croak("Usage: POSIX::pipe()"); + } + { + int RETVAL; + + RETVAL = pipe(); + ST(0) = sv_newmortal(); + sv_setiv(ST(0), (I32)RETVAL); + } + return ax; +} + +static int +XS_POSIX_read(ix, ax, items) +register int ix; +register int ax; +register int items; +{ + if (items != 0) { + croak("Usage: POSIX::read()"); + } + { + int RETVAL; + + RETVAL = read(); + ST(0) = sv_newmortal(); + sv_setiv(ST(0), (I32)RETVAL); + } + return ax; +} + +static int +XS_POSIX_readlink(ix, ax, items) +register int ix; +register int ax; +register int items; +{ + if (items != 3) { + croak("Usage: POSIX::readlink(path, buf, bufsiz)"); + } + { + char * path = SvPV(ST(1),na); + char * buf = sv_grow(ST(2), SvIV(ST(3))); + int bufsiz = (int)SvIV(ST(3)); + int RETVAL; + + RETVAL = readlink(path, buf, bufsiz); + ST(0) = sv_newmortal(); + sv_setiv(ST(0), (I32)RETVAL); + } + return ax; +} + +static int +XS_POSIX_rename(ix, ax, items) +register int ix; +register int ax; +register int items; +{ + if (items != 0) { + croak("Usage: POSIX::rename()"); + } + { + int RETVAL; + + RETVAL = rename(); + ST(0) = sv_newmortal(); + sv_setiv(ST(0), (I32)RETVAL); + } + return ax; +} + +static int +XS_POSIX_rmdir(ix, ax, items) +register int ix; +register int ax; +register int items; +{ + if (items != 0) { + croak("Usage: POSIX::rmdir()"); + } + { + int RETVAL; + + RETVAL = rmdir(); + ST(0) = sv_newmortal(); + sv_setiv(ST(0), (I32)RETVAL); + } + return ax; +} + +static int +XS_POSIX_setgid(ix, ax, items) +register int ix; +register int ax; +register int items; +{ + if (items != 0) { + croak("Usage: POSIX::setgid()"); + } + { + int RETVAL; + + RETVAL = setgid(); + ST(0) = sv_newmortal(); + sv_setiv(ST(0), (I32)RETVAL); + } + return ax; +} + +static int +XS_POSIX_setpgid(ix, ax, items) +register int ix; +register int ax; +register int items; +{ + if (items != 2) { + croak("Usage: POSIX::setpgid(pid, pgid)"); + } + { + pid_t pid = (int)SvIV(ST(1)); + pid_t pgid = (int)SvIV(ST(2)); + int RETVAL; + + RETVAL = setpgid(pid, pgid); + ST(0) = sv_newmortal(); + sv_setiv(ST(0), (I32)RETVAL); + } + return ax; +} + +static int +XS_POSIX_setpgrp(ix, ax, items) +register int ix; +register int ax; +register int items; +{ + if (items != 2) { + croak("Usage: POSIX::setpgrp(pid, pgrp)"); + } + { + int pid = (int)SvIV(ST(1)); + int pgrp = (int)SvIV(ST(2)); + int RETVAL; + + RETVAL = setpgrp(pid, pgrp); + ST(0) = sv_newmortal(); + sv_setiv(ST(0), (I32)RETVAL); + } + return ax; +} + +static int +XS_POSIX_setsid(ix, ax, items) +register int ix; +register int ax; +register int items; +{ + if (items != 0) { + croak("Usage: POSIX::setsid()"); + } + { + pid_t RETVAL; + + RETVAL = setsid(); + ST(0) = sv_newmortal(); + sv_setiv(ST(0), (I32)RETVAL); + } + return ax; +} + +static int +XS_POSIX_setuid(ix, ax, items) +register int ix; +register int ax; +register int items; +{ + if (items != 0) { + croak("Usage: POSIX::setuid()"); + } + { + int RETVAL; + + RETVAL = setuid(); + ST(0) = sv_newmortal(); + sv_setiv(ST(0), (I32)RETVAL); + } + return ax; +} + +static int +XS_POSIX_stat(ix, ax, items) +register int ix; +register int ax; +register int items; +{ + if (items != 0) { + croak("Usage: POSIX::stat()"); + } + { + int RETVAL; + + RETVAL = stat(); + ST(0) = sv_newmortal(); + sv_setiv(ST(0), (I32)RETVAL); + } + return ax; +} + +static int +XS_POSIX_symlink(ix, ax, items) +register int ix; +register int ax; +register int items; +{ + if (items != 0) { + croak("Usage: POSIX::symlink()"); + } + { + int RETVAL; + + RETVAL = symlink(); + ST(0) = sv_newmortal(); + sv_setiv(ST(0), (I32)RETVAL); + } + return ax; +} + +static int +XS_POSIX_system(ix, ax, items) +register int ix; +register int ax; +register int items; +{ + if (items != 0) { + croak("Usage: POSIX::system()"); + } + { + int RETVAL; + + RETVAL = system(); + ST(0) = sv_newmortal(); + sv_setiv(ST(0), (I32)RETVAL); + } + return ax; +} + +static int +XS_POSIX_tcgetpgrp(ix, ax, items) +register int ix; +register int ax; +register int items; +{ + if (items != 1) { + croak("Usage: POSIX::tcgetpgrp(fd)"); + } + { + int fd = (int)SvIV(ST(1)); + pid_t RETVAL; + + RETVAL = tcgetpgrp(fd); + ST(0) = sv_newmortal(); + sv_setiv(ST(0), (I32)RETVAL); + } + return ax; +} + +static int +XS_POSIX_tcsetpgrp(ix, ax, items) +register int ix; +register int ax; +register int items; +{ + if (items != 2) { + croak("Usage: POSIX::tcsetpgrp(fd, pgrp_id)"); + } + { + int fd = (int)SvIV(ST(1)); + pid_t pgrp_id = (int)SvIV(ST(2)); + int RETVAL; + + RETVAL = tcsetpgrp(fd, pgrp_id); + ST(0) = sv_newmortal(); + sv_setiv(ST(0), (I32)RETVAL); + } + return ax; +} + +static int +XS_POSIX_times(ix, ax, items) +register int ix; +register int ax; +register int items; +{ + if (items != 1) { + croak("Usage: POSIX::times(tms)"); + } + { + struct tms * tms = (struct tms*)sv_grow(ST(1), sizeof(struct tms)); + int RETVAL; + + RETVAL = times(tms); + ST(0) = sv_newmortal(); + sv_setiv(ST(0), (I32)RETVAL); + SvCUR(ST(1)) = sizeof(struct tms); + } + return ax; +} + +static int +XS_POSIX_umask(ix, ax, items) +register int ix; +register int ax; +register int items; +{ + if (items != 0) { + croak("Usage: POSIX::umask()"); + } + { + int RETVAL; + + RETVAL = umask(); + ST(0) = sv_newmortal(); + sv_setiv(ST(0), (I32)RETVAL); + } + return ax; +} + +static int +XS_POSIX_uname(ix, ax, items) +register int ix; +register int ax; +register int items; +{ + if (items != 0) { + croak("Usage: POSIX::uname()"); + } + { + int RETVAL; + dSP; + struct utsname utsname; + sp--; + if (uname(&utsname) >= 0) { + EXTEND(sp, 5); + PUSHs(sv_2mortal(newSVpv(utsname.sysname, 0))); + PUSHs(sv_2mortal(newSVpv(utsname.nodename, 0))); + PUSHs(sv_2mortal(newSVpv(utsname.release, 0))); + PUSHs(sv_2mortal(newSVpv(utsname.version, 0))); + PUSHs(sv_2mortal(newSVpv(utsname.machine, 0))); + } + return sp - stack_base; + } + return ax; +} + +static int +XS_POSIX_unlink(ix, ax, items) +register int ix; +register int ax; +register int items; +{ + if (items != 0) { + croak("Usage: POSIX::unlink()"); + } + { + int RETVAL; + + RETVAL = unlink(); + ST(0) = sv_newmortal(); + sv_setiv(ST(0), (I32)RETVAL); + } + return ax; +} + +static int +XS_POSIX_utime(ix, ax, items) +register int ix; +register int ax; +register int items; +{ + if (items != 0) { + croak("Usage: POSIX::utime()"); + } + { + int RETVAL; + + RETVAL = utime(); + ST(0) = sv_newmortal(); + sv_setiv(ST(0), (I32)RETVAL); + } + return ax; +} + +static int +XS_POSIX_wait(ix, ax, items) +register int ix; +register int ax; +register int items; +{ + if (items != 0) { + croak("Usage: POSIX::wait()"); + } + { + int RETVAL; + + RETVAL = wait(); + ST(0) = sv_newmortal(); + sv_setiv(ST(0), (I32)RETVAL); + } + return ax; +} + +static int +XS_POSIX_waitpid(ix, ax, items) +register int ix; +register int ax; +register int items; +{ + if (items != 3) { + croak("Usage: POSIX::waitpid(pid, statusp, options)"); + } + { + int pid = (int)SvIV(ST(1)); + int statusp = (int)SvIV(ST(2)); + int options = (int)SvIV(ST(3)); + int RETVAL; + + RETVAL = waitpid(pid, &statusp, options); + ST(0) = sv_newmortal(); + sv_setiv(ST(0), (I32)RETVAL); + sv_setiv(ST(2), (I32)statusp); + } + return ax; +} + +static int +XS_POSIX_write(ix, ax, items) +register int ix; +register int ax; +register int items; +{ + if (items != 0) { + croak("Usage: POSIX::write()"); + } + { + int RETVAL; + + RETVAL = write(); + ST(0) = sv_newmortal(); + sv_setiv(ST(0), (I32)RETVAL); + } + return ax; +} + +int boot_POSIX(ix,ax,items) +int ix; +int ax; +int items; +{ + char* file = __FILE__; + + newXSUB("POSIX::_exit", 0, XS_POSIX__exit, file); + newXSUB("POSIX::chdir", 0, XS_POSIX_chdir, file); + newXSUB("POSIX::chmod", 0, XS_POSIX_chmod, file); + newXSUB("POSIX::close", 0, XS_POSIX_close, file); + newXSUB("POSIX::dup", 0, XS_POSIX_dup, file); + newXSUB("POSIX::dup2", 0, XS_POSIX_dup2, file); + newXSUB("POSIX::fdopen", 0, XS_POSIX_fdopen, file); + newXSUB("POSIX::fstat", 0, XS_POSIX_fstat, file); + newXSUB("POSIX::getpgrp", 0, XS_POSIX_getpgrp, file); + newXSUB("POSIX::link", 0, XS_POSIX_link, file); + newXSUB("POSIX::lseek", 0, XS_POSIX_lseek, file); + newXSUB("POSIX::lstat", 0, XS_POSIX_lstat, file); + newXSUB("POSIX::mkdir", 0, XS_POSIX_mkdir, file); + newXSUB("POSIX::nice", 0, XS_POSIX_nice, file); + newXSUB("POSIX::open", 0, XS_POSIX_open, file); + newXSUB("POSIX::pipe", 0, XS_POSIX_pipe, file); + newXSUB("POSIX::read", 0, XS_POSIX_read, file); + newXSUB("POSIX::readlink", 0, XS_POSIX_readlink, file); + newXSUB("POSIX::rename", 0, XS_POSIX_rename, file); + newXSUB("POSIX::rmdir", 0, XS_POSIX_rmdir, file); + newXSUB("POSIX::setgid", 0, XS_POSIX_setgid, file); + newXSUB("POSIX::setpgid", 0, XS_POSIX_setpgid, file); + newXSUB("POSIX::setpgrp", 0, XS_POSIX_setpgrp, file); + newXSUB("POSIX::setsid", 0, XS_POSIX_setsid, file); + newXSUB("POSIX::setuid", 0, XS_POSIX_setuid, file); + newXSUB("POSIX::stat", 0, XS_POSIX_stat, file); + newXSUB("POSIX::symlink", 0, XS_POSIX_symlink, file); + newXSUB("POSIX::system", 0, XS_POSIX_system, file); + newXSUB("POSIX::tcgetpgrp", 0, XS_POSIX_tcgetpgrp, file); + newXSUB("POSIX::tcsetpgrp", 0, XS_POSIX_tcsetpgrp, file); + newXSUB("POSIX::times", 0, XS_POSIX_times, file); + newXSUB("POSIX::umask", 0, XS_POSIX_umask, file); + newXSUB("POSIX::uname", 0, XS_POSIX_uname, file); + newXSUB("POSIX::unlink", 0, XS_POSIX_unlink, file); + newXSUB("POSIX::utime", 0, XS_POSIX_utime, file); + newXSUB("POSIX::wait", 0, XS_POSIX_wait, file); + newXSUB("POSIX::waitpid", 0, XS_POSIX_waitpid, file); + newXSUB("POSIX::write", 0, XS_POSIX_write, file); +} diff --git a/Quick b/Quick new file mode 100644 index 0000000..13d6ae0 --- /dev/null +++ b/Quick @@ -0,0 +1,170 @@ +#!/usr/local/bin/perl5 +# +# This document is in the public domain. +# +# The purpose is to document by example some of the new Perl5 features. +# It also functions as a mini test suite; you can extracted the +# expected output using: +# perl -ne 'm/.*prints ``(.*)..$/ && print $1,"\n";' +# There are a couple of places that print out internal address so it's +# not perfect yet, those should be fixed. +# +# Thanks to the following for their input: +# Johan.Vromans@NL.net +# Daniel Faken +# Tom Christiansen +# Dean Roehrich +# Larry Wall +# +# TODO when I get perl5a6 to play with +# *foo = \&func; # replaces only function (etc) +# AUTOLOAD { ...; } # called if method not found +# goto &func; # goto's a function +# require FOOBAR; # loads FOOBAR.pm +# @ISA +# +# import()/@EXPORT/etc + +# my + # static scoping + sub samp1 { print $z,"\n"; } + sub samp2 { my($z) = "world"; &samp1; } + $z = "hello"; &samp2; # prints ``hello'' + +# package; + # for catching non-local variable references + sub samp3 { + my $x = shift; # local() would work also + package; # empty package + $main::count += $x; # this is ok. + # $y = 1; # compile time error + } + +# => + # works like comma (,); use for key/value pairs + # sometimes used to disambiguate the final expression in a block + # might someday supply warnings if you get out of sync + %foo = ( abc => foo ); + print $foo{abc},"\n"; # prints ``foo'' + +# :: + # works like tick (') (use of ' is deprecated in perl5) + print $main::foo{abc},"\n"; # prints ``foo'' + +# bless ref; + # Bless takes a reference and returns an "object" + $oref = bless \$scalar; + +# -> + # dereferences an "object" + $x = { def => bar }; # $x is ref to anonymous hash + print $x->{def},"\n"; # prints ``bar'' + + # method derefs must be bless'ed + { + package sample; + sub samp4 { my($this) = shift; print $this->{def},"\n"; } + sub samp5 { print "samp5: @_\n"; } + $main::y = bless $main::x; # $x is ref, $y is "object" + } + $y->samp4(); # prints ``bar'' + + # indirect object calls + samp5 $y arglist; # prints ``samp5: sample=HASH(0xa85e0) arglist'' + + # static method calls (often used for constructors, see below) + samp5 sample arglist; # prints ``samp5: sample arglist'' + +# function calls without & + sub samp6 { print "look ma\n"; } + samp6; # prints ``look ma'' + +# ref + # returns "object" type + { + package OBJ1; + $x = bless \$y; # returns "object" $x in "class" OBJ1 + print ref $x,"\n"; # prints ``OBJ1'' + } + + # and non-references return undef. + $z = 1; + print "non-ref\n" if !defined(ref $z); # prints ``non-ref'' + + # ref's to "builtins" return type + print ref \$ascalar,"\n"; # prints ``SCALAR'' + print ref \@array,"\n"; # prints ``ARRAY'' + print ref \%hash,"\n"; # prints ``HASH'' + sub func { print shift,"\n"; } + print ref \&func,"\n"; # prints ``CODE'' + print ref \\$scalar,"\n"; # prints ``REF'' + +# tie + # bind a variable to a package with magic functions: + # new, fetch, store, delete, firstkey, nextkey (XXX: others???) + # Usage: tie variable, PackageName, ARGLIST + { + package TIEPACK; + sub new { print "NEW: @_\n"; my($class, $x) = @_; bless \$x } + sub fetch { print "fetch @_\n"; my($this) = @_; ${$this} } + sub store { print "store @_\n"; my($this, $x) = @_; ${$this} = $x } + sub DESTROY { print "DESTROY @_\n" } + } + tie $h, TIEPACK, "black_tie"; # prints ``NEW: TIEPACK black_tie'' + print $h, "\n"; # prints ``fetch TIEPACK=SCALAR(0x882a0)'' + # prints ``black_tie'' + $h = 'bar'; # prints ``store TIEPACK=SCALAR(0x882a0) bar'' + untie $h; # DESTROY (XXX: broken in perl5a5???) + +# References and Anonymous data-structures + $sref = \$scalar; # $$sref is scalar + $aref = \@array; # @$aref is array + $href = \%hash; # %$href is hash table + $fref = \&func; # &$fref is function + $refref = \$fref; # ref to ref to function + &$$refref("call the function"); # prints ``call the function'' + + %hash = ( abc => foo ); # hash (just like perl4) + print $hash{abc},"\n"; # prints ``foo'' + $ref = { abc => bar }; # reference to anon hash + print $ref->{abc},"\n"; # prints ``bar'' + + @ary = ( 0, 1, 2 ); # array (just like perl4) + print $ary[1],"\n"; # prints ``1'' + $ref = [ 3, 4, 5 ]; # reference to anon array + print $ref->[1],"\n"; # prints ``4'' + +# Nested data-structures + @foo = ( 0, { name => foobar }, 2, 3 ); # $#foo == 3 + $aref = [ 0, { name => foobar }, 2, 3 ]; # ref to anon array + $href = { # ref to hash of arrays + John => [ Mary, Pat, Blanch ], + Paul => [ Sally, Jill, Jane ], + Mark => [ Ann, Bob, Dawn ], + }; + print $href->{Paul}->[0], "\n"; # prints ``Sally'' + print $href->{Paul}[0],"\n"; # shorthand version, prints ``Sally'' + +# Multiple Inheritence (get rich quick :-) + { + package OBJ2; sub abc { print "abc\n"; } + package OBJ3; sub def { print "def\n"; } + package OBJ4; @ISA = ("OBJ2", "OBJ3"); + $x = bless { foo => bar }; + $x->abc; # prints ``abc'' + $x->def; # prints ``def'' + } + +# Packages, Classes, Objects, Methods, Constructors, Destructors, etc. + # XXX: I'll add more explinations/samples about the above here + { + package OBJ5; + sub new { print "NEW: @_\n"; my($x) = "empty"; bless \$x } + sub DESTROY { print "DESTROY\n" } + sub output { my($this) = shift; print "value = $$this\n"; } + } + # Constructors are often written as static method calls: + $x = new OBJ5; # prints ``NEW: OBJ5'' + $x->output; # prints ``value = empty'' + # The destructor is responsible for calling any base class destructors. + undef $x; diff --git a/SDBM_File.c b/SDBM_File.c index d6e08c4..459cfa2 100644 --- a/SDBM_File.c +++ b/SDBM_File.c @@ -24,7 +24,7 @@ register int items; SDBM_File RETVAL; RETVAL = sdbm_new(dbtype, filename, flags, mode); - ST(0) = sv_mortalcopy(&sv_undef); + ST(0) = sv_newmortal(); sv_setptrobj(ST(0), RETVAL, "SDBM_File"); } return sp; @@ -42,10 +42,10 @@ register int items; { SDBM_File db; - if (sv_isa(ST(1), "SDBM_File")) + if (SvROK(ST(1))) db = (SDBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1))); else - croak("db is not of type SDBM_File"); + croak("db is not a reference"); sdbm_close(db); } return sp; @@ -73,7 +73,7 @@ register int items; key.dptr = SvPV(ST(2), key.dsize);; RETVAL = sdbm_fetch(db, key); - ST(0) = sv_mortalcopy(&sv_undef); + ST(0) = sv_newmortal(); sv_setpvn(ST(0), RETVAL.dptr, RETVAL.dsize); } return sp; @@ -111,7 +111,7 @@ register int items; } RETVAL = sdbm_store(db, key, value, flags); - ST(0) = sv_mortalcopy(&sv_undef); + ST(0) = sv_newmortal(); sv_setiv(ST(0), (I32)RETVAL); } return sp; @@ -139,7 +139,7 @@ register int items; key.dptr = SvPV(ST(2), key.dsize);; RETVAL = sdbm_delete(db, key); - ST(0) = sv_mortalcopy(&sv_undef); + ST(0) = sv_newmortal(); sv_setiv(ST(0), (I32)RETVAL); } return sp; @@ -164,7 +164,7 @@ register int items; croak("db is not of type SDBM_File"); RETVAL = sdbm_firstkey(db); - ST(0) = sv_mortalcopy(&sv_undef); + ST(0) = sv_newmortal(); sv_setpvn(ST(0), RETVAL.dptr, RETVAL.dsize); } return sp; @@ -192,7 +192,7 @@ register int items; key.dptr = SvPV(ST(2), key.dsize);; RETVAL = nextkey(db, key); - ST(0) = sv_mortalcopy(&sv_undef); + ST(0) = sv_newmortal(); sv_setpvn(ST(0), RETVAL.dptr, RETVAL.dsize); } return sp; @@ -217,7 +217,7 @@ register int items; croak("db is not of type SDBM_File"); RETVAL = sdbm_error(db); - ST(0) = sv_mortalcopy(&sv_undef); + ST(0) = sv_newmortal(); sv_setiv(ST(0), (I32)RETVAL); } return sp; @@ -242,13 +242,13 @@ register int items; croak("db is not of type SDBM_File"); RETVAL = sdbm_clearerr(db); - ST(0) = sv_mortalcopy(&sv_undef); + ST(0) = sv_newmortal(); sv_setiv(ST(0), (I32)RETVAL); } return sp; } -int init_SDBM_File(ix,sp,items) +int boot_SDBM_File(ix,sp,items) int ix; int sp; int items; diff --git a/TCL b/TCL deleted file mode 100644 index 5409bbf..0000000 --- a/TCL +++ /dev/null @@ -1,169 +0,0 @@ -Article 1475 of comp.lang.tcl: -Path: netlabs!news!usc!cs.utexas.edu!sun-barr!ames!agate!sprite.Berkeley.EDU!ouster -From: ouster@sprite.Berkeley.EDU (John Ousterhout) -Newsgroups: comp.lang.tcl -Subject: Planning for Tcl 7.0 -Message-ID: <1avu22INN5ao@agate.berkeley.edu> -Date: 8 Oct 92 00:06:26 GMT -Organization: U.C. Berkeley Sprite Project -Lines: 156 -NNTP-Posting-Host: tyranny.berkeley.edu - - -For the last year I've made only small changes to Tcl while focussing -on the canvas and text widgets for Tk. I'm now making plans to catch -up on a bunch of much-needed bug fixes and enhancements to Tcl. Some -of the changes I'm considering are not backwards-compatible. The -purpose of this message is to let know know what changes I'm considering -for Tcl 7.0 and to solicit feedback. I'm particularly interested in -comments on the changes that are incompatible: I'll probably drop -the changes for which I get lots of negative feedback and not much -positive feedback. If there are other changes that you think are -important but aren't contained on this list, let me know and I may add -them. - -Incompatible changes: ---------------------- - -The changes listed below are likely to require changes to existing -scripts and/or C code. Each change includes an explanation of why the -change might be useful. I'd like to know whether or not you think the change -is useful enough to justify the incompatibility. - -1. Eliminate the "|" option in the "open" command. Instead, add a -"popen" command that does the same thing. Rationale: in the current -implementation you can't open a file whose name begins with "|". -Also, I think the "popen" command would be more logical. - -2. Eliminate the Tcl_WaitPids procedure and use the waitpid POSIX call -instead. Also change the wait code to periodically poll for dead -child processes so that zombie processes don't get left around forever. -Rationale: the current code tends to leave zombies around in some -situations. Switching to waitpid should solve this problem in a -relatively portable fashion. The only incompatibility will be for -C procedures that call Tcl_WaitPids; they'll have to switch to call -waitpid instead. I'll provide a compatibility version of waitpid for -use on systems that don't have it yet. - -3. Clean up backslash processing in several ways: - - Change backslash-newline to eat up all the whitespace following the - newline and replace the sequence with a single whitespace character. - Right now it only eats up the newline character and replaces it - with an empty string. Rationale: this would be more consistent - with other programs that process backslash-newline sequences. - - Eliminate the sequences \Mxx, \Cxxx, and \e. - Rationale: these sequences are left around from ancient times. - They're not particular compatible with any other program. I - should have removed them in Tcl 6.0 but didn't. They did get - removed from the documentation, however, so no-one should be - using them (?). - - Change \x (where x is not one of the characters that gets special - backslash treatment) to expand to x, not \x. - Rationale: the current behavior is inconsistent with all other - programs I know of that handle backslashes, and I think it's - confusing. - - Change "format" so it doesn't do an additional layer of backslash - processing on its format string. - Rationale: I don't know why it currently behaves as it does, and - I think it's confusing. - -4. Change "regsub" so that when no match occurs it sets the result -variable to the original string, rather than leaving it unmodified. -Rationale: the current behavior results in extra tests of the regsub -result that could sometimes be avoided with the proposed new behavior. -I doubt that there's much code that will break with the change (this -would have to be code that depends on the result variable *not* being -modified). - -5. Change the name "UNIX" in the "errorCode" variable to "POSIX". -Rationale: I suspect that I'm eventually going to get a call from the -USL lawyers on this one if I don't change it. Better to change it now -in an orderly fashion so I don't have change it hastily in the future. - -6. Change glob to return only the names of existing files. -Rationale: at present "glob */foo" expands * and generates a result -without checking to see if each directory has a "foo" file in it. This -makes the current behavior incompatible with csh, for example. One -question is whether constructs like "glob {a,b}.c" should also check for -the existence of each of the files. At present they don't (i.e. a.c and -b.c will be returned even if they don't exist), but neither does csh. My -inclination is to make the behavior match csh (names containing *?[] are -checked for existence, others aren't). I'd be interested to hear -opinions on this one: check all names for existence, check only names -including *?[] (for csh compatibility), or keep it as it is? - -7. Change "gets" so it returns 1 for success and 0 for failure. At present -it returns the line length for success and -1 for failure. -Rationale: this would allow slightly simple Tcl scripts: you could just -say - while [gets $f line] {...} -instead of - while {[gets $f line] >= 0} {...} -I'm not really convinced that this one is important enough to justify the -incompatibility, so it won't take much negative feedback to kill it. - -Other changes: --------------- - -The changes listed below shouldn't introduce substantial compatibility -problems. Of course, any change can potentially cause scripts to stop -working (e.g. almost any change will break the test suite), but very -few if any people should be affected by these changes. - -8. Implement Tcl_CreateExternVar() procedure along lines proposed by -Andreas Stolcke to tie a C variable to a Tcl variable with automatic -updates between them. - -9. Changes to exec: - - Allow redirection to an existing file descriptor in "exec", - with a mechanism like >&1 or >& stdout. - - Allow file names immediately after ">" and "<" without - intervening spaces. - -10. Changes related to files: - - Fix Scott Bolte bug (closing stdin and stdout). - - Move TclGetOpenFile and OpenFile stuff to tcl.h so that they're - accessible to applications. - - Extend access modes in open to include the complete set of POSIX - access modes (such as O_EXCL and O_NONBLOCK). - -11. Re-instate Tcl_WatchInterp to notify application when an interpreter -is deleted. - -12. Add "elseif" mechanism to "if" command for chaining "else {if ..." -constructs more cleanly. Require exact matches on "then" and "else" -keywords. - -13. Remove UNIX system call declarations from tclUnix.h. Use them from -unistd.h instead, and provide a default version of unistd.h for systems -that don't have one. - -14. Changes in the expr command, mostly following suggestions made by -George Howlett a long time ago: - - Increase precision of floating-point results. - - Make floating-point numbers always print with a point. - - Add transcendental functions like sin and exp. - - Add explicit integer and floating conversion operations. - - Don't promote large integers to floating-point automatically. - - Allow multiple arguments to expr command. - -15. Extend lsort to allow alternate sorting mechanisms, like numeric, -or client-supplied. - -16. Allow alternate pattern-matching forms (e.g. exact or regexp) for -lsearch and case. - -17. Add XPG/3 positional argument specifiers to format (code contributed -by Mark Diekhans). - -18. Change "file readlink" to return an error on systems that don't -support it rather than removing the option entirely. - -19. Add a mechanism for scheduling a Tcl command to be executed when the -interpreter reaches a clean point. This is needed for things like -signal support. - -20. Change upvar so that you can refer to an element of an array as -well as a whole array. - - diff --git a/Todo b/Todo index d073b04..d8badae 100755 --- a/Todo +++ b/Todo @@ -1,19 +1,17 @@ -Must-have external packages - POSIX - X/Motif/whatever +Modules + POSIX (in progress) + X/Motif/Tk etc. + +Tie Modules + VecArray Implement array using vec() + SubstrArray Implement array using substr() + VirtualArray Implement array using a file + ShiftSplice Defines shift et al in terms of splice method Bugs - BEGIN { require 'perldb.pl' } Make yyparse recursion longjmp() proof. - perl -c shell_script bug - fix the need for double ^D on $x - STDOUT->print("howdy\n"); - %ENV not there Make "delete $array{$key} while ($key) = each %array" safe - using unpack(P,$ref) shouldn't unref the ref - binary function is missing - wrong line reported for runtime elsif condition error - unreference variable warnings busted (but don't warn on $seen{$key}++) + Wrong line reported for runtime elsif condition error Regexp extensions /m for multiline @@ -24,16 +22,28 @@ Regexp extensions /f for fixed variable interpolation? Rewrite regexp parser for better integrated optimization -Nice to have +Would be nice to have Profiler pack "(stuff)*" lexperl Bundled perl preprocessor - FILEHANDLE methods Make $[ compile-time instead of run-time + Use posix calls internally where possible + const variables + gettimeofday + bytecompiler + format BOTTOM + willcall() + -iprefix. + All ARGV input should act like <> + Multiple levels of warning + +Pragmas ("assume" maybe?) + integer, float + nodebug, debug + autocroak? Optimizations - Make specialized allocators Optimize switch statements Optimize foreach on array Optimize foreach (1..1000000) @@ -44,25 +54,19 @@ Optimizations Cache hash value? Optimize away @_ where possible sfio? + "one pass" global destruction Need to think more about - ref in list context - When does split() go to @_? - Figure out BEGIN { ... @ARGV ... } - Implement eval once? (Unnecessary with cache?) - Detect inconsistent linkage when using -DDEBUGGING? + ref function in list context Populate %SIG at startup if appropriate - Multiple levels of warning + write HANDLE [formats]. Vague possibilities - readonly variables sub mysplice(@, $, $, ...) data prettyprint function? (or is it, as I suspect, a lib routine?) Nested destructors make tr/// return histogram in list context? undef wantarray in void context - goto &replacement_routine - filehandle references Loop control on do{} et al Explicit switch statements perl to C translator @@ -70,3 +74,4 @@ Vague possibilities built-in globbing compile to real threaded code structured types + paren counting in tokener to queue remote expectations diff --git a/XSUB.h b/XSUB.h index 764b8e6..a8a193b 100644 --- a/XSUB.h +++ b/XSUB.h @@ -1 +1 @@ -#define ST(s) stack_base[sp + s] +#define ST(s) stack_base[ax + s] diff --git a/av.c b/av.c index dd54bd5..7232e8a 100644 --- a/av.c +++ b/av.c @@ -35,11 +35,11 @@ I32 lval; { SV *sv; - if (SvMAGICAL(av)) { + if (SvRMAGICAL(av)) { if (mg_find((SV*)av,'P')) { if (key < 0) return 0; - sv = sv_2mortal(NEWSV(61,0)); + sv = sv_newmortal(); mg_copy((SV*)av, sv, 0, key); if (!lval) { mg_get((SV*)sv); @@ -62,7 +62,7 @@ I32 lval; if (AvREAL(av)) sv = NEWSV(5,0); else - sv = sv_mortalcopy(&sv_undef); + sv = sv_newmortal(); return av_store(av,key,sv); } } @@ -91,7 +91,7 @@ SV *val; return 0; } - if (SvMAGICAL(av)) { + if (SvRMAGICAL(av)) { if (mg_find((SV*)av,'P')) { mg_copy((SV*)av, val, 0, key); return 0; @@ -132,16 +132,16 @@ SV *val; if (AvFILL(av) < key) { while (++AvFILL(av) < key) { if (ary[AvFILL(av)] != Nullsv) { - sv_free(ary[AvFILL(av)]); + SvREFCNT_dec(ary[AvFILL(av)]); ary[AvFILL(av)] = Nullsv; } } } if (ary[key]) - sv_free(ary[key]); + SvREFCNT_dec(ary[key]); } ary[key] = val; - if (SvMAGICAL(av)) { + if (SvSMAGICAL(av)) { MAGIC* mg = SvMAGIC(av); sv_magic(val, (SV*)av, tolower(mg->mg_type), 0, key); mg_set((SV*)av); @@ -234,7 +234,7 @@ register AV *av; SvPVX(av) = (char*)(AvARRAY(av) - key); } for (key = 0; key <= AvMAX(av); key++) - sv_free(AvARRAY(av)[key]); + SvREFCNT_dec(AvARRAY(av)[key]); AvFILL(av) = -1; Zero(AvARRAY(av), AvMAX(av)+1, SV*); } @@ -254,7 +254,7 @@ register AV *av; } if (AvREAL(av)) { for (key = 0; key <= AvMAX(av); key++) - sv_free(AvARRAY(av)[key]); + SvREFCNT_dec(AvARRAY(av)[key]); } Safefree(AvALLOC(av)); AvALLOC(av) = 0; @@ -288,7 +288,7 @@ register AV *av; return Nullsv; retval = AvARRAY(av)[AvFILL(av)]; AvARRAY(av)[AvFILL(av)--] = Nullsv; - if (SvMAGICAL(av)) + if (SvSMAGICAL(av)) mg_set((SV*)av); return retval; } @@ -352,7 +352,7 @@ register AV *av; SvPVX(av) = (char*)(AvARRAY(av) + 1); AvMAX(av)--; AvFILL(av)--; - if (SvMAGICAL(av)) + if (SvSMAGICAL(av)) mg_set((SV*)av); return retval; } @@ -373,7 +373,7 @@ I32 fill; fill = -1; if (fill <= AvMAX(av)) { AvFILL(av) = fill; - if (SvMAGICAL(av)) + if (SvSMAGICAL(av)) mg_set((SV*)av); } else { diff --git a/bar b/bar new file mode 100755 index 0000000..5288a3e --- /dev/null +++ b/bar @@ -0,0 +1,8 @@ +#!./perl + +require POSIX; import POSIX; + +print &getpid, "\n"; + +@uname = &uname; +print "@uname\n"; diff --git a/bar.pm b/bar.pm new file mode 100755 index 0000000..330c168 --- /dev/null +++ b/bar.pm @@ -0,0 +1,10 @@ +#!./perl + +print ""; +@c = caller; +print "@c"; +__END__ + +require POSIX; import POSIX getpid; + +print &getpid, "\n"; diff --git a/bench/fib b/bench/fib new file mode 100755 index 0000000..022d9d0 --- /dev/null +++ b/bench/fib @@ -0,0 +1,20 @@ +#!./perl + +sub fib +{ + ($_[0] < 2) ? $_[0] : &fib($_[0]-1) + &fib($_[0]-2); +} + +sub myruntime +{ + local(@t) = times; # in seconds + $t[0] + $t[1]; +} + +$x = (shift || 20); +print "Starting fib($x)\n"; +$before = &myruntime; +$y = &fib($x); +$after = &myruntime; +printf("Done. Result $y in %g cpu seconds.\n", $after-$before); + diff --git a/cflags b/cflags index 672dfc6..a2cbc62 100755 --- a/cflags +++ b/cflags @@ -38,48 +38,7 @@ for file do : or customize here case "$file" in - array) ;; - cmd) ;; - cons) ;; - consarg) ;; - doarg) ;; - doio) ;; - dolist) ;; - dump) ;; - eval) ;; - form) ;; - hash) ;; - malloc) ;; - perl) ;; - perly) ;; - regcomp) ;; - regexec) ;; - stab) ;; - str) ;; - toke) ;; - usersub) ;; - util) ;; - tarray) ;; - tcmd) ;; - tcons) ;; - tconsarg) ;; - tdoarg) ;; - tdoio) ;; - tdolist) ;; - tdump) ;; - teval) ;; - tform) ;; - thash) ;; - tmalloc) ;; - tperl) ;; - tperly) ;; - tregcomp) ;; - tregexec) ;; - tstab) ;; - tstr) ;; - ttoke) ;; - tusersub) ;; - tutil) ;; + SDBM*) ccflags="$ccflags -pic";; *) ;; esac diff --git a/configpm b/configpm new file mode 100755 index 0000000..8900d86 --- /dev/null +++ b/configpm @@ -0,0 +1,27 @@ +#!./perl + +@ARGV = "./config.sh"; + +undef $/; +$_ = <>; +s:^#!/bin/sh\n::; +s/'undef'/undef/g; +s/\n(\w+)=/;\n\$Config{'$1'} = /g; +s/;\n\$Config/\n\$Config/; + +open STDOUT, ">lib/Config.pm" + or die "Can't open lib/Config.pm: $!\n"; +$myver = sprintf("%.3f", $]); +print <<"ENDOFBEG"; +package Config; +require Exporter; +\@ISA = (Exporter); +\@EXPORT = qw(%Config); + +\$] == $myver or die sprintf + "Perl lib version ($myver) doesn't match executable version (%.3f)\\n", \$]; + +ENDOFBEG + +print $_; + diff --git a/cop.h b/cop.h index 0b1868b..acf0fda 100644 --- a/cop.h +++ b/cop.h @@ -71,14 +71,12 @@ struct block_sub { GV * dfoutgv; AV * savearray; AV * argarray; - AV * comppad; U16 olddepth; U8 hasargs; }; #define PUSHSUB(cx) \ cx->blk_sub.cv = cv; \ - cx->blk_sub.gv = gv; \ cx->blk_sub.olddepth = CvDEPTH(cv); \ cx->blk_sub.hasargs = hasargs; @@ -90,12 +88,13 @@ struct block_sub { #define POPSUB(cx) \ if (cx->blk_sub.hasargs) { /* put back old @_ */ \ - av_free(cx->blk_sub.argarray); \ GvAV(defgv) = cx->blk_sub.savearray; \ } \ - if (!(CvDEPTH(cx->blk_sub.cv) = cx->blk_sub.olddepth)) { \ - if (CvDELETED(cx->blk_sub.cv)) \ - sv_free((SV*)cx->blk_sub.cv); \ + if (cx->blk_sub.cv) { \ + if (!(CvDEPTH(cx->blk_sub.cv) = cx->blk_sub.olddepth)) { \ + if (CvDELETED(cx->blk_sub.cv)) \ + SvREFCNT_dec((SV*)cx->blk_sub.cv); \ + } \ } #define POPFORMAT(cx) \ @@ -109,7 +108,7 @@ struct block_eval { OP * old_eval_root; }; -#define PUSHEVAL(cx,n) \ +#define PUSHEVAL(cx,n,fgv) \ cx->blk_eval.old_in_eval = in_eval; \ cx->blk_eval.old_op_type = op->op_type; \ cx->blk_eval.old_name = n; \ @@ -176,18 +175,17 @@ struct block { #define blk_loop cx_u.cx_blk.blk_u.blku_loop /* Enter a block. */ -#define PUSHBLOCK(cx,t,s) CXINC, cx = &cxstack[cxstack_ix], \ +#define PUSHBLOCK(cx,t,sp) CXINC, cx = &cxstack[cxstack_ix], \ cx->cx_type = t, \ - cx->blk_oldsp = s - stack_base, \ + cx->blk_oldsp = sp - stack_base, \ cx->blk_oldcop = curcop, \ cx->blk_oldmarksp = markstack_ptr - markstack, \ cx->blk_oldscopesp = scopestack_ix, \ cx->blk_oldretsp = retstack_ix, \ cx->blk_oldpm = curpm, \ cx->blk_gimme = gimme; \ - if (debug & 4) \ - fprintf(stderr,"Entering block %d, type %d\n", \ - cxstack_ix, t); + DEBUG_l( fprintf(stderr,"Entering block %d, type %s\n", \ + cxstack_ix, block_type[t]); ) /* Exit a block (RETURN and LAST). */ #define POPBLOCK(cx) cx = &cxstack[cxstack_ix--], \ @@ -198,9 +196,8 @@ struct block { retstack_ix = cx->blk_oldretsp, \ curpm = cx->blk_oldpm, \ gimme = cx->blk_gimme; \ - if (debug & 4) \ - fprintf(stderr,"Leaving block %d, type %d\n", \ - cxstack_ix+1,cx->cx_type); + DEBUG_l( fprintf(stderr,"Leaving block %d, type %s\n", \ + cxstack_ix+1,block_type[cx->cx_type]); ) /* Continue a block elsewhere (NEXT and REDO). */ #define TOPBLOCK(cx) cx = &cxstack[cxstack_ix], \ diff --git a/cv.h b/cv.h index 92dc11b..2675ede 100644 --- a/cv.h +++ b/cv.h @@ -22,6 +22,7 @@ struct xpvcv { OP * xcv_root; I32 (*xcv_usersub)(); I32 xcv_userindex; + GV * xcv_gv; GV * xcv_filegv; long xcv_depth; /* >= 2 indicates recursive call */ AV * xcv_padlist; @@ -33,6 +34,7 @@ struct xpvcv { #define CvROOT(sv) ((XPVCV*)SvANY(sv))->xcv_root #define CvUSERSUB(sv) ((XPVCV*)SvANY(sv))->xcv_usersub #define CvUSERINDEX(sv) ((XPVCV*)SvANY(sv))->xcv_userindex +#define CvGV(sv) ((XPVCV*)SvANY(sv))->xcv_gv #define CvFILEGV(sv) ((XPVCV*)SvANY(sv))->xcv_filegv #define CvDEPTH(sv) ((XPVCV*)SvANY(sv))->xcv_depth #define CvPADLIST(sv) ((XPVCV*)SvANY(sv))->xcv_padlist diff --git a/deb.c b/deb.c index 0af6110..d052db3 100644 --- a/deb.c +++ b/deb.c @@ -37,47 +37,66 @@ #include "EXTERN.h" #include "perl.h" -#ifdef I_VARARGS -# include +#ifdef STANDARD_C +# include +#else +# ifdef I_VARARGS +# include +# endif #endif void deb_growlevel(); -# ifndef I_VARARGS +#if !defined(STANDARD_C) && !defined(I_VARARGS) + +/* + * Fallback on the old hackers way of doing varargs + */ + /*VARARGS1*/ -void deb(pat,a1,a2,a3,a4,a5,a6,a7,a8) -char *pat; +void +deb(pat,a1,a2,a3,a4,a5,a6,a7,a8) + char *pat; { register I32 i; - fprintf(stderr,"%-4ld",(long)curop->cop_line); + fprintf(stderr,"(%s:%ld)\t", + SvPVX(GvSV(curcop->cop_filegv)),(long)curcop->cop_line); for (i=0; icop_line); + fprintf(stderr,"(%s:%ld)\t", + SvPVX(GvSV(curcop->cop_filegv)),(long)curcop->cop_line); for (i=0; i + +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +static int +XS_DynamicLoader_bootstrap(ix, sp, items) +register int ix; +register int sp; +register int items; +{ + if (items < 1 || items > 1) { + croak("Usage: DynamicLoader::bootstrap(package)"); + } + { + char* package = SvPV(ST(1),na); + void* obj = 0; + int (*bootproc)(); + char tmpbuf[1024]; + char tmpbuf2[128]; + AV *av = GvAVn(incgv); + I32 i; + + for (i = 0; i <= AvFILL(av); i++) { + (void)sprintf(tmpbuf, "%s/auto/%s/%s.so", + SvPVx(*av_fetch(av, i, TRUE), na), package, package); + if (obj = dlopen(tmpbuf,1)) + break; + } + if (!obj) + croak("Can't find loadable object for package %s in @INC", package); + + sprintf(tmpbuf2, "boot_%s", package); + bootproc = (int (*)())dlsym(obj, tmpbuf2); + if (!bootproc) + croak("Shared object %s contains no %s function", tmpbuf, tmpbuf2); + bootproc(); + + ST(0) = sv_mortalcopy(&sv_yes); + } + return sp; +} + +int +boot_DynamicLoader(ix,sp,items) +int ix; +int sp; +int items; +{ + char* file = __FILE__; + + newXSUB("DynamicLoader::bootstrap", 0, XS_DynamicLoader_bootstrap, file); +} diff --git a/doio.c b/doio.c index d76cefa..64093bc 100644 --- a/doio.c +++ b/doio.c @@ -94,6 +94,7 @@ I32 len; FILE *saveofp = Nullfp; char savetype = ' '; + SAVEFREEPV(myname); mode[0] = mode[1] = mode[2] = '\0'; name = myname; forkprocess = 1; /* assume true if no fork */ @@ -101,32 +102,32 @@ I32 len; name[--len] = '\0'; if (!io) io = GvIO(gv) = newIO(); - else if (io->ifp) { - fd = fileno(io->ifp); - if (io->type == '-') + else if (IoIFP(io)) { + fd = fileno(IoIFP(io)); + if (IoTYPE(io) == '-') result = 0; else if (fd <= maxsysfd) { - saveifp = io->ifp; - saveofp = io->ofp; - savetype = io->type; + saveifp = IoIFP(io); + saveofp = IoOFP(io); + savetype = IoTYPE(io); result = 0; } - else if (io->type == '|') - result = my_pclose(io->ifp); - else if (io->ifp != io->ofp) { - if (io->ofp) { - result = fclose(io->ofp); - fclose(io->ifp); /* clear stdio, fd already closed */ + else if (IoTYPE(io) == '|') + result = my_pclose(IoIFP(io)); + else if (IoIFP(io) != IoOFP(io)) { + if (IoOFP(io)) { + result = fclose(IoOFP(io)); + fclose(IoIFP(io)); /* clear stdio, fd already closed */ } else - result = fclose(io->ifp); + result = fclose(IoIFP(io)); } else - result = fclose(io->ifp); + result = fclose(IoIFP(io)); if (result == EOF && fd > maxsysfd) fprintf(stderr,"Warning: unable to close filehandle %s properly.\n", GvENAME(gv)); - io->ofp = io->ifp = Nullfp; + IoOFP(io) = IoIFP(io) = Nullfp; } if (*name == '+' && len > 1 && name[len-1] != '|') { /* scary */ mode[1] = *name++; @@ -137,7 +138,7 @@ I32 len; else { mode[1] = '\0'; } - io->type = *name; + IoTYPE(io) = *name; if (*name == '|') { /*SUPPRESS 530*/ for (name++; isSPACE(*name); name++) ; @@ -151,7 +152,7 @@ I32 len; TAINT_PROPER("open"); name++; if (*name == '>') { - mode[0] = io->type = 'a'; + mode[0] = IoTYPE(io) = 'a'; name++; } else @@ -172,10 +173,10 @@ I32 len; #endif goto say_false; } - if (GvIO(gv) && GvIO(gv)->ifp) { - fd = fileno(GvIO(gv)->ifp); - if (GvIO(gv)->type == 's') - io->type = 's'; + if (GvIO(gv) && IoIFP(GvIO(gv))) { + fd = fileno(IoIFP(GvIO(gv))); + if (IoTYPE(GvIO(gv)) == 's') + IoTYPE(io) = 's'; } else fd = -1; @@ -189,7 +190,7 @@ I32 len; name++; if (strEQ(name,"-")) { fp = stdout; - io->type = '-'; + IoTYPE(io) = '-'; } else { fp = fopen(name,mode); @@ -206,7 +207,7 @@ I32 len; goto duplicity; if (strEQ(name,"-")) { fp = stdin; - io->type = '-'; + IoTYPE(io) = '-'; } else fp = fopen(name,mode); @@ -221,35 +222,33 @@ I32 len; TAINT_ENV(); TAINT_PROPER("piped open"); fp = my_popen(name,"r"); - io->type = '|'; + IoTYPE(io) = '|'; } else { - io->type = '<'; + IoTYPE(io) = '<'; /*SUPPRESS 530*/ for (; isSPACE(*name); name++) ; if (strEQ(name,"-")) { fp = stdin; - io->type = '-'; + IoTYPE(io) = '-'; } else fp = fopen(name,"r"); } } if (!fp) { - if (dowarn && io->type == '<' && strchr(name, '\n')) + if (dowarn && IoTYPE(io) == '<' && strchr(name, '\n')) warn(warn_nl, "open"); - Safefree(myname); goto say_false; } - Safefree(myname); - if (io->type && - io->type != '|' && io->type != '-') { + if (IoTYPE(io) && + IoTYPE(io) != '|' && IoTYPE(io) != '-') { if (fstat(fileno(fp),&statbuf) < 0) { (void)fclose(fp); goto say_false; } if (S_ISSOCK(statbuf.st_mode)) - io->type = 's'; /* in case a socket was passed in to us */ + IoTYPE(io) = 's'; /* in case a socket was passed in to us */ #ifdef HAS_SOCKET else if ( #ifdef S_IFMT @@ -261,7 +260,7 @@ I32 len; I32 buflen = sizeof tokenbuf; if (getsockname(fileno(fp), tokenbuf, &buflen) >= 0 || errno != ENOTSOCK) - io->type = 's'; /* some OS's return 0 on fstat()ed socket */ + IoTYPE(io) = 's'; /* some OS's return 0 on fstat()ed socket */ /* but some return 0 for streams too, sigh */ } #endif @@ -298,25 +297,25 @@ I32 len; fd = fileno(fp); fcntl(fd,FFt_SETFD,fd > maxsysfd); #endif - io->ifp = fp; + IoIFP(io) = fp; if (writing) { - if (io->type == 's' - || (io->type == '>' && S_ISCHR(statbuf.st_mode)) ) { - if (!(io->ofp = fdopen(fileno(fp),"w"))) { + if (IoTYPE(io) == 's' + || (IoTYPE(io) == '>' && S_ISCHR(statbuf.st_mode)) ) { + if (!(IoOFP(io) = fdopen(fileno(fp),"w"))) { fclose(fp); - io->ifp = Nullfp; + IoIFP(io) = Nullfp; goto say_false; } } else - io->ofp = fp; + IoOFP(io) = fp; } return TRUE; say_false: - io->ifp = saveifp; - io->ofp = saveofp; - io->type = savetype; + IoIFP(io) = saveifp; + IoOFP(io) = saveofp; + IoTYPE(io) = savetype; return FALSE; } @@ -335,7 +334,7 @@ register GV *gv; if (!argvoutgv) argvoutgv = gv_fetchpv("ARGVOUT",TRUE); if (filemode & (S_ISUID|S_ISGID)) { - fflush(GvIO(argvoutgv)->ifp); /* chmod must follow last write */ + fflush(IoIFP(GvIO(argvoutgv))); /* chmod must follow last write */ #ifdef HAS_FCHMOD (void)fchmod(lastfd,filemode); #else @@ -346,6 +345,7 @@ register GV *gv; while (av_len(GvAV(gv)) >= 0) { STRLEN len; sv = av_shift(GvAV(gv)); + SAVEFREESV(sv); sv_setsv(GvSV(gv),sv); SvSETMAGIC(GvSV(gv)); oldname = SvPVx(GvSV(gv), len); @@ -353,9 +353,8 @@ register GV *gv; if (inplace) { TAINT_PROPER("inplace open"); if (strEQ(oldname,"-")) { - sv_free(sv); defoutgv = gv_fetchpv("STDOUT",TRUE); - return GvIO(gv)->ifp; + return IoIFP(GvIO(gv)); } #ifndef FLEXFILENAMES filedev = statbuf.st_dev; @@ -368,7 +367,6 @@ register GV *gv; warn("Can't do inplace edit: %s is not a regular file", oldname ); do_close(gv,FALSE); - sv_free(sv); continue; } if (*inplace) { @@ -384,7 +382,6 @@ register GV *gv; warn("Can't do inplace edit: %s > 14 characters", SvPVX(sv) ); do_close(gv,FALSE); - sv_free(sv); continue; } #endif @@ -394,7 +391,6 @@ register GV *gv; warn("Can't rename %s to %s: %s, skipping file", oldname, SvPVX(sv), strerror(errno) ); do_close(gv,FALSE); - sv_free(sv); continue; } #else @@ -409,7 +405,6 @@ register GV *gv; warn("Can't rename %s to %s: %s, skipping file", oldname, SvPVX(sv), strerror(errno) ); do_close(gv,FALSE); - sv_free(sv); continue; } (void)UNLINK(oldname); @@ -421,7 +416,6 @@ register GV *gv; warn("Can't rename %s to %s: %s, skipping file", oldname, SvPVX(sv), strerror(errno) ); do_close(gv,FALSE); - sv_free(sv); continue; } #else @@ -436,11 +430,10 @@ register GV *gv; warn("Can't do inplace edit on %s: %s", oldname, strerror(errno) ); do_close(gv,FALSE); - sv_free(sv); continue; } defoutgv = argvoutgv; - lastfd = fileno(GvIO(argvoutgv)->ifp); + lastfd = fileno(IoIFP(GvIO(argvoutgv))); (void)fstat(lastfd,&statbuf); #ifdef HAS_FCHMOD (void)fchmod(lastfd,filemode); @@ -457,12 +450,10 @@ register GV *gv; #endif } } - sv_free(sv); - return GvIO(gv)->ifp; + return IoIFP(GvIO(gv)); } else fprintf(stderr,"Can't open %s: %s\n",SvPV(sv, na), strerror(errno)); - sv_free(sv); } if (inplace) { (void)do_close(argvoutgv,FALSE); @@ -492,24 +483,24 @@ GV *wgv; if (!rstio) rstio = GvIO(rgv) = newIO(); - else if (rstio->ifp) + else if (IoIFP(rstio)) do_close(rgv,FALSE); if (!wstio) wstio = GvIO(wgv) = newIO(); - else if (wstio->ifp) + else if (IoIFP(wstio)) do_close(wgv,FALSE); if (pipe(fd) < 0) goto badexit; - rstio->ifp = fdopen(fd[0], "r"); - wstio->ofp = fdopen(fd[1], "w"); - wstio->ifp = wstio->ofp; - rstio->type = '<'; - wstio->type = '>'; - if (!rstio->ifp || !wstio->ofp) { - if (rstio->ifp) fclose(rstio->ifp); + IoIFP(rstio) = fdopen(fd[0], "r"); + IoOFP(wstio) = fdopen(fd[1], "w"); + IoIFP(wstio) = IoOFP(wstio); + IoTYPE(rstio) = '<'; + IoTYPE(wstio) = '>'; + if (!IoIFP(rstio) || !IoOFP(wstio)) { + if (IoIFP(rstio)) fclose(IoIFP(rstio)); else close(fd[0]); - if (wstio->ofp) fclose(wstio->ofp); + if (IoOFP(wstio)) fclose(IoOFP(wstio)); else close(fd[1]); goto badexit; } @@ -524,9 +515,13 @@ badexit: #endif bool +#ifndef STANDARD_C do_close(gv,explicit) GV *gv; bool explicit; +#else +do_close(GV *gv, bool explicit) +#endif /* STANDARD_C */ { bool retval = FALSE; register IO *io; @@ -544,30 +539,30 @@ bool explicit; warn("Close on unopened file <%s>",GvENAME(gv)); return FALSE; } - if (io->ifp) { - if (io->type == '|') { - status = my_pclose(io->ifp); + if (IoIFP(io)) { + if (IoTYPE(io) == '|') { + status = my_pclose(IoIFP(io)); retval = (status == 0); statusvalue = (unsigned short)status & 0xffff; } - else if (io->type == '-') + else if (IoTYPE(io) == '-') retval = TRUE; else { - if (io->ofp && io->ofp != io->ifp) { /* a socket */ - retval = (fclose(io->ofp) != EOF); - fclose(io->ifp); /* clear stdio, fd already closed */ + if (IoOFP(io) && IoOFP(io) != IoIFP(io)) { /* a socket */ + retval = (fclose(IoOFP(io)) != EOF); + fclose(IoIFP(io)); /* clear stdio, fd already closed */ } else - retval = (fclose(io->ifp) != EOF); + retval = (fclose(IoIFP(io)) != EOF); } - io->ofp = io->ifp = Nullfp; + IoOFP(io) = IoIFP(io) = Nullfp; } if (explicit) { - io->lines = 0; - io->page = 0; - io->lines_left = io->page_len; + IoLINES(io) = 0; + IoPAGE(io) = 0; + IoLINES_LEFT(io) = IoPAGE_LEN(io); } - io->type = ' '; + IoTYPE(io) = ' '; return retval; } @@ -583,23 +578,23 @@ GV *gv; if (!io) return TRUE; - while (io->ifp) { + while (IoIFP(io)) { #ifdef STDSTDIO /* (the code works without this) */ - if (io->ifp->_cnt > 0) /* cheat a little, since */ + if (IoIFP(io)->_cnt > 0) /* cheat a little, since */ return FALSE; /* this is the most usual case */ #endif - ch = getc(io->ifp); + ch = getc(IoIFP(io)); if (ch != EOF) { - (void)ungetc(ch, io->ifp); + (void)ungetc(ch, IoIFP(io)); return FALSE; } #ifdef STDSTDIO - if (io->ifp->_cnt < -1) - io->ifp->_cnt = -1; + if (IoIFP(io)->_cnt < -1) + IoIFP(io)->_cnt = -1; #endif - if (gv == argvgv) { /* not necessarily a real EOF yet? */ + if (op->op_flags & OPf_SPECIAL) { /* not necessarily a real EOF yet? */ if (!nextargv(argvgv)) /* get another fp handy */ return TRUE; } @@ -619,15 +614,15 @@ GV *gv; goto phooey; io = GvIO(gv); - if (!io || !io->ifp) + if (!io || !IoIFP(io)) goto phooey; #ifdef ULTRIX_STDIO_BOTCH - if (feof(io->ifp)) - (void)fseek (io->ifp, 0L, 2); /* ultrix 1.2 workaround */ + if (feof(IoIFP(io))) + (void)fseek (IoIFP(io), 0L, 2); /* ultrix 1.2 workaround */ #endif - return ftell(io->ifp); + return ftell(IoIFP(io)); phooey: if (dowarn) @@ -648,15 +643,15 @@ int whence; goto nuts; io = GvIO(gv); - if (!io || !io->ifp) + if (!io || !IoIFP(io)) goto nuts; #ifdef ULTRIX_STDIO_BOTCH - if (feof(io->ifp)) - (void)fseek (io->ifp, 0L, 2); /* ultrix 1.2 workaround */ + if (feof(IoIFP(io))) + (void)fseek (IoIFP(io), 0L, 2); /* ultrix 1.2 workaround */ #endif - return fseek(io->ifp, pos, whence) >= 0; + return fseek(IoIFP(io), pos, whence) >= 0; nuts: if (dowarn) @@ -676,7 +671,7 @@ SV *argstr; register char *s; I32 retval; - if (!gv || !argstr || !(io = GvIO(gv)) || !io->ifp) { + if (!gv || !argstr || !(io = GvIO(gv)) || !IoIFP(io)) { errno = EBADF; /* well, sort of... */ return -1; } @@ -714,13 +709,13 @@ SV *argstr; #ifndef lint if (optype == OP_IOCTL) - retval = ioctl(fileno(io->ifp), func, s); + retval = ioctl(fileno(IoIFP(io)), func, s); else #ifdef DOSISH croak("fcntl is not implemented"); #else #ifdef HAS_FCNTL - retval = fcntl(fileno(io->ifp), func, s); + retval = fcntl(fileno(IoIFP(io)), func, s); #else croak("fcntl is not implemented"); #endif @@ -852,7 +847,7 @@ FILE *fp; if (!sv) return TRUE; if (ofmt) { - if (SvMAGICAL(sv)) + if (SvGMAGICAL(sv)) mg_get(sv); if (SvIOK(sv) && SvIVX(sv) != 0) { fprintf(fp, ofmt, (double)SvIVX(sv)); @@ -866,9 +861,11 @@ FILE *fp; } switch (SvTYPE(sv)) { case SVt_NULL: + if (dowarn) + warn(warn_uninit); return TRUE; case SVt_IV: - if (SvMAGICAL(sv)) + if (SvGMAGICAL(sv)) mg_get(sv); fprintf(fp, "%d", SvIVX(sv)); return !ferror(fp); @@ -891,11 +888,11 @@ dARGS if (op->op_flags & OPf_SPECIAL) { EXTEND(sp,1); io = GvIO(cGVOP->op_gv); - if (io && io->ifp) { + if (io && IoIFP(io)) { statgv = cGVOP->op_gv; sv_setpv(statname,""); laststype = OP_STAT; - return (laststatval = fstat(fileno(io->ifp), &statcache)); + return (laststatval = fstat(fileno(IoIFP(io)), &statcache)); } else { if (cGVOP->op_gv == defgv) diff --git a/doop.c b/doop.c index 146bd24..1a2ee51 100644 --- a/doop.c +++ b/doop.c @@ -163,8 +163,14 @@ register SV **sp; } if (items-- > 0) { - char *s = SvPV(*mark, tmplen); - sv_setpvn(sv, s, tmplen); + char *s; + + if (*mark) { + s = SvPV(*mark, tmplen); + sv_setpvn(sv, s, tmplen); + } + else + sv_setpv(sv, ""); mark++; } else @@ -377,10 +383,14 @@ SV *sv; SV *targ = LvTARG(sv); register I32 offset; register I32 size; - register unsigned char *s = (unsigned char*)SvPVX(targ); - register unsigned long lval = U_L(SvNV(sv)); + register unsigned char *s; + register unsigned long lval; I32 mask; + if (!targ) + return; + s = (unsigned char*)SvPVX(targ); + lval = U_L(SvNV(sv)); offset = LvTARGOFF(sv); size = LvTARGLEN(sv); if (size < 8) { @@ -584,7 +594,7 @@ dARGS if (GIMME != G_ARRAY) { dTARGET; - if (!SvMAGICAL(hv) || !mg_find((SV*)hv,'P')) + if (!SvRMAGICAL(hv) || !mg_find((SV*)hv,'P')) i = HvKEYS(hv); else { i = 0; diff --git a/dump.c b/dump.c index 7839ed7..5d80a70 100644 --- a/dump.c +++ b/dump.c @@ -44,6 +44,8 @@ HV* stash; U32 i; HE *entry; + if (!HvARRAY(stash)) + return; for (i = 0; i <= HvMAX(stash); i++) { for (entry = HvARRAY(stash)[i]; entry; entry = entry->hent_next) { GV *gv = (GV*)entry->hent_val; @@ -61,7 +63,7 @@ void dump_sub(gv) GV* gv; { - SV *sv = sv_mortalcopy(&sv_undef); + SV *sv = sv_newmortal(); if (GvCV(gv)) { gv_fullname(sv,gv); dump("\nSUB %s = ", SvPVX(sv)); @@ -107,8 +109,12 @@ register OP *op; else fprintf(stderr, "DONE\n"); dumplvl++; - if (op->op_targ) - dump("TARG = %d\n", op->op_targ); + if (op->op_targ) { + if (op->op_type == OP_NULL) + dump(" (was %s)\n", op_name[op->op_targ]); + else + dump("TARG = %d\n", op->op_targ); + } #ifdef NOTDEF dump("ADDR = 0x%lx => 0x%lx\n",op, op->op_next); #endif @@ -182,10 +188,12 @@ register OP *op; case OP_GVSV: case OP_GV: if (cGVOP->op_gv) { + ENTER; tmpsv = NEWSV(0,0); + SAVEFREESV(tmpsv); gv_fullname(tmpsv,cGVOP->op_gv); dump("GV = %s\n", SvPV(tmpsv, na)); - sv_free(tmpsv); + LEAVE; } else dump("GV = NULL\n"); @@ -264,7 +272,7 @@ register GV *gv; fprintf(stderr,"{}\n"); return; } - sv = sv_mortalcopy(&sv_undef); + sv = sv_newmortal(); dumplvl++; fprintf(stderr,"{\n"); gv_fullname(sv,gv); diff --git a/embed.h b/embed.h index 5a9b072..50078b5 100644 --- a/embed.h +++ b/embed.h @@ -1,860 +1,883 @@ -/* This file is derived from global.var and interp.var */ +/* This file is derived from global.sym and interp.sym */ /* (Doing namespace management portably in C is really gross.) */ #ifdef EMBED /* globals we need to hide from the world */ -#define No PERLNo -#define Sv PERLSv -#define Xpv PERLXpv -#define Yes PERLYes -#define additem PERLadditem -#define an PERLan -#define buf PERLbuf -#define bufend PERLbufend -#define bufptr PERLbufptr -#define check PERLcheck -#define coeff PERLcoeff -#define compiling PERLcompiling -#define comppad PERLcomppad -#define comppadname PERLcomppadname -#define comppadnamefill PERLcomppadnamefill -#define cop_seqmax PERLcop_seqmax -#define cryptseen PERLcryptseen -#define cshlen PERLcshlen -#define cshname PERLcshname -#define curinterp PERLcurinterp -#define curpad PERLcurpad -#define dc PERLdc -#define di PERLdi -#define ds PERLds -#define egid PERLegid -#define error_count PERLerror_count -#define euid PERLeuid -#define evstr PERLevstr -#define expect PERLexpect -#define expectterm PERLexpectterm -#define fold PERLfold -#define freq PERLfreq -#define gid PERLgid -#define hexdigit PERLhexdigit -#define in_format PERLin_format -#define in_my PERLin_my -#define know_next PERLknow_next -#define last_lop PERLlast_lop -#define last_uni PERLlast_uni -#define linestr PERLlinestr -#define markstack PERLmarkstack -#define markstack_max PERLmarkstack_max -#define markstack_ptr PERLmarkstack_ptr -#define multi_close PERLmulti_close -#define multi_end PERLmulti_end -#define multi_open PERLmulti_open -#define multi_start PERLmulti_start -#define na PERLna -#define needblockscope PERLneedblockscope -#define nexttype PERLnexttype -#define nextval PERLnextval -#define no_aelem PERLno_aelem -#define no_dir_func PERLno_dir_func -#define no_func PERLno_func -#define no_helem PERLno_helem -#define no_mem PERLno_mem -#define no_modify PERLno_modify -#define no_security PERLno_security -#define no_sock_func PERLno_sock_func -#define no_usym PERLno_usym -#define nointrp PERLnointrp -#define nomem PERLnomem -#define nomemok PERLnomemok -#define oldbufptr PERLoldbufptr -#define oldoldbufptr PERLoldoldbufptr -#define op PERLop -#define op_name PERLop_name -#define op_seqmax PERLop_seqmax -#define opargs PERLopargs -#define origalen PERLorigalen -#define origenviron PERLorigenviron -#define padix PERLpadix -#define patleave PERLpatleave -#define ppaddr PERLppaddr -#define rcsid PERLrcsid -#define reall_srchlen PERLreall_srchlen -#define regarglen PERLregarglen -#define regbol PERLregbol -#define regcode PERLregcode -#define regdummy PERLregdummy -#define regendp PERLregendp -#define regeol PERLregeol -#define regfold PERLregfold -#define reginput PERLreginput -#define reglastparen PERLreglastparen -#define regmyendp PERLregmyendp -#define regmyp_size PERLregmyp_size -#define regmystartp PERLregmystartp -#define regnarrate PERLregnarrate -#define regnpar PERLregnpar -#define regparse PERLregparse -#define regprecomp PERLregprecomp -#define regprev PERLregprev -#define regsawback PERLregsawback -#define regsawbracket PERLregsawbracket -#define regsize PERLregsize -#define regstartp PERLregstartp -#define regtill PERLregtill -#define regxend PERLregxend -#define retstack PERLretstack -#define retstack_ix PERLretstack_ix -#define retstack_max PERLretstack_max -#define rsfp PERLrsfp -#define savestack PERLsavestack -#define savestack_ix PERLsavestack_ix -#define savestack_max PERLsavestack_max -#define saw_return PERLsaw_return -#define scopestack PERLscopestack -#define scopestack_ix PERLscopestack_ix -#define scopestack_max PERLscopestack_max -#define scrgv PERLscrgv -#define sig_name PERLsig_name -#define simple PERLsimple -#define stack_base PERLstack_base -#define stack_max PERLstack_max -#define stack_sp PERLstack_sp -#define statbuf PERLstatbuf -#define sub_generation PERLsub_generation -#define subline PERLsubline -#define subname PERLsubname -#define sv_no PERLsv_no -#define sv_undef PERLsv_undef -#define sv_yes PERLsv_yes -#define thisexpr PERLthisexpr -#define timesbuf PERLtimesbuf -#define tokenbuf PERLtokenbuf -#define uid PERLuid -#define varies PERLvaries -#define vert PERLvert -#define vtbl_arylen PERLvtbl_arylen -#define vtbl_bm PERLvtbl_bm -#define vtbl_dbline PERLvtbl_dbline -#define vtbl_env PERLvtbl_env -#define vtbl_envelem PERLvtbl_envelem -#define vtbl_glob PERLvtbl_glob -#define vtbl_isa PERLvtbl_isa -#define vtbl_isaelem PERLvtbl_isaelem -#define vtbl_mglob PERLvtbl_mglob -#define vtbl_pack PERLvtbl_pack -#define vtbl_packelem PERLvtbl_packelem -#define vtbl_sig PERLvtbl_sig -#define vtbl_sigelem PERLvtbl_sigelem -#define vtbl_substr PERLvtbl_substr -#define vtbl_sv PERLvtbl_sv -#define vtbl_taint PERLvtbl_taint -#define vtbl_uvar PERLvtbl_uvar -#define vtbl_vec PERLvtbl_vec -#define warn_nl PERLwarn_nl -#define warn_nosemi PERLwarn_nosemi -#define warn_reserved PERLwarn_reserved -#define watchaddr PERLwatchaddr -#define watchok PERLwatchok -#define yychar PERLyychar -#define yycheck PERLyycheck -#define yydebug PERLyydebug -#define yydefred PERLyydefred -#define yydgoto PERLyydgoto -#define yyerrflag PERLyyerrflag -#define yygindex PERLyygindex -#define yylen PERLyylen -#define yylhs PERLyylhs -#define yylval PERLyylval -#define yyname PERLyyname -#define yynerrs PERLyynerrs -#define yyrindex PERLyyrindex -#define yyrule PERLyyrule -#define yysindex PERLyysindex -#define yytable PERLyytable -#define yyval PERLyyval -#define append_elem PERLappend_elem -#define append_list PERLappend_list -#define apply PERLapply -#define av_clear PERLav_clear -#define av_fake PERLav_fake -#define av_fetch PERLav_fetch -#define av_fill PERLav_fill -#define av_free PERLav_free -#define av_len PERLav_len -#define av_make PERLav_make -#define av_pop PERLav_pop -#define av_popnulls PERLav_popnulls -#define av_push PERLav_push -#define av_shift PERLav_shift -#define av_store PERLav_store -#define av_undef PERLav_undef -#define av_unshift PERLav_unshift -#define bind_match PERLbind_match -#define block_head PERLblock_head -#define calllist PERLcalllist -#define cando PERLcando -#define check_uni PERLcheck_uni -#define checkcomma PERLcheckcomma -#define ck_aelem PERLck_aelem -#define ck_chop PERLck_chop -#define ck_concat PERLck_concat -#define ck_eof PERLck_eof -#define ck_eval PERLck_eval -#define ck_exec PERLck_exec -#define ck_formline PERLck_formline -#define ck_ftst PERLck_ftst -#define ck_fun PERLck_fun -#define ck_glob PERLck_glob -#define ck_grep PERLck_grep -#define ck_gvconst PERLck_gvconst -#define ck_index PERLck_index -#define ck_lengthconst PERLck_lengthconst -#define ck_lfun PERLck_lfun -#define ck_listiob PERLck_listiob -#define ck_match PERLck_match -#define ck_null PERLck_null -#define ck_repeat PERLck_repeat -#define ck_retarget PERLck_retarget -#define ck_rvconst PERLck_rvconst -#define ck_select PERLck_select -#define ck_shift PERLck_shift -#define ck_sort PERLck_sort -#define ck_split PERLck_split -#define ck_subr PERLck_subr -#define ck_trunc PERLck_trunc -#define convert PERLconvert -#define cpy7bit PERLcpy7bit -#define cpytill PERLcpytill -#define croak PERLcroak -#define cv_clear PERLcv_clear -#define cxinc PERLcxinc -#define deb PERLdeb -#define deb_growlevel PERLdeb_growlevel -#define debop PERLdebop -#define debstack PERLdebstack -#define debstackptrs PERLdebstackptrs -#define die PERLdie -#define die_where PERLdie_where -#define do_aexec PERLdo_aexec -#define do_chop PERLdo_chop -#define do_close PERLdo_close -#define do_ctl PERLdo_ctl -#define do_eof PERLdo_eof -#define do_exec PERLdo_exec -#define do_execfree PERLdo_execfree -#define do_ipcctl PERLdo_ipcctl -#define do_ipcget PERLdo_ipcget -#define do_join PERLdo_join -#define do_kv PERLdo_kv -#define do_msgrcv PERLdo_msgrcv -#define do_msgsnd PERLdo_msgsnd -#define do_open PERLdo_open -#define do_pipe PERLdo_pipe -#define do_print PERLdo_print -#define do_readline PERLdo_readline -#define do_seek PERLdo_seek -#define do_semop PERLdo_semop -#define do_shmio PERLdo_shmio -#define do_sprintf PERLdo_sprintf -#define do_tell PERLdo_tell -#define do_trans PERLdo_trans -#define do_vecset PERLdo_vecset -#define do_vop PERLdo_vop -#define doeval PERLdoeval -#define dofindlabel PERLdofindlabel -#define dopoptoeval PERLdopoptoeval -#define dump_all PERLdump_all -#define dump_eval PERLdump_eval -#define dump_gv PERLdump_gv -#define dump_op PERLdump_op -#define dump_packsubs PERLdump_packsubs -#define dump_pm PERLdump_pm -#define dump_sub PERLdump_sub -#define fbm_compile PERLfbm_compile -#define fbm_instr PERLfbm_instr -#define fetch_gv PERLfetch_gv -#define fetch_io PERLfetch_io -#define fetch_stash PERLfetch_stash -#define fold_constants PERLfold_constants -#define force_ident PERLforce_ident -#define force_next PERLforce_next -#define force_word PERLforce_word -#define free_tmps PERLfree_tmps -#define gen_constant_list PERLgen_constant_list -#define getgimme PERLgetgimme -#define gp_free PERLgp_free -#define gp_ref PERLgp_ref -#define gv_AVadd PERLgv_AVadd -#define gv_HVadd PERLgv_HVadd -#define gv_check PERLgv_check -#define gv_efullname PERLgv_efullname -#define gv_fetchfile PERLgv_fetchfile -#define gv_fetchmeth PERLgv_fetchmeth -#define gv_fetchmethod PERLgv_fetchmethod -#define gv_fetchpv PERLgv_fetchpv -#define gv_fullname PERLgv_fullname -#define gv_init PERLgv_init -#define he_delayfree PERLhe_delayfree -#define he_free PERLhe_free -#define hoistmust PERLhoistmust -#define hv_clear PERLhv_clear -#define hv_delete PERLhv_delete -#define hv_fetch PERLhv_fetch -#define hv_free PERLhv_free -#define hv_iterinit PERLhv_iterinit -#define hv_iterkey PERLhv_iterkey -#define hv_iternext PERLhv_iternext -#define hv_iterval PERLhv_iterval -#define hv_magic PERLhv_magic -#define hv_store PERLhv_store -#define hv_undef PERLhv_undef -#define ibcmp PERLibcmp -#define ingroup PERLingroup -#define instr PERLinstr -#define intuit_more PERLintuit_more -#define invert PERLinvert -#define jmaybe PERLjmaybe -#define keyword PERLkeyword -#define leave_scope PERLleave_scope -#define lex_end PERLlex_end -#define lex_start PERLlex_start -#define linklist PERLlinklist -#define list PERLlist -#define listkids PERLlistkids -#define localize PERLlocalize -#define looks_like_number PERLlooks_like_number -#define magic_clearpack PERLmagic_clearpack -#define magic_get PERLmagic_get -#define magic_getarylen PERLmagic_getarylen -#define magic_getglob PERLmagic_getglob -#define magic_getpack PERLmagic_getpack -#define magic_gettaint PERLmagic_gettaint -#define magic_getuvar PERLmagic_getuvar -#define magic_len PERLmagic_len -#define magic_nextpack PERLmagic_nextpack -#define magic_set PERLmagic_set -#define magic_setarylen PERLmagic_setarylen -#define magic_setbm PERLmagic_setbm -#define magic_setdbline PERLmagic_setdbline -#define magic_setenv PERLmagic_setenv -#define magic_setglob PERLmagic_setglob -#define magic_setisa PERLmagic_setisa -#define magic_setmglob PERLmagic_setmglob -#define magic_setpack PERLmagic_setpack -#define magic_setsig PERLmagic_setsig -#define magic_setsubstr PERLmagic_setsubstr -#define magic_settaint PERLmagic_settaint -#define magic_setuvar PERLmagic_setuvar -#define magic_setvec PERLmagic_setvec -#define magicname PERLmagicname -#define mess PERLmess -#define mg_clear PERLmg_clear -#define mg_copy PERLmg_copy -#define mg_find PERLmg_find -#define mg_free PERLmg_free -#define mg_get PERLmg_get -#define mg_len PERLmg_len -#define mg_set PERLmg_set -#define mod PERLmod -#define modkids PERLmodkids -#define moreswitches PERLmoreswitches -#define my PERLmy -#define my_exit PERLmy_exit -#define my_lstat PERLmy_lstat -#define my_pclose PERLmy_pclose -#define my_popen PERLmy_popen -#define my_setenv PERLmy_setenv -#define my_stat PERLmy_stat -#define my_unexec PERLmy_unexec -#define newANONHASH PERLnewANONHASH -#define newANONLIST PERLnewANONLIST -#define newASSIGNOP PERLnewASSIGNOP -#define newAV PERLnewAV -#define newAVREF PERLnewAVREF -#define newBINOP PERLnewBINOP -#define newCONDOP PERLnewCONDOP -#define newCVOP PERLnewCVOP -#define newCVREF PERLnewCVREF -#define newFORM PERLnewFORM -#define newFOROP PERLnewFOROP -#define newGVOP PERLnewGVOP -#define newGVREF PERLnewGVREF -#define newGVgen PERLnewGVgen -#define newHV PERLnewHV -#define newHVREF PERLnewHVREF -#define newIO PERLnewIO -#define newLISTOP PERLnewLISTOP -#define newLOGOP PERLnewLOGOP -#define newLOOPOP PERLnewLOOPOP -#define newMETHOD PERLnewMETHOD -#define newNULLLIST PERLnewNULLLIST -#define newOP PERLnewOP -#define newPMOP PERLnewPMOP -#define newPVOP PERLnewPVOP -#define newRANGE PERLnewRANGE -#define newSLICEOP PERLnewSLICEOP -#define newSTATEOP PERLnewSTATEOP -#define newSUB PERLnewSUB -#define newSV PERLnewSV -#define newSVOP PERLnewSVOP -#define newSVREF PERLnewSVREF -#define newSViv PERLnewSViv -#define newSVnv PERLnewSVnv -#define newSVpv PERLnewSVpv -#define newSVsv PERLnewSVsv -#define newUNOP PERLnewUNOP -#define newWHILEOP PERLnewWHILEOP -#define newXSUB PERLnewXSUB -#define nextargv PERLnextargv -#define ninstr PERLninstr -#define no_fh_allowed PERLno_fh_allowed -#define no_op PERLno_op -#define nsavestr PERLnsavestr -#define oopsAV PERLoopsAV -#define oopsCV PERLoopsCV -#define oopsHV PERLoopsHV -#define op_free PERLop_free -#define package PERLpackage -#define pad_alloc PERLpad_alloc -#define pad_allocmy PERLpad_allocmy -#define pad_findmy PERLpad_findmy -#define pad_free PERLpad_free -#define pad_leavemy PERLpad_leavemy -#define pad_reset PERLpad_reset -#define pad_sv PERLpad_sv -#define pad_swipe PERLpad_swipe -#define peep PERLpeep -#define pidgone PERLpidgone -#define pmruntime PERLpmruntime -#define pmtrans PERLpmtrans -#define pop_return PERLpop_return -#define pop_scope PERLpop_scope -#define pp_aassign PERLpp_aassign -#define pp_accept PERLpp_accept -#define pp_add PERLpp_add -#define pp_aelem PERLpp_aelem -#define pp_aelemfast PERLpp_aelemfast -#define pp_alarm PERLpp_alarm -#define pp_and PERLpp_and -#define pp_andassign PERLpp_andassign -#define pp_anonhash PERLpp_anonhash -#define pp_anonlist PERLpp_anonlist -#define pp_aslice PERLpp_aslice -#define pp_atan2 PERLpp_atan2 -#define pp_av2arylen PERLpp_av2arylen -#define pp_backtick PERLpp_backtick -#define pp_bind PERLpp_bind -#define pp_binmode PERLpp_binmode -#define pp_bit_and PERLpp_bit_and -#define pp_bit_or PERLpp_bit_or -#define pp_bless PERLpp_bless -#define pp_caller PERLpp_caller -#define pp_chdir PERLpp_chdir -#define pp_chmod PERLpp_chmod -#define pp_chop PERLpp_chop -#define pp_chown PERLpp_chown -#define pp_chroot PERLpp_chroot -#define pp_close PERLpp_close -#define pp_closedir PERLpp_closedir -#define pp_complement PERLpp_complement -#define pp_concat PERLpp_concat -#define pp_cond_expr PERLpp_cond_expr -#define pp_connect PERLpp_connect -#define pp_const PERLpp_const -#define pp_cos PERLpp_cos -#define pp_crypt PERLpp_crypt -#define pp_cswitch PERLpp_cswitch -#define pp_dbmclose PERLpp_dbmclose -#define pp_dbmopen PERLpp_dbmopen -#define pp_dbstate PERLpp_dbstate -#define pp_defined PERLpp_defined -#define pp_delete PERLpp_delete -#define pp_die PERLpp_die -#define pp_divide PERLpp_divide -#define pp_dofile PERLpp_dofile -#define pp_done PERLpp_done -#define pp_dump PERLpp_dump -#define pp_each PERLpp_each -#define pp_egrent PERLpp_egrent -#define pp_ehostent PERLpp_ehostent -#define pp_enetent PERLpp_enetent -#define pp_enter PERLpp_enter -#define pp_entereval PERLpp_entereval -#define pp_enteriter PERLpp_enteriter -#define pp_enterloop PERLpp_enterloop -#define pp_entersubr PERLpp_entersubr -#define pp_entertry PERLpp_entertry -#define pp_enterwrite PERLpp_enterwrite -#define pp_eof PERLpp_eof -#define pp_eprotoent PERLpp_eprotoent -#define pp_epwent PERLpp_epwent -#define pp_eq PERLpp_eq -#define pp_eservent PERLpp_eservent -#define pp_evalonce PERLpp_evalonce -#define pp_exec PERLpp_exec -#define pp_exit PERLpp_exit -#define pp_exp PERLpp_exp -#define pp_fcntl PERLpp_fcntl -#define pp_fileno PERLpp_fileno -#define pp_flip PERLpp_flip -#define pp_flock PERLpp_flock -#define pp_flop PERLpp_flop -#define pp_fork PERLpp_fork -#define pp_formline PERLpp_formline -#define pp_ftatime PERLpp_ftatime -#define pp_ftbinary PERLpp_ftbinary -#define pp_ftblk PERLpp_ftblk -#define pp_ftchr PERLpp_ftchr -#define pp_ftctime PERLpp_ftctime -#define pp_ftdir PERLpp_ftdir -#define pp_fteexec PERLpp_fteexec -#define pp_fteowned PERLpp_fteowned -#define pp_fteread PERLpp_fteread -#define pp_ftewrite PERLpp_ftewrite -#define pp_ftfile PERLpp_ftfile -#define pp_ftis PERLpp_ftis -#define pp_ftlink PERLpp_ftlink -#define pp_ftmtime PERLpp_ftmtime -#define pp_ftpipe PERLpp_ftpipe -#define pp_ftrexec PERLpp_ftrexec -#define pp_ftrowned PERLpp_ftrowned -#define pp_ftrread PERLpp_ftrread -#define pp_ftrwrite PERLpp_ftrwrite -#define pp_ftsgid PERLpp_ftsgid -#define pp_ftsize PERLpp_ftsize -#define pp_ftsock PERLpp_ftsock -#define pp_ftsuid PERLpp_ftsuid -#define pp_ftsvtx PERLpp_ftsvtx -#define pp_fttext PERLpp_fttext -#define pp_fttty PERLpp_fttty -#define pp_ftzero PERLpp_ftzero -#define pp_ge PERLpp_ge -#define pp_getc PERLpp_getc -#define pp_getlogin PERLpp_getlogin -#define pp_getpeername PERLpp_getpeername -#define pp_getpgrp PERLpp_getpgrp -#define pp_getppid PERLpp_getppid -#define pp_getpriority PERLpp_getpriority -#define pp_getsockname PERLpp_getsockname -#define pp_ggrent PERLpp_ggrent -#define pp_ggrgid PERLpp_ggrgid -#define pp_ggrnam PERLpp_ggrnam -#define pp_ghbyaddr PERLpp_ghbyaddr -#define pp_ghbyname PERLpp_ghbyname -#define pp_ghostent PERLpp_ghostent -#define pp_glob PERLpp_glob -#define pp_gmtime PERLpp_gmtime -#define pp_gnbyaddr PERLpp_gnbyaddr -#define pp_gnbyname PERLpp_gnbyname -#define pp_gnetent PERLpp_gnetent -#define pp_goto PERLpp_goto -#define pp_gpbyname PERLpp_gpbyname -#define pp_gpbynumber PERLpp_gpbynumber -#define pp_gprotoent PERLpp_gprotoent -#define pp_gpwent PERLpp_gpwent -#define pp_gpwnam PERLpp_gpwnam -#define pp_gpwuid PERLpp_gpwuid -#define pp_grepstart PERLpp_grepstart -#define pp_grepwhile PERLpp_grepwhile -#define pp_gsbyname PERLpp_gsbyname -#define pp_gsbyport PERLpp_gsbyport -#define pp_gservent PERLpp_gservent -#define pp_gsockopt PERLpp_gsockopt -#define pp_gt PERLpp_gt -#define pp_gv PERLpp_gv -#define pp_gvsv PERLpp_gvsv -#define pp_helem PERLpp_helem -#define pp_hex PERLpp_hex -#define pp_hslice PERLpp_hslice -#define pp_index PERLpp_index -#define pp_indread PERLpp_indread -#define pp_int PERLpp_int -#define pp_intadd PERLpp_intadd -#define pp_interp PERLpp_interp -#define pp_ioctl PERLpp_ioctl -#define pp_iter PERLpp_iter -#define pp_join PERLpp_join -#define pp_keys PERLpp_keys -#define pp_kill PERLpp_kill -#define pp_last PERLpp_last -#define pp_lc PERLpp_lc -#define pp_lcfirst PERLpp_lcfirst -#define pp_le PERLpp_le -#define pp_leave PERLpp_leave -#define pp_leaveeval PERLpp_leaveeval -#define pp_leaveloop PERLpp_leaveloop -#define pp_leavesubr PERLpp_leavesubr -#define pp_leavetry PERLpp_leavetry -#define pp_leavewrite PERLpp_leavewrite -#define pp_left_shift PERLpp_left_shift -#define pp_length PERLpp_length -#define pp_lineseq PERLpp_lineseq -#define pp_link PERLpp_link -#define pp_list PERLpp_list -#define pp_listen PERLpp_listen -#define pp_localtime PERLpp_localtime -#define pp_log PERLpp_log -#define pp_lslice PERLpp_lslice -#define pp_lstat PERLpp_lstat -#define pp_lt PERLpp_lt -#define pp_match PERLpp_match -#define pp_method PERLpp_method -#define pp_mkdir PERLpp_mkdir -#define pp_modulo PERLpp_modulo -#define pp_msgctl PERLpp_msgctl -#define pp_msgget PERLpp_msgget -#define pp_msgrcv PERLpp_msgrcv -#define pp_msgsnd PERLpp_msgsnd -#define pp_multiply PERLpp_multiply -#define pp_ncmp PERLpp_ncmp -#define pp_ne PERLpp_ne -#define pp_negate PERLpp_negate -#define pp_next PERLpp_next -#define pp_nextstate PERLpp_nextstate -#define pp_not PERLpp_not -#define pp_nswitch PERLpp_nswitch -#define pp_null PERLpp_null -#define pp_oct PERLpp_oct -#define pp_open PERLpp_open -#define pp_open_dir PERLpp_open_dir -#define pp_or PERLpp_or -#define pp_orassign PERLpp_orassign -#define pp_ord PERLpp_ord -#define pp_pack PERLpp_pack -#define pp_padav PERLpp_padav -#define pp_padhv PERLpp_padhv -#define pp_padsv PERLpp_padsv -#define pp_pipe_op PERLpp_pipe_op -#define pp_pop PERLpp_pop -#define pp_postdec PERLpp_postdec -#define pp_postinc PERLpp_postinc -#define pp_pow PERLpp_pow -#define pp_predec PERLpp_predec -#define pp_preinc PERLpp_preinc -#define pp_print PERLpp_print -#define pp_prtf PERLpp_prtf -#define pp_push PERLpp_push -#define pp_pushmark PERLpp_pushmark -#define pp_pushre PERLpp_pushre -#define pp_rand PERLpp_rand -#define pp_range PERLpp_range -#define pp_rcatline PERLpp_rcatline -#define pp_read PERLpp_read -#define pp_readdir PERLpp_readdir -#define pp_readline PERLpp_readline -#define pp_readlink PERLpp_readlink -#define pp_recv PERLpp_recv -#define pp_redo PERLpp_redo -#define pp_ref PERLpp_ref -#define pp_refgen PERLpp_refgen -#define pp_regcmaybe PERLpp_regcmaybe -#define pp_regcomp PERLpp_regcomp -#define pp_rename PERLpp_rename -#define pp_repeat PERLpp_repeat -#define pp_require PERLpp_require -#define pp_reset PERLpp_reset -#define pp_return PERLpp_return -#define pp_reverse PERLpp_reverse -#define pp_rewinddir PERLpp_rewinddir -#define pp_right_shift PERLpp_right_shift -#define pp_rindex PERLpp_rindex -#define pp_rmdir PERLpp_rmdir -#define pp_rv2av PERLpp_rv2av -#define pp_rv2cv PERLpp_rv2cv -#define pp_rv2gv PERLpp_rv2gv -#define pp_rv2hv PERLpp_rv2hv -#define pp_rv2sv PERLpp_rv2sv -#define pp_sassign PERLpp_sassign -#define pp_scalar PERLpp_scalar -#define pp_schop PERLpp_schop -#define pp_scmp PERLpp_scmp -#define pp_scope PERLpp_scope -#define pp_seek PERLpp_seek -#define pp_seekdir PERLpp_seekdir -#define pp_select PERLpp_select -#define pp_semctl PERLpp_semctl -#define pp_semget PERLpp_semget -#define pp_semop PERLpp_semop -#define pp_send PERLpp_send -#define pp_seq PERLpp_seq -#define pp_setpgrp PERLpp_setpgrp -#define pp_setpriority PERLpp_setpriority -#define pp_sge PERLpp_sge -#define pp_sgrent PERLpp_sgrent -#define pp_sgt PERLpp_sgt -#define pp_shift PERLpp_shift -#define pp_shmctl PERLpp_shmctl -#define pp_shmget PERLpp_shmget -#define pp_shmread PERLpp_shmread -#define pp_shmwrite PERLpp_shmwrite -#define pp_shostent PERLpp_shostent -#define pp_shutdown PERLpp_shutdown -#define pp_sin PERLpp_sin -#define pp_sle PERLpp_sle -#define pp_sleep PERLpp_sleep -#define pp_slt PERLpp_slt -#define pp_sne PERLpp_sne -#define pp_snetent PERLpp_snetent -#define pp_socket PERLpp_socket -#define pp_sockpair PERLpp_sockpair -#define pp_sort PERLpp_sort -#define pp_splice PERLpp_splice -#define pp_split PERLpp_split -#define pp_sprintf PERLpp_sprintf -#define pp_sprotoent PERLpp_sprotoent -#define pp_spwent PERLpp_spwent -#define pp_sqrt PERLpp_sqrt -#define pp_srand PERLpp_srand -#define pp_sselect PERLpp_sselect -#define pp_sservent PERLpp_sservent -#define pp_ssockopt PERLpp_ssockopt -#define pp_stat PERLpp_stat -#define pp_stub PERLpp_stub -#define pp_study PERLpp_study -#define pp_subst PERLpp_subst -#define pp_substcont PERLpp_substcont -#define pp_substr PERLpp_substr -#define pp_subtract PERLpp_subtract -#define pp_sv2len PERLpp_sv2len -#define pp_symlink PERLpp_symlink -#define pp_syscall PERLpp_syscall -#define pp_sysread PERLpp_sysread -#define pp_system PERLpp_system -#define pp_syswrite PERLpp_syswrite -#define pp_tell PERLpp_tell -#define pp_telldir PERLpp_telldir -#define pp_tie PERLpp_tie -#define pp_time PERLpp_time -#define pp_tms PERLpp_tms -#define pp_trans PERLpp_trans -#define pp_truncate PERLpp_truncate -#define pp_uc PERLpp_uc -#define pp_ucfirst PERLpp_ucfirst -#define pp_umask PERLpp_umask -#define pp_undef PERLpp_undef -#define pp_unlink PERLpp_unlink -#define pp_unpack PERLpp_unpack -#define pp_unshift PERLpp_unshift -#define pp_unstack PERLpp_unstack -#define pp_untie PERLpp_untie -#define pp_utime PERLpp_utime -#define pp_values PERLpp_values -#define pp_vec PERLpp_vec -#define pp_wait PERLpp_wait -#define pp_waitpid PERLpp_waitpid -#define pp_wantarray PERLpp_wantarray -#define pp_warn PERLpp_warn -#define pp_xor PERLpp_xor -#define prepend_elem PERLprepend_elem -#define push_return PERLpush_return -#define push_scope PERLpush_scope -#define pv_grow PERLpv_grow -#define q PERLq -#define ref PERLref -#define refkids PERLrefkids -#define regcomp PERLregcomp -#define regdump PERLregdump -#define regexec PERLregexec -#define regfree PERLregfree -#define regnext PERLregnext -#define regprop PERLregprop -#define repeatcpy PERLrepeatcpy -#define rninstr PERLrninstr -#define run PERLrun -#define save_I32 PERLsave_I32 -#define save_aptr PERLsave_aptr -#define save_ary PERLsave_ary -#define save_hash PERLsave_hash -#define save_hptr PERLsave_hptr -#define save_int PERLsave_int -#define save_item PERLsave_item -#define save_list PERLsave_list -#define save_nogv PERLsave_nogv -#define save_scalar PERLsave_scalar -#define save_sptr PERLsave_sptr -#define save_svref PERLsave_svref -#define savestack_grow PERLsavestack_grow -#define savestr PERLsavestr -#define sawparens PERLsawparens -#define scalar PERLscalar -#define scalarkids PERLscalarkids -#define scalarseq PERLscalarseq -#define scalarvoid PERLscalarvoid -#define scan_const PERLscan_const -#define scan_formline PERLscan_formline -#define scan_heredoc PERLscan_heredoc -#define scan_hex PERLscan_hex -#define scan_ident PERLscan_ident -#define scan_inputsymbol PERLscan_inputsymbol -#define scan_num PERLscan_num -#define scan_oct PERLscan_oct -#define scan_pat PERLscan_pat -#define scan_prefix PERLscan_prefix -#define scan_str PERLscan_str -#define scan_subst PERLscan_subst -#define scan_trans PERLscan_trans -#define scan_word PERLscan_word -#define scope PERLscope -#define screaminstr PERLscreaminstr -#define setenv_getix PERLsetenv_getix -#define skipspace PERLskipspace -#define sublex_done PERLsublex_done -#define sublex_start PERLsublex_start -#define sv_2bool PERLsv_2bool -#define sv_2cv PERLsv_2cv -#define sv_2iv PERLsv_2iv -#define sv_2mortal PERLsv_2mortal -#define sv_2nv PERLsv_2nv -#define sv_2pv PERLsv_2pv -#define sv_backoff PERLsv_backoff -#define sv_catpv PERLsv_catpv -#define sv_catpvn PERLsv_catpvn -#define sv_catsv PERLsv_catsv -#define sv_chop PERLsv_chop -#define sv_clear PERLsv_clear -#define sv_cmp PERLsv_cmp -#define sv_dec PERLsv_dec -#define sv_eq PERLsv_eq -#define sv_free PERLsv_free -#define sv_gets PERLsv_gets -#define sv_grow PERLsv_grow -#define sv_inc PERLsv_inc -#define sv_insert PERLsv_insert -#define sv_isa PERLsv_isa -#define sv_len PERLsv_len -#define sv_magic PERLsv_magic -#define sv_mortalcopy PERLsv_mortalcopy -#define sv_peek PERLsv_peek -#define sv_ref PERLsv_ref -#define sv_replace PERLsv_replace -#define sv_reset PERLsv_reset -#define sv_setiv PERLsv_setiv -#define sv_setnv PERLsv_setnv -#define sv_setptrobj PERLsv_setptrobj -#define sv_setpv PERLsv_setpv -#define sv_setpvn PERLsv_setpvn -#define sv_setsv PERLsv_setsv -#define sv_unmagic PERLsv_unmagic -#define sv_upgrade PERLsv_upgrade -#define sv_usepvn PERLsv_usepvn -#define taint_env PERLtaint_env -#define taint_not PERLtaint_not -#define taint_proper PERLtaint_proper -#define too_few_arguments PERLtoo_few_arguments -#define too_many_arguments PERLtoo_many_arguments -#define wait4pid PERLwait4pid -#define warn PERLwarn -#define watch PERLwatch -#define whichsig PERLwhichsig -#define yyerror PERLyyerror -#define yylex PERLyylex -#define yyparse PERLyyparse +#define No perl_No +#define Sv perl_Sv +#define Xpv perl_Xpv +#define Yes perl_Yes +#define additem perl_additem +#define an perl_an +#define buf perl_buf +#define bufend perl_bufend +#define bufptr perl_bufptr +#define check perl_check +#define coeff perl_coeff +#define compiling perl_compiling +#define comppad perl_comppad +#define comppad_name perl_comppad_name +#define comppad_name_fill perl_comppad_name_fill +#define cop_seqmax perl_cop_seqmax +#define cryptseen perl_cryptseen +#define cshlen perl_cshlen +#define cshname perl_cshname +#define curinterp perl_curinterp +#define curpad perl_curpad +#define dc perl_dc +#define di perl_di +#define ds perl_ds +#define egid perl_egid +#define error_count perl_error_count +#define euid perl_euid +#define evalseq perl_evalseq +#define evstr perl_evstr +#define expect perl_expect +#define expectterm perl_expectterm +#define fold perl_fold +#define freq perl_freq +#define gid perl_gid +#define hexdigit perl_hexdigit +#define in_format perl_in_format +#define in_my perl_in_my +#define know_next perl_know_next +#define last_lop perl_last_lop +#define last_lop_op perl_last_lop_op +#define last_uni perl_last_uni +#define linestr perl_linestr +#define markstack perl_markstack +#define markstack_max perl_markstack_max +#define markstack_ptr perl_markstack_ptr +#define max_intro_pending perl_max_intro_pending +#define min_intro_pending perl_min_intro_pending +#define multi_close perl_multi_close +#define multi_end perl_multi_end +#define multi_open perl_multi_open +#define multi_start perl_multi_start +#define na perl_na +#define needblockscope perl_needblockscope +#define nexttype perl_nexttype +#define nextval perl_nextval +#define no_aelem perl_no_aelem +#define no_dir_func perl_no_dir_func +#define no_func perl_no_func +#define no_helem perl_no_helem +#define no_mem perl_no_mem +#define no_modify perl_no_modify +#define no_security perl_no_security +#define no_sock_func perl_no_sock_func +#define no_usym perl_no_usym +#define nointrp perl_nointrp +#define nomem perl_nomem +#define nomemok perl_nomemok +#define oldbufptr perl_oldbufptr +#define oldoldbufptr perl_oldoldbufptr +#define op perl_op +#define op_name perl_op_name +#define op_seqmax perl_op_seqmax +#define opargs perl_opargs +#define origalen perl_origalen +#define origenviron perl_origenviron +#define padix perl_padix +#define patleave perl_patleave +#define ppaddr perl_ppaddr +#define rcsid perl_rcsid +#define reall_srchlen perl_reall_srchlen +#define regarglen perl_regarglen +#define regbol perl_regbol +#define regcode perl_regcode +#define regdummy perl_regdummy +#define regendp perl_regendp +#define regeol perl_regeol +#define regfold perl_regfold +#define reginput perl_reginput +#define reglastparen perl_reglastparen +#define regmyendp perl_regmyendp +#define regmyp_size perl_regmyp_size +#define regmystartp perl_regmystartp +#define regnarrate perl_regnarrate +#define regnpar perl_regnpar +#define regparse perl_regparse +#define regprecomp perl_regprecomp +#define regprev perl_regprev +#define regsawback perl_regsawback +#define regsawbracket perl_regsawbracket +#define regsize perl_regsize +#define regstartp perl_regstartp +#define regtill perl_regtill +#define regxend perl_regxend +#define retstack perl_retstack +#define retstack_ix perl_retstack_ix +#define retstack_max perl_retstack_max +#define rsfp perl_rsfp +#define savestack perl_savestack +#define savestack_ix perl_savestack_ix +#define savestack_max perl_savestack_max +#define saw_return perl_saw_return +#define scopestack perl_scopestack +#define scopestack_ix perl_scopestack_ix +#define scopestack_max perl_scopestack_max +#define scrgv perl_scrgv +#define sig_name perl_sig_name +#define simple perl_simple +#define stack_base perl_stack_base +#define stack_max perl_stack_max +#define stack_sp perl_stack_sp +#define statbuf perl_statbuf +#define sub_generation perl_sub_generation +#define subline perl_subline +#define subname perl_subname +#define sv_no perl_sv_no +#define sv_undef perl_sv_undef +#define sv_yes perl_sv_yes +#define thisexpr perl_thisexpr +#define timesbuf perl_timesbuf +#define tokenbuf perl_tokenbuf +#define uid perl_uid +#define varies perl_varies +#define vert perl_vert +#define vtbl_arylen perl_vtbl_arylen +#define vtbl_bm perl_vtbl_bm +#define vtbl_dbline perl_vtbl_dbline +#define vtbl_env perl_vtbl_env +#define vtbl_envelem perl_vtbl_envelem +#define vtbl_glob perl_vtbl_glob +#define vtbl_isa perl_vtbl_isa +#define vtbl_isaelem perl_vtbl_isaelem +#define vtbl_mglob perl_vtbl_mglob +#define vtbl_pack perl_vtbl_pack +#define vtbl_packelem perl_vtbl_packelem +#define vtbl_sig perl_vtbl_sig +#define vtbl_sigelem perl_vtbl_sigelem +#define vtbl_substr perl_vtbl_substr +#define vtbl_sv perl_vtbl_sv +#define vtbl_taint perl_vtbl_taint +#define vtbl_uvar perl_vtbl_uvar +#define vtbl_vec perl_vtbl_vec +#define warn_nl perl_warn_nl +#define warn_nosemi perl_warn_nosemi +#define warn_reserved perl_warn_reserved +#define watchaddr perl_watchaddr +#define watchok perl_watchok +#define yychar perl_yychar +#define yycheck perl_yycheck +#define yydebug perl_yydebug +#define yydefred perl_yydefred +#define yydgoto perl_yydgoto +#define yyerrflag perl_yyerrflag +#define yygindex perl_yygindex +#define yylen perl_yylen +#define yylhs perl_yylhs +#define yylval perl_yylval +#define yyname perl_yyname +#define yynerrs perl_yynerrs +#define yyrindex perl_yyrindex +#define yyrule perl_yyrule +#define yysindex perl_yysindex +#define yytable perl_yytable +#define yyval perl_yyval +#define append_elem perl_append_elem +#define append_list perl_append_list +#define apply perl_apply +#define av_clear perl_av_clear +#define av_fake perl_av_fake +#define av_fetch perl_av_fetch +#define av_fill perl_av_fill +#define av_free perl_av_free +#define av_len perl_av_len +#define av_make perl_av_make +#define av_pop perl_av_pop +#define av_popnulls perl_av_popnulls +#define av_push perl_av_push +#define av_shift perl_av_shift +#define av_store perl_av_store +#define av_undef perl_av_undef +#define av_unshift perl_av_unshift +#define bind_match perl_bind_match +#define block_head perl_block_head +#define calllist perl_calllist +#define cando perl_cando +#define check_uni perl_check_uni +#define checkcomma perl_checkcomma +#define ck_aelem perl_ck_aelem +#define ck_chop perl_ck_chop +#define ck_concat perl_ck_concat +#define ck_eof perl_ck_eof +#define ck_eval perl_ck_eval +#define ck_exec perl_ck_exec +#define ck_formline perl_ck_formline +#define ck_ftst perl_ck_ftst +#define ck_fun perl_ck_fun +#define ck_glob perl_ck_glob +#define ck_grep perl_ck_grep +#define ck_gvconst perl_ck_gvconst +#define ck_index perl_ck_index +#define ck_lengthconst perl_ck_lengthconst +#define ck_lfun perl_ck_lfun +#define ck_listiob perl_ck_listiob +#define ck_match perl_ck_match +#define ck_null perl_ck_null +#define ck_repeat perl_ck_repeat +#define ck_retarget perl_ck_retarget +#define ck_rvconst perl_ck_rvconst +#define ck_select perl_ck_select +#define ck_shift perl_ck_shift +#define ck_sort perl_ck_sort +#define ck_split perl_ck_split +#define ck_subr perl_ck_subr +#define ck_trunc perl_ck_trunc +#define convert perl_convert +#define cpy7bit perl_cpy7bit +#define cpytill perl_cpytill +#define croak perl_croak +#define cv_clear perl_cv_clear +#define cxinc perl_cxinc +#define deb perl_deb +#define deb_growlevel perl_deb_growlevel +#define debop perl_debop +#define debstack perl_debstack +#define debstackptrs perl_debstackptrs +#define die perl_die +#define die_where perl_die_where +#define do_aexec perl_do_aexec +#define do_chop perl_do_chop +#define do_close perl_do_close +#define do_ctl perl_do_ctl +#define do_eof perl_do_eof +#define do_exec perl_do_exec +#define do_execfree perl_do_execfree +#define do_ipcctl perl_do_ipcctl +#define do_ipcget perl_do_ipcget +#define do_join perl_do_join +#define do_kv perl_do_kv +#define do_msgrcv perl_do_msgrcv +#define do_msgsnd perl_do_msgsnd +#define do_open perl_do_open +#define do_pipe perl_do_pipe +#define do_print perl_do_print +#define do_readline perl_do_readline +#define do_seek perl_do_seek +#define do_semop perl_do_semop +#define do_shmio perl_do_shmio +#define do_sprintf perl_do_sprintf +#define do_tell perl_do_tell +#define do_trans perl_do_trans +#define do_vecset perl_do_vecset +#define do_vop perl_do_vop +#define doeval perl_doeval +#define dofindlabel perl_dofindlabel +#define dopoptoeval perl_dopoptoeval +#define dump_all perl_dump_all +#define dump_eval perl_dump_eval +#define dump_gv perl_dump_gv +#define dump_op perl_dump_op +#define dump_packsubs perl_dump_packsubs +#define dump_pm perl_dump_pm +#define dump_sub perl_dump_sub +#define fbm_compile perl_fbm_compile +#define fbm_instr perl_fbm_instr +#define fetch_gv perl_fetch_gv +#define fetch_io perl_fetch_io +#define fetch_stash perl_fetch_stash +#define fold_constants perl_fold_constants +#define force_ident perl_force_ident +#define force_next perl_force_next +#define force_word perl_force_word +#define free_tmps perl_free_tmps +#define gen_constant_list perl_gen_constant_list +#define getgimme perl_getgimme +#define gp_free perl_gp_free +#define gp_ref perl_gp_ref +#define gv_AVadd perl_gv_AVadd +#define gv_HVadd perl_gv_HVadd +#define gv_check perl_gv_check +#define gv_efullname perl_gv_efullname +#define gv_fetchfile perl_gv_fetchfile +#define gv_fetchmeth perl_gv_fetchmeth +#define gv_fetchmethod perl_gv_fetchmethod +#define gv_fetchpv perl_gv_fetchpv +#define gv_fullname perl_gv_fullname +#define gv_init perl_gv_init +#define he_delayfree perl_he_delayfree +#define he_free perl_he_free +#define hoistmust perl_hoistmust +#define hv_clear perl_hv_clear +#define hv_delete perl_hv_delete +#define hv_fetch perl_hv_fetch +#define hv_free perl_hv_free +#define hv_iterinit perl_hv_iterinit +#define hv_iterkey perl_hv_iterkey +#define hv_iternext perl_hv_iternext +#define hv_iterval perl_hv_iterval +#define hv_magic perl_hv_magic +#define hv_store perl_hv_store +#define hv_undef perl_hv_undef +#define ibcmp perl_ibcmp +#define ingroup perl_ingroup +#define instr perl_instr +#define intuit_more perl_intuit_more +#define invert perl_invert +#define jmaybe perl_jmaybe +#define keyword perl_keyword +#define leave_scope perl_leave_scope +#define lex_end perl_lex_end +#define lex_start perl_lex_start +#define linklist perl_linklist +#define list perl_list +#define listkids perl_listkids +#define localize perl_localize +#define looks_like_number perl_looks_like_number +#define magic_clearpack perl_magic_clearpack +#define magic_get perl_magic_get +#define magic_getarylen perl_magic_getarylen +#define magic_getglob perl_magic_getglob +#define magic_getpack perl_magic_getpack +#define magic_gettaint perl_magic_gettaint +#define magic_getuvar perl_magic_getuvar +#define magic_len perl_magic_len +#define magic_nextpack perl_magic_nextpack +#define magic_set perl_magic_set +#define magic_setarylen perl_magic_setarylen +#define magic_setbm perl_magic_setbm +#define magic_setdbline perl_magic_setdbline +#define magic_setenv perl_magic_setenv +#define magic_setglob perl_magic_setglob +#define magic_setisa perl_magic_setisa +#define magic_setmglob perl_magic_setmglob +#define magic_setpack perl_magic_setpack +#define magic_setsig perl_magic_setsig +#define magic_setsubstr perl_magic_setsubstr +#define magic_settaint perl_magic_settaint +#define magic_setuvar perl_magic_setuvar +#define magic_setvec perl_magic_setvec +#define magicname perl_magicname +#define mess perl_mess +#define mg_clear perl_mg_clear +#define mg_copy perl_mg_copy +#define mg_find perl_mg_find +#define mg_free perl_mg_free +#define mg_get perl_mg_get +#define mg_len perl_mg_len +#define mg_magical perl_mg_magical +#define mg_set perl_mg_set +#define mod perl_mod +#define modkids perl_modkids +#define moreswitches perl_moreswitches +#define my perl_my +#define my_exit perl_my_exit +#define my_lstat perl_my_lstat +#define my_pclose perl_my_pclose +#define my_popen perl_my_popen +#define my_setenv perl_my_setenv +#define my_stat perl_my_stat +#define my_unexec perl_my_unexec +#define newANONHASH perl_newANONHASH +#define newANONLIST perl_newANONLIST +#define newASSIGNOP perl_newASSIGNOP +#define newAV perl_newAV +#define newAVREF perl_newAVREF +#define newBINOP perl_newBINOP +#define newCONDOP perl_newCONDOP +#define newCVOP perl_newCVOP +#define newCVREF perl_newCVREF +#define newFORM perl_newFORM +#define newFOROP perl_newFOROP +#define newGVOP perl_newGVOP +#define newGVREF perl_newGVREF +#define newGVgen perl_newGVgen +#define newHV perl_newHV +#define newHVREF perl_newHVREF +#define newIO perl_newIO +#define newLISTOP perl_newLISTOP +#define newLOGOP perl_newLOGOP +#define newLOOPEX perl_newLOOPEX +#define newLOOPOP perl_newLOOPOP +#define newMETHOD perl_newMETHOD +#define newNULLLIST perl_newNULLLIST +#define newOP perl_newOP +#define newPMOP perl_newPMOP +#define newPVOP perl_newPVOP +#define newRANGE perl_newRANGE +#define newSLICEOP perl_newSLICEOP +#define newSTATEOP perl_newSTATEOP +#define newSUB perl_newSUB +#define newSV perl_newSV +#define newSVOP perl_newSVOP +#define newSVREF perl_newSVREF +#define newSViv perl_newSViv +#define newSVnv perl_newSVnv +#define newSVpv perl_newSVpv +#define newSVsv perl_newSVsv +#define newUNOP perl_newUNOP +#define newWHILEOP perl_newWHILEOP +#define newXSUB perl_newXSUB +#define nextargv perl_nextargv +#define ninstr perl_ninstr +#define no_fh_allowed perl_no_fh_allowed +#define no_op perl_no_op +#define nsavestr perl_nsavestr +#define oopsAV perl_oopsAV +#define oopsCV perl_oopsCV +#define oopsHV perl_oopsHV +#define op_free perl_op_free +#define package perl_package +#define pad_alloc perl_pad_alloc +#define pad_allocmy perl_pad_allocmy +#define pad_findmy perl_pad_findmy +#define pad_free perl_pad_free +#define pad_leavemy perl_pad_leavemy +#define pad_reset perl_pad_reset +#define pad_sv perl_pad_sv +#define pad_swipe perl_pad_swipe +#define peep perl_peep +#define pidgone perl_pidgone +#define pmruntime perl_pmruntime +#define pmtrans perl_pmtrans +#define pop_return perl_pop_return +#define pop_scope perl_pop_scope +#define pp_aassign perl_pp_aassign +#define pp_accept perl_pp_accept +#define pp_add perl_pp_add +#define pp_aelem perl_pp_aelem +#define pp_aelemfast perl_pp_aelemfast +#define pp_alarm perl_pp_alarm +#define pp_and perl_pp_and +#define pp_andassign perl_pp_andassign +#define pp_anonhash perl_pp_anonhash +#define pp_anonlist perl_pp_anonlist +#define pp_aslice perl_pp_aslice +#define pp_atan2 perl_pp_atan2 +#define pp_av2arylen perl_pp_av2arylen +#define pp_backtick perl_pp_backtick +#define pp_bind perl_pp_bind +#define pp_binmode perl_pp_binmode +#define pp_bit_and perl_pp_bit_and +#define pp_bit_or perl_pp_bit_or +#define pp_bless perl_pp_bless +#define pp_caller perl_pp_caller +#define pp_chdir perl_pp_chdir +#define pp_chmod perl_pp_chmod +#define pp_chop perl_pp_chop +#define pp_chown perl_pp_chown +#define pp_chroot perl_pp_chroot +#define pp_close perl_pp_close +#define pp_closedir perl_pp_closedir +#define pp_complement perl_pp_complement +#define pp_concat perl_pp_concat +#define pp_cond_expr perl_pp_cond_expr +#define pp_connect perl_pp_connect +#define pp_const perl_pp_const +#define pp_cos perl_pp_cos +#define pp_crypt perl_pp_crypt +#define pp_cswitch perl_pp_cswitch +#define pp_dbmclose perl_pp_dbmclose +#define pp_dbmopen perl_pp_dbmopen +#define pp_dbstate perl_pp_dbstate +#define pp_defined perl_pp_defined +#define pp_delete perl_pp_delete +#define pp_die perl_pp_die +#define pp_divide perl_pp_divide +#define pp_dofile perl_pp_dofile +#define pp_done perl_pp_done +#define pp_dump perl_pp_dump +#define pp_each perl_pp_each +#define pp_egrent perl_pp_egrent +#define pp_ehostent perl_pp_ehostent +#define pp_enetent perl_pp_enetent +#define pp_enter perl_pp_enter +#define pp_entereval perl_pp_entereval +#define pp_enteriter perl_pp_enteriter +#define pp_enterloop perl_pp_enterloop +#define pp_entersubr perl_pp_entersubr +#define pp_entertry perl_pp_entertry +#define pp_enterwrite perl_pp_enterwrite +#define pp_eof perl_pp_eof +#define pp_eprotoent perl_pp_eprotoent +#define pp_epwent perl_pp_epwent +#define pp_eq perl_pp_eq +#define pp_eservent perl_pp_eservent +#define pp_evalonce perl_pp_evalonce +#define pp_exec perl_pp_exec +#define pp_exit perl_pp_exit +#define pp_exp perl_pp_exp +#define pp_fcntl perl_pp_fcntl +#define pp_fileno perl_pp_fileno +#define pp_flip perl_pp_flip +#define pp_flock perl_pp_flock +#define pp_flop perl_pp_flop +#define pp_fork perl_pp_fork +#define pp_formline perl_pp_formline +#define pp_ftatime perl_pp_ftatime +#define pp_ftbinary perl_pp_ftbinary +#define pp_ftblk perl_pp_ftblk +#define pp_ftchr perl_pp_ftchr +#define pp_ftctime perl_pp_ftctime +#define pp_ftdir perl_pp_ftdir +#define pp_fteexec perl_pp_fteexec +#define pp_fteowned perl_pp_fteowned +#define pp_fteread perl_pp_fteread +#define pp_ftewrite perl_pp_ftewrite +#define pp_ftfile perl_pp_ftfile +#define pp_ftis perl_pp_ftis +#define pp_ftlink perl_pp_ftlink +#define pp_ftmtime perl_pp_ftmtime +#define pp_ftpipe perl_pp_ftpipe +#define pp_ftrexec perl_pp_ftrexec +#define pp_ftrowned perl_pp_ftrowned +#define pp_ftrread perl_pp_ftrread +#define pp_ftrwrite perl_pp_ftrwrite +#define pp_ftsgid perl_pp_ftsgid +#define pp_ftsize perl_pp_ftsize +#define pp_ftsock perl_pp_ftsock +#define pp_ftsuid perl_pp_ftsuid +#define pp_ftsvtx perl_pp_ftsvtx +#define pp_fttext perl_pp_fttext +#define pp_fttty perl_pp_fttty +#define pp_ftzero perl_pp_ftzero +#define pp_ge perl_pp_ge +#define pp_getc perl_pp_getc +#define pp_getlogin perl_pp_getlogin +#define pp_getpeername perl_pp_getpeername +#define pp_getpgrp perl_pp_getpgrp +#define pp_getppid perl_pp_getppid +#define pp_getpriority perl_pp_getpriority +#define pp_getsockname perl_pp_getsockname +#define pp_ggrent perl_pp_ggrent +#define pp_ggrgid perl_pp_ggrgid +#define pp_ggrnam perl_pp_ggrnam +#define pp_ghbyaddr perl_pp_ghbyaddr +#define pp_ghbyname perl_pp_ghbyname +#define pp_ghostent perl_pp_ghostent +#define pp_glob perl_pp_glob +#define pp_gmtime perl_pp_gmtime +#define pp_gnbyaddr perl_pp_gnbyaddr +#define pp_gnbyname perl_pp_gnbyname +#define pp_gnetent perl_pp_gnetent +#define pp_goto perl_pp_goto +#define pp_gpbyname perl_pp_gpbyname +#define pp_gpbynumber perl_pp_gpbynumber +#define pp_gprotoent perl_pp_gprotoent +#define pp_gpwent perl_pp_gpwent +#define pp_gpwnam perl_pp_gpwnam +#define pp_gpwuid perl_pp_gpwuid +#define pp_grepstart perl_pp_grepstart +#define pp_grepwhile perl_pp_grepwhile +#define pp_gsbyname perl_pp_gsbyname +#define pp_gsbyport perl_pp_gsbyport +#define pp_gservent perl_pp_gservent +#define pp_gsockopt perl_pp_gsockopt +#define pp_gt perl_pp_gt +#define pp_gv perl_pp_gv +#define pp_gvsv perl_pp_gvsv +#define pp_helem perl_pp_helem +#define pp_hex perl_pp_hex +#define pp_hslice perl_pp_hslice +#define pp_index perl_pp_index +#define pp_indread perl_pp_indread +#define pp_int perl_pp_int +#define pp_intadd perl_pp_intadd +#define pp_interp perl_pp_interp +#define pp_ioctl perl_pp_ioctl +#define pp_iter perl_pp_iter +#define pp_join perl_pp_join +#define pp_keys perl_pp_keys +#define pp_kill perl_pp_kill +#define pp_last perl_pp_last +#define pp_lc perl_pp_lc +#define pp_lcfirst perl_pp_lcfirst +#define pp_le perl_pp_le +#define pp_leave perl_pp_leave +#define pp_leaveeval perl_pp_leaveeval +#define pp_leaveloop perl_pp_leaveloop +#define pp_leavesubr perl_pp_leavesubr +#define pp_leavetry perl_pp_leavetry +#define pp_leavewrite perl_pp_leavewrite +#define pp_left_shift perl_pp_left_shift +#define pp_length perl_pp_length +#define pp_lineseq perl_pp_lineseq +#define pp_link perl_pp_link +#define pp_list perl_pp_list +#define pp_listen perl_pp_listen +#define pp_localtime perl_pp_localtime +#define pp_log perl_pp_log +#define pp_lslice perl_pp_lslice +#define pp_lstat perl_pp_lstat +#define pp_lt perl_pp_lt +#define pp_match perl_pp_match +#define pp_method perl_pp_method +#define pp_mkdir perl_pp_mkdir +#define pp_modulo perl_pp_modulo +#define pp_msgctl perl_pp_msgctl +#define pp_msgget perl_pp_msgget +#define pp_msgrcv perl_pp_msgrcv +#define pp_msgsnd perl_pp_msgsnd +#define pp_multiply perl_pp_multiply +#define pp_ncmp perl_pp_ncmp +#define pp_ne perl_pp_ne +#define pp_negate perl_pp_negate +#define pp_next perl_pp_next +#define pp_nextstate perl_pp_nextstate +#define pp_not perl_pp_not +#define pp_nswitch perl_pp_nswitch +#define pp_null perl_pp_null +#define pp_oct perl_pp_oct +#define pp_open perl_pp_open +#define pp_open_dir perl_pp_open_dir +#define pp_or perl_pp_or +#define pp_orassign perl_pp_orassign +#define pp_ord perl_pp_ord +#define pp_pack perl_pp_pack +#define pp_padav perl_pp_padav +#define pp_padhv perl_pp_padhv +#define pp_padsv perl_pp_padsv +#define pp_pipe_op perl_pp_pipe_op +#define pp_pop perl_pp_pop +#define pp_postdec perl_pp_postdec +#define pp_postinc perl_pp_postinc +#define pp_pow perl_pp_pow +#define pp_predec perl_pp_predec +#define pp_preinc perl_pp_preinc +#define pp_print perl_pp_print +#define pp_prtf perl_pp_prtf +#define pp_push perl_pp_push +#define pp_pushmark perl_pp_pushmark +#define pp_pushre perl_pp_pushre +#define pp_rand perl_pp_rand +#define pp_range perl_pp_range +#define pp_rcatline perl_pp_rcatline +#define pp_read perl_pp_read +#define pp_readdir perl_pp_readdir +#define pp_readline perl_pp_readline +#define pp_readlink perl_pp_readlink +#define pp_recv perl_pp_recv +#define pp_redo perl_pp_redo +#define pp_ref perl_pp_ref +#define pp_refgen perl_pp_refgen +#define pp_regcmaybe perl_pp_regcmaybe +#define pp_regcomp perl_pp_regcomp +#define pp_rename perl_pp_rename +#define pp_repeat perl_pp_repeat +#define pp_require perl_pp_require +#define pp_reset perl_pp_reset +#define pp_return perl_pp_return +#define pp_reverse perl_pp_reverse +#define pp_rewinddir perl_pp_rewinddir +#define pp_right_shift perl_pp_right_shift +#define pp_rindex perl_pp_rindex +#define pp_rmdir perl_pp_rmdir +#define pp_rv2av perl_pp_rv2av +#define pp_rv2cv perl_pp_rv2cv +#define pp_rv2gv perl_pp_rv2gv +#define pp_rv2hv perl_pp_rv2hv +#define pp_rv2sv perl_pp_rv2sv +#define pp_sassign perl_pp_sassign +#define pp_scalar perl_pp_scalar +#define pp_schop perl_pp_schop +#define pp_scmp perl_pp_scmp +#define pp_scope perl_pp_scope +#define pp_seek perl_pp_seek +#define pp_seekdir perl_pp_seekdir +#define pp_select perl_pp_select +#define pp_semctl perl_pp_semctl +#define pp_semget perl_pp_semget +#define pp_semop perl_pp_semop +#define pp_send perl_pp_send +#define pp_seq perl_pp_seq +#define pp_setpgrp perl_pp_setpgrp +#define pp_setpriority perl_pp_setpriority +#define pp_sge perl_pp_sge +#define pp_sgrent perl_pp_sgrent +#define pp_sgt perl_pp_sgt +#define pp_shift perl_pp_shift +#define pp_shmctl perl_pp_shmctl +#define pp_shmget perl_pp_shmget +#define pp_shmread perl_pp_shmread +#define pp_shmwrite perl_pp_shmwrite +#define pp_shostent perl_pp_shostent +#define pp_shutdown perl_pp_shutdown +#define pp_sin perl_pp_sin +#define pp_sle perl_pp_sle +#define pp_sleep perl_pp_sleep +#define pp_slt perl_pp_slt +#define pp_sne perl_pp_sne +#define pp_snetent perl_pp_snetent +#define pp_socket perl_pp_socket +#define pp_sockpair perl_pp_sockpair +#define pp_sort perl_pp_sort +#define pp_splice perl_pp_splice +#define pp_split perl_pp_split +#define pp_sprintf perl_pp_sprintf +#define pp_sprotoent perl_pp_sprotoent +#define pp_spwent perl_pp_spwent +#define pp_sqrt perl_pp_sqrt +#define pp_srand perl_pp_srand +#define pp_sselect perl_pp_sselect +#define pp_sservent perl_pp_sservent +#define pp_ssockopt perl_pp_ssockopt +#define pp_stat perl_pp_stat +#define pp_stub perl_pp_stub +#define pp_study perl_pp_study +#define pp_subst perl_pp_subst +#define pp_substcont perl_pp_substcont +#define pp_substr perl_pp_substr +#define pp_subtract perl_pp_subtract +#define pp_sv2len perl_pp_sv2len +#define pp_symlink perl_pp_symlink +#define pp_syscall perl_pp_syscall +#define pp_sysread perl_pp_sysread +#define pp_system perl_pp_system +#define pp_syswrite perl_pp_syswrite +#define pp_tell perl_pp_tell +#define pp_telldir perl_pp_telldir +#define pp_tie perl_pp_tie +#define pp_time perl_pp_time +#define pp_tms perl_pp_tms +#define pp_trans perl_pp_trans +#define pp_truncate perl_pp_truncate +#define pp_uc perl_pp_uc +#define pp_ucfirst perl_pp_ucfirst +#define pp_umask perl_pp_umask +#define pp_undef perl_pp_undef +#define pp_unlink perl_pp_unlink +#define pp_unpack perl_pp_unpack +#define pp_unshift perl_pp_unshift +#define pp_unstack perl_pp_unstack +#define pp_untie perl_pp_untie +#define pp_utime perl_pp_utime +#define pp_values perl_pp_values +#define pp_vec perl_pp_vec +#define pp_wait perl_pp_wait +#define pp_waitpid perl_pp_waitpid +#define pp_wantarray perl_pp_wantarray +#define pp_warn perl_pp_warn +#define pp_xor perl_pp_xor +#define prepend_elem perl_prepend_elem +#define push_return perl_push_return +#define push_scope perl_push_scope +#define q perl_q +#define ref perl_ref +#define refkids perl_refkids +#define regcomp perl_regcomp +#define regdump perl_regdump +#define regexec perl_regexec +#define regfree perl_regfree +#define regnext perl_regnext +#define regprop perl_regprop +#define repeatcpy perl_repeatcpy +#define rninstr perl_rninstr +#define run perl_run +#define save_I32 perl_save_I32 +#define save_aptr perl_save_aptr +#define save_ary perl_save_ary +#define save_clearsv perl_save_clearsv +#define save_delete perl_save_delete +#define save_freeop perl_save_freeop +#define save_freepv perl_save_freepv +#define save_freesv perl_save_freesv +#define save_hash perl_save_hash +#define save_hptr perl_save_hptr +#define save_int perl_save_int +#define save_item perl_save_item +#define save_list perl_save_list +#define save_nogv perl_save_nogv +#define save_scalar perl_save_scalar +#define save_sptr perl_save_sptr +#define save_svref perl_save_svref +#define savestack_grow perl_savestack_grow +#define savestr perl_savestr +#define sawparens perl_sawparens +#define scalar perl_scalar +#define scalarkids perl_scalarkids +#define scalarseq perl_scalarseq +#define scalarvoid perl_scalarvoid +#define scan_const perl_scan_const +#define scan_formline perl_scan_formline +#define scan_heredoc perl_scan_heredoc +#define scan_hex perl_scan_hex +#define scan_ident perl_scan_ident +#define scan_inputsymbol perl_scan_inputsymbol +#define scan_num perl_scan_num +#define scan_oct perl_scan_oct +#define scan_pat perl_scan_pat +#define scan_prefix perl_scan_prefix +#define scan_str perl_scan_str +#define scan_subst perl_scan_subst +#define scan_trans perl_scan_trans +#define scan_word perl_scan_word +#define scope perl_scope +#define screaminstr perl_screaminstr +#define setenv_getix perl_setenv_getix +#define skipspace perl_skipspace +#define start_subparse perl_start_subparse +#define sublex_done perl_sublex_done +#define sublex_start perl_sublex_start +#define sv_2bool perl_sv_2bool +#define sv_2cv perl_sv_2cv +#define sv_2iv perl_sv_2iv +#define sv_2mortal perl_sv_2mortal +#define sv_2nv perl_sv_2nv +#define sv_2pv perl_sv_2pv +#define sv_backoff perl_sv_backoff +#define sv_catpv perl_sv_catpv +#define sv_catpvn perl_sv_catpvn +#define sv_catsv perl_sv_catsv +#define sv_chop perl_sv_chop +#define sv_clean_all perl_sv_clean_all +#define sv_clean_magic perl_sv_clean_magic +#define sv_clean_refs perl_sv_clean_refs +#define sv_clear perl_sv_clear +#define sv_cmp perl_sv_cmp +#define sv_dec perl_sv_dec +#define sv_dump perl_sv_dump +#define sv_eq perl_sv_eq +#define sv_free perl_sv_free +#define sv_gets perl_sv_gets +#define sv_grow perl_sv_grow +#define sv_inc perl_sv_inc +#define sv_insert perl_sv_insert +#define sv_isa perl_sv_isa +#define sv_len perl_sv_len +#define sv_magic perl_sv_magic +#define sv_mortalcopy perl_sv_mortalcopy +#define sv_newmortal perl_sv_newmortal +#define sv_peek perl_sv_peek +#define sv_ref perl_sv_ref +#define sv_replace perl_sv_replace +#define sv_report_used perl_sv_report_used +#define sv_reset perl_sv_reset +#define sv_setiv perl_sv_setiv +#define sv_setnv perl_sv_setnv +#define sv_setptrobj perl_sv_setptrobj +#define sv_setpv perl_sv_setpv +#define sv_setpvn perl_sv_setpvn +#define sv_setsv perl_sv_setsv +#define sv_unmagic perl_sv_unmagic +#define sv_upgrade perl_sv_upgrade +#define sv_usepvn perl_sv_usepvn +#define taint_env perl_taint_env +#define taint_not perl_taint_not +#define taint_proper perl_taint_proper +#define too_few_arguments perl_too_few_arguments +#define too_many_arguments perl_too_many_arguments +#define wait4pid perl_wait4pid +#define warn perl_warn +#define watch perl_watch +#define whichsig perl_whichsig +#define xiv_root perl_xiv_root +#define xnv_root perl_xnv_root +#define xpv_root perl_xpv_root +#define xrv_root perl_xrv_root +#define yyerror perl_yyerror +#define yyerror perl_yyerror +#define yylex perl_yylex +#define yyparse perl_yyparse +#define yywarn perl_yywarn -#endif /* EMBEDDED */ +#endif /* EMBED */ -/* Put interpreter specific variables into a struct? */ +/* Put interpreter specific symbols into a struct? */ #ifdef MULTIPLICITY @@ -916,7 +939,6 @@ #define forkprocess (curinterp->Iforkprocess) #define formfeed (curinterp->Iformfeed) #define formtarget (curinterp->Iformtarget) -#define freestrroot (curinterp->Ifreestrroot) #define gensym (curinterp->Igensym) #define in_eval (curinterp->Iin_eval) #define incgv (curinterp->Iincgv) @@ -993,6 +1015,10 @@ #define statusvalue (curinterp->Istatusvalue) #define stdingv (curinterp->Istdingv) #define strchop (curinterp->Istrchop) +#define sv_count (curinterp->Isv_count) +#define sv_rvcount (curinterp->Isv_rvcount) +#define sv_root (curinterp->Isv_root) +#define sv_arenaroot (curinterp->Isv_arenaroot) #define tainted (curinterp->Itainted) #define tainting (curinterp->Itainting) #define tmps_floor (curinterp->Itmps_floor) @@ -1003,7 +1029,7 @@ #define toptarget (curinterp->Itoptarget) #define unsafe (curinterp->Iunsafe) -#else /* not multiple, so translate interpreter variables the other way... */ +#else /* not multiple, so translate interpreter symbols the other way... */ #define IArgv Argv #define ICmd Cmd @@ -1063,7 +1089,6 @@ #define Iforkprocess forkprocess #define Iformfeed formfeed #define Iformtarget formtarget -#define Ifreestrroot freestrroot #define Igensym gensym #define Iin_eval in_eval #define Iincgv incgv @@ -1140,6 +1165,10 @@ #define Istatusvalue statusvalue #define Istdingv stdingv #define Istrchop strchop +#define Isv_count sv_count +#define Isv_rvcount sv_rvcount +#define Isv_root sv_root +#define Isv_arenaroot sv_arenaroot #define Itainted tainted #define Itainting tainting #define Itmps_floor tmps_floor @@ -1150,4 +1179,4 @@ #define Itoptarget toptarget #define Iunsafe unsafe -#endif /* MULTIPLE_INTERPRETERS */ +#endif /* MULTIPLICITY */ diff --git a/embed_h.SH b/embed_h.SH index d78bffb..2ba9fe2 100755 --- a/embed_h.SH +++ b/embed_h.SH @@ -1,7 +1,7 @@ #!/bin/sh cat <<'END' >embed.h -/* This file is derived from global.var and interp.var */ +/* This file is derived from global.sym and interp.sym */ /* (Doing namespace management portably in C is really gross.) */ @@ -10,24 +10,24 @@ cat <<'END' >embed.h /* globals we need to hide from the world */ END -sed >embed.h \ +sed >embed.h \ -e 's/[ ]*#.*//' \ -e '/^[ ]*$/d' \ - -e 's/\(.*\)/#define \1 PERL\1/' \ + -e 's/\(.*\)/#define \1 perl_\1/' \ -e 's/\(................ \) /\1/' cat <<'END' >> embed.h -#endif /* EMBEDDED */ +#endif /* EMBED */ -/* Put interpreter specific variables into a struct? */ +/* Put interpreter specific symbols into a struct? */ #ifdef MULTIPLICITY END -sed >embed.h \ +sed >embed.h \ -e 's/[ ]*#.*//' \ -e '/^[ ]*$/d' \ -e 's/\(.*\)/#define \1 (curinterp->I\1)/' \ @@ -35,11 +35,11 @@ sed >embed.h \ cat <<'END' >> embed.h -#else /* not multiple, so translate interpreter variables the other way... */ +#else /* not multiple, so translate interpreter symbols the other way... */ END -sed >embed.h \ +sed >embed.h \ -e 's/[ ]*#.*//' \ -e '/^[ ]*$/d' \ -e 's/\(.*\)/#define I\1 \1/' \ @@ -47,6 +47,6 @@ sed >embed.h \ cat <<'END' >> embed.h -#endif /* MULTIPLE_INTERPRETERS */ +#endif /* MULTIPLICITY */ END diff --git a/eval.c.save b/eval.c.save deleted file mode 100644 index 964bc03..0000000 --- a/eval.c.save +++ /dev/null @@ -1,3048 +0,0 @@ -/* $RCSfile: eval.c,v $$Revision: 4.1 $$Date: 92/08/07 18:20:29 $ - * - * Copyright (c) 1991, Larry Wall - * - * You may distribute under the terms of either the GNU General Public - * License or the Artistic License, as specified in the README file. - * - * $Log: eval.c,v $ - * Revision 4.1 92/08/07 18:20:29 lwall - * - * Revision 4.0.1.4 92/06/08 13:20:20 lwall - * patch20: added explicit time_t support - * patch20: fixed confusion between a *var's real name and its effective name - * patch20: added Atari ST portability - * patch20: new warning for use of x with non-numeric right operand - * patch20: modulus with highest bit in left operand set didn't always work - * patch20: dbmclose(%array) didn't work - * patch20: added ... as variant on .. - * patch20: O_PIPE conflicted with Atari - * - * Revision 4.0.1.3 91/11/05 17:15:21 lwall - * patch11: prepared for ctype implementations that don't define isascii() - * patch11: various portability fixes - * patch11: added sort {} LIST - * patch11: added eval {} - * patch11: sysread() in socket was substituting recv() - * patch11: a last statement outside any block caused occasional core dumps - * patch11: missing arguments caused core dump in -D8 code - * patch11: eval 'stuff' now optimized to eval {stuff} - * - * Revision 4.0.1.2 91/06/07 11:07:23 lwall - * patch4: new copyright notice - * patch4: length($`), length($&), length($') now optimized to avoid string copy - * patch4: assignment wasn't correctly de-tainting the assigned variable. - * patch4: default top-of-form format is now FILEHANDLE_TOP - * patch4: added $^P variable to control calling of perldb routines - * patch4: taintchecks could improperly modify parent in vfork() - * patch4: many, many itty-bitty portability fixes - * - * Revision 4.0.1.1 91/04/11 17:43:48 lwall - * patch1: fixed failed fork to return undef as documented - * patch1: reduced maximum branch distance in eval.c - * - * Revision 4.0 91/03/20 01:16:48 lwall - * 4.0 baseline. - * - */ - -#include "EXTERN.h" -#include "perl.h" - -extern int (*ppaddr[])(); -extern int mark[]; - -#if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX) -#include -#endif - -#ifdef I_FCNTL -#include -#endif -#ifdef MSDOS -/* I_FCNTL *MUST* not be defined for MS-DOS and OS/2 - but fcntl.h is required for O_BINARY */ -#include -#endif -#ifdef I_SYS_FILE -#include -#endif -#ifdef I_VFORK -# include -#endif - -double sin(), cos(), atan2(), pow(); - -char *getlogin(); - -int -eval(arg,gimme,sp) -register ARG *arg; -int gimme; -register int sp; -{ - register STR *str; - register int anum; - register int optype; - register STR **st; - int maxarg; - double value; - register char *tmps; - char *tmps2; - int argflags; - int argtype; - union argptr argptr; - int arglast[8]; /* highest sp for arg--valid only for non-O_LIST args */ - unsigned long tmpulong; - long tmplong; - time_t when; - STRLEN tmplen; - FILE *fp; - STR *tmpstr; - FCMD *form; - STAB *stab; - STAB *stab2; - STIO *stio; - ARRAY *ary; - int old_rslen; - int old_rschar; - VOIDRET (*ihand)(); /* place to save signal during system() */ - VOIDRET (*qhand)(); /* place to save signal during system() */ - bool assigning = FALSE; - int mymarkbase = savestack->ary_fill; - - if (!arg) - goto say_undef; - optype = arg->arg_type; - maxarg = arg->arg_len; - arglast[0] = sp; - str = arg->arg_ptr.arg_str; - if (sp + maxarg > stack->ary_max) - astore(stack, sp + maxarg, Nullstr); - st = stack->ary_array; - -#ifdef DEBUGGING - if (debug) { - if (debug & 8) { - deb("%s (%lx) %d args:\n",opname[optype],arg,maxarg); - } - debname[dlevel] = opname[optype][0]; - debdelim[dlevel] = ':'; - if (++dlevel >= dlmax) - grow_dlevel(); - } -#endif - - if (mark[optype]) { - saveint(&markbase); - markbase = mymarkbase; - saveint(&stack_mark); - stack_mark = sp; - } - for (anum = 1; anum <= maxarg; anum++) { - argflags = arg[anum].arg_flags; - argtype = arg[anum].arg_type; - argptr = arg[anum].arg_ptr; - re_eval: - switch (argtype) { - default: - if (!ppaddr[optype] || optype == O_SUBR || optype == O_DBSUBR) { - st[++sp] = &str_undef; - } -#ifdef DEBUGGING - tmps = "NULL"; -#endif - break; - case A_EXPR: -#ifdef DEBUGGING - if (debug & 8) { - tmps = "EXPR"; - deb("%d.EXPR =>\n",anum); - } -#endif - sp = eval(argptr.arg_arg, - (argflags & AF_ARYOK) ? G_ARRAY : G_SCALAR, sp); - if (sp + (maxarg - anum) > stack->ary_max) - astore(stack, sp + (maxarg - anum), Nullstr); - st = stack->ary_array; /* possibly reallocated */ - break; - case A_CMD: -#ifdef DEBUGGING - if (debug & 8) { - tmps = "CMD"; - deb("%d.CMD (%lx) =>\n",anum,argptr.arg_cmd); - } -#endif - sp = cmd_exec(argptr.arg_cmd, gimme, sp); - if (sp + (maxarg - anum) > stack->ary_max) - astore(stack, sp + (maxarg - anum), Nullstr); - st = stack->ary_array; /* possibly reallocated */ - break; - case A_LARYSTAB: - ++sp; - switch (optype) { - case O_ITEM2: argtype = 2; break; - case O_ITEM3: argtype = 3; break; - default: argtype = anum; break; - } - str = afetch(stab_array(argptr.arg_stab), - arg[argtype].arg_len - arybase, TRUE); -#ifdef DEBUGGING - if (debug & 8) { - (void)sprintf(buf,"LARYSTAB $%s[%d]",stab_name(argptr.arg_stab), - arg[argtype].arg_len); - tmps = buf; - } -#endif - goto do_crement; - case A_ARYSTAB: - switch (optype) { - case O_ITEM2: argtype = 2; break; - case O_ITEM3: argtype = 3; break; - default: argtype = anum; break; - } - st[++sp] = afetch(stab_array(argptr.arg_stab), - arg[argtype].arg_len - arybase, FALSE); -#ifdef DEBUGGING - if (debug & 8) { - (void)sprintf(buf,"ARYSTAB $%s[%d]",stab_name(argptr.arg_stab), - arg[argtype].arg_len); - tmps = buf; - } -#endif - break; - case A_STAR: - stab = argptr.arg_stab; - st[++sp] = (STR*)stab; - if (!stab_xarray(stab)) - aadd(stab); - if (!stab_xhash(stab)) - hadd(stab); - if (!stab_io(stab)) - stab_io(stab) = stio_new(); -#ifdef DEBUGGING - if (debug & 8) { - (void)sprintf(buf,"STAR *%s -> *%s", - stab_name(argptr.arg_stab), stab_ename(argptr.arg_stab)); - tmps = buf; - } -#endif - break; - case A_LSTAR: - str = st[++sp] = (STR*)argptr.arg_stab; -#ifdef DEBUGGING - if (debug & 8) { - (void)sprintf(buf,"LSTAR *%s -> *%s", - stab_name(argptr.arg_stab), stab_ename(argptr.arg_stab)); - tmps = buf; - } -#endif - break; - case A_STAB: - st[++sp] = STAB_STR(argptr.arg_stab); -#ifdef DEBUGGING - if (debug & 8) { - (void)sprintf(buf,"STAB $%s",stab_name(argptr.arg_stab)); - tmps = buf; - } -#endif - break; - case A_LENSTAB: - str_numset(str, (double)STAB_LEN(argptr.arg_stab)); - st[++sp] = str; -#ifdef DEBUGGING - if (debug & 8) { - (void)sprintf(buf,"LENSTAB $%s",stab_name(argptr.arg_stab)); - tmps = buf; - } -#endif - break; - case A_LEXPR: -#ifdef DEBUGGING - if (debug & 8) { - tmps = "LEXPR"; - deb("%d.LEXPR =>\n",anum); - } -#endif - if (argflags & AF_ARYOK) { - sp = eval(argptr.arg_arg, G_ARRAY, sp); - if (sp + (maxarg - anum) > stack->ary_max) - astore(stack, sp + (maxarg - anum), Nullstr); - st = stack->ary_array; /* possibly reallocated */ - } - else { - sp = eval(argptr.arg_arg, G_SCALAR, sp); - st = stack->ary_array; /* possibly reallocated */ - str = st[sp]; - goto do_crement; - } - break; - case A_LVAL: -#ifdef DEBUGGING - if (debug & 8) { - (void)sprintf(buf,"LVAL $%s",stab_name(argptr.arg_stab)); - tmps = buf; - } -#endif - ++sp; - str = STAB_STR(argptr.arg_stab); - if (!str) - fatal("panic: A_LVAL"); - do_crement: - assigning = TRUE; - if (argflags & AF_PRE) { - if (argflags & AF_UP) - str_inc(str); - else - str_dec(str); - STABSET(str); - st[sp] = str; - str = arg->arg_ptr.arg_str; - } - else if (argflags & AF_POST) { - st[sp] = str_mortal(str); - if (argflags & AF_UP) - str_inc(str); - else - str_dec(str); - STABSET(str); - str = arg->arg_ptr.arg_str; - } - else - st[sp] = str; - break; - case A_LARYLEN: - ++sp; - stab = argptr.arg_stab; - str = stab_array(argptr.arg_stab)->ary_magic; - if (optype != O_SASSIGN || argflags & (AF_PRE|AF_POST)) - str_numset(str,(double)(stab_array(stab)->ary_fill+arybase)); -#ifdef DEBUGGING - tmps = "LARYLEN"; -#endif - if (!str) - fatal("panic: A_LEXPR"); - goto do_crement; - case A_ARYLEN: - stab = argptr.arg_stab; - st[++sp] = stab_array(stab)->ary_magic; - str_numset(st[sp],(double)(stab_array(stab)->ary_fill+arybase)); -#ifdef DEBUGGING - tmps = "ARYLEN"; -#endif - break; - case A_SINGLE: - st[++sp] = argptr.arg_str; -#ifdef DEBUGGING - tmps = "SINGLE"; -#endif - break; - case A_DOUBLE: - (void) interp(str,argptr.arg_str,sp); - st = stack->ary_array; - st[++sp] = str; -#ifdef DEBUGGING - tmps = "DOUBLE"; -#endif - break; - case A_BACKTICK: - tmps = str_get(interp(str,argptr.arg_str,sp)); - st = stack->ary_array; -#ifdef TAINT - TAINT_PROPER("``"); -#endif - fp = mypopen(tmps,"r"); - str_set(str,""); - if (fp) { - if (gimme == G_SCALAR) { - while (str_gets(str,fp,str->str_cur) != Nullch) - /*SUPPRESS 530*/ - ; - } - else { - for (;;) { - if (++sp > stack->ary_max) { - astore(stack, sp, Nullstr); - st = stack->ary_array; - } - str = st[sp] = Str_new(56,80); - if (str_gets(str,fp,0) == Nullch) { - sp--; - break; - } - if (str->str_len - str->str_cur > 20) { - str->str_len = str->str_cur+1; - Renew(str->str_ptr, str->str_len, char); - } - str_2mortal(str); - } - } - statusvalue = mypclose(fp); - } - else - statusvalue = -1; - - if (gimme == G_SCALAR) - st[++sp] = str; -#ifdef DEBUGGING - tmps = "BACK"; -#endif - break; - case A_WANTARRAY: - { - if (curcsv->wantarray == G_ARRAY) - st[++sp] = &str_yes; - else - st[++sp] = &str_no; - } -#ifdef DEBUGGING - tmps = "WANTARRAY"; -#endif - break; - case A_INDREAD: - last_in_stab = stabent(str_get(STAB_STR(argptr.arg_stab)),TRUE); - old_rschar = rschar; - old_rslen = rslen; - goto do_read; - case A_GLOB: - argflags |= AF_POST; /* enable newline chopping */ - last_in_stab = argptr.arg_stab; - old_rschar = rschar; - old_rslen = rslen; - rslen = 1; -#ifdef DOSISH - rschar = 0; -#else -#ifdef CSH - rschar = 0; -#else - rschar = '\n'; -#endif /* !CSH */ -#endif /* !MSDOS */ - goto do_read; - case A_READ: - last_in_stab = argptr.arg_stab; - old_rschar = rschar; - old_rslen = rslen; - do_read: - if (anum > 1) /* assign to scalar */ - gimme = G_SCALAR; /* force context to scalar */ - if (gimme == G_ARRAY) - str = Str_new(57,0); - ++sp; - fp = Nullfp; - if (stab_io(last_in_stab)) { - fp = stab_io(last_in_stab)->ifp; - if (!fp) { - if (stab_io(last_in_stab)->flags & IOF_ARGV) { - if (stab_io(last_in_stab)->flags & IOF_START) { - stab_io(last_in_stab)->flags &= ~IOF_START; - stab_io(last_in_stab)->lines = 0; - if (alen(stab_array(last_in_stab)) < 0) { - tmpstr = str_make("-",1); /* assume stdin */ - (void)apush(stab_array(last_in_stab), tmpstr); - } - } - fp = nextargv(last_in_stab); - if (!fp) { /* Note: fp != stab_io(last_in_stab)->ifp */ - (void)do_close(last_in_stab,FALSE); /* now it does*/ - stab_io(last_in_stab)->flags |= IOF_START; - } - } - else if (argtype == A_GLOB) { - (void) interp(str,stab_val(last_in_stab),sp); - st = stack->ary_array; - tmpstr = Str_new(55,0); -#ifdef DOSISH - str_set(tmpstr, "perlglob "); - str_scat(tmpstr,str); - str_cat(tmpstr," |"); -#else -#ifdef CSH - str_nset(tmpstr,cshname,cshlen); - str_cat(tmpstr," -cf 'set nonomatch; glob "); - str_scat(tmpstr,str); - str_cat(tmpstr,"'|"); -#else - str_set(tmpstr, "echo "); - str_scat(tmpstr,str); - str_cat(tmpstr, - "|tr -s ' \t\f\r' '\\012\\012\\012\\012'|"); -#endif /* !CSH */ -#endif /* !MSDOS */ - (void)do_open(last_in_stab,tmpstr->str_ptr, - tmpstr->str_cur); - fp = stab_io(last_in_stab)->ifp; - str_free(tmpstr); - } - } - } - if (!fp && dowarn) - warn("Read on closed filehandle <%s>",stab_ename(last_in_stab)); - tmplen = str->str_len; /* remember if already alloced */ - if (!tmplen) - Str_Grow(str,80); /* try short-buffering it */ - keepgoing: - if (!fp) - st[sp] = &str_undef; - else if (!str_gets(str,fp, optype == O_RCAT ? str->str_cur : 0)) { - clearerr(fp); - if (stab_io(last_in_stab)->flags & IOF_ARGV) { - fp = nextargv(last_in_stab); - if (fp) - goto keepgoing; - (void)do_close(last_in_stab,FALSE); - stab_io(last_in_stab)->flags |= IOF_START; - } - else if (argflags & AF_POST) { - (void)do_close(last_in_stab,FALSE); - } - st[sp] = &str_undef; - rschar = old_rschar; - rslen = old_rslen; - if (gimme == G_ARRAY) { - --sp; - str_2mortal(str); - goto array_return; - } - break; - } - else { - stab_io(last_in_stab)->lines++; - st[sp] = str; -#ifdef TAINT - str->str_tainted = 1; /* Anything from the outside world...*/ -#endif - if (argflags & AF_POST) { - if (str->str_cur > 0) - str->str_cur--; - if (str->str_ptr[str->str_cur] == rschar) - str->str_ptr[str->str_cur] = '\0'; - else - str->str_cur++; - for (tmps = str->str_ptr; *tmps; tmps++) - if (!isALPHA(*tmps) && !isDIGIT(*tmps) && - index("$&*(){}[]'\";\\|?<>~`",*tmps)) - break; - if (*tmps && stat(str->str_ptr,&statbuf) < 0) - goto keepgoing; /* unmatched wildcard? */ - } - if (gimme == G_ARRAY) { - if (str->str_len - str->str_cur > 20) { - str->str_len = str->str_cur+1; - Renew(str->str_ptr, str->str_len, char); - } - str_2mortal(str); - if (++sp > stack->ary_max) { - astore(stack, sp, Nullstr); - st = stack->ary_array; - } - str = Str_new(58,80); - goto keepgoing; - } - else if (!tmplen && str->str_len - str->str_cur > 80) { - /* try to reclaim a bit of scalar space on 1st alloc */ - if (str->str_cur < 60) - str->str_len = 80; - else - str->str_len = str->str_cur+40; /* allow some slop */ - Renew(str->str_ptr, str->str_len, char); - } - } - rschar = old_rschar; - rslen = old_rslen; -#ifdef DEBUGGING - tmps = "READ"; -#endif - break; - } -#ifdef DEBUGGING - if (debug & 8) { - if (strEQ(tmps, "NULL")) - deb("%d.%s\n",anum,tmps); - else - deb("%d.%s = '%s'\n",anum,tmps,str_peek(st[sp])); - } -#endif - if (anum < 8) - arglast[anum] = sp; - } - - if (ppaddr[optype]) { - int status; - - /* pretend like we've been maintaining stack_* all along */ - stack_ary = stack->ary_array; - stack_sp = stack_ary + sp; - if (mark[optype] && stack_mark != arglast[0]) - warn("Inconsistent stack mark %d != %d", stack_mark, arglast[0]); - stack_max = stack_ary + stack->ary_max; - - status = (*ppaddr[optype])(str, arg, gimme); - - if (savestack->ary_fill > mymarkbase) { - warn("Inconsistent stack base"); - restorelist(mymarkbase); - } - sp = stack_sp - stack_ary; - if (sp < arglast[0]) - warn("TOO MANY POPS"); - st += arglast[0]; - goto array_return; - } - - st += arglast[0]; - -#ifdef SMALLSWITCHES - if (optype < O_CHOWN) -#endif - switch (optype) { - case O_RCAT: - STABSET(str); - break; - case O_ITEM: - if (gimme == G_ARRAY) - goto array_return; - /* FALL THROUGH */ - case O_SCALAR: - STR_SSET(str,st[1]); - STABSET(str); - break; - case O_ITEM2: - if (gimme == G_ARRAY) - goto array_return; - --anum; - STR_SSET(str,st[arglast[anum]-arglast[0]]); - STABSET(str); - break; - case O_ITEM3: - if (gimme == G_ARRAY) - goto array_return; - --anum; - STR_SSET(str,st[arglast[anum]-arglast[0]]); - STABSET(str); - break; - case O_CONCAT: - STR_SSET(str,st[1]); - str_scat(str,st[2]); - STABSET(str); - break; - case O_REPEAT: - if (gimme == G_ARRAY && arg[1].arg_flags & AF_ARYOK) { - sp = do_repeatary(arglast); - goto array_return; - } - STR_SSET(str,st[1]); - anum = (int)str_gnum(st[2]); - if (anum >= 1) { - tmpstr = Str_new(50, 0); - tmps = str_get(str); - str_nset(tmpstr,tmps,str->str_cur); - tmps = str_get(tmpstr); /* force to be string */ - STR_GROW(str, (anum * str->str_cur) + 1); - repeatcpy(str->str_ptr, tmps, tmpstr->str_cur, anum); - str->str_cur *= anum; - str->str_ptr[str->str_cur] = '\0'; - str->str_nok = 0; - str_free(tmpstr); - } - else { - if (dowarn && st[2]->str_pok && !looks_like_number(st[2])) - warn("Right operand of x is not numeric"); - str_sset(str,&str_no); - } - STABSET(str); - break; - case O_MATCH: - sp = do_match(str,arg, - gimme,arglast); - if (gimme == G_ARRAY) - goto array_return; - STABSET(str); - break; - case O_NMATCH: - sp = do_match(str,arg, - G_SCALAR,arglast); - str_sset(str, str_true(str) ? &str_no : &str_yes); - STABSET(str); - break; - case O_SUBST: - sp = do_subst(str,arg,arglast[0]); - goto array_return; - case O_NSUBST: - sp = do_subst(str,arg,arglast[0]); - str = arg->arg_ptr.arg_str; - str_set(str, str_true(str) ? No : Yes); - goto array_return; - case O_ASSIGN: - if (arg[1].arg_flags & AF_ARYOK) { - if (arg->arg_len == 1) { - arg->arg_type = O_LOCAL; - goto local; - } - else { - arg->arg_type = O_AASSIGN; - goto aassign; - } - } - else { - arg->arg_type = O_SASSIGN; - goto sassign; - } - case O_LOCAL: - local: - arglast[2] = arglast[1]; /* push a null array */ - /* FALL THROUGH */ - case O_AASSIGN: - aassign: - sp = do_assign(arg, - gimme,arglast); - goto array_return; - case O_SASSIGN: - sassign: -#ifdef TAINT - if (tainted && !st[2]->str_tainted) - tainted = 0; -#endif - STR_SSET(str, st[2]); - STABSET(str); - break; - case O_CHOP: - st -= arglast[0]; - str = arg->arg_ptr.arg_str; - for (sp = arglast[0] + 1; sp <= arglast[1]; sp++) - do_chop(str,st[sp]); - st += arglast[0]; - break; - case O_DEFINED: - if (arg[1].arg_type & A_DONT) { - sp = do_defined(str,arg, - gimme,arglast); - goto array_return; - } - else if (str->str_pok || str->str_nok) - goto say_yes; - goto say_no; - case O_UNDEF: - if (arg[1].arg_type & A_DONT) { - sp = do_undef(str,arg, - gimme,arglast); - goto array_return; - } - else if (str != stab_val(defstab)) { - if (str->str_len) { - if (str->str_state == SS_INCR) - Str_Grow(str,0); - Safefree(str->str_ptr); - str->str_ptr = Nullch; - str->str_len = 0; - } - str->str_pok = str->str_nok = 0; - STABSET(str); - } - goto say_undef; - case O_STUDY: - sp = do_study(str,arg, - gimme,arglast); - goto array_return; - case O_POW: - value = str_gnum(st[1]); - value = pow(value,str_gnum(st[2])); - goto donumset; - case O_MULTIPLY: - value = str_gnum(st[1]); - value *= str_gnum(st[2]); - goto donumset; - case O_DIVIDE: - if ((value = str_gnum(st[2])) == 0.0) - fatal("Illegal division by zero"); -#ifdef SLOPPYDIVIDE - /* insure that 20./5. == 4. */ - { - double x; - int k; - x = str_gnum(st[1]); - if ((double)(int)x == x && - (double)(int)value == value && - (k = (int)x/(int)value)*(int)value == (int)x) { - value = k; - } else { - value = x/value; - } - } -#else - value = str_gnum(st[1]) / value; -#endif - goto donumset; - case O_MODULO: - tmpulong = (unsigned long) str_gnum(st[2]); - if (tmpulong == 0L) - fatal("Illegal modulus zero"); -#ifndef lint - value = str_gnum(st[1]); - if (value >= 0.0) - value = (double)(((unsigned long)value) % tmpulong); - else { - tmplong = (long)value; - value = (double)(tmpulong - ((-tmplong - 1) % tmpulong)) - 1; - } -#endif - goto donumset; - case O_ADD: - value = str_gnum(st[1]); - value += str_gnum(st[2]); - goto donumset; - case O_SUBTRACT: - value = str_gnum(st[1]); - value -= str_gnum(st[2]); - goto donumset; - case O_LEFT_SHIFT: - value = str_gnum(st[1]); - anum = (int)str_gnum(st[2]); -#ifndef lint - value = (double)(U_L(value) << anum); -#endif - goto donumset; - case O_RIGHT_SHIFT: - value = str_gnum(st[1]); - anum = (int)str_gnum(st[2]); -#ifndef lint - value = (double)(U_L(value) >> anum); -#endif - goto donumset; - case O_LT: - value = str_gnum(st[1]); - value = (value < str_gnum(st[2])) ? 1.0 : 0.0; - goto donumset; - case O_GT: - value = str_gnum(st[1]); - value = (value > str_gnum(st[2])) ? 1.0 : 0.0; - goto donumset; - case O_LE: - value = str_gnum(st[1]); - value = (value <= str_gnum(st[2])) ? 1.0 : 0.0; - goto donumset; - case O_GE: - value = str_gnum(st[1]); - value = (value >= str_gnum(st[2])) ? 1.0 : 0.0; - goto donumset; - case O_EQ: - if (dowarn) { - if ((!st[1]->str_nok && !looks_like_number(st[1])) || - (!st[2]->str_nok && !looks_like_number(st[2])) ) - warn("Possible use of == on string value"); - } - value = str_gnum(st[1]); - value = (value == str_gnum(st[2])) ? 1.0 : 0.0; - goto donumset; - case O_NE: - value = str_gnum(st[1]); - value = (value != str_gnum(st[2])) ? 1.0 : 0.0; - goto donumset; - case O_NCMP: - value = str_gnum(st[1]); - value -= str_gnum(st[2]); - if (value > 0.0) - value = 1.0; - else if (value < 0.0) - value = -1.0; - goto donumset; - case O_BIT_AND: - if (!sawvec || st[1]->str_nok || st[2]->str_nok) { - value = str_gnum(st[1]); -#ifndef lint - value = (double)(U_L(value) & U_L(str_gnum(st[2]))); -#endif - goto donumset; - } - else - do_vop(optype,str,st[1],st[2]); - break; - case O_XOR: - if (!sawvec || st[1]->str_nok || st[2]->str_nok) { - value = str_gnum(st[1]); -#ifndef lint - value = (double)(U_L(value) ^ U_L(str_gnum(st[2]))); -#endif - goto donumset; - } - else - do_vop(optype,str,st[1],st[2]); - break; - case O_BIT_OR: - if (!sawvec || st[1]->str_nok || st[2]->str_nok) { - value = str_gnum(st[1]); -#ifndef lint - value = (double)(U_L(value) | U_L(str_gnum(st[2]))); -#endif - goto donumset; - } - else - do_vop(optype,str,st[1],st[2]); - break; -/* use register in evaluating str_true() */ - case O_AND: - if (str_true(st[1])) { - anum = 2; - optype = O_ITEM2; - argflags = arg[anum].arg_flags; - if (gimme == G_ARRAY) - argflags |= AF_ARYOK; - argtype = arg[anum].arg_type & A_MASK; - argptr = arg[anum].arg_ptr; - maxarg = anum = 1; - sp = arglast[0]; - st -= sp; - goto re_eval; - } - else { - if (assigning) { - str_sset(str, st[1]); - STABSET(str); - } - else - str = st[1]; - break; - } - case O_OR: - if (str_true(st[1])) { - if (assigning) { - str_sset(str, st[1]); - STABSET(str); - } - else - str = st[1]; - break; - } - else { - anum = 2; - optype = O_ITEM2; - argflags = arg[anum].arg_flags; - if (gimme == G_ARRAY) - argflags |= AF_ARYOK; - argtype = arg[anum].arg_type & A_MASK; - argptr = arg[anum].arg_ptr; - maxarg = anum = 1; - sp = arglast[0]; - st -= sp; - goto re_eval; - } - case O_COND_EXPR: - anum = (str_true(st[1]) ? 2 : 3); - optype = (anum == 2 ? O_ITEM2 : O_ITEM3); - argflags = arg[anum].arg_flags; - if (gimme == G_ARRAY) - argflags |= AF_ARYOK; - argtype = arg[anum].arg_type & A_MASK; - argptr = arg[anum].arg_ptr; - maxarg = anum = 1; - sp = arglast[0]; - st -= sp; - goto re_eval; - case O_COMMA: - if (gimme == G_ARRAY) - goto array_return; - str = st[2]; - break; - case O_NEGATE: - value = -str_gnum(st[1]); - goto donumset; - case O_NOT: -#ifdef NOTNOT - { char xxx = str_true(st[1]); value = (double) !xxx; } -#else - value = (double) !str_true(st[1]); -#endif - goto donumset; - case O_COMPLEMENT: - if (!sawvec || st[1]->str_nok) { -#ifndef lint - value = (double) ~U_L(str_gnum(st[1])); -#endif - goto donumset; - } - else { - STR_SSET(str,st[1]); - tmps = str_get(str); - for (anum = str->str_cur; anum; anum--, tmps++) - *tmps = ~*tmps; - } - break; - case O_SELECT: - stab_efullname(str,defoutstab); - if (maxarg > 0) { - if ((arg[1].arg_type & A_MASK) == A_WORD) - defoutstab = arg[1].arg_ptr.arg_stab; - else - defoutstab = stabent(str_get(st[1]),TRUE); - if (!stab_io(defoutstab)) - stab_io(defoutstab) = stio_new(); - curoutstab = defoutstab; - } - STABSET(str); - break; - case O_WRITE: - if (maxarg == 0) - stab = defoutstab; - else if ((arg[1].arg_type & A_MASK) == A_WORD) { - if (!(stab = arg[1].arg_ptr.arg_stab)) - stab = defoutstab; - } - else - stab = stabent(str_get(st[1]),TRUE); - if (!stab_io(stab)) { - str_set(str, No); - STABSET(str); - break; - } - curoutstab = stab; - fp = stab_io(stab)->ofp; - if (stab_io(stab)->fmt_stab) - form = stab_form(stab_io(stab)->fmt_stab); - else - form = stab_form(stab); - if (!form || !fp) { - if (dowarn) { - if (form) - warn("No format for filehandle"); - else { - if (stab_io(stab)->ifp) - warn("Filehandle only opened for input"); - else - warn("Write on closed filehandle"); - } - } - str_set(str, No); - STABSET(str); - break; - } - format(&outrec,form,sp); - do_write(&outrec,stab,sp); - if (stab_io(stab)->flags & IOF_FLUSH) - (void)fflush(fp); - str_set(str, Yes); - STABSET(str); - break; - case O_DBMOPEN: -#ifdef SOME_DBM - anum = arg[1].arg_type & A_MASK; - if (anum == A_WORD || anum == A_STAB) - stab = arg[1].arg_ptr.arg_stab; - else - stab = stabent(str_get(st[1]),TRUE); - if (st[3]->str_nok || st[3]->str_pok) - anum = (int)str_gnum(st[3]); - else - anum = -1; - value = (double)hdbmopen(stab_hash(stab),str_get(st[2]),anum); - goto donumset; -#else - fatal("No dbm or ndbm on this machine"); -#endif - case O_DBMCLOSE: -#ifdef SOME_DBM - anum = arg[1].arg_type & A_MASK; - if (anum == A_WORD || anum == A_STAB) - stab = arg[1].arg_ptr.arg_stab; - else - stab = stabent(str_get(st[1]),TRUE); - hdbmclose(stab_hash(stab)); - goto say_yes; -#else - fatal("No dbm or ndbm on this machine"); -#endif - case O_OPEN: - if ((arg[1].arg_type & A_MASK) == A_WORD) - stab = arg[1].arg_ptr.arg_stab; - else - stab = stabent(str_get(st[1]),TRUE); - tmps = str_get(st[2]); - if (do_open(stab,tmps,st[2]->str_cur)) { - value = (double)forkprocess; - stab_io(stab)->lines = 0; - goto donumset; - } - else if (forkprocess == 0) /* we are a new child */ - goto say_zero; - else - goto say_undef; - /* break; */ - case O_TRANS: - value = (double) do_trans(str,arg); - str = arg->arg_ptr.arg_str; - goto donumset; - case O_NTRANS: - str_set(arg->arg_ptr.arg_str, do_trans(str,arg) == 0 ? Yes : No); - str = arg->arg_ptr.arg_str; - break; - case O_CLOSE: - if (maxarg == 0) - stab = defoutstab; - else if ((arg[1].arg_type & A_MASK) == A_WORD) - stab = arg[1].arg_ptr.arg_stab; - else - stab = stabent(str_get(st[1]),TRUE); - str_set(str, do_close(stab,TRUE) ? Yes : No ); - STABSET(str); - break; - case O_EACH: - sp = do_each(str,stab_hash(arg[1].arg_ptr.arg_stab), - gimme,arglast); - goto array_return; - case O_VALUES: - case O_KEYS: - sp = do_kv(str,stab_hash(arg[1].arg_ptr.arg_stab), optype, - gimme,arglast); - goto array_return; - case O_LARRAY: - str->str_nok = str->str_pok = 0; - str->str_u.str_stab = arg[1].arg_ptr.arg_stab; - str->str_state = SS_ARY; - break; - case O_ARRAY: - ary = stab_array(arg[1].arg_ptr.arg_stab); - maxarg = ary->ary_fill + 1; - if (gimme == G_ARRAY) { /* array wanted */ - sp = arglast[0]; - st -= sp; - if (maxarg > 0 && sp + maxarg > stack->ary_max) { - astore(stack,sp + maxarg, Nullstr); - st = stack->ary_array; - } - st += sp; - Copy(ary->ary_array, &st[1], maxarg, STR*); - sp += maxarg; - goto array_return; - } - else { - value = (double)maxarg; - goto donumset; - } - case O_AELEM: - anum = ((int)str_gnum(st[2])) - arybase; - str = afetch(stab_array(arg[1].arg_ptr.arg_stab),anum,FALSE); - break; - case O_DELETE: - tmpstab = arg[1].arg_ptr.arg_stab; - tmps = str_get(st[2]); - str = hdelete(stab_hash(tmpstab),tmps,st[2]->str_cur); - if (tmpstab == envstab) - my_setenv(tmps,Nullch); - if (!str) - goto say_undef; - break; - case O_LHASH: - str->str_nok = str->str_pok = 0; - str->str_u.str_stab = arg[1].arg_ptr.arg_stab; - str->str_state = SS_HASH; - break; - case O_HASH: - if (gimme == G_ARRAY) { /* array wanted */ - sp = do_kv(str,stab_hash(arg[1].arg_ptr.arg_stab), optype, - gimme,arglast); - goto array_return; - } - else { - tmpstab = arg[1].arg_ptr.arg_stab; - if (!stab_hash(tmpstab)->tbl_fill) - goto say_zero; - sprintf(buf,"%d/%d",stab_hash(tmpstab)->tbl_fill, - stab_hash(tmpstab)->tbl_max+1); - str_set(str,buf); - } - break; - case O_HELEM: - tmpstab = arg[1].arg_ptr.arg_stab; - tmps = str_get(st[2]); - str = hfetch(stab_hash(tmpstab),tmps,st[2]->str_cur,FALSE); - break; - case O_LAELEM: - anum = ((int)str_gnum(st[2])) - arybase; - str = afetch(stab_array(arg[1].arg_ptr.arg_stab),anum,TRUE); - if (!str || str == &str_undef) - fatal("Assignment to non-creatable value, subscript %d",anum); - break; - case O_LHELEM: - tmpstab = arg[1].arg_ptr.arg_stab; - tmps = str_get(st[2]); - anum = st[2]->str_cur; - str = hfetch(stab_hash(tmpstab),tmps,anum,TRUE); - if (!str || str == &str_undef) - fatal("Assignment to non-creatable value, subscript \"%s\"",tmps); - if (tmpstab == envstab) /* heavy wizardry going on here */ - str_magic(str, tmpstab, 'E', tmps, anum); /* str is now magic */ - /* he threw the brick up into the air */ - else if (tmpstab == sigstab) - str_magic(str, tmpstab, 'S', tmps, anum); -#ifdef SOME_DBM - else if (stab_hash(tmpstab)->tbl_dbm) - str_magic(str, tmpstab, 'D', tmps, anum); -#endif - else if (tmpstab == DBline) - str_magic(str, tmpstab, 'L', tmps, anum); - break; - case O_LSLICE: - anum = 2; - argtype = FALSE; - goto do_slice_already; - case O_ASLICE: - anum = 1; - argtype = FALSE; - goto do_slice_already; - case O_HSLICE: - anum = 0; - argtype = FALSE; - goto do_slice_already; - case O_LASLICE: - anum = 1; - argtype = TRUE; - goto do_slice_already; - case O_LHSLICE: - anum = 0; - argtype = TRUE; - do_slice_already: - sp = do_slice(arg[1].arg_ptr.arg_stab,str,anum,argtype, - gimme,arglast); - goto array_return; - case O_SPLICE: - sp = do_splice(stab_array(arg[1].arg_ptr.arg_stab),gimme,arglast); - goto array_return; - case O_PUSH: - if (arglast[2] - arglast[1] != 1) - str = do_push(stab_array(arg[1].arg_ptr.arg_stab),arglast); - else { - str = Str_new(51,0); /* must copy the STR */ - str_sset(str,st[2]); - (void)apush(stab_array(arg[1].arg_ptr.arg_stab),str); - } - break; - case O_POP: - str = apop(ary = stab_array(arg[1].arg_ptr.arg_stab)); - goto staticalization; - case O_SHIFT: - str = ashift(ary = stab_array(arg[1].arg_ptr.arg_stab)); - staticalization: - if (!str) - goto say_undef; - if (ary->ary_flags & ARF_REAL) - (void)str_2mortal(str); - break; - case O_UNPACK: - sp = do_unpack(str,gimme,arglast); - goto array_return; - case O_SPLIT: - value = str_gnum(st[3]); - sp = do_split(str, arg[2].arg_ptr.arg_spat, (int)value, - gimme,arglast); - goto array_return; - case O_LENGTH: - if (maxarg < 1) - value = (double)str_len(stab_val(defstab)); - else - value = (double)str_len(st[1]); - goto donumset; - case O_SPRINTF: - do_sprintf(str, sp-arglast[0], st+1); - break; - case O_SUBSTR: - anum = ((int)str_gnum(st[2])) - arybase; /* anum=where to start*/ - tmps = str_get(st[1]); /* force conversion to string */ - /*SUPPRESS 560*/ - if (argtype = (str == st[1])) - str = arg->arg_ptr.arg_str; - if (anum < 0) - anum += st[1]->str_cur + arybase; - if (anum < 0 || anum > st[1]->str_cur) - str_nset(str,"",0); - else { - optype = maxarg < 3 ? st[1]->str_cur : (int)str_gnum(st[3]); - if (optype < 0) - optype = 0; - tmps += anum; - anum = st[1]->str_cur - anum; /* anum=how many bytes left*/ - if (anum > optype) - anum = optype; - str_nset(str, tmps, anum); - if (argtype) { /* it's an lvalue! */ - Lstring *lstr = (Lstring*)str; - - str->str_magic = st[1]; - st[1]->str_rare = 's'; - lstr->lstr_offset = tmps - str_get(st[1]); - lstr->lstr_len = anum; - } - } - break; - case O_PACK: - /*SUPPRESS 701*/ - (void)do_pack(str,arglast); - break; - case O_GREP: - sp = do_grep(arg,str,gimme,arglast); - goto array_return; - case O_JOIN: - do_join(str,arglast); - break; - case O_SLT: - tmps = str_get(st[1]); - value = (double) (str_cmp(st[1],st[2]) < 0); - goto donumset; - case O_SGT: - tmps = str_get(st[1]); - value = (double) (str_cmp(st[1],st[2]) > 0); - goto donumset; - case O_SLE: - tmps = str_get(st[1]); - value = (double) (str_cmp(st[1],st[2]) <= 0); - goto donumset; - case O_SGE: - tmps = str_get(st[1]); - value = (double) (str_cmp(st[1],st[2]) >= 0); - goto donumset; - case O_SEQ: - tmps = str_get(st[1]); - value = (double) str_eq(st[1],st[2]); - goto donumset; - case O_SNE: - tmps = str_get(st[1]); - value = (double) !str_eq(st[1],st[2]); - goto donumset; - case O_SCMP: - tmps = str_get(st[1]); - value = (double) str_cmp(st[1],st[2]); - goto donumset; - case O_SUBR: - sp = do_subr(arg,gimme,arglast); - st = stack->ary_array + arglast[0]; /* maybe realloced */ - goto array_return; - case O_DBSUBR: - sp = do_subr(arg,gimme,arglast); - st = stack->ary_array + arglast[0]; /* maybe realloced */ - goto array_return; - case O_CALLER: - sp = do_caller(arg,maxarg,gimme,arglast); - st = stack->ary_array + arglast[0]; /* maybe realloced */ - goto array_return; - case O_SORT: - sp = do_sort(str,arg, - gimme,arglast); - goto array_return; - case O_REVERSE: - if (gimme == G_ARRAY) - sp = do_reverse(arglast); - else - sp = do_sreverse(str, arglast); - goto array_return; - case O_WARN: - if (arglast[2] - arglast[1] != 1) { - do_join(str,arglast); - tmps = str_get(str); - } - else { - str = st[2]; - tmps = str_get(st[2]); - } - if (!tmps || !*tmps) - tmps = "Warning: something's wrong"; - warn("%s",tmps); - goto say_yes; - case O_DIE: - if (arglast[2] - arglast[1] != 1) { - do_join(str,arglast); - tmps = str_get(str); - } - else { - str = st[2]; - tmps = str_get(st[2]); - } - if (!tmps || !*tmps) - tmps = "Died"; - fatal("%s",tmps); - goto say_zero; - case O_PRTF: - case O_PRINT: - if ((arg[1].arg_type & A_MASK) == A_WORD) - stab = arg[1].arg_ptr.arg_stab; - else - stab = stabent(str_get(st[1]),TRUE); - if (!stab) - stab = defoutstab; - if (!stab_io(stab)) { - if (dowarn) - warn("Filehandle never opened"); - goto say_zero; - } - if (!(fp = stab_io(stab)->ofp)) { - if (dowarn) { - if (stab_io(stab)->ifp) - warn("Filehandle opened only for input"); - else - warn("Print on closed filehandle"); - } - goto say_zero; - } - else { - if (optype == O_PRTF || arglast[2] - arglast[1] != 1) - value = (double)do_aprint(arg,fp,arglast); - else { - value = (double)do_print(st[2],fp); - if (orslen && optype == O_PRINT) - if (fwrite(ors, 1, orslen, fp) == 0) - goto say_zero; - } - if (stab_io(stab)->flags & IOF_FLUSH) - if (fflush(fp) == EOF) - goto say_zero; - } - goto donumset; - case O_CHDIR: - if (maxarg < 1) - tmps = Nullch; - else - tmps = str_get(st[1]); - if (!tmps || !*tmps) { - tmpstr = hfetch(stab_hash(envstab),"HOME",4,FALSE); - tmps = str_get(tmpstr); - } - if (!tmps || !*tmps) { - tmpstr = hfetch(stab_hash(envstab),"LOGDIR",6,FALSE); - tmps = str_get(tmpstr); - } -#ifdef TAINT - TAINT_PROPER("chdir"); -#endif - value = (double)(chdir(tmps) >= 0); - goto donumset; - case O_EXIT: - if (maxarg < 1) - anum = 0; - else - anum = (int)str_gnum(st[1]); - my_exit(anum); - goto say_zero; - case O_RESET: - if (maxarg < 1) - tmps = ""; - else - tmps = str_get(st[1]); - str_reset(tmps,curcmd->c_stash); - value = 1.0; - goto donumset; - case O_LIST: - if (gimme == G_ARRAY) - goto array_return; - if (maxarg > 0) - str = st[sp - arglast[0]]; /* unwanted list, return last item */ - else - str = &str_undef; - break; - case O_EOF: - if (maxarg <= 0) - stab = last_in_stab; - else if ((arg[1].arg_type & A_MASK) == A_WORD) - stab = arg[1].arg_ptr.arg_stab; - else - stab = stabent(str_get(st[1]),TRUE); - str_set(str, do_eof(stab) ? Yes : No); - STABSET(str); - break; - case O_GETC: - if (maxarg <= 0) - stab = stdinstab; - else if ((arg[1].arg_type & A_MASK) == A_WORD) - stab = arg[1].arg_ptr.arg_stab; - else - stab = stabent(str_get(st[1]),TRUE); - if (!stab) - stab = argvstab; - if (!stab || do_eof(stab)) /* make sure we have fp with something */ - goto say_undef; - else { -#ifdef TAINT - tainted = 1; -#endif - str_set(str," "); - *str->str_ptr = getc(stab_io(stab)->ifp); /* should never be EOF */ - } - STABSET(str); - break; - case O_TELL: - if (maxarg <= 0) - stab = last_in_stab; - else if ((arg[1].arg_type & A_MASK) == A_WORD) - stab = arg[1].arg_ptr.arg_stab; - else - stab = stabent(str_get(st[1]),TRUE); -#ifndef lint - value = (double)do_tell(stab); -#else - (void)do_tell(stab); -#endif - goto donumset; - case O_RECV: - case O_READ: - case O_SYSREAD: - if ((arg[1].arg_type & A_MASK) == A_WORD) - stab = arg[1].arg_ptr.arg_stab; - else - stab = stabent(str_get(st[1]),TRUE); - tmps = str_get(st[2]); - anum = (int)str_gnum(st[3]); - errno = 0; - maxarg = sp - arglast[0]; - if (maxarg > 4) - warn("Too many args on read"); - if (maxarg == 4) - maxarg = (int)str_gnum(st[4]); - else - maxarg = 0; - if (!stab_io(stab) || !stab_io(stab)->ifp) - goto say_undef; -#ifdef HAS_SOCKET - if (optype == O_RECV) { - argtype = sizeof buf; - STR_GROW(st[2], anum+1), (tmps = str_get(st[2])); /* sneaky */ - anum = recvfrom(fileno(stab_io(stab)->ifp), tmps, anum, maxarg, - buf, &argtype); - if (anum >= 0) { - st[2]->str_cur = anum; - st[2]->str_ptr[anum] = '\0'; - str_nset(str,buf,argtype); - } - else - str_sset(str,&str_undef); - break; - } -#else - if (optype == O_RECV) - goto badsock; -#endif - STR_GROW(st[2], anum+maxarg+1), (tmps = str_get(st[2])); /* sneaky */ - if (optype == O_SYSREAD) { - anum = read(fileno(stab_io(stab)->ifp), tmps+maxarg, anum); - } - else -#ifdef HAS_SOCKET - if (stab_io(stab)->type == 's') { - argtype = sizeof buf; - anum = recvfrom(fileno(stab_io(stab)->ifp), tmps+maxarg, anum, 0, - buf, &argtype); - } - else -#endif - anum = fread(tmps+maxarg, 1, anum, stab_io(stab)->ifp); - if (anum < 0) - goto say_undef; - st[2]->str_cur = anum+maxarg; - st[2]->str_ptr[anum+maxarg] = '\0'; - value = (double)anum; - goto donumset; - case O_SYSWRITE: - case O_SEND: - if ((arg[1].arg_type & A_MASK) == A_WORD) - stab = arg[1].arg_ptr.arg_stab; - else - stab = stabent(str_get(st[1]),TRUE); - tmps = str_get(st[2]); - anum = (int)str_gnum(st[3]); - errno = 0; - stio = stab_io(stab); - maxarg = sp - arglast[0]; - if (!stio || !stio->ifp) { - anum = -1; - if (dowarn) { - if (optype == O_SYSWRITE) - warn("Syswrite on closed filehandle"); - else - warn("Send on closed socket"); - } - } - else if (optype == O_SYSWRITE) { - if (maxarg > 4) - warn("Too many args on syswrite"); - if (maxarg == 4) - optype = (int)str_gnum(st[4]); - else - optype = 0; - anum = write(fileno(stab_io(stab)->ifp), tmps+optype, anum); - } -#ifdef HAS_SOCKET - else if (maxarg >= 4) { - if (maxarg > 4) - warn("Too many args on send"); - tmps2 = str_get(st[4]); - anum = sendto(fileno(stab_io(stab)->ifp), tmps, st[2]->str_cur, - anum, tmps2, st[4]->str_cur); - } - else - anum = send(fileno(stab_io(stab)->ifp), tmps, st[2]->str_cur, anum); -#else - else - goto badsock; -#endif - if (anum < 0) - goto say_undef; - value = (double)anum; - goto donumset; - case O_SEEK: - if ((arg[1].arg_type & A_MASK) == A_WORD) - stab = arg[1].arg_ptr.arg_stab; - else - stab = stabent(str_get(st[1]),TRUE); - value = str_gnum(st[2]); - str_set(str, do_seek(stab, - (long)value, (int)str_gnum(st[3]) ) ? Yes : No); - STABSET(str); - break; - case O_RETURN: - tmps = "_SUB_"; /* just fake up a "last _SUB_" */ - optype = O_LAST; - if (curcsv && curcsv->wantarray == G_ARRAY) { - lastretstr = Nullstr; - lastspbase = arglast[1]; - lastsize = arglast[2] - arglast[1]; - } - else - lastretstr = str_mortal(st[arglast[2] - arglast[0]]); - goto dopop; - case O_REDO: - case O_NEXT: - case O_LAST: - tmps = Nullch; - if (maxarg > 0) { - tmps = str_get(arg[1].arg_ptr.arg_str); - dopop: - while (loop_ptr >= 0 && (!loop_stack[loop_ptr].loop_label || - strNE(tmps,loop_stack[loop_ptr].loop_label) )) { -#ifdef DEBUGGING - if (debug & 4) { - deb("(Skipping label #%d %s)\n",loop_ptr, - loop_stack[loop_ptr].loop_label); - } -#endif - loop_ptr--; - } -#ifdef DEBUGGING - if (debug & 4) { - deb("(Found label #%d %s)\n",loop_ptr, - loop_stack[loop_ptr].loop_label); - } -#endif - } - if (loop_ptr < 0) { - if (tmps && strEQ(tmps, "_SUB_")) - fatal("Can't return outside a subroutine"); - fatal("Bad label: %s", maxarg > 0 ? tmps : ""); - } - if (!lastretstr && optype == O_LAST && lastsize) { - st -= arglast[0]; - st += lastspbase + 1; - optype = loop_stack[loop_ptr].loop_sp - lastspbase; /* negative */ - if (optype) { - for (anum = lastsize; anum > 0; anum--,st++) - st[optype] = str_mortal(st[0]); - } - longjmp(loop_stack[loop_ptr].loop_env, O_LAST); - } - longjmp(loop_stack[loop_ptr].loop_env, optype); - case O_DUMP: - case O_GOTO:/* shudder */ - goto_targ = str_get(arg[1].arg_ptr.arg_str); - if (!*goto_targ) - goto_targ = Nullch; /* just restart from top */ - if (optype == O_DUMP) { - do_undump = TRUE; - my_unexec(); - } - longjmp(top_env, 1); - case O_INDEX: - tmps = str_get(st[1]); - if (maxarg < 3) - anum = 0; - else { - anum = (int) str_gnum(st[3]) - arybase; - if (anum < 0) - anum = 0; - else if (anum > st[1]->str_cur) - anum = st[1]->str_cur; - } -#ifndef lint - if (!(tmps2 = fbminstr((unsigned char*)tmps + anum, - (unsigned char*)tmps + st[1]->str_cur, st[2]))) -#else - if (tmps2 = fbminstr(Null(unsigned char*),Null(unsigned char*),Nullstr)) -#endif - value = (double)(-1 + arybase); - else - value = (double)(tmps2 - tmps + arybase); - goto donumset; - case O_RINDEX: - tmps = str_get(st[1]); - tmps2 = str_get(st[2]); - if (maxarg < 3) - anum = st[1]->str_cur; - else { - anum = (int) str_gnum(st[3]) - arybase + st[2]->str_cur; - if (anum < 0) - anum = 0; - else if (anum > st[1]->str_cur) - anum = st[1]->str_cur; - } -#ifndef lint - if (!(tmps2 = rninstr(tmps, tmps + anum, - tmps2, tmps2 + st[2]->str_cur))) -#else - if (tmps2 = rninstr(Nullch,Nullch,Nullch,Nullch)) -#endif - value = (double)(-1 + arybase); - else - value = (double)(tmps2 - tmps + arybase); - goto donumset; - case O_TIME: -#ifndef lint - value = (double) time(Null(long*)); -#endif - goto donumset; - case O_TMS: - sp = do_tms(str,gimme,arglast); - goto array_return; - case O_LOCALTIME: - if (maxarg < 1) - (void)time(&when); - else - when = (time_t)str_gnum(st[1]); - sp = do_time(str,localtime(&when), - gimme,arglast); - goto array_return; - case O_GMTIME: - if (maxarg < 1) - (void)time(&when); - else - when = (time_t)str_gnum(st[1]); - sp = do_time(str,gmtime(&when), - gimme,arglast); - goto array_return; - case O_TRUNCATE: - sp = do_truncate(str,arg, - gimme,arglast); - goto array_return; - case O_LSTAT: - case O_STAT: - sp = do_stat(str,arg, - gimme,arglast); - goto array_return; - case O_CRYPT: -#ifdef HAS_CRYPT - tmps = str_get(st[1]); -#ifdef FCRYPT - str_set(str,fcrypt(tmps,str_get(st[2]))); -#else - str_set(str,crypt(tmps,str_get(st[2]))); -#endif -#else - fatal( - "The crypt() function is unimplemented due to excessive paranoia."); -#endif - break; - case O_ATAN2: - value = str_gnum(st[1]); - value = atan2(value,str_gnum(st[2])); - goto donumset; - case O_SIN: - if (maxarg < 1) - value = str_gnum(stab_val(defstab)); - else - value = str_gnum(st[1]); - value = sin(value); - goto donumset; - case O_COS: - if (maxarg < 1) - value = str_gnum(stab_val(defstab)); - else - value = str_gnum(st[1]); - value = cos(value); - goto donumset; - case O_RAND: - if (maxarg < 1) - value = 1.0; - else - value = str_gnum(st[1]); - if (value == 0.0) - value = 1.0; -#if RANDBITS == 31 - value = rand() * value / 2147483648.0; -#else -#if RANDBITS == 16 - value = rand() * value / 65536.0; -#else -#if RANDBITS == 15 - value = rand() * value / 32768.0; -#else - value = rand() * value / (double)(((unsigned long)1) << RANDBITS); -#endif -#endif -#endif - goto donumset; - case O_SRAND: - if (maxarg < 1) { - (void)time(&when); - anum = when; - } - else - anum = (int)str_gnum(st[1]); - (void)srand(anum); - goto say_yes; - case O_EXP: - if (maxarg < 1) - value = str_gnum(stab_val(defstab)); - else - value = str_gnum(st[1]); - value = exp(value); - goto donumset; - case O_LOG: - if (maxarg < 1) - value = str_gnum(stab_val(defstab)); - else - value = str_gnum(st[1]); - if (value <= 0.0) - fatal("Can't take log of %g\n", value); - value = log(value); - goto donumset; - case O_SQRT: - if (maxarg < 1) - value = str_gnum(stab_val(defstab)); - else - value = str_gnum(st[1]); - if (value < 0.0) - fatal("Can't take sqrt of %g\n", value); - value = sqrt(value); - goto donumset; - case O_INT: - if (maxarg < 1) - value = str_gnum(stab_val(defstab)); - else - value = str_gnum(st[1]); - if (value >= 0.0) - (void)modf(value,&value); - else { - (void)modf(-value,&value); - value = -value; - } - goto donumset; - case O_ORD: - if (maxarg < 1) - tmps = str_get(stab_val(defstab)); - else - tmps = str_get(st[1]); -#ifndef I286 - value = (double) (*tmps & 255); -#else - anum = (int) *tmps; - value = (double) (anum & 255); -#endif - goto donumset; - case O_ALARM: -#ifdef HAS_ALARM - if (maxarg < 1) - tmps = str_get(stab_val(defstab)); - else - tmps = str_get(st[1]); - if (!tmps) - tmps = "0"; - anum = alarm((unsigned int)atoi(tmps)); - if (anum < 0) - goto say_undef; - value = (double)anum; - goto donumset; -#else - fatal("Unsupported function alarm"); - break; -#endif - case O_SLEEP: - if (maxarg < 1) - tmps = Nullch; - else - tmps = str_get(st[1]); - (void)time(&when); - if (!tmps || !*tmps) - sleep((32767<<16)+32767); - else - sleep((unsigned int)atoi(tmps)); -#ifndef lint - value = (double)when; - (void)time(&when); - value = ((double)when) - value; -#endif - goto donumset; - case O_RANGE: - sp = do_range(gimme,arglast); - goto array_return; - case O_F_OR_R: - if (gimme == G_ARRAY) { /* it's a range */ - /* can we optimize to constant array? */ - if ((arg[1].arg_type & A_MASK) == A_SINGLE && - (arg[2].arg_type & A_MASK) == A_SINGLE) { - st[2] = arg[2].arg_ptr.arg_str; - sp = do_range(gimme,arglast); - st = stack->ary_array; - maxarg = sp - arglast[0]; - str_free(arg[1].arg_ptr.arg_str); - arg[1].arg_ptr.arg_str = Nullstr; - str_free(arg[2].arg_ptr.arg_str); - arg[2].arg_ptr.arg_str = Nullstr; - arg->arg_type = O_ARRAY; - arg[1].arg_type = A_STAB|A_DONT; - arg->arg_len = 1; - stab = arg[1].arg_ptr.arg_stab = aadd(genstab()); - ary = stab_array(stab); - afill(ary,maxarg - 1); - anum = maxarg; - st += arglast[0]+1; - while (maxarg-- > 0) - ary->ary_array[maxarg] = str_smake(st[maxarg]); - st -= arglast[0]+1; - goto array_return; - } - arg->arg_type = optype = O_RANGE; - maxarg = arg->arg_len = 2; - anum = 2; - arg[anum].arg_flags &= ~AF_ARYOK; - argflags = arg[anum].arg_flags; - argtype = arg[anum].arg_type & A_MASK; - arg[anum].arg_type = argtype; - argptr = arg[anum].arg_ptr; - sp = arglast[0]; - st -= sp; - sp++; - goto re_eval; - } - arg->arg_type = O_FLIP; - /* FALL THROUGH */ - case O_FLIP: - if ((arg[1].arg_type & A_MASK) == A_SINGLE ? - last_in_stab && (int)str_gnum(st[1]) == stab_io(last_in_stab)->lines - : - str_true(st[1]) ) { - arg[2].arg_type &= ~A_DONT; - arg[1].arg_type |= A_DONT; - arg->arg_type = optype = O_FLOP; - if (arg->arg_flags & AF_COMMON) { - str_numset(str,0.0); - anum = 2; - argflags = arg[2].arg_flags; - argtype = arg[2].arg_type & A_MASK; - argptr = arg[2].arg_ptr; - sp = arglast[0]; - st -= sp++; - goto re_eval; - } - else { - str_numset(str,1.0); - break; - } - } - str_set(str,""); - break; - case O_FLOP: - str_inc(str); - if ((arg[2].arg_type & A_MASK) == A_SINGLE ? - last_in_stab && (int)str_gnum(st[2]) == stab_io(last_in_stab)->lines - : - str_true(st[2]) ) { - arg->arg_type = O_FLIP; - arg[1].arg_type &= ~A_DONT; - arg[2].arg_type |= A_DONT; - str_cat(str,"E0"); - } - break; - case O_FORK: -#ifdef HAS_FORK - anum = fork(); - if (anum < 0) - goto say_undef; - if (!anum) { - /*SUPPRESS 560*/ - if (tmpstab = stabent("$",allstabs)) - str_numset(STAB_STR(tmpstab),(double)getpid()); - hclear(pidstatus, FALSE); /* no kids, so don't wait for 'em */ - } - value = (double)anum; - goto donumset; -#else - fatal("Unsupported function fork"); - break; -#endif - case O_WAIT: -#ifdef HAS_WAIT -#ifndef lint - anum = wait(&argflags); - if (anum > 0) - pidgone(anum,argflags); - value = (double)anum; -#endif - statusvalue = (unsigned short)argflags; - goto donumset; -#else - fatal("Unsupported function wait"); - break; -#endif - case O_WAITPID: -#ifdef HAS_WAIT -#ifndef lint - anum = (int)str_gnum(st[1]); - optype = (int)str_gnum(st[2]); - anum = wait4pid(anum, &argflags,optype); - value = (double)anum; -#endif - statusvalue = (unsigned short)argflags; - goto donumset; -#else - fatal("Unsupported function wait"); - break; -#endif - case O_SYSTEM: -#ifdef HAS_FORK -#ifdef TAINT - if (arglast[2] - arglast[1] == 1) { - taintenv(); - tainted |= st[2]->str_tainted; - TAINT_PROPER("system"); - } -#endif - while ((anum = vfork()) == -1) { - if (errno != EAGAIN) { - value = -1.0; - goto donumset; - } - sleep(5); - } - if (anum > 0) { -#ifndef lint - ihand = signal(SIGINT, SIG_IGN); - qhand = signal(SIGQUIT, SIG_IGN); - argtype = wait4pid(anum, &argflags, 0); -#else - ihand = qhand = 0; -#endif - (void)signal(SIGINT, ihand); - (void)signal(SIGQUIT, qhand); - statusvalue = (unsigned short)argflags; - if (argtype < 0) - value = -1.0; - else { - value = (double)((unsigned int)argflags & 0xffff); - } - do_execfree(); /* free any memory child malloced on vfork */ - goto donumset; - } - if ((arg[1].arg_type & A_MASK) == A_STAB) - value = (double)do_aexec(st[1],arglast); - else if (arglast[2] - arglast[1] != 1) - value = (double)do_aexec(Nullstr,arglast); - else { - value = (double)do_exec(str_get(str_mortal(st[2]))); - } - _exit(-1); -#else /* ! FORK */ - if ((arg[1].arg_type & A_MASK) == A_STAB) - value = (double)do_aspawn(st[1],arglast); - else if (arglast[2] - arglast[1] != 1) - value = (double)do_aspawn(Nullstr,arglast); - else { - value = (double)do_spawn(str_get(str_mortal(st[2]))); - } - goto donumset; -#endif /* FORK */ - case O_EXEC_OP: - if ((arg[1].arg_type & A_MASK) == A_STAB) - value = (double)do_aexec(st[1],arglast); - else if (arglast[2] - arglast[1] != 1) - value = (double)do_aexec(Nullstr,arglast); - else { -#ifdef TAINT - taintenv(); - tainted |= st[2]->str_tainted; - TAINT_PROPER("exec"); -#endif - value = (double)do_exec(str_get(str_mortal(st[2]))); - } - goto donumset; - case O_HEX: - if (maxarg < 1) - tmps = str_get(stab_val(defstab)); - else - tmps = str_get(st[1]); - value = (double)scanhex(tmps, 99, &argtype); - goto donumset; - - case O_OCT: - if (maxarg < 1) - tmps = str_get(stab_val(defstab)); - else - tmps = str_get(st[1]); - while (*tmps && (isSPACE(*tmps) || *tmps == '0')) - tmps++; - if (*tmps == 'x') - value = (double)scanhex(++tmps, 99, &argtype); - else - value = (double)scanoct(tmps, 99, &argtype); - goto donumset; - -/* These common exits are hidden here in the middle of the switches for the - benefit of those machines with limited branch addressing. Sigh. */ - -array_return: -#ifdef DEBUGGING - if (debug) { - dlevel--; - if (debug & 8) { - anum = sp - arglast[0]; - switch (anum) { - case 0: - deb("%s RETURNS ()\n",opname[optype]); - break; - case 1: - deb("%s RETURNS (\"%s\")\n",opname[optype], - st[1] ? str_get(st[1]) : ""); - break; - default: - tmps = st[1] ? str_get(st[1]) : ""; - deb("%s RETURNS %d ARGS (\"%s\",%s\"%s\")\n",opname[optype], - anum,tmps,anum==2?"":"...,", - st[anum] ? str_get(st[anum]) : ""); - break; - } - } - } -#endif - stack_ary = stack->ary_array; - stack_max = stack_ary + stack->ary_max; - stack_sp = stack_ary + sp; - return sp; - -say_yes: - str = &str_yes; - goto normal_return; - -say_no: - str = &str_no; - goto normal_return; - -say_undef: - str = &str_undef; - goto normal_return; - -say_zero: - value = 0.0; - /* FALL THROUGH */ - -donumset: - str_numset(str,value); - STABSET(str); - st[1] = str; -#ifdef DEBUGGING - if (debug) { - dlevel--; - if (debug & 8) - deb("%s RETURNS \"%f\"\n",opname[optype],value); - } -#endif - stack_ary = stack->ary_array; - stack_max = stack_ary + stack->ary_max; - stack_sp = stack_ary + arglast[0] + 1; - return arglast[0] + 1; -#ifdef SMALLSWITCHES - } - else - switch (optype) { -#endif - case O_CHOWN: -#ifdef HAS_CHOWN - value = (double)apply(optype,arglast); - goto donumset; -#else - fatal("Unsupported function chown"); - break; -#endif - case O_KILL: -#ifdef HAS_KILL - value = (double)apply(optype,arglast); - goto donumset; -#else - fatal("Unsupported function kill"); - break; -#endif - case O_UNLINK: - case O_CHMOD: - case O_UTIME: - value = (double)apply(optype,arglast); - goto donumset; - case O_UMASK: -#ifdef HAS_UMASK - if (maxarg < 1) { - anum = umask(0); - (void)umask(anum); - } - else - anum = umask((int)str_gnum(st[1])); - value = (double)anum; -#ifdef TAINT - TAINT_PROPER("umask"); -#endif - goto donumset; -#else - fatal("Unsupported function umask"); - break; -#endif -#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM) - case O_MSGGET: - case O_SHMGET: - case O_SEMGET: - if ((anum = do_ipcget(optype, arglast)) == -1) - goto say_undef; - value = (double)anum; - goto donumset; - case O_MSGCTL: - case O_SHMCTL: - case O_SEMCTL: - anum = do_ipcctl(optype, arglast); - if (anum == -1) - goto say_undef; - if (anum != 0) { - value = (double)anum; - goto donumset; - } - str_set(str,"0 but true"); - STABSET(str); - break; - case O_MSGSND: - value = (double)(do_msgsnd(arglast) >= 0); - goto donumset; - case O_MSGRCV: - value = (double)(do_msgrcv(arglast) >= 0); - goto donumset; - case O_SEMOP: - value = (double)(do_semop(arglast) >= 0); - goto donumset; - case O_SHMREAD: - case O_SHMWRITE: - value = (double)(do_shmio(optype, arglast) >= 0); - goto donumset; -#else /* not SYSVIPC */ - case O_MSGGET: - case O_MSGCTL: - case O_MSGSND: - case O_MSGRCV: - case O_SEMGET: - case O_SEMCTL: - case O_SEMOP: - case O_SHMGET: - case O_SHMCTL: - case O_SHMREAD: - case O_SHMWRITE: - fatal("System V IPC is not implemented on this machine"); -#endif /* not SYSVIPC */ - case O_RENAME: - tmps = str_get(st[1]); - tmps2 = str_get(st[2]); -#ifdef TAINT - TAINT_PROPER("rename"); -#endif -#ifdef HAS_RENAME - value = (double)(rename(tmps,tmps2) >= 0); -#else - if (same_dirent(tmps2, tmps)) /* can always rename to same name */ - anum = 1; - else { - if (euid || stat(tmps2,&statbuf) < 0 || !S_ISDIR(statbuf.st_mode)) - (void)UNLINK(tmps2); - if (!(anum = link(tmps,tmps2))) - anum = UNLINK(tmps); - } - value = (double)(anum >= 0); -#endif - goto donumset; - case O_LINK: -#ifdef HAS_LINK - tmps = str_get(st[1]); - tmps2 = str_get(st[2]); -#ifdef TAINT - TAINT_PROPER("link"); -#endif - value = (double)(link(tmps,tmps2) >= 0); - goto donumset; -#else - fatal("Unsupported function link"); - break; -#endif - case O_MKDIR: - tmps = str_get(st[1]); - anum = (int)str_gnum(st[2]); -#ifdef TAINT - TAINT_PROPER("mkdir"); -#endif -#ifdef HAS_MKDIR - value = (double)(mkdir(tmps,anum) >= 0); - goto donumset; -#else - (void)strcpy(buf,"mkdir "); -#endif -#if !defined(HAS_MKDIR) || !defined(HAS_RMDIR) - one_liner: - for (tmps2 = buf+6; *tmps; ) { - *tmps2++ = '\\'; - *tmps2++ = *tmps++; - } - (void)strcpy(tmps2," 2>&1"); - rsfp = mypopen(buf,"r"); - if (rsfp) { - *buf = '\0'; - tmps2 = fgets(buf,sizeof buf,rsfp); - (void)mypclose(rsfp); - if (tmps2 != Nullch) { - for (errno = 1; errno < sys_nerr; errno++) { - if (instr(buf,sys_errlist[errno])) /* you don't see this */ - goto say_zero; - } - errno = 0; -#ifndef EACCES -#define EACCES EPERM -#endif - if (instr(buf,"cannot make")) - errno = EEXIST; - else if (instr(buf,"existing file")) - errno = EEXIST; - else if (instr(buf,"ile exists")) - errno = EEXIST; - else if (instr(buf,"non-exist")) - errno = ENOENT; - else if (instr(buf,"does not exist")) - errno = ENOENT; - else if (instr(buf,"not empty")) - errno = EBUSY; - else if (instr(buf,"cannot access")) - errno = EACCES; - else - errno = EPERM; - goto say_zero; - } - else { /* some mkdirs return no failure indication */ - tmps = str_get(st[1]); - anum = (stat(tmps,&statbuf) >= 0); - if (optype == O_RMDIR) - anum = !anum; - if (anum) - errno = 0; - else - errno = EACCES; /* a guess */ - value = (double)anum; - } - goto donumset; - } - else - goto say_zero; -#endif - case O_RMDIR: - if (maxarg < 1) - tmps = str_get(stab_val(defstab)); - else - tmps = str_get(st[1]); -#ifdef TAINT - TAINT_PROPER("rmdir"); -#endif -#ifdef HAS_RMDIR - value = (double)(rmdir(tmps) >= 0); - goto donumset; -#else - (void)strcpy(buf,"rmdir "); - goto one_liner; /* see above in HAS_MKDIR */ -#endif - case O_GETPPID: -#ifdef HAS_GETPPID - value = (double)getppid(); - goto donumset; -#else - fatal("Unsupported function getppid"); - break; -#endif - case O_GETPGRP: -#ifdef HAS_GETPGRP - if (maxarg < 1) - anum = 0; - else - anum = (int)str_gnum(st[1]); -#ifdef _POSIX_SOURCE - if (anum != 0) - fatal("POSIX getpgrp can't take an argument"); - value = (double)getpgrp(); -#else - value = (double)getpgrp(anum); -#endif - goto donumset; -#else - fatal("The getpgrp() function is unimplemented on this machine"); - break; -#endif - case O_SETPGRP: -#ifdef HAS_SETPGRP - argtype = (int)str_gnum(st[1]); - anum = (int)str_gnum(st[2]); -#ifdef TAINT - TAINT_PROPER("setpgrp"); -#endif - value = (double)(setpgrp(argtype,anum) >= 0); - goto donumset; -#else - fatal("The setpgrp() function is unimplemented on this machine"); - break; -#endif - case O_GETPRIORITY: -#ifdef HAS_GETPRIORITY - argtype = (int)str_gnum(st[1]); - anum = (int)str_gnum(st[2]); - value = (double)getpriority(argtype,anum); - goto donumset; -#else - fatal("The getpriority() function is unimplemented on this machine"); - break; -#endif - case O_SETPRIORITY: -#ifdef HAS_SETPRIORITY - argtype = (int)str_gnum(st[1]); - anum = (int)str_gnum(st[2]); - optype = (int)str_gnum(st[3]); -#ifdef TAINT - TAINT_PROPER("setpriority"); -#endif - value = (double)(setpriority(argtype,anum,optype) >= 0); - goto donumset; -#else - fatal("The setpriority() function is unimplemented on this machine"); - break; -#endif - case O_CHROOT: -#ifdef HAS_CHROOT - if (maxarg < 1) - tmps = str_get(stab_val(defstab)); - else - tmps = str_get(st[1]); -#ifdef TAINT - TAINT_PROPER("chroot"); -#endif - value = (double)(chroot(tmps) >= 0); - goto donumset; -#else - fatal("Unsupported function chroot"); - break; -#endif - case O_FCNTL: - case O_IOCTL: - if (maxarg <= 0) - stab = last_in_stab; - else if ((arg[1].arg_type & A_MASK) == A_WORD) - stab = arg[1].arg_ptr.arg_stab; - else - stab = stabent(str_get(st[1]),TRUE); - argtype = U_I(str_gnum(st[2])); -#ifdef TAINT - TAINT_PROPER("ioctl"); -#endif - anum = do_ctl(optype,stab,argtype,st[3]); - if (anum == -1) - goto say_undef; - if (anum != 0) { - value = (double)anum; - goto donumset; - } - str_set(str,"0 but true"); - STABSET(str); - break; - case O_FLOCK: -#ifdef HAS_FLOCK - if (maxarg <= 0) - stab = last_in_stab; - else if ((arg[1].arg_type & A_MASK) == A_WORD) - stab = arg[1].arg_ptr.arg_stab; - else - stab = stabent(str_get(st[1]),TRUE); - if (stab && stab_io(stab)) - fp = stab_io(stab)->ifp; - else - fp = Nullfp; - if (fp) { - argtype = (int)str_gnum(st[2]); - value = (double)(flock(fileno(fp),argtype) >= 0); - } - else - value = 0; - goto donumset; -#else - fatal("The flock() function is unimplemented on this machine"); - break; -#endif - case O_UNSHIFT: - ary = stab_array(arg[1].arg_ptr.arg_stab); - if (arglast[2] - arglast[1] != 1) - do_unshift(ary,arglast); - else { - STR *tmpstr = Str_new(52,0); /* must copy the STR */ - str_sset(tmpstr,st[2]); - aunshift(ary,1); - (void)astore(ary,0,tmpstr); - } - value = (double)(ary->ary_fill + 1); - goto donumset; - - case O_TRY: - sp = do_try(arg[1].arg_ptr.arg_cmd, - gimme,arglast); - goto array_return; - - case O_EVALONCE: - sp = do_eval(st[1], O_EVAL, curcmd->c_stash, TRUE, - gimme,arglast); - if (eval_root) { - str_free(arg[1].arg_ptr.arg_str); - arg[1].arg_ptr.arg_cmd = eval_root; - arg[1].arg_type = (A_CMD|A_DONT); - arg[0].arg_type = O_TRY; - } - goto array_return; - - case O_REQUIRE: - case O_DOFILE: - case O_EVAL: - if (maxarg < 1) - tmpstr = stab_val(defstab); - else - tmpstr = - (arg[1].arg_type & A_MASK) != A_NULL ? st[1] : stab_val(defstab); -#ifdef TAINT - tainted |= tmpstr->str_tainted; - TAINT_PROPER("eval"); -#endif - sp = do_eval(tmpstr, optype, curcmd->c_stash, FALSE, - gimme,arglast); - goto array_return; - - case O_FTRREAD: - argtype = 0; - anum = S_IRUSR; - goto check_perm; - case O_FTRWRITE: - argtype = 0; - anum = S_IWUSR; - goto check_perm; - case O_FTREXEC: - argtype = 0; - anum = S_IXUSR; - goto check_perm; - case O_FTEREAD: - argtype = 1; - anum = S_IRUSR; - goto check_perm; - case O_FTEWRITE: - argtype = 1; - anum = S_IWUSR; - goto check_perm; - case O_FTEEXEC: - argtype = 1; - anum = S_IXUSR; - check_perm: - if (mystat(arg,st[1]) < 0) - goto say_undef; - if (cando(anum,argtype,&statcache)) - goto say_yes; - goto say_no; - - case O_FTIS: - if (mystat(arg,st[1]) < 0) - goto say_undef; - goto say_yes; - case O_FTEOWNED: - case O_FTROWNED: - if (mystat(arg,st[1]) < 0) - goto say_undef; - if (statcache.st_uid == (optype == O_FTEOWNED ? euid : uid) ) - goto say_yes; - goto say_no; - case O_FTZERO: - if (mystat(arg,st[1]) < 0) - goto say_undef; - if (!statcache.st_size) - goto say_yes; - goto say_no; - case O_FTSIZE: - if (mystat(arg,st[1]) < 0) - goto say_undef; - value = (double)statcache.st_size; - goto donumset; - - case O_FTMTIME: - if (mystat(arg,st[1]) < 0) - goto say_undef; - value = (double)(basetime - statcache.st_mtime) / 86400.0; - goto donumset; - case O_FTATIME: - if (mystat(arg,st[1]) < 0) - goto say_undef; - value = (double)(basetime - statcache.st_atime) / 86400.0; - goto donumset; - case O_FTCTIME: - if (mystat(arg,st[1]) < 0) - goto say_undef; - value = (double)(basetime - statcache.st_ctime) / 86400.0; - goto donumset; - - case O_FTSOCK: - if (mystat(arg,st[1]) < 0) - goto say_undef; - if (S_ISSOCK(statcache.st_mode)) - goto say_yes; - goto say_no; - case O_FTCHR: - if (mystat(arg,st[1]) < 0) - goto say_undef; - if (S_ISCHR(statcache.st_mode)) - goto say_yes; - goto say_no; - case O_FTBLK: - if (mystat(arg,st[1]) < 0) - goto say_undef; - if (S_ISBLK(statcache.st_mode)) - goto say_yes; - goto say_no; - case O_FTFILE: - if (mystat(arg,st[1]) < 0) - goto say_undef; - if (S_ISREG(statcache.st_mode)) - goto say_yes; - goto say_no; - case O_FTDIR: - if (mystat(arg,st[1]) < 0) - goto say_undef; - if (S_ISDIR(statcache.st_mode)) - goto say_yes; - goto say_no; - case O_FTPIPE: - if (mystat(arg,st[1]) < 0) - goto say_undef; - if (S_ISFIFO(statcache.st_mode)) - goto say_yes; - goto say_no; - case O_FTLINK: - if (mylstat(arg,st[1]) < 0) - goto say_undef; - if (S_ISLNK(statcache.st_mode)) - goto say_yes; - goto say_no; - case O_SYMLINK: -#ifdef HAS_SYMLINK - tmps = str_get(st[1]); - tmps2 = str_get(st[2]); -#ifdef TAINT - TAINT_PROPER("symlink"); -#endif - value = (double)(symlink(tmps,tmps2) >= 0); - goto donumset; -#else - fatal("Unsupported function symlink"); -#endif - case O_READLINK: -#ifdef HAS_SYMLINK - if (maxarg < 1) - tmps = str_get(stab_val(defstab)); - else - tmps = str_get(st[1]); - anum = readlink(tmps,buf,sizeof buf); - if (anum < 0) - goto say_undef; - str_nset(str,buf,anum); - break; -#else - goto say_undef; /* just pretend it's a normal file */ -#endif - case O_FTSUID: -#ifdef S_ISUID - anum = S_ISUID; - goto check_xid; -#else - goto say_no; -#endif - case O_FTSGID: -#ifdef S_ISGID - anum = S_ISGID; - goto check_xid; -#else - goto say_no; -#endif - case O_FTSVTX: -#ifdef S_ISVTX - anum = S_ISVTX; -#else - goto say_no; -#endif - check_xid: - if (mystat(arg,st[1]) < 0) - goto say_undef; - if (statcache.st_mode & anum) - goto say_yes; - goto say_no; - case O_FTTTY: - if (arg[1].arg_type & A_DONT) { - stab = arg[1].arg_ptr.arg_stab; - tmps = ""; - } - else - stab = stabent(tmps = str_get(st[1]),FALSE); - if (stab && stab_io(stab) && stab_io(stab)->ifp) - anum = fileno(stab_io(stab)->ifp); - else if (isDIGIT(*tmps)) - anum = atoi(tmps); - else - goto say_undef; - if (isatty(anum)) - goto say_yes; - goto say_no; - case O_FTTEXT: - case O_FTBINARY: - str = do_fttext(arg,st[1]); - break; -#ifdef HAS_SOCKET - case O_SOCKET: - if ((arg[1].arg_type & A_MASK) == A_WORD) - stab = arg[1].arg_ptr.arg_stab; - else - stab = stabent(str_get(st[1]),TRUE); -#ifndef lint - value = (double)do_socket(stab,arglast); -#else - (void)do_socket(stab,arglast); -#endif - goto donumset; - case O_BIND: - if ((arg[1].arg_type & A_MASK) == A_WORD) - stab = arg[1].arg_ptr.arg_stab; - else - stab = stabent(str_get(st[1]),TRUE); -#ifndef lint - value = (double)do_bind(stab,arglast); -#else - (void)do_bind(stab,arglast); -#endif - goto donumset; - case O_CONNECT: - if ((arg[1].arg_type & A_MASK) == A_WORD) - stab = arg[1].arg_ptr.arg_stab; - else - stab = stabent(str_get(st[1]),TRUE); -#ifndef lint - value = (double)do_connect(stab,arglast); -#else - (void)do_connect(stab,arglast); -#endif - goto donumset; - case O_LISTEN: - if ((arg[1].arg_type & A_MASK) == A_WORD) - stab = arg[1].arg_ptr.arg_stab; - else - stab = stabent(str_get(st[1]),TRUE); -#ifndef lint - value = (double)do_listen(stab,arglast); -#else - (void)do_listen(stab,arglast); -#endif - goto donumset; - case O_ACCEPT: - if ((arg[1].arg_type & A_MASK) == A_WORD) - stab = arg[1].arg_ptr.arg_stab; - else - stab = stabent(str_get(st[1]),TRUE); - if ((arg[2].arg_type & A_MASK) == A_WORD) - stab2 = arg[2].arg_ptr.arg_stab; - else - stab2 = stabent(str_get(st[2]),TRUE); - do_accept(str,stab,stab2); - STABSET(str); - break; - case O_GHBYNAME: - if (maxarg < 1) - goto say_undef; - case O_GHBYADDR: - case O_GHOSTENT: - sp = do_ghent(optype, - gimme,arglast); - goto array_return; - case O_GNBYNAME: - if (maxarg < 1) - goto say_undef; - case O_GNBYADDR: - case O_GNETENT: - sp = do_gnent(optype, - gimme,arglast); - goto array_return; - case O_GPBYNAME: - if (maxarg < 1) - goto say_undef; - case O_GPBYNUMBER: - case O_GPROTOENT: - sp = do_gpent(optype, - gimme,arglast); - goto array_return; - case O_GSBYNAME: - if (maxarg < 1) - goto say_undef; - case O_GSBYPORT: - case O_GSERVENT: - sp = do_gsent(optype, - gimme,arglast); - goto array_return; - case O_SHOSTENT: - value = (double) sethostent((int)str_gnum(st[1])); - goto donumset; - case O_SNETENT: - value = (double) setnetent((int)str_gnum(st[1])); - goto donumset; - case O_SPROTOENT: - value = (double) setprotoent((int)str_gnum(st[1])); - goto donumset; - case O_SSERVENT: - value = (double) setservent((int)str_gnum(st[1])); - goto donumset; - case O_EHOSTENT: - value = (double) endhostent(); - goto donumset; - case O_ENETENT: - value = (double) endnetent(); - goto donumset; - case O_EPROTOENT: - value = (double) endprotoent(); - goto donumset; - case O_ESERVENT: - value = (double) endservent(); - goto donumset; - case O_SOCKPAIR: - if ((arg[1].arg_type & A_MASK) == A_WORD) - stab = arg[1].arg_ptr.arg_stab; - else - stab = stabent(str_get(st[1]),TRUE); - if ((arg[2].arg_type & A_MASK) == A_WORD) - stab2 = arg[2].arg_ptr.arg_stab; - else - stab2 = stabent(str_get(st[2]),TRUE); -#ifndef lint - value = (double)do_spair(stab,stab2,arglast); -#else - (void)do_spair(stab,stab2,arglast); -#endif - goto donumset; - case O_SHUTDOWN: - if ((arg[1].arg_type & A_MASK) == A_WORD) - stab = arg[1].arg_ptr.arg_stab; - else - stab = stabent(str_get(st[1]),TRUE); -#ifndef lint - value = (double)do_shutdown(stab,arglast); -#else - (void)do_shutdown(stab,arglast); -#endif - goto donumset; - case O_GSOCKOPT: - case O_SSOCKOPT: - if ((arg[1].arg_type & A_MASK) == A_WORD) - stab = arg[1].arg_ptr.arg_stab; - else - stab = stabent(str_get(st[1]),TRUE); - sp = do_sopt(optype,stab,arglast); - goto array_return; - case O_GETSOCKNAME: - case O_GETPEERNAME: - if ((arg[1].arg_type & A_MASK) == A_WORD) - stab = arg[1].arg_ptr.arg_stab; - else - stab = stabent(str_get(st[1]),TRUE); - if (!stab) - goto say_undef; - sp = do_getsockname(optype,stab,arglast); - goto array_return; - -#else /* HAS_SOCKET not defined */ - case O_SOCKET: - case O_BIND: - case O_CONNECT: - case O_LISTEN: - case O_ACCEPT: - case O_SOCKPAIR: - case O_GHBYNAME: - case O_GHBYADDR: - case O_GHOSTENT: - case O_GNBYNAME: - case O_GNBYADDR: - case O_GNETENT: - case O_GPBYNAME: - case O_GPBYNUMBER: - case O_GPROTOENT: - case O_GSBYNAME: - case O_GSBYPORT: - case O_GSERVENT: - case O_SHOSTENT: - case O_SNETENT: - case O_SPROTOENT: - case O_SSERVENT: - case O_EHOSTENT: - case O_ENETENT: - case O_EPROTOENT: - case O_ESERVENT: - case O_SHUTDOWN: - case O_GSOCKOPT: - case O_SSOCKOPT: - case O_GETSOCKNAME: - case O_GETPEERNAME: - badsock: - fatal("Unsupported socket function"); -#endif /* HAS_SOCKET */ - case O_SSELECT: -#ifdef HAS_SELECT - sp = do_select(gimme,arglast); - goto array_return; -#else - fatal("select not implemented"); -#endif - case O_FILENO: - if (maxarg < 1) - goto say_undef; - if ((arg[1].arg_type & A_MASK) == A_WORD) - stab = arg[1].arg_ptr.arg_stab; - else - stab = stabent(str_get(st[1]),TRUE); - if (!stab || !(stio = stab_io(stab)) || !(fp = stio->ifp)) - goto say_undef; - value = fileno(fp); - goto donumset; - case O_BINMODE: - if (maxarg < 1) - goto say_undef; - if ((arg[1].arg_type & A_MASK) == A_WORD) - stab = arg[1].arg_ptr.arg_stab; - else - stab = stabent(str_get(st[1]),TRUE); - if (!stab || !(stio = stab_io(stab)) || !(fp = stio->ifp)) - goto say_undef; -#ifdef DOSISH -#ifdef atarist - if(fflush(fp)) - str_set(str, No); - else - { - fp->_flag |= _IOBIN; - str_set(str, Yes); - } -#else - str_set(str, (setmode(fileno(fp), O_BINARY) != -1) ? Yes : No); -#endif -#else - str_set(str, Yes); -#endif - STABSET(str); - break; - case O_VEC: - sp = do_vec(str == st[1], arg->arg_ptr.arg_str, arglast); - goto array_return; - case O_GPWNAM: - case O_GPWUID: - case O_GPWENT: -#ifdef HAS_PASSWD - sp = do_gpwent(optype, - gimme,arglast); - goto array_return; - case O_SPWENT: - value = (double) setpwent(); - goto donumset; - case O_EPWENT: - value = (double) endpwent(); - goto donumset; -#else - case O_EPWENT: - case O_SPWENT: - fatal("Unsupported password function"); - break; -#endif - case O_GGRNAM: - case O_GGRGID: - case O_GGRENT: -#ifdef HAS_GROUP - sp = do_ggrent(optype, - gimme,arglast); - goto array_return; - case O_SGRENT: - value = (double) setgrent(); - goto donumset; - case O_EGRENT: - value = (double) endgrent(); - goto donumset; -#else - case O_EGRENT: - case O_SGRENT: - fatal("Unsupported group function"); - break; -#endif - case O_GETLOGIN: -#ifdef HAS_GETLOGIN - if (!(tmps = getlogin())) - goto say_undef; - str_set(str,tmps); -#else - fatal("Unsupported function getlogin"); -#endif - break; - case O_OPEN_DIR: - case O_READDIR: - case O_TELLDIR: - case O_SEEKDIR: - case O_REWINDDIR: - case O_CLOSEDIR: - if (maxarg < 1) - goto say_undef; - if ((arg[1].arg_type & A_MASK) == A_WORD) - stab = arg[1].arg_ptr.arg_stab; - else - stab = stabent(str_get(st[1]),TRUE); - if (!stab) - goto say_undef; - sp = do_dirop(optype,stab,gimme,arglast); - goto array_return; - case O_SYSCALL: - value = (double)do_syscall(arglast); - goto donumset; - case O_PIPE_OP: -#ifdef HAS_PIPE - if ((arg[1].arg_type & A_MASK) == A_WORD) - stab = arg[1].arg_ptr.arg_stab; - else - stab = stabent(str_get(st[1]),TRUE); - if ((arg[2].arg_type & A_MASK) == A_WORD) - stab2 = arg[2].arg_ptr.arg_stab; - else - stab2 = stabent(str_get(st[2]),TRUE); - do_pipe(str,stab,stab2); - STABSET(str); -#else - fatal("Unsupported function pipe"); -#endif - break; - } - - normal_return: - st[1] = str; -#ifdef DEBUGGING - if (debug) { - dlevel--; - if (debug & 8) - deb("%s RETURNS \"%s\"\n",opname[optype],str_get(str)); - } -#endif - stack_ary = stack->ary_array; - stack_max = stack_ary + stack->ary_max; - stack_sp = stack_ary + arglast[0] + 1; - return arglast[0] + 1; -} diff --git a/ext/dbm/GDBM_File.c b/ext/dbm/GDBM_File.c index b5d4a88..f940a59 100644 --- a/ext/dbm/GDBM_File.c +++ b/ext/dbm/GDBM_File.c @@ -21,7 +21,7 @@ register int sp; register int items; { if (items < 5 || items > 6) { - fatal("Usage: GDBM_File::new(dbtype, name, block_size, read_write, mode, fatal_func = (FATALFUNC)fatal)"); + croak("Usage: GDBM_File::new(dbtype, name, block_size, read_write, mode, fatal_func = (FATALFUNC)croak)"); } { char * dbtype = SvPV(ST(1),na); @@ -33,7 +33,7 @@ register int items; GDBM_File RETVAL; if (items < 6) - fatal_func = (FATALFUNC)fatal; + fatal_func = (FATALFUNC)croak; else { fatal_func = (FATALFUNC)SvPV(ST(6),na); } @@ -52,7 +52,7 @@ register int sp; register int items; { if (items < 4 || items > 5) { - fatal("Usage: GDBM_File::open(name, block_size, read_write, mode, fatal_func = (FATALFUNC)fatal)"); + croak("Usage: GDBM_File::open(name, block_size, read_write, mode, fatal_func = (FATALFUNC)croak)"); } { char * name = SvPV(ST(1),na); @@ -63,7 +63,7 @@ register int items; GDBM_File RETVAL; if (items < 5) - fatal_func = (FATALFUNC)fatal; + fatal_func = (FATALFUNC)croak; else { fatal_func = (FATALFUNC)SvPV(ST(5),na); } @@ -82,15 +82,15 @@ register int sp; register int items; { if (items < 1 || items > 1) { - fatal("Usage: GDBM_File::close(db)"); + croak("Usage: GDBM_File::close(db)"); } { GDBM_File db; if (sv_isa(ST(1), "GDBM_File")) - db = (GDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1))); + db = (GDBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1))); else - fatal("db is not of type GDBM_File"); + croak("db is not of type GDBM_File"); gdbm_close(db); } @@ -104,15 +104,15 @@ register int sp; register int items; { if (items < 1 || items > 1) { - fatal("Usage: GDBM_File::DESTROY(db)"); + croak("Usage: GDBM_File::DESTROY(db)"); } { GDBM_File db; if (sv_isa(ST(1), "GDBM_File")) - db = (GDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1))); + db = (GDBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1))); else - fatal("db is not of type GDBM_File"); + croak("db is not of type GDBM_File"); gdbm_close(db); } return sp; @@ -125,7 +125,7 @@ register int sp; register int items; { if (items < 2 || items > 2) { - fatal("Usage: GDBM_File::fetch(db, key)"); + croak("Usage: GDBM_File::fetch(db, key)"); } { GDBM_File db; @@ -133,9 +133,9 @@ register int items; gdatum RETVAL; if (sv_isa(ST(1), "GDBM_File")) - db = (GDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1))); + db = (GDBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1))); else - fatal("db is not of type GDBM_File"); + croak("db is not of type GDBM_File"); key.dptr = SvPV(ST(2), key.dsize);; @@ -153,7 +153,7 @@ register int sp; register int items; { if (items < 3 || items > 4) { - fatal("Usage: GDBM_File::store(db, key, value, flags = GDBM_REPLACE)"); + croak("Usage: GDBM_File::store(db, key, value, flags = GDBM_REPLACE)"); } { GDBM_File db; @@ -163,9 +163,9 @@ register int items; int RETVAL; if (sv_isa(ST(1), "GDBM_File")) - db = (GDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1))); + db = (GDBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1))); else - fatal("db is not of type GDBM_File"); + croak("db is not of type GDBM_File"); key.dptr = SvPV(ST(2), key.dsize);; @@ -191,7 +191,7 @@ register int sp; register int items; { if (items < 2 || items > 2) { - fatal("Usage: GDBM_File::delete(db, key)"); + croak("Usage: GDBM_File::delete(db, key)"); } { GDBM_File db; @@ -199,9 +199,9 @@ register int items; int RETVAL; if (sv_isa(ST(1), "GDBM_File")) - db = (GDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1))); + db = (GDBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1))); else - fatal("db is not of type GDBM_File"); + croak("db is not of type GDBM_File"); key.dptr = SvPV(ST(2), key.dsize);; @@ -219,16 +219,16 @@ register int sp; register int items; { if (items < 1 || items > 1) { - fatal("Usage: GDBM_File::firstkey(db)"); + croak("Usage: GDBM_File::firstkey(db)"); } { GDBM_File db; gdatum RETVAL; if (sv_isa(ST(1), "GDBM_File")) - db = (GDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1))); + db = (GDBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1))); else - fatal("db is not of type GDBM_File"); + croak("db is not of type GDBM_File"); RETVAL = gdbm_firstkey(db); ST(0) = sv_mortalcopy(&sv_undef); @@ -244,7 +244,7 @@ register int sp; register int items; { if (items < 2 || items > 2) { - fatal("Usage: GDBM_File::nextkey(db, key)"); + croak("Usage: GDBM_File::nextkey(db, key)"); } { GDBM_File db; @@ -252,9 +252,9 @@ register int items; gdatum RETVAL; if (sv_isa(ST(1), "GDBM_File")) - db = (GDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1))); + db = (GDBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1))); else - fatal("db is not of type GDBM_File"); + croak("db is not of type GDBM_File"); key.dptr = SvPV(ST(2), key.dsize);; @@ -272,16 +272,16 @@ register int sp; register int items; { if (items < 1 || items > 1) { - fatal("Usage: GDBM_File::reorganize(db)"); + croak("Usage: GDBM_File::reorganize(db)"); } { GDBM_File db; int RETVAL; if (sv_isa(ST(1), "GDBM_File")) - db = (GDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1))); + db = (GDBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1))); else - fatal("db is not of type GDBM_File"); + croak("db is not of type GDBM_File"); RETVAL = gdbm_reorganize(db); ST(0) = sv_mortalcopy(&sv_undef); @@ -290,7 +290,7 @@ register int items; return sp; } -int init_GDBM_File(ix,sp,items) +int boot_GDBM_File(ix,sp,items) int ix; int sp; int items; diff --git a/ext/dbm/Makefile b/ext/dbm/Makefile index 61afe01..970724d 100644 --- a/ext/dbm/Makefile +++ b/ext/dbm/Makefile @@ -1,14 +1,20 @@ all: NDBM_File.c ODBM_File.c GDBM_File.c SDBM_File.c NDBM_File.c: NDBM_File.xs - ../xsubpp ../typemap NDBM_File.xs >NDBM_File.c + ../xsubpp NDBM_File.xs >NDBM_File.c SDBM_File.c: SDBM_File.xs - ../xsubpp ../typemap SDBM_File.xs >SDBM_File.c + ../xsubpp SDBM_File.xs >SDBM_File.c + +SDBM_File.o: SDBM_File.c + cc -g -I../.. -pic -c SDBM_File.c + +SDBM_File.so: SDBM_File.o sdbm/libsdbm.a + ld -o SDBM_File.so SDBM_File.o sdbm/libsdbm.a ODBM_File.c: ODBM_File.xs - ../xsubpp ../typemap ODBM_File.xs >ODBM_File.c + ../xsubpp ODBM_File.xs >ODBM_File.c GDBM_File.c: GDBM_File.xs - ../xsubpp ../typemap GDBM_File.xs >GDBM_File.c + ../xsubpp GDBM_File.xs >GDBM_File.c diff --git a/ext/dbm/ODBM_File.c b/ext/dbm/ODBM_File.c index b2fa7dd..1aea2ce 100644 --- a/ext/dbm/ODBM_File.c +++ b/ext/dbm/ODBM_File.c @@ -28,7 +28,7 @@ register int sp; register int items; { if (items < 4 || items > 4) { - fatal("Usage: ODBM_File::new(dbtype, filename, flags, mode)"); + croak("Usage: ODBM_File::new(dbtype, filename, flags, mode)"); } { char * dbtype = SvPV(ST(1),na); @@ -39,18 +39,18 @@ register int items; { char tmpbuf[1025]; if (dbmrefcnt++) - fatal("Old dbm can only open one database"); + croak("Old dbm can only open one database"); sprintf(tmpbuf,"%s.dir",filename); if (stat(tmpbuf, &statbuf) < 0) { if (flags & O_CREAT) { if (mode < 0 || close(creat(tmpbuf,mode)) < 0) - fatal("ODBM_File: Can't create %s", filename); + croak("ODBM_File: Can't create %s", filename); sprintf(tmpbuf,"%s.pag",filename); if (close(creat(tmpbuf,mode)) < 0) - fatal("ODBM_File: Can't create %s", filename); + croak("ODBM_File: Can't create %s", filename); } else - fatal("ODBM_FILE: Can't open %s", filename); + croak("ODBM_FILE: Can't open %s", filename); } RETVAL = (void*)(dbminit(filename) >= 0 ? &dbmrefcnt : 0); ST(0) = sv_mortalcopy(&sv_undef); @@ -67,15 +67,15 @@ register int sp; register int items; { if (items < 1 || items > 1) { - fatal("Usage: ODBM_File::DESTROY(db)"); + croak("Usage: ODBM_File::DESTROY(db)"); } { ODBM_File db; if (sv_isa(ST(1), "ODBM_File")) - db = (ODBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1))); + db = (ODBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1))); else - fatal("db is not of type ODBM_File"); + croak("db is not of type ODBM_File"); dbmrefcnt--; dbmclose(); } @@ -89,7 +89,7 @@ register int sp; register int items; { if (items < 2 || items > 2) { - fatal("Usage: ODBM_File::fetch(db, key)"); + croak("Usage: ODBM_File::fetch(db, key)"); } { ODBM_File db; @@ -97,9 +97,9 @@ register int items; datum RETVAL; if (sv_isa(ST(1), "ODBM_File")) - db = (ODBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1))); + db = (ODBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1))); else - fatal("db is not of type ODBM_File"); + croak("db is not of type ODBM_File"); key.dptr = SvPV(ST(2), key.dsize);; @@ -117,7 +117,7 @@ register int sp; register int items; { if (items < 3 || items > 4) { - fatal("Usage: ODBM_File::store(db, key, value, flags = DBM_REPLACE)"); + croak("Usage: ODBM_File::store(db, key, value, flags = DBM_REPLACE)"); } { ODBM_File db; @@ -127,9 +127,9 @@ register int items; int RETVAL; if (sv_isa(ST(1), "ODBM_File")) - db = (ODBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1))); + db = (ODBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1))); else - fatal("db is not of type ODBM_File"); + croak("db is not of type ODBM_File"); key.dptr = SvPV(ST(2), key.dsize);; @@ -155,7 +155,7 @@ register int sp; register int items; { if (items < 2 || items > 2) { - fatal("Usage: ODBM_File::delete(db, key)"); + croak("Usage: ODBM_File::delete(db, key)"); } { ODBM_File db; @@ -163,9 +163,9 @@ register int items; int RETVAL; if (sv_isa(ST(1), "ODBM_File")) - db = (ODBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1))); + db = (ODBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1))); else - fatal("db is not of type ODBM_File"); + croak("db is not of type ODBM_File"); key.dptr = SvPV(ST(2), key.dsize);; @@ -183,16 +183,16 @@ register int sp; register int items; { if (items < 1 || items > 1) { - fatal("Usage: ODBM_File::firstkey(db)"); + croak("Usage: ODBM_File::firstkey(db)"); } { ODBM_File db; datum RETVAL; if (sv_isa(ST(1), "ODBM_File")) - db = (ODBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1))); + db = (ODBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1))); else - fatal("db is not of type ODBM_File"); + croak("db is not of type ODBM_File"); RETVAL = odbm_firstkey(db); ST(0) = sv_mortalcopy(&sv_undef); @@ -208,7 +208,7 @@ register int sp; register int items; { if (items < 2 || items > 2) { - fatal("Usage: ODBM_File::nextkey(db, key)"); + croak("Usage: ODBM_File::nextkey(db, key)"); } { ODBM_File db; @@ -216,9 +216,9 @@ register int items; datum RETVAL; if (sv_isa(ST(1), "ODBM_File")) - db = (ODBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1))); + db = (ODBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1))); else - fatal("db is not of type ODBM_File"); + croak("db is not of type ODBM_File"); key.dptr = SvPV(ST(2), key.dsize);; @@ -229,7 +229,7 @@ register int items; return sp; } -int init_ODBM_File(ix,sp,items) +int boot_ODBM_File(ix,sp,items) int ix; int sp; int items; diff --git a/ext/dbm/SDBM_File.c b/ext/dbm/SDBM_File.c index 7baafc4..e69de29 100644 --- a/ext/dbm/SDBM_File.c +++ b/ext/dbm/SDBM_File.c @@ -1,266 +0,0 @@ -#include "EXTERN.h" -#include "perl.h" -#include "XSUB.h" -#include "ext/dbm/sdbm/sdbm.h" - -typedef DBM* SDBM_File; -#define sdbm_new(dbtype,filename,flags,mode) sdbm_open(filename,flags,mode) - -static int -XS_SDBM_File_sdbm_new(ix, sp, items) -register int ix; -register int sp; -register int items; -{ - if (items < 4 || items > 4) { - fatal("Usage: SDBM_File::new(dbtype, filename, flags, mode)"); - } - { - char * dbtype = SvPV(ST(1),na); - char * filename = SvPV(ST(2),na); - int flags = (int)SvIV(ST(3)); - int mode = (int)SvIV(ST(4)); - SDBM_File RETVAL; - - RETVAL = sdbm_new(dbtype, filename, flags, mode); - ST(0) = sv_mortalcopy(&sv_undef); - sv_setptrobj(ST(0), RETVAL, "SDBM_File"); - } - return sp; -} - -static int -XS_SDBM_File_sdbm_DESTROY(ix, sp, items) -register int ix; -register int sp; -register int items; -{ - if (items < 1 || items > 1) { - fatal("Usage: SDBM_File::DESTROY(db)"); - } - { - SDBM_File db; - - if (sv_isa(ST(1), "SDBM_File")) - db = (SDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1))); - else - fatal("db is not of type SDBM_File"); - sdbm_close(db); - } - return sp; -} - -static int -XS_SDBM_File_sdbm_fetch(ix, sp, items) -register int ix; -register int sp; -register int items; -{ - if (items < 2 || items > 2) { - fatal("Usage: SDBM_File::fetch(db, key)"); - } - { - SDBM_File db; - datum key; - datum RETVAL; - - if (sv_isa(ST(1), "SDBM_File")) - db = (SDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1))); - else - fatal("db is not of type SDBM_File"); - - key.dptr = SvPV(ST(2), key.dsize);; - - RETVAL = sdbm_fetch(db, key); - ST(0) = sv_mortalcopy(&sv_undef); - sv_setpvn(ST(0), RETVAL.dptr, RETVAL.dsize); - } - return sp; -} - -static int -XS_SDBM_File_sdbm_store(ix, sp, items) -register int ix; -register int sp; -register int items; -{ - if (items < 3 || items > 4) { - fatal("Usage: SDBM_File::store(db, key, value, flags = DBM_REPLACE)"); - } - { - SDBM_File db; - datum key; - datum value; - int flags; - int RETVAL; - - if (sv_isa(ST(1), "SDBM_File")) - db = (SDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1))); - else - fatal("db is not of type SDBM_File"); - - key.dptr = SvPV(ST(2), key.dsize);; - - value.dptr = SvPV(ST(3), value.dsize);; - - if (items < 4) - flags = DBM_REPLACE; - else { - flags = (int)SvIV(ST(4)); - } - - RETVAL = sdbm_store(db, key, value, flags); - ST(0) = sv_mortalcopy(&sv_undef); - sv_setiv(ST(0), (I32)RETVAL); - } - return sp; -} - -static int -XS_SDBM_File_sdbm_delete(ix, sp, items) -register int ix; -register int sp; -register int items; -{ - if (items < 2 || items > 2) { - fatal("Usage: SDBM_File::delete(db, key)"); - } - { - SDBM_File db; - datum key; - int RETVAL; - - if (sv_isa(ST(1), "SDBM_File")) - db = (SDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1))); - else - fatal("db is not of type SDBM_File"); - - key.dptr = SvPV(ST(2), key.dsize);; - - RETVAL = sdbm_delete(db, key); - ST(0) = sv_mortalcopy(&sv_undef); - sv_setiv(ST(0), (I32)RETVAL); - } - return sp; -} - -static int -XS_SDBM_File_sdbm_firstkey(ix, sp, items) -register int ix; -register int sp; -register int items; -{ - if (items < 1 || items > 1) { - fatal("Usage: SDBM_File::firstkey(db)"); - } - { - SDBM_File db; - datum RETVAL; - - if (sv_isa(ST(1), "SDBM_File")) - db = (SDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1))); - else - fatal("db is not of type SDBM_File"); - - RETVAL = sdbm_firstkey(db); - ST(0) = sv_mortalcopy(&sv_undef); - sv_setpvn(ST(0), RETVAL.dptr, RETVAL.dsize); - } - return sp; -} - -static int -XS_SDBM_File_sdbm_nextkey(ix, sp, items) -register int ix; -register int sp; -register int items; -{ - if (items < 2 || items > 2) { - fatal("Usage: SDBM_File::nextkey(db, key)"); - } - { - SDBM_File db; - datum key; - datum RETVAL; - - if (sv_isa(ST(1), "SDBM_File")) - db = (SDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1))); - else - fatal("db is not of type SDBM_File"); - - key.dptr = SvPV(ST(2), key.dsize);; - - RETVAL = sdbm_nextkey(db, key); - ST(0) = sv_mortalcopy(&sv_undef); - sv_setpvn(ST(0), RETVAL.dptr, RETVAL.dsize); - } - return sp; -} - -static int -XS_SDBM_File_sdbm_error(ix, sp, items) -register int ix; -register int sp; -register int items; -{ - if (items < 1 || items > 1) { - fatal("Usage: SDBM_File::error(db)"); - } - { - SDBM_File db; - int RETVAL; - - if (sv_isa(ST(1), "SDBM_File")) - db = (SDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1))); - else - fatal("db is not of type SDBM_File"); - - RETVAL = sdbm_error(db); - ST(0) = sv_mortalcopy(&sv_undef); - sv_setiv(ST(0), (I32)RETVAL); - } - return sp; -} - -static int -XS_SDBM_File_sdbm_clearerr(ix, sp, items) -register int ix; -register int sp; -register int items; -{ - if (items < 1 || items > 1) { - fatal("Usage: SDBM_File::clearerr(db)"); - } - { - SDBM_File db; - int RETVAL; - - if (sv_isa(ST(1), "SDBM_File")) - db = (SDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1))); - else - fatal("db is not of type SDBM_File"); - - RETVAL = sdbm_clearerr(db); - ST(0) = sv_mortalcopy(&sv_undef); - sv_setiv(ST(0), (I32)RETVAL); - } - return sp; -} - -int init_SDBM_File(ix,sp,items) -int ix; -int sp; -int items; -{ - char* file = __FILE__; - - newXSUB("SDBM_File::new", 0, XS_SDBM_File_sdbm_new, file); - newXSUB("SDBM_File::DESTROY", 0, XS_SDBM_File_sdbm_DESTROY, file); - newXSUB("SDBM_File::fetch", 0, XS_SDBM_File_sdbm_fetch, file); - newXSUB("SDBM_File::store", 0, XS_SDBM_File_sdbm_store, file); - newXSUB("SDBM_File::delete", 0, XS_SDBM_File_sdbm_delete, file); - newXSUB("SDBM_File::firstkey", 0, XS_SDBM_File_sdbm_firstkey, file); - newXSUB("SDBM_File::nextkey", 0, XS_SDBM_File_sdbm_nextkey, file); - newXSUB("SDBM_File::error", 0, XS_SDBM_File_sdbm_error, file); - newXSUB("SDBM_File::clearerr", 0, XS_SDBM_File_sdbm_clearerr, file); -} diff --git a/ext/dbm/sdbm/makefile b/ext/dbm/sdbm/makefile index 5dabe40..c959c1f 100644 --- a/ext/dbm/sdbm/makefile +++ b/ext/dbm/sdbm/makefile @@ -2,7 +2,7 @@ # makefile for public domain ndbm-clone: sdbm # DUFF: use duff's device (loop unroll) in parts of the code # -CFLAGS = -O -DSDBM -DDUFF -DBSD42 +CFLAGS = -O -DSDBM -DDUFF -DBSD42 -pic #LDFLAGS = -p OBJS = sdbm.o pair.o hash.o diff --git a/ext/dbm/typemap b/ext/dbm/typemap new file mode 100644 index 0000000..13147fa --- /dev/null +++ b/ext/dbm/typemap @@ -0,0 +1,24 @@ +# +#################################### DBM SECTION +# + +datum T_DATUM +gdatum T_GDATUM +NDBM_File T_PTROBJ +GDBM_File T_PTROBJ +SDBM_File T_PTROBJ +ODBM_File T_PTROBJ +DB_File T_PTROBJ +DBZ_File T_PTROBJ +FATALFUNC T_OPAQUEPTR + +INPUT +T_DATUM + $var.dptr = SvPV($arg, $var.dsize); +T_GDATUM + UNIMPLEMENTED +OUTPUT +T_DATUM + sv_setpvn($arg, $var.dptr, $var.dsize); +T_GDATUM + sv_usepvn($arg, $var.dptr, $var.dsize); diff --git a/ext/dl/dl.c b/ext/dl/dl.c new file mode 100644 index 0000000..38a798c --- /dev/null +++ b/ext/dl/dl.c @@ -0,0 +1,54 @@ +#include + +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +static int +XS_DynamicLoader_bootstrap(ix, sp, items) +register int ix; +register int sp; +register int items; +{ + if (items < 1 || items > 1) { + croak("Usage: DynamicLoader::bootstrap(package)"); + } + { + char* package = SvPV(ST(1),na); + void* obj = 0; + int (*bootproc)(); + char tmpbuf[1024]; + char tmpbuf2[128]; + AV *av = GvAVn(incgv); + I32 i; + + for (i = 0; i <= AvFILL(av); i++) { + (void)sprintf(tmpbuf, "%s/auto/%s/%s.so", + SvPVx(*av_fetch(av, i, TRUE), na), package, package); + if (obj = dlopen(tmpbuf,1)) + break; + } + if (!obj) + croak("Can't find loadable object for package %s in @INC", package); + + sprintf(tmpbuf2, "boot_%s", package); + bootproc = (int (*)())dlsym(obj, tmpbuf2); + if (!bootproc) + croak("Shared object %s contains no %s function", tmpbuf, tmpbuf2); + bootproc(); + + ST(0) = sv_mortalcopy(&sv_yes); + } + return sp; +} + +int +boot_DynamicLoader(ix,sp,items) +int ix; +int sp; +int items; +{ + char* file = __FILE__; + + newXSUB("DynamicLoader::bootstrap", 0, XS_DynamicLoader_bootstrap, file); +} diff --git a/ext/dl/eg/Makefile b/ext/dl/eg/Makefile new file mode 100644 index 0000000..d1ae210 --- /dev/null +++ b/ext/dl/eg/Makefile @@ -0,0 +1,20 @@ +CC = /vol/apps/lucid-3.1/lcc + +all: main test test1 +main: main.c + $(CC) -g -o main main.c -ldl + +test.o: test.c + $(CC) -g -pic -c test.c + +test: test.o + ld -o test -assert pure-text test.o + +test1.o: test1.c + $(CC) -g -pic -c test1.c + +test1: test1.o + ld -o test1 -assert pure-text test1.o + +clean: + /bin/rm -f *.o test test1 main diff --git a/ext/dl/eg/Makefile.att b/ext/dl/eg/Makefile.att new file mode 100644 index 0000000..435b916 --- /dev/null +++ b/ext/dl/eg/Makefile.att @@ -0,0 +1,18 @@ +all: main test test1 +main: main.c + cc -g -o main main.c -ldl + +test.o: test.c + cc -g -pic -c test.c + +test: test.o + cc -o test -G test.o + +test1.o: test1.c + cc -g -pic -c test1.c + +test1: test1.o + cc -o test1 -G test1.o + +clean: + /bin/rm -f *.o test test1 main diff --git a/ext/dl/eg/main.c b/ext/dl/eg/main.c new file mode 100644 index 0000000..ac01554 --- /dev/null +++ b/ext/dl/eg/main.c @@ -0,0 +1,28 @@ +#include +#include + +main(argc, argv, arge) +int argc; +char **argv; +char **arge; +{ + void *obj; + void (*proc)(); + void *obj1; + void (*proc1)(); + + if (!(obj = dlopen("test", 1))) + fprintf(stderr, "%s\n", dlerror()); + if (!(obj1 = dlopen("test1", 1))) + fprintf(stderr, "%s\n", dlerror()); + proc = (void (*)())dlsym(obj, "test"); + proc1 = (void (*)())dlsym(obj1, "test1"); + proc(); + proc1(); + dlclose(obj); +} + +void print() +{ + printf("got here!\n"); +} diff --git a/ext/dl/eg/test.c b/ext/dl/eg/test.c new file mode 100644 index 0000000..a66db19 --- /dev/null +++ b/ext/dl/eg/test.c @@ -0,0 +1,4 @@ +test() +{ + print(); +} diff --git a/ext/dl/eg/test1.c b/ext/dl/eg/test1.c new file mode 100644 index 0000000..fc7b1b2 --- /dev/null +++ b/ext/dl/eg/test1.c @@ -0,0 +1,11 @@ +#include + +test1() +{ + void *obj; + void (*proc)(); + + obj = dlopen("test", 1); + proc = (void (*)())dlsym(obj, "test"); + proc(); +} diff --git a/ext/posix/POSIX.xs b/ext/posix/POSIX.xs index 5918199..7981f88 100644 --- a/ext/posix/POSIX.xs +++ b/ext/posix/POSIX.xs @@ -1,10 +1,215 @@ #include "EXTERN.h" #include "perl.h" #include "XSUB.h" +#include + +#define HAS_UNAME + +#ifndef HAS_GETPGRP +#define getpgrp(a,b) not_here("getpgrp") +#endif +#ifndef HAS_NICE +#define nice(a) not_here("nice") +#endif +#ifndef HAS_READLINK +#define readlink(a,b,c) not_here("readlink") +#endif +#ifndef HAS_SETPGID +#define setpgid(a,b) not_here("setpgid") +#endif +#ifndef HAS_SETPGRP +#define setpgrp(a,b) not_here("setpgrp") +#endif +#ifndef HAS_SETSID +#define setsid() not_here("setsid") +#endif +#ifndef HAS_SYMLINK +#define symlink(a,b) not_here("symlink") +#endif +#ifndef HAS_TCGETPGRP +#define tcgetpgrp(a) not_here("tcgetpgrp") +#endif +#ifndef HAS_TCSETPGRP +#define tcsetpgrp(a,b) not_here("tcsetpgrp") +#endif +#ifndef HAS_TIMES +#define times(a) not_here("times") +#endif +#ifndef HAS_UNAME +#define uname(a) not_here("uname") +#endif +#ifndef HAS_WAITPID +#define waitpid(a,b,c) not_here("waitpid") +#endif + +static int +not_here(s) +char *s; +{ + croak("POSIX::%s not implemented on this architecture", s); + return -1; +} MODULE = POSIX PACKAGE = POSIX +void +_exit(status) + int status + +int +chdir(path) + char * path + +int +chmod(path, mode) + char * path + mode_t mode + +int +close(fd) + int fd + +int +dup(fd) + int fd + +int +dup2(fd1, fd2) + int fd1 + int fd2 + FILE * -fdopen(fildes, type) - fd fildes +fdopen(fd, type) + int fd char * type + +int +fstat(fd, buf) + int fd + struct stat * buf = (struct stat*)sv_grow(ST(2),sizeof(struct stat)); + CLEANUP: + SvCUR(ST(2)) = sizeof(struct stat); + +int +getpgrp(pid) + int pid + +int +link() + +int +lseek() + +int +lstat() + +int +mkdir() + +int +nice(incr) + int incr + +int +open() + +int +pipe() + +int +read() + +int +readlink(path, buf, bufsiz) + char * path + char * buf = sv_grow(ST(2), SvIV(ST(3))); + int bufsiz + +int +rename() + +int +rmdir() + +int +setgid() + +int +setpgid(pid, pgid) + pid_t pid + pid_t pgid + +int +setpgrp(pid, pgrp) + int pid + int pgrp + +pid_t +setsid() + +int +setuid() + +int +stat() + +int +symlink() + +int +system() + +pid_t +tcgetpgrp(fd) + int fd + +int +tcsetpgrp(fd, pgrp_id) + int fd + pid_t pgrp_id + +int +times(tms) + struct tms * tms = (struct tms*)sv_grow(ST(1), sizeof(struct tms)); + CLEANUP: + SvCUR(ST(1)) = sizeof(struct tms); + +int +umask() + +int +uname() + CODE: + dSP; + struct utsname utsname; + sp--; + if (uname(&utsname) >= 0) { + EXTEND(sp, 5); + PUSHs(sv_2mortal(newSVpv(utsname.sysname, 0))); + PUSHs(sv_2mortal(newSVpv(utsname.nodename, 0))); + PUSHs(sv_2mortal(newSVpv(utsname.release, 0))); + PUSHs(sv_2mortal(newSVpv(utsname.version, 0))); + PUSHs(sv_2mortal(newSVpv(utsname.machine, 0))); + } + return sp - stack_base; + +int +unlink() + +int +utime() + +int +wait() + +int +waitpid(pid, statusp, options) + int pid + int &statusp + int options + OUTPUT: + statusp + +int +write() + diff --git a/ext/posix/typemap b/ext/posix/typemap new file mode 100644 index 0000000..98d2135 --- /dev/null +++ b/ext/posix/typemap @@ -0,0 +1,4 @@ +mode_t T_INT +pid_t T_INT +fd T_INT +FILE * T_PTR diff --git a/ext/typemap b/ext/typemap index 29cd051..8c9f48d 100644 --- a/ext/typemap +++ b/ext/typemap @@ -23,219 +23,133 @@ Result T_U_CHAR Boolean T_U_CHAR double T_DOUBLE -# -#################################### XLIB SECTION -# - -# basic X types -Atom T_U_LONG -Atom * T_OPAQUEPTR -Bool T_INT -KeyCode T_U_LONG -Status T_INT -Time T_U_LONG -VisualID T_U_LONG -XID T_U_LONG -GC T_PTR -Display * T_PTR -Screen * T_PTR -Visual * T_PTR -XImage * T_PTR -Region T_PTR - -# things that are XIDs -Colormap T_U_LONG -Cursor T_U_LONG -Drawable T_U_LONG -Font T_U_LONG -GContext T_U_LONG -KeySym T_U_LONG -KeySym * T_OPAQUEPTR -Pixmap T_U_LONG -Pixmap * T_OPAQUEPTR -Window T_U_LONG -Window * T_OPAQUEPTR - -# X resource manager types -XrmDatabase T_PTR -XrmQuark T_INT -XrmQuarkList T_OPAQUEPTR -XrmName T_INT -XrmNameList T_OPAQUEPTR -XrmClass T_INT -XrmClassList T_OPAQUEPTR -XrmRepresentation T_INT -XrmString T_STRING -XrmBinding T_ENUM -XrmBindingList T_OPAQUEPTR -XrmOptionKind T_ENUM -XrmSearchList T_OPAQUEPTR - -# context manager types -XContext T_INT - -# Xlib data structures -XArc * T_OPAQUEPTR -XCharStruct T_OPAQUE -XCharStruct * T_OPAQUEPTR -XColor T_OPAQUE -XColor * T_OPAQUEPTR -XComposeStatus * T_OPAQUEPTR -XEvent T_OPAQUE -XEvent * T_OPAQUEPTR -XFontStruct T_OPAQUE -XFontStruct * T_PTR -XGCValues * T_OPAQUEPTR -XIconSize * T_OPAQUEPTR -XKeyboardControl * T_OPAQUEPTR -XKeyboardState T_OPAQUE -XModifierKeymap * T_PTR -XPoint T_OPAQUE -XPoint * T_OPAQUEPTR -XRectangle T_OPAQUE -XRectangle * T_OPAQUEPTR -XSegment * T_OPAQUEPTR -XSetWindowAttributes * T_OPAQUEPTR -XSizeHints T_OPAQUE -XSizeHints * T_OPAQUEPTR -XStandardColormap T_OPAQUE -XStandardColormap * T_OPAQUEPTR -XTimeCoord * T_OPAQUEPTR -XVisualInfo T_OPAQUE -XVisualInfo * T_OPAQUEPTR -XWindowAttributes T_OPAQUE -XWindowAttributes * T_OPAQUEPTR -XWindowChanges * T_OPAQUEPTR -XWMHints * T_OPAQUEPTR - -# these data types must be handled specially -#XrmValue T_OPAQUE -#XrmValue * T_OPAQUEPTR -#XrmOptionDescList T_OPAQUEPTR -#XClassHint T_OPAQUE -#XClassHint * T_OPAQUEPTR -#XHostAddress * T_OPAQUEPTR -#XTextItem * T_OPAQUEPTR -#XTextItem16 * T_OPAQUEPTR -#XTextProperty T_OPAQUE -#XTextProperty * T_OPAQUEPTR - -# -#################################### PARCPLACE OI SECTION -# - -# basic OI types -OI_alignment T_ENUM -OI_bevel_style T_ENUM -OI_bool T_ENUM -OI_charset T_ENUM -OI_char_encode_type T_ENUM -OI_configure_mask T_ENUM -OI_drop_type T_ENUM -OI_ef_char_chk_status T_ENUM -OI_ef_entry_chk_status T_ENUM -OI_ef_mode T_ENUM -OI_enhance T_ENUM -OI_gravity T_ENUM -OI_gauge_ends T_ENUM -OI_gauge_ticks T_ENUM -OI_layout T_INT -OI_menu_cell_type T_ENUM -OI_mnemonic_style T_ENUM -OI_model_type T_ENUM -OI_mt_char_chk_status T_ENUM -OI_mt_entry_chk_status T_ENUM -OI_mt_mode T_ENUM -OI_number T_SHORT -OI_number * T_OPAQUEPTR -OI_orient T_ENUM -OI_pic_type T_ENUM -OI_pic_pixel T_ENUM -OI_psn_type T_ENUM -OI_rm_db T_ENUM -OI_sav_rst_typ T_ENUM -OI_scroll_event T_ENUM -OI_size_track T_ENUM -OI_slider_current T_ENUM -OI_slider_ends T_ENUM -OI_slider_ticks T_ENUM -OI_stat T_ENUM -OI_state T_ENUM -OI_wm_state T_ENUM -PIXEL T_LONG - -# OI classes -OI_abbr_menu * T_PTR -OI_animate_item * T_PTR -OI_app_window * T_PTR -OI_base_text * T_PTR -OI_box * T_PTR -OI_button_menu * T_PTR -OI_command_dialog_box * T_PTR -OI_excl_menu * T_PTR -OI_excl_check_menu * T_PTR -OI_excl_rect_menu * T_PTR -OI_basic_menu * T_PTR -OI_class * T_PTR -OI_connection * T_PTR -OI_ctlr_1d * T_PTR -OI_d_tech * T_PTR -OI_d_tech ** T_OPAQUEPTR -OI_dialog_box * T_PTR -OI_display_1d * T_PTR -OI_entry_field * T_PTR -OI_error_dialog_box * T_PTR -OI_excl_menu * T_PTR -OI_file_dialog_box * T_PTR -OI_gauge * T_PTR -OI_glyph * T_PTR -OI_help * T_PTR -OI_info_dialog_box * T_PTR -OI_menu * T_PTR -OI_menu_cell * T_PTR -OI_menu_cell ** T_OPAQUEPTR -OI_menu_spec * T_PACKED -OI_message_dialog_box * T_PTR -OI_ms_dialog_box * T_PTR -OI_multi_text * T_PTR -OI_panner * T_PTR -OI_pic_spec_mask * T_PTR -OI_pic_spec_mask ** T_OPAQUEPTR -OI_poly_menu * T_PTR -OI_poly_check_menu * T_PTR -OI_poly_rect_menu * T_PTR -OI_prompt_dialog_box * T_PTR -OI_question_dialog_box * T_PTR -OI_scroll_bar * T_PTR -OI_scroll_box * T_PTR -OI_scroll_menu * T_PTR -OI_scroll_text * T_PTR -OI_select_dialog_box * T_PTR -OI_separator * T_PTR -OI_seq_entry_field * T_PTR -OI_slider * T_PTR -OI_static_text * T_PTR -OI_translation_table * T_PTR -OI_warn_dialog_box * T_PTR -OI_work_dialog_box * T_PTR - -# -#################################### XPM SECTION -# -XpmAttributes * T_PACKED -XpmColorSymbol * T_PACKED -XpmExtension * T_PACKED - -# -#################################### DBM SECTION -# - -datum T_DATUM -gdatum T_GDATUM -NDBM_File T_PTROBJ -GDBM_File T_PTROBJ -SDBM_File T_PTROBJ -ODBM_File T_PTROBJ -DB_File T_PTROBJ -DBZ_File T_PTROBJ -FATALFUNC T_OPAQUEPTR +############################################################################# +INPUT +T_INT + $var = (int)SvIV($arg) +T_ENUM + $var = ($type)SvIV($arg) +T_U_INT + $var = (unsigned int)SvIV($arg) +T_SHORT + $var = (short)SvIV($arg) +T_U_SHORT + $var = (unsigned short)SvIV($arg) +T_LONG + $var = (long)SvIV($arg) +T_U_LONG + $var = (unsigned long)SvIV($arg) +T_CHAR + $var = (char)*SvPV($arg,na) +T_U_CHAR + $var = (unsigned char)SvIV($arg) +T_FLOAT + $var = (float)SvNV($arg) +T_DOUBLE + $var = SvNV($arg) +T_STRING + $var = SvPV($arg,na) +T_PTR + $var = ($type)(unsigned long)SvNV($arg) +T_PTRREF + if (SvROK($arg)) + $var = ($type)(unsigned long)SvNV((SV*)SvRV($arg)); + else + croak(\"$var is not a reference\") +T_PTROBJ + if (sv_isa($arg, \"${ntype}\")) + $var = ($type)(unsigned long)SvNV((SV*)SvRV($arg)); + else + croak(\"$var is not of type ${ntype}\") +T_PTRDESC + if (sv_isa($arg, \"${ntype}\")) { + ${type}_desc = (\U${type}_DESC\E*)(unsigned long)SvNV((SV*)SvRV($arg)); + $var = ${type}_desc->ptr; + } + else + croak(\"$var is not of type ${ntype}\") +T_REFREF + if (SvROK($arg)) + $var = *($type)(unsigned long)SvNV((SV*)SvRV($arg)); + else + croak(\"$var is not a reference\") +T_REFOBJ + if (sv_isa($arg, \"${ntype}\")) + $var = *($type)(unsigned long)SvNV((SV*)SvRV($arg)); + else + croak(\"$var is not of type ${ntype}\") +T_OPAQUE + $var NOT IMPLEMENTED +T_OPAQUEPTR + $var = ($type)SvPV($arg,na) +T_PACKED + $var = XS_unpack_$ntype($arg) +T_PACKEDARRAY + $var = XS_unpack_$ntype($arg) +T_CALLBACK + $var = make_perl_cb_$type($arg) +T_ARRAY + $var = $ntype(items -= $argoff); + U32 ix_$var = $argoff; + while (items--) { + DO_ARRAY_ELEM; + } +############################################################################# +OUTPUT +T_INT + sv_setiv($arg, (I32)$var); +T_ENUM + sv_setiv($arg, (I32)$var); +T_U_INT + sv_setiv($arg, (I32)$var); +T_SHORT + sv_setiv($arg, (I32)$var); +T_U_SHORT + sv_setiv($arg, (I32)$var); +T_LONG + sv_setiv($arg, (I32)$var); +T_U_LONG + sv_setiv($arg, (I32)$var); +T_CHAR + sv_setpvn($arg, (char *)&$var, 1); +T_U_CHAR + sv_setiv($arg, (I32)$var); +T_FLOAT + sv_setnv($arg, (double)$var); +T_DOUBLE + sv_setnv($arg, $var); +T_STRING + sv_setpv($arg, $var); +T_PTR + sv_setnv($arg, (double)(unsigned long)$var); +T_PTRREF + sv_setptrref($arg, $var); +T_PTROBJ + sv_setptrobj($arg, $var, \"${ntype}\"); +T_PTRDESC + sv_setptrobj($arg, (void*)new\U${type}_DESC\E($var), \"${ntype}\"); +T_REFREF + sv_setrefref($arg, \"${ntype}\", XS_service_$ntype, + ($var ? (void*)new $ntype($var) : 0)); +T_REFOBJ + NOT IMPLEMENTED +T_OPAQUE + sv_setpvn($arg, (char *)&$var, sizeof($var)); +T_OPAQUEPTR + sv_setpvn($arg, (char *)$var, sizeof(*$var)), XFree((char *)$var); +T_PACKED + XS_pack_$ntype($arg, $var); +T_PACKEDARRAY + XS_pack_$ntype($arg, $var, count_$ntype); +T_DATAUNIT + sv_setpvn($arg, $var.chp(), $var.size()); +T_CALLBACK + sv_setpvn($arg, $var.context.value().chp(), + $var.context.value().size()); +T_ARRAY + ST_EXTEND($var.size); + for (U32 ix_$var = 0; ix_$var < $var.size; ix_$var++) { + ST(ix_$var) = sv_newmortal(); + DO_ARRAY_ELEM + } + sp += $var.size - 1; diff --git a/ext/typemap.oi b/ext/typemap.oi new file mode 100644 index 0000000..fc93718 --- /dev/null +++ b/ext/typemap.oi @@ -0,0 +1,99 @@ +# +#################################### PARCPLACE OI SECTION +# + +# basic OI types +OI_alignment T_ENUM +OI_bevel_style T_ENUM +OI_bool T_ENUM +OI_charset T_ENUM +OI_char_encode_type T_ENUM +OI_configure_mask T_ENUM +OI_drop_type T_ENUM +OI_ef_char_chk_status T_ENUM +OI_ef_entry_chk_status T_ENUM +OI_ef_mode T_ENUM +OI_enhance T_ENUM +OI_gravity T_ENUM +OI_gauge_ends T_ENUM +OI_gauge_ticks T_ENUM +OI_layout T_INT +OI_menu_cell_type T_ENUM +OI_mnemonic_style T_ENUM +OI_model_type T_ENUM +OI_mt_char_chk_status T_ENUM +OI_mt_entry_chk_status T_ENUM +OI_mt_mode T_ENUM +OI_number T_SHORT +OI_number * T_OPAQUEPTR +OI_orient T_ENUM +OI_pic_type T_ENUM +OI_pic_pixel T_ENUM +OI_psn_type T_ENUM +OI_rm_db T_ENUM +OI_sav_rst_typ T_ENUM +OI_scroll_event T_ENUM +OI_size_track T_ENUM +OI_slider_current T_ENUM +OI_slider_ends T_ENUM +OI_slider_ticks T_ENUM +OI_stat T_ENUM +OI_state T_ENUM +OI_wm_state T_ENUM +PIXEL T_LONG + +# OI classes +OI_abbr_menu * T_PTR +OI_animate_item * T_PTR +OI_app_window * T_PTR +OI_base_text * T_PTR +OI_box * T_PTR +OI_button_menu * T_PTR +OI_command_dialog_box * T_PTR +OI_excl_menu * T_PTR +OI_excl_check_menu * T_PTR +OI_excl_rect_menu * T_PTR +OI_basic_menu * T_PTR +OI_class * T_PTR +OI_connection * T_PTR +OI_ctlr_1d * T_PTR +OI_d_tech * T_PTR +OI_d_tech ** T_OPAQUEPTR +OI_dialog_box * T_PTR +OI_display_1d * T_PTR +OI_entry_field * T_PTR +OI_error_dialog_box * T_PTR +OI_excl_menu * T_PTR +OI_file_dialog_box * T_PTR +OI_gauge * T_PTR +OI_glyph * T_PTR +OI_help * T_PTR +OI_info_dialog_box * T_PTR +OI_menu * T_PTR +OI_menu_cell * T_PTR +OI_menu_cell ** T_OPAQUEPTR +OI_menu_spec * T_PACKED +OI_message_dialog_box * T_PTR +OI_ms_dialog_box * T_PTR +OI_multi_text * T_PTR +OI_panner * T_PTR +OI_pic_spec_mask * T_PTR +OI_pic_spec_mask ** T_OPAQUEPTR +OI_poly_menu * T_PTR +OI_poly_check_menu * T_PTR +OI_poly_rect_menu * T_PTR +OI_prompt_dialog_box * T_PTR +OI_question_dialog_box * T_PTR +OI_scroll_bar * T_PTR +OI_scroll_box * T_PTR +OI_scroll_menu * T_PTR +OI_scroll_text * T_PTR +OI_select_dialog_box * T_PTR +OI_separator * T_PTR +OI_seq_entry_field * T_PTR +OI_slider * T_PTR +OI_static_text * T_PTR +OI_translation_table * T_PTR +OI_warn_dialog_box * T_PTR +OI_work_dialog_box * T_PTR + diff --git a/ext/typemap.xlib b/ext/typemap.xlib new file mode 100644 index 0000000..b04d130 --- /dev/null +++ b/ext/typemap.xlib @@ -0,0 +1,97 @@ +# +#################################### XLIB SECTION +# + +# basic X types +Atom T_U_LONG +Atom * T_OPAQUEPTR +Bool T_INT +KeyCode T_U_LONG +Status T_INT +Time T_U_LONG +VisualID T_U_LONG +XID T_U_LONG +GC T_PTR +Display * T_PTR +Screen * T_PTR +Visual * T_PTR +XImage * T_PTR +Region T_PTR + +# things that are XIDs +Colormap T_U_LONG +Cursor T_U_LONG +Drawable T_U_LONG +Font T_U_LONG +GContext T_U_LONG +KeySym T_U_LONG +KeySym * T_OPAQUEPTR +Pixmap T_U_LONG +Pixmap * T_OPAQUEPTR +Window T_U_LONG +Window * T_OPAQUEPTR + +# X resource manager types +XrmDatabase T_PTR +XrmQuark T_INT +XrmQuarkList T_OPAQUEPTR +XrmName T_INT +XrmNameList T_OPAQUEPTR +XrmClass T_INT +XrmClassList T_OPAQUEPTR +XrmRepresentation T_INT +XrmString T_STRING +XrmBinding T_ENUM +XrmBindingList T_OPAQUEPTR +XrmOptionKind T_ENUM +XrmSearchList T_OPAQUEPTR + +# context manager types +XContext T_INT + +# Xlib data structures +XArc * T_OPAQUEPTR +XCharStruct T_OPAQUE +XCharStruct * T_OPAQUEPTR +XColor T_OPAQUE +XColor * T_OPAQUEPTR +XComposeStatus * T_OPAQUEPTR +XEvent T_OPAQUE +XEvent * T_OPAQUEPTR +XFontStruct T_OPAQUE +XFontStruct * T_PTR +XGCValues * T_OPAQUEPTR +XIconSize * T_OPAQUEPTR +XKeyboardControl * T_OPAQUEPTR +XKeyboardState T_OPAQUE +XModifierKeymap * T_PTR +XPoint T_OPAQUE +XPoint * T_OPAQUEPTR +XRectangle T_OPAQUE +XRectangle * T_OPAQUEPTR +XSegment * T_OPAQUEPTR +XSetWindowAttributes * T_OPAQUEPTR +XSizeHints T_OPAQUE +XSizeHints * T_OPAQUEPTR +XStandardColormap T_OPAQUE +XStandardColormap * T_OPAQUEPTR +XTimeCoord * T_OPAQUEPTR +XVisualInfo T_OPAQUE +XVisualInfo * T_OPAQUEPTR +XWindowAttributes T_OPAQUE +XWindowAttributes * T_OPAQUEPTR +XWindowChanges * T_OPAQUEPTR +XWMHints * T_OPAQUEPTR + +# these data types must be handled specially +#XrmValue T_OPAQUE +#XrmValue * T_OPAQUEPTR +#XrmOptionDescList T_OPAQUEPTR +#XClassHint T_OPAQUE +#XClassHint * T_OPAQUEPTR +#XHostAddress * T_OPAQUEPTR +#XTextItem * T_OPAQUEPTR +#XTextItem16 * T_OPAQUEPTR +#XTextProperty T_OPAQUE +#XTextProperty * T_OPAQUEPTR + diff --git a/ext/typemap.xpm b/ext/typemap.xpm new file mode 100644 index 0000000..d131276 --- /dev/null +++ b/ext/typemap.xpm @@ -0,0 +1,7 @@ +# +#################################### XPM SECTION +# +XpmAttributes * T_PACKED +XpmColorSymbol * T_PACKED +XpmExtension * T_PACKED + diff --git a/ext/xsubpp b/ext/xsubpp index e7a710b..d2be4f5 100755 --- a/ext/xsubpp +++ b/ext/xsubpp @@ -1,177 +1,78 @@ -#!/usr/bin/perl +#!./perl # $Header$ -$usage = "Usage: xsubpp [-a] [-s] [-c] typemap file.xs\n"; -die $usage unless (@ARGV >= 2 && @ARGV <= 6); +$usage = "Usage: xsubpp [-ansi] [-C++] [-except] [-tm typemap] file.xs\n"; -SWITCH: while ($ARGV[0] =~ /^-/) { +SWITCH: while ($ARGV[0] =~ s/^-//) { $flag = shift @ARGV; - $aflag = 1, next SWITCH if $flag =~ /^-a$/; - $spat = $1, next SWITCH if $flag =~ /^-s(.*)$/; - $cflag = 1, next SWITCH if $flag =~ /^-c$/; - $eflag = 1, next SWITCH if $flag =~ /^-e$/; + $ansiflag = 1, next SWITCH if $flag eq 'ansi'; + $spat = shift, next SWITCH if $flag eq 's'; + $cplusplus = 1, next SWITCH if $flag eq 'C++'; + $except = 1, next SWITCH if $flag eq 'except'; + push(@tm,shift), next SWITCH if $flag eq 'typemap'; die $usage; } +@ARGV == 1 or die $usage; +chop($pwd = `pwd`); +($dir, $filename) = @ARGV[0] =~ m#(.*)/(.*)# + or ($dir, $filename) = ('.', $ARGV[0]); +chdir($dir); $typemap = shift @ARGV; -open(TYPEMAP, $typemap) || die "cannot open $typemap\n"; -while () { - next if /^\s*$/ || /^#/; - chop; - ($typename, $kind) = split(/\t+/, $_, 2); - $type_kind{$typename} = $kind; +foreach $typemap (@tm) { + die "Can't find $typemap in $pwd\n" unless -r $typemap; } -close(TYPEMAP); - -%input_expr = (JUNK, split(/\n(T_\w*)\s*\n/, <<'T_END')); - -T_INT - $var = (int)SvIV($arg) -T_ENUM - $var = ($type)SvIV($arg) -T_U_INT - $var = (unsigned int)SvIV($arg) -T_SHORT - $var = (short)SvIV($arg) -T_U_SHORT - $var = (unsigned short)SvIV($arg) -T_LONG - $var = (long)SvIV($arg) -T_U_LONG - $var = (unsigned long)SvIV($arg) -T_CHAR - $var = (char)*SvPV($arg,na) -T_U_CHAR - $var = (unsigned char)SvIV($arg) -T_FLOAT - $var = (float)SvNV($arg) -T_DOUBLE - $var = SvNV($arg) -T_STRING - $var = SvPV($arg,na) -T_PTR - $var = ($type)(unsigned long)SvNV($arg) -T_PTRREF - if (SvROK($arg)) - $var = ($type)(unsigned long)SvNV((SV*)SvRV($arg)); - else - croak(\"$var is not a reference\") -T_PTROBJ - if (sv_isa($arg, \"${ntype}\")) - $var = ($type)(unsigned long)SvNV((SV*)SvRV($arg)); - else - croak(\"$var is not of type ${ntype}\") -T_PTRDESC - if (sv_isa($arg, \"${ntype}\")) { - ${type}_desc = (\U${type}_DESC\E*)(unsigned long)SvNV((SV*)SvRV($arg)); - $var = ${type}_desc->ptr; +unshift @tm, qw(../../../typemap ../../typemap ../typemap typemap); +foreach $typemap (@tm) { + open(TYPEMAP, $typemap) || next; + $mode = Typemap; + $current = \$junk; + while () { + next if /^#/; + if (/^INPUT\s*$/) { $mode = Input, next } + if (/^OUTPUT\s*$/) { $mode = Output, next } + if (/^TYPEMAP\s*$/) { $mode = Typemap, next } + if ($mode eq Typemap) { + chop; + ($typename, $kind) = split(/\t+/, $_, 2); + $type_kind{$typename} = $kind if $kind ne ''; } - else - croak(\"$var is not of type ${ntype}\") -T_REFREF - if (SvROK($arg)) - $var = *($type)(unsigned long)SvNV((SV*)SvRV($arg)); - else - croak(\"$var is not a reference\") -T_REFOBJ - if (sv_isa($arg, \"${ntype}\")) - $var = *($type)(unsigned long)SvNV((SV*)SvRV($arg)); - else - croak(\"$var is not of type ${ntype}\") -T_OPAQUE - $var NOT IMPLEMENTED -T_OPAQUEPTR - $var = ($type)SvPV($arg,na) -T_PACKED - $var = XS_unpack_$ntype($arg) -T_PACKEDARRAY - $var = XS_unpack_$ntype($arg) -T_CALLBACK - $var = make_perl_cb_$type($arg) -T_ARRAY - $var = $ntype(items -= $argoff); - U32 ix_$var = $argoff; - while (items--) { - DO_ARRAY_ELEM; + elsif ($mode eq Input) { + if (/^\s/) { + $$current .= $_; + } + else { + s/\s*$//; +# $input_expr{$_} = ''; + $current = \$input_expr{$_}; + } } -T_DATUM - $var.dptr = SvPV($arg, $var.dsize); -T_GDATUM - UNIMPLEMENTED -T_PLACEHOLDER -T_END - -$* = 1; %output_expr = (JUNK, split(/^(T_\w*)\s*\n/, <<'T_END')); $* = 0; -T_INT - sv_setiv($arg, (I32)$var); -T_ENUM - sv_setiv($arg, (I32)$var); -T_U_INT - sv_setiv($arg, (I32)$var); -T_SHORT - sv_setiv($arg, (I32)$var); -T_U_SHORT - sv_setiv($arg, (I32)$var); -T_LONG - sv_setiv($arg, (I32)$var); -T_U_LONG - sv_setiv($arg, (I32)$var); -T_CHAR - sv_setpvn($arg, (char *)&$var, 1); -T_U_CHAR - sv_setiv($arg, (I32)$var); -T_FLOAT - sv_setnv($arg, (double)$var); -T_DOUBLE - sv_setnv($arg, $var); -T_STRING - sv_setpv($arg, $var); -T_PTR - sv_setnv($arg, (double)(unsigned long)$var); -T_PTRREF - sv_setptrref($arg, $var); -T_PTROBJ - sv_setptrobj($arg, $var, \"${ntype}\"); -T_PTRDESC - sv_setptrobj($arg, (void*)new\U${type}_DESC\E($var), \"${ntype}\"); -T_REFREF - sv_setrefref($arg, \"${ntype}\", XS_service_$ntype, - ($var ? (void*)new $ntype($var) : 0)); -T_REFOBJ - NOT IMPLEMENTED -T_OPAQUE - sv_setpvn($arg, (char *)&$var, sizeof($var)); -T_OPAQUEPTR - sv_setpvn($arg, (char *)$var, sizeof(*$var)), XFree((char *)$var); -T_PACKED - XS_pack_$ntype($arg, $var); -T_PACKEDARRAY - XS_pack_$ntype($arg, $var, count_$ntype); -T_DATAUNIT - sv_setpvn($arg, $var.chp(), $var.size()); -T_CALLBACK - sv_setpvn($arg, $var.context.value().chp(), - $var.context.value().size()); -T_ARRAY - ST_EXTEND($var.size); - for (U32 ix_$var = 0; ix_$var < $var.size; ix_$var++) { - ST(ix_$var) = sv_mortalcopy(&sv_undef); - DO_ARRAY_ELEM + else { + if (/^\s/) { + $$current .= $_; + } + else { + s/\s*$//; +# $output_expr{$_} = ''; + $current = \$output_expr{$_}; + } } - sp += $var.size - 1; -T_DATUM - sv_setpvn($arg, $var.dptr, $var.dsize); -T_GDATUM - sv_usepvn($arg, $var.dptr, $var.dsize); -T_END + } + close(TYPEMAP); +} -$uvfile = shift @ARGV; -open(F, $uvfile) || die "cannot open $uvfile\n"; +foreach $key (keys %input_expr) { + $input_expr{$key} =~ s/\n+$//; +} -if ($eflag) { - print qq|#include "cfm/basic.h"\n|; +sub Q { + local $text = shift; + $text =~ tr/#//d; + $text; } +open(F, $filename) || die "cannot open $filename\n"; + while () { last if ($Module, $foo, $Package, $foo1, $Prefix) = /^MODULE\s*=\s*(\w+)(\s+PACKAGE\s*=\s*(\w+))?(\s+PREFIX\s*=\s*(.+))?$/; @@ -196,7 +97,7 @@ while () { $Package .= "::" if defined $Package && $Package ne ""; next; } - split(/[\t ]*\n/); + @line = split(/[\t ]*\n/); # initialize info arrays undef(%args_match); @@ -208,12 +109,12 @@ while () { undef($elipsis); # extract return type, function name and arguments - $ret_type = shift(@_); + $ret_type = shift(@line); if ($ret_type =~ /^static\s+(.*)$/) { $static = 1; $ret_type = $1; } - $func_header = shift(@_); + $func_header = shift(@line); ($func_name, $orig_args) = $func_header =~ /^([\w:]+)\s*\((.*)\)$/; if ($func_name =~ /(.*)::(.*)/) { $class = $1; @@ -254,39 +155,47 @@ while () { @args_match{@args} = 1..@args; # print function header - print <<"EOF" if $aflag; -static int -XS_${Pack}_$func_name(int, int sp, int items) + if ($ansiflag) { + print Q<<"EOF"; +#static int +#XS_${Pack}_$func_name(int, int ax, int items) EOF - print <<"EOF" if !$aflag; -static int -XS_${Pack}_$func_name(ix, sp, items) -register int ix; -register int sp; -register int items; -EOF - print <<"EOF" if $elipsis; -{ - if (items < $min_args) { - croak("Usage: $pname($orig_args)"); - } + } + else { + print Q<<"EOF"; +#static int +#XS_${Pack}_$func_name(ix, ax, items) +#register int ix; +#register int ax; +#register int items; EOF - print <<"EOF" if !$elipsis; -{ - if (items < $min_args || items > $num_args) { - croak("Usage: $pname($orig_args)"); - } + } + if ($elipsis) { + $cond = qq(items < $min_args); + } + elsif ($min_args == $num_args) { + $cond = qq(items != $min_args); + } + else { + $cond = qq(items < $min_args || items > $num_args); + } + +print Q<<"EOF"; +#{ +# if ($cond) { +# croak("Usage: $pname($orig_args)"); +# } EOF # Now do a block of some sort. $condnum = 0; -if (!@_) { - @_ = "CLEANUP:"; +if (!@line) { + @line = "CLEANUP:"; } -while (@_) { +while (@line) { if ($_[0] =~ s/^\s*CASE\s*:\s*//) { - $cond = shift(@_); + $cond = shift(@line); if ($condnum == 0) { print " if ($cond)\n"; } @@ -299,18 +208,24 @@ while (@_) { $condnum++; } - print <<"EOF" if $eflag; - TRY { + if ($except) { + print Q<<"EOF"; +# char errbuf[1024]; +# *errbuf = '\0'; +# TRY { EOF - print <<"EOF" if !$eflag; - { + } + else { + print Q<<"EOF"; +# { EOF + } # do initialization of input variables $thisdone = 0; $retvaldone = 0; $deferred = ""; - while ($_ = shift(@_)) { + while ($_ = shift(@line)) { last if /^\s*NOT_IMPLEMENTED_YET/; last if /^\s*(CODE|OUTPUT|CLEANUP|CASE)\s*:/; ($var_type, $var_name, $var_init) = @@ -359,7 +274,7 @@ EOF } print $deferred; if (/^\s*CODE:/) { - while ($_ = shift(@_)) { + while ($_ = shift(@line)) { last if /^\s*(OUTPUT|CLEANUP|CASE)\s*:/; print "$_\n"; } @@ -384,7 +299,7 @@ EOF # do output variables if (/^\s*OUTPUT\s*:/) { - while ($_ = shift(@_)) { + while ($_ = shift(@line)) { last if /^\s*CLEANUP\s*:/; s/^\s+//; ($outarg, $outcode) = split(/\t+/); @@ -401,43 +316,49 @@ EOF } # do cleanup if (/^\s*CLEANUP\s*:/) { - while ($_ = shift(@_)) { + while ($_ = shift(@line)) { last if /^\s*CASE\s*:/; print "$_\n"; } } # print function trailer - print < bar }; + $x->abc; # prints ``abc'' + $x->def; # prints ``def'' + } diff --git a/global.var b/global.sym similarity index 95% rename from global.var rename to global.sym index 13486f7..21c6ca6 100644 --- a/global.var +++ b/global.sym @@ -1,4 +1,7 @@ -# Global variables +# Global symbols that need to be hidden in embedded applications. + +# Variables + No Sv Xpv @@ -12,8 +15,8 @@ check coeff compiling comppad -comppadname -comppadnamefill +comppad_name +comppad_name_fill cop_seqmax cryptseen cshlen @@ -26,6 +29,7 @@ ds egid error_count euid +evalseq evstr expect expectterm @@ -37,11 +41,14 @@ in_format in_my know_next last_lop +last_lop_op last_uni linestr markstack markstack_max markstack_ptr +max_intro_pending +min_intro_pending multi_close multi_end multi_open @@ -353,6 +360,7 @@ mg_find mg_free mg_get mg_len +mg_magical mg_set mod modkids @@ -384,6 +392,7 @@ newHVREF newIO newLISTOP newLOGOP +newLOOPEX newLOOPOP newMETHOD newNULLLIST @@ -747,7 +756,6 @@ pp_xor prepend_elem push_return push_scope -pv_grow q ref refkids @@ -763,6 +771,11 @@ run save_I32 save_aptr save_ary +save_clearsv +save_delete +save_freeop +save_freepv +save_freesv save_hash save_hptr save_int @@ -797,6 +810,7 @@ scope screaminstr setenv_getix skipspace +start_subparse sublex_done sublex_start sv_2bool @@ -810,9 +824,13 @@ sv_catpv sv_catpvn sv_catsv sv_chop +sv_clean_all +sv_clean_magic +sv_clean_refs sv_clear sv_cmp sv_dec +sv_dump sv_eq sv_free sv_gets @@ -823,9 +841,11 @@ sv_isa sv_len sv_magic sv_mortalcopy +sv_newmortal sv_peek sv_ref sv_replace +sv_report_used sv_reset sv_setiv sv_setnv @@ -845,6 +865,12 @@ wait4pid warn watch whichsig +xiv_root +xnv_root +xpv_root +xrv_root +yyerror yyerror yylex yyparse +yywarn diff --git a/gv.c b/gv.c index 5e04e52..ec23d90 100644 --- a/gv.c +++ b/gv.c @@ -70,9 +70,11 @@ char *name; char tmpbuf[1200]; GV *gv; - sprintf(tmpbuf,"'_<%s", name); + sprintf(tmpbuf,"::_<%s", name); gv = gv_fetchpv(tmpbuf, TRUE); sv_setpv(GvSV(gv), name); + if (*name == '/') + SvMULTI_on(gv); if (perldb) hv_magic(GvHVn(gv_AVadd(gv)), gv, 'L'); return gv; @@ -92,10 +94,11 @@ int multi; if (SvLEN(gv)) Safefree(SvPVX(gv)); Newz(602,gp, 1, GP); - GvGP(gv) = gp; + GvGP(gv) = gp_ref(gp); GvREFCNT(gv) = 1; GvSV(gv) = NEWSV(72,0); GvLINE(gv) = curcop->cop_line; + GvFILEGV(gv) = curcop->cop_filegv; GvEGV(gv) = gv; sv_magic((SV*)gv, (SV*)gv, '*', name, len); GvSTASH(gv) = stash; @@ -286,6 +289,7 @@ I32 add; case 'I': if (strEQ(name, "ISA")) { AV* av = GvAVn(gv); + SvMULTI_on(gv); sv_magic((SV*)av, (SV*)gv, 'I', 0, 0); } break; @@ -435,9 +439,14 @@ IO * newIO() { IO *io; - - Newz(603,io,1,IO); - io->page_len = 60; + GV *iogv; + + io = (IO*)NEWSV(0,0); + sv_upgrade(io,SVt_PVIO); + SvREFCNT(io) = 1; + SvOBJECT_on(io); + iogv = gv_fetchpv("FileHandle::", TRUE); + SvSTASH(io) = (HV*)SvREFCNT_inc(GvHV(iogv)); return io; } @@ -450,6 +459,8 @@ HV* stash; register GV *gv; HV *hv; + if (!HvARRAY(stash)) + return; for (i = 0; i <= HvMAX(stash); i++) { for (entry = HvARRAY(stash)[i]; entry; entry = entry->hent_next) { if (isALPHA(*entry->hent_key)) { @@ -457,6 +468,9 @@ HV* stash; if (SvMULTI(gv)) continue; curcop->cop_line = GvLINE(gv); + curcop->cop_filegv = GvFILEGV(gv); + if (SvMULTI(GvFILEGV(gv))) /* Filename began with slash */ + continue; warn("Possible typo: \"%s::%s\"", HvNAME(stash), GvNAME(gv)); } else if (*entry->hent_key == '_' && @@ -503,17 +517,15 @@ GV* gv; if (--gp->gp_refcnt > 0) return; - sv_free((SV*)gp->gp_sv); - sv_free((SV*)gp->gp_av); - sv_free((SV*)gp->gp_hv); - if (io = gp->gp_io) { + SvREFCNT_dec(gp->gp_sv); + SvREFCNT_dec(gp->gp_av); + SvREFCNT_dec(gp->gp_hv); + if ((io = gp->gp_io) && SvTYPE(io) != SVTYPEMASK) { do_close(gv,FALSE); - Safefree(io->top_name); - Safefree(io->fmt_name); - Safefree(io); + SvREFCNT_dec(io); } - if (cv = gp->gp_cv) - sv_free((SV*)cv); + if ((cv = gp->gp_cv) && !GvCVGEN(gv)) + SvREFCNT_dec(cv); Safefree(gp); GvGP(gv) = 0; } diff --git a/gv.h b/gv.h index e6b6878..a0da45e 100644 --- a/gv.h +++ b/gv.h @@ -36,6 +36,7 @@ struct gp { U32 gp_cvgen; /* generational validity of cached gv_cv */ I32 gp_lastexpr; /* used by nothing_in_common() */ line_t gp_line; /* line first declared at (for -w) */ + GV * gp_filegv; /* file first declared in (for -w) */ char gp_flags; }; @@ -79,6 +80,7 @@ HV *GvHVn(); #define GvLASTEXPR(gv) (GvGP(gv)->gp_lastexpr) #define GvLINE(gv) (GvGP(gv)->gp_line) +#define GvFILEGV(gv) (GvGP(gv)->gp_filegv) #define GvFLAGS(gv) (GvGP(gv)->gp_flags) @@ -92,30 +94,6 @@ HV *GvHVn(); #define GvSTASH(gv) (GvXPVGV(gv)->xgv_stash) #define GvESTASH(gv) GvSTASH(GvEGV(gv)) -struct io { - FILE * ifp; /* ifp and ofp are normally the same */ - FILE * ofp; /* but sockets need separate streams */ -#ifdef HAS_READDIR - DIR * dirp; /* for opendir, readdir, etc */ -#endif - long lines; /* $. */ - long page; /* $% */ - long page_len; /* $= */ - long lines_left; /* $- */ - char * top_name; /* $^ */ - GV * top_gv; /* $^ */ - char * fmt_name; /* $~ */ - GV * fmt_gv; /* $~ */ - SV * object; - short subprocess; /* -| or |- */ - char type; - char flags; -}; - -#define IOf_ARGV 1 /* this fp iterates over ARGV */ -#define IOf_START 2 /* check for null ARGV and substitute '-' */ -#define IOf_FLUSH 4 /* this fp wants a flush after write op */ - #define Nullgv Null(GV*) #define DM_UID 0x003 diff --git a/hv.c b/hv.c index b0958e2..2468e87 100644 --- a/hv.c +++ b/hv.c @@ -48,9 +48,9 @@ I32 lval; if (!hv) return 0; - if (SvMAGICAL(hv)) { + if (SvRMAGICAL(hv)) { if (mg_find((SV*)hv,'P')) { - sv = sv_2mortal(NEWSV(61,0)); + sv = sv_newmortal(); mg_copy((SV*)hv, sv, key, klen); if (!lval) { mg_get(sv); @@ -111,7 +111,6 @@ register U32 hash; xhv = (XPVHV*)SvANY(hv); if (SvMAGICAL(hv)) { - MAGIC* mg = SvMAGIC(hv); mg_copy((SV*)hv, val, key, klen); if (!xhv->xhv_array) return 0; @@ -136,7 +135,7 @@ register U32 hash; continue; if (bcmp(entry->hent_key,key,klen)) /* is this it? */ continue; - sv_free(entry->hent_val); + SvREFCNT_dec(entry->hent_val); entry->hent_val = val; return &entry->hent_val; } @@ -175,7 +174,7 @@ U32 klen; if (!hv) return Nullsv; - if (SvMAGICAL(hv)) { + if (SvRMAGICAL(hv)) { sv = *hv_fetch(hv, key, klen, TRUE); mg_clear(sv); } @@ -276,7 +275,7 @@ register HE *hent; { if (!hent) return; - sv_free(hent->hent_val); + SvREFCNT_dec(hent->hent_val); Safefree(hent->hent_key); Safefree(hent); } @@ -380,8 +379,8 @@ HV *hv; xhv = (XPVHV*)SvANY(hv); entry = xhv->xhv_eiter; - if (SvMAGICAL(hv) && (mg = mg_find((SV*)hv,'P'))) { - SV *key = sv_2mortal(NEWSV(0,0)); + if (SvRMAGICAL(hv) && (mg = mg_find((SV*)hv,'P'))) { + SV *key = sv_newmortal(); if (entry) sv_setpvn(key, entry->hent_key, entry->hent_klen); else { @@ -398,7 +397,7 @@ HV *hv; return entry; } if (entry->hent_val) - sv_free(entry->hent_val); + SvREFCNT_dec(entry->hent_val); Safefree(entry); xhv->xhv_eiter = Null(HE*); return Null(HE*); @@ -437,9 +436,9 @@ hv_iterval(hv,entry) HV *hv; register HE *entry; { - if (SvMAGICAL(hv)) { + if (SvRMAGICAL(hv)) { if (mg_find((SV*)hv,'P')) { - SV* sv = sv_2mortal(NEWSV(61,0)); + SV* sv = sv_newmortal(); mg_copy((SV*)hv, sv, entry->hent_key, entry->hent_klen); mg_get(sv); sv_unmagic(sv,'p'); diff --git a/interp.var b/interp.sym similarity index 96% rename from interp.var rename to interp.sym index 3429de6..b2a4127 100644 --- a/interp.var +++ b/interp.sym @@ -56,7 +56,6 @@ firstgv forkprocess formfeed formtarget -freestrroot gensym in_eval incgv @@ -133,6 +132,10 @@ statname statusvalue stdingv strchop +sv_count +sv_rvcount +sv_root +sv_arenaroot tainted tainting tmps_floor diff --git a/keywords.h b/keywords.h index b075a84..54b629d 100644 --- a/keywords.h +++ b/keywords.h @@ -2,228 +2,230 @@ #define KEY___LINE__ 1 #define KEY___FILE__ 2 #define KEY___END__ 3 -#define KEY_BEGIN 4 -#define KEY_DESTROY 5 -#define KEY_END 6 -#define KEY_EQ 7 -#define KEY_GE 8 -#define KEY_GT 9 -#define KEY_LE 10 -#define KEY_LT 11 -#define KEY_NE 12 -#define KEY_abs 13 -#define KEY_accept 14 -#define KEY_alarm 15 -#define KEY_and 16 -#define KEY_atan2 17 -#define KEY_bind 18 -#define KEY_binmode 19 -#define KEY_bless 20 -#define KEY_caller 21 -#define KEY_chdir 22 -#define KEY_chmod 23 -#define KEY_chop 24 -#define KEY_chown 25 -#define KEY_chr 26 -#define KEY_chroot 27 -#define KEY_close 28 -#define KEY_closedir 29 -#define KEY_cmp 30 -#define KEY_connect 31 -#define KEY_continue 32 -#define KEY_cos 33 -#define KEY_crypt 34 -#define KEY_dbmclose 35 -#define KEY_dbmopen 36 -#define KEY_defined 37 -#define KEY_delete 38 -#define KEY_die 39 -#define KEY_do 40 -#define KEY_dump 41 -#define KEY_each 42 -#define KEY_else 43 -#define KEY_elsif 44 -#define KEY_endgrent 45 -#define KEY_endhostent 46 -#define KEY_endnetent 47 -#define KEY_endprotoent 48 -#define KEY_endpwent 49 -#define KEY_endservent 50 -#define KEY_eof 51 -#define KEY_eq 52 -#define KEY_eval 53 -#define KEY_exec 54 -#define KEY_exit 55 -#define KEY_exp 56 -#define KEY_fcntl 57 -#define KEY_fileno 58 -#define KEY_flock 59 -#define KEY_for 60 -#define KEY_foreach 61 -#define KEY_fork 62 -#define KEY_format 63 -#define KEY_formline 64 -#define KEY_ge 65 -#define KEY_getc 66 -#define KEY_getgrent 67 -#define KEY_getgrgid 68 -#define KEY_getgrnam 69 -#define KEY_gethostbyaddr 70 -#define KEY_gethostbyname 71 -#define KEY_gethostent 72 -#define KEY_getlogin 73 -#define KEY_getnetbyaddr 74 -#define KEY_getnetbyname 75 -#define KEY_getnetent 76 -#define KEY_getpeername 77 -#define KEY_getpgrp 78 -#define KEY_getppid 79 -#define KEY_getpriority 80 -#define KEY_getprotobyname 81 -#define KEY_getprotobynumber 82 -#define KEY_getprotoent 83 -#define KEY_getpwent 84 -#define KEY_getpwnam 85 -#define KEY_getpwuid 86 -#define KEY_getservbyname 87 -#define KEY_getservbyport 88 -#define KEY_getservent 89 -#define KEY_getsockname 90 -#define KEY_getsockopt 91 -#define KEY_glob 92 -#define KEY_gmtime 93 -#define KEY_goto 94 -#define KEY_grep 95 -#define KEY_gt 96 -#define KEY_hex 97 -#define KEY_if 98 -#define KEY_index 99 -#define KEY_int 100 -#define KEY_ioctl 101 -#define KEY_join 102 -#define KEY_keys 103 -#define KEY_kill 104 -#define KEY_last 105 -#define KEY_lc 106 -#define KEY_lcfirst 107 -#define KEY_le 108 -#define KEY_length 109 -#define KEY_link 110 -#define KEY_listen 111 -#define KEY_local 112 -#define KEY_localtime 113 -#define KEY_log 114 -#define KEY_lstat 115 -#define KEY_lt 116 -#define KEY_m 117 -#define KEY_mkdir 118 -#define KEY_msgctl 119 -#define KEY_msgget 120 -#define KEY_msgrcv 121 -#define KEY_msgsnd 122 -#define KEY_my 123 -#define KEY_ne 124 -#define KEY_next 125 -#define KEY_oct 126 -#define KEY_open 127 -#define KEY_opendir 128 -#define KEY_or 129 -#define KEY_ord 130 -#define KEY_pack 131 -#define KEY_package 132 -#define KEY_pipe 133 -#define KEY_pop 134 -#define KEY_print 135 -#define KEY_printf 136 -#define KEY_push 137 -#define KEY_q 138 -#define KEY_qq 139 -#define KEY_qx 140 -#define KEY_rand 141 -#define KEY_read 142 -#define KEY_readdir 143 -#define KEY_readline 144 -#define KEY_readlink 145 -#define KEY_readpipe 146 -#define KEY_recv 147 -#define KEY_redo 148 -#define KEY_ref 149 -#define KEY_rename 150 -#define KEY_require 151 -#define KEY_reset 152 -#define KEY_return 153 -#define KEY_reverse 154 -#define KEY_rewinddir 155 -#define KEY_rindex 156 -#define KEY_rmdir 157 -#define KEY_s 158 -#define KEY_scalar 159 -#define KEY_seek 160 -#define KEY_seekdir 161 -#define KEY_select 162 -#define KEY_semctl 163 -#define KEY_semget 164 -#define KEY_semop 165 -#define KEY_send 166 -#define KEY_setgrent 167 -#define KEY_sethostent 168 -#define KEY_setnetent 169 -#define KEY_setpgrp 170 -#define KEY_setpriority 171 -#define KEY_setprotoent 172 -#define KEY_setpwent 173 -#define KEY_setservent 174 -#define KEY_setsockopt 175 -#define KEY_shift 176 -#define KEY_shmctl 177 -#define KEY_shmget 178 -#define KEY_shmread 179 -#define KEY_shmwrite 180 -#define KEY_shutdown 181 -#define KEY_sin 182 -#define KEY_sleep 183 -#define KEY_socket 184 -#define KEY_socketpair 185 -#define KEY_sort 186 -#define KEY_splice 187 -#define KEY_split 188 -#define KEY_sprintf 189 -#define KEY_sqrt 190 -#define KEY_srand 191 -#define KEY_stat 192 -#define KEY_study 193 -#define KEY_sub 194 -#define KEY_substr 195 -#define KEY_symlink 196 -#define KEY_syscall 197 -#define KEY_sysread 198 -#define KEY_system 199 -#define KEY_syswrite 200 -#define KEY_tell 201 -#define KEY_telldir 202 -#define KEY_tie 203 -#define KEY_time 204 -#define KEY_times 205 -#define KEY_tr 206 -#define KEY_truncate 207 -#define KEY_uc 208 -#define KEY_ucfirst 209 -#define KEY_umask 210 -#define KEY_undef 211 -#define KEY_unless 212 -#define KEY_unlink 213 -#define KEY_unpack 214 -#define KEY_unshift 215 -#define KEY_untie 216 -#define KEY_until 217 -#define KEY_utime 218 -#define KEY_values 219 -#define KEY_vec 220 -#define KEY_wait 221 -#define KEY_waitpid 222 -#define KEY_wantarray 223 -#define KEY_warn 224 -#define KEY_while 225 -#define KEY_write 226 -#define KEY_x 227 -#define KEY_y 228 +#define KEY_AUTOLOAD 4 +#define KEY_BEGIN 5 +#define KEY_DESTROY 6 +#define KEY_END 7 +#define KEY_EQ 8 +#define KEY_GE 9 +#define KEY_GT 10 +#define KEY_LE 11 +#define KEY_LT 12 +#define KEY_NE 13 +#define KEY_abs 14 +#define KEY_accept 15 +#define KEY_alarm 16 +#define KEY_and 17 +#define KEY_atan2 18 +#define KEY_bind 19 +#define KEY_binmode 20 +#define KEY_bless 21 +#define KEY_caller 22 +#define KEY_chdir 23 +#define KEY_chmod 24 +#define KEY_chop 25 +#define KEY_chown 26 +#define KEY_chr 27 +#define KEY_chroot 28 +#define KEY_close 29 +#define KEY_closedir 30 +#define KEY_cmp 31 +#define KEY_connect 32 +#define KEY_continue 33 +#define KEY_cos 34 +#define KEY_crypt 35 +#define KEY_dbmclose 36 +#define KEY_dbmopen 37 +#define KEY_defined 38 +#define KEY_delete 39 +#define KEY_die 40 +#define KEY_do 41 +#define KEY_dump 42 +#define KEY_each 43 +#define KEY_else 44 +#define KEY_elsif 45 +#define KEY_endgrent 46 +#define KEY_endhostent 47 +#define KEY_endnetent 48 +#define KEY_endprotoent 49 +#define KEY_endpwent 50 +#define KEY_endservent 51 +#define KEY_eof 52 +#define KEY_eq 53 +#define KEY_eval 54 +#define KEY_exec 55 +#define KEY_exit 56 +#define KEY_exp 57 +#define KEY_fcntl 58 +#define KEY_fileno 59 +#define KEY_flock 60 +#define KEY_for 61 +#define KEY_foreach 62 +#define KEY_fork 63 +#define KEY_format 64 +#define KEY_formline 65 +#define KEY_ge 66 +#define KEY_getc 67 +#define KEY_getgrent 68 +#define KEY_getgrgid 69 +#define KEY_getgrnam 70 +#define KEY_gethostbyaddr 71 +#define KEY_gethostbyname 72 +#define KEY_gethostent 73 +#define KEY_getlogin 74 +#define KEY_getnetbyaddr 75 +#define KEY_getnetbyname 76 +#define KEY_getnetent 77 +#define KEY_getpeername 78 +#define KEY_getpgrp 79 +#define KEY_getppid 80 +#define KEY_getpriority 81 +#define KEY_getprotobyname 82 +#define KEY_getprotobynumber 83 +#define KEY_getprotoent 84 +#define KEY_getpwent 85 +#define KEY_getpwnam 86 +#define KEY_getpwuid 87 +#define KEY_getservbyname 88 +#define KEY_getservbyport 89 +#define KEY_getservent 90 +#define KEY_getsockname 91 +#define KEY_getsockopt 92 +#define KEY_glob 93 +#define KEY_gmtime 94 +#define KEY_goto 95 +#define KEY_grep 96 +#define KEY_gt 97 +#define KEY_hex 98 +#define KEY_if 99 +#define KEY_index 100 +#define KEY_int 101 +#define KEY_ioctl 102 +#define KEY_join 103 +#define KEY_keys 104 +#define KEY_kill 105 +#define KEY_last 106 +#define KEY_lc 107 +#define KEY_lcfirst 108 +#define KEY_le 109 +#define KEY_length 110 +#define KEY_link 111 +#define KEY_listen 112 +#define KEY_local 113 +#define KEY_localtime 114 +#define KEY_log 115 +#define KEY_lstat 116 +#define KEY_lt 117 +#define KEY_m 118 +#define KEY_mkdir 119 +#define KEY_msgctl 120 +#define KEY_msgget 121 +#define KEY_msgrcv 122 +#define KEY_msgsnd 123 +#define KEY_my 124 +#define KEY_ne 125 +#define KEY_next 126 +#define KEY_oct 127 +#define KEY_open 128 +#define KEY_opendir 129 +#define KEY_or 130 +#define KEY_ord 131 +#define KEY_pack 132 +#define KEY_package 133 +#define KEY_pipe 134 +#define KEY_pop 135 +#define KEY_print 136 +#define KEY_printf 137 +#define KEY_push 138 +#define KEY_q 139 +#define KEY_qq 140 +#define KEY_qw 141 +#define KEY_qx 142 +#define KEY_rand 143 +#define KEY_read 144 +#define KEY_readdir 145 +#define KEY_readline 146 +#define KEY_readlink 147 +#define KEY_readpipe 148 +#define KEY_recv 149 +#define KEY_redo 150 +#define KEY_ref 151 +#define KEY_rename 152 +#define KEY_require 153 +#define KEY_reset 154 +#define KEY_return 155 +#define KEY_reverse 156 +#define KEY_rewinddir 157 +#define KEY_rindex 158 +#define KEY_rmdir 159 +#define KEY_s 160 +#define KEY_scalar 161 +#define KEY_seek 162 +#define KEY_seekdir 163 +#define KEY_select 164 +#define KEY_semctl 165 +#define KEY_semget 166 +#define KEY_semop 167 +#define KEY_send 168 +#define KEY_setgrent 169 +#define KEY_sethostent 170 +#define KEY_setnetent 171 +#define KEY_setpgrp 172 +#define KEY_setpriority 173 +#define KEY_setprotoent 174 +#define KEY_setpwent 175 +#define KEY_setservent 176 +#define KEY_setsockopt 177 +#define KEY_shift 178 +#define KEY_shmctl 179 +#define KEY_shmget 180 +#define KEY_shmread 181 +#define KEY_shmwrite 182 +#define KEY_shutdown 183 +#define KEY_sin 184 +#define KEY_sleep 185 +#define KEY_socket 186 +#define KEY_socketpair 187 +#define KEY_sort 188 +#define KEY_splice 189 +#define KEY_split 190 +#define KEY_sprintf 191 +#define KEY_sqrt 192 +#define KEY_srand 193 +#define KEY_stat 194 +#define KEY_study 195 +#define KEY_sub 196 +#define KEY_substr 197 +#define KEY_symlink 198 +#define KEY_syscall 199 +#define KEY_sysread 200 +#define KEY_system 201 +#define KEY_syswrite 202 +#define KEY_tell 203 +#define KEY_telldir 204 +#define KEY_tie 205 +#define KEY_time 206 +#define KEY_times 207 +#define KEY_tr 208 +#define KEY_truncate 209 +#define KEY_uc 210 +#define KEY_ucfirst 211 +#define KEY_umask 212 +#define KEY_undef 213 +#define KEY_unless 214 +#define KEY_unlink 215 +#define KEY_unpack 216 +#define KEY_unshift 217 +#define KEY_untie 218 +#define KEY_until 219 +#define KEY_utime 220 +#define KEY_values 221 +#define KEY_vec 222 +#define KEY_wait 223 +#define KEY_waitpid 224 +#define KEY_wantarray 225 +#define KEY_warn 226 +#define KEY_while 227 +#define KEY_write 228 +#define KEY_x 229 +#define KEY_y 230 diff --git a/lib/AutoLoader.pm b/lib/AutoLoader.pm new file mode 100644 index 0000000..dba8ca2 --- /dev/null +++ b/lib/AutoLoader.pm @@ -0,0 +1,15 @@ +package AutoLoader; + +AUTOLOAD { + my $name = "auto/$AUTOLOAD.al"; + $name =~ s#::#/#g; + eval {require $name}; + if ($@) { + ($p,$f,$l) = caller($AutoLevel); + $@ =~ s/ at .*\n//; + die "$@ at $f line $l\n"; + } + goto &$AUTOLOAD; +} + +1; diff --git a/lib/Config.pm b/lib/Config.pm new file mode 100644 index 0000000..f911b21 --- /dev/null +++ b/lib/Config.pm @@ -0,0 +1,275 @@ +package Config; +require Exporter; +@ISA = (Exporter); +@EXPORT = qw(%Config); + +$] == 5.000 or die sprintf + "Perl lib version (5.000) doesn't match executable version (%.3f)\n", $]; + +# config.sh +# This file was produced by running the Configure script. +$Config{'d_eunice'} = undef; +$Config{'define'} = 'define'; +$Config{'eunicefix'} = ':'; +$Config{'loclist'} = ' +cat +cp +echo +expr +grep +mkdir +mv +rm +sed +sort +tr +uniq +'; +$Config{'expr'} = '/bin/expr'; +$Config{'sed'} = '/bin/sed'; +$Config{'echo'} = '/bin/echo'; +$Config{'cat'} = '/bin/cat'; +$Config{'rm'} = '/bin/rm'; +$Config{'mv'} = '/bin/mv'; +$Config{'cp'} = '/bin/cp'; +$Config{'tail'} = ''; +$Config{'tr'} = '/bin/tr'; +$Config{'mkdir'} = '/bin/mkdir'; +$Config{'sort'} = '/bin/sort'; +$Config{'uniq'} = '/bin/uniq'; +$Config{'grep'} = '/bin/grep'; +$Config{'trylist'} = ' +Mcc +bison +cpp +csh +egrep +line +nroff +perl +test +uname +yacc +'; +$Config{'test'} = 'test'; +$Config{'inews'} = ''; +$Config{'egrep'} = '/bin/egrep'; +$Config{'more'} = ''; +$Config{'pg'} = ''; +$Config{'Mcc'} = 'Mcc'; +$Config{'vi'} = ''; +$Config{'mailx'} = ''; +$Config{'mail'} = ''; +$Config{'cpp'} = '/usr/lib/cpp'; +$Config{'perl'} = '/home/netlabs1/lwall/pl/perl'; +$Config{'emacs'} = ''; +$Config{'ls'} = ''; +$Config{'rmail'} = ''; +$Config{'sendmail'} = ''; +$Config{'shar'} = ''; +$Config{'smail'} = ''; +$Config{'tbl'} = ''; +$Config{'troff'} = ''; +$Config{'nroff'} = '/bin/nroff'; +$Config{'uname'} = '/bin/uname'; +$Config{'uuname'} = ''; +$Config{'line'} = '/bin/line'; +$Config{'chgrp'} = ''; +$Config{'chmod'} = ''; +$Config{'lint'} = ''; +$Config{'sleep'} = ''; +$Config{'pr'} = ''; +$Config{'tar'} = ''; +$Config{'ln'} = ''; +$Config{'lpr'} = ''; +$Config{'lp'} = ''; +$Config{'touch'} = ''; +$Config{'make'} = ''; +$Config{'date'} = ''; +$Config{'csh'} = '/bin/csh'; +$Config{'bash'} = ''; +$Config{'ksh'} = ''; +$Config{'lex'} = ''; +$Config{'flex'} = ''; +$Config{'bison'} = '/usr/local/bin/bison'; +$Config{'Log'} = '$Log'; +$Config{'Header'} = '$Header'; +$Config{'Id'} = '$Id'; +$Config{'lastuname'} = 'SunOS scalpel 4.1.2 1 sun4c'; +$Config{'alignbytes'} = '8'; +$Config{'bin'} = '/usr/local/bin'; +$Config{'installbin'} = '/usr/local/bin'; +$Config{'byteorder'} = '4321'; +$Config{'contains'} = 'grep'; +$Config{'cppstdin'} = '/usr/lib/cpp'; +$Config{'cppminus'} = ''; +$Config{'d_bcmp'} = 'define'; +$Config{'d_bcopy'} = 'define'; +$Config{'d_safebcpy'} = 'define'; +$Config{'d_bzero'} = 'define'; +$Config{'d_castneg'} = 'define'; +$Config{'castflags'} = '0'; +$Config{'d_charsprf'} = 'define'; +$Config{'d_chsize'} = undef; +$Config{'d_crypt'} = 'define'; +$Config{'cryptlib'} = ''; +$Config{'d_csh'} = 'define'; +$Config{'d_dosuid'} = undef; +$Config{'d_dup2'} = 'define'; +$Config{'d_fchmod'} = 'define'; +$Config{'d_fchown'} = 'define'; +$Config{'d_fcntl'} = 'define'; +$Config{'d_flexfnam'} = 'define'; +$Config{'d_flock'} = 'define'; +$Config{'d_getgrps'} = 'define'; +$Config{'d_gethent'} = undef; +$Config{'d_getpgrp'} = 'define'; +$Config{'d_getpgrp2'} = undef; +$Config{'d_getprior'} = 'define'; +$Config{'d_htonl'} = 'define'; +$Config{'d_index'} = undef; +$Config{'d_isascii'} = 'define'; +$Config{'d_killpg'} = 'define'; +$Config{'d_lstat'} = 'define'; +$Config{'d_memcmp'} = 'define'; +$Config{'d_memcpy'} = 'define'; +$Config{'d_safemcpy'} = undef; +$Config{'d_memmove'} = undef; +$Config{'d_memset'} = 'define'; +$Config{'d_mkdir'} = 'define'; +$Config{'d_msg'} = 'define'; +$Config{'d_msgctl'} = 'define'; +$Config{'d_msgget'} = 'define'; +$Config{'d_msgrcv'} = 'define'; +$Config{'d_msgsnd'} = 'define'; +$Config{'d_ndbm'} = 'define'; +$Config{'d_odbm'} = 'define'; +$Config{'d_open3'} = 'define'; +$Config{'d_readdir'} = 'define'; +$Config{'d_rename'} = 'define'; +$Config{'d_rewindir'} = undef; +$Config{'d_rmdir'} = 'define'; +$Config{'d_seekdir'} = 'define'; +$Config{'d_select'} = 'define'; +$Config{'d_sem'} = 'define'; +$Config{'d_semctl'} = 'define'; +$Config{'d_semget'} = 'define'; +$Config{'d_semop'} = 'define'; +$Config{'d_setegid'} = 'define'; +$Config{'d_seteuid'} = 'define'; +$Config{'d_setpgrp'} = 'define'; +$Config{'d_setpgrp2'} = undef; +$Config{'d_setprior'} = 'define'; +$Config{'d_setregid'} = 'define'; +$Config{'d_setresgid'} = undef; +$Config{'d_setreuid'} = 'define'; +$Config{'d_setresuid'} = undef; +$Config{'d_setrgid'} = 'define'; +$Config{'d_setruid'} = 'define'; +$Config{'d_shm'} = 'define'; +$Config{'d_shmat'} = 'define'; +$Config{'d_voidshmat'} = undef; +$Config{'d_shmctl'} = 'define'; +$Config{'d_shmdt'} = 'define'; +$Config{'d_shmget'} = 'define'; +$Config{'d_socket'} = 'define'; +$Config{'d_sockpair'} = 'define'; +$Config{'d_oldsock'} = undef; +$Config{'socketlib'} = ''; +$Config{'d_statblks'} = 'define'; +$Config{'d_stdstdio'} = 'define'; +$Config{'d_strctcpy'} = 'define'; +$Config{'d_strerror'} = undef; +$Config{'d_symlink'} = 'define'; +$Config{'d_syscall'} = 'define'; +$Config{'d_telldir'} = 'define'; +$Config{'d_truncate'} = 'define'; +$Config{'d_vfork'} = 'define'; +$Config{'d_voidsig'} = 'define'; +$Config{'d_tosignal'} = 'int'; +$Config{'d_volatile'} = undef; +$Config{'d_vprintf'} = 'define'; +$Config{'d_charvspr'} = 'define'; +$Config{'d_wait4'} = 'define'; +$Config{'d_waitpid'} = 'define'; +$Config{'gidtype'} = 'gid_t'; +$Config{'groupstype'} = 'int'; +$Config{'i_fcntl'} = undef; +$Config{'i_gdbm'} = undef; +$Config{'i_grp'} = 'define'; +$Config{'i_niin'} = 'define'; +$Config{'i_sysin'} = undef; +$Config{'i_pwd'} = 'define'; +$Config{'d_pwquota'} = undef; +$Config{'d_pwage'} = 'define'; +$Config{'d_pwchange'} = undef; +$Config{'d_pwclass'} = undef; +$Config{'d_pwexpire'} = undef; +$Config{'d_pwcomment'} = 'define'; +$Config{'i_sys_file'} = 'define'; +$Config{'i_sysioctl'} = 'define'; +$Config{'i_time'} = undef; +$Config{'i_sys_time'} = 'define'; +$Config{'i_sys_select'} = undef; +$Config{'d_systimekernel'} = undef; +$Config{'i_utime'} = 'define'; +$Config{'i_varargs'} = 'define'; +$Config{'i_vfork'} = 'define'; +$Config{'intsize'} = '4'; +$Config{'libc'} = '/usr/lib/libc.so.1.7'; +$Config{'nm_opts'} = ''; +$Config{'libndir'} = ''; +$Config{'i_my_dir'} = undef; +$Config{'i_ndir'} = undef; +$Config{'i_sys_ndir'} = undef; +$Config{'i_dirent'} = 'define'; +$Config{'i_sys_dir'} = undef; +$Config{'d_dirnamlen'} = undef; +$Config{'ndirc'} = ''; +$Config{'ndiro'} = ''; +$Config{'mallocsrc'} = 'malloc.c'; +$Config{'mallocobj'} = 'malloc.o'; +$Config{'d_mymalloc'} = 'define'; +$Config{'mallocptrtype'} = 'char'; +$Config{'mansrc'} = '/usr/man/manl'; +$Config{'manext'} = 'l'; +$Config{'models'} = 'none'; +$Config{'split'} = ''; +$Config{'small'} = ''; +$Config{'medium'} = ''; +$Config{'large'} = ''; +$Config{'huge'} = ''; +$Config{'optimize'} = '-g'; +$Config{'ccflags'} = '-DDEBUGGING -DHAS_SDBM'; +$Config{'cppflags'} = '-DDEBUGGING -DHAS_SDBM'; +$Config{'ldflags'} = ''; +$Config{'cc'} = 'cc'; +$Config{'nativegcc'} = ''; +$Config{'libs'} = '-ldbm -lm -lposix'; +$Config{'n'} = '-n'; +$Config{'c'} = ''; +$Config{'package'} = 'perl'; +$Config{'randbits'} = '31'; +$Config{'scriptdir'} = '/usr/local/bin'; +$Config{'installscr'} = '/usr/local/bin'; +$Config{'sig_name'} = 'ZERO HUP INT QUIT ILL TRAP ABRT EMT FPE KILL BUS SEGV SYS PIPE ALRM TERM URG STOP TSTP CONT CLD TTIN TTOU IO XCPU XFSZ VTALRM PROF WINCH LOST USR1 USR2'; +$Config{'spitshell'} = 'cat'; +$Config{'shsharp'} = 'true'; +$Config{'sharpbang'} = '#!'; +$Config{'startsh'} = '#!/bin/sh'; +$Config{'stdchar'} = 'unsigned char'; +$Config{'uidtype'} = 'uid_t'; +$Config{'usrinclude'} = '/usr/include'; +$Config{'inclPath'} = ''; +$Config{'void'} = ''; +$Config{'voidhave'} = '7'; +$Config{'voidwant'} = '7'; +$Config{'w_localtim'} = '1'; +$Config{'w_s_timevl'} = '1'; +$Config{'w_s_tm'} = '1'; +$Config{'yacc'} = '/bin/yacc'; +$Config{'lib'} = ''; +$Config{'privlib'} = '/usr/local/lib/perl'; +$Config{'installprivlib'} = '/usr/local/lib/perl'; +$Config{'PATCHLEVEL'} = 34; +$Config{'CONFIG'} = true diff --git a/lib/English.pm b/lib/English.pm new file mode 100644 index 0000000..959e5b6 --- /dev/null +++ b/lib/English.pm @@ -0,0 +1,139 @@ +package English; + +require Exporter; +@ISA = (Exporter); + +@EXPORT = qw( + *ARG + $MAGIC + $MATCH + $PREMATCH + $POSTMATCH + $LAST_PAREN_MATCH + $INPUT_LINE_NUMBER + $NR + $INPUT_RECORD_SEPARATOR + $RS + $OUTPUT_AUTOFLUSH + $OUTPUT_FIELD_SEPARATOR + $OFS + $OUTPUT_RECORD_SEPARATOR + $ORS + $LIST_SEPARATOR + $SUBSCRIPT_SEPARATOR + $SUBSEP + $FORMAT_PAGE_NUMBER + $FORMAT_LINES_PER_PAGE + $FORMAT_LINES_LEFT + $FORMAT_NAME + $FORMAT_TOP_NAME + $FORMAT_LINE_BREAK_CHARACTERS + $FORMAT_FORMFEED + $CHILD_ERROR + $OS_ERROR + $EVAL_ERROR + $PROCESS_ID + $PID + $REAL_USER_ID + $UID + $EFFECTIVE_USER_ID + $EUID + $REAL_GROUP_ID + $GID + $EFFECTIVE_GROUP_ID + $EGID + $PROGRAM_NAME + $PERL_VERSION + $DEBUGGING + $SYSTEM_FD_MAX + $INPLACE_EDIT + $PERLDB + $BASETIME + $WARNING + $EXECUTABLE_NAME + $ARRAY_BASE + $OFMT + $MULTILINE_MATCHING +); + +# The ground of all being. + + *MAGIC = \$_ ; + *ARG = *_ ; + +# Matching. + + *MATCH = \$& ; + *PREMATCH = \$` ; + *POSTMATCH = \$' ; + *LAST_PAREN_MATCH = \$+ ; + +# Input. + + *INPUT_LINE_NUMBER = \$. ; + *NR = \$. ; + *INPUT_RECORD_SEPARATOR = \$/ ; + *RS = \$/ ; + +# Output. + + *OUTPUT_AUTOFLUSH = \$| ; + *OUTPUT_FIELD_SEPARATOR = \$, ; + *OFS = \$, ; + *OUTPUT_RECORD_SEPARATOR = \$\ ; + *ORS = \$\ ; + +# Interpolation "constants". + + *LIST_SEPARATOR = \$" ; + *SUBSCRIPT_SEPARATOR = \$; ; + *SUBSEP = \$; ; + +# Formats + + *FORMAT_PAGE_NUMBER = \$% ; + *FORMAT_LINES_PER_PAGE = \$= ; + *FORMAT_LINES_LEFT = \$- ; + *FORMAT_NAME = \$~ ; + *FORMAT_TOP_NAME = \$^ ; + *FORMAT_LINE_BREAK_CHARACTERS = \$: ; + *FORMAT_FORMFEED = \$^L ; + +# Error status. + + *CHILD_ERROR = \$? ; + *OS_ERROR = \$! ; + *EVAL_ERROR = \$@ ; + +# Process info. + + *PROCESS_ID = \$$ ; + *PID = \$$ ; + *REAL_USER_ID = \$< ; + *UID = \$< ; + *EFFECTIVE_USER_ID = \$> ; + *EUID = \$> ; + *REAL_GROUP_ID = \$( ; + *GID = \$( ; + *EFFECTIVE_GROUP_ID = \$) ; + *EGID = \$) ; + *PROGRAM_NAME = \$0 ; + +# Internals. + + *PERL_VERSION = \$] ; + *DEBUGGING = \$^D ; + *SYSTEM_FD_MAX = \$^F ; + *INPLACE_EDIT = \$^I ; + *PERLDB = \$^P ; + *BASETIME = \$^T ; + *WARNING = \$^W ; + *EXECUTABLE_NAME = \$^X ; + +# Deprecated. + + *ARRAY_BASE = \$[ ; + *OFMT = \$# ; + *MULTILINE_MATCHING = \$* ; + +1; diff --git a/lib/Exporter.pm b/lib/Exporter.pm new file mode 100644 index 0000000..0b021b3 --- /dev/null +++ b/lib/Exporter.pm @@ -0,0 +1,46 @@ +package Exporter; + +require 5.000; + +sub import { + my ($callpack, $callfile, $callline) = caller($ExportLevel); + my $pack = shift; + my @imports = @_; + *exports = \@{"${pack}::EXPORT"}; + if (@imports) { + my $oops; + my $type; + *exports = \%{"${pack}::EXPORT"}; + if (!%exports) { + grep(s/^&//, @exports); + @exports{@exports} = (1) x @exports; + } + foreach $sym (@imports) { + if (!$exports{$sym}) { + if ($sym !~ s/^&// || !$exports{$sym}) { + warn "$sym is not exported by the $pack module ", + "at $callfile line $callline\n"; + $oops++; + next; + } + } + } + die "Can't continue with import errors.\n" if $oops; + } + else { + @imports = @exports; + } + foreach $sym (@imports) { + $type = '&'; + $type = $1 if $sym =~ s/^(\W)//; + *{"${callpack}::$sym"} = + $type eq '&' ? \&{"${pack}::$sym"} : + $type eq '$' ? \${"${pack}::$sym"} : + $type eq '@' ? \@{"${pack}::$sym"} : + $type eq '%' ? \%{"${pack}::$sym"} : + $type eq '*' ? *{"${pack}::$sym"} : + warn "Can't export symbol: $type$sym\n"; + } +}; + +1; diff --git a/lib/FOOBAR.pm b/lib/FOOBAR.pm new file mode 100644 index 0000000..9013b4e --- /dev/null +++ b/lib/FOOBAR.pm @@ -0,0 +1,10 @@ +package FOOBAR; + +require Exporter; +@ISA = (Exporter); +@EXPORT = (foo, bar); + +sub foo { print "FOO\n" }; +sub bar { print "BAR\n" }; + +1; diff --git a/lib/FileHandle.pm b/lib/FileHandle.pm new file mode 100644 index 0000000..b975c2b --- /dev/null +++ b/lib/FileHandle.pm @@ -0,0 +1,110 @@ +package FileHandle; + +BEGIN { + require 5.000; + require English; import English; +} +@ISA = (); + +sub print { + local($this) = shift; + print $this @_; +} + +sub output_autoflush { + local($old) = select($_[0]); + local($prev) = $OUTPUT_AUTOFLUSH; + $OUTPUT_AUTOFLUSH = @_ > 1 ? $_[1] : 1; + select($old); + $prev; +} + +sub output_field_separator { + local($old) = select($_[0]); + local($prev) = $OUTPUT_FIELD_SEPARATOR; + $OUTPUT_FIELD_SEPARATOR = $_[1] if @_ > 1; + select($old); + $prev; +} + +sub output_record_separator { + local($old) = select($_[0]); + local($prev) = $OUTPUT_RECORD_SEPARATOR; + $OUTPUT_RECORD_SEPARATOR = $_[1] if @_ > 1; + select($old); + $prev; +} + +sub input_record_separator { + local($old) = select($_[0]); + local($prev) = $INPUT_RECORD_SEPARATOR; + $INPUT_RECORD_SEPARATOR = $_[1] if @_ > 1; + select($old); + $prev; +} + +sub input_line_number { + local($old) = select($_[0]); + local($prev) = $INPUT_LINE_NUMBER; + $INPUT_LINE_NUMBER = $_[1] if @_ > 1; + select($old); + $prev; +} + +sub format_page_number { + local($old) = select($_[0]); + local($prev) = $FORMAT_PAGE_NUMBER; + $FORMAT_PAGE_NUMBER = $_[1] if @_ > 1; + select($old); + $prev; +} + +sub format_lines_per_page { + local($old) = select($_[0]); + local($prev) = $FORMAT_LINES_PER_PAGE; + $FORMAT_LINES_PER_PAGE = $_[1] if @_ > 1; + select($old); + $prev; +} + +sub format_lines_left { + local($old) = select($_[0]); + local($prev) = $FORMAT_LINES_LEFT; + $FORMAT_LINES_LEFT = $_[1] if @_ > 1; + select($old); + $prev; +} + +sub format_name { + local($old) = select($_[0]); + local($prev) = $FORMAT_NAME; + $FORMAT_NAME = $_[1] if @_ > 1; + select($old); + $prev; +} + +sub format_top_name { + local($old) = select($_[0]); + local($prev) = $FORMAT_TOP_NAME; + $FORMAT_TOP_NAME = $_[1] if @_ > 1; + select($old); + $prev; +} + +sub format_line_break_characters { + local($old) = select($_[0]); + local($prev) = $FORMAT_LINE_BREAK_CHARACTERS; + $FORMAT_LINE_BREAK_CHARACTERS = $_[1] if @_ > 1; + select($old); + $prev; +} + +sub format_formfeed { + local($old) = select($_[0]); + local($prev) = $FORMAT_FORMFEED; + $FORMAT_FORMFEED = $_[1] if @_ > 1; + select($old); + $prev; +} + +1; diff --git a/lib/Hostname.pm b/lib/Hostname.pm new file mode 100644 index 0000000..4a59695 --- /dev/null +++ b/lib/Hostname.pm @@ -0,0 +1,48 @@ +# by David Sundstrom sunds@asictest.sc.ti.com +# Texas Instruments + +package Hostname; + +require Exporter; +@ISA = (Exporter); +@EXPORT = (hostname); + +# +# Try every conceivable way to get hostname. +# + +sub hostname { + # method 1 - we already know it + return $host if defined $host; + + # method 2 - syscall is preferred since it avoids tainting problems + eval { + require "syscall.ph"; + $host = "\0" x 65; ## preload scalar + syscall(&SYS_gethostname, $host, 65) == 0; + } + + # method 3 - sysV uname command + || eval { + $host = `uname -n 2>/dev/null`; ## sysVish + } + + # method 4 - trusty old hostname command + || eval { + $host = `hostname 2>/dev/null`; # bsdish + } + + # method 5 - Apollo pre-SR10 + || eval { + ($host,$a,$b,$c,$d)=split(/[:\. ]/,`/com/host`,6); + } + + # bummer + || die "Cannot get host name of local machine\n"; + + # remove garbage + $host =~ tr/\0\r\n//d; + $host; +} + +1; diff --git a/lib/POSIX.pm b/lib/POSIX.pm new file mode 100644 index 0000000..bf5d355 --- /dev/null +++ b/lib/POSIX.pm @@ -0,0 +1,200 @@ +package POSIX; + +require Exporter; +require AutoLoader; +@ISA = (Exporter, AutoLoader, DynamicLoader); + +$H{assert_h} = [qw(assert NDEBUG)]; + +$H{ctype_h} = [qw(isalnum isalpha iscntrl isdigit isgraph islower + isprint ispunct isspace isupper isxdigit tolower toupper)]; + +$H{dirent_h} = [qw(closedir opendir readdir rewinddir)]; + +$H{errno_h} = [qw(E2BIG EACCES EAGAIN EBADF EBUSY ECHILD EDEADLK EDOM + EEXIST EFAULT EFBIG EINTR EINVAL EIO EISDIR EMFILE + EMLINK ENAMETOOLONG ENFILE ENODEV ENOENT ENOEXEC ENOLCK + ENOMEM ENOSPC ENOSYS ENOTDIR ENOTEMPTY ENOTTY ENXIO + EPERM EPIPE ERANGE EROFS ESPIPE ESRCH EXDEV errno)]; + +$H{fcntl_h} = [qw(FD_CLOEXEC F_DUPFD F_GETFD F_GETFL F_GETLK F_RDLCK + F_SETFD F_SETFL F_SETLK F_SETLKW F_UNLCK F_WRLCK + O_ACCMODE O_APPEND O_CREAT O_EXCL O_NOCTTY O_NONBLOCK + O_RDONLY O_RDWR O_TRUNC O_WRONLY + creat fcntl open + SEEK_CUR SEEK_END SEEK_SET + S_IRGRP S_IROTH S_IRUSR S_IRWXG S_IRWXO S_IRWXU + S_ISBLK S_ISCHR S_ISDIR S_ISFIFO S_ISGID S_ISREG S_ISUID + S_IWGRP S_IWOTH S_IWUSR)]; + +$H{float_h} = [qw(DBL_DIG DBL_EPSILON DBL_MANT_DIG + DBL_MAX DBL_MAX_10_EXP DBL_MAX_EXP + DBL_MIN DBL_MIN_10_EXP DBL_MIN_EXP + FLT_DIG FLT_EPSILON FLT_MANT_DIG + FLT_MAX FLT_MAX_10_EXP FLT_MAX_EXP + FLT_MIN FLT_MIN_10_EXP FLT_MIN_EXP + FLT_RADIX FLT_ROUNDS + LDBL_DIG LDBL_EPSILON LDBL_MANT_DIG + LDBL_MAX LDBL_MAX_10_EXP LDBL_MAX_EXP + LDBL_MIN LDBL_MIN_10_EXP LDBL_MIN_EXP)]; + +$H{grp_h} = [qw(getgrgid getgrnam)]; + +$H{limits_h} = [qw( ARG_MAX CHAR_BIT CHAR_MAX CHAR_MIN CHILD_MAX + INT_MAX INT_MIN LINK_MAX LONG_MAX LONG_MIN MAX_CANON + MAX_INPUT MB_LEN_MAX NAME_MAX NGROUPS_MAX OPEN_MAX + PATH_MAX PIPE_BUF SCHAR_MAX SCHAR_MIN SHRT_MAX SHRT_MIN + SSIZE_MAX STREAM_MAX TZNAME_MAX UCHAR_MAX UINT_MAX + ULONG_MAX USHRT_MAX _POSIX_ARG_MAX _POSIX_CHILD_MAX + _POSIX_LINK_MAX _POSIX_MAX_CANON _POSIX_MAX_INPUT + _POSIX_NAME_MAX _POSIX_NGROUPS_MAX _POSIX_OPEN_MAX + _POSIX_PATH_MAX _POSIX_PIPE_BUF _POSIX_SSIZE_MAX + _POSIX_STREADM_MAX _POSIX_TZNAME_MAX)]; + +$H{locale_h} = [qw(LC_ALL LC_COLLATE LC_CTYPE LC_MONETARY LC_NUMERIC + LC_TIME NULL localeconf setlocale)]; + +$H{math_h} = [qw(HUGE_VAL acos asin atan2 atan ceil cos cosh exp + fabs floor fmod frexp ldexp log10 log modf pow sin sinh + sqrt tan tanh)]; + +$H{pwd_h} = [qw(getpwnam getpwuid)]; + +$H{setjmp_h} = [qw(longjmp setjmp siglongjmp sigsetjmp)]; + +$H{signal_h} = [qw(SA_NOCLDSTOP SIGABRT SIGALRM SIGCHLD SIGCONT SIGFPE + SIGHUP SIGILL SIGINT SIGKILL SIGPIPE SIGQUIT SIGSEGV + SIGSTOP SIGTERM SIGTSTP SIGTTIN SIGTTOU SIGUSR1 SIGUSR2 + SIG_BLOCK SIG_DFL SIG_ERR SIG_IGN SIG_SETMASK SIG_UNBLOCK + kill raise sigaction sigaddset sigdelset sigemptyset + sigfillset sigismember signal sigpending sigprocmask + sigsuspend)]; + +$H{stdarg_h} = [qw()]; + +$H{stddef_h} = [qw(NULL offsetof)]; + +$H{stdio_h} = [qw(BUFSIZ EOF FILENAME_MAX L_ctermid L_cuserid + L_tmpname NULL SEEK_CUR SEEK_END SEEK_SET STREAM_MAX + TMP_MAX stderr stdin stdout _IOFBF _IOLBF _IONBF + clearerr fclose fdopen feof ferror fflush fgetc fgetpos + fgets fileno fopen fprintf fputc fputs fread freopen + fscanf fseek fsetpos ftell fwrite getc getchar gets + perror printf putc putchar puts remove rename rewind + scanf setbuf setvbuf sprintf sscanf tmpfile tmpnam + ungetc vfprintf vprintf vsprintf)]; + +$H{stdlib_h} = [qw(EXIT_FAILURE EXIT_SUCCESS MB_CUR_MAX NULL RAND_MAX + abort abs atexit atof atoi atol bsearch calloc div exit + free getenv labs ldiv malloc mblen mbstowcs mbtowc + qsort rand realloc srand strtod strtol stroul system + wcstombs wctomb)]; + +$H{string_h} = [qw(NULL memchr memcmp memcpy memmove memset strcat + strchr strcmp strcoll strcpy strcspn strerror strlen + strncat strncmp strncpy strpbrk strrchr strspn strstr + strtok strxfrm)]; + +$H{sys_stat_h} = [qw(S_IRGRP S_IROTH S_IRUSR S_IRWXG S_IRWXO S_IRWXU + S_ISBLK S_ISCHR S_ISDIR S_ISFIFO S_ISGID S_ISREG + S_ISUID S_IWGRP S_IWOTH S_IWUSR S_IXGRP S_IXOTH S_IXUSR + chmod fstat mkdir mkfifo stat umask)]; + +$H{sys_times_h} = [qw(times)]; + +$H{sys_types_h} = [qw()]; + +$H{sys_utsname_h} = [qw(uname)]; + +$H{sys_wait_h} = [qw(WEXITSTATUS WIFEXITED WIFSIGNALED WIFSTOPPED + WNOHANG WSTOPSIG WTERMSIG WUNTRACED wait waitpid)]; + +$H{termios_h} = [qw( B0 B110 B1200 B134 B150 B1800 B19200 B200 B2400 + B300 B38400 B4800 B50 B600 B75 B9600 BRKINT CLOCAL + CREAD CS5 CS6 CS7 CS8 CSIZE CSTOPB ECHO ECHOE ECHOK + ECHONL HUPCL ICANON ICRNL IEXTEN IGNBRK IGNCR IGNPAR + INLCR INPCK ISIG ISTRIP IXOFF IXON NCCS NOFLSH OPOST + PARENB PARMRK PARODD TCIFLUSH TCIOFF TCIOFLUSH TCION + TCOFLUSH TCOOFF TCOON TCSADRAIN TCSAFLUSH TCSANOW + TOSTOP VEOF VEOL VERASE VINTR VKILL VMIN VQUIT VSTART + VSTOP VSUSP VTIME + cfgetispeed cfgetospeed cfsetispeed cfsetospeed tcdrain + tcflow tcflush tcgetattr tcsendbreak tcsetattr )]; + +$H{time_h} = [qw(CLK_TCK CLOCKS_PER_SEC NULL asctime clock ctime + difftime gmtime localtime mktime strftime time tzset tzname)]; + +$H{unistd_h} = [qw(F_OK NULL R_OK SEEK_CUR SEEK_END SEEK_SET + STRERR_FILENO STDIN_FILENO STDOUT_FILENO W_OK X_OK + _PC_CHOWN_RESTRICTED _PC_LINK_MAX _PC_MAX_CANON + _PC_MAX_INPUT _PC_NAME_MAX _PC_NO_TRUNC _PC_PATH_MAX + _PC_PIPE_BUF _PC_VDISABLE _POSIX_CHOWN_RESTRICTED + _POSIX_JOB_CONTROL _POSIX_NO_TRUNC _POSIX_SAVED_IDS + _POSIX_VDISABLE _POSIX_VERSION _SC_ARG_MAX + _SC_CHILD_MAX _SC_CLK_TCK _SC_JOB_CONTROL + _SC_NGROUPS_MAX _SC_OPEN_MAX _SC_SAVED_IDS + _SC_STREAM_MAX _SC_TZNAME_MAX _SC_VERSION + _exit access alarm chdir chown close ctermid cuserid + dup2 dup execl execle execlp execv execve execvp fork + fpathconf getcwd getegid geteuid getgid getgroups + getlogin getpgrp getpid getppid getuid isatty link + lseek pathconf pause pipe read rmdir setgid setpgid + setsid setuid sleep sysconf tcgetpgrp tcsetpgrp ttyname + unlink write)]; + +$H{utime_h} = [qw(utime)]; + +sub expand { + local (@mylist); + foreach $entry (@_) { + if ($H{$entry}) { + push(@mylist, @{$H{$entry}}); + } + else { + push(@mylist, $entry); + } + } + @mylist; +} + +@EXPORT = expand qw(assert_h ctype_h dirent_h errno_h fcntl_h float_h + grp_h limits_h locale_h math_h pwd_h setjmp_h signal_h + stdarg_h stddef_h stdio_h stdlib_h string_h sys_stat_h + sys_times_h sys_types_h sys_utsname_h sys_wait_h + termios_h time_h unistd_h utime_h); + +sub import { + my $this = shift; + my @list = expand @_; + local $Exporter::ExportLevel = 1; + Exporter::import($this,@list); +} + +bootstrap POSIX; + +sub usage { local ($mess, $pack, $file, $line) = @_; + die "Usage: POSIX::$_[0] at $file line $line\n"; +} + +1; + +__END__ +sub getpid { + usage "getpid()", caller if @_ != 0; + $$; +} + +sub getppid { + usage "getppid()", caller if @_ != 0; + getppid; +} + +sub fork { + usage "fork()", caller if @_ != 0; + fork; +} + +sub kill { + usage "kill(pid, sig)", caller if @_ != 2; + kill $_[1], $_[0]; +} diff --git a/lib/SDBM_File.pm b/lib/SDBM_File.pm new file mode 100644 index 0000000..470d891 --- /dev/null +++ b/lib/SDBM_File.pm @@ -0,0 +1,9 @@ +package SDBM_File; + +require Exporter; +@ISA = (Exporter, DynamicLoader); +@EXPORT = split(' ', 'new fetch store delete firstkey nextkey error clearerr'); + +bootstrap SDBM_File; + +1; diff --git a/lib/bigint.pl b/lib/bigint.pl index 45ffe1d..e6ba644 100644 --- a/lib/bigint.pl +++ b/lib/bigint.pl @@ -33,10 +33,14 @@ package bigint; # bgcd(BINT,BINT) return BINT greatest common divisor # bnorm(BINT) return BINT normalization # + +$zero = 0; + # normalize string form of number. Strip leading zeros. Strip any # white space and add a sign, if missing. # Strings that are not numbers result the value 'NaN'. + sub main'bnorm { #(num_str) return num_str local($_) = @_; s/\s+//g; # strip white space @@ -263,7 +267,7 @@ sub main'bdiv { #(dividend: num_str, divisor: num_str) return num_str else { @d = @x; } - (&external($sr, @q), &external($srem, @d, 0)); + (&external($sr, @q), &external($srem, @d, $zero)); } else { &external($sr, @q); } diff --git a/lib/find.pl b/lib/find.pl index 8dab054..d55cd33 100644 --- a/lib/find.pl +++ b/lib/find.pl @@ -26,6 +26,8 @@ # $dev < 0 && # ($prune = 1); # } +# +# Set the variable $dont_use_nlink if you're using AFS, since AFS cheats. sub find { chop($cwd = `pwd`); @@ -66,7 +68,7 @@ sub finddir { local(@filenames) = readdir(DIR); closedir(DIR); - if ($nlink == 2) { # This dir has no subdirectories. + if ($nlink == 2 && !$dont_use_nlink) { # This dir has no subdirectories. for (@filenames) { next if $_ eq '.'; next if $_ eq '..'; @@ -83,7 +85,7 @@ sub finddir { $nlink = $prune = 0; $name = "$dir/$_"; &wanted; - if ($subcount > 0) { # Seen all the subdirs? + if ($subcount > 0 || $dont_use_nlink) { # Seen all the subdirs? # Get link count and check for directoriness. diff --git a/lib/perldb.pl b/lib/perldb.pl index deeef8a..0b50555 100644 --- a/lib/perldb.pl +++ b/lib/perldb.pl @@ -72,7 +72,8 @@ else { } open(IN, "<$console") || open(IN, "<&STDIN"); # so we don't dingle stdin -open(OUT,">$console") || open(OUT, ">&STDOUT"); # so we don't dongle stdout +open(OUT,">$console") || open(OUT, "<&STDERR") + || open(OUT, ">&STDOUT"); # so we don't dongle stdout select(OUT); $| = 1; # for DB::OUT select(STDOUT); @@ -95,7 +96,6 @@ sub DB { ($package, $filename, $line) = caller; $usercontext = '($@, $!, $[, $,, $/, $\) = @saved;' . "package $package;"; # this won't let them modify, alas - local($^P) = 0; # don't debug our own evals local(*dbline) = "::_<$filename"; $max = $#dbline; if (($stop,$action) = split(/\0/,$dbline{$line})) { diff --git a/lib/verbose.pl b/lib/verbose.pl deleted file mode 100644 index ee6143c..0000000 --- a/lib/verbose.pl +++ /dev/null @@ -1,78 +0,0 @@ -# The ground of all being. - - *MAGIC = *_ ; - -# Matching. - - *MATCH = *& ; - *PREMATCH = *` ; - *POSTMATCH = *' ; - *LAST_PAREN_MATCH = *+ ; - -# Input. - - *INPUT_LINE_NUMBER = *. ; - *NR = *. ; - *INPUT_RECORD_SEPARATOR = */ ; - *RS = */ ; - -# Output. - - *OUTPUT_AUTOFLUSH = *| ; - *OUTPUT_FIELD_SEPARATOR = *, ; - *OFS = *, ; - *OUTPUT_RECORD_SEPARATOR = *\ ; - *ORS = *\ ; - -# Interpolation "constants". - - *LIST_SEPARATOR = *" ; - *SUBSCRIPT_SEPARATOR = *; ; - *SUBSEP = *; ; - -# Formats - - *FORMAT_PAGE_NUMBER = *% ; - *FORMAT_LINES_PER_PAGE = *= ; - *FORMAT_LINES_LEFT = *- ; - *FORMAT_NAME = *~ ; - *FORMAT_TOP_NAME = *^ ; - *FORMAT_LINE_BREAK_CHARACTERS = *: ; - *FORMAT_FORMFEED = *^L ; - -# Error status. - - *CHILD_ERROR = *? ; - *OS_ERROR = *! ; - *EVAL_ERROR = *@ ; - -# Process info. - - *PROCESS_ID = *$ ; - *PID = *$ ; - *REAL_USER_ID = *< ; - *UID = *< ; - *EFFECTIVE_USER_ID = *> ; - *EUID = *> ; - *REAL_GROUP_ID = *( ; - *GID = *( ; - *EFFECTIVE_GROUP_ID = *) ; - *EGID = *) ; - *PROGRAM_NAME = *0 ; - -# Internals. - - *PERL_VERSION = *] ; - *DEBUGGING = *^D ; - *SYSTEM_FD_MAX = *^F ; - *INPLACE_EDIT = *^I ; - *PERLDB = *^P ; - *BASETIME = *^T ; - *WARNING = *^W ; - *EXECUTABLE_NAME = *^X ; - -# Deprecated. - - *ARRAY_BASE = *[ ; - *OFMT = *# ; - *MULTILINE_MATCHING = ** ; diff --git a/main.c b/main.c index fe34e75..ff43754 100644 --- a/main.c +++ b/main.c @@ -33,22 +33,25 @@ perl_init_ext() { char *file = __FILE__; + boot_DynamicLoader(); + #ifdef HAS_DB - newXSUB("DB_File::init", 0, init_DB_File, file); + newXSUB("DB_File::bootstrap", 0, boot_DB_File, file); #endif #ifdef HAS_NDBM - newXSUB("NDBM_File::init", 0, init_NDBM_File, file); + newXSUB("NDBM_File::bootstrap", 0, boot_NDBM_File, file); #endif #ifdef HAS_GDBM - newXSUB("GDBM_File::init", 0, init_GDBM_File, file); + newXSUB("GDBM_File::bootstrap", 0, boot_GDBM_File, file); #endif #ifdef HAS_SDBM - newXSUB("SDBM_File::init", 0, init_SDBM_File, file); +/* newXSUB("SDBM_File::bootstrap", 0, boot_SDBM_File, file); */ #endif #ifdef HAS_ODBM - newXSUB("ODBM_File::init", 0, init_ODBM_File, file); + newXSUB("ODBM_File::bootstrap", 0, boot_ODBM_File, file); #endif #ifdef HAS_DBZ - newXSUB("DBZ_File::init", 0, init_DBZ_File, file); + newXSUB("DBZ_File::bootstrap", 0, boot_DBZ_File, file); #endif + newXSUB("POSIX::bootstrap", 0, boot_POSIX, file); } diff --git a/make.out b/make.out index bebbb6a..bc47759 100644 --- a/make.out +++ b/make.out @@ -1,12 +1,6 @@ make: Warning: Both `makefile' and `Makefile' exists -`sh cflags perl.o` perl.c +`sh cflags gv.o` gv.c CCCMD = cc -c -DDEBUGGING -DHAS_SDBM -g -`sh cflags op.o` op.c - CCCMD = cc -c -DDEBUGGING -DHAS_SDBM -g -`sh cflags mg.o` mg.c - CCCMD = cc -c -DDEBUGGING -DHAS_SDBM -g -`sh cflags toke.o` toke.c - CCCMD = cc -c -DDEBUGGING -DHAS_SDBM -g -cc -Bstatic main.o perly.o perl.o av.o scope.o op.o doop.o doio.o dump.o hv.o malloc.o mg.o pp.o regcomp.o regexec.o gv.o sv.o taint.o toke.o util.o deb.o run.o NDBM_File.o ODBM_File.o SDBM_File.o -ldbm -lm -lposix ext/dbm/sdbm/libsdbm.a -o perl +cc -Bstatic main.o perly.o perl.o av.o scope.o op.o doop.o doio.o dump.o hv.o malloc.o mg.o pp.o regcomp.o regexec.o gv.o sv.o taint.o toke.o util.o deb.o run.o NDBM_File.o ODBM_File.o POSIX.o dl.o -ldbm -lm -lposix -Bdynamic -ldl -Bstatic -o perl echo ""  diff --git a/makefile b/makefile index 0a2e308..c2307b6 100644 --- a/makefile +++ b/makefile @@ -44,7 +44,7 @@ mallocobj = malloc.o SLN = ln -s RMS = rm -f -libs = -ldbm -lm -lposix ext/dbm/sdbm/libsdbm.a +libs = -ldbm -lm -lposix -Bdynamic -ldl public = perl @@ -87,7 +87,7 @@ obj1 = av.o scope.o op.o doop.o doio.o dump.o hv.o obj2 = $(mallocobj) mg.o pp.o regcomp.o regexec.o obj3 = gv.o sv.o taint.o toke.o util.o deb.o run.o -obj = $(obj1) $(obj2) $(obj3) NDBM_File.o ODBM_File.o SDBM_File.o +obj = $(obj1) $(obj2) $(obj3) NDBM_File.o ODBM_File.o POSIX.o dl.o lintflags = -hbvxac @@ -100,7 +100,7 @@ SHELL = /bin/sh $(CCCMD) $*.c -all: perl +all: perl lib/Config.pm #all: $(public) $(private) $(util) $(scripts) # cd x2p; $(MAKE) all @@ -110,7 +110,7 @@ all: perl # and is harmless otherwise. perl: $& main.o perly.o perl.o $(obj) - $(CC) -Bstatic $(LARGE) $(CLDFLAGS) main.o perly.o perl.o $(obj) $(libs) -o perl + $(CC) -Bstatic $(LARGE) $(CLDFLAGS) main.o perly.o perl.o $(obj) $(libs) -Bstatic -o perl echo "" libperl.rlb: libperl.a @@ -128,6 +128,9 @@ libperl.a: $& perly.o perl.o $(obj) suidperl: $& sperl.o main.o libperl.rlb $(CC) $(LARGE) $(CLDFLAGS) sperl.o main.o libperl.a $(libs) -o suidperl +lib/Config.pm: config.sh + ./configpm + saber: $(saber) # load $(saber) # load /lib/libm.a @@ -138,37 +141,61 @@ sperl.o: perl.c perly.h patchlevel.h $(h) $(CCCMD) -DTAINT -DIAMSUID sperl.c $(RMS) sperl.c -ODBM_File.c: ext/dbm/ODBM_File.xs - ext/xsubpp ext/typemap ext/dbm/ODBM_File.xs >tmp - mv tmp ODBM_File.c - -NDBM_File.c: ext/dbm/NDBM_File.xs - ext/xsubpp ext/typemap ext/dbm/NDBM_File.xs >tmp - mv tmp NDBM_File.c +dl.o: ext/dl/dl.c + cp ext/dl/dl.c dl.c + $(CC) -c dl.c -SDBM_File.c: ext/dbm/SDBM_File.xs - ext/xsubpp ext/typemap ext/dbm/SDBM_File.xs > tmp - mv tmp SDBM_File.c +# ODBM_File extension -GDBM_File.c: ext/dbm/GDBM_File.xs - ext/xsubpp ext/typemap ext/dbm/GDBM_File.xs >tmp - mv tmp GDBM_File.c +ODBM_File.c: ext/dbm/ODBM_File.xs ext/xsubpp ext/typemap + ext/xsubpp ext/dbm/ODBM_File.xs >tmp + mv tmp ODBM_File.c ODBM_File.o: ODBM_File.c - $(CCCMD) ODBM_File.c + +# NDBM_File extension + +NDBM_File.c: ext/dbm/NDBM_File.xs ext/xsubpp ext/typemap + ext/xsubpp ext/dbm/NDBM_File.xs >tmp + mv tmp NDBM_File.c NDBM_File.o: NDBM_File.c - $(CCCMD) NDBM_File.c + +# SDBM_File extension + +SDBM_File.c: ext/dbm/SDBM_File.xs ext/xsubpp ext/typemap + ext/xsubpp ext/dbm/SDBM_File.xs > tmp + mv tmp SDBM_File.c SDBM_File.o: SDBM_File.c - $(CCCMD) SDBM_File.c -GDBM_File.o: GDBM_File.c - $(CCCMD) GDBM_File.c +lib/auto/SDBM_File/SDBM_File.so: SDBM_File.o ext/dbm/sdbm/libsdbm.a + @- mkdir lib/auto/SDBM_File 2>/dev/null + ld -o lib/auto/SDBM_File/SDBM_File.so SDBM_File.o ext/dbm/sdbm/libsdbm.a ext/dbm/sdbm/libsdbm.a: ext/dbm/sdbm/sdbm.c ext/dbm/sdbm/sdbm.h cd ext/dbm/sdbm; $(MAKE) sdbm +# GDBM_File extension + +GDBM_File.c: ext/dbm/GDBM_File.xs ext/xsubpp ext/typemap + ext/xsubpp ext/dbm/GDBM_File.xs >tmp + mv tmp GDBM_File.c + +GDBM_File.o: GDBM_File.c + +# POSIX extension + +POSIX.c: ext/posix/POSIX.xs ext/xsubpp ext/typemap + ext/xsubpp ext/posix/POSIX.xs > tmp + mv tmp POSIX.c + +POSIX.o: POSIX.c + +lib/auto/POSIX/POSIX.so: POSIX.o + @- mkdir lib/auto/POSIX 2>/dev/null + ld -o lib/auto/POSIX/POSIX.so POSIX.o ext/dbm/sdbm/libsdbm.a + perly.h: perly.c @ echo Dummy dependency for dumb parallel make touch perly.h @@ -176,7 +203,7 @@ perly.h: perly.c opcode.h: opcode.pl - opcode.pl -embed.h: embed_h.SH global.var interp.var +embed.h: embed_h.SH global.sym interp.sym sh embed_h.SH perly.c: diff --git a/malloc.c b/malloc.c index 3e940f4..41a5d78 100644 --- a/malloc.c +++ b/malloc.c @@ -82,7 +82,6 @@ union overhead { }; #define MAGIC 0xff /* magic # on accounting info */ -#define OLDMAGIC 0x7f /* same after a free() */ #define RMAGIC 0x55555555 /* magic # on range info */ #ifdef RCHECK #define RSLOP sizeof (u_int) @@ -303,16 +302,20 @@ free(mp) ASSERT(op->ov_magic == MAGIC); /* make sure it was in use */ #else if (op->ov_magic != MAGIC) { +#ifdef RCHECK warn("%s free() ignored", - op->ov_magic == OLDMAGIC ? "Duplicate" : "Bad"); + op->ov_rmagic == RMAGIC - 1 ? "Duplicate" : "Bad"); +#else + warn("Bad free() ignored"); +#endif return; /* sanity */ } - op->ov_magic = OLDMAGIC; #endif #ifdef RCHECK ASSERT(op->ov_rmagic == RMAGIC); if (op->ov_index <= 13) ASSERT(*(u_int *)((caddr_t)op + op->ov_size + 1 - RSLOP) == RMAGIC); + op->ov_rmagic = RMAGIC - 1; #endif ASSERT(op->ov_index < NBUCKETS); size = op->ov_index; diff --git a/mg.c b/mg.c index 3196673..f70a41b 100644 --- a/mg.c +++ b/mg.c @@ -11,16 +11,33 @@ #include "EXTERN.h" #include "perl.h" +void +mg_magical(sv) +SV* sv; +{ + MAGIC* mg; + for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) { + MGVTBL* vtbl = mg->mg_virtual; + if (vtbl) { + if (vtbl->svt_get) + SvGMAGICAL_on(sv); + if (vtbl->svt_set) + SvSMAGICAL_on(sv); + if (!(SvFLAGS(sv) & (SVs_GMG|SVs_SMG)) || vtbl->svt_clear) + SvRMAGICAL_on(sv); + } + } +} + int mg_get(sv) SV* sv; { MAGIC* mg; + U32 savemagic = SvMAGICAL(sv); SvMAGICAL_off(sv); - SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK|SVf_POK); - SvFLAGS(sv) |= SvPRIVATE(sv) & (SVf_IOK|SVf_NOK|SVf_POK); - SvPRIVATE(sv) &= ~(SVf_IOK|SVf_NOK|SVf_POK); + SvFLAGS(sv) |= (SvFLAGS(sv) & (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT; for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) { MGVTBL* vtbl = mg->mg_virtual; @@ -28,9 +45,8 @@ SV* sv; (*vtbl->svt_get)(sv, mg); } - SvMAGICAL_on(sv); - SvPRIVATE(sv) &= ~(SVf_IOK|SVf_NOK|SVf_POK); - SvPRIVATE(sv) |= SvFLAGS(sv) & (SVf_IOK|SVf_NOK|SVf_POK); + SvFLAGS(sv) |= savemagic; + assert(SvGMAGICAL(sv)); SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK|SVf_POK); return 0; @@ -42,6 +58,7 @@ SV* sv; { MAGIC* mg; MAGIC* nextmg; + U32 savemagic = SvMAGICAL(sv); SvMAGICAL_off(sv); @@ -53,10 +70,9 @@ SV* sv; } if (SvMAGIC(sv)) { - SvMAGICAL_on(sv); -/* SvPRIVATE(sv) &= ~(SVf_IOK|SVf_NOK|SVf_POK); */ - SvPRIVATE(sv) |= SvFLAGS(sv) & (SVf_IOK|SVf_NOK|SVf_POK); - SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK|SVf_POK); + SvFLAGS(sv) |= savemagic; + if (SvGMAGICAL(sv)) + SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK|SVf_POK); } return 0; @@ -69,11 +85,10 @@ SV* sv; MAGIC* mg; char *s; STRLEN len; + U32 savemagic = SvMAGICAL(sv); SvMAGICAL_off(sv); - SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK|SVf_POK); - SvFLAGS(sv) |= SvPRIVATE(sv) & (SVf_IOK|SVf_NOK|SVf_POK); - SvPRIVATE(sv) &= ~(SVf_IOK|SVf_NOK|SVf_POK); + SvFLAGS(sv) |= (SvFLAGS(sv) & (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT; for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) { MGVTBL* vtbl = mg->mg_virtual; @@ -83,10 +98,9 @@ SV* sv; mg_get(sv); s = SvPV(sv, len); - SvMAGICAL_on(sv); - SvPRIVATE(sv) &= ~(SVf_IOK|SVf_NOK|SVf_POK); - SvPRIVATE(sv) |= SvFLAGS(sv) & (SVf_IOK|SVf_NOK|SVf_POK); - SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK|SVf_POK); + SvFLAGS(sv) |= savemagic; + if (SvGMAGICAL(sv)) + SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK|SVf_POK); return len; } @@ -96,11 +110,10 @@ mg_clear(sv) SV* sv; { MAGIC* mg; + U32 savemagic = SvMAGICAL(sv); SvMAGICAL_off(sv); - SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK|SVf_POK); - SvFLAGS(sv) |= SvPRIVATE(sv) & (SVf_IOK|SVf_NOK|SVf_POK); - SvPRIVATE(sv) &= ~(SVf_IOK|SVf_NOK|SVf_POK); + SvFLAGS(sv) |= (SvFLAGS(sv) & (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT; for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) { MGVTBL* vtbl = mg->mg_virtual; @@ -108,18 +121,21 @@ SV* sv; (*vtbl->svt_clear)(sv, mg); } - SvMAGICAL_on(sv); - SvPRIVATE(sv) &= ~(SVf_IOK|SVf_NOK|SVf_POK); - SvPRIVATE(sv) |= SvFLAGS(sv) & (SVf_IOK|SVf_NOK|SVf_POK); - SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK|SVf_POK); + SvFLAGS(sv) |= savemagic; + if (SvGMAGICAL(sv)) + SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK|SVf_POK); return 0; } MAGIC* +#ifndef STANDARD_C mg_find(sv, type) SV* sv; char type; +#else +mg_find(SV *sv, char type) +#endif /* STANDARD_C */ { MAGIC* mg; for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) { @@ -160,7 +176,8 @@ SV* sv; (*vtbl->svt_free)(sv, mg); if (mg->mg_ptr && mg->mg_type != 'g') Safefree(mg->mg_ptr); - sv_free(mg->mg_obj); + if (mg->mg_obj != sv) + SvREFCNT_dec(mg->mg_obj); Safefree(mg); } SvMAGIC(sv) = 0; @@ -332,7 +349,7 @@ MAGIC *mg; case '.': #ifndef lint if (last_in_gv && GvIO(last_in_gv)) { - sv_setiv(sv,(I32)GvIO(last_in_gv)->lines); + sv_setiv(sv,(I32)IoLINES(GvIO(last_in_gv))); } #endif break; @@ -340,7 +357,7 @@ MAGIC *mg; sv_setiv(sv,(I32)statusvalue); break; case '^': - s = GvIO(defoutgv)->top_name; + s = IoTOP_NAME(GvIO(defoutgv)); if (s) sv_setpv(sv,s); else { @@ -349,20 +366,20 @@ MAGIC *mg; } break; case '~': - s = GvIO(defoutgv)->fmt_name; + s = IoFMT_NAME(GvIO(defoutgv)); if (!s) s = GvENAME(defoutgv); sv_setpv(sv,s); break; #ifndef lint case '=': - sv_setiv(sv,(I32)GvIO(defoutgv)->page_len); + sv_setiv(sv,(I32)IoPAGE_LEN(GvIO(defoutgv))); break; case '-': - sv_setiv(sv,(I32)GvIO(defoutgv)->lines_left); + sv_setiv(sv,(I32)IoLINES_LEFT(GvIO(defoutgv))); break; case '%': - sv_setiv(sv,(I32)GvIO(defoutgv)->page); + sv_setiv(sv,(I32)IoPAGE(GvIO(defoutgv))); break; #endif case ':': @@ -375,7 +392,7 @@ MAGIC *mg; case '|': if (!GvIO(defoutgv)) GvIO(defoutgv) = newIO(); - sv_setiv(sv, (GvIO(defoutgv)->flags & IOf_FLUSH) != 0 ); + sv_setiv(sv, (IoFLAGS(GvIO(defoutgv)) & IOf_FLUSH) != 0 ); break; case ',': sv_setpvn(sv,ofs,ofslen); @@ -448,7 +465,7 @@ MAGIC* mg; { register char *s; I32 i; - s = SvPVX(sv); + s = SvPV(sv,na); my_setenv(mg->mg_ptr,s); /* And you'll never guess what the dog had */ /* in its mouth... */ @@ -461,7 +478,7 @@ MAGIC* mg; s++; if (*tokenbuf != '/' || (stat(tokenbuf,&statbuf) && (statbuf.st_mode & 2)) ) - SvPRIVATE(sv) |= SVp_TAINTEDDIR; + MgTAINTEDDIR_on(mg); } } } @@ -475,7 +492,7 @@ MAGIC* mg; { register char *s; I32 i; - s = SvPVX(sv); + s = SvPV(sv,na); i = whichsig(mg->mg_ptr); /* ...no, a brick */ if (!i && (dowarn || strEQ(mg->mg_ptr,"ALARM"))) warn("No such signal: SIG%s", mg->mg_ptr); @@ -703,7 +720,7 @@ MAGIC* mg; gv = DBline; i = SvTRUE(sv); svp = av_fetch(GvAV(gv),atoi(mg->mg_ptr), FALSE); - if (svp && SvIOK(*svp) && (o = (OP*)SvSTASH(*svp))) + if (svp && SvIOKp(*svp) && (o = (OP*)SvSTASH(*svp))) o->op_private = i; else warn("Can't break at that line\n"); @@ -770,10 +787,9 @@ magic_setsubstr(sv,mg) SV* sv; MAGIC* mg; { - char *tmps = SvPVX(sv); - if (!tmps) - tmps = ""; - sv_insert(LvTARG(sv),LvTARGOFF(sv),LvTARGLEN(sv), tmps,SvCUR(sv)); + STRLEN len; + char *tmps = SvPV(sv,len); + sv_insert(LvTARG(sv),LvTARGOFF(sv),LvTARGLEN(sv), tmps, len); return 0; } @@ -844,9 +860,10 @@ MAGIC* mg; { register char *s; I32 i; + STRLEN len; switch (*mg->mg_ptr) { case '\004': /* ^D */ - debug = (SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)) | 32768; + debug = (SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)) | 0x80000000; DEBUG_x(dump_all()); break; case '\006': /* ^F */ @@ -856,7 +873,7 @@ MAGIC* mg; if (inplace) Safefree(inplace); if (SvOK(sv)) - inplace = savestr(SvPVX(sv)); + inplace = savestr(SvPV(sv,na)); else inplace = Nullch; break; @@ -881,32 +898,32 @@ MAGIC* mg; save_sptr((SV**)&last_in_gv); break; case '^': - Safefree(GvIO(defoutgv)->top_name); - GvIO(defoutgv)->top_name = s = savestr(SvPVX(sv)); - GvIO(defoutgv)->top_gv = gv_fetchpv(s,TRUE); + Safefree(IoTOP_NAME(GvIO(defoutgv))); + IoTOP_NAME(GvIO(defoutgv)) = s = savestr(SvPV(sv,na)); + IoTOP_GV(GvIO(defoutgv)) = gv_fetchpv(s,TRUE); break; case '~': - Safefree(GvIO(defoutgv)->fmt_name); - GvIO(defoutgv)->fmt_name = s = savestr(SvPVX(sv)); - GvIO(defoutgv)->fmt_gv = gv_fetchpv(s,TRUE); + Safefree(IoFMT_NAME(GvIO(defoutgv))); + IoFMT_NAME(GvIO(defoutgv)) = s = savestr(SvPV(sv,na)); + IoFMT_GV(GvIO(defoutgv)) = gv_fetchpv(s,TRUE); break; case '=': - GvIO(defoutgv)->page_len = (long)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)); + IoPAGE_LEN(GvIO(defoutgv)) = (long)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)); break; case '-': - GvIO(defoutgv)->lines_left = (long)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)); - if (GvIO(defoutgv)->lines_left < 0L) - GvIO(defoutgv)->lines_left = 0L; + IoLINES_LEFT(GvIO(defoutgv)) = (long)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)); + if (IoLINES_LEFT(GvIO(defoutgv)) < 0L) + IoLINES_LEFT(GvIO(defoutgv)) = 0L; break; case '%': - GvIO(defoutgv)->page = (long)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)); + IoPAGE(GvIO(defoutgv)) = (long)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)); break; case '|': if (!GvIO(defoutgv)) GvIO(defoutgv) = newIO(); - GvIO(defoutgv)->flags &= ~IOf_FLUSH; + IoFLAGS(GvIO(defoutgv)) &= ~IOf_FLUSH; if ((SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)) != 0) { - GvIO(defoutgv)->flags |= IOf_FLUSH; + IoFLAGS(GvIO(defoutgv)) |= IOf_FLUSH; } break; case '*': @@ -915,8 +932,8 @@ MAGIC* mg; break; case '/': if (SvPOK(sv)) { - nrs = rs = SvPVX(sv); - nrslen = rslen = SvCUR(sv); + nrs = rs = SvPV(sv,rslen); + nrslen = rslen; if (rspara = !rslen) { nrs = rs = "\n\n"; nrslen = rslen = 2; @@ -931,19 +948,17 @@ MAGIC* mg; case '\\': if (ors) Safefree(ors); - ors = savestr(SvPVX(sv)); - orslen = SvCUR(sv); + ors = savestr(SvPV(sv,orslen)); break; case ',': if (ofs) Safefree(ofs); - ofs = savestr(SvPVX(sv)); - ofslen = SvCUR(sv); + ofs = savestr(SvPV(sv, ofslen)); break; case '#': if (ofmt) Safefree(ofmt); - ofmt = savestr(SvPVX(sv)); + ofmt = savestr(SvPV(sv,na)); break; case '[': arybase = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv); @@ -1039,7 +1054,7 @@ MAGIC* mg; tainting |= (euid != uid || egid != gid); break; case ':': - chopset = SvPVX(sv); + chopset = SvPV(sv,na); break; case '0': if (!origalen) { @@ -1059,8 +1074,8 @@ MAGIC* mg; } origalen = s - origargv[0]; } - s = SvPVX(sv); - i = SvCUR(sv); + s = SvPV(sv,len); + i = len; if (i >= origalen) { i = origalen; SvCUR_set(sv, i); @@ -1072,9 +1087,10 @@ MAGIC* mg; s = origargv[0]+i; *s++ = '\0'; while (++i < origalen) - *s++ = '\0'; + *s++ = ' '; + s = origargv[0]+i; for (i = 1; i < origargc; i++) - origargv[i] = NULL; + origargv[i] = Nullch; } break; } @@ -1142,7 +1158,7 @@ I32 sig; oldstack = stack; SWITCHSTACK(stack, signalstack); - sv = sv_mortalcopy(&sv_undef); + sv = sv_newmortal(); sv_setpv(sv,sig_name[sig]); PUSHs(sv); @@ -1155,6 +1171,7 @@ I32 sig; PUSHSUB(cx); cx->blk_sub.savearray = GvAV(defgv); cx->blk_sub.argarray = av_fake(items, sp); + SAVEFREESV(cx->blk_sub.argarray); GvAV(defgv) = cx->blk_sub.argarray; CvDEPTH(cv)++; if (CvDEPTH(cv) >= 2) { diff --git a/mg.h b/mg.h index 1236ea8..c18c426 100644 --- a/mg.h +++ b/mg.h @@ -26,3 +26,7 @@ struct magic { char* mg_ptr; I32 mg_len; }; + +#define MGf_TAINTEDDIR 1 +#define MgTAINTEDDIR(mg) (mg->mg_flags & MGf_TAINTEDDIR) +#define MgTAINTEDDIR_on(mg) (mg->mg_flags |= MGf_TAINTEDDIR) diff --git a/op.c b/op.c index 31b4c7f..7c021cb 100644 --- a/op.c +++ b/op.c @@ -41,7 +41,7 @@ register I32 l; *d = '\0'; } -OP * +static OP * no_fh_allowed(op) OP *op; { @@ -51,7 +51,7 @@ OP *op; return op; } -OP * +static OP * too_few_arguments(op) OP *op; { @@ -60,7 +60,7 @@ OP *op; return op; } -OP * +static OP * too_many_arguments(op) OP *op; { @@ -69,6 +69,19 @@ OP *op; return op; } +static OP * +bad_type(n, t, op, kid) +I32 n; +char *t; +OP *op; +OP *kid; +{ + sprintf(tokenbuf, "Type of arg %d to %s must be %s (not %s)", + n, op_name[op->op_type], t, op_name[kid->op_type]); + yyerror(tokenbuf); + return op; +} + /* "register" allocation */ PADOFFSET @@ -79,9 +92,12 @@ char *name; SV *sv = NEWSV(0,0); sv_upgrade(sv, SVt_PVNV); sv_setpv(sv, name); - av_store(comppadname, off, sv); + av_store(comppad_name, off, sv); SvNVX(sv) = (double)cop_seqmax; - SvIVX(sv) = 99999999; + SvIVX(sv) = 0; /* Not yet introduced--see newSTATEOP */ + if (!min_intro_pending) + min_intro_pending = off; + max_intro_pending = off; if (*name == '@') av_store(comppad, off, (SV*)newAV()); else if (*name == '%') @@ -96,7 +112,7 @@ char *name; { I32 off; SV *sv; - SV **svp = AvARRAY(comppadname); + SV **svp = AvARRAY(comppad_name); register I32 i; register CONTEXT *cx; bool saweval; @@ -105,7 +121,8 @@ char *name; CV *cv; I32 seq = cop_seqmax; - for (off = comppadnamefill; off > 0; off--) { + /* The one we're looking for is probably just before comppad_name_fill. */ + for (off = comppad_name_fill; off > 0; off--) { if ((sv = svp[off]) && seq <= SvIVX(sv) && seq > (I32)SvNVX(sv) && @@ -151,10 +168,10 @@ char *name; SV *sv = NEWSV(0,0); sv_upgrade(sv, SVt_PVNV); sv_setpv(sv, name); - av_store(comppadname, newoff, sv); + av_store(comppad_name, newoff, sv); SvNVX(sv) = (double)curcop->cop_seq; - SvIVX(sv) = 99999999; - av_store(comppad, newoff, sv_ref(oldsv)); + SvIVX(sv) = 999999999; /* A ref, intro immediately */ + av_store(comppad, newoff, SvREFCNT_inc(oldsv)); return newoff; } } @@ -170,9 +187,16 @@ pad_leavemy(fill) I32 fill; { I32 off; - SV **svp = AvARRAY(comppadname); + SV **svp = AvARRAY(comppad_name); SV *sv; - for (off = AvFILL(comppadname); off > fill; off--) { + if (min_intro_pending && fill < min_intro_pending) { + for (off = max_intro_pending; off >= min_intro_pending; off--) { + if (sv = svp[off]) + warn("%s never introduced", SvPVX(sv)); + } + } + /* "Deintroduce" my variables that are leaving with this scope. */ + for (off = AvFILL(comppad_name); off > fill; off--) { if (sv = svp[off]) SvIVX(sv) = cop_seqmax; } @@ -197,18 +221,22 @@ U32 tmptype; else { do { sv = *av_fetch(comppad, ++padix, TRUE); - } while (SvSTORAGE(sv) & (SVs_PADTMP|SVs_PADMY)); + } while (SvFLAGS(sv) & (SVs_PADTMP|SVs_PADMY)); retval = padix; } - SvSTORAGE(sv) |= tmptype; + SvFLAGS(sv) |= tmptype; curpad = AvARRAY(comppad); DEBUG_X(fprintf(stderr, "Pad alloc %d for %s\n", retval, op_name[optype])); return (PADOFFSET)retval; } SV * +#ifndef STANDARD_C pad_sv(po) PADOFFSET po; +#else +pad_sv(PADOFFSET po) +#endif /* STANDARD_C */ { if (!po) croak("panic: pad_sv po"); @@ -217,8 +245,12 @@ PADOFFSET po; } void +#ifndef STANDARD_C pad_free(po) PADOFFSET po; +#else +pad_free(PADOFFSET po) +#endif /* STANDARD_C */ { if (AvARRAY(comppad) != curpad) croak("panic: pad_free curpad"); @@ -232,8 +264,12 @@ PADOFFSET po; } void +#ifndef STANDARD_C pad_swipe(po) PADOFFSET po; +#else +pad_swipe(PADOFFSET po) +#endif /* STANDARD_C */ { if (AvARRAY(comppad) != curpad) croak("panic: pad_swipe curpad"); @@ -277,22 +313,52 @@ OP *op; op_free(kid); } - if (op->op_targ > 0) - pad_free(op->op_targ); switch (op->op_type) { + case OP_NULL: + op->op_targ = 0; /* Was holding old type, if any. */ + break; case OP_GVSV: case OP_GV: - sv_free((SV*)cGVOP->op_gv); + SvREFCNT_dec((SV*)cGVOP->op_gv); + break; + case OP_NEXTSTATE: + case OP_DBSTATE: + SvREFCNT_dec(cCOP->cop_filegv); break; case OP_CONST: - sv_free(cSVOP->op_sv); + SvREFCNT_dec(cSVOP->op_sv); break; } + if (op->op_targ > 0) + pad_free(op->op_targ); + Safefree(op); } +static void +null(op) +OP* op; +{ + if (op->op_type != OP_NULL && op->op_targ > 0) + pad_free(op->op_targ); + op->op_targ = op->op_type; + op->op_type = OP_NULL; + op->op_ppaddr = ppaddr[OP_NULL]; +} + +static void +unlist(op) +OP* op; +{ + OP* kid = cLISTOP->op_first; + assert(kid->op_type == OP_PUSHMARK); + cLISTOP->op_first = kid->op_sibling; + null(kid); + null(op); +} + /* Contextualizers */ #define LINKLIST(o) ((o)->op_next ? (o)->op_next : linklist((OP*)o)) @@ -335,6 +401,16 @@ OP *op; } OP * +scalarboolean(op) +OP *op; +{ + if (dowarn && + op->op_type == OP_SASSIGN && cBINOP->op_first->op_type == OP_CONST) + warn("Found = in conditional, should be =="); + return scalar(op); +} + +OP * scalar(op) OP *op; { @@ -349,22 +425,27 @@ OP *op; switch (op->op_type) { case OP_REPEAT: scalar(cBINOP->op_first); - return op; + break; case OP_OR: case OP_AND: case OP_COND_EXPR: + for (kid = cUNOP->op_first->op_sibling; kid; kid = kid->op_sibling) + scalar(kid); break; - default: case OP_MATCH: case OP_SUBST: case OP_NULL: - if (!(op->op_flags & OPf_KIDS)) - return op; + default: + if (op->op_flags & OPf_KIDS) { + for (kid = cUNOP->op_first; kid; kid = kid->op_sibling) + scalar(kid); + } break; case OP_SCOPE: case OP_LEAVE: case OP_LEAVETRY: case OP_LINESEQ: + case OP_LIST: for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling) { if (kid->op_sibling) scalarvoid(kid); @@ -372,13 +453,8 @@ OP *op; scalar(kid); } curcop = &compiling; - return op; - case OP_LIST: - op = prepend_elem(OP_LIST, newOP(OP_PUSHMARK, 0), op); break; } - for (kid = cUNOP->op_first->op_sibling; kid; kid = kid->op_sibling) - scalar(kid); return op; } @@ -387,6 +463,8 @@ scalarvoid(op) OP *op; { OP *kid; + char* useless = 0; + SV* sv; if (!op) return op; @@ -397,33 +475,129 @@ OP *op; switch (op->op_type) { default: - if (dowarn && (opargs[op->op_type] & OA_FOLDCONST) && - !(op->op_flags & OPf_STACKED)) - warn("Useless use of %s", op_name[op->op_type]); - return op; + if (!(opargs[op->op_type] & OA_FOLDCONST)) + break; + if (op->op_flags & OPf_STACKED) + break; + /* FALL THROUGH */ + case OP_GVSV: + case OP_WANTARRAY: + case OP_GV: + case OP_PADSV: + case OP_PADAV: + case OP_PADHV: + case OP_PADANY: + case OP_AV2ARYLEN: + case OP_SV2LEN: + case OP_REF: + case OP_DEFINED: + case OP_HEX: + case OP_OCT: + case OP_LENGTH: + case OP_SUBSTR: + case OP_VEC: + case OP_INDEX: + case OP_RINDEX: + case OP_SPRINTF: + case OP_AELEM: + case OP_AELEMFAST: + case OP_ASLICE: + case OP_VALUES: + case OP_KEYS: + case OP_HELEM: + case OP_HSLICE: + case OP_UNPACK: + case OP_PACK: + case OP_SPLIT: + case OP_JOIN: + case OP_LSLICE: + case OP_ANONLIST: + case OP_ANONHASH: + case OP_SORT: + case OP_REVERSE: + case OP_RANGE: + case OP_FLIP: + case OP_FLOP: + case OP_CALLER: + case OP_FILENO: + case OP_EOF: + case OP_TELL: + case OP_GETSOCKNAME: + case OP_GETPEERNAME: + case OP_READLINK: + case OP_TELLDIR: + case OP_GETPPID: + case OP_GETPGRP: + case OP_GETPRIORITY: + case OP_TIME: + case OP_TMS: + case OP_LOCALTIME: + case OP_GMTIME: + case OP_GHBYNAME: + case OP_GHBYADDR: + case OP_GHOSTENT: + case OP_GNBYNAME: + case OP_GNBYADDR: + case OP_GNETENT: + case OP_GPBYNAME: + case OP_GPBYNUMBER: + case OP_GPROTOENT: + case OP_GSBYNAME: + case OP_GSBYPORT: + case OP_GSERVENT: + case OP_GPWNAM: + case OP_GPWUID: + case OP_GGRNAM: + case OP_GGRGID: + case OP_GETLOGIN: + if (!(op->op_flags & OPf_INTRO)) + useless = op_name[op->op_type]; + break; + + case OP_RV2GV: + case OP_RV2SV: + case OP_RV2AV: + case OP_RV2HV: + if (!(op->op_flags & OPf_INTRO)) + useless = "a variable"; + break; case OP_NEXTSTATE: + case OP_DBSTATE: curcop = ((COP*)op); /* for warning above */ break; case OP_CONST: - op->op_type = OP_NULL; /* don't execute a constant */ - sv_free(cSVOP->op_sv); /* don't even remember it */ + sv = cSVOP->op_sv; + if (dowarn) { + useless = "a constant"; + if (SvNIOK(sv) && (SvNV(sv) == 0.0 || SvNV(sv) == 1.0)) + useless = 0; + else if (SvPOK(sv)) { + if (strnEQ(SvPVX(sv), "di", 2) || + strnEQ(SvPVX(sv), "ig", 2)) + useless = 0; + } + } + null(op); /* don't execute a constant */ + SvREFCNT_dec(sv); /* don't even remember it */ break; case OP_POSTINC: - op->op_type = OP_PREINC; + op->op_type = OP_PREINC; /* pre-increment is faster */ op->op_ppaddr = ppaddr[OP_PREINC]; break; case OP_POSTDEC: - op->op_type = OP_PREDEC; + op->op_type = OP_PREDEC; /* pre-decrement is faster */ op->op_ppaddr = ppaddr[OP_PREDEC]; break; case OP_REPEAT: scalarvoid(cBINOP->op_first); + useless = op_name[op->op_type]; break; + case OP_OR: case OP_AND: case OP_COND_EXPR: @@ -440,15 +614,13 @@ OP *op; case OP_LEAVE: case OP_LEAVETRY: case OP_LINESEQ: - for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling) - scalarvoid(kid); - break; case OP_LIST: - op = prepend_elem(OP_LIST, newOP(OP_PUSHMARK, 0), op); for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling) scalarvoid(kid); break; } + if (useless && dowarn) + warn("Useless use of %s in void context", useless); return op; } @@ -515,26 +687,11 @@ OP *op; return op; } -static OP * -guess_mark(op) -OP *op; -{ - if (op->op_type == OP_LIST && - (!cLISTOP->op_first || - cLISTOP->op_first->op_type != OP_PUSHMARK)) - { - op = prepend_elem(OP_LIST, newOP(OP_PUSHMARK, 0), op); - op->op_private |= OPpLIST_GUESSED; - } - return op; -} - OP * scalarseq(op) OP *op; { OP *kid; - OP **prev; if (op) { if (op->op_type == OP_LINESEQ || @@ -542,14 +699,10 @@ OP *op; op->op_type == OP_LEAVE || op->op_type == OP_LEAVETRY) { - prev = &cLISTOP->op_first; for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling) { if (kid->op_sibling) { scalarvoid(kid); - prev = &kid->op_sibling; } - else - *prev = guess_mark(kid); } curcop = &compiling; } @@ -557,6 +710,8 @@ OP *op; if (needblockscope) op->op_flags |= OPf_PARENS; } + else + op = newOP(OP_STUB, 0); return op; } @@ -588,20 +743,15 @@ I32 type; switch (op->op_type) { case OP_ENTERSUBR: - if ((type == OP_DEFINED || type == OP_UNDEF || type == OP_REFGEN) && - !(op->op_flags & OPf_STACKED)) { + if ((type == OP_UNDEF) && !(op->op_flags & OPf_STACKED)) { op->op_type = OP_RV2CV; /* entersubr => rv2cv */ op->op_ppaddr = ppaddr[OP_RV2CV]; - cUNOP->op_first->op_type = OP_NULL; /* disable pushmark */ - cUNOP->op_first->op_ppaddr = ppaddr[OP_NULL]; + null(cUNOP->op_first); /* disable pushmark */ break; } /* FALL THROUGH */ default: - if (type == OP_DEFINED) - return scalar(op); /* ordinary expression, not lvalue */ - sprintf(tokenbuf, "Can't %s %s in %s", - type == OP_REFGEN ? "refer to" : "modify", + sprintf(tokenbuf, "Can't modify %s in %s", op_name[op->op_type], type ? op_name[type] : "local"); yyerror(tokenbuf); @@ -627,6 +777,7 @@ I32 type; case OP_RV2SV: if (type == OP_RV2AV || type == OP_RV2HV) op->op_private = type; + ref(cUNOP->op_first, op->op_type); /* FALL THROUGH */ case OP_PADSV: case OP_PADAV: @@ -635,9 +786,11 @@ I32 type; case OP_GV: case OP_AV2ARYLEN: case OP_SASSIGN: + case OP_AELEMFAST: + modcount++; + break; + case OP_REFGEN: - case OP_ANONLIST: - case OP_ANONHASH: modcount++; break; @@ -646,6 +799,7 @@ I32 type; case OP_SUBSTR: case OP_VEC: + pad_free(op->op_targ); op->op_targ = pad_alloc(op->op_type, SVs_PADMY); sv = PAD_SV(op->op_targ); sv_upgrade(sv, SVt_PVLV); @@ -653,13 +807,12 @@ I32 type; curpad[op->op_targ] = sv; /* FALL THROUGH */ case OP_NULL: - if (!(op->op_flags & OPf_KIDS)) - croak("panic: mod"); - mod(cBINOP->op_first, type ? type : op->op_type); + if (op->op_flags & OPf_KIDS) + mod(cBINOP->op_first, type); break; case OP_AELEM: case OP_HELEM: - mod(cBINOP->op_first, type ? type : op->op_type); + ref(cBINOP->op_first, op->op_type); if (type == OP_RV2AV || type == OP_RV2HV) op->op_private = type; break; @@ -667,11 +820,11 @@ I32 type; case OP_SCOPE: case OP_LEAVE: case OP_ENTER: - if (type != OP_RV2HV && type != OP_RV2AV) - break; if (!(op->op_flags & OPf_KIDS)) break; - /* FALL THROUGH */ + mod(cLISTOP->op_last, type); + break; + case OP_LIST: for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling) mod(kid, type); @@ -712,90 +865,64 @@ I32 type; return op; switch (op->op_type) { - default: - sprintf(tokenbuf, "Can't use %s as reference in %s", - op_name[op->op_type], - type ? op_name[type] : "local"); - yyerror(tokenbuf); - return op; - + case OP_ENTERSUBR: + if ((type == OP_REFGEN || type == OP_DEFINED) + && !(op->op_flags & (OPf_STACKED|OPf_PARENS))) { + op->op_type = OP_RV2CV; /* entersubr => rv2cv */ + op->op_ppaddr = ppaddr[OP_RV2CV]; + null(cUNOP->op_first); + } + break; + case OP_COND_EXPR: for (kid = cUNOP->op_first->op_sibling; kid; kid = kid->op_sibling) ref(kid, type); break; - + case OP_RV2SV: + if (type == OP_RV2AV || type == OP_RV2HV) + op->op_private = type; + ref(cUNOP->op_first, op->op_type); + break; + case OP_RV2AV: case OP_RV2HV: + op->op_flags |= OPf_LVAL; + /* FALL THROUGH */ case OP_RV2GV: ref(cUNOP->op_first, op->op_type); - /* FALL THROUGH */ - case OP_AASSIGN: - case OP_ASLICE: - case OP_HSLICE: - case OP_NEXTSTATE: - case OP_DBSTATE: - case OP_ENTERSUBR: break; - case OP_RV2SV: - if (type == OP_RV2AV || type == OP_RV2HV) - op->op_private = type; - /* FALL THROUGH */ - case OP_PADSV: + case OP_PADAV: case OP_PADHV: - case OP_UNDEF: - case OP_GV: - case OP_AV2ARYLEN: - case OP_SASSIGN: - case OP_REFGEN: - case OP_ANONLIST: - case OP_ANONHASH: + op->op_flags |= OPf_LVAL; break; - - case OP_PUSHMARK: - break; - - case OP_SUBSTR: - case OP_VEC: - op->op_targ = pad_alloc(op->op_type, SVs_PADMY); - sv = PAD_SV(op->op_targ); - sv_upgrade(sv, SVt_PVLV); - sv_magic(sv, 0, op->op_type == OP_VEC ? 'v' : 'x', 0, 0); - curpad[op->op_targ] = sv; - /* FALL THROUGH */ + + case OP_SCALAR: case OP_NULL: if (!(op->op_flags & OPf_KIDS)) break; - ref(cBINOP->op_first, type ? type : op->op_type); + ref(cBINOP->op_first, type); break; case OP_AELEM: case OP_HELEM: - ref(cBINOP->op_first, type ? type : op->op_type); - if (type == OP_RV2AV || type == OP_RV2HV) + ref(cBINOP->op_first, op->op_type); + if (type == OP_RV2AV || type == OP_RV2HV || type == OP_REFGEN) { op->op_private = type; + op->op_flags |= OPf_LVAL; + } break; case OP_SCOPE: case OP_LEAVE: case OP_ENTER: - if (type != OP_RV2HV && type != OP_RV2AV) - break; + case OP_LIST: if (!(op->op_flags & OPf_KIDS)) break; - /* FALL THROUGH */ - case OP_LIST: - for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling) - ref(kid, type); + ref(cLISTOP->op_last, type); break; } - op->op_flags |= OPf_LVAL; - if (!type) { - op->op_flags &= ~OPf_SPECIAL; - op->op_flags |= OPf_INTRO; - } - else if (type == OP_AASSIGN || type == OP_SASSIGN) - op->op_flags |= OPf_SPECIAL; - return op; + return scalar(op); + } OP * @@ -889,10 +1016,8 @@ OP *o; o->op_type = OP_SCOPE; o->op_ppaddr = ppaddr[OP_SCOPE]; kid = ((LISTOP*)o)->op_first; - if (kid->op_type == OP_NEXTSTATE) { - kid->op_type = OP_NULL; - kid->op_ppaddr = ppaddr[OP_NULL]; - } + if (kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE) + null(kid); } else o = newUNOP(OP_SCOPE, 0, o); @@ -910,7 +1035,8 @@ OP **startp; *startp = 0; return o; } - o = scope(scalarseq(o)); + o = scope(sawparens(scalarvoid(o))); + curcop = &compiling; *startp = LINKLIST(o); o->op_next = 0; peep(*startp); @@ -924,8 +1050,15 @@ I32 lex; { if (o->op_flags & OPf_PARENS) list(o); - else + else { scalar(o); + if (dowarn && bufptr > oldbufptr && bufptr[-1] == ',') { + char *s; + for (s = bufptr; *s && (isALNUM(*s) || strchr("@$%, ",*s)); s++) ; + if (*s == ';' || *s == '=' && (s[1] == '@' || s[2] == '@')) + warn("Parens missing around \"%s\" list", lex ? "my" : "local"); + } + } in_my = FALSE; if (lex) return my(o); @@ -1050,12 +1183,12 @@ OP* op; OP *kid; OP *last; - if (opargs[type] & OA_MARK) - op = prepend_elem(OP_LIST, newOP(OP_PUSHMARK, 0), op); - if (!op || op->op_type != OP_LIST) op = newLISTOP(OP_LIST, 0, op, Nullop); + if (!(opargs[type] & OA_MARK)) + null(cLISTOP->op_first); + op->op_type = type; op->op_ppaddr = ppaddr[type]; op->op_flags |= flags; @@ -1084,9 +1217,11 @@ OP* last; { if (!first) return last; - else if (!last) + + if (!last) return first; - else if (first->op_type == type) { + + if (first->op_type == type) { if (first->op_flags & OPf_KIDS) ((LISTOP*)first)->op_last->op_sibling = last; else { @@ -1109,11 +1244,14 @@ LISTOP* last; { if (!first) return (OP*)last; - else if (!last) + + if (!last) return (OP*)first; - else if (first->op_type != type) + + if (first->op_type != type) return prepend_elem(type, (OP*)first, (OP*)last); - else if (last->op_type != type) + + if (last->op_type != type) return append_elem(type, (OP*)first, (OP*)last); first->op_last->op_sibling = last->op_first; @@ -1134,15 +1272,23 @@ OP* last; { if (!first) return last; - else if (!last) + + if (!last) return first; - else if (last->op_type == type) { - if (!(last->op_flags & OPf_KIDS)) { - ((LISTOP*)last)->op_last = first; - last->op_flags |= OPf_KIDS; + + if (last->op_type == type) { + if (type == OP_LIST) { /* already a PUSHMARK there */ + first->op_sibling = ((LISTOP*)last)->op_first->op_sibling; + ((LISTOP*)last)->op_first->op_sibling = first; + } + else { + if (!(last->op_flags & OPf_KIDS)) { + ((LISTOP*)last)->op_last = first; + last->op_flags |= OPf_KIDS; + } + first->op_sibling = ((LISTOP*)last)->op_first; + ((LISTOP*)last)->op_first = first; } - first->op_sibling = ((LISTOP*)last)->op_first; - ((LISTOP*)last)->op_first = first; ((LISTOP*)last)->op_children++; return last; } @@ -1155,7 +1301,17 @@ OP* last; OP * newNULLLIST() { - return Nullop; + return newOP(OP_STUB, 0); +} + +OP * +force_list(op) +OP* op; +{ + if (!op || op->op_type != OP_LIST) + op = newLISTOP(OP_LIST, 0, op, Nullop); + null(op); + return op; } OP * @@ -1173,17 +1329,26 @@ OP* last; listop->op_ppaddr = ppaddr[type]; listop->op_children = (first != 0) + (last != 0); listop->op_flags = flags; - if (listop->op_children) - listop->op_flags |= OPf_KIDS; if (!last && first) last = first; else if (!first && last) first = last; + else if (first) + first->op_sibling = last; listop->op_first = first; listop->op_last = last; - if (first && first != last) - first->op_sibling = last; + if (type == OP_LIST) { + OP* pushop; + pushop = newOP(OP_PUSHMARK, 0); + pushop->op_sibling = first; + listop->op_first = pushop; + listop->op_flags |= OPf_KIDS; + if (!last) + listop->op_last = pushop; + } + else if (listop->op_children) + listop->op_flags |= OPf_KIDS; return (OP*)listop; } @@ -1216,15 +1381,12 @@ OP* first; { UNOP *unop; - if (opargs[type] & OA_MARK) { - if (first->op_type == OP_LIST) - prepend_elem(OP_LIST, newOP(OP_PUSHMARK, 0), first); - else - return newBINOP(type, flags, newOP(OP_PUSHMARK, 0), first); - } - if (!first) first = newOP(OP_STUB, 0); + if (opargs[type] & OA_MARK) + first = force_list(first); + else if (first->op_type == OP_LIST) + unlist(first); Newz(1101, unop, 1, UNOP); unop->op_type = type; @@ -1508,7 +1670,7 @@ GV *gv; Newz(1101, gvop, 1, GVOP); gvop->op_type = type; gvop->op_ppaddr = ppaddr[type]; - gvop->op_gv = (GV*)sv_ref(gv); + gvop->op_gv = (GV*)SvREFCNT_inc(gv); gvop->op_next = (OP*)gvop; gvop->op_flags = flags; if (opargs[type] & OA_RETSCALAR) @@ -1582,7 +1744,7 @@ OP *op; curstash = Nullhv; } copline = NOLINE; - expect = XBLOCK; + expect = XSTATE; } HV* @@ -1613,8 +1775,8 @@ OP *subscript; OP *listval; { return newBINOP(OP_LSLICE, flags, - list(prepend_elem(OP_LIST, newOP(OP_PUSHMARK, 0), subscript)), - list(prepend_elem(OP_LIST, newOP(OP_PUSHMARK, 0), listval)) ); + list(force_list(subscript)), + list(force_list(listval)) ); } static I32 @@ -1685,8 +1847,8 @@ OP *right; } } op = newBINOP(OP_AASSIGN, flags, - list(prepend_elem(OP_LIST, newOP(OP_PUSHMARK, 0), right)), - list(prepend_elem(OP_LIST, newOP(OP_PUSHMARK, 0), left)) ); + list(force_list(right)), + list(force_list(left)) ); op->op_private = 0; if (!(left->op_flags & OPf_INTRO)) { static int generation = 0; @@ -1718,7 +1880,6 @@ OP *right; if (curop != op) op->op_private = OPpASSIGN_COMMON; } - op->op_targ = pad_alloc(OP_AASSIGN, SVs_PADTMP); /* for scalar context */ return op; } if (!right) @@ -1741,11 +1902,28 @@ OP *op; { register COP *cop; - comppadnamefill = AvFILL(comppadname); /* introduce my variables */ + /* Introduce my variables. */ + if (min_intro_pending) { + SV **svp = AvARRAY(comppad_name); + I32 i; + SV *sv; + for (i = min_intro_pending; i <= max_intro_pending; i++) { + if (sv = svp[i]) + SvIVX(sv) = 999999999; /* Don't know scope end yet. */ + } + min_intro_pending = 0; + comppad_name_fill = max_intro_pending; /* Needn't search higher */ + } Newz(1101, cop, 1, COP); - cop->op_type = OP_NEXTSTATE; - cop->op_ppaddr = ppaddr[ perldb ? OP_DBSTATE : OP_NEXTSTATE ]; + if (perldb && curcop->cop_line && curstash != debstash) { + cop->op_type = OP_DBSTATE; + cop->op_ppaddr = ppaddr[ OP_DBSTATE ]; + } + else { + cop->op_type = OP_NEXTSTATE; + cop->op_ppaddr = ppaddr[ OP_NEXTSTATE ]; + } cop->op_flags = flags; cop->op_private = 0; cop->op_next = (OP*)cop; @@ -1762,10 +1940,10 @@ OP *op; cop->cop_line = copline; copline = NOLINE; } - cop->cop_filegv = curcop->cop_filegv; + cop->cop_filegv = SvREFCNT_inc(curcop->cop_filegv); cop->cop_stash = curstash; - if (perldb) { + if (perldb && curstash != debstash) { SV **svp = av_fetch(GvAV(curcop->cop_filegv),(I32)cop->cop_line, FALSE); if (svp && *svp != &sv_undef && !SvIOK(*svp)) { SvIVX(*svp) = 1; @@ -1787,7 +1965,7 @@ OP* other; LOGOP *logop; OP *op; - scalar(first); + scalarboolean(first); /* optimize "!a && b" to "a || b", and "!a || b" to "a && b" */ if (first->op_type == OP_NOT && (first->op_flags & OPf_SPECIAL)) { if (type == OP_AND || type == OP_OR) { @@ -1860,7 +2038,7 @@ OP* false; if (!true) return newLOGOP(OP_OR, 0, first, false); - scalar(first); + scalarboolean(first); if (first->op_type == OP_CONST) { if (SvTRUE(((SVOP*)first)->op_sv)) { op_free(first); @@ -1967,7 +2145,7 @@ OP *block; expr = newASSIGNOP(0, newSVREF(newGVOP(OP_GV, 0, defgv)), expr); } - listop = append_elem(OP_LINESEQ, guess_mark(block), newOP(OP_UNSTACK, 0)); + listop = append_elem(OP_LINESEQ, block, newOP(OP_UNSTACK, 0)); op = newLOGOP(OP_AND, 0, expr, listop); ((LISTOP*)listop)->op_last->op_next = LINKLIST(op); @@ -2046,6 +2224,7 @@ OP *cont; } OP * +#ifndef STANDARD_C newFOROP(flags,label,forline,sv,expr,block,cont) I32 flags; char *label; @@ -2054,6 +2233,9 @@ OP* sv; OP* expr; OP*block; OP*cont; +#else +newFOROP(I32 flags,char *label,line_t forline,OP *sv,OP *expr,OP *block,OP *cont) +#endif /* STANDARD_C */ { LOOP *loop; @@ -2073,18 +2255,45 @@ OP*cont; sv = newGVOP(OP_GV, 0, defgv); } loop = (LOOP*)list(convert(OP_ENTERITER, 0, - append_elem(OP_LIST, - prepend_elem(OP_LIST, newOP(OP_PUSHMARK, 0), expr), - scalar(sv)))); + append_elem(OP_LIST, force_list(expr), scalar(sv)))); return newSTATEOP(0, label, newWHILEOP(flags, 1, loop, newOP(OP_ITER, 0), block, cont)); } +OP* +newLOOPEX(type, label) +I32 type; +OP* label; +{ + OP *op; + if (type != OP_GOTO || label->op_type == OP_CONST) { + op = newPVOP(type, 0, savestr(SvPVx(((SVOP*)label)->op_sv, na))); + op_free(label); + } + else { + if (label->op_type == OP_ENTERSUBR) + label = newUNOP(OP_REFGEN, 0, ref(label, OP_REFGEN)); + op = newUNOP(type, OPf_STACKED, label); + } + needblockscope = TRUE; + return op; +} + void cv_clear(cv) CV *cv; { if (!CvUSERSUB(cv) && CvROOT(cv)) { + ENTER; + if (CvPADLIST(cv)) { + SV** svp = av_fetch(CvPADLIST(cv), 0, FALSE); + if (svp) { + SAVESPTR(comppad); + SAVESPTR(curpad); + comppad = (AV*)*svp; /* Need same context we had compiling */ + curpad = AvARRAY(comppad); + } + } op_free(CvROOT(cv)); CvROOT(cv) = Nullop; if (CvDEPTH(cv)) @@ -2098,6 +2307,8 @@ CV *cv; } av_free((AV*)CvPADLIST(cv)); } + SvREFCNT_dec(CvGV(cv)); + LEAVE; } } @@ -2111,6 +2322,7 @@ OP *block; char *name = SvPVx(cSVOP->op_sv, na); GV *gv = gv_fetchpv(name,2); AV* av; + char *s; sub_generation++; if ((cv = GvCV(gv)) && !GvCVGEN(gv)) { @@ -2124,7 +2336,7 @@ OP *block; warn("Subroutine %s redefined",name); curcop->cop_line = oldline; } - sv_free((SV*)cv); + SvREFCNT_dec(cv); } } Newz(101,cv,1,CV); @@ -2133,62 +2345,74 @@ OP *block; GvCV(gv) = cv; GvCVGEN(gv) = 0; CvFILEGV(cv) = curcop->cop_filegv; + CvGV(cv) = SvREFCNT_inc(gv); + CvSTASH(cv) = curstash; + + av = newAV(); + av_store(av, 0, Nullsv); + av_store(comppad, 0, (SV*)av); + SvOK_on(av); + AvREAL_off(av); av = newAV(); AvREAL_off(av); - if (AvFILL(comppadname) < AvFILL(comppad)) - av_store(comppadname, AvFILL(comppad), Nullsv); - av_store(av, 0, (SV*)comppadname); + if (AvFILL(comppad_name) < AvFILL(comppad)) + av_store(comppad_name, AvFILL(comppad), Nullsv); + av_store(av, 0, (SV*)comppad_name); av_store(av, 1, (SV*)comppad); AvFILL(av) = 1; CvPADLIST(cv) = av; - comppadname = newAV(); + comppad_name = newAV(); if (!block) { CvROOT(cv) = 0; op_free(op); copline = NOLINE; - leave_scope(floor); + LEAVE_SCOPE(floor); return; } CvROOT(cv) = newUNOP(OP_LEAVESUBR, 0, scalarseq(block)); CvSTART(cv) = LINKLIST(CvROOT(cv)); CvROOT(cv)->op_next = 0; - CvSTASH(cv) = curstash; peep(CvSTART(cv)); CvDELETED(cv) = FALSE; - if (strEQ(name, "BEGIN")) { - line_t oldline = curcop->cop_line; - GV* oldfile = curcop->cop_filegv; + if (s = strrchr(name,':')) + s++; + else + s = name; + if (strEQ(s, "BEGIN")) { + line_t oldline = compiling.cop_line; + ENTER; + SAVESPTR(compiling.cop_filegv); + SAVEI32(perldb); if (!beginav) beginav = newAV(); - av_push(beginav, sv_ref(gv)); + av_push(beginav, cv); DEBUG_x( dump_sub(gv) ); rs = nrs; rslen = nrslen; rschar = nrschar; rspara = (nrslen == 2); + GvCV(gv) = 0; calllist(beginav); - sv_free((SV*)cv); rs = "\n"; rslen = 1; rschar = '\n'; rspara = 0; - GvCV(gv) = 0; curcop = &compiling; - curcop->cop_line = oldline; /* might have compiled something */ - curcop->cop_filegv = oldfile; /* recursively, clobbering these */ + curcop->cop_line = oldline; /* might have recursed to yylex */ + LEAVE; } - else if (strEQ(name, "END")) { + else if (strEQ(s, "END")) { if (!endav) endav = newAV(); av_unshift(endav, 1); - av_store(endav, 0, sv_ref(gv)); + av_store(endav, 0, SvREFCNT_inc(cv)); } - if (perldb) { + if (perldb && curstash != debstash) { SV *sv; - SV *tmpstr = sv_mortalcopy(&sv_undef); + SV *tmpstr = sv_newmortal(); sprintf(buf,"%s:%ld",SvPVX(GvSV(curcop->cop_filegv)), subline); sv = newSVpv(buf,0); @@ -2200,7 +2424,7 @@ OP *block; } op_free(op); copline = NOLINE; - leave_scope(floor); + LEAVE_SCOPE(floor); } void @@ -2212,6 +2436,7 @@ char *filename; { register CV *cv; GV *gv = gv_fetchpv(name,2); + char *s; sub_generation++; if ((cv = GvCV(gv)) && !GvCVGEN(gv)) { @@ -2227,21 +2452,26 @@ char *filename; sv_upgrade(cv, SVt_PVCV); SvREFCNT(cv) = 1; GvCV(gv) = cv; + CvGV(cv) = SvREFCNT_inc(gv); GvCVGEN(gv) = 0; CvFILEGV(cv) = gv_fetchfile(filename); CvUSERSUB(cv) = subaddr; CvUSERINDEX(cv) = ix; CvDELETED(cv) = FALSE; - if (strEQ(name, "BEGIN")) { + if (s = strrchr(name,':')) + s++; + else + s = name; + if (strEQ(s, "BEGIN")) { if (!beginav) beginav = newAV(); - av_push(beginav, sv_ref(gv)); + av_push(beginav, SvREFCNT_inc(gv)); } - else if (strEQ(name, "END")) { + else if (strEQ(s, "END")) { if (!endav) endav = newAV(); av_unshift(endav, 1); - av_store(endav, 0, sv_ref(gv)); + av_store(endav, 0, SvREFCNT_inc(gv)); } } @@ -2269,12 +2499,13 @@ OP *block; warn("Format %s redefined",name); curcop->cop_line = oldline; } - sv_free((SV*)cv); + SvREFCNT_dec(cv); } Newz(101,cv,1,CV); sv_upgrade(cv, SVt_PVFM); SvREFCNT(cv) = 1; GvFORM(gv) = cv; + CvGV(cv) = SvREFCNT_inc(gv); CvFILEGV(cv) = curcop->cop_filegv; CvPADLIST(cv) = av = newAV(); @@ -2290,7 +2521,7 @@ OP *block; FmLINES(cv) = 0; op_free(op); copline = NOLINE; - leave_scope(floor); + LEAVE_SCOPE(floor); } OP * @@ -2309,7 +2540,7 @@ OP *name; mop->op_targ = pad_alloc(OP_METHOD, SVs_PADTMP); mop->op_next = LINKLIST(ref); ref->op_next = (OP*)mop; - return (OP*)mop; + return scalar((OP*)mop); } OP * @@ -2438,14 +2669,6 @@ OP *o; /* Check routines. */ OP * -ck_aelem(op) -OP *op; -{ - /* XXX need to optimize constant subscript here. */ - return op; -} - -OP * ck_concat(op) OP *op; { @@ -2480,12 +2703,13 @@ OP *op; { I32 type = op->op_type; - if (op->op_flags & OPf_KIDS) + if (op->op_flags & OPf_KIDS) { + if (cLISTOP->op_first->op_type == OP_STUB) { + op_free(op); + op = newUNOP(type, OPf_SPECIAL, + newGVOP(OP_GV, 0, gv_fetchpv("main'ARGV", TRUE))); + } return ck_fun(op); - - if (op->op_flags & OPf_SPECIAL) { - op_free(op); - op = newUNOP(type, 0, newGVOP(OP_GV, 0, gv_fetchpv("main'ARGV", TRUE))); } return op; } @@ -2500,8 +2724,7 @@ OP *op; if (!kid) { op->op_flags &= ~OPf_KIDS; - op->op_type = OP_NULL; - op->op_ppaddr = ppaddr[OP_NULL]; + null(op); } else if (kid->op_type == OP_LINESEQ) { LOGOP *enter; @@ -2540,10 +2763,8 @@ OP *op; if (op->op_flags & OPf_STACKED) { op = ck_fun(op); kid = cUNOP->op_first->op_sibling; - if (kid->op_type == OP_RV2GV) { - kid->op_type = OP_NULL; - kid->op_ppaddr = ppaddr[OP_NULL]; - } + if (kid->op_type == OP_RV2GV) + null(kid); } else op = listkids(op); @@ -2567,7 +2788,7 @@ register OP *op; SVOP *kid = (SVOP*)cUNOP->op_first; if (kid->op_type == OP_CONST) { kid->op_type = OP_GV; - kid->op_sv = sv_ref((SV*)gv_fetchpv(SvPVx(kid->op_sv, na), + kid->op_sv = SvREFCNT_inc(gv_fetchpv(SvPVx(kid->op_sv, na), 1+(op->op_type==OP_RV2CV))); } return op; @@ -2629,7 +2850,9 @@ OP *op; if (op->op_flags & OPf_KIDS) { tokid = &cLISTOP->op_first; kid = cLISTOP->op_first; - if (kid->op_type == OP_PUSHMARK) { + if (kid->op_type == OP_PUSHMARK || + kid->op_type == OP_NULL && kid->op_targ == OP_PUSHMARK) + { tokid = &kid->op_sibling; kid = kid->op_sibling; } @@ -2663,6 +2886,8 @@ OP *op; kid->op_sibling = sibl; *tokid = kid; } + else if (kid->op_type != OP_RV2AV && kid->op_type != OP_PADAV) + bad_type(numargs, "array", op, kid); mod(kid, op->op_type); break; case OA_HVREF: @@ -2679,6 +2904,8 @@ OP *op; kid->op_sibling = sibl; *tokid = kid; } + else if (kid->op_type != OP_RV2HV && kid->op_type != OP_PADHV) + bad_type(numargs, "hash", op, kid); mod(kid, op->op_type); break; case OA_CVREF: @@ -2803,6 +3030,13 @@ OP *op; } OP * +ck_rfun(op) +OP *op; +{ + return refkids(ck_fun(op), op->op_type); +} + +OP * ck_listiob(op) OP *op; { @@ -2810,7 +3044,7 @@ OP *op; kid = cLISTOP->op_first; if (!kid) { - prepend_elem(op->op_type, newOP(OP_PUSHMARK, 0), op); + op = force_list(op); kid = cLISTOP->op_first; } if (kid->op_type == OP_PUSHMARK) @@ -2854,8 +3088,7 @@ OP *op; { if (cBINOP->op_first->op_flags & OPf_PARENS) { op->op_private = OPpREPEAT_DOLIST; - cBINOP->op_first = - prepend_elem(OP_NULL, newOP(OP_PUSHMARK, 0), cBINOP->op_first); + cBINOP->op_first = force_list(cBINOP->op_first); } else scalar(op); @@ -2863,6 +3096,33 @@ OP *op; } OP * +ck_require(op) +OP *op; +{ + if (op->op_flags & OPf_KIDS) { /* Shall we fake a BEGIN {}? */ + SVOP *kid = (SVOP*)cUNOP->op_first; + + if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) { + char *name = SvPVX(subname); + char *s; + sv_catpvn(kid->op_sv, ".pm", 3); + if (s = strrchr(name,':')) + s++; + else + s = name; + if (strNE(s, "BEGIN")) { + op = newSTATEOP(0, Nullch, op); + newSUB(start_subparse(), + newSVOP(OP_CONST, 0, newSVpv("BEGIN", 5)), + op); + return newOP(OP_STUB,0); + } + } + } + return ck_fun(op); +} + +OP * ck_retarget(op) OP *op; { @@ -2877,7 +3137,7 @@ OP *op; { if (op->op_flags & OPf_KIDS) { OP *kid = cLISTOP->op_first->op_sibling; /* get past pushmark */ - if (kid) { + if (kid->op_sibling) { op->op_type = OP_SSELECT; op->op_ppaddr = ppaddr[OP_SSELECT]; op = ck_fun(op); @@ -2920,8 +3180,7 @@ OP *op; peep(k); } else if (kid->op_type == OP_LEAVE) { - kid->op_type = OP_NULL; /* wipe out leave */ - kid->op_ppaddr = ppaddr[OP_NULL]; + null(kid); /* wipe out leave */ kid->op_next = kid; for (k = kLISTOP->op_first->op_next; k; k = k->op_next) { @@ -2931,8 +3190,7 @@ OP *op; peep(kLISTOP->op_first); } kid = cLISTOP->op_first->op_sibling; /* get past pushmark */ - kid->op_type = OP_NULL; /* wipe out rv2gv */ - kid->op_ppaddr = ppaddr[OP_NULL]; + null(kid); /* wipe out rv2gv */ kid->op_next = kid; op->op_flags |= OPf_SPECIAL; } @@ -2950,17 +3208,14 @@ OP *op; if (op->op_flags & OPf_STACKED) return no_fh_allowed(op); - if (!(op->op_flags & OPf_KIDS)) - op = prepend_elem(OP_SPLIT, - pmruntime( - newPMOP(OP_MATCH, OPf_SPECIAL), - newSVOP(OP_CONST, 0, newSVpv(" ", 1)), - Nullop), - op); - kid = cLISTOP->op_first; - if (kid->op_type == OP_PUSHMARK) + if (kid->op_type != OP_NULL) croak("panic: ck_split"); + kid = kid->op_sibling; + op_free(cLISTOP->op_first); + cLISTOP->op_first = kid; + if (!kid) + cLISTOP->op_first = kid = newSVOP(OP_CONST, 0, newSVpv(" ", 1)); if (kid->op_type != OP_MATCH) { OP *sibl = kid->op_sibling; @@ -2973,7 +3228,7 @@ OP *op; } pm = (PMOP*)kid; if (pm->op_pmshort && !(pm->op_pmflags & PMf_ALL)) { - sv_free(pm->op_pmshort); /* can't use substring to optimize */ + SvREFCNT_dec(pm->op_pmshort); /* can't use substring to optimize */ pm->op_pmshort = 0; } @@ -3006,17 +3261,23 @@ OP *op; OP *o = ((cUNOP->op_first->op_sibling) ? cUNOP : ((UNOP*)cUNOP->op_first))->op_first->op_sibling; - if (o->op_type == OP_RV2CV) { - o->op_type = OP_NULL; /* disable rv2cv */ - o->op_ppaddr = ppaddr[OP_NULL]; - } + if (o->op_type == OP_RV2CV) + null(o); /* disable rv2cv */ op->op_private = 0; - if (perldb) + if (perldb && curstash != debstash) op->op_private |= OPpSUBR_DB; return op; } OP * +ck_svconst(op) +OP *op; +{ + SvREADONLY_on(cSVOP->op_sv); + return op; +} + +OP * ck_trunc(op) OP *op; { @@ -3042,6 +3303,12 @@ register OP* op; if (op->op_seq) return; switch (op->op_type) { + case OP_STUB: + if ((op->op_flags & (OPf_KNOW|OPf_LIST)) != (OPf_KNOW|OPf_LIST)) { + op->op_seq = ++op_seqmax; + break; /* Scalar stub must produce undef. List stub is noop */ + } + /* FALL THROUGH */ case OP_NULL: case OP_SCALAR: case OP_LINESEQ: @@ -3054,15 +3321,36 @@ register OP* op; break; case OP_GV: - if (op->op_next->op_type == OP_RV2SV && - op->op_next->op_private < OP_RV2GV) - { - op->op_next->op_type = OP_NULL; - op->op_next->op_ppaddr = ppaddr[OP_NULL]; - op->op_flags |= op->op_next->op_flags & OPf_INTRO; - op->op_next = op->op_next->op_next; - op->op_type = OP_GVSV; - op->op_ppaddr = ppaddr[OP_GVSV]; + if (op->op_next->op_type == OP_RV2SV) { + if (op->op_next->op_private < OP_RV2GV) { + null(op->op_next); + op->op_flags |= op->op_next->op_flags & OPf_INTRO; + op->op_next = op->op_next->op_next; + op->op_type = OP_GVSV; + op->op_ppaddr = ppaddr[OP_GVSV]; + } + } + else if (op->op_next->op_type == OP_RV2AV) { + OP* pop = op->op_next->op_next; + I32 i; + if (pop->op_type == OP_CONST && + pop->op_next->op_type == OP_AELEM && + pop->op_next->op_private < OP_RV2GV && + !(pop->op_next->op_flags & OPf_INTRO) && + (i = SvIV(((SVOP*)pop)->op_sv)) <= 255 && + i >= 0) + { + null(op->op_next); + null(pop->op_next); + null(pop); + op->op_flags &= ~OPf_LVAL; + op->op_flags |= pop->op_next->op_flags & OPf_LVAL; + op->op_next = pop->op_next->op_next; + op->op_type = OP_AELEMFAST; + op->op_ppaddr = ppaddr[OP_AELEMFAST]; + op->op_private = i; + GvAVn((GV*)cSVOP->op_sv); + } } op->op_seq = ++op_seqmax; break; diff --git a/opcode.h b/opcode.h index e9bbcca..aea0a8a 100644 --- a/opcode.h +++ b/opcode.h @@ -343,7 +343,7 @@ char *op_name[] = { "ref-to-scalar cast", "array length", "subroutine reference", - "backslash reference", + "reference constructor", "reference-type operator", "bless", "backticks", @@ -644,7 +644,6 @@ char *op_name[] = { }; #endif -OP * ck_aelem P((OP* op)); OP * ck_chop P((OP* op)); OP * ck_concat P((OP* op)); OP * ck_eof P((OP* op)); @@ -662,12 +661,15 @@ OP * ck_listiob P((OP* op)); OP * ck_match P((OP* op)); OP * ck_null P((OP* op)); OP * ck_repeat P((OP* op)); +OP * ck_require P((OP* op)); +OP * ck_rfun P((OP* op)); OP * ck_rvconst P((OP* op)); OP * ck_select P((OP* op)); OP * ck_shift P((OP* op)); OP * ck_sort P((OP* op)); OP * ck_split P((OP* op)); OP * ck_subr P((OP* op)); +OP * ck_svconst P((OP* op)); OP * ck_trunc P((OP* op)); OP * pp_null P((void)); @@ -1321,7 +1323,7 @@ OP * (*check[])() = { ck_fun, /* scalar */ ck_null, /* pushmark */ ck_null, /* wantarray */ - ck_null, /* const */ + ck_svconst, /* const */ ck_null, /* interp */ ck_null, /* gvsv */ ck_null, /* gv */ @@ -1352,7 +1354,7 @@ OP * (*check[])() = { ck_null, /* aassign */ ck_null, /* schop */ ck_chop, /* chop */ - ck_lfun, /* defined */ + ck_rfun, /* defined */ ck_lfun, /* undef */ ck_fun, /* study */ ck_lfun, /* preinc */ @@ -1418,7 +1420,7 @@ OP * (*check[])() = { ck_fun, /* lc */ ck_rvconst, /* rv2av */ ck_null, /* aelemfast */ - ck_aelem, /* aelem */ + ck_null, /* aelem */ ck_null, /* aslice */ ck_fun, /* each */ ck_fun, /* values */ @@ -1594,7 +1596,7 @@ OP * (*check[])() = { ck_fun, /* semget */ ck_fun, /* semctl */ ck_fun, /* semop */ - ck_fun, /* require */ + ck_require, /* require */ ck_fun, /* dofile */ ck_eval, /* entereval */ ck_null, /* leaveeval */ diff --git a/opcode.pl b/opcode.pl index 321188e..c3452ff 100755 --- a/opcode.pl +++ b/opcode.pl @@ -163,7 +163,7 @@ scalar scalar ck_fun s S pushmark pushmark ck_null s wantarray wantarray ck_null is -const constant item ck_null s +const constant item ck_svconst s interp interpreted string ck_null 0 gvsv scalar variable ck_null ds @@ -182,7 +182,7 @@ sv2len scalar value length ck_null ist rv2sv ref-to-scalar cast ck_rvconst ds av2arylen array length ck_null is rv2cv subroutine reference ck_rvconst d -refgen backslash reference ck_null fst L +refgen reference constructor ck_null fst L ref reference-type operator ck_fun st S? bless bless ck_fun s S S? @@ -209,7 +209,7 @@ aassign list assignment ck_null t L L schop scalar chop ck_null t chop chop ck_chop mt L -defined defined operator ck_lfun is S? +defined defined operator ck_rfun is S? undef undef operator ck_lfun s S? study study ck_fun st S? @@ -298,7 +298,7 @@ lc lower case ck_fun ft S rv2av array deref ck_rvconst dt aelemfast known array element ck_null s A S -aelem array element ck_aelem s A S +aelem array element ck_null s A S aslice array slice ck_null m A L # Associative arrays. @@ -539,7 +539,7 @@ semop semop ck_fun imst S S S # Eval. -require require ck_fun d S? +require require ck_require d S? dofile do 'file' ck_fun d S entereval eval string ck_eval d S leaveeval eval exit ck_null 0 S diff --git a/perl.c b/perl.c index c6c2bee..337e190 100644 --- a/perl.c +++ b/perl.c @@ -78,9 +78,8 @@ static void find_beginning(); static void init_main_stash(); static void open_script(); static void init_debugger(); -static void init_stack(); +static void init_stacks(); static void init_lexer(); -static void init_context_stack(); static void init_predump_symbols(); static void init_postdump_symbols(); static void init_perllib(); @@ -91,8 +90,8 @@ perl_alloc() PerlInterpreter *sv_interp; PerlInterpreter junk; - curinterp = &junk; - Zero(&junk, 1, PerlInterpreter); + curinterp = 0; +/* Zero(&junk, 1, PerlInterpreter); */ New(53, sv_interp, 1, PerlInterpreter); return sv_interp; } @@ -104,7 +103,9 @@ register PerlInterpreter *sv_interp; if (!(curinterp = sv_interp)) return; +#ifdef MULTIPLICITY Zero(sv_interp, 1, PerlInterpreter); +#endif /* Init the real globals? */ if (!linestr) { @@ -132,12 +133,10 @@ register PerlInterpreter *sv_interp; #endif } -#ifdef EMBEDDED +#ifdef MULTIPLICITY chopset = " \n-"; copline = NOLINE; curcop = &compiling; - cxstack_ix = -1; - cxstack_max = 128; dlmax = 128; laststatval = -1; laststype = OP_STAT; @@ -152,8 +151,6 @@ register PerlInterpreter *sv_interp; rslen = 1; statname = Nullsv; tmps_floor = -1; - tmps_ix = -1; - tmps_max = -1; #endif uid = (int)getuid(); @@ -167,19 +164,76 @@ register PerlInterpreter *sv_interp; fdpid = newAV(); /* for remembering popen pids by fd */ pidstatus = newHV();/* for remembering status of dead pids */ + + init_stacks(); + ENTER; } void perl_destruct(sv_interp) register PerlInterpreter *sv_interp; { + I32 last_sv_count; + if (!(curinterp = sv_interp)) return; -#ifdef EMBEDDED - if (main_root) + LEAVE; + FREE_TMPS(); + +#ifndef EMBED + /* The exit() function may do everything that needs doing. */ + if (!sv_rvcount) + return; +#endif + + /* Not so lucky. We must account for everything. First the syntax tree. */ + if (main_root) { + curpad = AvARRAY(comppad); op_free(main_root); - main_root = 0; + main_root = 0; + } + + /* + * Try to destruct global references. We do this first so that the + * destructors and destructees still exist. This code currently + * will break simple reference loops but may fail on more complicated + * ones. If so, the code below will clean up, but any destructors + * may fail to find what they're looking for. + */ + if (sv_count != 0) + sv_clean_refs(); + + /* Delete self-reference from main symbol table */ + GvHV(gv_fetchpv("::_main",TRUE)) = 0; + --SvREFCNT(defstash); + + /* Try to destruct main symbol table. May fail on reference loops. */ + SvREFCNT_dec(defstash); + + FREE_TMPS(); +#ifdef DEBUGGING + if (scopestack_ix != 0) + warn("Unbalanced scopes: %d more ENTERs than LEAVEs\n", scopestack_ix); + if (savestack_ix != 0) + warn("Unbalanced saves: %d more saves than restores\n", savestack_ix); + if (tmps_floor != -1) + warn("Unbalanced tmps: %d more allocs than frees\n", tmps_floor + 1); + if (cxstack_ix != -1) + warn("Unbalanced context: %d more PUSHes than POPs\n", cxstack_ix + 1); #endif + + /* Now absolutely destruct everything, somehow or other, loops or no. */ +#ifdef APPARENTLY_UNNECESSARY + if (sv_count != 0) + sv_clean_magic(); +#endif + last_sv_count = 0; + while (sv_count != 0 && sv_count != last_sv_count) { + last_sv_count = sv_count; + sv_clean_all(); + } + if (sv_count != 0) + warn("Scalars leaked: %d\n", sv_count); } void @@ -228,20 +282,29 @@ setuid perl scripts securely.\n"); case 1: statusvalue = 255; case 2: + curstash = defstash; + if (endav) + calllist(endav); return(statusvalue); /* my_exit() was called */ case 3: fprintf(stderr, "panic: top_env\n"); - exit(1); + return 1; } if (do_undump) { + + /* Come here if running an undumped a.out. */ + origfilename = savestr(argv[0]); do_undump = FALSE; cxstack_ix = -1; /* start label stack again */ - goto just_doit; + init_postdump_symbols(argc,argv,env); + return 0; } + sv_setpvn(linestr,"",0); sv = newSVpv("",0); /* first used for -I flags */ + SAVEFREESV(sv); init_main_stash(); for (argc--,argv++; argc > 0; argc--,argv++) { if (argv[0][0] != '-' || !argv[0][1]) @@ -352,9 +415,6 @@ setuid perl scripts securely.\n"); open_script(scriptname,dosearch,sv); - sv_free(sv); /* free -I directories */ - sv = Nullsv; - validate_suid(validarg); if (doextract) @@ -368,17 +428,16 @@ setuid perl scripts securely.\n"); av_push(comppad, Nullsv); curpad = AvARRAY(comppad); padname = newAV(); - comppadname = padname; - comppadnamefill = -1; + comppad_name = padname; + comppad_name_fill = 0; + min_intro_pending = 0; padix = 0; - init_stack(); - - init_context_stack(); - perl_init_ext(); /* in case linked C routines want magical variables */ init_predump_symbols(); + if (!do_undump) + init_postdump_symbols(argc,argv,env); init_lexer(); @@ -412,8 +471,9 @@ setuid perl scripts securely.\n"); if (do_undump) my_unexec(); - just_doit: /* come here if running an undumped a.out */ - init_postdump_symbols(argc,argv,env); + if (dowarn) + gv_check(defstash); + return 0; } @@ -423,8 +483,6 @@ 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 */ @@ -433,11 +491,13 @@ PerlInterpreter *sv_interp; curstash = defstash; if (endav) calllist(endav); + FREE_TMPS(); return(statusvalue); /* my_exit() was called */ case 3: if (!restartop) { fprintf(stderr, "panic: restartop\n"); - exit(1); + FREE_TMPS(); + return 1; } if (stack != mainstack) { dSP; @@ -482,10 +542,44 @@ int status; /* Be sure to refetch the stack pointer after calling these routines. */ int -perl_callback(subname, sp, gimme, hasargs, numargs) +perl_callargv(subname, sp, gimme, argv) +char *subname; +register I32 sp; /* current stack pointer */ +I32 gimme; /* TRUE if called in list context */ +register char **argv; /* null terminated arg list, NULL for no arglist */ +{ + register I32 items = 0; + I32 hasargs = (argv != 0); + + av_store(stack, ++sp, Nullsv); /* reserve spot for sub reference */ + if (hasargs) { + while (*argv) { + av_store(stack, ++sp, sv_2mortal(newSVpv(*argv,0))); + items++; + argv++; + } + } + return perl_callpv(subname, sp, gimme, hasargs, items); +} + +int +perl_callpv(subname, sp, gimme, hasargs, numargs) char *subname; I32 sp; /* stack pointer after args are pushed */ -I32 gimme; /* called in array or scalar context */ +I32 gimme; /* TRUE if called in list context */ +I32 hasargs; /* whether to create a @_ array for routine */ +I32 numargs; /* how many args are pushed on the stack */ +{ + return perl_callsv((SV*)gv_fetchpv(subname, TRUE), + sp, gimme, hasargs, numargs); +} + +/* May be called with any of a CV, a GV, or an SV containing the name. */ +int +perl_callsv(sv, sp, gimme, hasargs, numargs) +SV* sv; +I32 sp; /* stack pointer after args are pushed */ +I32 gimme; /* TRUE if called in list context */ I32 hasargs; /* whether to create a @_ array for routine */ I32 numargs; /* how many args are pushed on the stack */ { @@ -499,7 +593,7 @@ I32 numargs; /* how many args are pushed on the stack */ op = (OP*)&myop; Zero(op, 1, BINOP); pp_pushmark(); /* doesn't look at op, actually, except to return */ - *++stack_sp = (SV*)gv_fetchpv(subname, FALSE); + *++stack_sp = sv; stack_sp += numargs; if (hasargs) { @@ -510,32 +604,11 @@ I32 numargs; /* how many args are pushed on the stack */ if (op = pp_entersubr()) run(); - free_tmps(); + FREE_TMPS(); LEAVE; return stack_sp - stack_base; } -int -perl_callv(subname, sp, gimme, argv) -char *subname; -register I32 sp; /* current stack pointer */ -I32 gimme; /* called in array or scalar context */ -register char **argv; /* null terminated arg list, NULL for no arglist */ -{ - register I32 items = 0; - I32 hasargs = (argv != 0); - - av_store(stack, ++sp, Nullsv); /* reserve spot for 1st return arg */ - if (hasargs) { - while (*argv) { - av_store(stack, ++sp, sv_2mortal(newSVpv(*argv,0))); - items++; - argv++; - } - } - return perl_callback(subname, sp, gimme, hasargs, items); -} - void magicname(sym,name,namlen) char *sym; @@ -621,7 +694,7 @@ char *s; #ifdef DEBUGGING taint_not("-D"); if (isALPHA(s[1])) { - static char debopts[] = "psltocPmfrxuLHX"; + static char debopts[] = "psltocPmfrxuLHXD"; char *d; for (s++; *s && (d = strchr(debopts,*s)); s++) @@ -631,7 +704,7 @@ char *s; debug = atoi(s+1); for (s++; isDIGIT(*s); s++) ; } - debug |= 32768; + debug |= 0x80000000; #else warn("Recompile perl with -DDEBUGGING to use -D switch\n"); for (s++; isDIGIT(*s); s++) ; @@ -694,7 +767,7 @@ char *s; s++; return s; case 'v': - fputs("\nThis is perl, version 5.0, Alpha 5 (unsupported)\n\n",stdout); + fputs("\nThis is perl, version 5.0, Alpha 6 (unsupported)\n\n",stdout); fputs(rcsid,stdout); fputs("\nCopyright (c) 1989, 1990, 1991, 1992, 1993, 1994 Larry Wall\n",stdout); #ifdef MSDOS @@ -762,12 +835,14 @@ init_main_stash() GV *gv; curstash = defstash = newHV(); curstname = newSVpv("main",4); - GvHV(gv = gv_fetchpv("_main",TRUE)) = defstash; + GvHV(gv = gv_fetchpv("_main",TRUE)) = (HV*)SvREFCNT_inc(defstash); SvREADONLY_on(gv); HvNAME(defstash) = "main"; incgv = gv_HVadd(gv_AVadd(gv_fetchpv("INC",TRUE))); SvMULTI_on(incgv); defgv = gv_fetchpv("_",TRUE); + curstash = defstash; + compiling.cop_stash = defstash; } static void @@ -827,7 +902,7 @@ SV *sv; scriptname = xfound; } - origfilename = savestr(scriptname); + origfilename = savestr(e_fp ? "-e" : scriptname); curcop->cop_filegv = gv_fetchfile(origfilename); if (strEQ(origfilename,"-")) scriptname = ""; @@ -1141,7 +1216,7 @@ init_debugger() GV* tmpgv; debstash = newHV(); - GvHV(gv_fetchpv("_DB",TRUE)) = debstash; + GvHV(gv_fetchpv("::_DB",TRUE)) = debstash; curstash = debstash; dbargs = GvAV(gv_AVadd((tmpgv = gv_fetchpv("args",TRUE)))); SvMULTI_on(tmpgv); @@ -1162,7 +1237,7 @@ init_debugger() } static void -init_stack() +init_stacks() { stack = newAV(); mainstack = stack; /* remember in case we switch stacks */ @@ -1171,7 +1246,7 @@ init_stack() stack_base = AvARRAY(stack); stack_sp = stack_base; - stack_max = stack_base + 128; + stack_max = stack_base + 127; New(54,markstack,64,int); markstack_ptr = markstack; @@ -1188,20 +1263,15 @@ init_stack() New(54,retstack,16,OP*); retstack_ix = 0; retstack_max = 16; -} -static void -init_lexer() -{ - bufend = bufptr = SvPV(linestr, na); - subname = newSVpv("main",4); - lex_start(); /* we never leave */ -} - -static void -init_context_stack() -{ New(50,cxstack,128,CONTEXT); + cxstack_ix = -1; + cxstack_max = 128; + + New(50,tmps_stack,128,SV*); + tmps_ix = -1; + tmps_max = 128; + DEBUG( { New(51,debname,128,char); New(52,debdelim,128,char); @@ -1209,6 +1279,16 @@ init_context_stack() } static void +init_lexer() +{ + FILE* tmpfp = rsfp; + + lex_start(linestr); + rsfp = tmpfp; + subname = newSVpv("main",4); +} + +static void init_predump_symbols() { GV *tmpgv; @@ -1219,28 +1299,28 @@ init_predump_symbols() SvMULTI_on(stdingv); if (!GvIO(stdingv)) GvIO(stdingv) = newIO(); - GvIO(stdingv)->ifp = stdin; + IoIFP(GvIO(stdingv)) = stdin; tmpgv = gv_fetchpv("stdin",TRUE); - GvIO(tmpgv) = GvIO(stdingv); + GvIO(tmpgv) = (IO*)SvREFCNT_inc(GvIO(stdingv)); SvMULTI_on(tmpgv); tmpgv = gv_fetchpv("STDOUT",TRUE); SvMULTI_on(tmpgv); if (!GvIO(tmpgv)) GvIO(tmpgv) = newIO(); - GvIO(tmpgv)->ofp = GvIO(tmpgv)->ifp = stdout; + IoOFP(GvIO(tmpgv)) = IoIFP(GvIO(tmpgv)) = stdout; defoutgv = tmpgv; tmpgv = gv_fetchpv("stdout",TRUE); - GvIO(tmpgv) = GvIO(defoutgv); + GvIO(tmpgv) = (IO*)SvREFCNT_inc(GvIO(defoutgv)); SvMULTI_on(tmpgv); curoutgv = gv_fetchpv("STDERR",TRUE); SvMULTI_on(curoutgv); if (!GvIO(curoutgv)) GvIO(curoutgv) = newIO(); - GvIO(curoutgv)->ofp = GvIO(curoutgv)->ifp = stderr; + IoOFP(GvIO(curoutgv)) = IoIFP(GvIO(curoutgv)) = stderr; tmpgv = gv_fetchpv("stderr",TRUE); - GvIO(tmpgv) = GvIO(curoutgv); + GvIO(tmpgv) = (IO*)SvREFCNT_inc(GvIO(curoutgv)); SvMULTI_on(tmpgv); curoutgv = defoutgv; /* switch back to STDOUT */ @@ -1304,8 +1384,10 @@ register char **env; SvMULTI_on(envgv); hv = GvHVn(envgv); hv_clear(hv); - if (env != environ) + if (env != environ) { environ[0] = Nullch; + hv_magic(hv, envgv, 'E'); + } for (; *env; env++) { if (!(s = strchr(*env,'='))) continue; @@ -1320,8 +1402,6 @@ register char **env; if (tmpgv = gv_fetchpv("$",TRUE)) sv_setiv(GvSV(tmpgv),(I32)getpid()); - if (dowarn) - gv_check(defstash); } static void @@ -1341,31 +1421,26 @@ 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 */ + av_store(stack, ++sp, Nullsv); /* reserve spot for sub reference */ Copy(top_env, oldtop, 1, jmp_buf); - for (i = 0; i <= fill; i++) - { - GV *gv = (GV*)av_shift(list); - SV* tmpsv = NEWSV(0,0); + while (AvFILL(list) >= 0) { + CV *cv = (CV*)av_shift(list); - if (gv && GvCV(gv)) { - gv_efullname(tmpsv, gv); - if (setjmp(top_env)) { - if (list == beginav) - exit(1); - } - else { - perl_callback(SvPVX(tmpsv), sp, G_SCALAR, 0, 0); + SAVEFREESV(cv); + if (setjmp(top_env)) { + if (list == beginav) { + warn("BEGIN failed--execution aborted"); + Copy(oldtop, top_env, 1, jmp_buf); + my_exit(1); } } - sv_free(tmpsv); - sv_free(gv); + else { + perl_callsv((SV*)cv, sp, G_SCALAR, 0, 0); + } } Copy(oldtop, top_env, 1, jmp_buf); diff --git a/perl.h b/perl.h index 1b32d4d..81f724c 100644 --- a/perl.h +++ b/perl.h @@ -514,7 +514,6 @@ typedef struct Outrec Outrec; typedef struct lstring Lstring; typedef struct interpreter PerlInterpreter; typedef struct ff FF; -typedef struct io IO; typedef struct sv SV; typedef struct av AV; typedef struct hv HV; @@ -522,6 +521,7 @@ typedef struct cv CV; typedef struct regexp REGEXP; typedef struct gp GP; typedef struct sv GV; +typedef struct io IO; typedef struct context CONTEXT; typedef struct block BLOCK; @@ -538,6 +538,7 @@ typedef struct xpvgv XPVGV; typedef struct xpvcv XPVCV; typedef struct xpvbm XPVBM; typedef struct xpvfm XPVFM; +typedef struct xpvio XPVIO; typedef struct mgvtbl MGVTBL; typedef union any ANY; @@ -687,6 +688,7 @@ GIDTYPE getegid P(()); #define DEBUG_L(a) if (debug & 4096) a #define DEBUG_H(a) if (debug & 8192) a #define DEBUG_X(a) if (debug & 16384) a +#define DEBUG_D(a) if (debug & 32768) a #else #define DEB(a) #define DEBUG(a) @@ -705,6 +707,7 @@ GIDTYPE getegid P(()); #define DEBUG_L(a) #define DEBUG_H(a) #define DEBUG_X(a) +#define DEBUG_D(a) #endif #define YYMAXDEPTH 300 @@ -804,10 +807,16 @@ EXT bool nomemok; /* let malloc context handle nomem */ EXT U32 an; /* malloc sequence number */ EXT U32 cop_seqmax; /* statement sequence number */ EXT U32 op_seqmax; /* op sequence number */ +EXT U32 evalseq; /* eval sequence number */ EXT U32 sub_generation; /* inc to force methods to be looked up again */ EXT char ** origenviron; EXT U32 origalen; +EXT I32 * xiv_root; /* free xiv list--shared by interpreters */ +EXT double * xnv_root; /* free xnv list--shared by interpreters */ +EXT XRV * xrv_root; /* free xrv list--shared by interpreters */ +EXT XPV * xpv_root; /* free xpv list--shared by interpreters */ + /* Stack for currently executing thread--context switch must handle this. */ EXT SV ** stack_base; /* stack->array_ary */ EXT SV ** stack_sp; /* stack pointer now */ @@ -858,6 +867,8 @@ EXT char * hexdigit INIT("0123456789abcdef0123456789ABCDEFx"); EXT char * patleave INIT("\\.^$@dDwWsSbB+*?|()-nrtfeaxc0123456789[{]}"); EXT char * vert INIT("|"); +EXT char warn_uninit[] + INIT("Use of uninitialized variable"); EXT char warn_nosemi[] INIT("Semicolon seems to be missing"); EXT char warn_reserved[] @@ -865,7 +876,7 @@ EXT char warn_reserved[] EXT char warn_nl[] INIT("Unsuccessful %s on filename containing newline"); EXT char no_usym[] - INIT("Can't use an undefined value to create a symbol"); + INIT("Can't use an undefined value as %s reference"); EXT char no_aelem[] INIT("Modification of non-creatable array value attempted, subscript %d"); EXT char no_helem[] @@ -977,15 +988,32 @@ EXT unsigned char freq[] = { /* letter frequencies for mixed English/C */ EXT unsigned char freq[]; #endif +#ifdef DEBUGGING +#ifdef DOINIT +EXT char* block_type[] = { + "NULL", + "SUB", + "EVAL", + "LOOP", + "SUBST", + "BLOCK", +}; +#else +EXT char* block_type[]; +#endif +#endif + /*****************************************************************************/ /* This lexer/parser stuff is currently global since yacc is hard to reenter */ /*****************************************************************************/ +/* XXX This needs to be revisited, since BEGIN makes yacc re-enter... */ typedef enum { XOPERATOR, XTERM, - XBLOCK, XREF, + XSTATE, + XBLOCK, } expectation; EXT FILE * VOL rsfp INIT(Nullfp); @@ -994,7 +1022,7 @@ EXT char * bufptr; EXT char * oldbufptr; EXT char * oldoldbufptr; EXT char * bufend; -EXT expectation expect INIT(XBLOCK); /* how to interpret ambiguous tokens */ +EXT expectation expect INIT(XSTATE); /* how to interpret ambiguous tokens */ EXT I32 multi_start; /* 1st line of multi-line string */ EXT I32 multi_end; /* last line of multi-line string */ @@ -1007,8 +1035,10 @@ EXT I32 subline; /* line this subroutine began on */ EXT SV * subname; /* name of current subroutine */ EXT AV * comppad; /* storage for lexically scoped temporaries */ -EXT AV * comppadname; /* variable names for "my" variables */ -EXT I32 comppadnamefill;/* last "introduced" variable offset */ +EXT AV * comppad_name; /* variable names for "my" variables */ +EXT I32 comppad_name_fill;/* last "introduced" variable offset */ +EXT I32 min_intro_pending;/* start of vars to introduce */ +EXT I32 max_intro_pending;/* end of vars to introduce */ EXT I32 padix; /* max used index in current "register" pad */ EXT COP compiling; @@ -1016,6 +1046,7 @@ EXT SV * evstr; /* op_fold_const() temp string cache */ EXT I32 thisexpr; /* name id for nothing_in_common() */ EXT char * last_uni; /* position of last named-unary operator */ EXT char * last_lop; /* position of last list operator */ +EXT OPCODE last_lop_op; /* last list operator */ EXT bool in_format; /* we're compiling a run_format */ EXT bool in_my; /* we're compiling a "my" declaration */ EXT I32 needblockscope INIT(TRUE); /* block overhead needed? */ @@ -1053,7 +1084,7 @@ EXT char ** regmyendp; /* Global only to current interpreter instance */ /***********************************************/ -#ifdef EMBEDDED +#ifdef MULTIPLICITY #define IEXT #define IINIT(x) struct interpreter { @@ -1104,12 +1135,12 @@ IEXT SV * Iformfeed; /* $^L */ IEXT char * Ichopset IINIT(" \n-"); /* $: */ IEXT char * Irs IINIT("\n"); /* $/ */ IEXT U32 Irschar IINIT('\n'); /* final char of rs, or 0777 if none */ -IEXT I32 Irslen IINIT(1); +IEXT STRLEN Irslen IINIT(1); IEXT bool Irspara; IEXT char * Iofs; /* $, */ -IEXT I32 Iofslen; +IEXT STRLEN Iofslen; IEXT char * Iors; /* $\ */ -IEXT I32 Iorslen; +IEXT STRLEN Iorslen; IEXT char * Iofmt; /* $# */ IEXT I32 Imaxsysfd IINIT(MAXSYSFD); /* top fd to pass to subprocesses */ IEXT int Imultiline; /* $*--do strings hold >1 line? */ @@ -1159,11 +1190,14 @@ IEXT AV * Ipad; /* storage for lexically scoped temporaries */ IEXT AV * Ipadname; /* variable names for "my" variables */ /* memory management */ -IEXT SV * Ifreestrroot; IEXT SV ** Itmps_stack; IEXT I32 Itmps_ix IINIT(-1); IEXT I32 Itmps_floor IINIT(-1); -IEXT I32 Itmps_max IINIT(-1); +IEXT I32 Itmps_max; +IEXT I32 Isv_count; /* how many SV* are currently allocated */ +IEXT I32 Isv_rvcount; /* how many RV* are currently allocated */ +IEXT SV* Isv_root; /* storage for SVs belonging to interp */ +IEXT SV* Isv_arenaroot; /* list of areas for garbage collection */ /* funky return mechanisms */ IEXT I32 Ilastspbase; @@ -1239,7 +1273,7 @@ IEXT I32 Ilaststype IINIT(OP_STAT); #undef IEXT #undef IINIT -#ifdef EMBEDDED +#ifdef MULTIPLICITY }; #else struct interpreter { diff --git a/perl.man b/perl.man index 6720355..6f3c7db 100644 --- a/perl.man +++ b/perl.man @@ -453,6 +453,10 @@ will work under any of csh, sh or perl, such as the following: .fi .TP 5 +.B \-T +forces "taint" checks to be turned on. Ordinarily these checks are done +only when running setuid or setgid. +.TP 5 .B \-u causes .I perl @@ -1176,6 +1180,8 @@ or the .I while statement, you may replace \*(L"(EXPR)\*(R" with a BLOCK, and the conditional is true if the value of the last command in that block is true. +(This feature continues to work in Perl 5 but is deprecated. Please +change any occurrences of "if BLOCK" to "if (do BLOCK)".) .PP The .I for @@ -4418,7 +4424,7 @@ record, the page is advanced by writing a form feed, a special top-of-page format is used to format the new page header, and then the record is written. By default the top-of-page format is the name of the filehandle with -\*(L"_TOP\*(R" appended, but it may be dynamicallly set to the +\*(L"_TOP\*(R" appended, but it may be dynamically set to the format of your choice by assigning the name to the $^ variable while the filehandle is selected. The number of lines remaining on the current page is in variable $-, which diff --git a/perly.c b/perly.c index 8fd9983..91854f9 100644 --- a/perly.c +++ b/perly.c @@ -60,14 +60,14 @@ typedef union { #define UNIOP 296 #define SHIFTOP 297 #define MATCHOP 298 -#define ARROW 299 -#define UMINUS 300 -#define REFGEN 301 -#define POWOP 302 -#define PREINC 303 -#define PREDEC 304 -#define POSTINC 305 -#define POSTDEC 306 +#define UMINUS 299 +#define REFGEN 300 +#define POWOP 301 +#define PREINC 302 +#define PREDEC 303 +#define POSTINC 304 +#define POSTDEC 305 +#define ARROW 306 #define YYERRCODE 256 short yylhs[] = { -1, 30, 0, 7, 3, 8, 8, 8, 9, 9, 9, @@ -115,13 +115,13 @@ short yydefred[] = { 1, 0, 0, 0, 0, 0, 106, 108, 102, 0, 0, 0, 142, 5, 44, 47, 46, 48, 151, 153, 152, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 131, 0, 0, 0, 149, 0, 125, 0, + 0, 0, 0, 0, 0, 0, 149, 0, 125, 0, 0, 0, 0, 0, 0, 0, 0, 0, 58, 0, 133, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 98, 0, 145, 146, 147, 148, 150, 0, 34, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 90, 91, 0, 0, 0, 0, 0, + 0, 0, 90, 91, 0, 0, 0, 0, 0, 0, 0, 11, 0, 0, 57, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 36, 0, 136, 137, 0, 0, 0, 0, 0, 0, 0, 100, 0, @@ -149,1287 +149,1243 @@ short yydgoto[] = { 1, 13, 14, }; short yysindex[] = { 0, - 0, 0, 50, 0, -111, -240, -53, 0, 0, 0, - 0, 892, 0, 0, 0, -47, 0, -24, -39, 0, - 0, 0, -33, 0, -9, 0, -30, -26, -25, -22, - 32, -214, 68, 87, 108, -33, 2699, 2800, 38, 992, - -79, 2800, 2800, 2800, 2800, 2800, 2800, 2800, 1048, 0, - 2800, 2800, 1098, -33, -33, -33, -33, -33, -93, 0, - -4, 502, -87, -72, -52, 0, 0, 0, 140, 139, - -97, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 2800, 2800, 2800, -47, 2800, -47, 2800, -47, 2800, -47, - 1222, 175, 0, 180, 1328, 2800, 0, 176, 0, 9, - -32, 9, 207, 109, 120, 11, 2800, 203, 0, 1378, - 0, 9, -70, -70, -70, -50, -50, 159, 1, -70, - -70, 0, -18, 0, 0, 0, 0, 0, -47, 0, - 2800, 2800, 2800, 2800, 2800, 2800, 2800, 2800, 1428, 1499, - 2800, 2800, 2800, 2800, 1700, 1756, 1806, 1856, 2063, 2800, - 2113, 2800, -89, 0, 0, 2800, 2800, 2800, 2800, 2800, - 2165, 0, -94, -92, 0, 196, 203, 210, -93, 78, - -93, 106, -103, 145, -103, 194, 8, 0, 2800, 0, - 0, 197, 217, 1378, 2234, 2422, 137, 2800, 0, 2491, - 142, 0, 0, 1378, 0, 2800, 0, 2543, 170, 2593, - 0, 0, 0, 203, 203, 203, 203, 665, 52, 9, - -68, 2800, -187, 2800, -233, 332, 665, 665, 715, 2800, - 508, 2800, 1021, 2800, 691, 2800, 136, 2800, -121, -34, - 2800, -34, 58, 2800, 239, 2800, -16, 66, 10, 107, - 13, 0, 1, 240, 2800, 0, 0, 2800, -47, 0, - -47, 0, -47, -47, 241, 0, -47, 0, 2800, -47, - 1, 0, 0, 246, 0, 1, 0, 1, 2800, 131, - 169, 0, 0, 16, 0, 2800, 0, 665, 665, 2800, - 665, 665, 665, 665, 665, 665, 179, 148, 2800, 19, - 0, 185, 0, 191, 0, 0, 2800, 0, 411, -93, - -93, -103, 0, 2800, -103, 259, -93, -47, 0, 0, - 0, 151, 200, 0, 0, 23, 236, 0, 205, 264, - 0, 0, 0, 278, 0, 0, 0, 0, 198, 0, - 1222, 0, -93, 211, 0, 0, 0, 0, 0, -47, - 282, 0, 296, -103, -47, 0, 0, 0, + 0, 0, 74, 0, -113, -240, -53, 0, 0, 0, + 0, 938, 0, 0, 0, -47, 0, -51, 28, 0, + 0, 0, -33, 0, 75, 0, -22, -21, -20, -14, + 148, 2770, 87, 94, 110, -33, 2820, 2770, 171, 1094, + -214, 2770, 2770, 2770, 2770, 2770, 2770, 2770, 1146, 0, + 2770, 2770, 1209, -33, -33, -33, -33, -33, -194, 0, + 47, 814, -70, -52, -50, 0, 0, 0, 120, 89, + -138, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 2770, 2770, 2770, -47, 2770, -47, 2770, -47, 2770, -47, + 1324, 157, 814, 161, 1439, 2770, 0, 170, 0, -103, + -26, -103, 178, 93, 95, 67, 2770, 168, 0, 767, + 0, -103, -70, -70, -70, -87, -87, 130, 11, -70, + -70, 0, -16, 0, 0, 0, 0, 0, -47, 0, + 2770, 2770, 2770, 2770, 2770, 2770, 2770, 2770, 1495, 1595, + 2770, 2770, 2770, 2770, 1642, 1766, 1910, 1957, 2034, 2770, + 2081, 2770, 0, 0, -89, 2770, 2770, 2770, 2770, 2770, + 2225, 0, -247, -92, 0, 201, 168, 189, -194, 145, + -194, 174, 38, 188, 38, 182, -29, 0, 2770, 0, + 0, 206, 202, 767, 2349, 2396, 128, 2770, 0, 2493, + 132, 0, 0, 767, 0, 2770, 0, 2540, 162, 2664, + 0, 0, 0, 168, 168, 168, 168, 1295, 52, -103, + 687, 2770, -40, 2770, -176, 985, 1295, 1295, 350, 2770, + 176, 2770, 236, 2770, 420, 2770, 493, 2770, 116, -42, + 2770, -42, 102, 2770, 225, 2770, -4, 103, 3, 107, + 13, 0, 11, 232, 2770, 0, 0, 2770, -47, 0, + -47, 0, -47, -47, 235, 0, -47, 0, 2770, -47, + 11, 0, 0, 238, 0, 11, 0, 11, 2770, 108, + 160, 0, 0, 14, 0, 2770, 0, 1295, 1295, 2770, + 1295, 1295, 1295, 1295, 1295, 1295, 167, 131, 2770, 17, + 0, 172, 0, 175, 0, 0, 2770, 0, 719, -194, + -194, 38, 0, 2770, 38, 228, -194, -47, 0, 0, + 0, 133, 179, 0, 0, 19, 379, 0, 186, 277, + 0, 0, 0, 278, 0, 0, 0, 0, 230, 0, + 1324, 0, -194, 198, 0, 0, 0, 0, 0, -47, + 289, 0, 300, 38, -47, 0, 0, 0, }; short yyrindex[] = { 0, - 0, 0, 463, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 468, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 557, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 2841, 2887, 0, 0, 0, 0, 0, 0, 0, - 0, 3417, 3464, 0, 0, 0, 0, 0, 0, 0, + 0, 559, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 1, 2846, 0, 0, 0, 0, 0, 0, 0, + 0, 3442, 3496, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 100, 0, - 46, 5017, 5512, 618, 3723, 0, 0, 0, 2930, 0, + 15, 219, 605, 650, 3539, 0, 0, 0, 2912, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 3417, 0, 297, 0, 0, 0, 0, 0, 0, 0, - 280, 0, 0, 0, 0, 300, 0, 2971, 0, 4145, - 3764, 4186, 0, 0, 0, 0, 3417, 3034, 0, 3846, - 0, 4228, 5058, 5097, 5142, 5357, 5401, 3249, 0, 5438, - 5475, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 3442, 0, 310, 0, 0, 0, 0, 0, 0, 0, + 266, 0, 1970, 0, 0, 311, 0, 2978, 0, 3986, + 3711, 4119, 0, 0, 0, 0, 3442, 3026, 0, 5027, + 0, 4165, 5067, 5103, 5139, 5175, 5211, 3104, 0, 5282, + 5466, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 942, 0, 0, 48, 0, 163, 0, - 163, 0, 284, 0, 284, 0, 283, 0, 0, 0, - 0, 0, 0, 300, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 3846, 0, 0, 0, 0, 3293, 0, - 0, 0, 0, 80, 82, 93, 103, 1404, 4643, 4269, - 4313, 0, 3805, 0, 3, 1005, 4507, 4672, 0, 0, - 4631, 0, 4602, 0, 4573, 0, 4532, 0, 3888, 3334, - 0, 3376, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 3417, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 292, 0, + 0, 0, 0, 1038, 0, 0, 34, 0, 163, 0, + 163, 0, 284, 0, 284, 0, 295, 0, 0, 0, + 0, 0, 0, 311, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 5027, 0, 0, 0, 0, 3281, 0, + 0, 0, 0, 57, 58, 80, 82, 3930, 1699, 4226, + 4267, 0, 3794, 0, 3835, 4850, 4325, 4567, 0, 0, + 4505, 0, 4446, 0, 4405, 0, 4312, 0, 3879, 3359, + 0, 3400, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 3442, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 296, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 4691, 4761, 0, - 4909, 4950, 4954, 4962, 5005, 5013, 0, 0, 300, 0, - 0, 0, 0, 0, 0, 0, 300, 0, 0, 163, + 0, 0, 0, 0, 0, 0, 0, 4593, 4634, 0, + 4685, 4690, 4696, 4747, 4757, 4788, 0, 0, 311, 0, + 0, 0, 0, 0, 0, 0, 311, 0, 0, 163, 163, 284, 0, 0, 284, 0, 163, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 2386, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 2456, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 311, 0, 163, 0, 0, 0, 0, 0, 0, 0, + 329, 0, 163, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 284, 0, 0, 0, 0, }; short yygindex[] = { 0, 0, 0, 0, -148, 0, 0, -5, 298, 0, 0, - 0, 22, -170, -3, 5708, 591, 1069, 0, 0, 0, - 0, 0, 343, -80, 1003, 111, 0, 0, -113, 0, + 0, 41, -170, -3, 5451, 561, 1087, 0, 0, 0, + 0, 0, 367, -80, 12, 121, 0, 0, -120, 0, 0, 0, }; -#define YYTABLESIZE 5988 +#define YYTABLESIZE 5767 short yytable[] = { 17, - 165, 236, 55, 156, 258, 20, 59, 186, 61, 83, - 74, 15, 76, 85, 87, 183, 18, 89, 158, 77, - 156, 84, 86, 88, 90, 200, 193, 135, 260, 195, - 82, 99, 246, 234, 75, 152, 106, 111, 160, 135, - 156, 197, 93, 71, 198, 119, 71, 139, 197, 123, - 157, 198, 152, 135, 190, 250, 135, 252, 158, 135, - 71, 71, 135, 71, 150, 71, 135, 55, 151, 191, - 159, 91, 152, 55, 201, 15, 291, 103, 169, 167, - 171, 170, 173, 172, 175, 174, 13, 177, 38, 15, - 157, 182, 15, 71, 296, 71, 15, 15, 15, 25, - 15, 135, 293, 264, 13, 295, 38, 94, 315, 135, - 150, 321, 308, 273, 151, 336, 287, 310, 251, 311, - 16, 135, 17, 203, 292, 71, 95, 204, 205, 206, - 207, 328, 25, 14, 330, 25, 25, 25, 16, 25, - 17, 25, 25, 15, 25, 16, 253, 96, 233, 135, - 135, 14, 237, 238, 239, 240, 241, 243, 25, 139, - 140, 15, 25, 25, 298, 294, 254, 255, 235, 4, - 5, 6, 7, 347, 135, 261, 150, 107, 129, 161, - 151, 266, 268, 244, 270, 257, 326, 327, 135, 313, - 25, 135, 274, 332, 135, 25, 245, 162, 25, 25, - 25, 163, 25, 19, 25, 25, 319, 25, 320, 334, - 137, 153, 139, 140, 179, 185, 324, 154, 155, 342, - 180, 25, 25, 78, 25, 25, 25, 26, 149, 150, - 288, 188, 290, 151, 154, 155, 247, 262, 340, 248, - 135, 135, 55, 300, 189, 301, 135, 302, 303, 196, - 249, 305, 259, 25, 307, 167, 143, 263, 144, 269, - 276, 131, 132, 133, 134, 312, 272, 151, 71, 71, - 71, 71, 316, 131, 132, 133, 134, 71, 289, 297, - 304, 71, 71, 18, 71, 25, 309, 25, 25, 139, - 140, 71, 71, 314, 71, 71, 71, 71, 144, 71, - 329, 71, 333, 318, 338, 149, 150, 71, 71, 322, - 151, 4, 5, 6, 7, 323, 18, 331, 339, 18, - 18, 18, 345, 18, 335, 18, 18, 61, 18, 337, - 137, 138, 139, 140, 344, 343, 346, 37, 35, 348, - 143, 13, 18, 145, 146, 147, 148, 18, 149, 150, - 37, 35, 341, 151, 70, 25, 25, 25, 25, 25, - 25, 25, 25, 25, 25, 25, 25, 25, 25, 306, - 164, 0, 25, 25, 18, 25, 25, 25, 0, 0, + 165, 236, 55, 156, 258, 20, 59, 75, 61, 15, + 74, 197, 76, 186, 198, 183, 18, 83, 85, 87, + 156, 84, 86, 88, 90, 89, 193, 200, 260, 195, + 244, 99, 246, 234, 81, 152, 106, 111, 158, 135, + 160, 130, 107, 245, 130, 119, 135, 97, 250, 123, + 252, 197, 152, 110, 198, 13, 135, 135, 130, 130, + 135, 130, 135, 130, 158, 124, 125, 126, 127, 128, + 157, 15, 159, 13, 38, 15, 201, 129, 169, 167, + 171, 170, 173, 172, 175, 174, 77, 177, 291, 15, + 135, 182, 38, 130, 296, 293, 157, 16, 17, 25, + 15, 15, 15, 264, 139, 295, 315, 184, 15, 321, + 190, 336, 308, 273, 82, 16, 17, 310, 194, 311, + 14, 150, 15, 203, 151, 191, 94, 204, 205, 206, + 207, 328, 25, 95, 330, 25, 25, 25, 14, 25, + 15, 25, 25, 16, 25, 135, 135, 162, 233, 96, + 135, 135, 237, 238, 239, 240, 241, 243, 25, 161, + 287, 292, 25, 25, 298, 294, 313, 163, 235, 4, + 5, 6, 7, 347, 135, 261, 135, 139, 140, 326, + 327, 266, 268, 55, 270, 251, 332, 91, 135, 319, + 25, 334, 274, 149, 150, 25, 179, 151, 25, 25, + 25, 180, 25, 19, 25, 25, 55, 25, 320, 185, + 103, 135, 342, 55, 253, 188, 324, 135, 155, 189, + 196, 25, 25, 78, 25, 25, 25, 26, 257, 249, + 288, 135, 290, 153, 154, 155, 131, 132, 133, 134, + 259, 247, 263, 300, 248, 301, 262, 302, 303, 135, + 269, 305, 276, 25, 307, 167, 272, 150, 151, 51, + 151, 143, 51, 144, 289, 312, 130, 130, 130, 130, + 340, 297, 316, 135, 304, 130, 51, 51, 309, 130, + 130, 130, 130, 18, 314, 25, 331, 25, 25, 130, + 130, 318, 130, 130, 130, 130, 322, 130, 130, 323, + 329, 130, 333, 335, 130, 130, 130, 254, 255, 51, + 337, 51, 131, 132, 133, 134, 18, 338, 339, 18, + 18, 18, 343, 18, 35, 18, 18, 61, 18, 345, + 137, 138, 139, 140, 344, 4, 5, 6, 7, 348, + 346, 51, 18, 145, 146, 147, 148, 18, 149, 150, + 37, 143, 151, 13, 37, 25, 25, 25, 25, 25, + 25, 25, 25, 25, 25, 25, 25, 25, 25, 35, + 164, 341, 25, 25, 18, 25, 25, 25, 70, 306, 0, 0, 25, 25, 25, 25, 25, 25, 0, 0, - 25, 0, 143, 0, 144, 25, 0, 0, 153, 0, - 25, 0, 25, 25, 0, 0, 18, 0, 18, 18, - 0, 0, 0, 0, 137, 138, 139, 140, 25, 25, + 25, 0, 0, 0, 0, 25, 139, 140, 0, 25, + 0, 25, 25, 0, 0, 153, 18, 280, 18, 18, + 143, 0, 144, 150, 0, 0, 151, 0, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, - 25, 25, 149, 150, 0, 25, 25, 151, 25, 25, - 25, 0, 0, 0, 0, 25, 25, 25, 25, 25, - 25, 325, 0, 25, 0, 0, 0, 0, 25, 0, - 0, 0, 2, 25, 0, 25, 25, 0, 0, 0, - 136, 143, 0, 144, 137, 138, 139, 140, 0, 0, - 0, 0, 0, 0, 141, 142, 0, 145, 146, 147, - 148, 0, 149, 150, 0, 39, 0, 151, 39, 39, - 39, 0, 39, 0, 39, 39, 0, 39, 0, 0, - 136, 0, 0, 0, 137, 138, 139, 140, 0, 0, - 0, 39, 0, 0, 0, 0, 39, 145, 146, 147, - 148, 0, 149, 150, 0, 0, 0, 151, 0, 18, + 25, 25, 0, 0, 0, 25, 25, 0, 25, 25, + 25, 144, 0, 0, 0, 25, 25, 25, 25, 25, + 25, 0, 0, 25, 137, 138, 139, 140, 25, 0, + 0, 0, 25, 0, 25, 25, 0, 2, 146, 147, + 148, 0, 149, 150, 0, 136, 151, 0, 0, 137, + 138, 139, 140, 0, 51, 51, 51, 51, 0, 141, + 142, 0, 145, 146, 147, 148, 0, 149, 150, 0, + 39, 151, 0, 39, 39, 39, 0, 39, 0, 39, + 39, 0, 39, 0, 137, 138, 139, 140, 0, 0, + 0, 0, 51, 51, 51, 0, 39, 0, 0, 147, + 148, 39, 149, 150, 0, 0, 151, 0, 0, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, - 18, 18, 18, 39, 0, 0, 18, 18, 0, 18, - 18, 18, 143, 0, 144, 0, 18, 18, 18, 18, + 18, 18, 18, 0, 0, 0, 18, 18, 39, 18, + 18, 18, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 0, 0, 18, 0, 0, 0, 0, 18, - 0, 0, 0, 0, 18, 39, 18, 18, 39, 151, - 0, 0, 151, 151, 151, 0, 151, 141, 151, 151, - 141, 151, 0, 0, 0, 0, 136, 0, 0, 0, - 137, 138, 139, 140, 141, 141, 0, 141, 0, 141, - 151, 142, 0, 145, 146, 147, 148, 0, 149, 150, - 0, 0, 0, 151, 113, 114, 115, 116, 117, 0, - 0, 120, 121, 0, 0, 0, 0, 141, 0, 141, - 152, 0, 0, 152, 152, 152, 0, 152, 101, 152, - 152, 101, 152, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 101, 101, 0, 101, 141, - 101, 152, 151, 0, 0, 136, 0, 0, 0, 137, - 138, 139, 140, 0, 0, 0, 0, 0, 0, 141, - 142, 0, 145, 146, 147, 148, 0, 149, 150, 0, - 101, 0, 151, 0, 0, 0, 0, 0, 39, 39, - 39, 39, 39, 39, 0, 143, 0, 144, 39, 39, - 39, 39, 0, 0, 0, 39, 39, 0, 39, 39, - 39, 0, 0, 152, 0, 39, 39, 39, 39, 39, - 39, 0, 0, 39, 0, 0, 0, 0, 39, 0, - 0, 0, 0, 39, 0, 39, 39, 0, 0, 0, - 0, 0, 280, 0, 0, 143, 136, 144, 0, 0, - 137, 138, 139, 140, 0, 0, 137, 138, 139, 140, - 141, 142, 0, 145, 146, 147, 148, 0, 149, 150, - 146, 147, 148, 151, 149, 150, 0, 0, 0, 151, - 0, 0, 0, 151, 151, 151, 151, 151, 0, 0, - 0, 0, 141, 141, 141, 141, 0, 0, 0, 0, - 151, 141, 151, 151, 151, 141, 141, 141, 141, 151, - 151, 151, 151, 151, 151, 141, 141, 151, 141, 141, - 141, 141, 151, 141, 141, 141, 0, 151, 141, 151, - 151, 141, 141, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 152, 152, 152, 152, 152, 0, - 0, 0, 0, 101, 101, 101, 101, 0, 0, 0, - 0, 152, 101, 152, 152, 152, 101, 101, 101, 101, - 152, 152, 152, 152, 152, 152, 101, 101, 152, 101, - 101, 101, 101, 152, 101, 101, 101, 0, 152, 101, - 152, 152, 101, 101, 44, 0, 0, 55, 57, 54, - 0, 49, 0, 58, 52, 0, 51, 0, 0, 136, - 0, 0, 0, 137, 138, 139, 140, 0, 0, 0, - 50, 0, 0, 0, 0, 56, 145, 146, 147, 148, - 0, 149, 150, 0, 0, 0, 151, 0, 0, 137, - 138, 139, 140, 0, 39, 0, 0, 39, 39, 39, - 0, 39, 53, 39, 39, 148, 39, 149, 150, 136, - 0, 0, 151, 137, 138, 139, 140, 0, 0, 0, - 39, 0, 0, 141, 142, 39, 145, 146, 147, 148, - 0, 149, 150, 0, 15, 0, 151, 45, 0, 0, - 0, 0, 0, 0, 44, 81, 0, 55, 57, 54, - 0, 49, 39, 58, 52, 0, 51, 0, 97, 0, - 0, 0, 0, 0, 110, 81, 0, 0, 81, 0, - 105, 0, 0, 0, 0, 56, 124, 125, 126, 127, - 128, 0, 81, 81, 39, 0, 0, 39, 0, 0, + 0, 0, 0, 18, 0, 18, 18, 0, 0, 0, + 39, 151, 0, 39, 151, 151, 151, 0, 151, 141, + 151, 151, 141, 151, 113, 114, 115, 116, 117, 0, + 0, 120, 121, 0, 0, 0, 141, 141, 0, 141, + 0, 141, 151, 0, 136, 0, 0, 0, 137, 138, + 139, 140, 0, 0, 0, 0, 0, 0, 141, 142, + 0, 145, 146, 147, 148, 84, 149, 150, 84, 141, + 151, 141, 0, 136, 0, 0, 0, 137, 138, 139, + 140, 0, 84, 84, 0, 84, 0, 84, 0, 0, + 145, 146, 147, 148, 0, 149, 150, 0, 0, 151, + 0, 141, 152, 0, 151, 152, 152, 152, 0, 152, + 101, 152, 152, 101, 152, 0, 0, 84, 137, 138, + 139, 140, 0, 0, 0, 0, 0, 101, 101, 0, + 101, 0, 101, 152, 148, 0, 149, 150, 0, 0, + 151, 0, 0, 39, 39, 39, 39, 39, 39, 0, + 0, 0, 0, 39, 39, 39, 39, 0, 0, 0, + 39, 39, 101, 39, 39, 39, 0, 0, 0, 0, + 39, 39, 39, 39, 39, 39, 0, 0, 39, 325, + 0, 0, 0, 39, 0, 0, 0, 39, 0, 39, + 39, 137, 138, 139, 140, 152, 0, 0, 0, 143, + 0, 144, 0, 0, 0, 0, 0, 0, 0, 149, + 150, 0, 0, 151, 0, 0, 0, 0, 0, 44, + 0, 0, 55, 57, 54, 0, 49, 0, 58, 52, + 0, 51, 0, 0, 0, 151, 151, 151, 151, 151, + 0, 0, 0, 0, 141, 141, 141, 141, 0, 0, + 56, 0, 151, 141, 151, 151, 151, 141, 141, 141, + 141, 151, 151, 151, 151, 151, 151, 141, 141, 151, + 141, 141, 141, 141, 151, 141, 141, 53, 151, 141, + 151, 151, 141, 141, 141, 0, 0, 0, 0, 0, + 84, 84, 84, 84, 143, 0, 144, 0, 0, 84, + 0, 0, 0, 84, 84, 84, 84, 0, 0, 15, + 0, 0, 45, 84, 84, 0, 84, 84, 84, 84, + 0, 84, 84, 0, 0, 84, 152, 152, 152, 152, + 152, 0, 0, 0, 0, 101, 101, 101, 101, 0, + 0, 0, 0, 152, 101, 152, 152, 152, 101, 101, + 101, 101, 152, 152, 152, 152, 152, 152, 101, 101, + 152, 101, 101, 101, 101, 152, 101, 101, 0, 152, + 101, 152, 152, 101, 101, 101, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 137, 0, 139, 140, 0, + 44, 0, 0, 55, 57, 54, 0, 49, 0, 58, + 52, 0, 51, 149, 150, 0, 0, 151, 0, 0, + 0, 0, 0, 136, 0, 0, 50, 137, 138, 139, + 140, 56, 0, 0, 0, 0, 0, 141, 142, 0, + 145, 146, 147, 148, 0, 149, 150, 0, 0, 151, + 0, 0, 0, 22, 23, 24, 25, 26, 53, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 44, 0, 53, 55, 57, 54, 0, 49, 118, 58, - 52, 80, 51, 0, 0, 81, 0, 81, 184, 92, - 0, 0, 0, 0, 80, 101, 0, 104, 0, 194, - 0, 56, 0, 0, 15, 0, 0, 45, 0, 0, - 0, 0, 80, 80, 80, 80, 80, 81, 0, 0, - 44, 0, 0, 55, 57, 54, 0, 49, 53, 58, - 52, 0, 51, 0, 0, 0, 0, 21, 22, 23, - 24, 25, 26, 0, 0, 0, 0, 27, 28, 29, - 30, 56, 0, 0, 31, 32, 0, 33, 34, 35, - 15, 187, 0, 45, 36, 37, 38, 39, 40, 41, - 0, 0, 42, 0, 0, 0, 0, 43, 53, 0, - 122, 0, 46, 0, 47, 48, 0, 39, 39, 39, - 39, 39, 39, 0, 0, 0, 0, 39, 39, 39, - 39, 0, 0, 0, 39, 39, 0, 39, 39, 39, - 15, 0, 0, 45, 39, 39, 39, 39, 39, 39, - 0, 0, 39, 0, 0, 0, 0, 39, 0, 0, - 0, 0, 39, 0, 39, 39, 0, 0, 22, 23, - 24, 25, 26, 0, 44, 0, 0, 55, 57, 54, - 0, 49, 0, 58, 52, 32, 51, 33, 34, 35, - 81, 81, 81, 81, 36, 37, 38, 39, 40, 41, - 0, 0, 42, 0, 0, 56, 0, 43, 0, 0, - 0, 0, 46, 81, 47, 48, 0, 0, 0, 137, - 138, 139, 140, 81, 22, 23, 24, 25, 26, 81, - 81, 0, 53, 0, 147, 148, 0, 149, 150, 0, - 0, 32, 151, 33, 34, 35, 0, 0, 0, 0, - 36, 37, 38, 39, 40, 41, 0, 0, 42, 0, - 0, 0, 0, 43, 15, 0, 0, 45, 46, 0, - 47, 48, 0, 0, 22, 23, 24, 25, 26, 0, - 44, 0, 0, 55, 57, 54, 0, 49, 181, 58, - 52, 32, 51, 33, 34, 35, 0, 0, 0, 0, + 32, 0, 33, 34, 35, 143, 0, 144, 0, 36, + 37, 38, 39, 40, 41, 0, 0, 42, 0, 0, + 15, 0, 43, 45, 0, 0, 46, 0, 47, 48, + 39, 0, 163, 39, 39, 39, 0, 39, 0, 39, + 39, 0, 39, 0, 0, 0, 0, 0, 136, 0, + 0, 0, 137, 138, 139, 140, 39, 0, 0, 0, + 0, 39, 141, 142, 0, 145, 146, 147, 148, 80, + 149, 150, 0, 0, 151, 0, 0, 92, 0, 0, + 0, 0, 80, 101, 0, 104, 44, 0, 39, 55, + 57, 54, 0, 49, 0, 58, 52, 0, 51, 0, + 80, 80, 80, 80, 80, 0, 0, 0, 0, 0, + 0, 0, 105, 0, 0, 0, 0, 56, 0, 0, + 39, 0, 0, 39, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 44, 0, + 0, 55, 57, 54, 53, 49, 118, 58, 52, 187, + 51, 0, 0, 21, 22, 23, 24, 25, 26, 0, + 0, 0, 0, 27, 28, 29, 30, 0, 0, 56, + 31, 32, 0, 33, 34, 35, 15, 0, 0, 45, 36, 37, 38, 39, 40, 41, 0, 0, 42, 0, - 0, 56, 0, 43, 0, 0, 0, 0, 46, 0, - 47, 48, 0, 0, 0, 0, 0, 0, 0, 0, - 44, 0, 0, 55, 57, 54, 0, 49, 53, 58, - 52, 0, 51, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 43, 0, 0, 53, 46, 0, 47, + 48, 44, 0, 0, 55, 57, 54, 0, 49, 0, + 58, 52, 0, 51, 0, 0, 0, 0, 0, 136, + 0, 0, 0, 137, 138, 139, 140, 0, 15, 0, + 0, 45, 56, 0, 142, 0, 145, 146, 147, 148, + 0, 149, 150, 0, 0, 151, 0, 0, 0, 0, + 0, 0, 0, 39, 39, 39, 39, 39, 39, 53, + 0, 122, 0, 39, 39, 39, 39, 0, 0, 0, + 39, 39, 0, 39, 39, 39, 0, 0, 0, 0, + 39, 39, 39, 39, 39, 39, 0, 0, 39, 0, + 0, 15, 0, 39, 45, 0, 0, 39, 0, 39, + 39, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 22, 23, 24, 25, 26, 143, 44, 144, 0, 55, + 57, 54, 0, 49, 0, 58, 52, 32, 51, 33, + 34, 35, 0, 0, 0, 0, 36, 37, 38, 39, + 40, 41, 0, 0, 42, 0, 0, 56, 0, 43, + 0, 0, 0, 46, 0, 47, 48, 0, 0, 0, + 0, 0, 22, 23, 24, 25, 26, 0, 0, 0, + 0, 0, 0, 0, 53, 0, 0, 0, 0, 32, + 0, 33, 34, 35, 0, 0, 0, 0, 36, 37, + 38, 39, 40, 41, 0, 0, 42, 0, 0, 0, + 0, 43, 0, 0, 0, 46, 15, 47, 48, 45, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 56, 0, 0, 50, 0, 0, 50, 0, 0, - 15, 0, 0, 45, 0, 0, 0, 0, 0, 0, - 44, 50, 50, 55, 57, 54, 0, 49, 53, 58, - 52, 0, 51, 0, 0, 0, 0, 21, 22, 23, - 24, 25, 26, 0, 0, 0, 0, 0, 212, 0, - 0, 56, 0, 0, 50, 32, 50, 33, 34, 35, - 15, 0, 0, 45, 36, 37, 38, 39, 40, 41, - 0, 0, 42, 0, 0, 0, 0, 43, 53, 0, - 0, 0, 46, 0, 47, 48, 50, 0, 0, 0, - 0, 44, 0, 0, 55, 57, 54, 0, 49, 0, - 58, 52, 0, 51, 0, 0, 0, 0, 0, 0, - 15, 0, 0, 45, 0, 0, 0, 0, 0, 214, - 0, 0, 56, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 22, 23, 24, 25, 26, + 0, 44, 0, 0, 55, 57, 54, 0, 49, 181, + 58, 52, 32, 51, 33, 34, 35, 0, 0, 0, + 0, 36, 37, 38, 39, 40, 41, 0, 0, 42, + 0, 0, 56, 0, 43, 0, 0, 0, 46, 0, + 47, 48, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 44, 0, 53, + 55, 57, 54, 0, 49, 0, 58, 52, 0, 51, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 22, 23, 24, 25, 26, 53, + 0, 0, 0, 0, 0, 212, 0, 0, 56, 0, + 0, 15, 0, 0, 45, 0, 0, 0, 0, 136, + 0, 0, 0, 137, 138, 139, 140, 0, 0, 21, + 22, 23, 24, 25, 26, 53, 145, 146, 147, 148, + 0, 149, 150, 0, 0, 151, 0, 32, 0, 33, + 34, 35, 0, 0, 0, 0, 36, 37, 38, 39, + 40, 41, 0, 0, 42, 0, 0, 15, 0, 43, + 45, 0, 0, 46, 0, 47, 48, 44, 0, 0, + 55, 57, 54, 0, 49, 0, 58, 52, 0, 51, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 32, 0, 33, 34, 35, 0, 0, 0, 0, - 36, 37, 38, 39, 40, 41, 0, 0, 42, 0, - 0, 15, 0, 43, 45, 0, 0, 0, 46, 0, - 47, 48, 0, 0, 22, 23, 24, 25, 26, 0, + 0, 0, 0, 0, 0, 214, 0, 0, 56, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 32, 0, 33, 34, 35, 0, 0, 0, 0, - 36, 37, 38, 39, 40, 41, 0, 0, 42, 50, - 50, 50, 50, 43, 0, 0, 163, 0, 46, 0, - 47, 48, 0, 0, 22, 23, 24, 25, 26, 0, - 0, 0, 50, 50, 0, 0, 0, 0, 0, 0, - 0, 32, 50, 33, 34, 35, 0, 0, 50, 50, - 36, 37, 38, 39, 40, 41, 0, 0, 42, 0, - 0, 0, 0, 43, 0, 0, 0, 0, 46, 0, - 47, 48, 44, 0, 0, 55, 57, 54, 0, 49, - 0, 58, 52, 0, 51, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 44, 0, 0, 55, 57, 54, + 0, 49, 0, 58, 52, 53, 51, 0, 0, 0, 0, 0, 0, 0, 0, 22, 23, 24, 25, 26, - 220, 0, 0, 56, 0, 0, 0, 0, 0, 0, - 0, 0, 32, 0, 33, 34, 35, 0, 0, 0, - 0, 36, 37, 38, 39, 40, 41, 0, 44, 42, - 53, 55, 57, 54, 43, 49, 0, 58, 52, 46, - 51, 47, 48, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 222, 0, 0, 56, - 0, 0, 15, 0, 0, 45, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 44, 0, - 0, 55, 57, 54, 0, 49, 53, 58, 52, 0, - 51, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 224, 0, 0, 56, - 0, 0, 0, 0, 0, 0, 0, 0, 15, 0, - 0, 45, 0, 0, 0, 0, 0, 0, 44, 0, - 0, 55, 57, 54, 0, 49, 53, 58, 52, 0, + 0, 0, 220, 0, 0, 56, 0, 0, 0, 0, + 0, 0, 32, 0, 33, 34, 35, 15, 0, 0, + 45, 36, 37, 38, 39, 40, 41, 0, 0, 42, + 0, 0, 53, 0, 43, 0, 0, 0, 46, 77, + 47, 48, 77, 0, 0, 0, 0, 0, 0, 0, + 0, 22, 23, 24, 25, 26, 77, 77, 0, 77, + 0, 77, 0, 0, 15, 0, 0, 45, 32, 0, + 33, 34, 35, 0, 0, 0, 0, 36, 37, 38, + 39, 40, 41, 0, 0, 42, 0, 0, 0, 77, + 43, 77, 0, 0, 46, 0, 47, 48, 44, 0, + 0, 55, 57, 54, 0, 49, 0, 58, 52, 0, 51, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 226, 0, 0, 56, - 0, 0, 0, 0, 0, 0, 0, 0, 15, 0, - 0, 45, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 53, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 22, 23, 24, 25, - 26, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 32, 0, 33, 34, 35, 15, 0, - 0, 45, 36, 37, 38, 39, 40, 41, 0, 0, - 42, 0, 0, 0, 0, 43, 0, 0, 0, 0, - 46, 0, 47, 48, 0, 0, 0, 0, 0, 0, - 0, 0, 22, 23, 24, 25, 26, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 32, - 0, 33, 34, 35, 0, 0, 0, 0, 36, 37, + 0, 77, 0, 0, 0, 0, 222, 0, 0, 56, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 22, 23, 24, 25, 26, 53, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 32, 0, + 33, 34, 35, 0, 0, 0, 0, 36, 37, 38, + 39, 40, 41, 0, 0, 42, 0, 0, 15, 0, + 43, 45, 0, 0, 46, 0, 47, 48, 22, 23, + 24, 25, 26, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 32, 0, 33, 34, 35, + 0, 0, 0, 0, 36, 37, 38, 39, 40, 41, + 0, 0, 42, 0, 0, 0, 0, 43, 0, 0, + 0, 46, 44, 47, 48, 55, 57, 54, 0, 49, + 0, 58, 52, 0, 51, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 77, 77, 77, 77, 0, 0, + 224, 0, 0, 56, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 77, 77, 44, + 0, 0, 55, 57, 54, 0, 49, 0, 58, 52, + 53, 51, 77, 77, 77, 0, 0, 0, 0, 0, + 131, 0, 0, 131, 0, 0, 0, 226, 0, 0, + 56, 0, 22, 23, 24, 25, 26, 131, 131, 0, + 0, 0, 15, 0, 0, 45, 0, 0, 0, 32, + 0, 33, 34, 35, 0, 0, 0, 53, 36, 37, 38, 39, 40, 41, 0, 0, 42, 0, 0, 0, - 0, 43, 0, 0, 0, 0, 46, 0, 47, 48, - 0, 0, 22, 23, 24, 25, 26, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 32, - 0, 33, 34, 35, 0, 0, 0, 0, 36, 37, - 38, 39, 40, 41, 0, 44, 42, 0, 55, 57, - 54, 43, 49, 0, 58, 52, 46, 51, 47, 48, - 0, 0, 22, 23, 24, 25, 26, 0, 0, 0, - 0, 0, 0, 228, 0, 0, 56, 0, 0, 32, - 0, 33, 34, 35, 0, 0, 0, 0, 36, 37, - 38, 39, 40, 41, 0, 44, 42, 0, 55, 57, - 54, 43, 49, 53, 58, 52, 46, 51, 47, 48, + 131, 43, 131, 0, 0, 46, 44, 47, 48, 55, + 57, 54, 0, 49, 0, 58, 52, 0, 51, 15, + 0, 0, 45, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 131, 0, 228, 0, 0, 56, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 231, 0, 0, 56, 0, 0, 0, - 0, 0, 0, 0, 0, 15, 0, 0, 45, 0, - 0, 0, 0, 0, 0, 0, 0, 44, 0, 0, - 55, 57, 54, 53, 49, 242, 58, 52, 0, 51, + 0, 0, 0, 44, 0, 0, 55, 57, 54, 0, + 49, 0, 58, 52, 53, 51, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 231, 0, 0, 56, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 15, 0, 0, 45, + 0, 0, 0, 0, 0, 0, 22, 23, 24, 25, + 26, 53, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 32, 0, 33, 34, 35, 0, 0, + 0, 0, 36, 37, 38, 39, 40, 41, 0, 0, + 42, 0, 0, 15, 0, 43, 45, 0, 0, 46, + 0, 47, 48, 22, 23, 24, 25, 26, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 32, 0, 33, 34, 35, 131, 131, 131, 131, 36, + 37, 38, 39, 40, 41, 0, 0, 42, 0, 0, + 0, 0, 43, 0, 0, 0, 46, 44, 47, 48, + 55, 57, 54, 0, 49, 242, 58, 52, 0, 51, + 0, 0, 0, 131, 131, 131, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 56, 0, - 0, 0, 0, 0, 0, 15, 0, 0, 45, 0, + 22, 23, 24, 25, 26, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 32, 0, 33, + 34, 35, 0, 0, 0, 53, 36, 37, 38, 39, + 40, 41, 0, 0, 42, 0, 0, 0, 0, 43, + 0, 0, 0, 46, 0, 47, 48, 22, 23, 24, + 25, 26, 0, 0, 0, 0, 0, 15, 0, 0, + 45, 0, 0, 0, 32, 0, 33, 34, 35, 0, + 0, 0, 0, 36, 37, 38, 39, 40, 41, 0, + 0, 42, 0, 0, 0, 0, 43, 0, 0, 0, + 46, 44, 47, 48, 55, 57, 54, 0, 49, 265, + 58, 52, 0, 51, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 53, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 44, 0, 0, 55, - 57, 54, 0, 49, 265, 58, 52, 0, 51, 0, - 0, 0, 0, 0, 0, 0, 0, 15, 0, 0, - 45, 0, 0, 0, 0, 0, 0, 56, 0, 0, + 0, 0, 56, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 44, 0, + 0, 55, 57, 54, 0, 49, 267, 58, 52, 53, + 51, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 56, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 22, - 23, 24, 25, 26, 53, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 32, 0, 33, 34, - 35, 0, 0, 0, 0, 36, 37, 38, 39, 40, - 41, 0, 0, 42, 0, 0, 15, 0, 43, 45, - 0, 0, 0, 46, 0, 47, 48, 0, 0, 22, - 23, 24, 25, 26, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 32, 0, 33, 34, - 35, 0, 0, 0, 0, 36, 37, 38, 39, 40, - 41, 0, 0, 42, 0, 0, 0, 0, 43, 0, - 0, 0, 0, 46, 0, 47, 48, 0, 0, 0, - 0, 22, 23, 24, 25, 26, 82, 0, 0, 82, - 0, 0, 0, 0, 0, 0, 0, 0, 32, 0, - 33, 34, 35, 82, 82, 0, 82, 36, 37, 38, - 39, 40, 41, 0, 44, 42, 0, 55, 57, 54, - 43, 49, 267, 58, 52, 46, 51, 47, 48, 0, + 0, 15, 0, 0, 45, 0, 0, 0, 0, 0, + 0, 22, 23, 24, 25, 26, 53, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 82, 0, 32, 82, + 33, 34, 35, 0, 0, 0, 0, 36, 37, 38, + 39, 40, 41, 82, 82, 42, 82, 0, 15, 0, + 43, 45, 0, 0, 46, 44, 47, 48, 55, 57, + 54, 0, 49, 0, 58, 52, 0, 51, 0, 0, 0, 0, 0, 0, 0, 0, 82, 0, 82, 0, - 0, 0, 0, 0, 0, 56, 0, 0, 0, 0, - 22, 23, 24, 25, 26, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 32, 82, 33, - 34, 35, 53, 0, 0, 0, 36, 37, 38, 39, - 40, 41, 0, 44, 42, 0, 55, 57, 54, 43, - 49, 0, 58, 52, 46, 51, 47, 48, 0, 0, - 0, 0, 0, 0, 15, 0, 0, 45, 0, 271, - 0, 0, 0, 0, 56, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 44, 0, 0, 55, 57, - 54, 53, 49, 275, 58, 52, 0, 51, 0, 0, + 0, 271, 0, 0, 0, 0, 56, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 56, 0, 0, 0, - 0, 0, 0, 15, 0, 0, 45, 0, 0, 0, - 0, 0, 0, 0, 0, 44, 0, 0, 55, 57, - 54, 0, 49, 53, 58, 52, 0, 51, 0, 0, + 0, 0, 44, 0, 0, 55, 57, 54, 82, 49, + 275, 58, 52, 53, 51, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 82, 82, 82, 82, 0, 56, 0, 0, 0, + 0, 0, 0, 56, 0, 22, 23, 24, 25, 26, 0, 0, 0, 0, 0, 15, 0, 0, 45, 0, - 0, 0, 0, 0, 82, 82, 0, 0, 22, 23, - 24, 25, 26, 53, 82, 277, 0, 0, 0, 0, - 82, 82, 0, 0, 0, 32, 0, 33, 34, 35, - 0, 0, 0, 0, 36, 37, 38, 39, 40, 41, - 0, 0, 42, 0, 0, 15, 0, 43, 45, 0, - 0, 0, 46, 0, 47, 48, 0, 0, 0, 0, - 0, 44, 0, 0, 55, 57, 54, 0, 49, 0, - 58, 52, 0, 51, 0, 0, 0, 22, 23, 24, - 25, 26, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 56, 0, 32, 0, 33, 34, 35, 0, - 0, 0, 0, 36, 37, 38, 39, 40, 41, 0, - 0, 42, 0, 0, 0, 0, 43, 0, 0, 53, - 0, 46, 0, 47, 48, 0, 0, 0, 0, 22, - 23, 24, 25, 26, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 32, 0, 33, 34, - 35, 15, 0, 0, 45, 36, 37, 38, 39, 40, - 41, 0, 44, 42, 0, 55, 57, 54, 43, 49, - 0, 58, 52, 46, 51, 47, 48, 0, 0, 22, - 23, 24, 25, 26, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 56, 0, 0, 32, 0, 33, 34, - 35, 0, 0, 0, 0, 36, 37, 38, 39, 40, - 41, 130, 0, 42, 130, 0, 0, 0, 43, 0, - 53, 0, 0, 46, 0, 47, 48, 0, 130, 130, - 0, 130, 0, 130, 0, 0, 0, 0, 0, 0, + 0, 0, 32, 0, 33, 34, 35, 0, 0, 0, + 53, 36, 37, 38, 39, 40, 41, 0, 0, 42, + 0, 0, 0, 0, 43, 0, 0, 0, 46, 0, + 47, 48, 22, 23, 24, 25, 26, 0, 0, 0, + 0, 0, 15, 0, 0, 45, 0, 0, 0, 32, + 0, 33, 34, 35, 0, 0, 0, 0, 36, 37, + 38, 39, 40, 41, 0, 0, 42, 0, 0, 0, + 0, 43, 0, 0, 0, 46, 44, 47, 48, 55, + 57, 54, 0, 49, 0, 58, 52, 0, 51, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 15, 0, 0, 45, 0, 135, 0, 0, - 135, 130, 0, 130, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 135, 135, 0, 135, 0, 135, - 0, 0, 0, 0, 0, 98, 23, 24, 25, 26, - 0, 0, 0, 130, 0, 0, 0, 0, 0, 0, - 119, 0, 32, 119, 33, 34, 35, 135, 0, 135, - 0, 36, 37, 38, 39, 40, 41, 119, 119, 42, - 119, 0, 119, 0, 43, 0, 0, 0, 0, 46, - 0, 47, 48, 0, 0, 0, 0, 0, 0, 135, - 0, 141, 0, 0, 141, 0, 0, 0, 0, 0, - 119, 0, 119, 0, 0, 0, 0, 0, 141, 141, - 0, 141, 0, 141, 0, 0, 0, 0, 0, 0, + 0, 82, 82, 82, 82, 0, 0, 56, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 119, 0, 0, 0, 22, 23, 24, 25, - 26, 141, 0, 141, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 32, 144, 33, 34, 35, 0, 0, + 0, 0, 0, 0, 82, 82, 0, 0, 0, 22, + 23, 24, 25, 26, 53, 0, 277, 0, 0, 82, + 82, 82, 0, 0, 0, 0, 32, 0, 33, 34, + 35, 0, 0, 0, 0, 36, 37, 38, 39, 40, + 41, 0, 0, 42, 0, 0, 15, 0, 43, 45, + 0, 0, 46, 0, 47, 48, 22, 23, 24, 25, + 26, 0, 44, 0, 0, 55, 57, 54, 0, 49, + 0, 58, 52, 32, 51, 33, 34, 35, 0, 0, 0, 0, 36, 37, 38, 39, 40, 41, 0, 0, - 42, 144, 144, 141, 144, 43, 144, 0, 0, 0, - 46, 0, 47, 48, 0, 0, 130, 130, 130, 130, - 0, 0, 0, 0, 0, 130, 0, 0, 0, 130, - 130, 130, 130, 0, 144, 0, 144, 0, 0, 130, - 130, 0, 130, 130, 130, 130, 0, 130, 130, 130, - 0, 0, 130, 0, 0, 130, 130, 0, 0, 0, - 0, 0, 135, 135, 135, 135, 144, 0, 0, 0, - 0, 135, 0, 0, 0, 135, 135, 135, 135, 0, - 0, 0, 0, 0, 0, 135, 135, 0, 135, 135, - 135, 135, 0, 135, 135, 135, 0, 0, 135, 0, - 0, 135, 135, 0, 0, 119, 119, 119, 119, 0, - 0, 0, 0, 0, 119, 0, 0, 0, 119, 119, - 119, 119, 0, 0, 0, 0, 0, 0, 119, 119, - 0, 119, 119, 119, 119, 0, 119, 119, 119, 0, - 0, 119, 0, 0, 119, 119, 141, 141, 141, 141, - 0, 0, 0, 0, 0, 141, 0, 0, 0, 141, - 141, 141, 141, 0, 0, 0, 0, 0, 0, 141, - 141, 0, 141, 141, 141, 141, 0, 141, 141, 141, - 0, 0, 141, 0, 0, 141, 141, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 96, - 0, 0, 96, 0, 0, 0, 0, 0, 0, 144, - 144, 144, 144, 0, 0, 0, 96, 96, 144, 96, - 0, 96, 144, 144, 144, 144, 0, 0, 0, 0, - 0, 0, 144, 144, 0, 144, 144, 144, 144, 0, - 144, 144, 144, 95, 0, 144, 95, 0, 144, 144, - 0, 96, 0, 0, 0, 0, 0, 0, 0, 0, - 95, 95, 0, 95, 0, 95, 0, 0, 0, 0, + 42, 0, 0, 56, 0, 43, 0, 0, 0, 46, + 0, 47, 48, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 44, 0, 0, 55, 57, 54, 0, 49, + 53, 58, 52, 0, 51, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 96, 0, 0, 83, 0, 0, 83, 0, 0, - 0, 0, 0, 0, 0, 95, 0, 0, 0, 0, - 0, 83, 83, 0, 83, 0, 83, 0, 0, 0, + 0, 0, 0, 56, 0, 0, 135, 0, 0, 135, + 0, 0, 15, 0, 0, 45, 0, 0, 0, 0, + 0, 0, 0, 135, 135, 0, 135, 0, 135, 0, + 53, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 22, 23, 24, 25, 26, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 135, 32, 135, 33, + 34, 35, 15, 0, 0, 45, 36, 37, 38, 39, + 40, 41, 119, 0, 42, 119, 0, 0, 0, 43, + 0, 0, 0, 46, 0, 47, 48, 0, 135, 119, + 119, 0, 119, 0, 119, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 95, 69, 0, 0, 69, - 0, 0, 0, 0, 83, 0, 83, 0, 0, 0, - 0, 0, 0, 69, 69, 0, 69, 0, 69, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 83, 143, 0, 0, - 143, 0, 0, 0, 0, 0, 69, 0, 69, 0, - 0, 0, 0, 0, 143, 143, 0, 143, 0, 143, + 0, 0, 119, 0, 119, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 141, 0, + 0, 141, 0, 0, 0, 0, 22, 23, 24, 25, + 26, 0, 0, 0, 119, 141, 141, 0, 141, 0, + 141, 0, 0, 32, 0, 33, 34, 35, 0, 0, + 0, 0, 36, 37, 38, 39, 40, 41, 0, 0, + 42, 0, 0, 0, 0, 43, 144, 0, 141, 46, + 141, 47, 48, 0, 0, 0, 98, 23, 24, 25, + 26, 0, 0, 144, 144, 0, 144, 0, 144, 0, + 0, 0, 0, 32, 0, 33, 34, 35, 0, 0, + 141, 0, 36, 37, 38, 39, 40, 41, 0, 0, + 42, 135, 135, 135, 135, 43, 144, 0, 144, 46, + 135, 47, 48, 0, 135, 135, 135, 135, 0, 0, + 0, 0, 0, 0, 135, 135, 0, 135, 135, 135, + 135, 0, 135, 135, 96, 0, 135, 96, 144, 135, + 135, 135, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 96, 96, 0, 96, 0, 96, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 119, 119, 119, + 119, 0, 0, 0, 0, 0, 119, 0, 0, 0, + 119, 119, 119, 119, 0, 0, 96, 0, 0, 0, + 119, 119, 0, 119, 119, 119, 119, 0, 119, 119, + 0, 0, 119, 0, 0, 119, 119, 119, 0, 0, + 0, 0, 0, 0, 0, 0, 96, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 69, 0, - 0, 0, 0, 0, 132, 0, 0, 132, 0, 143, - 0, 0, 0, 0, 96, 96, 96, 96, 0, 0, - 0, 132, 132, 96, 132, 0, 132, 96, 96, 96, - 96, 0, 0, 0, 0, 0, 0, 96, 96, 0, - 96, 96, 96, 96, 0, 96, 96, 96, 0, 0, - 96, 0, 0, 96, 96, 0, 132, 0, 95, 95, - 95, 95, 0, 0, 0, 0, 0, 95, 0, 0, - 0, 95, 95, 95, 95, 0, 0, 0, 0, 0, - 0, 95, 95, 0, 95, 95, 95, 95, 0, 95, - 95, 95, 0, 0, 95, 0, 0, 95, 95, 83, - 83, 83, 83, 0, 0, 0, 0, 0, 83, 0, - 0, 0, 83, 83, 83, 83, 0, 0, 0, 0, - 0, 0, 83, 83, 0, 83, 83, 83, 83, 0, - 83, 83, 83, 0, 0, 0, 0, 0, 83, 83, - 0, 69, 69, 69, 69, 0, 0, 0, 0, 0, - 69, 0, 0, 0, 69, 69, 69, 69, 0, 0, - 0, 0, 0, 0, 69, 69, 0, 69, 69, 69, - 69, 0, 69, 69, 69, 0, 0, 0, 0, 0, - 69, 69, 143, 143, 143, 143, 0, 0, 0, 0, - 0, 143, 0, 0, 0, 143, 143, 143, 143, 0, - 0, 0, 0, 0, 0, 143, 143, 0, 143, 143, - 143, 143, 0, 143, 143, 143, 0, 0, 143, 0, - 0, 143, 143, 0, 0, 0, 0, 0, 0, 132, - 132, 132, 132, 0, 0, 0, 0, 0, 132, 0, - 0, 0, 132, 132, 132, 132, 0, 0, 0, 0, - 0, 0, 132, 132, 0, 132, 132, 132, 132, 0, - 132, 132, 132, 107, 0, 132, 107, 0, 132, 132, + 0, 0, 0, 141, 141, 141, 141, 0, 0, 0, + 0, 0, 141, 0, 0, 0, 141, 141, 141, 141, + 0, 0, 0, 0, 0, 0, 141, 141, 0, 141, + 141, 141, 141, 0, 141, 141, 0, 0, 141, 0, + 0, 141, 141, 141, 0, 0, 0, 0, 0, 0, + 0, 144, 144, 144, 144, 0, 0, 0, 0, 0, + 144, 0, 0, 0, 144, 144, 144, 144, 0, 0, + 0, 0, 0, 0, 144, 144, 0, 144, 144, 144, + 144, 95, 144, 144, 95, 0, 144, 0, 0, 144, + 144, 144, 0, 0, 0, 0, 0, 0, 95, 95, + 0, 95, 0, 95, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 96, + 96, 96, 96, 95, 0, 0, 0, 0, 96, 0, + 0, 0, 96, 96, 96, 96, 0, 0, 0, 0, + 0, 0, 96, 96, 0, 96, 96, 96, 96, 83, + 96, 96, 83, 95, 96, 0, 0, 96, 96, 96, + 0, 0, 0, 0, 0, 0, 83, 83, 0, 83, + 0, 83, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 107, 107, 0, 107, 0, 107, 0, 0, 0, 0, + 69, 0, 0, 69, 0, 0, 0, 0, 0, 83, + 0, 83, 0, 0, 0, 0, 0, 69, 69, 0, + 69, 0, 69, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 101, 0, 0, 101, 0, 0, - 0, 0, 0, 0, 0, 107, 0, 0, 0, 0, - 0, 101, 101, 0, 101, 0, 101, 0, 0, 0, + 0, 83, 143, 0, 0, 143, 0, 0, 0, 0, + 69, 0, 69, 0, 0, 0, 0, 0, 0, 143, + 143, 0, 143, 0, 143, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 70, 0, 0, 70, 0, - 0, 0, 0, 0, 0, 0, 101, 0, 0, 0, - 0, 0, 70, 70, 0, 70, 0, 70, 0, 0, + 0, 0, 69, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 143, 0, 132, 0, 0, 132, + 0, 0, 0, 0, 0, 0, 95, 95, 95, 95, + 0, 0, 0, 132, 132, 95, 132, 0, 132, 95, + 95, 95, 95, 0, 0, 0, 0, 0, 0, 95, + 95, 0, 95, 95, 95, 95, 0, 95, 95, 107, + 0, 95, 107, 0, 95, 95, 95, 0, 132, 0, + 0, 0, 0, 0, 0, 0, 107, 107, 0, 107, + 0, 107, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 143, 0, 0, 143, - 0, 0, 0, 0, 0, 70, 0, 70, 0, 0, - 0, 0, 0, 143, 143, 0, 143, 0, 143, 0, + 0, 0, 0, 0, 83, 83, 83, 83, 0, 0, + 0, 107, 0, 83, 0, 0, 0, 83, 83, 83, + 83, 0, 0, 0, 0, 0, 0, 83, 83, 0, + 83, 83, 83, 83, 0, 83, 83, 0, 0, 0, + 0, 0, 83, 83, 83, 69, 69, 69, 69, 0, + 0, 0, 0, 0, 69, 0, 0, 0, 69, 69, + 69, 69, 0, 0, 0, 0, 0, 0, 69, 69, + 0, 69, 69, 69, 69, 0, 69, 69, 0, 0, + 0, 0, 0, 69, 69, 69, 0, 143, 143, 143, + 143, 0, 0, 0, 0, 0, 143, 0, 0, 0, + 143, 143, 143, 143, 0, 0, 0, 0, 0, 0, + 143, 143, 0, 143, 143, 143, 143, 0, 143, 143, + 0, 0, 143, 0, 0, 143, 143, 143, 0, 0, + 0, 101, 0, 0, 101, 0, 0, 0, 0, 0, + 0, 132, 132, 132, 132, 0, 0, 0, 101, 101, + 132, 101, 0, 101, 132, 132, 132, 132, 0, 0, + 0, 0, 0, 0, 132, 132, 0, 132, 132, 132, + 132, 0, 132, 132, 0, 0, 132, 0, 0, 132, + 132, 132, 0, 101, 107, 107, 107, 107, 0, 0, + 0, 0, 0, 107, 0, 0, 0, 107, 107, 107, + 107, 0, 0, 0, 0, 0, 0, 107, 107, 0, + 107, 107, 107, 107, 70, 107, 107, 70, 0, 107, + 0, 0, 107, 107, 107, 0, 0, 0, 0, 0, + 0, 70, 70, 0, 70, 0, 70, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 70, 72, 0, - 0, 72, 0, 0, 0, 0, 0, 0, 143, 0, - 0, 0, 0, 0, 0, 72, 72, 0, 72, 0, - 72, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 71, 0, 0, 71, 0, + 0, 0, 0, 0, 70, 0, 70, 0, 0, 0, + 0, 0, 71, 71, 0, 71, 0, 71, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 72, 0, - 72, 0, 0, 0, 0, 0, 0, 0, 107, 107, - 107, 107, 0, 0, 0, 0, 0, 107, 0, 0, - 0, 107, 107, 107, 107, 0, 0, 0, 0, 0, - 72, 107, 107, 0, 107, 107, 107, 107, 0, 107, - 107, 107, 0, 0, 107, 0, 0, 107, 107, 101, - 101, 101, 101, 0, 0, 0, 0, 0, 101, 0, - 0, 0, 101, 101, 101, 101, 0, 0, 0, 0, - 0, 0, 101, 101, 0, 101, 101, 101, 101, 0, - 101, 101, 101, 0, 0, 101, 0, 0, 101, 101, - 70, 70, 70, 70, 0, 0, 0, 0, 0, 70, - 0, 0, 0, 70, 70, 70, 70, 0, 0, 0, - 0, 0, 0, 70, 70, 0, 70, 70, 70, 70, - 0, 70, 0, 70, 0, 0, 0, 0, 0, 70, - 70, 143, 143, 143, 143, 0, 0, 0, 0, 0, - 143, 0, 0, 0, 143, 143, 143, 143, 0, 0, - 0, 0, 0, 0, 143, 143, 0, 143, 143, 143, - 143, 0, 143, 143, 0, 0, 0, 143, 0, 0, - 143, 143, 0, 72, 72, 72, 72, 0, 0, 0, - 0, 0, 72, 0, 0, 0, 72, 72, 0, 0, + 0, 0, 0, 0, 0, 0, 70, 0, 0, 72, + 0, 0, 72, 0, 0, 71, 0, 71, 0, 0, 0, 0, 0, 0, 0, 0, 72, 72, 0, 72, - 72, 72, 72, 0, 72, 124, 72, 0, 124, 0, - 0, 0, 72, 72, 0, 0, 0, 0, 0, 0, - 0, 0, 124, 124, 0, 124, 0, 124, 0, 0, + 0, 72, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 71, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 72, + 50, 72, 0, 50, 0, 0, 101, 101, 101, 101, + 0, 0, 0, 0, 0, 101, 0, 50, 50, 101, + 101, 101, 101, 0, 0, 0, 0, 0, 0, 101, + 101, 72, 101, 101, 101, 101, 0, 101, 101, 0, + 0, 101, 0, 0, 101, 101, 101, 0, 0, 0, + 50, 0, 50, 0, 0, 0, 124, 0, 0, 124, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 94, 0, 0, 94, - 0, 0, 0, 0, 0, 124, 0, 124, 0, 0, - 0, 0, 0, 94, 94, 0, 94, 0, 94, 0, + 0, 0, 0, 124, 124, 0, 124, 0, 124, 0, + 0, 0, 50, 0, 0, 0, 0, 0, 0, 70, + 70, 70, 70, 0, 0, 0, 0, 0, 70, 0, + 0, 0, 70, 70, 70, 70, 124, 0, 124, 0, + 0, 0, 70, 70, 0, 70, 70, 70, 70, 0, + 70, 0, 0, 0, 0, 0, 0, 70, 70, 70, + 71, 71, 71, 71, 0, 0, 0, 0, 124, 71, + 0, 0, 0, 71, 71, 0, 71, 0, 0, 0, + 0, 0, 0, 71, 71, 0, 71, 71, 71, 71, + 0, 71, 0, 0, 0, 0, 0, 0, 71, 71, + 71, 0, 0, 0, 72, 72, 72, 72, 0, 0, + 0, 0, 0, 72, 0, 0, 0, 72, 72, 94, + 0, 0, 94, 0, 0, 0, 0, 72, 72, 0, + 72, 72, 72, 72, 0, 72, 94, 94, 0, 94, + 0, 94, 72, 72, 72, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 50, 50, 50, 50, 0, + 0, 0, 0, 0, 0, 134, 0, 0, 134, 94, + 0, 94, 0, 0, 0, 0, 0, 0, 50, 50, + 0, 0, 134, 134, 0, 134, 0, 134, 0, 0, + 0, 0, 0, 50, 50, 50, 0, 0, 0, 0, + 0, 94, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 124, 124, 124, 124, 134, 0, 134, 0, 0, + 124, 0, 0, 0, 124, 124, 73, 0, 0, 73, + 0, 0, 0, 0, 124, 124, 0, 124, 124, 124, + 124, 0, 0, 73, 73, 0, 73, 134, 73, 124, + 124, 124, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 74, 0, 0, + 74, 0, 0, 0, 0, 0, 73, 0, 73, 0, + 0, 0, 0, 0, 74, 74, 0, 74, 0, 74, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 124, 134, 0, - 0, 134, 0, 0, 0, 0, 94, 0, 94, 0, - 0, 0, 0, 0, 0, 134, 134, 0, 134, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 73, 0, + 0, 0, 75, 0, 0, 75, 0, 74, 0, 74, + 0, 0, 0, 0, 0, 80, 0, 0, 80, 75, + 75, 0, 75, 0, 75, 0, 0, 0, 0, 0, + 0, 0, 80, 80, 94, 94, 94, 94, 0, 74, + 0, 0, 0, 94, 0, 0, 0, 94, 94, 0, + 0, 0, 75, 0, 75, 0, 0, 94, 94, 0, + 94, 94, 94, 94, 0, 80, 0, 80, 0, 0, + 0, 0, 94, 94, 94, 0, 0, 0, 0, 0, + 134, 134, 134, 134, 75, 0, 0, 0, 0, 134, + 0, 0, 0, 134, 134, 76, 0, 80, 76, 0, + 0, 0, 0, 134, 134, 0, 134, 134, 134, 134, + 0, 0, 76, 76, 0, 76, 0, 76, 134, 134, 134, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 94, 73, - 0, 0, 73, 0, 0, 0, 0, 0, 134, 0, - 134, 0, 0, 0, 0, 0, 73, 73, 0, 73, - 0, 73, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 78, 0, 0, 78, + 0, 73, 73, 73, 73, 76, 0, 76, 0, 0, + 73, 0, 0, 78, 78, 73, 78, 0, 78, 0, + 0, 0, 0, 0, 73, 73, 0, 73, 73, 73, + 73, 0, 0, 0, 0, 0, 0, 76, 0, 73, + 73, 73, 74, 74, 74, 74, 78, 0, 78, 0, + 0, 74, 0, 0, 0, 79, 0, 0, 79, 0, + 0, 0, 0, 0, 0, 74, 74, 0, 74, 74, + 74, 74, 79, 79, 0, 79, 0, 79, 78, 0, + 74, 74, 74, 0, 0, 0, 0, 75, 75, 75, + 75, 0, 0, 0, 0, 0, 75, 0, 0, 0, + 80, 80, 80, 80, 0, 79, 0, 79, 0, 0, + 75, 75, 0, 75, 75, 75, 75, 60, 0, 0, + 60, 0, 0, 80, 80, 75, 75, 75, 0, 0, + 0, 0, 0, 0, 60, 60, 0, 79, 80, 80, + 80, 0, 0, 62, 0, 0, 62, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 134, 0, 0, 74, 0, 0, 74, 0, 0, 73, - 0, 73, 0, 0, 0, 0, 0, 0, 0, 0, - 74, 74, 0, 74, 0, 74, 0, 0, 0, 0, + 62, 62, 0, 0, 0, 0, 0, 60, 0, 60, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 73, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 74, 0, 74, 0, 0, 0, 0, - 124, 124, 124, 124, 0, 0, 0, 0, 0, 124, - 0, 0, 0, 124, 124, 0, 0, 0, 0, 0, - 0, 0, 0, 124, 124, 74, 124, 124, 124, 124, - 0, 0, 0, 124, 0, 0, 0, 0, 0, 124, - 124, 94, 94, 94, 94, 0, 0, 0, 0, 0, - 94, 0, 0, 0, 94, 94, 0, 0, 0, 0, - 0, 0, 0, 0, 94, 94, 0, 94, 94, 94, - 94, 0, 0, 0, 94, 0, 0, 0, 0, 0, - 94, 94, 0, 134, 134, 134, 134, 0, 0, 0, - 0, 0, 134, 0, 0, 0, 134, 134, 0, 0, - 0, 0, 0, 0, 0, 0, 134, 134, 0, 134, - 134, 134, 134, 0, 0, 0, 134, 0, 0, 0, - 0, 0, 134, 134, 73, 73, 73, 73, 0, 0, - 0, 0, 0, 73, 0, 0, 0, 80, 73, 0, - 80, 0, 0, 0, 0, 0, 0, 73, 73, 0, - 73, 73, 73, 73, 80, 80, 0, 73, 0, 0, - 0, 0, 75, 73, 73, 75, 0, 0, 74, 74, - 74, 74, 0, 0, 0, 0, 0, 74, 0, 75, - 75, 0, 75, 0, 75, 0, 0, 80, 0, 80, - 0, 74, 74, 0, 74, 74, 74, 74, 0, 0, - 0, 74, 0, 76, 0, 0, 76, 74, 74, 0, - 0, 0, 75, 0, 75, 0, 0, 0, 0, 80, - 76, 76, 0, 76, 0, 76, 0, 0, 0, 0, - 0, 0, 78, 0, 0, 78, 0, 0, 0, 0, - 0, 0, 0, 0, 75, 0, 0, 0, 0, 78, - 78, 0, 78, 76, 78, 76, 0, 0, 0, 0, - 0, 79, 0, 0, 79, 0, 0, 0, 0, 0, - 0, 0, 0, 77, 0, 0, 77, 0, 79, 79, - 0, 79, 78, 79, 78, 76, 0, 0, 0, 0, - 77, 77, 0, 77, 0, 77, 0, 0, 0, 0, - 0, 0, 60, 0, 0, 60, 0, 0, 0, 0, - 0, 79, 0, 79, 78, 0, 0, 0, 0, 60, - 60, 62, 0, 77, 62, 77, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 62, 62, - 0, 0, 0, 79, 0, 0, 0, 0, 0, 0, - 0, 0, 60, 0, 60, 77, 0, 0, 0, 0, - 0, 0, 80, 80, 80, 80, 0, 0, 0, 0, - 0, 62, 0, 62, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 60, 80, 80, 75, 75, 75, - 75, 63, 0, 0, 63, 80, 75, 0, 0, 0, - 0, 80, 80, 62, 0, 0, 0, 0, 63, 63, - 75, 75, 0, 75, 75, 75, 75, 0, 0, 0, - 75, 0, 0, 0, 0, 0, 75, 75, 76, 76, - 76, 76, 0, 0, 0, 0, 0, 76, 0, 0, - 0, 63, 0, 63, 0, 0, 0, 0, 0, 0, - 0, 76, 76, 0, 76, 76, 76, 78, 78, 78, - 78, 76, 0, 0, 0, 0, 78, 76, 76, 0, - 0, 0, 0, 63, 0, 0, 0, 0, 0, 0, - 78, 78, 0, 78, 78, 0, 79, 79, 79, 79, - 78, 0, 0, 0, 0, 79, 78, 78, 77, 77, - 77, 77, 0, 0, 0, 0, 0, 0, 0, 79, - 79, 0, 79, 0, 0, 0, 0, 0, 0, 79, - 0, 77, 77, 0, 0, 79, 79, 60, 60, 60, - 60, 77, 0, 0, 0, 0, 0, 77, 77, 68, - 0, 0, 68, 0, 0, 0, 62, 62, 62, 62, - 60, 60, 0, 0, 0, 0, 68, 68, 0, 0, - 60, 0, 0, 0, 0, 0, 60, 60, 0, 62, - 62, 0, 0, 0, 0, 0, 0, 0, 0, 62, - 67, 0, 0, 67, 66, 62, 62, 66, 0, 68, - 0, 68, 65, 0, 0, 65, 0, 67, 67, 0, - 0, 66, 66, 0, 0, 0, 0, 0, 0, 65, - 65, 0, 0, 0, 0, 0, 63, 63, 63, 63, - 0, 68, 0, 0, 0, 0, 0, 0, 0, 0, - 67, 0, 67, 0, 66, 64, 66, 0, 64, 63, - 63, 0, 65, 61, 65, 0, 61, 51, 0, 63, - 51, 0, 64, 64, 0, 63, 63, 0, 0, 0, - 61, 61, 67, 0, 51, 51, 66, 0, 0, 0, - 0, 0, 0, 0, 65, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 64, 0, 64, 87, 0, - 0, 87, 0, 61, 0, 61, 0, 51, 0, 51, - 0, 0, 0, 0, 0, 87, 87, 0, 87, 0, - 87, 0, 0, 0, 0, 0, 0, 64, 0, 0, - 0, 0, 0, 0, 0, 61, 0, 88, 0, 51, - 88, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 87, 0, 0, 0, 88, 88, 0, 88, 0, 88, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 68, 68, 68, 68, 0, 0, - 0, 0, 89, 0, 0, 89, 0, 0, 0, 88, - 0, 0, 0, 0, 0, 0, 0, 68, 68, 89, - 89, 0, 89, 0, 89, 0, 0, 68, 0, 0, - 0, 0, 0, 68, 68, 67, 67, 67, 67, 66, - 66, 66, 66, 0, 0, 0, 0, 65, 65, 65, - 65, 0, 0, 0, 89, 0, 0, 0, 67, 67, - 0, 0, 66, 66, 0, 0, 0, 0, 67, 0, - 65, 65, 66, 0, 67, 67, 0, 0, 66, 66, - 65, 0, 0, 0, 0, 0, 65, 65, 0, 0, - 64, 64, 64, 64, 0, 0, 0, 0, 61, 61, - 61, 61, 51, 51, 51, 51, 0, 0, 0, 0, - 0, 0, 0, 64, 64, 0, 0, 0, 0, 0, - 0, 61, 61, 64, 0, 0, 0, 0, 0, 64, - 64, 61, 0, 0, 0, 51, 0, 61, 61, 0, - 0, 51, 51, 87, 87, 87, 87, 0, 0, 0, - 0, 0, 87, 0, 0, 0, 87, 87, 87, 87, - 0, 0, 0, 0, 0, 0, 87, 87, 0, 87, - 87, 87, 87, 0, 87, 87, 87, 0, 0, 87, - 0, 0, 88, 88, 88, 88, 0, 0, 0, 0, - 0, 88, 0, 0, 0, 88, 88, 88, 88, 0, - 0, 0, 0, 0, 0, 88, 88, 0, 88, 88, - 88, 88, 0, 88, 88, 88, 0, 92, 88, 0, - 92, 0, 0, 0, 0, 0, 0, 89, 89, 89, - 89, 0, 0, 0, 92, 92, 89, 92, 0, 92, - 89, 89, 89, 89, 0, 0, 0, 0, 0, 0, - 89, 89, 0, 89, 89, 89, 89, 0, 89, 89, - 89, 93, 0, 89, 93, 0, 0, 0, 0, 92, - 0, 0, 0, 0, 0, 0, 0, 0, 93, 93, - 0, 93, 0, 93, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 85, 0, - 0, 85, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 93, 0, 85, 85, 0, 85, 0, - 85, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 86, 0, 0, 86, 0, + 76, 76, 76, 76, 63, 0, 0, 63, 0, 76, + 0, 0, 0, 62, 0, 62, 0, 0, 0, 60, + 0, 63, 63, 76, 76, 0, 76, 76, 76, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 76, 76, + 76, 78, 78, 78, 78, 62, 0, 0, 0, 0, + 78, 0, 0, 0, 63, 68, 63, 0, 68, 0, + 67, 0, 0, 67, 78, 78, 66, 78, 78, 66, + 0, 0, 68, 68, 0, 0, 0, 67, 67, 78, + 78, 78, 0, 66, 66, 0, 63, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 85, 0, 86, 86, 0, 86, 0, 86, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 84, 0, 0, 84, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 86, 0, 84, - 84, 0, 84, 0, 84, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 84, 0, 0, 0, 0, 0, + 79, 79, 79, 79, 0, 68, 0, 68, 0, 79, + 67, 0, 67, 0, 0, 0, 66, 65, 66, 0, + 65, 0, 0, 79, 79, 0, 79, 64, 0, 0, + 64, 0, 0, 0, 65, 65, 0, 68, 79, 79, + 79, 0, 67, 0, 64, 64, 0, 0, 66, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 61, 0, + 0, 61, 60, 60, 60, 60, 0, 65, 0, 65, + 0, 0, 0, 0, 0, 61, 61, 64, 0, 64, + 0, 0, 0, 0, 0, 60, 60, 0, 62, 62, + 62, 62, 0, 0, 0, 0, 0, 0, 0, 65, + 60, 60, 60, 0, 0, 0, 0, 0, 61, 64, + 61, 62, 62, 0, 0, 0, 0, 0, 0, 0, + 81, 0, 0, 81, 0, 0, 62, 62, 62, 63, + 63, 63, 63, 0, 0, 0, 0, 81, 81, 0, + 61, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 63, 63, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 63, 63, 63, + 81, 0, 81, 0, 0, 0, 0, 0, 0, 0, + 68, 68, 68, 68, 0, 67, 67, 67, 67, 0, + 0, 66, 66, 66, 66, 0, 0, 0, 0, 0, + 0, 0, 81, 68, 68, 0, 0, 0, 67, 67, + 0, 0, 0, 0, 66, 66, 0, 0, 68, 68, + 68, 0, 0, 67, 67, 67, 0, 0, 0, 66, + 66, 66, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 65, 65, 65, 65, 0, 0, 0, 0, + 0, 0, 64, 64, 64, 64, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 65, 65, 0, 0, 0, + 0, 0, 0, 0, 0, 64, 64, 0, 0, 0, + 65, 65, 65, 61, 61, 61, 61, 0, 0, 0, + 64, 64, 64, 0, 0, 0, 0, 143, 0, 0, + 143, 0, 0, 0, 0, 0, 61, 61, 0, 0, + 0, 0, 0, 0, 143, 143, 0, 143, 0, 143, + 0, 61, 61, 61, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 87, 0, 0, + 87, 0, 0, 0, 0, 81, 81, 81, 81, 143, + 0, 0, 0, 0, 87, 87, 0, 87, 0, 87, + 0, 0, 0, 0, 0, 0, 0, 0, 81, 0, + 0, 0, 0, 88, 0, 0, 88, 0, 0, 0, + 0, 0, 0, 81, 81, 81, 0, 0, 0, 87, + 88, 88, 0, 88, 0, 88, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 89, + 0, 0, 89, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 88, 89, 89, 0, 89, + 0, 89, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 92, 0, 0, 92, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 92, 92, 92, 92, 0, 0, 0, 0, - 0, 92, 0, 0, 0, 92, 92, 92, 92, 0, - 0, 0, 0, 0, 0, 92, 92, 0, 92, 92, - 92, 92, 0, 92, 92, 92, 0, 0, 92, 0, - 0, 0, 0, 0, 0, 0, 93, 93, 93, 93, - 0, 0, 0, 0, 0, 93, 0, 0, 0, 93, - 93, 93, 93, 0, 0, 0, 0, 0, 0, 93, - 93, 0, 93, 93, 93, 93, 0, 93, 93, 93, - 0, 0, 93, 85, 85, 85, 85, 0, 0, 0, - 0, 0, 85, 0, 0, 0, 85, 85, 85, 85, - 0, 0, 0, 0, 0, 0, 85, 85, 0, 85, - 85, 85, 85, 0, 85, 85, 85, 0, 0, 85, - 86, 86, 86, 86, 100, 102, 0, 0, 0, 86, - 112, 0, 0, 86, 86, 86, 86, 0, 0, 0, - 0, 0, 0, 86, 86, 0, 86, 86, 86, 86, - 0, 86, 86, 86, 0, 0, 86, 84, 84, 84, - 84, 0, 0, 0, 0, 0, 84, 0, 0, 166, - 84, 84, 84, 84, 0, 0, 0, 0, 0, 0, - 84, 84, 0, 84, 84, 84, 84, 0, 84, 84, - 0, 0, 0, 84, 0, 0, 0, 0, 0, 0, + 0, 89, 92, 92, 0, 92, 0, 92, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 93, 0, 0, 93, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 92, 93, 93, + 0, 93, 0, 93, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 208, 209, 210, 211, 213, 215, 216, 217, - 218, 219, 221, 223, 225, 227, 229, 230, 232, 0, + 0, 0, 143, 143, 143, 143, 0, 0, 0, 0, + 0, 143, 0, 93, 0, 143, 143, 143, 143, 0, + 0, 0, 0, 0, 0, 143, 143, 0, 143, 143, + 143, 143, 85, 143, 143, 85, 0, 143, 0, 0, + 143, 143, 87, 87, 87, 87, 0, 0, 0, 85, + 85, 87, 85, 0, 85, 87, 87, 87, 87, 0, + 0, 0, 0, 0, 0, 87, 87, 0, 87, 87, + 87, 87, 0, 87, 87, 0, 0, 87, 88, 88, + 88, 88, 0, 0, 85, 0, 0, 88, 0, 0, + 0, 88, 88, 88, 88, 0, 0, 0, 0, 0, + 0, 88, 88, 0, 88, 88, 88, 88, 0, 88, + 88, 0, 0, 88, 89, 89, 89, 89, 0, 0, + 0, 0, 0, 89, 0, 0, 0, 89, 89, 89, + 89, 0, 0, 0, 0, 0, 0, 89, 89, 0, + 89, 89, 89, 89, 0, 89, 89, 0, 0, 89, + 92, 92, 92, 92, 0, 0, 0, 0, 0, 92, + 0, 0, 0, 92, 92, 92, 92, 0, 0, 0, + 0, 0, 0, 92, 92, 0, 92, 92, 92, 92, + 0, 92, 92, 0, 0, 92, 93, 93, 93, 93, + 0, 0, 93, 0, 0, 93, 0, 100, 102, 93, + 93, 93, 93, 112, 0, 0, 0, 0, 0, 93, + 93, 0, 93, 93, 93, 93, 86, 93, 93, 86, + 0, 93, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 86, 86, 0, 86, 0, 86, 0, + 0, 0, 166, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 85, 85, 85, + 85, 0, 0, 0, 0, 0, 85, 0, 86, 0, + 85, 85, 85, 85, 0, 0, 0, 0, 0, 0, + 85, 85, 0, 85, 85, 85, 85, 0, 85, 85, + 0, 0, 85, 0, 0, 208, 209, 210, 211, 213, + 215, 216, 217, 218, 219, 221, 223, 225, 227, 229, + 230, 232, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 208, 0, 0, - 0, 0, 0, 0, 0, 208, 0, 208, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 278, - 0, 279, 0, 0, 0, 0, 0, 281, 0, 282, - 0, 283, 0, 284, 0, 285, 0, 0, 286, 0, + 208, 0, 0, 0, 0, 0, 0, 0, 208, 0, + 208, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 278, 0, 279, 0, 0, 0, 0, 0, + 281, 0, 282, 0, 283, 0, 284, 0, 285, 0, + 0, 286, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 299, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 299, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 317, + 317, 86, 86, 86, 86, 0, 0, 0, 0, 0, + 86, 0, 0, 0, 86, 86, 86, 86, 0, 0, + 0, 0, 0, 0, 86, 86, 0, 86, 86, 86, + 86, 0, 86, 86, 0, 0, 86, }; short yycheck[] = { 5, - 81, 91, 36, 91, 175, 59, 12, 40, 12, 40, - 16, 123, 18, 40, 40, 96, 257, 40, 91, 59, - 91, 27, 28, 29, 30, 44, 107, 44, 177, 110, - 40, 37, 125, 123, 59, 123, 40, 43, 91, 44, - 91, 41, 257, 41, 44, 49, 44, 281, 41, 53, - 123, 44, 123, 44, 44, 169, 44, 171, 91, 44, - 58, 59, 44, 61, 298, 63, 44, 36, 302, 59, - 123, 40, 123, 36, 93, 123, 93, 40, 84, 83, - 86, 85, 88, 87, 90, 89, 41, 91, 41, 123, - 123, 95, 123, 91, 243, 93, 123, 123, 123, 0, - 123, 44, 93, 184, 59, 93, 59, 40, 93, 44, - 298, 93, 261, 194, 302, 93, 59, 266, 41, 268, - 41, 44, 41, 129, 59, 123, 40, 131, 132, 133, - 134, 302, 33, 41, 305, 36, 37, 38, 59, 40, - 59, 42, 43, 41, 45, 257, 41, 40, 152, 44, - 44, 59, 156, 157, 158, 159, 160, 161, 59, 281, - 282, 59, 0, 64, 245, 59, 270, 271, 258, 262, - 263, 264, 265, 344, 44, 179, 298, 257, 272, 40, - 302, 185, 186, 278, 188, 41, 300, 301, 44, 59, - 91, 44, 196, 307, 44, 33, 291, 59, 36, 37, - 38, 299, 40, 257, 42, 43, 59, 45, 289, 59, - 279, 299, 281, 282, 40, 40, 297, 305, 306, 333, - 41, 59, 123, 257, 125, 126, 64, 261, 297, 298, - 234, 123, 236, 302, 305, 306, 41, 41, 41, 44, - 44, 44, 36, 249, 125, 251, 44, 253, 254, 91, - 41, 257, 59, 91, 260, 259, 61, 41, 63, 123, - 91, 266, 267, 268, 269, 269, 125, 302, 266, 267, - 268, 269, 276, 266, 267, 268, 269, 275, 40, 40, - 40, 279, 280, 0, 282, 123, 41, 125, 126, 281, - 282, 289, 290, 125, 292, 293, 294, 295, 63, 297, - 304, 299, 308, 125, 41, 297, 298, 305, 306, 125, - 302, 262, 263, 264, 265, 125, 33, 59, 41, 36, - 37, 38, 41, 40, 125, 42, 43, 331, 45, 125, - 279, 280, 281, 282, 340, 125, 41, 41, 59, 345, - 41, 59, 59, 292, 293, 294, 295, 64, 297, 298, - 59, 41, 331, 302, 12, 256, 257, 258, 259, 260, - 261, 262, 263, 264, 265, 266, 267, 268, 269, 259, - 73, -1, 273, 274, 91, 276, 277, 278, -1, -1, + 81, 91, 36, 91, 175, 59, 12, 59, 12, 123, + 16, 41, 18, 40, 44, 96, 257, 40, 40, 40, + 91, 27, 28, 29, 30, 40, 107, 44, 177, 110, + 278, 37, 125, 123, 23, 123, 40, 43, 91, 44, + 91, 41, 257, 291, 44, 49, 44, 36, 169, 53, + 171, 41, 123, 42, 44, 41, 44, 44, 58, 59, + 44, 61, 44, 63, 91, 54, 55, 56, 57, 58, + 123, 123, 123, 59, 41, 123, 93, 272, 84, 83, + 86, 85, 88, 87, 90, 89, 59, 91, 93, 123, + 44, 95, 59, 93, 243, 93, 123, 41, 41, 0, + 123, 123, 123, 184, 281, 93, 93, 96, 123, 93, + 44, 93, 261, 194, 40, 59, 59, 266, 107, 268, + 41, 298, 41, 129, 301, 59, 40, 131, 132, 133, + 134, 302, 33, 40, 305, 36, 37, 38, 59, 40, + 59, 42, 43, 257, 45, 44, 44, 59, 152, 40, + 44, 44, 156, 157, 158, 159, 160, 161, 59, 40, + 59, 59, 0, 64, 245, 59, 59, 306, 258, 262, + 263, 264, 265, 344, 44, 179, 44, 281, 282, 300, + 301, 185, 186, 36, 188, 41, 307, 40, 44, 59, + 91, 59, 196, 297, 298, 33, 40, 301, 36, 37, + 38, 41, 40, 257, 42, 43, 36, 45, 289, 40, + 40, 44, 333, 36, 41, 123, 297, 44, 306, 125, + 91, 59, 123, 257, 125, 126, 64, 261, 41, 41, + 234, 44, 236, 304, 305, 306, 266, 267, 268, 269, + 59, 41, 41, 249, 44, 251, 41, 253, 254, 44, + 123, 257, 91, 91, 260, 259, 125, 298, 301, 41, + 301, 61, 44, 63, 40, 269, 266, 267, 268, 269, + 41, 40, 276, 44, 40, 275, 58, 59, 41, 279, + 280, 281, 282, 0, 125, 123, 59, 125, 126, 289, + 290, 125, 292, 293, 294, 295, 125, 297, 298, 125, + 304, 301, 308, 125, 304, 305, 306, 270, 271, 91, + 125, 93, 266, 267, 268, 269, 33, 41, 41, 36, + 37, 38, 125, 40, 59, 42, 43, 331, 45, 41, + 279, 280, 281, 282, 340, 262, 263, 264, 265, 345, + 41, 123, 59, 292, 293, 294, 295, 64, 297, 298, + 41, 41, 301, 59, 59, 256, 257, 258, 259, 260, + 261, 262, 263, 264, 265, 266, 267, 268, 269, 41, + 73, 331, 273, 274, 91, 276, 277, 278, 12, 259, -1, -1, 283, 284, 285, 286, 287, 288, -1, -1, - 291, -1, 61, -1, 63, 296, -1, -1, 299, -1, - 301, -1, 303, 304, -1, -1, 123, -1, 125, 126, - -1, -1, -1, -1, 279, 280, 281, 282, 256, 257, + 291, -1, -1, -1, -1, 296, 281, 282, -1, 300, + -1, 302, 303, -1, -1, 306, 123, 58, 125, 126, + 61, -1, 63, 298, -1, -1, 301, -1, 256, 257, 258, 259, 260, 261, 262, 263, 264, 265, 266, 267, - 268, 269, 297, 298, -1, 273, 274, 302, 276, 277, - 278, -1, -1, -1, -1, 283, 284, 285, 286, 287, - 288, 41, -1, 291, -1, -1, -1, -1, 296, -1, - -1, -1, 0, 301, -1, 303, 304, -1, -1, -1, - 275, 61, -1, 63, 279, 280, 281, 282, -1, -1, - -1, -1, -1, -1, 289, 290, -1, 292, 293, 294, - 295, -1, 297, 298, -1, 33, -1, 302, 36, 37, - 38, -1, 40, -1, 42, 43, -1, 45, -1, -1, - 275, -1, -1, -1, 279, 280, 281, 282, -1, -1, - -1, 59, -1, -1, -1, -1, 64, 292, 293, 294, - 295, -1, 297, 298, -1, -1, -1, 302, -1, 256, + 268, 269, -1, -1, -1, 273, 274, -1, 276, 277, + 278, 63, -1, -1, -1, 283, 284, 285, 286, 287, + 288, -1, -1, 291, 279, 280, 281, 282, 296, -1, + -1, -1, 300, -1, 302, 303, -1, 0, 293, 294, + 295, -1, 297, 298, -1, 275, 301, -1, -1, 279, + 280, 281, 282, -1, 266, 267, 268, 269, -1, 289, + 290, -1, 292, 293, 294, 295, -1, 297, 298, -1, + 33, 301, -1, 36, 37, 38, -1, 40, -1, 42, + 43, -1, 45, -1, 279, 280, 281, 282, -1, -1, + -1, -1, 304, 305, 306, -1, 59, -1, -1, 294, + 295, 64, 297, 298, -1, -1, 301, -1, -1, 256, 257, 258, 259, 260, 261, 262, 263, 264, 265, 266, - 267, 268, 269, 91, -1, -1, 273, 274, -1, 276, - 277, 278, 61, -1, 63, -1, 283, 284, 285, 286, + 267, 268, 269, -1, -1, -1, 273, 274, 91, 276, + 277, 278, -1, -1, -1, -1, 283, 284, 285, 286, 287, 288, -1, -1, 291, -1, -1, -1, -1, 296, - -1, -1, -1, -1, 301, 123, 303, 304, 126, 33, - -1, -1, 36, 37, 38, -1, 40, 41, 42, 43, - 44, 45, -1, -1, -1, -1, 275, -1, -1, -1, - 279, 280, 281, 282, 58, 59, -1, 61, -1, 63, - 64, 290, -1, 292, 293, 294, 295, -1, 297, 298, - -1, -1, -1, 302, 44, 45, 46, 47, 48, -1, - -1, 51, 52, -1, -1, -1, -1, 91, -1, 93, - 33, -1, -1, 36, 37, 38, -1, 40, 41, 42, - 43, 44, 45, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 58, 59, -1, 61, 123, - 63, 64, 126, -1, -1, 275, -1, -1, -1, 279, - 280, 281, 282, -1, -1, -1, -1, -1, -1, 289, - 290, -1, 292, 293, 294, 295, -1, 297, 298, -1, - 93, -1, 302, -1, -1, -1, -1, -1, 256, 257, - 258, 259, 260, 261, -1, 61, -1, 63, 266, 267, - 268, 269, -1, -1, -1, 273, 274, -1, 276, 277, - 278, -1, -1, 126, -1, 283, 284, 285, 286, 287, - 288, -1, -1, 291, -1, -1, -1, -1, 296, -1, - -1, -1, -1, 301, -1, 303, 304, -1, -1, -1, - -1, -1, 58, -1, -1, 61, 275, 63, -1, -1, - 279, 280, 281, 282, -1, -1, 279, 280, 281, 282, - 289, 290, -1, 292, 293, 294, 295, -1, 297, 298, - 293, 294, 295, 302, 297, 298, -1, -1, -1, 302, - -1, -1, -1, 257, 258, 259, 260, 261, -1, -1, - -1, -1, 266, 267, 268, 269, -1, -1, -1, -1, - 274, 275, 276, 277, 278, 279, 280, 281, 282, 283, - 284, 285, 286, 287, 288, 289, 290, 291, 292, 293, - 294, 295, 296, 297, 298, 299, -1, 301, 302, 303, - 304, 305, 306, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 257, 258, 259, 260, 261, -1, + -1, -1, -1, 300, -1, 302, 303, -1, -1, -1, + 123, 33, -1, 126, 36, 37, 38, -1, 40, 41, + 42, 43, 44, 45, 44, 45, 46, 47, 48, -1, + -1, 51, 52, -1, -1, -1, 58, 59, -1, 61, + -1, 63, 64, -1, 275, -1, -1, -1, 279, 280, + 281, 282, -1, -1, -1, -1, -1, -1, 289, 290, + -1, 292, 293, 294, 295, 41, 297, 298, 44, 91, + 301, 93, -1, 275, -1, -1, -1, 279, 280, 281, + 282, -1, 58, 59, -1, 61, -1, 63, -1, -1, + 292, 293, 294, 295, -1, 297, 298, -1, -1, 301, + -1, 123, 33, -1, 126, 36, 37, 38, -1, 40, + 41, 42, 43, 44, 45, -1, -1, 93, 279, 280, + 281, 282, -1, -1, -1, -1, -1, 58, 59, -1, + 61, -1, 63, 64, 295, -1, 297, 298, -1, -1, + 301, -1, -1, 256, 257, 258, 259, 260, 261, -1, -1, -1, -1, 266, 267, 268, 269, -1, -1, -1, - -1, 274, 275, 276, 277, 278, 279, 280, 281, 282, - 283, 284, 285, 286, 287, 288, 289, 290, 291, 292, - 293, 294, 295, 296, 297, 298, 299, -1, 301, 302, - 303, 304, 305, 306, 33, -1, -1, 36, 37, 38, - -1, 40, -1, 42, 43, -1, 45, -1, -1, 275, - -1, -1, -1, 279, 280, 281, 282, -1, -1, -1, - 59, -1, -1, -1, -1, 64, 292, 293, 294, 295, - -1, 297, 298, -1, -1, -1, 302, -1, -1, 279, - 280, 281, 282, -1, 33, -1, -1, 36, 37, 38, - -1, 40, 91, 42, 43, 295, 45, 297, 298, 275, - -1, -1, 302, 279, 280, 281, 282, -1, -1, -1, - 59, -1, -1, 289, 290, 64, 292, 293, 294, 295, - -1, 297, 298, -1, 123, -1, 302, 126, -1, -1, - -1, -1, -1, -1, 33, 23, -1, 36, 37, 38, - -1, 40, 91, 42, 43, -1, 45, -1, 36, -1, - -1, -1, -1, -1, 42, 41, -1, -1, 44, -1, - 59, -1, -1, -1, -1, 64, 54, 55, 56, 57, - 58, -1, 58, 59, 123, -1, -1, 126, -1, -1, + 273, 274, 93, 276, 277, 278, -1, -1, -1, -1, + 283, 284, 285, 286, 287, 288, -1, -1, 291, 41, + -1, -1, -1, 296, -1, -1, -1, 300, -1, 302, + 303, 279, 280, 281, 282, 126, -1, -1, -1, 61, + -1, 63, -1, -1, -1, -1, -1, -1, -1, 297, + 298, -1, -1, 301, -1, -1, -1, -1, -1, 33, + -1, -1, 36, 37, 38, -1, 40, -1, 42, 43, + -1, 45, -1, -1, -1, 257, 258, 259, 260, 261, + -1, -1, -1, -1, 266, 267, 268, 269, -1, -1, + 64, -1, 274, 275, 276, 277, 278, 279, 280, 281, + 282, 283, 284, 285, 286, 287, 288, 289, 290, 291, + 292, 293, 294, 295, 296, 297, 298, 91, 300, 301, + 302, 303, 304, 305, 306, -1, -1, -1, -1, -1, + 266, 267, 268, 269, 61, -1, 63, -1, -1, 275, + -1, -1, -1, 279, 280, 281, 282, -1, -1, 123, + -1, -1, 126, 289, 290, -1, 292, 293, 294, 295, + -1, 297, 298, -1, -1, 301, 257, 258, 259, 260, + 261, -1, -1, -1, -1, 266, 267, 268, 269, -1, + -1, -1, -1, 274, 275, 276, 277, 278, 279, 280, + 281, 282, 283, 284, 285, 286, 287, 288, 289, 290, + 291, 292, 293, 294, 295, 296, 297, 298, -1, 300, + 301, 302, 303, 304, 305, 306, -1, -1, -1, -1, + -1, -1, -1, -1, -1, 279, -1, 281, 282, -1, + 33, -1, -1, 36, 37, 38, -1, 40, -1, 42, + 43, -1, 45, 297, 298, -1, -1, 301, -1, -1, + -1, -1, -1, 275, -1, -1, 59, 279, 280, 281, + 282, 64, -1, -1, -1, -1, -1, 289, 290, -1, + 292, 293, 294, 295, -1, 297, 298, -1, -1, 301, + -1, -1, -1, 257, 258, 259, 260, 261, 91, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 33, -1, 91, 36, 37, 38, -1, 40, 41, 42, - 43, 23, 45, -1, -1, 91, -1, 93, 96, 31, - -1, -1, -1, -1, 36, 37, -1, 39, -1, 107, - -1, 64, -1, -1, 123, -1, -1, 126, -1, -1, - -1, -1, 54, 55, 56, 57, 58, 123, -1, -1, - 33, -1, -1, 36, 37, 38, -1, 40, 91, 42, - 43, -1, 45, -1, -1, -1, -1, 256, 257, 258, - 259, 260, 261, -1, -1, -1, -1, 266, 267, 268, - 269, 64, -1, -1, 273, 274, -1, 276, 277, 278, - 123, 103, -1, 126, 283, 284, 285, 286, 287, 288, - -1, -1, 291, -1, -1, -1, -1, 296, 91, -1, - 93, -1, 301, -1, 303, 304, -1, 256, 257, 258, - 259, 260, 261, -1, -1, -1, -1, 266, 267, 268, - 269, -1, -1, -1, 273, 274, -1, 276, 277, 278, - 123, -1, -1, 126, 283, 284, 285, 286, 287, 288, - -1, -1, 291, -1, -1, -1, -1, 296, -1, -1, - -1, -1, 301, -1, 303, 304, -1, -1, 257, 258, - 259, 260, 261, -1, 33, -1, -1, 36, 37, 38, - -1, 40, -1, 42, 43, 274, 45, 276, 277, 278, - 266, 267, 268, 269, 283, 284, 285, 286, 287, 288, - -1, -1, 291, -1, -1, 64, -1, 296, -1, -1, - -1, -1, 301, 289, 303, 304, -1, -1, -1, 279, - 280, 281, 282, 299, 257, 258, 259, 260, 261, 305, - 306, -1, 91, -1, 294, 295, -1, 297, 298, -1, - -1, 274, 302, 276, 277, 278, -1, -1, -1, -1, + 274, -1, 276, 277, 278, 61, -1, 63, -1, 283, + 284, 285, 286, 287, 288, -1, -1, 291, -1, -1, + 123, -1, 296, 126, -1, -1, 300, -1, 302, 303, + 33, -1, 306, 36, 37, 38, -1, 40, -1, 42, + 43, -1, 45, -1, -1, -1, -1, -1, 275, -1, + -1, -1, 279, 280, 281, 282, 59, -1, -1, -1, + -1, 64, 289, 290, -1, 292, 293, 294, 295, 23, + 297, 298, -1, -1, 301, -1, -1, 31, -1, -1, + -1, -1, 36, 37, -1, 39, 33, -1, 91, 36, + 37, 38, -1, 40, -1, 42, 43, -1, 45, -1, + 54, 55, 56, 57, 58, -1, -1, -1, -1, -1, + -1, -1, 59, -1, -1, -1, -1, 64, -1, -1, + 123, -1, -1, 126, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, 33, -1, + -1, 36, 37, 38, 91, 40, 41, 42, 43, 103, + 45, -1, -1, 256, 257, 258, 259, 260, 261, -1, + -1, -1, -1, 266, 267, 268, 269, -1, -1, 64, + 273, 274, -1, 276, 277, 278, 123, -1, -1, 126, 283, 284, 285, 286, 287, 288, -1, -1, 291, -1, - -1, -1, -1, 296, 123, -1, -1, 126, 301, -1, - 303, 304, -1, -1, 257, 258, 259, 260, 261, -1, - 33, -1, -1, 36, 37, 38, -1, 40, 41, 42, - 43, 274, 45, 276, 277, 278, -1, -1, -1, -1, + -1, -1, -1, 296, -1, -1, 91, 300, -1, 302, + 303, 33, -1, -1, 36, 37, 38, -1, 40, -1, + 42, 43, -1, 45, -1, -1, -1, -1, -1, 275, + -1, -1, -1, 279, 280, 281, 282, -1, 123, -1, + -1, 126, 64, -1, 290, -1, 292, 293, 294, 295, + -1, 297, 298, -1, -1, 301, -1, -1, -1, -1, + -1, -1, -1, 256, 257, 258, 259, 260, 261, 91, + -1, 93, -1, 266, 267, 268, 269, -1, -1, -1, + 273, 274, -1, 276, 277, 278, -1, -1, -1, -1, 283, 284, 285, 286, 287, 288, -1, -1, 291, -1, - -1, 64, -1, 296, -1, -1, -1, -1, 301, -1, - 303, 304, -1, -1, -1, -1, -1, -1, -1, -1, - 33, -1, -1, 36, 37, 38, -1, 40, 91, 42, - 43, -1, 45, -1, -1, -1, -1, -1, -1, -1, + -1, 123, -1, 296, 126, -1, -1, 300, -1, 302, + 303, -1, -1, -1, -1, -1, -1, -1, -1, -1, + 257, 258, 259, 260, 261, 61, 33, 63, -1, 36, + 37, 38, -1, 40, -1, 42, 43, 274, 45, 276, + 277, 278, -1, -1, -1, -1, 283, 284, 285, 286, + 287, 288, -1, -1, 291, -1, -1, 64, -1, 296, + -1, -1, -1, 300, -1, 302, 303, -1, -1, -1, + -1, -1, 257, 258, 259, 260, 261, -1, -1, -1, + -1, -1, -1, -1, 91, -1, -1, -1, -1, 274, + -1, 276, 277, 278, -1, -1, -1, -1, 283, 284, + 285, 286, 287, 288, -1, -1, 291, -1, -1, -1, + -1, 296, -1, -1, -1, 300, 123, 302, 303, 126, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 64, -1, -1, 41, -1, -1, 44, -1, -1, - 123, -1, -1, 126, -1, -1, -1, -1, -1, -1, - 33, 58, 59, 36, 37, 38, -1, 40, 91, 42, - 43, -1, 45, -1, -1, -1, -1, 256, 257, 258, - 259, 260, 261, -1, -1, -1, -1, -1, 61, -1, - -1, 64, -1, -1, 91, 274, 93, 276, 277, 278, - 123, -1, -1, 126, 283, 284, 285, 286, 287, 288, - -1, -1, 291, -1, -1, -1, -1, 296, 91, -1, - -1, -1, 301, -1, 303, 304, 123, -1, -1, -1, - -1, 33, -1, -1, 36, 37, 38, -1, 40, -1, - 42, 43, -1, 45, -1, -1, -1, -1, -1, -1, - 123, -1, -1, 126, -1, -1, -1, -1, -1, 61, - -1, -1, 64, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, 257, 258, 259, 260, 261, + -1, 33, -1, -1, 36, 37, 38, -1, 40, 41, + 42, 43, 274, 45, 276, 277, 278, -1, -1, -1, + -1, 283, 284, 285, 286, 287, 288, -1, -1, 291, + -1, -1, 64, -1, 296, -1, -1, -1, 300, -1, + 302, 303, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, 33, -1, 91, + 36, 37, 38, -1, 40, -1, 42, 43, -1, 45, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 257, 258, 259, 260, 261, 91, + -1, -1, -1, -1, -1, 61, -1, -1, 64, -1, + -1, 123, -1, -1, 126, -1, -1, -1, -1, 275, + -1, -1, -1, 279, 280, 281, 282, -1, -1, 256, + 257, 258, 259, 260, 261, 91, 292, 293, 294, 295, + -1, 297, 298, -1, -1, 301, -1, 274, -1, 276, + 277, 278, -1, -1, -1, -1, 283, 284, 285, 286, + 287, 288, -1, -1, 291, -1, -1, 123, -1, 296, + 126, -1, -1, 300, -1, 302, 303, 33, -1, -1, + 36, 37, 38, -1, 40, -1, 42, 43, -1, 45, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 274, -1, 276, 277, 278, -1, -1, -1, -1, - 283, 284, 285, 286, 287, 288, -1, -1, 291, -1, - -1, 123, -1, 296, 126, -1, -1, -1, 301, -1, - 303, 304, -1, -1, 257, 258, 259, 260, 261, -1, + -1, -1, -1, -1, -1, 61, -1, -1, 64, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 274, -1, 276, 277, 278, -1, -1, -1, -1, - 283, 284, 285, 286, 287, 288, -1, -1, 291, 266, - 267, 268, 269, 296, -1, -1, 299, -1, 301, -1, - 303, 304, -1, -1, 257, 258, 259, 260, 261, -1, - -1, -1, 289, 290, -1, -1, -1, -1, -1, -1, - -1, 274, 299, 276, 277, 278, -1, -1, 305, 306, - 283, 284, 285, 286, 287, 288, -1, -1, 291, -1, - -1, -1, -1, 296, -1, -1, -1, -1, 301, -1, - 303, 304, 33, -1, -1, 36, 37, 38, -1, 40, - -1, 42, 43, -1, 45, -1, -1, -1, -1, -1, + -1, -1, -1, -1, 33, -1, -1, 36, 37, 38, + -1, 40, -1, 42, 43, 91, 45, -1, -1, -1, -1, -1, -1, -1, -1, 257, 258, 259, 260, 261, - 61, -1, -1, 64, -1, -1, -1, -1, -1, -1, - -1, -1, 274, -1, 276, 277, 278, -1, -1, -1, - -1, 283, 284, 285, 286, 287, 288, -1, 33, 291, - 91, 36, 37, 38, 296, 40, -1, 42, 43, 301, - 45, 303, 304, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 61, -1, -1, 64, - -1, -1, 123, -1, -1, 126, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 33, -1, - -1, 36, 37, 38, -1, 40, 91, 42, 43, -1, + -1, -1, 61, -1, -1, 64, -1, -1, -1, -1, + -1, -1, 274, -1, 276, 277, 278, 123, -1, -1, + 126, 283, 284, 285, 286, 287, 288, -1, -1, 291, + -1, -1, 91, -1, 296, -1, -1, -1, 300, 41, + 302, 303, 44, -1, -1, -1, -1, -1, -1, -1, + -1, 257, 258, 259, 260, 261, 58, 59, -1, 61, + -1, 63, -1, -1, 123, -1, -1, 126, 274, -1, + 276, 277, 278, -1, -1, -1, -1, 283, 284, 285, + 286, 287, 288, -1, -1, 291, -1, -1, -1, 91, + 296, 93, -1, -1, 300, -1, 302, 303, 33, -1, + -1, 36, 37, 38, -1, 40, -1, 42, 43, -1, 45, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 61, -1, -1, 64, - -1, -1, -1, -1, -1, -1, -1, -1, 123, -1, - -1, 126, -1, -1, -1, -1, -1, -1, 33, -1, - -1, 36, 37, 38, -1, 40, 91, 42, 43, -1, - 45, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 61, -1, -1, 64, - -1, -1, -1, -1, -1, -1, -1, -1, 123, -1, - -1, 126, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 91, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 257, 258, 259, 260, - 261, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 274, -1, 276, 277, 278, 123, -1, - -1, 126, 283, 284, 285, 286, 287, 288, -1, -1, - 291, -1, -1, -1, -1, 296, -1, -1, -1, -1, - 301, -1, 303, 304, -1, -1, -1, -1, -1, -1, - -1, -1, 257, 258, 259, 260, 261, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 274, - -1, 276, 277, 278, -1, -1, -1, -1, 283, 284, + -1, 123, -1, -1, -1, -1, 61, -1, -1, 64, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, 257, 258, 259, 260, 261, 91, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, 274, -1, + 276, 277, 278, -1, -1, -1, -1, 283, 284, 285, + 286, 287, 288, -1, -1, 291, -1, -1, 123, -1, + 296, 126, -1, -1, 300, -1, 302, 303, 257, 258, + 259, 260, 261, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, 274, -1, 276, 277, 278, + -1, -1, -1, -1, 283, 284, 285, 286, 287, 288, + -1, -1, 291, -1, -1, -1, -1, 296, -1, -1, + -1, 300, 33, 302, 303, 36, 37, 38, -1, 40, + -1, 42, 43, -1, 45, -1, -1, -1, -1, -1, + -1, -1, -1, -1, 266, 267, 268, 269, -1, -1, + 61, -1, -1, 64, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, 289, 290, 33, + -1, -1, 36, 37, 38, -1, 40, -1, 42, 43, + 91, 45, 304, 305, 306, -1, -1, -1, -1, -1, + 41, -1, -1, 44, -1, -1, -1, 61, -1, -1, + 64, -1, 257, 258, 259, 260, 261, 58, 59, -1, + -1, -1, 123, -1, -1, 126, -1, -1, -1, 274, + -1, 276, 277, 278, -1, -1, -1, 91, 283, 284, 285, 286, 287, 288, -1, -1, 291, -1, -1, -1, - -1, 296, -1, -1, -1, -1, 301, -1, 303, 304, - -1, -1, 257, 258, 259, 260, 261, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 274, - -1, 276, 277, 278, -1, -1, -1, -1, 283, 284, - 285, 286, 287, 288, -1, 33, 291, -1, 36, 37, - 38, 296, 40, -1, 42, 43, 301, 45, 303, 304, - -1, -1, 257, 258, 259, 260, 261, -1, -1, -1, - -1, -1, -1, 61, -1, -1, 64, -1, -1, 274, - -1, 276, 277, 278, -1, -1, -1, -1, 283, 284, - 285, 286, 287, 288, -1, 33, 291, -1, 36, 37, - 38, 296, 40, 91, 42, 43, 301, 45, 303, 304, + 91, 296, 93, -1, -1, 300, 33, 302, 303, 36, + 37, 38, -1, 40, -1, 42, 43, -1, 45, 123, + -1, -1, 126, -1, -1, -1, -1, -1, -1, -1, + -1, -1, 123, -1, 61, -1, -1, 64, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 61, -1, -1, 64, -1, -1, -1, - -1, -1, -1, -1, -1, 123, -1, -1, 126, -1, - -1, -1, -1, -1, -1, -1, -1, 33, -1, -1, - 36, 37, 38, 91, 40, 41, 42, 43, -1, 45, + -1, -1, -1, 33, -1, -1, 36, 37, 38, -1, + 40, -1, 42, 43, 91, 45, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, 61, -1, -1, 64, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, 123, -1, -1, 126, + -1, -1, -1, -1, -1, -1, 257, 258, 259, 260, + 261, 91, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, 274, -1, 276, 277, 278, -1, -1, + -1, -1, 283, 284, 285, 286, 287, 288, -1, -1, + 291, -1, -1, 123, -1, 296, 126, -1, -1, 300, + -1, 302, 303, 257, 258, 259, 260, 261, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + 274, -1, 276, 277, 278, 266, 267, 268, 269, 283, + 284, 285, 286, 287, 288, -1, -1, 291, -1, -1, + -1, -1, 296, -1, -1, -1, 300, 33, 302, 303, + 36, 37, 38, -1, 40, 41, 42, 43, -1, 45, + -1, -1, -1, 304, 305, 306, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 64, -1, - -1, -1, -1, -1, -1, 123, -1, -1, 126, -1, + 257, 258, 259, 260, 261, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, 274, -1, 276, + 277, 278, -1, -1, -1, 91, 283, 284, 285, 286, + 287, 288, -1, -1, 291, -1, -1, -1, -1, 296, + -1, -1, -1, 300, -1, 302, 303, 257, 258, 259, + 260, 261, -1, -1, -1, -1, -1, 123, -1, -1, + 126, -1, -1, -1, 274, -1, 276, 277, 278, -1, + -1, -1, -1, 283, 284, 285, 286, 287, 288, -1, + -1, 291, -1, -1, -1, -1, 296, -1, -1, -1, + 300, 33, 302, 303, 36, 37, 38, -1, 40, 41, + 42, 43, -1, 45, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 91, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 33, -1, -1, 36, - 37, 38, -1, 40, 41, 42, 43, -1, 45, -1, - -1, -1, -1, -1, -1, -1, -1, 123, -1, -1, - 126, -1, -1, -1, -1, -1, -1, 64, -1, -1, + -1, -1, 64, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, 33, -1, + -1, 36, 37, 38, -1, 40, 41, 42, 43, 91, + 45, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, 64, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 257, - 258, 259, 260, 261, 91, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 274, -1, 276, 277, - 278, -1, -1, -1, -1, 283, 284, 285, 286, 287, - 288, -1, -1, 291, -1, -1, 123, -1, 296, 126, - -1, -1, -1, 301, -1, 303, 304, -1, -1, 257, - 258, 259, 260, 261, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 274, -1, 276, 277, - 278, -1, -1, -1, -1, 283, 284, 285, 286, 287, - 288, -1, -1, 291, -1, -1, -1, -1, 296, -1, - -1, -1, -1, 301, -1, 303, 304, -1, -1, -1, - -1, 257, 258, 259, 260, 261, 41, -1, -1, 44, - -1, -1, -1, -1, -1, -1, -1, -1, 274, -1, - 276, 277, 278, 58, 59, -1, 61, 283, 284, 285, - 286, 287, 288, -1, 33, 291, -1, 36, 37, 38, - 296, 40, 41, 42, 43, 301, 45, 303, 304, -1, + -1, 123, -1, -1, 126, -1, -1, -1, -1, -1, + -1, 257, 258, 259, 260, 261, 91, -1, -1, -1, + -1, -1, -1, -1, -1, -1, 41, -1, 274, 44, + 276, 277, 278, -1, -1, -1, -1, 283, 284, 285, + 286, 287, 288, 58, 59, 291, 61, -1, 123, -1, + 296, 126, -1, -1, 300, 33, 302, 303, 36, 37, + 38, -1, 40, -1, 42, 43, -1, 45, -1, -1, -1, -1, -1, -1, -1, -1, 91, -1, 93, -1, - -1, -1, -1, -1, -1, 64, -1, -1, -1, -1, - 257, 258, 259, 260, 261, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 274, 123, 276, - 277, 278, 91, -1, -1, -1, 283, 284, 285, 286, - 287, 288, -1, 33, 291, -1, 36, 37, 38, 296, - 40, -1, 42, 43, 301, 45, 303, 304, -1, -1, - -1, -1, -1, -1, 123, -1, -1, 126, -1, 59, - -1, -1, -1, -1, 64, -1, -1, -1, -1, -1, + -1, 59, -1, -1, -1, -1, 64, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 33, -1, -1, 36, 37, - 38, 91, 40, 41, 42, 43, -1, 45, -1, -1, + -1, -1, 33, -1, -1, 36, 37, 38, 123, 40, + 41, 42, 43, 91, 45, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 64, -1, -1, -1, - -1, -1, -1, 123, -1, -1, 126, -1, -1, -1, - -1, -1, -1, -1, -1, 33, -1, -1, 36, 37, - 38, -1, 40, 91, 42, 43, -1, 45, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 266, 267, 268, 269, -1, 64, -1, -1, -1, + -1, -1, -1, 64, -1, 257, 258, 259, 260, 261, -1, -1, -1, -1, -1, 123, -1, -1, 126, -1, - -1, -1, -1, -1, 289, 290, -1, -1, 257, 258, - 259, 260, 261, 91, 299, 93, -1, -1, -1, -1, - 305, 306, -1, -1, -1, 274, -1, 276, 277, 278, - -1, -1, -1, -1, 283, 284, 285, 286, 287, 288, - -1, -1, 291, -1, -1, 123, -1, 296, 126, -1, - -1, -1, 301, -1, 303, 304, -1, -1, -1, -1, - -1, 33, -1, -1, 36, 37, 38, -1, 40, -1, - 42, 43, -1, 45, -1, -1, -1, 257, 258, 259, - 260, 261, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 64, -1, 274, -1, 276, 277, 278, -1, - -1, -1, -1, 283, 284, 285, 286, 287, 288, -1, - -1, 291, -1, -1, -1, -1, 296, -1, -1, 91, - -1, 301, -1, 303, 304, -1, -1, -1, -1, 257, - 258, 259, 260, 261, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 274, -1, 276, 277, - 278, 123, -1, -1, 126, 283, 284, 285, 286, 287, - 288, -1, 33, 291, -1, 36, 37, 38, 296, 40, - -1, 42, 43, 301, 45, 303, 304, -1, -1, 257, - 258, 259, 260, 261, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 64, -1, -1, 274, -1, 276, 277, - 278, -1, -1, -1, -1, 283, 284, 285, 286, 287, - 288, 41, -1, 291, 44, -1, -1, -1, 296, -1, - 91, -1, -1, 301, -1, 303, 304, -1, 58, 59, - -1, 61, -1, 63, -1, -1, -1, -1, -1, -1, + -1, -1, 274, -1, 276, 277, 278, -1, -1, -1, + 91, 283, 284, 285, 286, 287, 288, -1, -1, 291, + -1, -1, -1, -1, 296, -1, -1, -1, 300, -1, + 302, 303, 257, 258, 259, 260, 261, -1, -1, -1, + -1, -1, 123, -1, -1, 126, -1, -1, -1, 274, + -1, 276, 277, 278, -1, -1, -1, -1, 283, 284, + 285, 286, 287, 288, -1, -1, 291, -1, -1, -1, + -1, 296, -1, -1, -1, 300, 33, 302, 303, 36, + 37, 38, -1, 40, -1, 42, 43, -1, 45, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 123, -1, -1, 126, -1, 41, -1, -1, - 44, 91, -1, 93, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 58, 59, -1, 61, -1, 63, - -1, -1, -1, -1, -1, 257, 258, 259, 260, 261, - -1, -1, -1, 123, -1, -1, -1, -1, -1, -1, - 41, -1, 274, 44, 276, 277, 278, 91, -1, 93, - -1, 283, 284, 285, 286, 287, 288, 58, 59, 291, - 61, -1, 63, -1, 296, -1, -1, -1, -1, 301, - -1, 303, 304, -1, -1, -1, -1, -1, -1, 123, - -1, 41, -1, -1, 44, -1, -1, -1, -1, -1, - 91, -1, 93, -1, -1, -1, -1, -1, 58, 59, - -1, 61, -1, 63, -1, -1, -1, -1, -1, -1, + -1, 266, 267, 268, 269, -1, -1, 64, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 123, -1, -1, -1, 257, 258, 259, 260, - 261, 91, -1, 93, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 274, 41, 276, 277, 278, -1, -1, + -1, -1, -1, -1, 289, 290, -1, -1, -1, 257, + 258, 259, 260, 261, 91, -1, 93, -1, -1, 304, + 305, 306, -1, -1, -1, -1, 274, -1, 276, 277, + 278, -1, -1, -1, -1, 283, 284, 285, 286, 287, + 288, -1, -1, 291, -1, -1, 123, -1, 296, 126, + -1, -1, 300, -1, 302, 303, 257, 258, 259, 260, + 261, -1, 33, -1, -1, 36, 37, 38, -1, 40, + -1, 42, 43, 274, 45, 276, 277, 278, -1, -1, -1, -1, 283, 284, 285, 286, 287, 288, -1, -1, - 291, 58, 59, 123, 61, 296, 63, -1, -1, -1, - 301, -1, 303, 304, -1, -1, 266, 267, 268, 269, - -1, -1, -1, -1, -1, 275, -1, -1, -1, 279, - 280, 281, 282, -1, 91, -1, 93, -1, -1, 289, - 290, -1, 292, 293, 294, 295, -1, 297, 298, 299, - -1, -1, 302, -1, -1, 305, 306, -1, -1, -1, - -1, -1, 266, 267, 268, 269, 123, -1, -1, -1, - -1, 275, -1, -1, -1, 279, 280, 281, 282, -1, - -1, -1, -1, -1, -1, 289, 290, -1, 292, 293, - 294, 295, -1, 297, 298, 299, -1, -1, 302, -1, - -1, 305, 306, -1, -1, 266, 267, 268, 269, -1, - -1, -1, -1, -1, 275, -1, -1, -1, 279, 280, - 281, 282, -1, -1, -1, -1, -1, -1, 289, 290, - -1, 292, 293, 294, 295, -1, 297, 298, 299, -1, - -1, 302, -1, -1, 305, 306, 266, 267, 268, 269, - -1, -1, -1, -1, -1, 275, -1, -1, -1, 279, - 280, 281, 282, -1, -1, -1, -1, -1, -1, 289, - 290, -1, 292, 293, 294, 295, -1, 297, 298, 299, - -1, -1, 302, -1, -1, 305, 306, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 41, - -1, -1, 44, -1, -1, -1, -1, -1, -1, 266, - 267, 268, 269, -1, -1, -1, 58, 59, 275, 61, - -1, 63, 279, 280, 281, 282, -1, -1, -1, -1, - -1, -1, 289, 290, -1, 292, 293, 294, 295, -1, - 297, 298, 299, 41, -1, 302, 44, -1, 305, 306, - -1, 93, -1, -1, -1, -1, -1, -1, -1, -1, - 58, 59, -1, 61, -1, 63, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 123, -1, -1, 41, -1, -1, 44, -1, -1, - -1, -1, -1, -1, -1, 93, -1, -1, -1, -1, - -1, 58, 59, -1, 61, -1, 63, -1, -1, -1, + 291, -1, -1, 64, -1, 296, -1, -1, -1, 300, + -1, 302, 303, -1, -1, -1, -1, -1, -1, -1, + -1, -1, 33, -1, -1, 36, 37, 38, -1, 40, + 91, 42, 43, -1, 45, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 123, 41, -1, -1, 44, - -1, -1, -1, -1, 91, -1, 93, -1, -1, -1, + -1, -1, -1, 64, -1, -1, 41, -1, -1, 44, + -1, -1, 123, -1, -1, 126, -1, -1, -1, -1, -1, -1, -1, 58, 59, -1, 61, -1, 63, -1, + 91, -1, -1, -1, -1, -1, -1, -1, -1, -1, + 257, 258, 259, 260, 261, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, 91, 274, 93, 276, + 277, 278, 123, -1, -1, 126, 283, 284, 285, 286, + 287, 288, 41, -1, 291, 44, -1, -1, -1, 296, + -1, -1, -1, 300, -1, 302, 303, -1, 123, 58, + 59, -1, 61, -1, 63, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 123, 41, -1, -1, - 44, -1, -1, -1, -1, -1, 91, -1, 93, -1, - -1, -1, -1, -1, 58, 59, -1, 61, -1, 63, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 123, -1, - -1, -1, -1, -1, 41, -1, -1, 44, -1, 93, - -1, -1, -1, -1, 266, 267, 268, 269, -1, -1, - -1, 58, 59, 275, 61, -1, 63, 279, 280, 281, - 282, -1, -1, -1, -1, -1, -1, 289, 290, -1, - 292, 293, 294, 295, -1, 297, 298, 299, -1, -1, - 302, -1, -1, 305, 306, -1, 93, -1, 266, 267, - 268, 269, -1, -1, -1, -1, -1, 275, -1, -1, - -1, 279, 280, 281, 282, -1, -1, -1, -1, -1, - -1, 289, 290, -1, 292, 293, 294, 295, -1, 297, - 298, 299, -1, -1, 302, -1, -1, 305, 306, 266, - 267, 268, 269, -1, -1, -1, -1, -1, 275, -1, - -1, -1, 279, 280, 281, 282, -1, -1, -1, -1, - -1, -1, 289, 290, -1, 292, 293, 294, 295, -1, - 297, 298, 299, -1, -1, -1, -1, -1, 305, 306, + -1, -1, 91, -1, 93, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, 41, -1, + -1, 44, -1, -1, -1, -1, 257, 258, 259, 260, + 261, -1, -1, -1, 123, 58, 59, -1, 61, -1, + 63, -1, -1, 274, -1, 276, 277, 278, -1, -1, + -1, -1, 283, 284, 285, 286, 287, 288, -1, -1, + 291, -1, -1, -1, -1, 296, 41, -1, 91, 300, + 93, 302, 303, -1, -1, -1, 257, 258, 259, 260, + 261, -1, -1, 58, 59, -1, 61, -1, 63, -1, + -1, -1, -1, 274, -1, 276, 277, 278, -1, -1, + 123, -1, 283, 284, 285, 286, 287, 288, -1, -1, + 291, 266, 267, 268, 269, 296, 91, -1, 93, 300, + 275, 302, 303, -1, 279, 280, 281, 282, -1, -1, + -1, -1, -1, -1, 289, 290, -1, 292, 293, 294, + 295, -1, 297, 298, 41, -1, 301, 44, 123, 304, + 305, 306, -1, -1, -1, -1, -1, -1, -1, -1, + -1, 58, 59, -1, 61, -1, 63, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, 266, 267, 268, + 269, -1, -1, -1, -1, -1, 275, -1, -1, -1, + 279, 280, 281, 282, -1, -1, 93, -1, -1, -1, + 289, 290, -1, 292, 293, 294, 295, -1, 297, 298, + -1, -1, 301, -1, -1, 304, 305, 306, -1, -1, + -1, -1, -1, -1, -1, -1, 123, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, 266, 267, 268, 269, -1, -1, -1, + -1, -1, 275, -1, -1, -1, 279, 280, 281, 282, + -1, -1, -1, -1, -1, -1, 289, 290, -1, 292, + 293, 294, 295, -1, 297, 298, -1, -1, 301, -1, + -1, 304, 305, 306, -1, -1, -1, -1, -1, -1, -1, 266, 267, 268, 269, -1, -1, -1, -1, -1, 275, -1, -1, -1, 279, 280, 281, 282, -1, -1, -1, -1, -1, -1, 289, 290, -1, 292, 293, 294, - 295, -1, 297, 298, 299, -1, -1, -1, -1, -1, - 305, 306, 266, 267, 268, 269, -1, -1, -1, -1, - -1, 275, -1, -1, -1, 279, 280, 281, 282, -1, - -1, -1, -1, -1, -1, 289, 290, -1, 292, 293, - 294, 295, -1, 297, 298, 299, -1, -1, 302, -1, - -1, 305, 306, -1, -1, -1, -1, -1, -1, 266, - 267, 268, 269, -1, -1, -1, -1, -1, 275, -1, + 295, 41, 297, 298, 44, -1, 301, -1, -1, 304, + 305, 306, -1, -1, -1, -1, -1, -1, 58, 59, + -1, 61, -1, 63, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, 266, + 267, 268, 269, 93, -1, -1, -1, -1, 275, -1, -1, -1, 279, 280, 281, 282, -1, -1, -1, -1, - -1, -1, 289, 290, -1, 292, 293, 294, 295, -1, - 297, 298, 299, 41, -1, 302, 44, -1, 305, 306, + -1, -1, 289, 290, -1, 292, 293, 294, 295, 41, + 297, 298, 44, 123, 301, -1, -1, 304, 305, 306, + -1, -1, -1, -1, -1, -1, 58, 59, -1, 61, + -1, 63, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 58, 59, -1, 61, -1, 63, -1, -1, -1, -1, + 41, -1, -1, 44, -1, -1, -1, -1, -1, 91, + -1, 93, -1, -1, -1, -1, -1, 58, 59, -1, + 61, -1, 63, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, 123, 41, -1, -1, 44, -1, -1, -1, -1, + 91, -1, 93, -1, -1, -1, -1, -1, -1, 58, + 59, -1, 61, -1, 63, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, 123, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, 93, -1, 41, -1, -1, 44, + -1, -1, -1, -1, -1, -1, 266, 267, 268, 269, + -1, -1, -1, 58, 59, 275, 61, -1, 63, 279, + 280, 281, 282, -1, -1, -1, -1, -1, -1, 289, + 290, -1, 292, 293, 294, 295, -1, 297, 298, 41, + -1, 301, 44, -1, 304, 305, 306, -1, 93, -1, + -1, -1, -1, -1, -1, -1, 58, 59, -1, 61, + -1, 63, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 41, -1, -1, 44, -1, -1, - -1, -1, -1, -1, -1, 93, -1, -1, -1, -1, + -1, -1, -1, -1, 266, 267, 268, 269, -1, -1, + -1, 93, -1, 275, -1, -1, -1, 279, 280, 281, + 282, -1, -1, -1, -1, -1, -1, 289, 290, -1, + 292, 293, 294, 295, -1, 297, 298, -1, -1, -1, + -1, -1, 304, 305, 306, 266, 267, 268, 269, -1, + -1, -1, -1, -1, 275, -1, -1, -1, 279, 280, + 281, 282, -1, -1, -1, -1, -1, -1, 289, 290, + -1, 292, 293, 294, 295, -1, 297, 298, -1, -1, + -1, -1, -1, 304, 305, 306, -1, 266, 267, 268, + 269, -1, -1, -1, -1, -1, 275, -1, -1, -1, + 279, 280, 281, 282, -1, -1, -1, -1, -1, -1, + 289, 290, -1, 292, 293, 294, 295, -1, 297, 298, + -1, -1, 301, -1, -1, 304, 305, 306, -1, -1, + -1, 41, -1, -1, 44, -1, -1, -1, -1, -1, + -1, 266, 267, 268, 269, -1, -1, -1, 58, 59, + 275, 61, -1, 63, 279, 280, 281, 282, -1, -1, + -1, -1, -1, -1, 289, 290, -1, 292, 293, 294, + 295, -1, 297, 298, -1, -1, 301, -1, -1, 304, + 305, 306, -1, 93, 266, 267, 268, 269, -1, -1, + -1, -1, -1, 275, -1, -1, -1, 279, 280, 281, + 282, -1, -1, -1, -1, -1, -1, 289, 290, -1, + 292, 293, 294, 295, 41, 297, 298, 44, -1, 301, + -1, -1, 304, 305, 306, -1, -1, -1, -1, -1, -1, 58, 59, -1, 61, -1, 63, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 41, -1, -1, 44, -1, - -1, -1, -1, -1, -1, -1, 93, -1, -1, -1, + -1, -1, -1, -1, 91, -1, 93, -1, -1, -1, -1, -1, 58, 59, -1, 61, -1, 63, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 41, -1, -1, 44, - -1, -1, -1, -1, -1, 91, -1, 93, -1, -1, - -1, -1, -1, 58, 59, -1, 61, -1, 63, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 123, 41, -1, - -1, 44, -1, -1, -1, -1, -1, -1, 93, -1, - -1, -1, -1, -1, -1, 58, 59, -1, 61, -1, - 63, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, 123, -1, -1, 41, + -1, -1, 44, -1, -1, 91, -1, 93, -1, -1, + -1, -1, -1, -1, -1, -1, 58, 59, -1, 61, + -1, 63, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, 123, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, 91, + 41, 93, -1, 44, -1, -1, 266, 267, 268, 269, + -1, -1, -1, -1, -1, 275, -1, 58, 59, 279, + 280, 281, 282, -1, -1, -1, -1, -1, -1, 289, + 290, 123, 292, 293, 294, 295, -1, 297, 298, -1, + -1, 301, -1, -1, 304, 305, 306, -1, -1, -1, + 91, -1, 93, -1, -1, -1, 41, -1, -1, 44, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 91, -1, - 93, -1, -1, -1, -1, -1, -1, -1, 266, 267, - 268, 269, -1, -1, -1, -1, -1, 275, -1, -1, - -1, 279, 280, 281, 282, -1, -1, -1, -1, -1, - 123, 289, 290, -1, 292, 293, 294, 295, -1, 297, - 298, 299, -1, -1, 302, -1, -1, 305, 306, 266, + -1, -1, -1, 58, 59, -1, 61, -1, 63, -1, + -1, -1, 123, -1, -1, -1, -1, -1, -1, 266, 267, 268, 269, -1, -1, -1, -1, -1, 275, -1, - -1, -1, 279, 280, 281, 282, -1, -1, -1, -1, + -1, -1, 279, 280, 281, 282, 91, -1, 93, -1, -1, -1, 289, 290, -1, 292, 293, 294, 295, -1, - 297, 298, 299, -1, -1, 302, -1, -1, 305, 306, - 266, 267, 268, 269, -1, -1, -1, -1, -1, 275, - -1, -1, -1, 279, 280, 281, 282, -1, -1, -1, + 297, -1, -1, -1, -1, -1, -1, 304, 305, 306, + 266, 267, 268, 269, -1, -1, -1, -1, 123, 275, + -1, -1, -1, 279, 280, -1, 282, -1, -1, -1, -1, -1, -1, 289, 290, -1, 292, 293, 294, 295, - -1, 297, -1, 299, -1, -1, -1, -1, -1, 305, - 306, 266, 267, 268, 269, -1, -1, -1, -1, -1, - 275, -1, -1, -1, 279, 280, 281, 282, -1, -1, - -1, -1, -1, -1, 289, 290, -1, 292, 293, 294, - 295, -1, 297, 298, -1, -1, -1, 302, -1, -1, - 305, 306, -1, 266, 267, 268, 269, -1, -1, -1, - -1, -1, 275, -1, -1, -1, 279, 280, -1, -1, - -1, -1, -1, -1, -1, -1, 289, 290, -1, 292, - 293, 294, 295, -1, 297, 41, 299, -1, 44, -1, - -1, -1, 305, 306, -1, -1, -1, -1, -1, -1, + -1, 297, -1, -1, -1, -1, -1, -1, 304, 305, + 306, -1, -1, -1, 266, 267, 268, 269, -1, -1, + -1, -1, -1, 275, -1, -1, -1, 279, 280, 41, + -1, -1, 44, -1, -1, -1, -1, 289, 290, -1, + 292, 293, 294, 295, -1, 297, 58, 59, -1, 61, + -1, 63, 304, 305, 306, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, 266, 267, 268, 269, -1, + -1, -1, -1, -1, -1, 41, -1, -1, 44, 91, + -1, 93, -1, -1, -1, -1, -1, -1, 289, 290, -1, -1, 58, 59, -1, 61, -1, 63, -1, -1, + -1, -1, -1, 304, 305, 306, -1, -1, -1, -1, + -1, 123, -1, -1, -1, -1, -1, -1, -1, -1, + -1, 266, 267, 268, 269, 91, -1, 93, -1, -1, + 275, -1, -1, -1, 279, 280, 41, -1, -1, 44, + -1, -1, -1, -1, 289, 290, -1, 292, 293, 294, + 295, -1, -1, 58, 59, -1, 61, 123, 63, 304, + 305, 306, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, 41, -1, -1, + 44, -1, -1, -1, -1, -1, 91, -1, 93, -1, + -1, -1, -1, -1, 58, 59, -1, 61, -1, 63, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, 123, -1, + -1, -1, 41, -1, -1, 44, -1, 91, -1, 93, + -1, -1, -1, -1, -1, 41, -1, -1, 44, 58, + 59, -1, 61, -1, 63, -1, -1, -1, -1, -1, + -1, -1, 58, 59, 266, 267, 268, 269, -1, 123, + -1, -1, -1, 275, -1, -1, -1, 279, 280, -1, + -1, -1, 91, -1, 93, -1, -1, 289, 290, -1, + 292, 293, 294, 295, -1, 91, -1, 93, -1, -1, + -1, -1, 304, 305, 306, -1, -1, -1, -1, -1, + 266, 267, 268, 269, 123, -1, -1, -1, -1, 275, + -1, -1, -1, 279, 280, 41, -1, 123, 44, -1, + -1, -1, -1, 289, 290, -1, 292, 293, 294, 295, + -1, -1, 58, 59, -1, 61, -1, 63, 304, 305, + 306, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 41, -1, -1, 44, - -1, -1, -1, -1, -1, 91, -1, 93, -1, -1, - -1, -1, -1, 58, 59, -1, 61, -1, 63, -1, + -1, 266, 267, 268, 269, 91, -1, 93, -1, -1, + 275, -1, -1, 58, 59, 280, 61, -1, 63, -1, + -1, -1, -1, -1, 289, 290, -1, 292, 293, 294, + 295, -1, -1, -1, -1, -1, -1, 123, -1, 304, + 305, 306, 266, 267, 268, 269, 91, -1, 93, -1, + -1, 275, -1, -1, -1, 41, -1, -1, 44, -1, + -1, -1, -1, -1, -1, 289, 290, -1, 292, 293, + 294, 295, 58, 59, -1, 61, -1, 63, 123, -1, + 304, 305, 306, -1, -1, -1, -1, 266, 267, 268, + 269, -1, -1, -1, -1, -1, 275, -1, -1, -1, + 266, 267, 268, 269, -1, 91, -1, 93, -1, -1, + 289, 290, -1, 292, 293, 294, 295, 41, -1, -1, + 44, -1, -1, 289, 290, 304, 305, 306, -1, -1, + -1, -1, -1, -1, 58, 59, -1, 123, 304, 305, + 306, -1, -1, 41, -1, -1, 44, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 123, 41, -1, - -1, 44, -1, -1, -1, -1, 91, -1, 93, -1, - -1, -1, -1, -1, -1, 58, 59, -1, 61, -1, - 63, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 123, 41, - -1, -1, 44, -1, -1, -1, -1, -1, 91, -1, - 93, -1, -1, -1, -1, -1, 58, 59, -1, 61, - -1, 63, -1, -1, -1, -1, -1, -1, -1, -1, + 58, 59, -1, -1, -1, -1, -1, 91, -1, 93, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 123, -1, -1, 41, -1, -1, 44, -1, -1, 91, - -1, 93, -1, -1, -1, -1, -1, -1, -1, -1, - 58, 59, -1, 61, -1, 63, -1, -1, -1, -1, + 266, 267, 268, 269, 41, -1, -1, 44, -1, 275, + -1, -1, -1, 91, -1, 93, -1, -1, -1, 123, + -1, 58, 59, 289, 290, -1, 292, 293, 294, -1, + -1, -1, -1, -1, -1, -1, -1, -1, 304, 305, + 306, 266, 267, 268, 269, 123, -1, -1, -1, -1, + 275, -1, -1, -1, 91, 41, 93, -1, 44, -1, + 41, -1, -1, 44, 289, 290, 41, 292, 293, 44, + -1, -1, 58, 59, -1, -1, -1, 58, 59, 304, + 305, 306, -1, 58, 59, -1, 123, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 123, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 91, -1, 93, -1, -1, -1, -1, - 266, 267, 268, 269, -1, -1, -1, -1, -1, 275, - -1, -1, -1, 279, 280, -1, -1, -1, -1, -1, - -1, -1, -1, 289, 290, 123, 292, 293, 294, 295, - -1, -1, -1, 299, -1, -1, -1, -1, -1, 305, - 306, 266, 267, 268, 269, -1, -1, -1, -1, -1, - 275, -1, -1, -1, 279, 280, -1, -1, -1, -1, - -1, -1, -1, -1, 289, 290, -1, 292, 293, 294, - 295, -1, -1, -1, 299, -1, -1, -1, -1, -1, - 305, 306, -1, 266, 267, 268, 269, -1, -1, -1, - -1, -1, 275, -1, -1, -1, 279, 280, -1, -1, - -1, -1, -1, -1, -1, -1, 289, 290, -1, 292, - 293, 294, 295, -1, -1, -1, 299, -1, -1, -1, - -1, -1, 305, 306, 266, 267, 268, 269, -1, -1, - -1, -1, -1, 275, -1, -1, -1, 41, 280, -1, - 44, -1, -1, -1, -1, -1, -1, 289, 290, -1, - 292, 293, 294, 295, 58, 59, -1, 299, -1, -1, - -1, -1, 41, 305, 306, 44, -1, -1, 266, 267, - 268, 269, -1, -1, -1, -1, -1, 275, -1, 58, - 59, -1, 61, -1, 63, -1, -1, 91, -1, 93, - -1, 289, 290, -1, 292, 293, 294, 295, -1, -1, - -1, 299, -1, 41, -1, -1, 44, 305, 306, -1, - -1, -1, 91, -1, 93, -1, -1, -1, -1, 123, - 58, 59, -1, 61, -1, 63, -1, -1, -1, -1, - -1, -1, 41, -1, -1, 44, -1, -1, -1, -1, - -1, -1, -1, -1, 123, -1, -1, -1, -1, 58, - 59, -1, 61, 91, 63, 93, -1, -1, -1, -1, - -1, 41, -1, -1, 44, -1, -1, -1, -1, -1, - -1, -1, -1, 41, -1, -1, 44, -1, 58, 59, - -1, 61, 91, 63, 93, 123, -1, -1, -1, -1, - 58, 59, -1, 61, -1, 63, -1, -1, -1, -1, - -1, -1, 41, -1, -1, 44, -1, -1, -1, -1, - -1, 91, -1, 93, 123, -1, -1, -1, -1, 58, - 59, 41, -1, 91, 44, 93, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 58, 59, - -1, -1, -1, 123, -1, -1, -1, -1, -1, -1, - -1, -1, 91, -1, 93, 123, -1, -1, -1, -1, + 266, 267, 268, 269, -1, 91, -1, 93, -1, 275, + 91, -1, 93, -1, -1, -1, 91, 41, 93, -1, + 44, -1, -1, 289, 290, -1, 292, 41, -1, -1, + 44, -1, -1, -1, 58, 59, -1, 123, 304, 305, + 306, -1, 123, -1, 58, 59, -1, -1, 123, -1, + -1, -1, -1, -1, -1, -1, -1, -1, 41, -1, + -1, 44, 266, 267, 268, 269, -1, 91, -1, 93, + -1, -1, -1, -1, -1, 58, 59, 91, -1, 93, + -1, -1, -1, -1, -1, 289, 290, -1, 266, 267, + 268, 269, -1, -1, -1, -1, -1, -1, -1, 123, + 304, 305, 306, -1, -1, -1, -1, -1, 91, 123, + 93, 289, 290, -1, -1, -1, -1, -1, -1, -1, + 41, -1, -1, 44, -1, -1, 304, 305, 306, 266, + 267, 268, 269, -1, -1, -1, -1, 58, 59, -1, + 123, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, 289, 290, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, 304, 305, 306, + 91, -1, 93, -1, -1, -1, -1, -1, -1, -1, + 266, 267, 268, 269, -1, 266, 267, 268, 269, -1, + -1, 266, 267, 268, 269, -1, -1, -1, -1, -1, + -1, -1, 123, 289, 290, -1, -1, -1, 289, 290, + -1, -1, -1, -1, 289, 290, -1, -1, 304, 305, + 306, -1, -1, 304, 305, 306, -1, -1, -1, 304, + 305, 306, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 266, 267, 268, 269, -1, -1, -1, -1, - -1, 91, -1, 93, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 123, 289, 290, 266, 267, 268, - 269, 41, -1, -1, 44, 299, 275, -1, -1, -1, - -1, 305, 306, 123, -1, -1, -1, -1, 58, 59, - 289, 290, -1, 292, 293, 294, 295, -1, -1, -1, - 299, -1, -1, -1, -1, -1, 305, 306, 266, 267, - 268, 269, -1, -1, -1, -1, -1, 275, -1, -1, - -1, 91, -1, 93, -1, -1, -1, -1, -1, -1, - -1, 289, 290, -1, 292, 293, 294, 266, 267, 268, - 269, 299, -1, -1, -1, -1, 275, 305, 306, -1, - -1, -1, -1, 123, -1, -1, -1, -1, -1, -1, - 289, 290, -1, 292, 293, -1, 266, 267, 268, 269, - 299, -1, -1, -1, -1, 275, 305, 306, 266, 267, - 268, 269, -1, -1, -1, -1, -1, -1, -1, 289, - 290, -1, 292, -1, -1, -1, -1, -1, -1, 299, - -1, 289, 290, -1, -1, 305, 306, 266, 267, 268, - 269, 299, -1, -1, -1, -1, -1, 305, 306, 41, - -1, -1, 44, -1, -1, -1, 266, 267, 268, 269, - 289, 290, -1, -1, -1, -1, 58, 59, -1, -1, - 299, -1, -1, -1, -1, -1, 305, 306, -1, 289, - 290, -1, -1, -1, -1, -1, -1, -1, -1, 299, - 41, -1, -1, 44, 41, 305, 306, 44, -1, 91, - -1, 93, 41, -1, -1, 44, -1, 58, 59, -1, - -1, 58, 59, -1, -1, -1, -1, -1, -1, 58, - 59, -1, -1, -1, -1, -1, 266, 267, 268, 269, - -1, 123, -1, -1, -1, -1, -1, -1, -1, -1, - 91, -1, 93, -1, 91, 41, 93, -1, 44, 289, - 290, -1, 91, 41, 93, -1, 44, 41, -1, 299, - 44, -1, 58, 59, -1, 305, 306, -1, -1, -1, - 58, 59, 123, -1, 58, 59, 123, -1, -1, -1, - -1, -1, -1, -1, 123, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 91, -1, 93, 41, -1, - -1, 44, -1, 91, -1, 93, -1, 91, -1, 93, - -1, -1, -1, -1, -1, 58, 59, -1, 61, -1, - 63, -1, -1, -1, -1, -1, -1, 123, -1, -1, - -1, -1, -1, -1, -1, 123, -1, 41, -1, 123, - 44, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 93, -1, -1, -1, 58, 59, -1, 61, -1, 63, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 266, 267, 268, 269, -1, -1, - -1, -1, 41, -1, -1, 44, -1, -1, -1, 93, - -1, -1, -1, -1, -1, -1, -1, 289, 290, 58, - 59, -1, 61, -1, 63, -1, -1, 299, -1, -1, - -1, -1, -1, 305, 306, 266, 267, 268, 269, 266, - 267, 268, 269, -1, -1, -1, -1, 266, 267, 268, - 269, -1, -1, -1, 93, -1, -1, -1, 289, 290, - -1, -1, 289, 290, -1, -1, -1, -1, 299, -1, - 289, 290, 299, -1, 305, 306, -1, -1, 305, 306, - 299, -1, -1, -1, -1, -1, 305, 306, -1, -1, - 266, 267, 268, 269, -1, -1, -1, -1, 266, 267, - 268, 269, 266, 267, 268, 269, -1, -1, -1, -1, - -1, -1, -1, 289, 290, -1, -1, -1, -1, -1, - -1, 289, 290, 299, -1, -1, -1, -1, -1, 305, - 306, 299, -1, -1, -1, 299, -1, 305, 306, -1, - -1, 305, 306, 266, 267, 268, 269, -1, -1, -1, - -1, -1, 275, -1, -1, -1, 279, 280, 281, 282, - -1, -1, -1, -1, -1, -1, 289, 290, -1, 292, - 293, 294, 295, -1, 297, 298, 299, -1, -1, 302, -1, -1, 266, 267, 268, 269, -1, -1, -1, -1, - -1, 275, -1, -1, -1, 279, 280, 281, 282, -1, - -1, -1, -1, -1, -1, 289, 290, -1, 292, 293, - 294, 295, -1, 297, 298, 299, -1, 41, 302, -1, - 44, -1, -1, -1, -1, -1, -1, 266, 267, 268, - 269, -1, -1, -1, 58, 59, 275, 61, -1, 63, - 279, 280, 281, 282, -1, -1, -1, -1, -1, -1, - 289, 290, -1, 292, 293, 294, 295, -1, 297, 298, - 299, 41, -1, 302, 44, -1, -1, -1, -1, 93, - -1, -1, -1, -1, -1, -1, -1, -1, 58, 59, - -1, 61, -1, 63, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 41, -1, - -1, 44, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 93, -1, 58, 59, -1, 61, -1, - 63, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, 289, 290, -1, -1, -1, + -1, -1, -1, -1, -1, 289, 290, -1, -1, -1, + 304, 305, 306, 266, 267, 268, 269, -1, -1, -1, + 304, 305, 306, -1, -1, -1, -1, 41, -1, -1, + 44, -1, -1, -1, -1, -1, 289, 290, -1, -1, + -1, -1, -1, -1, 58, 59, -1, 61, -1, 63, + -1, 304, 305, 306, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, 41, -1, -1, + 44, -1, -1, -1, -1, 266, 267, 268, 269, 93, + -1, -1, -1, -1, 58, 59, -1, 61, -1, 63, + -1, -1, -1, -1, -1, -1, -1, -1, 289, -1, + -1, -1, -1, 41, -1, -1, 44, -1, -1, -1, + -1, -1, -1, 304, 305, 306, -1, -1, -1, 93, + 58, 59, -1, 61, -1, 63, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, 41, + -1, -1, 44, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, 93, 58, 59, -1, 61, + -1, 63, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 41, -1, -1, 44, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 93, -1, 58, 59, -1, 61, -1, 63, -1, -1, + -1, 93, 58, 59, -1, 61, -1, 63, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 41, -1, -1, 44, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 93, -1, 58, - 59, -1, 61, -1, 63, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 93, -1, -1, -1, -1, -1, + -1, 41, -1, -1, 44, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, 93, 58, 59, + -1, 61, -1, 63, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 266, 267, 268, 269, -1, -1, -1, -1, - -1, 275, -1, -1, -1, 279, 280, 281, 282, -1, + -1, 275, -1, 93, -1, 279, 280, 281, 282, -1, -1, -1, -1, -1, -1, 289, 290, -1, 292, 293, - 294, 295, -1, 297, 298, 299, -1, -1, 302, -1, - -1, -1, -1, -1, -1, -1, 266, 267, 268, 269, - -1, -1, -1, -1, -1, 275, -1, -1, -1, 279, - 280, 281, 282, -1, -1, -1, -1, -1, -1, 289, - 290, -1, 292, 293, 294, 295, -1, 297, 298, 299, - -1, -1, 302, 266, 267, 268, 269, -1, -1, -1, - -1, -1, 275, -1, -1, -1, 279, 280, 281, 282, - -1, -1, -1, -1, -1, -1, 289, 290, -1, 292, - 293, 294, 295, -1, 297, 298, 299, -1, -1, 302, - 266, 267, 268, 269, 37, 38, -1, -1, -1, 275, - 43, -1, -1, 279, 280, 281, 282, -1, -1, -1, + 294, 295, 41, 297, 298, 44, -1, 301, -1, -1, + 304, 305, 266, 267, 268, 269, -1, -1, -1, 58, + 59, 275, 61, -1, 63, 279, 280, 281, 282, -1, + -1, -1, -1, -1, -1, 289, 290, -1, 292, 293, + 294, 295, -1, 297, 298, -1, -1, 301, 266, 267, + 268, 269, -1, -1, 93, -1, -1, 275, -1, -1, + -1, 279, 280, 281, 282, -1, -1, -1, -1, -1, + -1, 289, 290, -1, 292, 293, 294, 295, -1, 297, + 298, -1, -1, 301, 266, 267, 268, 269, -1, -1, + -1, -1, -1, 275, -1, -1, -1, 279, 280, 281, + 282, -1, -1, -1, -1, -1, -1, 289, 290, -1, + 292, 293, 294, 295, -1, 297, 298, -1, -1, 301, + 266, 267, 268, 269, -1, -1, -1, -1, -1, 275, + -1, -1, -1, 279, 280, 281, 282, -1, -1, -1, -1, -1, -1, 289, 290, -1, 292, 293, 294, 295, - -1, 297, 298, 299, -1, -1, 302, 266, 267, 268, - 269, -1, -1, -1, -1, -1, 275, -1, -1, 82, + -1, 297, 298, -1, -1, 301, 266, 267, 268, 269, + -1, -1, 32, -1, -1, 275, -1, 37, 38, 279, + 280, 281, 282, 43, -1, -1, -1, -1, -1, 289, + 290, -1, 292, 293, 294, 295, 41, 297, 298, 44, + -1, 301, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, 58, 59, -1, 61, -1, 63, -1, + -1, -1, 82, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, 266, 267, 268, + 269, -1, -1, -1, -1, -1, 275, -1, 93, -1, 279, 280, 281, 282, -1, -1, -1, -1, -1, -1, 289, 290, -1, 292, 293, 294, 295, -1, 297, 298, - -1, -1, -1, 302, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, 301, -1, -1, 135, 136, 137, 138, 139, + 140, 141, 142, 143, 144, 145, 146, 147, 148, 149, + 150, 151, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 135, 136, 137, 138, 139, 140, 141, 142, - 143, 144, 145, 146, 147, 148, 149, 150, 151, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + 190, -1, -1, -1, -1, -1, -1, -1, 198, -1, + 200, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, 212, -1, 214, -1, -1, -1, -1, -1, + 220, -1, 222, -1, 224, -1, 226, -1, 228, -1, + -1, 231, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, 248, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 190, -1, -1, - -1, -1, -1, -1, -1, 198, -1, 200, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 212, - -1, 214, -1, -1, -1, -1, -1, 220, -1, 222, - -1, 224, -1, 226, -1, 228, -1, -1, 231, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 248, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 280, + 280, 266, 267, 268, 269, -1, -1, -1, -1, -1, + 275, -1, -1, -1, 279, 280, 281, 282, -1, -1, + -1, -1, -1, -1, 289, 290, -1, 292, 293, 294, + 295, -1, 297, 298, -1, -1, 301, }; #define YYFINAL 1 #ifndef YYDEBUG @@ -1450,8 +1406,8 @@ char *yyname[] = { "UNLESS","ELSE","ELSIF","CONTINUE","FOR","LOOPEX","DOTDOT","FUNC0","FUNC1", "FUNC","RELOP","EQOP","MULOP","ADDOP","DOLSHARP","DO","LOCAL","DELETE", "HASHBRACK","NOAMP","OROP","ANDOP","LSTOP","OROR","ANDAND","BITOROP","BITANDOP", -"UNIOP","SHIFTOP","MATCHOP","ARROW","UMINUS","REFGEN","POWOP","PREINC","PREDEC", -"POSTINC","POSTDEC", +"UNIOP","SHIFTOP","MATCHOP","UMINUS","REFGEN","POWOP","PREINC","PREDEC", +"POSTINC","POSTDEC","ARROW", }; char *yyrule[] = { "$accept : prog", @@ -1585,7 +1541,7 @@ char *yyrule[] = { "term : DO scalar '(' ')'", "term : DO scalar '(' expr crp", "term : LOOPEX", -"term : LOOPEX WORD", +"term : LOOPEX sexpr", "term : UNIOP", "term : UNIOP block", "term : UNIOP sexpr", @@ -1637,9 +1593,9 @@ int yyerrflag; int yychar; YYSTYPE yyval; YYSTYPE yylval; -#line 605 "perly.y" +#line 611 "perly.y" /* PROGRAM */ -#line 1648 "y.tab.c" +#line 1604 "y.tab.c" #define YYABORT goto yyabort #define YYACCEPT goto yyaccept #define YYERROR goto yyerrlab @@ -1830,16 +1786,16 @@ yyreduce: switch (yyn) { case 1: -#line 102 "perly.y" +#line 103 "perly.y" { #if defined(YYDEBUG) && defined(DEBUGGING) yydebug = (debug & 1); #endif - expect = XBLOCK; + expect = XSTATE; } break; case 2: -#line 109 "perly.y" +#line 110 "perly.y" { if (in_eval) { eval_root = newUNOP(OP_LEAVEEVAL, 0, yyvsp[0].opval); eval_start = linklist(eval_root); @@ -1851,43 +1807,47 @@ case 2: } break; case 3: -#line 121 "perly.y" +#line 122 "perly.y" { int nbs = needblockscope; yyval.opval = scalarseq(yyvsp[-1].opval); if (copline > (line_t)yyvsp[-3].ival) copline = yyvsp[-3].ival; - leave_scope(yyvsp[-2].ival); + LEAVE_SCOPE(yyvsp[-2].ival); if (nbs) needblockscope = TRUE; /* propagate outward */ - pad_leavemy(comppadnamefill); } + pad_leavemy(comppad_name_fill); } break; case 4: -#line 132 "perly.y" +#line 133 "perly.y" { yyval.ival = savestack_ix; - SAVEINT(comppadnamefill); + comppad_name_fill = AvFILL(comppad_name); + SAVEINT(min_intro_pending); + SAVEINT(max_intro_pending); + min_intro_pending = 0; + SAVEINT(comppad_name_fill); SAVEINT(needblockscope); needblockscope = FALSE; } break; case 5: -#line 139 "perly.y" +#line 144 "perly.y" { yyval.opval = Nullop; } break; case 6: -#line 141 "perly.y" +#line 146 "perly.y" { yyval.opval = yyvsp[-1].opval; } break; case 7: -#line 143 "perly.y" +#line 148 "perly.y" { yyval.opval = append_list(OP_LINESEQ, (LISTOP*)yyvsp[-1].opval, (LISTOP*)yyvsp[0].opval); pad_reset(); if (yyvsp[-1].opval && yyvsp[0].opval) needblockscope = TRUE; } break; case 8: -#line 149 "perly.y" +#line 154 "perly.y" { yyval.opval = newSTATEOP(0, yyvsp[-1].pval, yyvsp[0].opval); } break; case 10: -#line 152 "perly.y" +#line 157 "perly.y" { if (yyvsp[-1].pval != Nullch) { yyval.opval = newSTATEOP(0, yyvsp[-1].pval, newOP(OP_NULL, 0)); } @@ -1895,119 +1855,119 @@ case 10: yyval.opval = Nullop; copline = NOLINE; } - expect = XBLOCK; } + expect = XSTATE; } break; case 11: -#line 161 "perly.y" +#line 166 "perly.y" { yyval.opval = newSTATEOP(0, yyvsp[-2].pval, yyvsp[-1].opval); - expect = XBLOCK; } + expect = XSTATE; } break; case 12: -#line 166 "perly.y" +#line 171 "perly.y" { yyval.opval = Nullop; } break; case 13: -#line 168 "perly.y" +#line 173 "perly.y" { yyval.opval = yyvsp[0].opval; } break; case 14: -#line 170 "perly.y" +#line 175 "perly.y" { yyval.opval = newLOGOP(OP_AND, 0, yyvsp[0].opval, yyvsp[-2].opval); } break; case 15: -#line 172 "perly.y" +#line 177 "perly.y" { yyval.opval = newLOGOP(OP_OR, 0, yyvsp[0].opval, yyvsp[-2].opval); } break; case 16: -#line 174 "perly.y" -{ yyval.opval = newLOOPOP(0, 1, scalar(yyvsp[0].opval), yyvsp[-2].opval); } +#line 179 "perly.y" +{ yyval.opval = newLOOPOP(OPf_PARENS, 1, scalar(yyvsp[0].opval), yyvsp[-2].opval); } break; case 17: -#line 176 "perly.y" -{ yyval.opval = newLOOPOP(0, 1, invert(scalar(yyvsp[0].opval)), yyvsp[-2].opval);} +#line 181 "perly.y" +{ yyval.opval = newLOOPOP(OPf_PARENS, 1, invert(scalar(yyvsp[0].opval)), yyvsp[-2].opval);} break; case 18: -#line 180 "perly.y" +#line 185 "perly.y" { yyval.opval = Nullop; } break; case 19: -#line 182 "perly.y" +#line 187 "perly.y" { yyval.opval = scope(yyvsp[0].opval); } break; case 20: -#line 184 "perly.y" +#line 189 "perly.y" { copline = yyvsp[-5].ival; yyval.opval = newCONDOP(0, yyvsp[-3].opval, scope(yyvsp[-1].opval), yyvsp[0].opval); } break; case 21: -#line 189 "perly.y" +#line 194 "perly.y" { copline = yyvsp[-5].ival; yyval.opval = newCONDOP(0, yyvsp[-3].opval, scope(yyvsp[-1].opval), yyvsp[0].opval); } break; case 22: -#line 192 "perly.y" +#line 197 "perly.y" { copline = yyvsp[-5].ival; yyval.opval = newCONDOP(0, invert(scalar(yyvsp[-3].opval)), scope(yyvsp[-1].opval), yyvsp[0].opval); } break; case 23: -#line 196 "perly.y" +#line 201 "perly.y" { copline = yyvsp[-3].ival; yyval.opval = newCONDOP(0, scope(yyvsp[-2].opval), scope(yyvsp[-1].opval), yyvsp[0].opval); } break; case 24: -#line 199 "perly.y" +#line 204 "perly.y" { copline = yyvsp[-3].ival; yyval.opval = newCONDOP(0, invert(scalar(scope(yyvsp[-2].opval))), scope(yyvsp[-1].opval), yyvsp[0].opval); } break; case 25: -#line 205 "perly.y" +#line 210 "perly.y" { yyval.opval = Nullop; } break; case 26: -#line 207 "perly.y" +#line 212 "perly.y" { yyval.opval = scope(yyvsp[0].opval); } break; case 27: -#line 211 "perly.y" +#line 216 "perly.y" { copline = yyvsp[-5].ival; yyval.opval = newSTATEOP(0, yyvsp[-6].pval, newWHILEOP(0, 1, (LOOP*)Nullop, yyvsp[-3].opval, yyvsp[-1].opval, yyvsp[0].opval) ); } break; case 28: -#line 216 "perly.y" +#line 221 "perly.y" { copline = yyvsp[-5].ival; yyval.opval = newSTATEOP(0, yyvsp[-6].pval, newWHILEOP(0, 1, (LOOP*)Nullop, invert(scalar(yyvsp[-3].opval)), yyvsp[-1].opval, yyvsp[0].opval) ); } break; case 29: -#line 221 "perly.y" +#line 226 "perly.y" { copline = yyvsp[-3].ival; yyval.opval = newSTATEOP(0, yyvsp[-4].pval, newWHILEOP(0, 1, (LOOP*)Nullop, scope(yyvsp[-2].opval), yyvsp[-1].opval, yyvsp[0].opval) ); } break; case 30: -#line 226 "perly.y" +#line 231 "perly.y" { copline = yyvsp[-3].ival; yyval.opval = newSTATEOP(0, yyvsp[-4].pval, newWHILEOP(0, 1, (LOOP*)Nullop, invert(scalar(scope(yyvsp[-2].opval))), yyvsp[-1].opval, yyvsp[0].opval)); } break; case 31: -#line 231 "perly.y" +#line 236 "perly.y" { yyval.opval = newFOROP(0, yyvsp[-7].pval, yyvsp[-6].ival, mod(yyvsp[-5].opval, OP_ENTERLOOP), yyvsp[-3].opval, yyvsp[-1].opval, yyvsp[0].opval); } break; case 32: -#line 234 "perly.y" +#line 239 "perly.y" { yyval.opval = newFOROP(0, yyvsp[-6].pval, yyvsp[-5].ival, Nullop, yyvsp[-3].opval, yyvsp[-1].opval, yyvsp[0].opval); } break; case 33: -#line 237 "perly.y" +#line 242 "perly.y" { copline = yyvsp[-8].ival; yyval.opval = append_elem(OP_LINESEQ, newSTATEOP(0, yyvsp[-9].pval, scalar(yyvsp[-6].opval)), @@ -2016,346 +1976,348 @@ case 33: scalar(yyvsp[-4].opval), yyvsp[0].opval, scalar(yyvsp[-2].opval)) )); } break; case 34: -#line 244 "perly.y" +#line 249 "perly.y" { yyval.opval = newSTATEOP(0, yyvsp[-2].pval, newWHILEOP(0, 1, (LOOP*)Nullop, Nullop, yyvsp[-1].opval, yyvsp[0].opval)); } break; case 35: -#line 250 "perly.y" +#line 255 "perly.y" { yyval.opval = Nullop; } break; case 37: -#line 255 "perly.y" +#line 260 "perly.y" { (void)scan_num("1"); yyval.opval = yylval.opval; } break; case 39: -#line 260 "perly.y" +#line 265 "perly.y" { yyval.pval = Nullch; } break; case 41: -#line 265 "perly.y" +#line 270 "perly.y" { yyval.ival = 0; } break; case 42: -#line 267 "perly.y" +#line 272 "perly.y" { yyval.ival = 0; } break; case 43: -#line 269 "perly.y" +#line 274 "perly.y" { yyval.ival = 0; } break; case 44: -#line 273 "perly.y" +#line 278 "perly.y" { newFORM(yyvsp[-2].ival, yyvsp[-1].opval, yyvsp[0].opval); } break; case 45: -#line 275 "perly.y" +#line 280 "perly.y" { newFORM(yyvsp[-1].ival, Nullop, yyvsp[0].opval); } break; case 46: -#line 279 "perly.y" +#line 284 "perly.y" { newSUB(yyvsp[-2].ival, yyvsp[-1].opval, yyvsp[0].opval); } break; case 47: -#line 281 "perly.y" -{ newSUB(yyvsp[-2].ival, yyvsp[-1].opval, Nullop); expect = XBLOCK; } +#line 286 "perly.y" +{ newSUB(yyvsp[-2].ival, yyvsp[-1].opval, Nullop); expect = XSTATE; } break; case 48: -#line 285 "perly.y" +#line 290 "perly.y" { package(yyvsp[-1].opval); } break; case 49: -#line 287 "perly.y" +#line 292 "perly.y" { package(Nullop); } break; case 50: -#line 291 "perly.y" +#line 296 "perly.y" { yyval.opval = append_elem(OP_LIST, yyvsp[-2].opval, yyvsp[0].opval); } break; case 52: -#line 296 "perly.y" +#line 301 "perly.y" { yyval.opval = convert(yyvsp[-2].ival, OPf_STACKED, prepend_elem(OP_LIST, newGVREF(yyvsp[-1].opval), yyvsp[0].opval) ); } break; case 53: -#line 299 "perly.y" +#line 304 "perly.y" { yyval.opval = convert(yyvsp[-4].ival, OPf_STACKED, prepend_elem(OP_LIST, newGVREF(yyvsp[-2].opval), yyvsp[-1].opval) ); } break; case 54: -#line 302 "perly.y" +#line 307 "perly.y" { yyval.opval = convert(yyvsp[-1].ival, OPf_STACKED, prepend_elem(OP_LIST, newGVREF(yyvsp[-3].opval), yyvsp[0].opval) ); } break; case 55: -#line 305 "perly.y" +#line 310 "perly.y" { yyval.opval = convert(yyvsp[-3].ival, OPf_STACKED, prepend_elem(OP_LIST, newGVREF(yyvsp[-5].opval), yyvsp[-1].opval) ); } break; case 56: -#line 308 "perly.y" +#line 313 "perly.y" { yyval.opval = convert(OP_ENTERSUBR, OPf_STACKED|OPf_SPECIAL, - prepend_elem(OP_LIST, newMETHOD(yyvsp[-5].opval,yyvsp[-3].opval), yyvsp[-1].opval)); } + prepend_elem(OP_LIST, + newMETHOD(yyvsp[-5].opval,yyvsp[-3].opval), list(yyvsp[-1].opval))); } break; case 57: -#line 311 "perly.y" +#line 317 "perly.y" { yyval.opval = convert(OP_ENTERSUBR, OPf_STACKED|OPf_SPECIAL, - prepend_elem(OP_LIST, newMETHOD(yyvsp[-1].opval,yyvsp[-2].opval), yyvsp[0].opval)); } + prepend_elem(OP_LIST, + newMETHOD(yyvsp[-1].opval,yyvsp[-2].opval), list(yyvsp[0].opval))); } break; case 58: -#line 314 "perly.y" +#line 321 "perly.y" { yyval.opval = convert(yyvsp[-1].ival, 0, yyvsp[0].opval); } break; case 59: -#line 316 "perly.y" +#line 323 "perly.y" { yyval.opval = convert(yyvsp[-3].ival, 0, yyvsp[-1].opval); } break; case 60: -#line 320 "perly.y" +#line 327 "perly.y" { yyval.opval = newASSIGNOP(OPf_STACKED, yyvsp[-2].opval, yyvsp[0].opval); } break; case 61: -#line 322 "perly.y" +#line 329 "perly.y" { yyval.opval = newBINOP(yyvsp[-2].ival, OPf_STACKED, mod(scalar(yyvsp[-3].opval), yyvsp[-2].ival), scalar(yyvsp[0].opval)); } break; case 62: -#line 325 "perly.y" +#line 332 "perly.y" { yyval.opval = newBINOP(yyvsp[-2].ival, OPf_STACKED, mod(scalar(yyvsp[-3].opval), yyvsp[-2].ival), scalar(yyvsp[0].opval)); } break; case 63: -#line 328 "perly.y" +#line 335 "perly.y" { yyval.opval = newBINOP(yyvsp[-2].ival, OPf_STACKED, mod(scalar(yyvsp[-3].opval), yyvsp[-2].ival), scalar(yyvsp[0].opval));} break; case 64: -#line 331 "perly.y" +#line 338 "perly.y" { yyval.opval = newBINOP(yyvsp[-2].ival, OPf_STACKED, mod(scalar(yyvsp[-3].opval), yyvsp[-2].ival), scalar(yyvsp[0].opval)); } break; case 65: -#line 334 "perly.y" +#line 341 "perly.y" { yyval.opval = newBINOP(yyvsp[-2].ival, OPf_STACKED, mod(scalar(yyvsp[-3].opval), yyvsp[-2].ival), scalar(yyvsp[0].opval)); } break; case 66: -#line 337 "perly.y" +#line 344 "perly.y" { yyval.opval = newBINOP(yyvsp[-2].ival, OPf_STACKED, mod(scalar(yyvsp[-3].opval), yyvsp[-2].ival), scalar(yyvsp[0].opval)); } break; case 67: -#line 340 "perly.y" +#line 347 "perly.y" { yyval.opval = newLOGOP(OP_ANDASSIGN, 0, mod(scalar(yyvsp[-3].opval), OP_ANDASSIGN), newUNOP(OP_SASSIGN, 0, scalar(yyvsp[0].opval))); } break; case 68: -#line 344 "perly.y" +#line 351 "perly.y" { yyval.opval = newLOGOP(OP_ORASSIGN, 0, mod(scalar(yyvsp[-3].opval), OP_ORASSIGN), newUNOP(OP_SASSIGN, 0, scalar(yyvsp[0].opval))); } break; case 69: -#line 350 "perly.y" +#line 357 "perly.y" { yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); } break; case 70: -#line 352 "perly.y" +#line 359 "perly.y" { if (yyvsp[-1].ival != OP_REPEAT) scalar(yyvsp[-2].opval); yyval.opval = newBINOP(yyvsp[-1].ival, 0, yyvsp[-2].opval, scalar(yyvsp[0].opval)); } break; case 71: -#line 356 "perly.y" +#line 363 "perly.y" { yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); } break; case 72: -#line 358 "perly.y" +#line 365 "perly.y" { yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); } break; case 73: -#line 360 "perly.y" +#line 367 "perly.y" { yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); } break; case 74: -#line 362 "perly.y" +#line 369 "perly.y" { yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); } break; case 75: -#line 364 "perly.y" +#line 371 "perly.y" { yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); } break; case 76: -#line 366 "perly.y" +#line 373 "perly.y" { yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); } break; case 77: -#line 368 "perly.y" +#line 375 "perly.y" { yyval.opval = newRANGE(yyvsp[-1].ival, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval));} break; case 78: -#line 370 "perly.y" +#line 377 "perly.y" { yyval.opval = newLOGOP(OP_AND, 0, yyvsp[-2].opval, yyvsp[0].opval); } break; case 79: -#line 372 "perly.y" +#line 379 "perly.y" { yyval.opval = newLOGOP(OP_OR, 0, yyvsp[-2].opval, yyvsp[0].opval); } break; case 80: -#line 374 "perly.y" +#line 381 "perly.y" { yyval.opval = newLOGOP(OP_AND, 0, yyvsp[-2].opval, yyvsp[0].opval); } break; case 81: -#line 376 "perly.y" +#line 383 "perly.y" { yyval.opval = newLOGOP(OP_OR, 0, yyvsp[-2].opval, yyvsp[0].opval); } break; case 82: -#line 378 "perly.y" +#line 385 "perly.y" { yyval.opval = newCONDOP(0, yyvsp[-4].opval, yyvsp[-2].opval, yyvsp[0].opval); } break; case 83: -#line 380 "perly.y" +#line 387 "perly.y" { yyval.opval = bind_match(yyvsp[-1].ival, yyvsp[-2].opval, yyvsp[0].opval); } break; case 84: -#line 382 "perly.y" +#line 389 "perly.y" { yyval.opval = yyvsp[0].opval; } break; case 85: -#line 386 "perly.y" +#line 393 "perly.y" { yyval.opval = newUNOP(OP_NEGATE, 0, scalar(yyvsp[0].opval)); } break; case 86: -#line 388 "perly.y" +#line 395 "perly.y" { yyval.opval = yyvsp[0].opval; } break; case 87: -#line 390 "perly.y" +#line 397 "perly.y" { yyval.opval = newUNOP(OP_NOT, 0, scalar(yyvsp[0].opval)); } break; case 88: -#line 392 "perly.y" +#line 399 "perly.y" { yyval.opval = newUNOP(OP_COMPLEMENT, 0, scalar(yyvsp[0].opval));} break; case 89: -#line 394 "perly.y" -{ yyval.opval = newUNOP(OP_REFGEN, 0, mod(yyvsp[0].opval,OP_REFGEN)); } +#line 401 "perly.y" +{ yyval.opval = newUNOP(OP_REFGEN, 0, ref(yyvsp[0].opval,OP_REFGEN)); } break; case 90: -#line 396 "perly.y" +#line 403 "perly.y" { yyval.opval = newUNOP(OP_POSTINC, 0, mod(scalar(yyvsp[-1].opval), OP_POSTINC)); } break; case 91: -#line 399 "perly.y" +#line 406 "perly.y" { yyval.opval = newUNOP(OP_POSTDEC, 0, mod(scalar(yyvsp[-1].opval), OP_POSTDEC)); } break; case 92: -#line 402 "perly.y" +#line 409 "perly.y" { yyval.opval = newUNOP(OP_PREINC, 0, mod(scalar(yyvsp[0].opval), OP_PREINC)); } break; case 93: -#line 405 "perly.y" +#line 412 "perly.y" { yyval.opval = newUNOP(OP_PREDEC, 0, mod(scalar(yyvsp[0].opval), OP_PREDEC)); } break; case 94: -#line 408 "perly.y" +#line 415 "perly.y" { yyval.opval = localize(yyvsp[0].opval,yyvsp[-1].ival); } break; case 95: -#line 410 "perly.y" +#line 417 "perly.y" { yyval.opval = sawparens(yyvsp[-1].opval); } break; case 96: -#line 412 "perly.y" -{ yyval.opval = newNULLLIST(); } +#line 419 "perly.y" +{ yyval.opval = sawparens(newNULLLIST()); } break; case 97: -#line 414 "perly.y" +#line 421 "perly.y" { yyval.opval = newANONLIST(yyvsp[-1].opval); } break; case 98: -#line 416 "perly.y" +#line 423 "perly.y" { yyval.opval = newANONLIST(Nullop); } break; case 99: -#line 418 "perly.y" +#line 425 "perly.y" { yyval.opval = newANONHASH(yyvsp[-1].opval); } break; case 100: -#line 420 "perly.y" +#line 427 "perly.y" { yyval.opval = newANONHASH(Nullop); } break; case 101: -#line 422 "perly.y" +#line 429 "perly.y" { yyval.opval = yyvsp[0].opval; } break; case 102: -#line 424 "perly.y" +#line 431 "perly.y" { yyval.opval = yyvsp[0].opval; } break; case 103: -#line 426 "perly.y" +#line 433 "perly.y" { yyval.opval = newBINOP(OP_AELEM, 0, oopsAV(yyvsp[-3].opval), scalar(yyvsp[-1].opval)); } break; case 104: -#line 428 "perly.y" +#line 435 "perly.y" { yyval.opval = newBINOP(OP_AELEM, 0, - scalar(ref(newAVREF(yyvsp[-4].opval),OP_RV2AV)), + ref(newAVREF(yyvsp[-4].opval),OP_RV2AV), scalar(yyvsp[-1].opval));} break; case 105: -#line 432 "perly.y" +#line 439 "perly.y" { yyval.opval = newBINOP(OP_AELEM, 0, - scalar(ref(newAVREF(yyvsp[-3].opval),OP_RV2AV)), + ref(newAVREF(yyvsp[-3].opval),OP_RV2AV), scalar(yyvsp[-1].opval));} break; case 106: -#line 436 "perly.y" +#line 443 "perly.y" { yyval.opval = yyvsp[0].opval; } break; case 107: -#line 438 "perly.y" +#line 445 "perly.y" { yyval.opval = yyvsp[0].opval; } break; case 108: -#line 440 "perly.y" +#line 447 "perly.y" { yyval.opval = newUNOP(OP_AV2ARYLEN, 0, ref(yyvsp[0].opval, OP_AV2ARYLEN));} break; case 109: -#line 442 "perly.y" +#line 449 "perly.y" { yyval.opval = newBINOP(OP_HELEM, 0, oopsHV(yyvsp[-4].opval), jmaybe(yyvsp[-2].opval)); expect = XOPERATOR; } break; case 110: -#line 445 "perly.y" +#line 452 "perly.y" { yyval.opval = newBINOP(OP_HELEM, 0, - scalar(ref(newHVREF(yyvsp[-5].opval),OP_RV2HV)), + ref(newHVREF(yyvsp[-5].opval),OP_RV2HV), jmaybe(yyvsp[-2].opval)); expect = XOPERATOR; } break; case 111: -#line 450 "perly.y" +#line 457 "perly.y" { yyval.opval = newBINOP(OP_HELEM, 0, - scalar(ref(newHVREF(yyvsp[-4].opval),OP_RV2HV)), + ref(newHVREF(yyvsp[-4].opval),OP_RV2HV), jmaybe(yyvsp[-2].opval)); expect = XOPERATOR; } break; case 112: -#line 455 "perly.y" +#line 462 "perly.y" { yyval.opval = newSLICEOP(0, yyvsp[-1].opval, yyvsp[-4].opval); } break; case 113: -#line 457 "perly.y" +#line 464 "perly.y" { yyval.opval = newSLICEOP(0, yyvsp[-1].opval, Nullop); } break; case 114: -#line 459 "perly.y" +#line 466 "perly.y" { yyval.opval = prepend_elem(OP_ASLICE, newOP(OP_PUSHMARK, 0), list( @@ -2364,7 +2326,7 @@ case 114: ref(yyvsp[-3].opval, OP_ASLICE)))); } break; case 115: -#line 466 "perly.y" +#line 473 "perly.y" { yyval.opval = prepend_elem(OP_HSLICE, newOP(OP_PUSHMARK, 0), list( @@ -2374,197 +2336,196 @@ case 115: expect = XOPERATOR; } break; case 116: -#line 474 "perly.y" +#line 481 "perly.y" { yyval.opval = newBINOP(OP_DELETE, 0, oopsHV(yyvsp[-4].opval), jmaybe(yyvsp[-2].opval)); expect = XOPERATOR; } break; case 117: -#line 477 "perly.y" +#line 484 "perly.y" { yyval.opval = newBINOP(OP_DELETE, 0, oopsHV(yyvsp[-5].opval), jmaybe(yyvsp[-3].opval)); expect = XOPERATOR; } break; case 118: -#line 480 "perly.y" +#line 487 "perly.y" { yyval.opval = yyvsp[0].opval; } break; case 119: -#line 482 "perly.y" +#line 489 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUBR, 0, scalar(yyvsp[0].opval)); } break; case 120: -#line 485 "perly.y" +#line 492 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUBR, OPf_STACKED, scalar(yyvsp[-2].opval)); } break; case 121: -#line 487 "perly.y" +#line 494 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUBR, OPf_STACKED, list(prepend_elem(OP_LIST, scalar(yyvsp[-3].opval), yyvsp[-1].opval))); } break; case 122: -#line 490 "perly.y" +#line 497 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUBR, OPf_STACKED, list(prepend_elem(OP_LIST, newCVREF(scalar(yyvsp[-1].opval)), yyvsp[0].opval))); } break; case 123: -#line 494 "perly.y" +#line 501 "perly.y" { yyval.opval = convert(OP_ENTERSUBR, OPf_STACKED|OPf_SPECIAL, - prepend_elem(OP_LIST, newMETHOD(yyvsp[-1].opval,yyvsp[-2].opval), yyvsp[0].opval)); } + prepend_elem(OP_LIST, + newMETHOD(yyvsp[-1].opval,yyvsp[-2].opval), list(yyvsp[0].opval))); } break; case 124: -#line 497 "perly.y" +#line 505 "perly.y" { yyval.opval = newUNOP(OP_DOFILE, 0, scalar(yyvsp[0].opval)); } break; case 125: -#line 499 "perly.y" +#line 507 "perly.y" { yyval.opval = newUNOP(OP_NULL, OPf_SPECIAL, scope(yyvsp[0].opval)); } break; case 126: -#line 501 "perly.y" +#line 509 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUBR, OPf_SPECIAL|OPf_STACKED, list(prepend_elem(OP_LIST, - scalar(newCVREF(scalar(yyvsp[-2].opval))), newNULLLIST()))); } + scalar(newCVREF(scalar(yyvsp[-2].opval))), Nullop))); } break; case 127: -#line 505 "perly.y" +#line 513 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUBR, OPf_SPECIAL|OPf_STACKED, list(prepend_elem(OP_LIST, scalar(newCVREF(scalar(yyvsp[-3].opval))), yyvsp[-1].opval))); } break; case 128: -#line 510 "perly.y" +#line 518 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUBR, OPf_SPECIAL|OPf_STACKED, list(prepend_elem(OP_LIST, - scalar(newCVREF(scalar(yyvsp[-2].opval))), newNULLLIST())));} + scalar(newCVREF(scalar(yyvsp[-2].opval))), Nullop)));} break; case 129: -#line 514 "perly.y" +#line 522 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUBR, OPf_SPECIAL|OPf_STACKED, list(prepend_elem(OP_LIST, scalar(newCVREF(scalar(yyvsp[-3].opval))), yyvsp[-1].opval))); } break; case 130: -#line 519 "perly.y" +#line 527 "perly.y" { yyval.opval = newOP(yyvsp[0].ival, OPf_SPECIAL); needblockscope = TRUE; } break; case 131: -#line 521 "perly.y" -{ yyval.opval = newPVOP(yyvsp[-1].ival, 0, - savestr(SvPVx(((SVOP*)yyvsp[0].opval)->op_sv, na))); - op_free(yyvsp[0].opval); needblockscope = TRUE; } +#line 529 "perly.y" +{ yyval.opval = newLOOPEX(yyvsp[-1].ival,yyvsp[0].opval); } break; case 132: -#line 525 "perly.y" +#line 531 "perly.y" { yyval.opval = newOP(yyvsp[0].ival, 0); } break; case 133: -#line 527 "perly.y" +#line 533 "perly.y" { yyval.opval = newUNOP(yyvsp[-1].ival, 0, yyvsp[0].opval); } break; case 134: -#line 529 "perly.y" +#line 535 "perly.y" { yyval.opval = newUNOP(yyvsp[-1].ival, 0, yyvsp[0].opval); } break; case 135: -#line 531 "perly.y" +#line 537 "perly.y" { yyval.opval = newOP(yyvsp[0].ival, 0); } break; case 136: -#line 533 "perly.y" +#line 539 "perly.y" { yyval.opval = newOP(yyvsp[-2].ival, 0); } break; case 137: -#line 535 "perly.y" +#line 541 "perly.y" { yyval.opval = newOP(yyvsp[-2].ival, OPf_SPECIAL); } break; case 138: -#line 537 "perly.y" +#line 543 "perly.y" { yyval.opval = newUNOP(yyvsp[-3].ival, 0, yyvsp[-1].opval); } break; case 139: -#line 539 "perly.y" +#line 545 "perly.y" { yyval.opval = pmruntime(yyvsp[-3].opval, yyvsp[-1].opval, Nullop); } break; case 140: -#line 541 "perly.y" +#line 547 "perly.y" { yyval.opval = pmruntime(yyvsp[-5].opval, yyvsp[-3].opval, yyvsp[-1].opval); } break; case 143: -#line 547 "perly.y" -{ yyval.opval = newNULLLIST(); } +#line 553 "perly.y" +{ yyval.opval = Nullop; } break; case 144: -#line 549 "perly.y" +#line 555 "perly.y" { yyval.opval = yyvsp[0].opval; } break; case 145: -#line 553 "perly.y" +#line 559 "perly.y" { yyval.opval = newCVREF(yyvsp[0].opval); } break; case 146: -#line 557 "perly.y" +#line 563 "perly.y" { yyval.opval = newSVREF(yyvsp[0].opval); } break; case 147: -#line 561 "perly.y" +#line 567 "perly.y" { yyval.opval = newAVREF(yyvsp[0].opval); } break; case 148: -#line 565 "perly.y" +#line 571 "perly.y" { yyval.opval = newHVREF(yyvsp[0].opval); } break; case 149: -#line 569 "perly.y" +#line 575 "perly.y" { yyval.opval = newAVREF(yyvsp[0].opval); } break; case 150: -#line 573 "perly.y" +#line 579 "perly.y" { yyval.opval = newGVREF(yyvsp[0].opval); } break; case 151: -#line 577 "perly.y" +#line 583 "perly.y" { yyval.opval = scalar(yyvsp[0].opval); } break; case 152: -#line 579 "perly.y" +#line 585 "perly.y" { yyval.opval = scalar(yyvsp[0].opval); } break; case 153: -#line 581 "perly.y" +#line 587 "perly.y" { yyval.opval = scalar(scope(yyvsp[0].opval)); } break; case 154: -#line 584 "perly.y" +#line 590 "perly.y" { yyval.opval = yyvsp[0].opval; } break; case 155: -#line 588 "perly.y" +#line 594 "perly.y" { yyval.ival = 1; } break; case 156: -#line 590 "perly.y" +#line 596 "perly.y" { yyval.ival = 0; } break; case 157: -#line 594 "perly.y" +#line 600 "perly.y" { yyval.ival = 1; } break; case 158: -#line 596 "perly.y" +#line 602 "perly.y" { yyval.ival = 0; } break; case 159: -#line 600 "perly.y" +#line 606 "perly.y" { yyval.ival = 1; } break; case 160: -#line 602 "perly.y" +#line 608 "perly.y" { yyval.ival = 0; } break; -#line 2523 "y.tab.c" +#line 2484 "y.tab.c" } yyssp -= yym; yystate = *yyssp; diff --git a/perly.c.diff b/perly.c.diff index 4d81353..c8d6f10 100644 --- a/perly.c.diff +++ b/perly.c.diff @@ -1,7 +1,7 @@ -*** perly.c.orig Fri Jan 14 03:56:26 1994 ---- perly.c Sun Jan 16 18:29:19 1994 +*** perly.c.orig Mon Feb 14 14:24:43 1994 +--- perly.c Mon Feb 14 14:24:44 1994 *************** -*** 1635,1647 **** +*** 1591,1603 **** int yynerrs; int yyerrflag; int yychar; @@ -12,13 +12,13 @@ - short yyss[YYSTACKSIZE]; - YYSTYPE yyvs[YYSTACKSIZE]; - #define yystacksize YYSTACKSIZE - #line 605 "perly.y" + #line 611 "perly.y" /* PROGRAM */ - #line 1648 "y.tab.c" ---- 1635,1642 ---- + #line 1604 "y.tab.c" +--- 1591,1598 ---- *************** -*** 1652,1657 **** ---- 1647,1665 ---- +*** 1608,1613 **** +--- 1603,1621 ---- yyparse() { register int yym, yyn, yystate; @@ -39,8 +39,8 @@ register char *yys; extern char *getenv(); *************** -*** 1668,1673 **** ---- 1676,1689 ---- +*** 1624,1629 **** +--- 1632,1645 ---- yyerrflag = 0; yychar = (-1); @@ -56,7 +56,7 @@ yyvsp = yyvs; *yyssp = yystate = 0; *************** -*** 1683,1689 **** +*** 1639,1645 **** yys = 0; if (yychar <= YYMAXTOKEN) yys = yyname[yychar]; if (!yys) yys = "illegal-symbol"; @@ -64,7 +64,7 @@ yychar, yys); } #endif ---- 1699,1705 ---- +--- 1655,1661 ---- yys = 0; if (yychar <= YYMAXTOKEN) yys = yyname[yychar]; if (!yys) yys = "illegal-symbol"; @@ -73,7 +73,7 @@ } #endif *************** -*** 1693,1704 **** +*** 1649,1660 **** { #if YYDEBUG if (yydebug) @@ -86,7 +86,7 @@ } *++yyssp = yystate = yytable[yyn]; *++yyvsp = yylval; ---- 1709,1732 ---- +--- 1665,1688 ---- { #if YYDEBUG if (yydebug) @@ -112,7 +112,7 @@ *++yyssp = yystate = yytable[yyn]; *++yyvsp = yylval; *************** -*** 1734,1745 **** +*** 1690,1701 **** { #if YYDEBUG if (yydebug) @@ -125,7 +125,7 @@ } *++yyssp = yystate = yytable[yyn]; *++yyvsp = yylval; ---- 1762,1788 ---- +--- 1718,1744 ---- { #if YYDEBUG if (yydebug) @@ -154,7 +154,7 @@ *++yyssp = yystate = yytable[yyn]; *++yyvsp = yylval; *************** -*** 1749,1756 **** +*** 1705,1712 **** { #if YYDEBUG if (yydebug) @@ -163,7 +163,7 @@ #endif if (yyssp <= yyss) goto yyabort; --yyssp; ---- 1792,1800 ---- +--- 1748,1756 ---- { #if YYDEBUG if (yydebug) @@ -174,7 +174,7 @@ if (yyssp <= yyss) goto yyabort; --yyssp; *************** -*** 1767,1774 **** +*** 1723,1730 **** yys = 0; if (yychar <= YYMAXTOKEN) yys = yyname[yychar]; if (!yys) yys = "illegal-symbol"; @@ -183,7 +183,7 @@ } #endif yychar = (-1); ---- 1811,1819 ---- +--- 1767,1775 ---- yys = 0; if (yychar <= YYMAXTOKEN) yys = yyname[yychar]; if (!yys) yys = "illegal-symbol"; @@ -194,7 +194,7 @@ #endif yychar = (-1); *************** -*** 1777,1783 **** +*** 1733,1739 **** yyreduce: #if YYDEBUG if (yydebug) @@ -202,7 +202,7 @@ yystate, yyn, yyrule[yyn]); #endif yym = yylen[yyn]; ---- 1822,1828 ---- +--- 1778,1784 ---- yyreduce: #if YYDEBUG if (yydebug) @@ -211,7 +211,7 @@ #endif yym = yylen[yyn]; *************** -*** 2529,2536 **** +*** 2490,2497 **** { #if YYDEBUG if (yydebug) @@ -220,7 +220,7 @@ #endif yystate = YYFINAL; *++yyssp = YYFINAL; ---- 2574,2582 ---- +--- 2535,2543 ---- { #if YYDEBUG if (yydebug) @@ -231,7 +231,7 @@ yystate = YYFINAL; *++yyssp = YYFINAL; *************** -*** 2544,2550 **** +*** 2505,2511 **** yys = 0; if (yychar <= YYMAXTOKEN) yys = yyname[yychar]; if (!yys) yys = "illegal-symbol"; @@ -239,7 +239,7 @@ YYFINAL, yychar, yys); } #endif ---- 2590,2596 ---- +--- 2551,2557 ---- yys = 0; if (yychar <= YYMAXTOKEN) yys = yyname[yychar]; if (!yys) yys = "illegal-symbol"; @@ -248,7 +248,7 @@ } #endif *************** -*** 2559,2578 **** +*** 2520,2539 **** yystate = yydgoto[yym]; #if YYDEBUG if (yydebug) @@ -269,7 +269,7 @@ yyaccept: ! return (0); } ---- 2605,2645 ---- +--- 2566,2606 ---- yystate = yydgoto[yym]; #if YYDEBUG if (yydebug) diff --git a/perly.h b/perly.h index 5d90ce1..3dbb284 100644 --- a/perly.h +++ b/perly.h @@ -40,14 +40,14 @@ #define UNIOP 296 #define SHIFTOP 297 #define MATCHOP 298 -#define ARROW 299 -#define UMINUS 300 -#define REFGEN 301 -#define POWOP 302 -#define PREINC 303 -#define PREDEC 304 -#define POSTINC 305 -#define POSTDEC 306 +#define UMINUS 299 +#define REFGEN 300 +#define POWOP 301 +#define PREINC 302 +#define PREDEC 303 +#define POSTINC 304 +#define POSTDEC 305 +#define ARROW 306 typedef union { I32 ival; char *pval; diff --git a/perly.y b/perly.y index 1ac9ce1..ac73fc0 100644 --- a/perly.y +++ b/perly.y @@ -90,10 +90,11 @@ %left SHIFTOP %left ADDOP %left MULOP -%left MATCHOP ARROW +%left MATCHOP %right '!' '~' UMINUS REFGEN %right POWOP %nonassoc PREINC PREDEC POSTINC POSTDEC +%left ARROW %left '(' %% /* RULES */ @@ -103,7 +104,7 @@ prog : /* NULL */ #if defined(YYDEBUG) && defined(DEBUGGING) yydebug = (debug & 1); #endif - expect = XBLOCK; + expect = XSTATE; } /*CONTINUED*/ lineseq { if (in_eval) { @@ -122,15 +123,19 @@ block : '{' remember lineseq '}' $$ = scalarseq($3); if (copline > (line_t)$1) copline = $1; - leave_scope($2); + LEAVE_SCOPE($2); if (nbs) needblockscope = TRUE; /* propagate outward */ - pad_leavemy(comppadnamefill); } + pad_leavemy(comppad_name_fill); } ; remember: /* NULL */ /* in case they push a package name */ { $$ = savestack_ix; - SAVEINT(comppadnamefill); + comppad_name_fill = AvFILL(comppad_name); + SAVEINT(min_intro_pending); + SAVEINT(max_intro_pending); + min_intro_pending = 0; + SAVEINT(comppad_name_fill); SAVEINT(needblockscope); needblockscope = FALSE; } ; @@ -156,10 +161,10 @@ line : label cond $$ = Nullop; copline = NOLINE; } - expect = XBLOCK; } + expect = XSTATE; } | label sideff ';' { $$ = newSTATEOP(0, $1, $2); - expect = XBLOCK; } + expect = XSTATE; } ; sideff : error @@ -171,9 +176,9 @@ sideff : error | expr UNLESS expr { $$ = newLOGOP(OP_OR, 0, $3, $1); } | expr WHILE expr - { $$ = newLOOPOP(0, 1, scalar($3), $1); } + { $$ = newLOOPOP(OPf_PARENS, 1, scalar($3), $1); } | expr UNTIL expr - { $$ = newLOOPOP(0, 1, invert(scalar($3)), $1);} + { $$ = newLOOPOP(OPf_PARENS, 1, invert(scalar($3)), $1);} ; else : /* NULL */ @@ -278,7 +283,7 @@ format : FORMAT WORD block subrout : SUB WORD block { newSUB($1, $2, $3); } | SUB WORD ';' - { newSUB($1, $2, Nullop); expect = XBLOCK; } + { newSUB($1, $2, Nullop); expect = XSTATE; } ; package : PACKAGE WORD ';' @@ -306,10 +311,12 @@ listop : LSTOP indirob listexpr prepend_elem(OP_LIST, newGVREF($1), $5) ); } | term ARROW METHOD '(' listexpr ')' { $$ = convert(OP_ENTERSUBR, OPf_STACKED|OPf_SPECIAL, - prepend_elem(OP_LIST, newMETHOD($1,$3), $5)); } + prepend_elem(OP_LIST, + newMETHOD($1,$3), list($5))); } | METHOD indirob listexpr { $$ = convert(OP_ENTERSUBR, OPf_STACKED|OPf_SPECIAL, - prepend_elem(OP_LIST, newMETHOD($2,$1), $3)); } + prepend_elem(OP_LIST, + newMETHOD($2,$1), list($3))); } | LSTOP listexpr { $$ = convert($1, 0, $2); } | FUNC '(' listexpr ')' @@ -391,7 +398,7 @@ term : '-' term %prec UMINUS | '~' term { $$ = newUNOP(OP_COMPLEMENT, 0, scalar($2));} | REFGEN term - { $$ = newUNOP(OP_REFGEN, 0, mod($2,OP_REFGEN)); } + { $$ = newUNOP(OP_REFGEN, 0, ref($2,OP_REFGEN)); } | term POSTINC { $$ = newUNOP(OP_POSTINC, 0, mod(scalar($1), OP_POSTINC)); } @@ -409,7 +416,7 @@ term : '-' term %prec UMINUS | '(' expr crp { $$ = sawparens($2); } | '(' ')' - { $$ = newNULLLIST(); } + { $$ = sawparens(newNULLLIST()); } | '[' expr crb %prec '(' { $$ = newANONLIST($2); } | '[' ']' %prec '(' @@ -426,11 +433,11 @@ term : '-' term %prec UMINUS { $$ = newBINOP(OP_AELEM, 0, oopsAV($1), scalar($3)); } | term ARROW '[' expr ']' %prec '(' { $$ = newBINOP(OP_AELEM, 0, - scalar(ref(newAVREF($1),OP_RV2AV)), + ref(newAVREF($1),OP_RV2AV), scalar($4));} | term '[' expr ']' %prec '(' { $$ = newBINOP(OP_AELEM, 0, - scalar(ref(newAVREF($1),OP_RV2AV)), + ref(newAVREF($1),OP_RV2AV), scalar($3));} | hsh %prec '(' { $$ = $1; } @@ -443,12 +450,12 @@ term : '-' term %prec UMINUS expect = XOPERATOR; } | term ARROW '{' expr ';' '}' %prec '(' { $$ = newBINOP(OP_HELEM, 0, - scalar(ref(newHVREF($1),OP_RV2HV)), + ref(newHVREF($1),OP_RV2HV), jmaybe($4)); expect = XOPERATOR; } | term '{' expr ';' '}' %prec '(' { $$ = newBINOP(OP_HELEM, 0, - scalar(ref(newHVREF($1),OP_RV2HV)), + ref(newHVREF($1),OP_RV2HV), jmaybe($3)); expect = XOPERATOR; } | '(' expr crp '[' expr ']' %prec '(' @@ -492,7 +499,8 @@ term : '-' term %prec UMINUS newCVREF(scalar($2)), $3))); } | NOAMP WORD indirob listexpr { $$ = convert(OP_ENTERSUBR, OPf_STACKED|OPf_SPECIAL, - prepend_elem(OP_LIST, newMETHOD($3,$2), $4)); } + prepend_elem(OP_LIST, + newMETHOD($3,$2), list($4))); } | DO sexpr %prec UNIOP { $$ = newUNOP(OP_DOFILE, 0, scalar($2)); } | DO block %prec '(' @@ -500,7 +508,7 @@ term : '-' term %prec UMINUS | DO WORD '(' ')' { $$ = newUNOP(OP_ENTERSUBR, OPf_SPECIAL|OPf_STACKED, list(prepend_elem(OP_LIST, - scalar(newCVREF(scalar($2))), newNULLLIST()))); } + scalar(newCVREF(scalar($2))), Nullop))); } | DO WORD '(' expr crp { $$ = newUNOP(OP_ENTERSUBR, OPf_SPECIAL|OPf_STACKED, list(prepend_elem(OP_LIST, @@ -509,7 +517,7 @@ term : '-' term %prec UMINUS | DO scalar '(' ')' { $$ = newUNOP(OP_ENTERSUBR, OPf_SPECIAL|OPf_STACKED, list(prepend_elem(OP_LIST, - scalar(newCVREF(scalar($2))), newNULLLIST())));} + scalar(newCVREF(scalar($2))), Nullop)));} | DO scalar '(' expr crp { $$ = newUNOP(OP_ENTERSUBR, OPf_SPECIAL|OPf_STACKED, list(prepend_elem(OP_LIST, @@ -517,10 +525,8 @@ term : '-' term %prec UMINUS $4))); } | LOOPEX { $$ = newOP($1, OPf_SPECIAL); needblockscope = TRUE; } - | LOOPEX WORD - { $$ = newPVOP($1, 0, - savestr(SvPVx(((SVOP*)$2)->op_sv, na))); - op_free($2); needblockscope = TRUE; } + | LOOPEX sexpr + { $$ = newLOOPEX($1,$2); } | UNIOP { $$ = newOP($1, 0); } | UNIOP block @@ -544,7 +550,7 @@ term : '-' term %prec UMINUS ; listexpr: /* NULL */ - { $$ = newNULLLIST(); } + { $$ = Nullop; } | expr { $$ = $1; } ; diff --git a/perly.y.save b/perly.y.save deleted file mode 100644 index 8babbb9..0000000 --- a/perly.y.save +++ /dev/null @@ -1,591 +0,0 @@ -/* $RCSfile: perly.y,v $$Revision: 4.1 $$Date: 92/08/07 18:26:16 $ - * - * Copyright (c) 1991, Larry Wall - * - * You may distribute under the terms of either the GNU General Public - * License or the Artistic License, as specified in the README file. - * - * $Log: perly.y,v $ - * Revision 4.1 92/08/07 18:26:16 lwall - * - * Revision 4.0.1.5 92/06/11 21:12:50 lwall - * patch34: expectterm incorrectly set to indicate start of program or block - * - * Revision 4.0.1.4 92/06/08 17:33:25 lwall - * patch20: one of the backdoors to expectterm was on the wrong reduction - * - * Revision 4.0.1.3 92/06/08 15:18:16 lwall - * patch20: an expression may now start with a bareword - * patch20: relaxed requirement for semicolon at the end of a block - * patch20: added ... as variant on .. - * patch20: fixed double debug break in foreach with implicit array assignment - * patch20: if {block} {block} didn't work any more - * patch20: deleted some minor memory leaks - * - * Revision 4.0.1.2 91/11/05 18:17:38 lwall - * patch11: extra comma at end of list is now allowed in more places (Hi, Felix!) - * patch11: once-thru blocks didn't display right in the debugger - * patch11: debugger got confused over nested subroutine definitions - * - * Revision 4.0.1.1 91/06/07 11:42:34 lwall - * patch4: new copyright notice - * - * Revision 4.0 91/03/20 01:38:40 lwall - * 4.0 baseline. - * - */ - -%{ -#include "EXTERN.h" -#include "perl.h" - -/*SUPPRESS 530*/ -/*SUPPRESS 593*/ -/*SUPPRESS 595*/ - -%} - -%start prog - -%union { - int ival; - char *cval; - OP *opval; - COP *copval; - struct compcmd compval; - GV *stabval; - FF *formval; -} - -%token '{' ')' - -%token WORD -%token LABEL -%token APPEND OPEN SSELECT LOOPEX DOTDOT DOLSHARP -%token USING FORMAT DO SHIFT PUSH POP LVALFUN -%token WHILE UNTIL IF UNLESS ELSE ELSIF CONTINUE SPLIT FLIST -%token FOR FILOP FILOP2 FILOP3 FILOP4 FILOP22 FILOP25 -%token FUNC0 FUNC1 FUNC2 FUNC2x FUNC3 FUNC4 FUNC5 HSHFUN HSHFUN3 -%token FLIST2 SUB LOCAL DELETE FUNC -%token RELOP EQOP MULOP ADDOP PACKAGE -%token FORMLIST -%token THING STRING - -%type prog decl format remember crp -%type block lineseq line loop cond sideff nexpr else -%type expr sexpr term scalar ary hsh arylen star amper -%type listexpr indirob -%type texpr listop -%type label -%type compblock - -%nonassoc LSTOP -%left ',' -%right '=' -%right '?' ':' -%nonassoc DOTDOT -%left OROR -%left ANDAND -%left BITOROP -%left BITANDOP -%nonassoc EQOP -%nonassoc RELOP -%nonassoc UNIOP -%left SHIFTOP -%left ADDOP -%left MULOP -%left MATCHOP -%right '!' '~' UMINUS -%right POWOP -%nonassoc INC DEC -%left '(' - -%% /* RULES */ - -prog : /* NULL */ - { -#if defined(YYDEBUG) && defined(DEBUGGING) - yydebug = (debug & 1); -#endif - expectterm = 2; - } - /*CONTINUED*/ lineseq - { if (in_eval) - eval_root = block_head($2); - else - main_root = block_head($2); } - ; - -compblock: block CONTINUE block - { $$.comp_true = $1; $$.comp_alt = $3; } - | block else - { $$.comp_true = $1; $$.comp_alt = $2; } - ; - -else : /* NULL */ - { $$ = Nullcop; } - | ELSE block - { $$ = $2; } - | ELSIF '(' expr ')' compblock - { cmdline = $1; - $$ = newCCOP(OP_ELSIF,1,$3,$5); } - ; - -block : '{' remember lineseq '}' - { $$ = block_head($3); - if (cmdline > (line_t)$1) - cmdline = $1; - if (savestack->av_fill > $2) - leave_scope($2); - expectterm = 2; } - ; - -remember: /* NULL */ /* in case they push a package name */ - { $$ = savestack->av_fill; } - ; - -lineseq : /* NULL */ - { $$ = Nullcop; } - | lineseq line - { $$ = append_elem(OP_LINESEQ,$1,$2); } - ; - -line : decl - { $$ = Nullcop; } - | label cond - { $$ = add_label($1,$2); } - | loop /* loops add their own labels */ - | label ';' - { if ($1 != Nullch) { - $$ = add_label($1, newACOP(Nullgv, Nullop) ); - } - else { - $$ = Nullcop; - cmdline = NOLINE; - } - expectterm = 2; } - | label sideff ';' - { $$ = add_label($1,$2); - expectterm = 2; } - ; - -sideff : error - { $$ = Nullcop; } - | expr - { $$ = newACOP(Nullgv, $1); } - | expr IF expr - { $$ = addcond( - newACOP(Nullgv, Nullop, $1), $3); } - | expr UNLESS expr - { $$ = addcond(invert( - newACOP(Nullgv, Nullop, $1)), $3); } - | expr WHILE expr - { $$ = addloop( - newACOP(Nullgv, Nullop, $1), $3); } - | expr UNTIL expr - { $$ = addloop(invert( - newACOP(Nullgv, Nullop, $1)), $3); } - ; - -cond : IF '(' expr ')' compblock - { cmdline = $1; - $$ = newICOP(OP_IF,$3,$5); } - | UNLESS '(' expr ')' compblock - { cmdline = $1; - $$ = invert(newICOP(OP_IF,$3,$5)); } - | IF block compblock - { cmdline = $1; - $$ = newICOP(OP_IF,$2,$3); } - | UNLESS block compblock - { cmdline = $1; - $$ = invert(newICOP(OP_IF,$2,$3)); } - ; - -loop : label WHILE '(' texpr ')' compblock - { cmdline = $2; - $$ = wopt(add_label($1, - newCCOP(OP_WHILE,1,$4,$6) )); } - | label UNTIL '(' expr ')' compblock - { cmdline = $2; - $$ = wopt(add_label($1, - invert(newCCOP(OP_WHILE,1,$4,$6)) )); } - | label WHILE block compblock - { cmdline = $2; - $$ = wopt(add_label($1, - newCCOP(OP_WHILE, 1, $3,$4) )); } - | label UNTIL block compblock - { cmdline = $2; - $$ = wopt(add_label($1, - invert(newCCOP(OP_WHILE,1,$3,$4)) )); } - | label FOR scalar '(' expr crp compblock - { cmdline = $2; - /* - * The following gobbledygook catches EXPRs that - * aren't explicit array refs and translates - * foreach VAR (EXPR) { - * into - * @ary = EXPR; - * foreach VAR (@ary) { - * where @ary is a hidden array made by newGVgen(). - * (Note that @ary may become a local array if - * it is determined that it might be called - * recursively. See cmd_tosave().) - */ - if ($5->op_type != OP_ARRAY) { - scrstab = gv_AVadd(newGVgen()); - $$ = append_elem(OP_LINESEQ, - newACOP(Nullgv, - newBINOP(OP_ASSIGN, - listref(newUNOP(OP_ARRAY, - gv_to_op(A_STAB,scrstab))), - forcelist($5))), - wopt(over($3,add_label($1, - newCCOP(OP_WHILE, 0, - newUNOP(OP_ARRAY, - gv_to_op(A_STAB,scrstab)), - $7))))); - $$->cop_line = $2; - $$->cop_head->cop_line = $2; - } - else { - $$ = wopt(over($3,add_label($1, - newCCOP(OP_WHILE,1,$5,$7) ))); - } - } - | label FOR '(' expr crp compblock - { cmdline = $2; - if ($4->op_type != OP_ARRAY) { - scrstab = gv_AVadd(newGVgen()); - $$ = append_elem(OP_LINESEQ, - newACOP(Nullgv, - newBINOP(OP_ASSIGN, - listref(newUNOP(OP_ARRAY, - gv_to_op(A_STAB,scrstab))), - forcelist($4))), - wopt(over(defstab,add_label($1, - newCCOP(OP_WHILE, 0, - newUNOP(OP_ARRAY, - gv_to_op(A_STAB,scrstab)), - $6))))); - $$->cop_line = $2; - $$->cop_head->cop_line = $2; - } - else { /* lisp, anyone? */ - $$ = wopt(over(defstab,add_label($1, - newCCOP(OP_WHILE,1,$4,$6) ))); - } - } - | label FOR '(' nexpr ';' texpr ';' nexpr ')' block - /* basically fake up an initialize-while lineseq */ - { yyval.compval.comp_true = $10; - yyval.compval.comp_alt = $8; - cmdline = $2; - $$ = append_elem(OP_LINESEQ,$4,wopt(add_label($1, - newCCOP(OP_WHILE,1,$6,yyval.compval) ))); } - | label compblock /* a block is a loop that happens once */ - { $$ = add_label($1,newCCOP(OP_BLOCK,1,Nullop,$2)); } - ; - -nexpr : /* NULL */ - { $$ = Nullcop; } - | sideff - ; - -texpr : /* NULL means true */ - { (void)scan_num("1"); $$ = yylval.op; } - | expr - ; - -label : /* empty */ - { $$ = Nullch; } - | LABEL - ; - -decl : format - { $$ = 0; } - | subrout - { $$ = 0; } - | package - { $$ = 0; } - ; - -format : FORMAT WORD '=' FORMLIST - { if (strEQ($2,"stdout")) - newFORM(newGV("STDOUT",TRUE),$4); - else if (strEQ($2,"stderr")) - newFORM(newGV("STDERR",TRUE),$4); - else - newFORM(newGV($2,TRUE),$4); - Safefree($2); $2 = Nullch; } - | FORMAT '=' FORMLIST - { newFORM(newGV("STDOUT",TRUE),$3); } - ; - -subrout : SUB WORD block - { newSUB($2,$3); - cmdline = NOLINE; - if (savestack->av_fill > $1) - leave_scope($1); } - ; - -package : PACKAGE WORD ';' - { char tmpbuf[256]; - GV *tmpstab; - - save_hptr(&curstash); - save_item(curstname); - sv_setpv(curstname,$2); - sprintf(tmpbuf,"'_%s",$2); - tmpstab = newGV(tmpbuf,TRUE); - if (!GvHV(tmpstab)) - GvHV(tmpstab) = newHV(0); - curstash = GvHV(tmpstab); - if (!curstash->hv_name) - curstash->hv_name = savestr($2); - curstash->hv_coeffsize = 0; - Safefree($2); $2 = Nullch; - cmdline = NOLINE; - expectterm = 2; - } - ; - -expr : expr ',' sexpr - { $$ = append_elem(OP_LIST, $1, $3); } - | sexpr - ; - -sexpr : sexpr '=' sexpr - { $$ = newBINOP(OP_ASSIGN, ref($1), $3); } - | sexpr POWOP '=' sexpr - { $$ = newBINOP($2, ref($1), $4); } - | sexpr MULOP '=' sexpr - { $$ = newBINOP($2, ref($1), $4); } - | sexpr ADDOP '=' sexpr - { $$ = newBINOP($2, ref($1), $4);} - | sexpr SHIFTOP '=' sexpr - { $$ = newBINOP($2, ref($1), $4); } - | sexpr BITANDOP '=' sexpr - { $$ = newBINOP($2, ref($1), $4); } - | sexpr BITOROP '=' sexpr - { $$ = newBINOP($2, ref($1), $4); } - - - | sexpr POWOP sexpr - { $$ = newBINOP($2, $1, $3); } - | sexpr MULOP sexpr - { if ($2 == OP_REPEAT) - $1 = forcelist($1); - $$ = newBINOP($2, $1, $3); - if ($2 == OP_REPEAT) { - if ($$[1].op_type != A_EXPR || - $$[1].op_ptr.op_op->op_type != OP_LIST) - $$[1].op_flags &= ~AF_ARYOK; - } } - | sexpr ADDOP sexpr - { $$ = newBINOP($2, $1, $3); } - | sexpr SHIFTOP sexpr - { $$ = newBINOP($2, $1, $3); } - | sexpr RELOP sexpr - { $$ = newBINOP($2, $1, $3); } - | sexpr EQOP sexpr - { $$ = newBINOP($2, $1, $3); } - | sexpr BITANDOP sexpr - { $$ = newBINOP($2, $1, $3); } - | sexpr BITOROP sexpr - { $$ = newBINOP($2, $1, $3); } - | sexpr DOTDOT sexpr - { $$ = newBINOP($2, $1, $3); } - | sexpr ANDAND sexpr - { $$ = newBINOP(OP_AND, $1, $3); } - | sexpr OROR sexpr - { $$ = newBINOP(OP_OR, $1, $3); } - | sexpr '?' sexpr ':' sexpr - { $$ = newCONDOP(OP_COND_EXPR, $1, $3, $5); } - | sexpr MATCHOP sexpr - { $$ = bind_match($2, $1, $3); } - | term - { $$ = $1; } - ; - -term : '-' term %prec UMINUS - { $$ = newUNOP(OP_NEGATE, $2); } - | '+' term %prec UMINUS - { $$ = $2; } - | '!' term - { $$ = newUNOP(OP_NOT, $2); } - | '~' term - { $$ = newUNOP(OP_COMPLEMENT, $2);} - | term INC - { $$ = newUNOP(OP_POSTINC,ref($1)); } - | term DEC - { $$ = newUNOP(OP_POSTDEC,ref($1)); } - | INC term - { $$ = newUNOP(OP_PREINC,ref($2)); } - | DEC term - { $$ = newUNOP(OP_PREDEC,ref($2)); } - | LOCAL '(' expr crp - { $$ = localize(forcelist($3)); } - | '(' expr crp - { $$ = $2; } - | '(' ')' - { $$ = Nullop; } /* XXX may be insufficient */ - | scalar %prec '(' - { $$ = gv_to_op(A_STAB,$1); } - | star %prec '(' - { $$ = gv_to_op(A_STAR,$1); } - | scalar '[' expr ']' %prec '(' - { $$ = newBINOP(OP_AELEM, - gv_to_op(A_STAB,gv_AVadd($1)), $3); } - | hsh %prec '(' - { $$ = newUNOP(OP_HASH, gv_to_op(A_STAB,$1)); } - | ary %prec '(' - { $$ = newUNOP(OP_ARRAY, gv_to_op(A_STAB,$1)); } - | arylen %prec '(' - { $$ = newUNOP(OP_ARYLEN, gv_to_op(A_STAB,$1)); } - | scalar '{' expr ';' '}' %prec '(' - { $$ = newBINOP(OP_HELEM, - gv_to_op(A_STAB,gv_HVadd($1)), - jmaybe($3)); - expectterm = FALSE; } - | '(' expr crp '[' expr ']' %prec '(' - { $$ = newSLICEOP(OP_LSLICE, Nullop, - forcelist($5), - forcelist($2)); } - | '(' ')' '[' expr ']' %prec '(' - { $$ = newSLICEOP(OP_LSLICE, Nullop, - forcelist($4), Nullop); } - | ary '[' expr ']' %prec '(' - { $$ = newBINOP(OP_ASLICE, - gv_to_op(A_STAB,gv_AVadd($1)), - forcelist($3)); } - | ary '{' expr ';' '}' %prec '(' - { $$ = newBINOP(OP_HSLICE, - gv_to_op(A_STAB,gv_HVadd($1)), - forcelist($3)); - expectterm = FALSE; } - | DELETE scalar '{' expr ';' '}' %prec '(' - { $$ = newBINOP(OP_DELETE, - gv_to_op(A_STAB,gv_HVadd($2)), - jmaybe($4)); - expectterm = FALSE; } - | DELETE '(' scalar '{' expr ';' '}' ')' %prec '(' - { $$ = newBINOP(OP_DELETE, - gv_to_op(A_STAB,gv_HVadd($3)), - jmaybe($5)); - expectterm = FALSE; } - | THING %prec '(' - { $$ = $1; } - - | amper - { $$ = newUNIOP(OP_SUBR, - gv_to_op(A_STAB,$1)); } - | amper '(' ')' - { $$ = newBINOP(OP_SUBR, - gv_to_op(A_STAB,$1), - flatten(Nullop)); } - | amper '(' expr crp - { $$ = newBINOP(OP_SUBR, - gv_to_op(A_STAB,$1), - $3); } - - | DO sexpr %prec UNIOP - { $$ = newUNOP(OP_DOFILE,$2); - allgvs = TRUE;} - | DO block %prec '(' - { $$ = $2; } - | DO WORD '(' ')' - { $$ = newBINOP(OP_SUBR, - gv_to_op(A_WORD,newGV($2,MULTI)), - Nullop); - Safefree($2); $2 = Nullch; - $$->op_flags |= AF_DEPR; } - | DO WORD '(' expr crp - { $$ = newBINOP(OP_SUBR, - gv_to_op(A_WORD,newGV($2,MULTI)), - $4); Safefree($2); $2 = Nullch; - $$->op_flags |= AF_DEPR; } - | DO scalar '(' ')' - { $$ = newBINOP(OP_SUBR, - gv_to_op(A_STAB,$2), - flatten(Nullop)); - $$->op_flags |= AF_DEPR; } - | DO scalar '(' expr crp - { $$ = newBINOP(OP_SUBR, - gv_to_op(A_STAB,$2), - $4); - $$->op_flags |= AF_DEPR; } - | LOOPEX - { $$ = newOP($1); } - | LOOPEX WORD - { $$ = newUNIOP($1,pv_to_op($2)); } - | UNIOP - { $$ = newOP($1); } - | UNIOP block - { $$ = newUNOP($1,$2); } - | UNIOP sexpr - { $$ = newUNOP($1,$2); } - | FUNC0 - { $$ = newOP($1); } - | FUNC0 '(' ')' - { $$ = newOP($1); } - | FUNC1 '(' ')' - { $$ = newOP($1); } - | FUNC1 '(' expr ')' - { $$ = newUNIOP($1,$3); } - | WORD - | listop - ; - -listop : LSTOP listexpr - { $$ = newUNOP($1, $2); } - | FUNC '(' listexpr ')' - { $$ = newUNOP($1, $3); } - ; - -listexpr: /* NULL */ - { $$ = newNULLLIST(); } - | expr - { $$ = $1; } - | indirob expr - { $$ = prepend_elem(OP_LIST, $1, $2); } - ; - -amper : '&' indirob - { $$ = $2; } - ; - -scalar : '$' indirob - { $$ = $2; } - ; - -ary : '@' indirob - { $$ = $2; } - ; - -hsh : '%' indirob - { $$ = $2; } - ; - -arylen : DOLSHARP indirob - { $$ = $2; } - ; - -star : '*' indirob - { $$ = $2; } - ; - -indirob : WORD - { $$ = newINDIROB($1); } - | scalar - { $$ = newINDIROB($1); } - | block - { $$ = newINDIROB($1); } - ; - -crp : ',' ')' - { $$ = 1; } - | ')' - { $$ = 0; } - ; - -%% /* PROGRAM */ diff --git a/pp.c b/pp.c index c819f38..d5c33d1 100644 --- a/pp.c +++ b/pp.c @@ -58,8 +58,12 @@ extern int h_errno; #include #endif -#ifdef I_VARARGS -# include +#ifdef STANDARD_C +# include +#else +# ifdef I_VARARGS +# include +# endif #endif static I32 dopoptosub P((I32 startingblock)); @@ -175,8 +179,8 @@ PP(pp_padsv) { dSP; dTARGET; XPUSHs(TARG); - if ((op->op_flags & (OPf_INTRO|OPf_SPECIAL)) == OPf_INTRO) - SvOK_off(TARG); + if (op->op_flags & OPf_INTRO) + SAVECLEARSV(curpad[op->op_targ]); RETURN; } @@ -184,8 +188,8 @@ PP(pp_padav) { dSP; dTARGET; XPUSHs(TARG); - if ((op->op_flags & (OPf_INTRO|OPf_SPECIAL)) == OPf_INTRO) - av_clear((AV*)TARG); + if (op->op_flags & OPf_INTRO) + SAVECLEARSV(curpad[op->op_targ]); if (op->op_flags & OPf_LVAL) RETURN; PUTBACK; @@ -196,8 +200,8 @@ PP(pp_padhv) { dSP; dTARGET; XPUSHs(TARG); - if ((op->op_flags & (OPf_INTRO|OPf_SPECIAL)) == OPf_INTRO) - hv_clear((HV*)TARG); + if (op->op_flags & OPf_INTRO) + SAVECLEARSV(curpad[op->op_targ]); if (op->op_flags & OPf_LVAL) RETURN; PUTBACK; @@ -229,7 +233,7 @@ PP(pp_rv2gv) else { if (SvTYPE(sv) != SVt_PVGV) { if (!SvOK(sv)) - DIE(no_usym); + DIE(no_usym, "a glob"); sv = (SV*)gv_fetchpv(SvPV(sv, na), TRUE); } } @@ -282,26 +286,28 @@ PP(pp_rv2sv) GV *gv = sv; if (SvTYPE(gv) != SVt_PVGV) { if (!SvOK(sv)) - DIE(no_usym); + DIE(no_usym, "a scalar"); gv = (SV*)gv_fetchpv(SvPV(sv, na), TRUE); } sv = GvSV(gv); if (op->op_private == OP_RV2HV && (!SvROK(sv) || SvTYPE(SvRV(sv)) != SVt_PVHV)) { - sv_free(sv); + SvREFCNT_dec(sv); sv = NEWSV(0,0); sv_upgrade(sv, SVt_RV); - SvRV(sv) = sv_ref((SV*)newHV()); + SvRV(sv) = SvREFCNT_inc(newHV()); SvROK_on(sv); + ++sv_rvcount; GvSV(gv) = sv; } else if (op->op_private == OP_RV2AV && (!SvROK(sv) || SvTYPE(SvRV(sv)) != SVt_PVAV)) { - sv_free(sv); + SvREFCNT_dec(sv); sv = NEWSV(0,0); sv_upgrade(sv, SVt_RV); - SvRV(sv) = sv_ref((SV*)newAV()); + SvRV(sv) = SvREFCNT_inc(newAV()); SvROK_on(sv); + ++sv_rvcount; GvSV(gv) = sv; } } @@ -332,7 +338,9 @@ PP(pp_rv2cv) SV *sv; GV *gv; HV *stash; - CV *cv = sv_2cv(TOPs, &stash, &gv, 0); + + /* We always try to add a non-existent subroutine in case of AUTOLOAD. */ + CV *cv = sv_2cv(TOPs, &stash, &gv, TRUE); SETs((SV*)cv); RETURN; @@ -344,10 +352,11 @@ PP(pp_refgen) SV* rv; if (!sv) RETSETUNDEF; - rv = sv_mortalcopy(&sv_undef); + rv = sv_newmortal(); sv_upgrade(rv, SVt_RV); - SvRV(rv) = sv_ref(sv); + SvRV(rv) = SvREFCNT_inc(sv); SvROK_on(rv); + ++sv_rvcount; SETs(rv); RETURN; } @@ -417,7 +426,7 @@ PP(pp_bless) ref = SvRV(sv); SvOBJECT_on(ref); SvUPGRADE(ref, SVt_PVMG); - SvSTASH(ref) = stash; + SvSTASH(ref) = (HV*)SvREFCNT_inc(stash); RETURN; } @@ -444,7 +453,7 @@ PP(pp_backtick) for (;;) { sv = NEWSV(56, 80); if (sv_gets(sv, fp, 0) == Nullch) { - sv_free(sv); + SvREFCNT_dec(sv); break; } XPUSHs(sv_2mortal(sv)); @@ -478,26 +487,28 @@ do_readline() fp = Nullfp; if (io) { - fp = io->ifp; + fp = IoIFP(io); if (!fp) { - if (io->flags & IOf_ARGV) { - if (io->flags & IOf_START) { - io->flags &= ~IOf_START; - io->lines = 0; + if (IoFLAGS(io) & IOf_ARGV) { + if (IoFLAGS(io) & IOf_START) { + IoFLAGS(io) &= ~IOf_START; + IoLINES(io) = 0; if (av_len(GvAVn(last_in_gv)) < 0) { SV *tmpstr = newSVpv("-", 1); /* assume stdin */ (void)av_push(GvAVn(last_in_gv), tmpstr); } } fp = nextargv(last_in_gv); - if (!fp) { /* Note: fp != io->ifp */ + if (!fp) { /* Note: fp != IoIFP(io) */ (void)do_close(last_in_gv, FALSE); /* now it does*/ - io->flags |= IOf_START; + IoFLAGS(io) |= IOf_START; } } else if (type == OP_GLOB) { SV *tmpcmd = NEWSV(55, 0); SV *tmpglob = POPs; + ENTER; + SAVEFREESV(tmpcmd); #ifdef DOSISH sv_setpv(tmpcmd, "perlglob "); sv_catsv(tmpcmd, tmpglob); @@ -515,8 +526,8 @@ do_readline() #endif /* !CSH */ #endif /* !MSDOS */ (void)do_open(last_in_gv, SvPVX(tmpcmd), SvCUR(tmpcmd)); - fp = io->ifp; - sv_free(tmpcmd); + fp = IoIFP(io); + LEAVE; } } else if (type == OP_GLOB) @@ -547,12 +558,12 @@ do_readline() for (;;) { if (!sv_gets(sv, fp, offset)) { clearerr(fp); - if (io->flags & IOf_ARGV) { + if (IoFLAGS(io) & IOf_ARGV) { fp = nextargv(last_in_gv); if (fp) continue; (void)do_close(last_in_gv, FALSE); - io->flags |= IOf_START; + IoFLAGS(io) |= IOf_START; } else if (type == OP_GLOB) { (void)do_close(last_in_gv, FALSE); @@ -561,7 +572,7 @@ do_readline() RETPUSHUNDEF; RETURN; } - io->lines++; + IoLINES(io)++; XPUSHs(sv); if (tainting) { tainted = TRUE; @@ -777,7 +788,7 @@ play_it_again: } } if (--BmUSEFUL(pm->op_pmshort) < 0) { - sv_free(pm->op_pmshort); + SvREFCNT_dec(pm->op_pmshort); pm->op_pmshort = Nullsv; /* opt is being useless */ } } @@ -808,7 +819,7 @@ play_it_again: i = 0; EXTEND(SP, iters + i); for (i = !i; i <= iters; i++) { - PUSHs(sv_mortalcopy(&sv_no)); + PUSHs(sv_newmortal()); /*SUPPRESS 560*/ if (s = rx->startp[i]) { len = rx->endp[i] - s; @@ -955,7 +966,7 @@ PP(pp_subst) } } if (--BmUSEFUL(pm->op_pmshort) < 0) { - sv_free(pm->op_pmshort); + SvREFCNT_dec(pm->op_pmshort); pm->op_pmshort = Nullsv; /* opt is being useless */ } } @@ -1049,7 +1060,7 @@ PP(pp_subst) } SvPOK_only(TARG); SvSETMAGIC(TARG); - PUSHs(sv_2mortal(newSVnv((double)iters))); + PUSHs(sv_2mortal(newSViv((I32)iters))); RETURN; } PUSHs(&sv_no); @@ -1092,7 +1103,7 @@ PP(pp_subst) sv_replace(TARG, dstr); SvPOK_only(TARG); SvSETMAGIC(TARG); - PUSHs(sv_2mortal(newSVnv((double)iters))); + PUSHs(sv_2mortal(newSViv((I32)iters))); RETURN; } PUSHs(&sv_no); @@ -1133,7 +1144,7 @@ PP(pp_substcont) sv_replace(targ, dstr); SvPOK_only(targ); SvSETMAGIC(targ); - PUSHs(sv_2mortal(newSVnv((double)(cx->sb_iters - 1)))); + PUSHs(sv_2mortal(newSViv((I32)cx->sb_iters - 1))); POPSUBST(cx); RETURNOP(pm->op_next); } @@ -1175,7 +1186,7 @@ PP(pp_trans) PP(pp_sassign) { dSP; dPOPTOPssrl; - if (tainting && tainted && (!SvMAGICAL(lstr) || !mg_find(lstr, 't'))) { + if (tainting && tainted && (!SvRMAGICAL(lstr) || !mg_find(lstr, 't'))) { TAINT_NOT; } SvSetSV(rstr, lstr); @@ -1225,7 +1236,7 @@ PP(pp_aassign) switch (SvTYPE(sv)) { case SVt_PVAV: ary = (AV*)sv; - magic = SvMAGICAL(ary) != 0; + magic = SvSMAGICAL(ary) != 0; AvREAL_on(ary); AvFILL(ary) = -1; i = 0; @@ -1244,7 +1255,7 @@ PP(pp_aassign) SV *tmpstr; hash = (HV*)sv; - magic = SvMAGICAL(hash) != 0; + magic = SvSMAGICAL(hash) != 0; hv_clear(hash); while (relem < lastrelem) { /* gobble up all the rest */ @@ -1266,7 +1277,7 @@ PP(pp_aassign) break; default: if (SvTHINKFIRST(sv)) { - if (SvREADONLY(sv)) { + if (SvREADONLY(sv) && curcop != &compiling) { if (sv != &sv_undef && sv != &sv_yes && sv != &sv_no) DIE(no_modify); if (relem <= lastrelem) @@ -1520,7 +1531,7 @@ PP(pp_study) SvSCREAM_on(TARG); retval = 1; ret: - XPUSHs(sv_2mortal(newSVnv((double)retval))); + XPUSHs(sv_2mortal(newSViv((I32)retval))); RETURN; } @@ -1546,6 +1557,8 @@ PP(pp_postinc) sv_setsv(TARG, TOPs); sv_inc(TOPs); SvSETMAGIC(TOPs); + if (!SvOK(TARG)) + sv_setiv(TARG, 0); SETs(TARG); return NORMAL; } @@ -1651,8 +1664,8 @@ PP(pp_repeat) char *tmps; tmpstr = POPs; - if (SvTHINKFIRST(tmpstr)) { - if (SvREADONLY(tmpstr)) + if (TARG == tmpstr && SvTHINKFIRST(tmpstr)) { + if (SvREADONLY(tmpstr) && curcop != &compiling) DIE("Can't x= to readonly value"); if (SvROK(tmpstr)) sv_unref(tmpstr); @@ -1670,7 +1683,7 @@ PP(pp_repeat) SvCUR(TARG) *= count; *SvEND(TARG) = '\0'; SvPOK_only(TARG); - sv_free(tmpstr); + SvREFCNT_dec(tmpstr); } else sv_setsv(TARG, &sv_no); @@ -2160,7 +2173,7 @@ PP(pp_substr) sv_setpvn(TARG, tmps, rem); if (lvalue) { /* it's an lvalue! */ if (SvTHINKFIRST(sv)) { - if (SvREADONLY(sv)) + if (SvREADONLY(sv) && curcop != &compiling) DIE(no_modify); if (SvROK(sv)) sv_unref(sv); @@ -2216,7 +2229,7 @@ PP(pp_vec) if (lvalue) { /* it's an lvalue! */ if (SvTHINKFIRST(src)) { - if (SvREADONLY(src)) + if (SvREADONLY(src) && curcop != &compiling) DIE(no_modify); if (SvROK(src)) sv_unref(src); @@ -2506,8 +2519,10 @@ PP(pp_formline) bool gotsome; STRLEN len; - if (!SvCOMPILED(form)) + if (!SvCOMPILED(form)) { + SvREADONLY_off(form); doparseform(form); + } SvUPGRADE(formtarget, SVt_PV); SvGROW(formtarget, SvCUR(formtarget) + SvCUR(form) + 1); @@ -2600,25 +2615,37 @@ PP(pp_formline) case FF_CHECKCHOP: s = SvPV(sv, len); itemsize = len; - if (itemsize > fieldsize) - itemsize = fieldsize; - send = chophere = s + itemsize; - while (s < send || (s == send && isSPACE(*s))) { - if (isSPACE(*s)) { - if (chopspace) - chophere = s; - if (*s == '\r') + if (itemsize <= fieldsize) { + send = chophere = s + itemsize; + while (s < send) { + if (*s == '\r') { + itemsize = s - SvPVX(sv); break; - } - else { - if (*s & ~31) + } + if (*s++ & ~31) gotsome = TRUE; - if (strchr(chopset, *s)) - chophere = s + 1; } - s++; } - itemsize = chophere - SvPVX(sv); + else { + itemsize = fieldsize; + send = chophere = s + itemsize; + while (s < send || (s == send && isSPACE(*s))) { + if (isSPACE(*s)) { + if (chopspace) + chophere = s; + if (*s == '\r') + break; + } + else { + if (*s & ~31) + gotsome = TRUE; + if (strchr(chopset, *s)) + chophere = s + 1; + } + s++; + } + itemsize = chophere - SvPVX(sv); + } break; case FF_SPACE: @@ -2935,7 +2962,7 @@ PP(pp_rv2av) else { if (SvTYPE(sv) != SVt_PVGV) { if (!SvOK(sv)) - DIE(no_usym); + DIE(no_usym, "an array"); sv = (SV*)gv_fetchpv(SvPV(sv, na), TRUE); } av = GvAVn(sv); @@ -2965,8 +2992,8 @@ PP(pp_rv2av) PP(pp_aelemfast) { dSP; - AV *av = (AV*)cSVOP->op_sv; - SV** svp = av_fetch(av, op->op_private - arybase, FALSE); + AV *av = GvAV((GV*)cSVOP->op_sv); + SV** svp = av_fetch(av, op->op_private - arybase, op->op_flags & OPf_LVAL); PUSHs(svp ? *svp : &sv_undef); RETURN; } @@ -2986,18 +3013,20 @@ PP(pp_aelem) save_svref(svp); else if (!SvOK(*svp)) { if (op->op_private == OP_RV2HV) { - sv_free(*svp); + SvREFCNT_dec(*svp); *svp = NEWSV(0,0); sv_upgrade(*svp, SVt_RV); - SvRV(*svp) = sv_ref((SV*)newHV()); + SvRV(*svp) = SvREFCNT_inc(newHV()); SvROK_on(*svp); + ++sv_rvcount; } else if (op->op_private == OP_RV2AV) { - sv_free(*svp); + SvREFCNT_dec(*svp); *svp = NEWSV(0,0); sv_upgrade(*svp, SVt_RV); - SvRV(*svp) = sv_ref((SV*)newAV()); + SvRV(*svp) = SvREFCNT_inc(newAV()); SvROK_on(*svp); + ++sv_rvcount; } } } @@ -3047,22 +3076,16 @@ PP(pp_each) I32 i; char *tmps; - if (mystrk) { - sv_free(mystrk); - mystrk = Nullsv; - } - EXTEND(SP, 2); if (entry) { + tmps = hv_iterkey(entry, &i); + if (!i) + tmps = ""; + PUSHs(sv_2mortal(newSVpv(tmps, i))); if (GIMME == G_ARRAY) { - tmps = hv_iterkey(entry, &i); - if (!i) - tmps = ""; - mystrk = newSVpv(tmps, i); - PUSHs(mystrk); + sv_setsv(TARG, hv_iterval(hash, entry)); + PUSHs(TARG); } - sv_setsv(TARG, hv_iterval(hash, entry)); - PUSHs(TARG); } else if (GIMME == G_SCALAR) RETPUSHUNDEF; @@ -3128,7 +3151,7 @@ PP(pp_rv2hv) else { if (SvTYPE(sv) != SVt_PVGV) { if (!SvOK(sv)) - DIE(no_usym); + DIE(no_usym, "a hash"); sv = (SV*)gv_fetchpv(SvPV(sv, na), TRUE); } hv = GvHVn(sv); @@ -3147,12 +3170,12 @@ PP(pp_rv2hv) } else { dTARGET; - if (HvFILL(hv)) - sv_setiv(TARG, 0); - else { + if (HvFILL(hv)) { sprintf(buf, "%d/%d", HvFILL(hv), HvMAX(hv)+1); sv_setpv(TARG, buf); } + else + sv_setiv(TARG, 0); SETTARG; RETURN; } @@ -3175,18 +3198,20 @@ PP(pp_helem) save_svref(svp); else if (!SvOK(*svp)) { if (op->op_private == OP_RV2HV) { - sv_free(*svp); + SvREFCNT_dec(*svp); *svp = NEWSV(0,0); sv_upgrade(*svp, SVt_RV); - SvRV(*svp) = sv_ref((SV*)newHV()); + SvRV(*svp) = SvREFCNT_inc(newHV()); SvROK_on(*svp); + ++sv_rvcount; } else if (op->op_private == OP_RV2AV) { - sv_free(*svp); + SvREFCNT_dec(*svp); *svp = NEWSV(0,0); sv_upgrade(*svp, SVt_RV); - SvRV(*svp) = sv_ref((SV*)newAV()); + SvRV(*svp) = SvREFCNT_inc(newAV()); SvROK_on(*svp); + ++sv_rvcount; } } } @@ -4279,6 +4304,8 @@ PP(pp_split) DIE("panic: do_split"); if (pm->op_pmreplroot) ary = GvAVn((GV*)pm->op_pmreplroot); + else if (gimme != G_ARRAY) + ary = GvAVn(defgv); else ary = Nullav; if (ary && (gimme != G_ARRAY || (pm->op_pmflags & PMf_ONCE))) { @@ -4455,17 +4482,14 @@ PP(pp_join) PP(pp_list) { - dSP; + dSP; dMARK; if (GIMME != G_ARRAY) { - dMARK; if (++MARK <= SP) *MARK = *SP; /* unwanted list, return last item */ else *MARK = &sv_undef; SP = MARK; } - else if (op->op_private & OPpLIST_GUESSED) /* didn't need that pushmark */ - markstack_ptr--; RETURN; } @@ -4626,7 +4650,7 @@ PP(pp_splice) if (AvREAL(ary)) { sv_2mortal(*MARK); for (i = length - 1, dst = &AvARRAY(ary)[offset]; i > 0; i--) - sv_free(*dst++); /* free them now */ + SvREFCNT_dec(*dst++); /* free them now */ } } AvFILL(ary) += diff; @@ -4690,7 +4714,7 @@ PP(pp_splice) dst = AvARRAY(ary) + AvFILL(ary); for (i = diff; i > 0; i--) { if (*dst) /* stuff was hanging around */ - sv_free(*dst); /* after $#foo */ + SvREFCNT_dec(*dst); /* after $#foo */ dst--; } if (after) { @@ -4724,7 +4748,7 @@ PP(pp_splice) if (AvREAL(ary)) { sv_2mortal(*MARK); while (length-- > 0) - sv_free(tmparyval[length]); + SvREFCNT_dec(tmparyval[length]); } Safefree(tmparyval); } @@ -4823,7 +4847,7 @@ PP(pp_grepstart) GvSV(defgv) = src; } else - GvSV(defgv) = sv_mortalcopy(&sv_undef); + GvSV(defgv) = sv_newmortal(); RETURNOP(((LOGOP*)op->op_next)->op_other); } @@ -4865,7 +4889,7 @@ PP(pp_grepwhile) GvSV(defgv) = src; } else - GvSV(defgv) = sv_mortalcopy(&sv_undef); + GvSV(defgv) = sv_newmortal(); RETURNOP(cLOGOP->op_other); } @@ -4903,7 +4927,7 @@ PP(pp_sort) cv = sv_2cv(*++MARK, &stash, &gv, 0); if (!(cv && CvROOT(cv))) { if (gv) { - SV *tmpstr = sv_mortalcopy(&sv_undef); + SV *tmpstr = sv_newmortal(); gv_efullname(tmpstr, gv); if (CvUSERSUB(cv)) DIE("Usersub \"%s\" called in sort", SvPVX(tmpstr)); @@ -5042,7 +5066,7 @@ PP(pp_flip) SV *targ = PAD_SV(op->op_targ); if ((op->op_private & OPpFLIP_LINENUM) - ? last_in_gv && SvIV(sv) == GvIO(last_in_gv)->lines + ? last_in_gv && SvIV(sv) == IoLINES(GvIO(last_in_gv)) : SvTRUE(sv) ) { sv_setiv(PAD_SV(cUNOP->op_first->op_targ), 1); if (op->op_flags & OPf_SPECIAL) { @@ -5104,7 +5128,7 @@ PP(pp_flop) SV *targ = PAD_SV(cUNOP->op_first->op_targ); sv_inc(targ); if ((op->op_private & OPpFLIP_LINENUM) - ? last_in_gv && SvIV(sv) == GvIO(last_in_gv)->lines + ? last_in_gv && SvIV(sv) == IoLINES(GvIO(last_in_gv)) : SvTRUE(sv) ) { sv_setiv(PAD_SV(((UNOP*)cUNOP->op_first)->op_first->op_targ), 0); sv_catpv(targ, "E0"); @@ -5230,8 +5254,8 @@ I32 cxix; while (cxstack_ix > cxix) { cx = &cxstack[cxstack_ix--]; - DEBUG_l(fprintf(stderr, "Unwinding block %d, type %d\n", cxstack_ix+1, - cx->cx_type)); + DEBUG_l(fprintf(stderr, "Unwinding block %d, type %s\n", cxstack_ix+1, + block_type[cx->cx_type])); /* Note: we don't need to restore the base context info till the end. */ switch (cx->cx_type) { case CXt_SUB: @@ -5249,13 +5273,15 @@ I32 cxix; } } -/*VARARGS0*/ +#ifdef STANDARD_C OP * -#ifdef __STDC__ -die(char* pat,...) +die(char* pat, ...) #else -die(va_alist) -va_dcl +/*VARARGS0*/ +OP * +die(pat, va_alist) + char *pat; + va_dcl #endif { va_list args; @@ -5263,8 +5289,12 @@ va_dcl char *message; OP *retop; +#ifdef STANDARD_C + va_start(args, pat); +#else va_start(args); - message = mess(args); +#endif + message = mess(pat, args); va_end(args); restartop = die_where(message); if (stack != mainstack) @@ -5382,11 +5412,11 @@ PP(pp_method) if (!SvOK(sv) || !(iogv = gv_fetchpv(SvPVX(sv), FALSE)) || - !(io=GvIO(iogv))) + !(ob=(SV*)GvIO(iogv))) { char *name = SvPVX(((SVOP*)cLOGOP->op_other)->op_sv); char tmpbuf[256]; - char* packname = SvPVX(sv); + char* packname = SvPV(sv, na); HV *stash; if (!isALPHA(*packname)) DIE("Can't call method \"%s\" without a package or object reference", name); @@ -5401,14 +5431,6 @@ DIE("Can't call method \"%s\" without a package or object reference", name); PUSHs(sv); RETURN; } - if (!(ob = io->object)) { - ob = sv_ref((SV*)newHV()); - SvOBJECT_on(ob); - SvUPGRADE(ob, SVt_PVMG); - iogv = gv_fetchpv("FILEHANDLE'flush", TRUE); - SvSTASH(ob) = GvSTASH(iogv); - io->object = ob; - } } if (!ob || !SvOBJECT(ob)) { @@ -5432,30 +5454,74 @@ DIE("Can't call method \"%s\" without a package or object reference", name); PP(pp_entersubr) { dSP; dMARK; - SV *sv; + SV *sv = *++MARK; GV *gv; HV *stash; - register CV *cv = sv_2cv(*++MARK, &stash, &gv, 0); + register CV *cv; register I32 items = SP - MARK; I32 hasargs = (op->op_flags & OPf_STACKED) != 0; register CONTEXT *cx; + if (!sv) + DIE("Not a subroutine reference"); + switch (SvTYPE(sv)) { + default: + if (!SvROK(sv)) { + if (!SvOK(sv)) + DIE(no_usym, "a subroutine"); + gv = gv_fetchpv(SvPV(sv, na), FALSE); + if (!gv) + cv = 0; + else + cv = GvCV(gv); + break; + } + /* FALL THROUGH */ + case SVt_RV: + cv = (CV*)SvRV(sv); + if (SvTYPE(cv) == SVt_PVCV) + break; + /* FALL THROUGH */ + case SVt_PVHV: + case SVt_PVAV: + DIE("Not a subroutine reference"); + case SVt_PVCV: + cv = (CV*)sv; + break; + case SVt_PVGV: + if (!(cv = GvCV((GV*)sv))) + cv = sv_2cv(sv, &stash, &gv, TRUE); + break; + } + ENTER; SAVETMPS; - if (!(cv && (CvROOT(cv) || CvUSERSUB(cv)))) { - if (gv) { - SV *tmpstr = sv_mortalcopy(&sv_undef); + retry: + if (!cv) + DIE("Not a subroutine reference"); + + if (!CvROOT(cv) && !CvUSERSUB(cv)) { + if (gv = CvGV(cv)) { + SV *tmpstr = sv_newmortal(); + GV *ngv; gv_efullname(tmpstr, gv); - DIE("Undefined subroutine \"%s\" called",SvPVX(tmpstr)); + ngv = gv_fetchmethod(GvESTASH(gv), "AUTOLOAD"); + if (ngv && ngv != gv && (cv = GvCV(ngv))) { /* One more chance... */ + gv = ngv; + sv_setsv(GvSV(gv), tmpstr); + goto retry; + } + else + DIE("Undefined subroutine &%s called",SvPVX(tmpstr)); } - if (cv) - DIE("Undefined subroutine called"); - DIE("Not a subroutine reference"); + DIE("Undefined subroutine called"); } + if ((op->op_private & OPpSUBR_DB) && !CvUSERSUB(cv)) { sv = GvSV(DBsub); save_item(sv); + gv = CvGV(cv); gv_efullname(sv,gv); cv = GvCV(DBsub); if (!cv) @@ -5475,15 +5541,10 @@ PP(pp_entersubr) push_return(op->op_next); PUSHBLOCK(cx, CXt_SUB, MARK - 1); PUSHSUB(cx); - if (hasargs) { - cx->blk_sub.savearray = GvAV(defgv); - cx->blk_sub.argarray = av_fake(items, ++MARK); - GvAV(defgv) = cx->blk_sub.argarray; - } CvDEPTH(cv)++; if (CvDEPTH(cv) >= 2) { /* save temporaries on recursion? */ if (CvDEPTH(cv) == 100 && dowarn) - warn("Deep recursion on subroutine \"%s\"",GvENAME(gv)); + warn("Deep recursion on subroutine \"%s\"",GvENAME(CvGV(cv))); if (CvDEPTH(cv) > AvFILL(padlist)) { AV *newpad = newAV(); I32 ix = AvFILL((AV*)svp[1]); @@ -5501,6 +5562,13 @@ PP(pp_entersubr) else av_store(newpad, ix--, NEWSV(0,0)); } + if (hasargs) { + AV* av = newAV(); + av_store(av, 0, Nullsv); + av_store(newpad, 0, (SV*)av); + SvOK_on(av); + AvREAL_off(av); + } av_store(padlist, CvDEPTH(cv), (SV*)newpad); AvFILL(padlist) = CvDEPTH(cv); svp = AvARRAY(padlist); @@ -5508,6 +5576,36 @@ PP(pp_entersubr) } SAVESPTR(curpad); curpad = AvARRAY((AV*)svp[CvDEPTH(cv)]); + if (hasargs) { + AV* av = (AV*)curpad[0]; + SV** ary; + + cx->blk_sub.savearray = GvAV(defgv); + cx->blk_sub.argarray = av; + GvAV(defgv) = cx->blk_sub.argarray; + ++MARK; + + if (items >= AvMAX(av)) { + ary = AvALLOC(av); + if (AvARRAY(av) != ary) { + AvMAX(av) += AvARRAY(av) - AvALLOC(av); + SvPVX(av) = (char*)ary; + } + if (items >= AvMAX(av)) { + AvMAX(av) = items - 1; + Renew(ary,items+1,SV*); + AvALLOC(av) = ary; + SvPVX(av) = (char*)ary; + } + } + Copy(MARK,AvARRAY(av),items,SV*); + AvFILL(av) = items - 1; + while (items--) { + if (*MARK) + SvTEMP_off(*MARK); + MARK++; + } + } RETURNOP(CvSTART(cv)); } } @@ -5526,7 +5624,10 @@ PP(pp_leavesubr) if (gimme == G_SCALAR) { MARK = newsp + 1; if (MARK <= SP) - *MARK = sv_mortalcopy(TOPs); + if (SvFLAGS(TOPs) & (SVs_PADTMP|SVs_TEMP)) + *MARK = TOPs; + else + *MARK = sv_mortalcopy(TOPs); else { MEXTEND(mark,0); *MARK = &sv_undef; @@ -5535,7 +5636,8 @@ PP(pp_leavesubr) } else { for (mark = newsp + 1; mark <= SP; mark++) - *mark = sv_mortalcopy(*mark); + if (!(SvFLAGS(*mark) & (SVs_PADTMP|SVs_TEMP))) + *mark = sv_mortalcopy(*mark); /* in case LEAVE wipes old return values */ } @@ -5576,11 +5678,6 @@ PP(pp_caller) cxix = nextcxix; } cx = &cxstack[cxix]; - if (cx->blk_oldcop == &compiling) { - if (GIMME != G_ARRAY) - RETPUSHUNDEF; - RETURN; - } if (GIMME != G_ARRAY) { dTARGET; @@ -5591,19 +5688,29 @@ PP(pp_caller) PUSHs(sv_2mortal(newSVpv(HvNAME(cx->blk_oldcop->cop_stash), 0))); PUSHs(sv_2mortal(newSVpv(SvPVX(GvSV(cx->blk_oldcop->cop_filegv)), 0))); - PUSHs(sv_2mortal(newSVnv((double)cx->blk_oldcop->cop_line))); + PUSHs(sv_2mortal(newSViv((I32)cx->blk_oldcop->cop_line))); if (!MAXARG) RETURN; - sv = NEWSV(49, 0); - gv_efullname(sv, cx->blk_sub.gv); - PUSHs(sv_2mortal(sv)); - PUSHs(sv_2mortal(newSVnv((double)cx->blk_sub.hasargs))); - PUSHs(sv_2mortal(newSVnv((double)cx->blk_gimme))); - if (cx->blk_sub.hasargs) { + if (cx->cx_type == CXt_SUB) { + sv = NEWSV(49, 0); + gv_efullname(sv, CvGV(cx->blk_sub.cv)); + PUSHs(sv_2mortal(sv)); + PUSHs(sv_2mortal(newSViv((I32)cx->blk_sub.hasargs))); + } + else { + PUSHs(sv_2mortal(newSVpv("(eval)",0))); + PUSHs(sv_2mortal(newSViv(0))); + } + PUSHs(sv_2mortal(newSViv((I32)cx->blk_gimme))); + if (cx->blk_sub.hasargs && curstash == debstash) { AV *ary = cx->blk_sub.argarray; - if (!dbargs) - dbargs = GvAV(gv_AVadd(gv_fetchpv("DB'args", TRUE))); + if (!dbargs) { + GV* tmpgv; + dbargs = GvAV(gv_AVadd(tmpgv = gv_fetchpv("DB::args", TRUE))); + SvMULTI_on(tmpgv); + AvREAL_off(dbargs); + } if (AvMAX(dbargs) < AvFILL(ary)) av_store(dbargs, AvFILL(ary), Nullsv); Copy(AvARRAY(ary), AvARRAY(dbargs), AvFILL(ary)+1, SV*); @@ -5732,7 +5839,7 @@ PP(pp_nextstate) curcop = (COP*)op; TAINT_NOT; /* Each statement is presumed innocent */ stack_sp = stack_base + cxstack[cxstack_ix].blk_oldsp; - free_tmps(); + FREE_TMPS(); return NORMAL; } @@ -5741,7 +5848,7 @@ PP(pp_dbstate) curcop = (COP*)op; TAINT_NOT; /* Each statement is presumed innocent */ stack_sp = stack_base + cxstack[cxstack_ix].blk_oldsp; - free_tmps(); + FREE_TMPS(); if (op->op_private || SvIV(DBsingle) || SvIV(DBsignal) || SvIV(DBtrace)) { @@ -5755,6 +5862,8 @@ PP(pp_dbstate) ENTER; SAVETMPS; + SAVEI32(debug); + debug = 0; hasargs = 0; gv = DBgv; cv = GvCV(gv); @@ -5762,14 +5871,14 @@ PP(pp_dbstate) *++sp = Nullsv; if (!cv) - DIE("No DB'DB routine defined"); + DIE("No DB::DB routine defined"); + if (CvDEPTH(cv) >= 1) /* don't do recursive DB::DB call */ + return NORMAL; push_return(op->op_next); PUSHBLOCK(cx, CXt_SUB, sp - 1); PUSHSUB(cx); CvDEPTH(cv)++; - if (CvDEPTH(cv) >= 2) - DIE("DB'DB called recursively"); SAVESPTR(curpad); curpad = AvARRAY((AV*)*av_fetch(CvPADLIST(cv),1,FALSE)); RETURNOP(CvSTART(cv)); @@ -5783,10 +5892,9 @@ PP(pp_unstack) I32 oldsave; TAINT_NOT; /* Each statement is presumed innocent */ stack_sp = stack_base + cxstack[cxstack_ix].blk_oldsp; - free_tmps(); + FREE_TMPS(); oldsave = scopestack[scopestack_ix - 1]; - if (savestack_ix > oldsave) - leave_scope(oldsave); + LEAVE_SCOPE(oldsave); return NORMAL; } @@ -5798,7 +5906,7 @@ PP(pp_enter) ENTER; SAVETMPS; - PUSHBLOCK(cx,CXt_BLOCK,sp); + PUSHBLOCK(cx, CXt_BLOCK, sp); RETURN; } @@ -5807,10 +5915,32 @@ PP(pp_leave) { dSP; register CONTEXT *cx; - I32 gimme; + register SV **mark; SV **newsp; + I32 gimme; POPBLOCK(cx); + + if (GIMME == G_SCALAR) { + MARK = newsp + 1; + if (MARK <= SP) + if (SvFLAGS(TOPs) & (SVs_PADTMP|SVs_TEMP)) + *MARK = TOPs; + else + *MARK = sv_mortalcopy(TOPs); + else { + MEXTEND(mark,0); + *MARK = &sv_undef; + } + SP = MARK; + } + else { + for (mark = newsp + 1; mark <= SP; mark++) + if (!(SvFLAGS(*mark) & (SVs_PADTMP|SVs_TEMP))) + *mark = sv_mortalcopy(*mark); + /* in case LEAVE wipes old return values */ + } + LEAVE; RETURN; @@ -5832,7 +5962,7 @@ PP(pp_enteriter) SAVETMPS; ENTER; - PUSHBLOCK(cx,CXt_LOOP,SP); + PUSHBLOCK(cx, CXt_LOOP, SP); PUSHLOOP(cx, svp, MARK); cx->blk_loop.iterary = stack; cx->blk_loop.iterix = MARK - stack_base; @@ -5854,9 +5984,12 @@ PP(pp_iter) if (cx->blk_loop.iterix >= cx->blk_oldsp) RETPUSHNO; - sv = AvARRAY(cx->blk_loop.iterary)[++cx->blk_loop.iterix]; - SvTEMP_off(sv); - *cx->blk_loop.itervar = sv ? sv : &sv_undef; + if (sv = AvARRAY(cx->blk_loop.iterary)[++cx->blk_loop.iterix]) { + SvTEMP_off(sv); + *cx->blk_loop.itervar = sv; + } + else + *cx->blk_loop.itervar = &sv_undef; RETPUSHYES; } @@ -6041,8 +6174,7 @@ PP(pp_next) TOPBLOCK(cx); oldsave = scopestack[scopestack_ix - 1]; - if (savestack_ix > oldsave) - leave_scope(oldsave); + LEAVE_SCOPE(oldsave); return cx->blk_loop.next_op; } @@ -6068,8 +6200,7 @@ PP(pp_redo) TOPBLOCK(cx); oldsave = scopestack[scopestack_ix - 1]; - if (savestack_ix > oldsave) - leave_scope(oldsave); + LEAVE_SCOPE(oldsave); return cx->blk_loop.redo_op; } @@ -6093,15 +6224,17 @@ OP **opstack; if (op->op_flags & OPf_KIDS) { /* First try all the kids at this level, since that's likeliest. */ for (kid = cUNOP->op_first; kid; kid = kid->op_sibling) { - if (kid->op_type == OP_NEXTSTATE && kCOP->cop_label && - strEQ(kCOP->cop_label, label)) + if ((kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE) && + kCOP->cop_label && strEQ(kCOP->cop_label, label)) return kid; } for (kid = cUNOP->op_first; kid; kid = kid->op_sibling) { if (kid == lastgotoprobe) continue; - if (kid->op_type == OP_NEXTSTATE) { - if (ops > opstack && ops[-1]->op_type == OP_NEXTSTATE) + if (kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE) { + if (ops > opstack && + (ops[-1]->op_type == OP_NEXTSTATE || + ops[-1]->op_type == OP_DBSTATE)) *ops = kid; else *ops++ = kid; @@ -6131,7 +6264,126 @@ PP(pp_goto) char *label; label = 0; - if (op->op_flags & OPf_SPECIAL) { + if (op->op_flags & OPf_STACKED) { + SV *sv = POPs; + + /* This egregious kludge implements goto &subroutine */ + if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVCV) { + I32 cxix; + register CONTEXT *cx; + CV* cv = (CV*)SvRV(sv); + SV** mark; + I32 items = 0; + I32 oldsave; + + /* First do some returnish stuff. */ + cxix = dopoptosub(cxstack_ix); + if (cxix < 0) + DIE("Can't goto subroutine outside a subroutine"); + if (cxix < cxstack_ix) + dounwind(cxix); + TOPBLOCK(cx); + mark = ++stack_sp; + *stack_sp = (SV*)cv; + if (cx->blk_sub.hasargs) { /* put @_ back onto stack */ + items = AvFILL(cx->blk_sub.argarray) + 1; + Copy(AvARRAY(cx->blk_sub.argarray), ++stack_sp, items, SV*); + stack_sp += items; + GvAV(defgv) = cx->blk_sub.savearray; + } + if (!(CvDEPTH(cx->blk_sub.cv) = cx->blk_sub.olddepth)) { + if (CvDELETED(cx->blk_sub.cv)) + SvREFCNT_dec(cx->blk_sub.cv); + } + oldsave = scopestack[scopestack_ix - 1]; + LEAVE_SCOPE(oldsave); + + /* Now do some callish stuff. */ + if (CvUSERSUB(cv)) { + items = (*CvUSERSUB(cv))(CvUSERINDEX(cv), + mark - stack_base, items); + sp = stack_base + items; + LEAVE; + return pop_return(); + } + else { + AV* padlist = CvPADLIST(cv); + SV** svp = AvARRAY(padlist); + cx->blk_sub.cv = cv; + cx->blk_sub.olddepth = CvDEPTH(cv); + CvDEPTH(cv)++; + if (CvDEPTH(cv) >= 2) { /* save temporaries on recursion? */ + if (CvDEPTH(cv) == 100 && dowarn) + warn("Deep recursion on subroutine \"%s\"", + GvENAME(CvGV(cv))); + if (CvDEPTH(cv) > AvFILL(padlist)) { + AV *newpad = newAV(); + I32 ix = AvFILL((AV*)svp[1]); + svp = AvARRAY(svp[0]); + while (ix > 0) { + if (svp[ix]) { + char *name = SvPVX(svp[ix]); /* XXX */ + if (*name == '@') + av_store(newpad, ix--, (SV*)newAV()); + else if (*name == '%') + av_store(newpad, ix--, (SV*)newHV()); + else + av_store(newpad, ix--, NEWSV(0,0)); + } + else + av_store(newpad, ix--, NEWSV(0,0)); + } + if (cx->blk_sub.hasargs) { + AV* av = newAV(); + av_store(av, 0, Nullsv); + av_store(newpad, 0, (SV*)av); + SvOK_on(av); + AvREAL_off(av); + } + av_store(padlist, CvDEPTH(cv), (SV*)newpad); + AvFILL(padlist) = CvDEPTH(cv); + svp = AvARRAY(padlist); + } + } + SAVESPTR(curpad); + curpad = AvARRAY((AV*)svp[CvDEPTH(cv)]); + if (cx->blk_sub.hasargs) { + AV* av = (AV*)curpad[0]; + SV** ary; + + cx->blk_sub.savearray = GvAV(defgv); + cx->blk_sub.argarray = av; + GvAV(defgv) = cx->blk_sub.argarray; + ++mark; + + if (items >= AvMAX(av)) { + ary = AvALLOC(av); + if (AvARRAY(av) != ary) { + AvMAX(av) += AvARRAY(av) - AvALLOC(av); + SvPVX(av) = (char*)ary; + } + if (items >= AvMAX(av)) { + AvMAX(av) = items - 1; + Renew(ary,items+1,SV*); + AvALLOC(av) = ary; + SvPVX(av) = (char*)ary; + } + } + Copy(mark,AvARRAY(av),items,SV*); + AvFILL(av) = items - 1; + while (items--) { + if (*mark) + SvTEMP_off(*mark); + mark++; + } + } + RETURNOP(CvSTART(cv)); + } + } + else + label = SvPV(sv,na); + } + else if (op->op_flags & OPf_SPECIAL) { if (op->op_type != OP_DUMP) DIE("goto must have label"); } @@ -6190,8 +6442,7 @@ PP(pp_goto) dounwind(ix); TOPBLOCK(cx); oldsave = scopestack[scopestack_ix - 1]; - if (savestack_ix > oldsave) - leave_scope(oldsave); + LEAVE_SCOPE(oldsave); } /* push wanted frames */ @@ -6288,7 +6539,7 @@ PP(pp_open) gv = (GV*)POPs; tmps = SvPV(sv, len); if (do_open(gv, tmps, len)) { - GvIO(gv)->lines = 0; + IoLINES(GvIO(gv)) = 0; PUSHi( (I32)forkprocess ); } else if (forkprocess == 0) /* we are a new child */ @@ -6331,24 +6582,24 @@ PP(pp_pipe_op) rstio = GvIOn(rgv); wstio = GvIOn(wgv); - if (rstio->ifp) + if (IoIFP(rstio)) do_close(rgv, FALSE); - if (wstio->ifp) + if (IoIFP(wstio)) do_close(wgv, FALSE); if (pipe(fd) < 0) goto badexit; - rstio->ifp = fdopen(fd[0], "r"); - wstio->ofp = fdopen(fd[1], "w"); - wstio->ifp = wstio->ofp; - rstio->type = '<'; - wstio->type = '>'; + IoIFP(rstio) = fdopen(fd[0], "r"); + IoOFP(wstio) = fdopen(fd[1], "w"); + IoIFP(wstio) = IoOFP(wstio); + IoTYPE(rstio) = '<'; + IoTYPE(wstio) = '>'; - if (!rstio->ifp || !wstio->ofp) { - if (rstio->ifp) fclose(rstio->ifp); + if (!IoIFP(rstio) || !IoOFP(wstio)) { + if (IoIFP(rstio)) fclose(IoIFP(rstio)); else close(fd[0]); - if (wstio->ofp) fclose(wstio->ofp); + if (IoOFP(wstio)) fclose(IoOFP(wstio)); else close(fd[1]); goto badexit; } @@ -6371,7 +6622,7 @@ PP(pp_fileno) if (MAXARG < 1) RETPUSHUNDEF; gv = (GV*)POPs; - if (!gv || !(io = GvIO(gv)) || !(fp = io->ifp)) + if (!gv || !(io = GvIO(gv)) || !(fp = IoIFP(io))) RETPUSHUNDEF; PUSHi(fileno(fp)); RETURN; @@ -6410,7 +6661,7 @@ PP(pp_binmode) gv = (GV*)POPs; EXTEND(SP, 1); - if (!gv || !(io = GvIO(gv)) || !(fp = io->ifp)) + if (!gv || !(io = GvIO(gv)) || !(fp = IoIFP(io))) RETSETUNDEF; #ifdef DOSISH @@ -6692,7 +6943,7 @@ PP(pp_getc) RETPUSHUNDEF; TAINT_IF(1); sv_setpv(TARG, " "); - *SvPVX(TARG) = getc(GvIO(gv)->ifp); /* should never be EOF */ + *SvPVX(TARG) = getc(IoIFP(GvIO(gv))); /* should never be EOF */ PUSHTARG; RETURN; } @@ -6742,8 +6993,8 @@ PP(pp_enterwrite) RETPUSHNO; } curoutgv = gv; - if (io->fmt_gv) - fgv = io->fmt_gv; + if (IoFMT_GV(io)) + fgv = IoFMT_GV(io); else fgv = gv; @@ -6751,7 +7002,7 @@ PP(pp_enterwrite) if (!cv) { if (fgv) { - SV *tmpstr = sv_mortalcopy(&sv_undef); + SV *tmpstr = sv_newmortal(); gv_efullname(tmpstr, gv); DIE("Undefined format \"%s\" called",SvPVX(tmpstr)); } @@ -6766,7 +7017,7 @@ PP(pp_leavewrite) dSP; GV *gv = cxstack[cxstack_ix].blk_sub.gv; register IO *io = GvIO(gv); - FILE *ofp = io->ofp; + FILE *ofp = IoOFP(io); FILE *fp; SV **mark; SV **newsp; @@ -6774,37 +7025,37 @@ PP(pp_leavewrite) register CONTEXT *cx; DEBUG_f(fprintf(stderr,"left=%ld, todo=%ld\n", - (long)io->lines_left, (long)FmLINES(formtarget))); - if (io->lines_left < FmLINES(formtarget) && + (long)IoLINES_LEFT(io), (long)FmLINES(formtarget))); + if (IoLINES_LEFT(io) < FmLINES(formtarget) && formtarget != toptarget) { - if (!io->top_gv) { + if (!IoTOP_GV(io)) { GV *topgv; char tmpbuf[256]; - if (!io->top_name) { - if (!io->fmt_name) - io->fmt_name = savestr(GvNAME(gv)); - sprintf(tmpbuf, "%s_TOP", io->fmt_name); + if (!IoTOP_NAME(io)) { + if (!IoFMT_NAME(io)) + IoFMT_NAME(io) = savestr(GvNAME(gv)); + sprintf(tmpbuf, "%s_TOP", IoFMT_NAME(io)); topgv = gv_fetchpv(tmpbuf,FALSE); if (topgv && GvFORM(topgv)) - io->top_name = savestr(tmpbuf); + IoTOP_NAME(io) = savestr(tmpbuf); else - io->top_name = savestr("top"); + IoTOP_NAME(io) = savestr("top"); } - topgv = gv_fetchpv(io->top_name,FALSE); + topgv = gv_fetchpv(IoTOP_NAME(io),FALSE); if (!topgv || !GvFORM(topgv)) { - io->lines_left = 100000000; + IoLINES_LEFT(io) = 100000000; goto forget_top; } - io->top_gv = topgv; + IoTOP_GV(io) = topgv; } - if (io->lines_left >= 0 && io->page > 0) + if (IoLINES_LEFT(io) >= 0 && IoPAGE(io) > 0) fwrite(SvPVX(formfeed), SvCUR(formfeed), 1, ofp); - io->lines_left = io->page_len; - io->page++; + IoLINES_LEFT(io) = IoPAGE_LEN(io); + IoPAGE(io)++; formtarget = toptarget; - return doform(GvFORM(io->top_gv),gv,op); + return doform(GvFORM(IoTOP_GV(io)),gv,op); } forget_top: @@ -6812,10 +7063,10 @@ PP(pp_leavewrite) POPFORMAT(cx); LEAVE; - fp = io->ofp; + fp = IoOFP(io); if (!fp) { if (dowarn) { - if (io->ifp) + if (IoIFP(io)) warn("Filehandle only opened for input"); else warn("Write on closed filehandle"); @@ -6823,7 +7074,7 @@ PP(pp_leavewrite) PUSHs(&sv_no); } else { - if ((io->lines_left -= FmLINES(formtarget)) < 0) { + if ((IoLINES_LEFT(io) -= FmLINES(formtarget)) < 0) { if (dowarn) warn("page overflow"); } @@ -6833,7 +7084,7 @@ PP(pp_leavewrite) else { FmLINES(formtarget) = 0; SvCUR_set(formtarget, 0); - if (io->flags & IOf_FLUSH) + if (IoFLAGS(io) & IOf_FLUSH) (void)fflush(fp); PUSHs(&sv_yes); } @@ -6861,9 +7112,9 @@ PP(pp_prtf) errno = EBADF; goto just_say_no; } - else if (!(fp = io->ofp)) { + else if (!(fp = IoOFP(io))) { if (dowarn) { - if (io->ifp) + if (IoIFP(io)) warn("Filehandle opened only for input"); else warn("printf on closed filehandle"); @@ -6876,17 +7127,17 @@ PP(pp_prtf) if (!do_print(sv, fp)) goto just_say_no; - if (io->flags & IOf_FLUSH) + if (IoFLAGS(io) & IOf_FLUSH) if (fflush(fp) == EOF) goto just_say_no; } - sv_free(sv); + SvREFCNT_dec(sv); SP = ORIGMARK; PUSHs(&sv_yes); RETURN; just_say_no: - sv_free(sv); + SvREFCNT_dec(sv); SP = ORIGMARK; PUSHs(&sv_undef); RETURN; @@ -6909,9 +7160,9 @@ PP(pp_print) errno = EBADF; goto just_say_no; } - else if (!(fp = io->ofp)) { + else if (!(fp = IoOFP(io))) { if (dowarn) { - if (io->ifp) + if (IoIFP(io)) warn("Filehandle opened only for input"); else warn("print on closed filehandle"); @@ -6948,7 +7199,7 @@ PP(pp_print) if (fwrite(ors, 1, orslen, fp) == 0 || ferror(fp)) goto just_say_no; - if (io->flags & IOf_FLUSH) + if (IoFLAGS(io) & IOf_FLUSH) if (fflush(fp) == EOF) goto just_say_no; } @@ -6982,7 +7233,7 @@ PP(pp_sysread) buffer = SvPV(bufstr, blen); length = SvIVx(*++MARK); if (SvTHINKFIRST(bufstr)) { - if (SvREADONLY(bufstr)) + if (SvREADONLY(bufstr) && curcop != &compiling) DIE(no_modify); if (SvROK(bufstr)) sv_unref(bufstr); @@ -6995,13 +7246,13 @@ PP(pp_sysread) if (MARK < SP) warn("Too many args on read"); io = GvIO(gv); - if (!io || !io->ifp) + if (!io || !IoIFP(io)) goto say_undef; #ifdef HAS_SOCKET if (op->op_type == OP_RECV) { bufsize = sizeof buf; SvGROW(bufstr, length+1), (buffer = SvPV(bufstr, blen)); /* sneaky */ - length = recvfrom(fileno(io->ifp), buffer, length, offset, + length = recvfrom(fileno(IoIFP(io)), buffer, length, offset, buf, &bufsize); if (length < 0) RETPUSHUNDEF; @@ -7019,18 +7270,18 @@ PP(pp_sysread) #endif SvGROW(bufstr, length+offset+1), (buffer = SvPV(bufstr, blen)); /* sneaky */ if (op->op_type == OP_SYSREAD) { - length = read(fileno(io->ifp), buffer+offset, length); + length = read(fileno(IoIFP(io)), buffer+offset, length); } else #ifdef HAS_SOCKET - if (io->type == 's') { + if (IoTYPE(io) == 's') { bufsize = sizeof buf; - length = recvfrom(fileno(io->ifp), buffer+offset, length, 0, + length = recvfrom(fileno(IoIFP(io)), buffer+offset, length, 0, buf, &bufsize); } else #endif - length = fread(buffer+offset, 1, length, io->ifp); + length = fread(buffer+offset, 1, length, IoIFP(io)); if (length < 0) goto say_undef; SvCUR_set(bufstr, length+offset); @@ -7069,7 +7320,7 @@ PP(pp_send) length = SvIVx(*++MARK); errno = 0; io = GvIO(gv); - if (!io || !io->ifp) { + if (!io || !IoIFP(io)) { length = -1; if (dowarn) { if (op->op_type == OP_SYSWRITE) @@ -7085,7 +7336,7 @@ PP(pp_send) offset = 0; if (MARK < SP) warn("Too many args on syswrite"); - length = write(fileno(io->ifp), buffer+offset, length); + length = write(fileno(IoIFP(io)), buffer+offset, length); } #ifdef HAS_SOCKET else if (SP >= MARK) { @@ -7093,10 +7344,10 @@ PP(pp_send) if (SP > MARK) warn("Too many args on send"); buffer = SvPVx(*++MARK, mlen); - length = sendto(fileno(io->ifp), buffer, blen, length, buffer, mlen); + length = sendto(fileno(IoIFP(io)), buffer, blen, length, buffer, mlen); } else - length = send(fileno(io->ifp), buffer, blen, length); + length = send(fileno(IoIFP(io)), buffer, blen, length); #else else DIE(no_sock_func, "send"); @@ -7126,7 +7377,7 @@ PP(pp_eof) gv = last_in_gv; else gv = (GV*)POPs; - PUSHs(do_eof(gv) ? &sv_yes : &sv_no); + PUSHs(!gv || do_eof(gv) ? &sv_yes : &sv_no); RETURN; } @@ -7167,8 +7418,8 @@ PP(pp_truncate) #ifdef HAS_TRUNCATE if (op->op_flags & OPf_SPECIAL) { tmpgv = gv_fetchpv(POPp,FALSE); - if (!tmpgv || !GvIO(tmpgv) || !GvIO(tmpgv)->ifp || - ftruncate(fileno(GvIO(tmpgv)->ifp), len) < 0) + if (!tmpgv || !GvIO(tmpgv) || !IoIFP(GvIO(tmpgv)) || + ftruncate(fileno(IoIFP(GvIO(tmpgv))), len) < 0) result = 0; } else if (truncate(POPp, len) < 0) @@ -7176,8 +7427,8 @@ PP(pp_truncate) #else if (op->op_flags & OPf_SPECIAL) { tmpgv = gv_fetchpv(POPp,FALSE); - if (!tmpgv || !GvIO(tmpgv) || !GvIO(tmpgv)->ifp || - chsize(fileno(GvIO(tmpgv)->ifp), len) < 0) + if (!tmpgv || !GvIO(tmpgv) || !IoIFP(GvIO(tmpgv)) || + chsize(fileno(IoIFP(GvIO(tmpgv))), len) < 0) result = 0; } else { @@ -7219,13 +7470,13 @@ PP(pp_ioctl) GV *gv = (GV*)POPs; IO *io = GvIOn(gv); - if (!io || !argstr || !io->ifp) { + if (!io || !argstr || !IoIFP(io)) { errno = EBADF; /* well, sort of... */ RETPUSHUNDEF; } if (SvPOK(argstr) || !SvNIOK(argstr)) { - STRLEN len; + STRLEN len = 0; if (!SvPOK(argstr)) s = SvPV(argstr, len); retval = IOCPARM_LEN(func); @@ -7249,13 +7500,13 @@ PP(pp_ioctl) TAINT_PROPER(optype == OP_IOCTL ? "ioctl" : "fcntl"); if (optype == OP_IOCTL) - retval = ioctl(fileno(io->ifp), func, s); + retval = ioctl(fileno(IoIFP(io)), func, s); else #ifdef DOSISH DIE("fcntl is not implemented"); #else # ifdef HAS_FCNTL - retval = fcntl(fileno(io->ifp), func, s); + retval = fcntl(fileno(IoIFP(io)), func, s); # else DIE("fcntl is not implemented"); # endif @@ -7293,7 +7544,7 @@ PP(pp_flock) else gv = (GV*)POPs; if (gv && GvIO(gv)) - fp = GvIO(gv)->ifp; + fp = IoIFP(GvIO(gv)); else fp = Nullfp; if (fp) { @@ -7329,20 +7580,20 @@ PP(pp_socket) } io = GvIOn(gv); - if (io->ifp) + if (IoIFP(io)) do_close(gv, FALSE); TAINT_PROPER("socket"); fd = socket(domain, type, protocol); if (fd < 0) RETPUSHUNDEF; - io->ifp = fdopen(fd, "r"); /* stdio gets confused about sockets */ - io->ofp = fdopen(fd, "w"); - io->type = 's'; - if (!io->ifp || !io->ofp) { - if (io->ifp) fclose(io->ifp); - if (io->ofp) fclose(io->ofp); - if (!io->ifp && !io->ofp) close(fd); + IoIFP(io) = fdopen(fd, "r"); /* stdio gets confused about sockets */ + IoOFP(io) = fdopen(fd, "w"); + IoTYPE(io) = 's'; + if (!IoIFP(io) || !IoOFP(io)) { + if (IoIFP(io)) fclose(IoIFP(io)); + if (IoOFP(io)) fclose(IoOFP(io)); + if (!IoIFP(io) && !IoOFP(io)) close(fd); RETPUSHUNDEF; } @@ -7372,27 +7623,27 @@ PP(pp_sockpair) io1 = GvIOn(gv1); io2 = GvIOn(gv2); - if (io1->ifp) + if (IoIFP(io1)) do_close(gv1, FALSE); - if (io2->ifp) + if (IoIFP(io2)) do_close(gv2, FALSE); TAINT_PROPER("socketpair"); if (socketpair(domain, type, protocol, fd) < 0) RETPUSHUNDEF; - io1->ifp = fdopen(fd[0], "r"); - io1->ofp = fdopen(fd[0], "w"); - io1->type = 's'; - io2->ifp = fdopen(fd[1], "r"); - io2->ofp = fdopen(fd[1], "w"); - io2->type = 's'; - if (!io1->ifp || !io1->ofp || !io2->ifp || !io2->ofp) { - if (io1->ifp) fclose(io1->ifp); - if (io1->ofp) fclose(io1->ofp); - if (!io1->ifp && !io1->ofp) close(fd[0]); - if (io2->ifp) fclose(io2->ifp); - if (io2->ofp) fclose(io2->ofp); - if (!io2->ifp && !io2->ofp) close(fd[1]); + IoIFP(io1) = fdopen(fd[0], "r"); + IoOFP(io1) = fdopen(fd[0], "w"); + IoTYPE(io1) = 's'; + IoIFP(io2) = fdopen(fd[1], "r"); + IoOFP(io2) = fdopen(fd[1], "w"); + IoTYPE(io2) = 's'; + if (!IoIFP(io1) || !IoOFP(io1) || !IoIFP(io2) || !IoOFP(io2)) { + if (IoIFP(io1)) fclose(IoIFP(io1)); + if (IoOFP(io1)) fclose(IoOFP(io1)); + if (!IoIFP(io1) && !IoOFP(io1)) close(fd[0]); + if (IoIFP(io2)) fclose(IoIFP(io2)); + if (IoOFP(io2)) fclose(IoOFP(io2)); + if (!IoIFP(io2) && !IoOFP(io2)) close(fd[1]); RETPUSHUNDEF; } @@ -7412,12 +7663,12 @@ PP(pp_bind) register IO *io = GvIOn(gv); STRLEN len; - if (!io || !io->ifp) + if (!io || !IoIFP(io)) goto nuts; addr = SvPV(addrstr, len); TAINT_PROPER("bind"); - if (bind(fileno(io->ifp), addr, len) >= 0) + if (bind(fileno(IoIFP(io)), addr, len) >= 0) RETPUSHYES; else RETPUSHUNDEF; @@ -7442,12 +7693,12 @@ PP(pp_connect) register IO *io = GvIOn(gv); STRLEN len; - if (!io || !io->ifp) + if (!io || !IoIFP(io)) goto nuts; addr = SvPV(addrstr, len); TAINT_PROPER("connect"); - if (connect(fileno(io->ifp), addr, len) >= 0) + if (connect(fileno(IoIFP(io)), addr, len) >= 0) RETPUSHYES; else RETPUSHUNDEF; @@ -7470,10 +7721,10 @@ PP(pp_listen) GV *gv = (GV*)POPs; register IO *io = GvIOn(gv); - if (!io || !io->ifp) + if (!io || !IoIFP(io)) goto nuts; - if (listen(fileno(io->ifp), backlog) >= 0) + if (listen(fileno(IoIFP(io)), backlog) >= 0) RETPUSHYES; else RETPUSHUNDEF; @@ -7508,23 +7759,23 @@ PP(pp_accept) goto nuts; gstio = GvIO(ggv); - if (!gstio || !gstio->ifp) + if (!gstio || !IoIFP(gstio)) goto nuts; nstio = GvIOn(ngv); - if (nstio->ifp) + if (IoIFP(nstio)) do_close(ngv, FALSE); - fd = accept(fileno(gstio->ifp), (struct sockaddr *)buf, &len); + fd = accept(fileno(IoIFP(gstio)), (struct sockaddr *)buf, &len); if (fd < 0) goto badexit; - nstio->ifp = fdopen(fd, "r"); - nstio->ofp = fdopen(fd, "w"); - nstio->type = 's'; - if (!nstio->ifp || !nstio->ofp) { - if (nstio->ifp) fclose(nstio->ifp); - if (nstio->ofp) fclose(nstio->ofp); - if (!nstio->ifp && !nstio->ofp) close(fd); + IoIFP(nstio) = fdopen(fd, "r"); + IoOFP(nstio) = fdopen(fd, "w"); + IoTYPE(nstio) = 's'; + if (!IoIFP(nstio) || !IoOFP(nstio)) { + if (IoIFP(nstio)) fclose(IoIFP(nstio)); + if (IoOFP(nstio)) fclose(IoOFP(nstio)); + if (!IoIFP(nstio) && !IoOFP(nstio)) close(fd); goto badexit; } @@ -7552,10 +7803,10 @@ PP(pp_shutdown) GV *gv = (GV*)POPs; register IO *io = GvIOn(gv); - if (!io || !io->ifp) + if (!io || !IoIFP(io)) goto nuts; - PUSHi( shutdown(fileno(io->ifp), how) >= 0 ); + PUSHi( shutdown(fileno(IoIFP(io)), how) >= 0 ); RETURN; nuts: @@ -7598,10 +7849,10 @@ PP(pp_ssockopt) gv = (GV*)POPs; io = GvIOn(gv); - if (!io || !io->ifp) + if (!io || !IoIFP(io)) goto nuts; - fd = fileno(io->ifp); + fd = fileno(IoIFP(io)); switch (optype) { case OP_GSOCKOPT: SvCUR_set(sv, 256); @@ -7649,13 +7900,13 @@ PP(pp_getpeername) GV *gv = (GV*)POPs; register IO *io = GvIOn(gv); - if (!io || !io->ifp) + if (!io || !IoIFP(io)) goto nuts; sv = sv_2mortal(NEWSV(22, 257)); SvCUR_set(sv, 256); SvPOK_on(sv); - fd = fileno(io->ifp); + fd = fileno(IoIFP(io)); switch (optype) { case OP_GETSOCKNAME: if (getsockname(fd, SvPVX(sv), (int*)&SvCUR(sv)) < 0) @@ -7700,8 +7951,8 @@ PP(pp_stat) laststype = OP_STAT; statgv = tmpgv; sv_setpv(statname, ""); - if (!GvIO(tmpgv) || !GvIO(tmpgv)->ifp || - fstat(fileno(GvIO(tmpgv)->ifp), &statcache) < 0) { + if (!GvIO(tmpgv) || !IoIFP(GvIO(tmpgv)) || + fstat(fileno(IoIFP(GvIO(tmpgv))), &statcache) < 0) { max = 0; laststatval = -1; } @@ -7734,20 +7985,20 @@ PP(pp_stat) RETPUSHUNDEF; } if (max) { - PUSHs(sv_2mortal(newSVnv((double)statcache.st_dev))); - PUSHs(sv_2mortal(newSVnv((double)statcache.st_ino))); - PUSHs(sv_2mortal(newSVnv((double)statcache.st_mode))); - PUSHs(sv_2mortal(newSVnv((double)statcache.st_nlink))); - PUSHs(sv_2mortal(newSVnv((double)statcache.st_uid))); - PUSHs(sv_2mortal(newSVnv((double)statcache.st_gid))); - PUSHs(sv_2mortal(newSVnv((double)statcache.st_rdev))); - PUSHs(sv_2mortal(newSVnv((double)statcache.st_size))); - PUSHs(sv_2mortal(newSVnv((double)statcache.st_atime))); - PUSHs(sv_2mortal(newSVnv((double)statcache.st_mtime))); - PUSHs(sv_2mortal(newSVnv((double)statcache.st_ctime))); + PUSHs(sv_2mortal(newSViv((I32)statcache.st_dev))); + PUSHs(sv_2mortal(newSViv((I32)statcache.st_ino))); + PUSHs(sv_2mortal(newSViv((I32)statcache.st_mode))); + PUSHs(sv_2mortal(newSViv((I32)statcache.st_nlink))); + PUSHs(sv_2mortal(newSViv((I32)statcache.st_uid))); + PUSHs(sv_2mortal(newSViv((I32)statcache.st_gid))); + PUSHs(sv_2mortal(newSViv((I32)statcache.st_rdev))); + PUSHs(sv_2mortal(newSViv((I32)statcache.st_size))); + PUSHs(sv_2mortal(newSViv((I32)statcache.st_atime))); + PUSHs(sv_2mortal(newSViv((I32)statcache.st_mtime))); + PUSHs(sv_2mortal(newSViv((I32)statcache.st_ctime))); #ifdef STATBLOCKS - PUSHs(sv_2mortal(newSVnv((double)statcache.st_blksize))); - PUSHs(sv_2mortal(newSVnv((double)statcache.st_blocks))); + PUSHs(sv_2mortal(newSViv((I32)statcache.st_blksize))); + PUSHs(sv_2mortal(newSViv((I32)statcache.st_blocks))); #else PUSHs(sv_2mortal(newSVpv("", 0))); PUSHs(sv_2mortal(newSVpv("", 0))); @@ -8029,8 +8280,8 @@ PP(pp_fttty) } else gv = gv_fetchpv(tmps = POPp, FALSE); - if (gv && GvIO(gv) && GvIO(gv)->ifp) - fd = fileno(GvIO(gv)->ifp); + if (gv && GvIO(gv) && IoIFP(GvIO(gv))) + fd = fileno(IoIFP(GvIO(gv))); else if (isDIGIT(*tmps)) fd = atoi(tmps); else @@ -8066,23 +8317,23 @@ PP(pp_fttext) sv_setpv(statname, ""); io = GvIO(statgv); } - if (io && io->ifp) { + if (io && IoIFP(io)) { #if defined(STDSTDIO) || defined(atarist) /* this will work with atariST */ - fstat(fileno(io->ifp), &statcache); + fstat(fileno(IoIFP(io)), &statcache); if (S_ISDIR(statcache.st_mode)) /* handle NFS glitch */ if (op->op_type == OP_FTTEXT) RETPUSHNO; else RETPUSHYES; - if (io->ifp->_cnt <= 0) { - i = getc(io->ifp); + if (IoIFP(io)->_cnt <= 0) { + i = getc(IoIFP(io)); if (i != EOF) - (void)ungetc(i, io->ifp); + (void)ungetc(i, IoIFP(io)); } - if (io->ifp->_cnt <= 0) /* null file is anything */ + if (IoIFP(io)->_cnt <= 0) /* null file is anything */ RETPUSHYES; - len = io->ifp->_cnt + (io->ifp->_ptr - io->ifp->_base); - s = io->ifp->_base; + len = IoIFP(io)->_cnt + (IoIFP(io)->_ptr - IoIFP(io)->_base); + s = IoIFP(io)->_base; #else DIE("-T and -B not implemented on filehandles"); #endif @@ -8423,9 +8674,9 @@ PP(pp_open_dir) if (!io) goto nope; - if (io->dirp) - closedir(io->dirp); - if (!(io->dirp = opendir(dirname))) + if (IoDIRP(io)) + closedir(IoDIRP(io)); + if (!(IoDIRP(io) = opendir(dirname))) goto nope; RETPUSHYES; @@ -8449,12 +8700,12 @@ PP(pp_readdir) GV *gv = (GV*)POPs; register IO *io = GvIOn(gv); - if (!io || !io->dirp) + if (!io || !IoDIRP(io)) goto nope; if (GIMME == G_ARRAY) { /*SUPPRESS 560*/ - while (dp = readdir(io->dirp)) { + while (dp = readdir(IoDIRP(io))) { #ifdef DIRNAMLEN XPUSHs(sv_2mortal(newSVpv(dp->d_name, dp->d_namlen))); #else @@ -8463,7 +8714,7 @@ PP(pp_readdir) } } else { - if (!(dp = readdir(io->dirp))) + if (!(dp = readdir(IoDIRP(io)))) goto nope; #ifdef DIRNAMLEN XPUSHs(sv_2mortal(newSVpv(dp->d_name, dp->d_namlen))); @@ -8495,10 +8746,10 @@ PP(pp_telldir) GV *gv = (GV*)POPs; register IO *io = GvIOn(gv); - if (!io || !io->dirp) + if (!io || !IoDIRP(io)) goto nope; - PUSHi( telldir(io->dirp) ); + PUSHi( telldir(IoDIRP(io)) ); RETURN; nope: if (!errno) @@ -8517,10 +8768,10 @@ PP(pp_seekdir) GV *gv = (GV*)POPs; register IO *io = GvIOn(gv); - if (!io || !io->dirp) + if (!io || !IoDIRP(io)) goto nope; - (void)seekdir(io->dirp, along); + (void)seekdir(IoDIRP(io), along); RETPUSHYES; nope: @@ -8539,10 +8790,10 @@ PP(pp_rewinddir) GV *gv = (GV*)POPs; register IO *io = GvIOn(gv); - if (!io || !io->dirp) + if (!io || !IoDIRP(io)) goto nope; - (void)rewinddir(io->dirp); + (void)rewinddir(IoDIRP(io)); RETPUSHYES; nope: if (!errno) @@ -8560,12 +8811,12 @@ PP(pp_closedir) GV *gv = (GV*)POPs; register IO *io = GvIOn(gv); - if (!io || !io->dirp) + if (!io || !IoDIRP(io)) goto nope; - if (closedir(io->dirp) < 0) + if (closedir(IoDIRP(io)) < 0) goto nope; - io->dirp = 0; + IoDIRP(io) = 0; RETPUSHYES; nope: @@ -8909,15 +9160,15 @@ PP(pp_gmtime) PUSHp(mybuf, strlen(mybuf)); } else if (tmbuf) { - PUSHs(sv_2mortal(newSVnv((double)tmbuf->tm_sec))); - PUSHs(sv_2mortal(newSVnv((double)tmbuf->tm_min))); - PUSHs(sv_2mortal(newSVnv((double)tmbuf->tm_hour))); - PUSHs(sv_2mortal(newSVnv((double)tmbuf->tm_mday))); - PUSHs(sv_2mortal(newSVnv((double)tmbuf->tm_mon))); - PUSHs(sv_2mortal(newSVnv((double)tmbuf->tm_year))); - PUSHs(sv_2mortal(newSVnv((double)tmbuf->tm_wday))); - PUSHs(sv_2mortal(newSVnv((double)tmbuf->tm_yday))); - PUSHs(sv_2mortal(newSVnv((double)tmbuf->tm_isdst))); + PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_sec))); + PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_min))); + PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_hour))); + PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_mday))); + PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_mon))); + PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_year))); + PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_wday))); + PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_yday))); + PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_isdst))); } RETURN; } @@ -9123,11 +9374,14 @@ doeval() SAVEINT(padix); SAVESPTR(curpad); SAVESPTR(comppad); - SAVESPTR(comppadname); - SAVEINT(comppadnamefill); + SAVESPTR(comppad_name); + SAVEINT(comppad_name_fill); + SAVEINT(min_intro_pending); + SAVEINT(max_intro_pending); comppad = newAV(); - comppadname = newAV(); - comppadnamefill = -1; + comppad_name = newAV(); + comppad_name_fill = 0; + min_intro_pending = 0; av_push(comppad, Nullsv); curpad = AvARRAY(comppad); padix = 0; @@ -9151,23 +9405,22 @@ doeval() rslen = 1; rschar = '\n'; rspara = 0; - lex_start(); if (yyparse() || error_count || !eval_root) { SV **newsp; I32 gimme; CONTEXT *cx; I32 optype; - lex_end(); op = saveop; - POPBLOCK(cx); - POPEVAL(cx); - pop_return(); - LEAVE; if (eval_root) { op_free(eval_root); eval_root = Nullop; } + POPBLOCK(cx); + POPEVAL(cx); + pop_return(); + lex_end(); + LEAVE; if (optype == OP_REQUIRE) DIE("%s", SvPVx(GvSV(gv_fetchpv("@",TRUE)), na)); rs = nrs; @@ -9176,22 +9429,19 @@ doeval() rspara = (nrslen == 2); RETPUSHUNDEF; } - lex_end(); rs = nrs; rslen = nrslen; rschar = nrschar; rspara = (nrslen == 2); compiling.cop_line = 0; + SAVEFREESV(comppad_name); + SAVEFREESV(comppad); + SAVEFREEOP(eval_root); DEBUG_x(dump_eval()); /* compiled okay, so do it */ - if (beginav) { - calllist(beginav); - av_free(beginav); - beginav = 0; - } sv_setpv(GvSV(gv_fetchpv("@",TRUE)),""); RETURNOP(eval_start); } @@ -9205,6 +9455,7 @@ PP(pp_require) char *tmpname; SV** svp; I32 gimme = G_SCALAR; + FILE *tryrsfp = 0; if (MAXARG < 1) { sv = GvSV(defgv); @@ -9212,6 +9463,12 @@ PP(pp_require) } else sv = POPs; + if (SvNIOK(sv) && !SvPOKp(sv)) { + if (SvNV(sv) > atof(patchlevel) + 0.000999) + DIE("Perl %3.3f required--this is only version %s, stopped", + SvNV(sv),patchlevel); + RETPUSHYES; + } name = SvPV(sv, na); if (op->op_type == OP_REQUIRE && (svp = hv_fetch(GvHVn(incgv), name, SvCUR(sv), 0)) && @@ -9220,16 +9477,13 @@ PP(pp_require) /* prepare to compile file */ - sv_setpv(linestr,""); - - SAVESPTR(rsfp); /* in case we're in a BEGIN */ tmpname = savestr(name); if (*tmpname == '/' || (*tmpname == '.' && (tmpname[1] == '/' || (tmpname[1] == '.' && tmpname[2] == '/')))) { - rsfp = fopen(tmpname,"r"); + tryrsfp = fopen(tmpname,"r"); } else { AV *ar = GvAVn(incgv); @@ -9238,8 +9492,8 @@ PP(pp_require) for (i = 0; i <= AvFILL(ar); i++) { (void)sprintf(buf, "%s/%s", SvPVx(*av_fetch(ar, i, TRUE), na), name); - rsfp = fopen(buf, "r"); - if (rsfp) { + tryrsfp = fopen(buf, "r"); + if (tryrsfp) { char *s = buf; if (*s == '.' && s[1] == '/') @@ -9253,7 +9507,7 @@ PP(pp_require) compiling.cop_filegv = gv_fetchfile(tmpname); Safefree(tmpname); tmpname = Nullch; - if (!rsfp) { + if (!tryrsfp) { if (op->op_type == OP_REQUIRE) { sprintf(tokenbuf,"Can't locate %s in @INC", name); if (instr(tokenbuf,".h ")) @@ -9268,15 +9522,17 @@ PP(pp_require) ENTER; SAVETMPS; + lex_start(sv_2mortal(newSVpv("",0))); + rsfp = tryrsfp; + name = savestr(name); + SAVEFREEPV(name); /* switch to eval mode */ push_return(op->op_next); - PUSHBLOCK(cx,CXt_EVAL,SP); - PUSHEVAL(cx,savestr(name)); + PUSHBLOCK(cx, CXt_EVAL, SP); + PUSHEVAL(cx, name, compiling.cop_filegv); - if (curcop->cop_line == 0) /* don't debug debugger... */ - perldb = FALSE; compiling.cop_line = 0; PUTBACK; @@ -9294,25 +9550,27 @@ PP(pp_entereval) register CONTEXT *cx; dPOPss; I32 gimme = GIMME; + char tmpbuf[32]; ENTER; SAVETMPS; + lex_start(sv); /* switch to eval mode */ + sprintf(tmpbuf, "_<(eval %d)", ++evalseq); + compiling.cop_filegv = gv_fetchfile(tmpbuf+2); + compiling.cop_line = 1; + SAVEDELETE(defstash, savestr(tmpbuf), strlen(tmpbuf)); + push_return(op->op_next); - PUSHBLOCK(cx,CXt_EVAL,SP); - PUSHEVAL(cx,0); + PUSHBLOCK(cx, CXt_EVAL, SP); + PUSHEVAL(cx, 0, compiling.cop_filegv); /* prepare to compile string */ - save_item(linestr); - sv_setsv(linestr, sv); - sv_catpv(linestr, "\n;"); - compiling.cop_filegv = gv_fetchfile("(eval)"); - compiling.cop_line = 1; - if (perldb) - save_lines(GvAV(curcop->cop_filegv), linestr); + if (perldb && curstash != debstash) + save_lines(GvAV(compiling.cop_filegv), linestr); PUTBACK; return doeval(); } @@ -9334,8 +9592,12 @@ PP(pp_leaveeval) if (gimme == G_SCALAR) { MARK = newsp + 1; - if (MARK <= SP) - *MARK = sv_mortalcopy(TOPs); + if (MARK <= SP) { + if (SvFLAGS(TOPs) & SVs_TEMP) + *MARK = TOPs; + else + *MARK = sv_mortalcopy(TOPs); + } else { MEXTEND(mark,0); *MARK = &sv_undef; @@ -9344,7 +9606,8 @@ PP(pp_leaveeval) } else { for (mark = newsp + 1; mark <= SP; mark++) - *mark = sv_mortalcopy(*mark); + if (!(SvFLAGS(TOPs) & SVs_TEMP)) + *mark = sv_mortalcopy(*mark); /* in case LEAVE wipes old return values */ } @@ -9357,12 +9620,9 @@ PP(pp_leaveeval) } else if (optype == OP_REQUIRE) retop = die("%s did not return a true value", name); - Safefree(name); } - op_free(eroot); - av_free(comppad); - av_free(comppadname); + lex_end(); LEAVE; sv_setpv(GvSV(gv_fetchpv("@",TRUE)),""); @@ -9376,7 +9636,7 @@ PP(pp_evalonce) SP = do_eval(st[1], OP_EVAL, curcop->cop_stash, TRUE, GIMME, arglast); if (eval_root) { - sv_free(cSVOP->op_sv); + SvREFCNT_dec(cSVOP->op_sv); op[1].arg_ptr.arg_cmd = eval_root; op[1].op_type = (A_CMD|A_DONT); op[0].op_type = OP_TRY; @@ -9397,8 +9657,9 @@ PP(pp_entertry) SAVETMPS; push_return(cLOGOP->op_other->op_next); - PUSHBLOCK(cx,CXt_EVAL,SP); - PUSHEVAL(cx,0); + PUSHBLOCK(cx, CXt_EVAL, SP); + PUSHEVAL(cx, 0, 0); + eval_root = op; /* Only needed so that goto works right. */ in_eval = 1; sv_setpv(GvSV(gv_fetchpv("@",TRUE)),""); @@ -9420,8 +9681,12 @@ PP(pp_leavetry) if (gimme == G_SCALAR) { MARK = newsp + 1; - if (MARK <= SP) - *MARK = sv_mortalcopy(TOPs); + if (MARK <= SP) { + if (SvFLAGS(TOPs) & (SVs_PADTMP|SVs_TEMP)) + *MARK = TOPs; + else + *MARK = sv_mortalcopy(TOPs); + } else { MEXTEND(mark,0); *MARK = &sv_undef; @@ -9430,7 +9695,8 @@ PP(pp_leavetry) } else { for (mark = newsp + 1; mark <= SP; mark++) - *mark = sv_mortalcopy(*mark); + if (!(SvFLAGS(TOPs) & (SVs_PADTMP|SVs_TEMP))) + *mark = sv_mortalcopy(*mark); /* in case LEAVE wipes old return values */ } @@ -9498,7 +9764,7 @@ PP(pp_ghostent) #endif if (GIMME != G_ARRAY) { - PUSHs(sv = sv_mortalcopy(&sv_undef)); + PUSHs(sv = sv_newmortal()); if (hent) { if (which == OP_GHBYNAME) { sv_setpvn(sv, hent->h_addr, hent->h_length); @@ -9581,7 +9847,7 @@ PP(pp_gnetent) EXTEND(SP, 4); if (GIMME != G_ARRAY) { - PUSHs(sv = sv_mortalcopy(&sv_undef)); + PUSHs(sv = sv_newmortal()); if (nent) { if (which == OP_GNBYNAME) sv_setiv(sv, (I32)nent->n_net); @@ -9651,7 +9917,7 @@ PP(pp_gprotoent) EXTEND(SP, 3); if (GIMME != G_ARRAY) { - PUSHs(sv = sv_mortalcopy(&sv_undef)); + PUSHs(sv = sv_newmortal()); if (pent) { if (which == OP_GPBYNAME) sv_setiv(sv, (I32)pent->p_proto); @@ -9730,7 +9996,7 @@ PP(pp_gservent) EXTEND(SP, 4); if (GIMME != G_ARRAY) { - PUSHs(sv = sv_mortalcopy(&sv_undef)); + PUSHs(sv = sv_newmortal()); if (sent) { if (which == OP_GSBYNAME) { #ifdef HAS_NTOHS @@ -9901,7 +10167,7 @@ PP(pp_gpwent) EXTEND(SP, 10); if (GIMME != G_ARRAY) { - PUSHs(sv = sv_mortalcopy(&sv_undef)); + PUSHs(sv = sv_newmortal()); if (pwent) { if (which == OP_GPWNAM) sv_setiv(sv, (I32)pwent->pw_uid); @@ -10018,7 +10284,7 @@ PP(pp_ggrent) EXTEND(SP, 4); if (GIMME != G_ARRAY) { - PUSHs(sv = sv_mortalcopy(&sv_undef)); + PUSHs(sv = sv_newmortal()); if (grent) { if (which == OP_GGRNAM) sv_setiv(sv, (I32)grent->gr_gid); @@ -10099,7 +10365,7 @@ PP(pp_syscall) if (tainting) { while (++MARK <= SP) { - if (SvMAGICAL(*MARK) && mg_find(*MARK, 't')) + if (SvRMAGICAL(*MARK) && mg_find(*MARK, 't')) tainted = TRUE; } MARK = ORIGMARK; diff --git a/pp.h b/pp.h index d6a1c4c..84ca50f 100644 --- a/pp.h +++ b/pp.h @@ -83,18 +83,18 @@ /* Go to some pains in the rare event that we must extend the stack. */ #define EXTEND(p,n) do { if (stack_max - p < (n)) { \ - av_fill(stack, (p - stack_base) + (n)); \ + av_fill(stack, (p - stack_base) + (n) + 128); \ sp = AvARRAY(stack) + (sp - stack_base); \ stack_base = AvARRAY(stack); \ - stack_max = stack_base + AvMAX(stack); \ + stack_max = stack_base + AvMAX(stack) - 1; \ } } while (0) /* Same thing, but update mark register too. */ #define MEXTEND(p,n) do {if (stack_max - p < (n)) { \ - av_fill(stack, (p - stack_base) + (n)); \ + av_fill(stack, (p - stack_base) + (n) + 128); \ sp = AvARRAY(stack) + (sp - stack_base); \ mark = AvARRAY(stack) + (mark - stack_base); \ stack_base = AvARRAY(stack); \ - stack_max = stack_base + AvMAX(stack); \ + stack_max = stack_base + AvMAX(stack) - 1; \ } } while (0) #define PUSHs(s) (*++sp = (s)) @@ -169,3 +169,8 @@ #define SAVELONG(l) save_int((long*)(&l)); #define SAVESPTR(s) save_sptr((SV**)(&s)) #define SAVETMPS save_int(&tmps_floor), tmps_floor = tmps_ix +#define SAVEFREESV(s) save_freesv((SV*)(s)) +#define SAVEFREEOP(o) save_freeop((OP*)(o)) +#define SAVEFREEPV(p) save_freepv((char*)(p)) +#define SAVECLEARSV(sv) save_clearsv((SV**)(&sv)) +#define SAVEDELETE(h,k,l) save_delete((HV*)(h), (char*)(k), (I32)l) diff --git a/proto.h b/proto.h index 9407cca..7bec500 100644 --- a/proto.h +++ b/proto.h @@ -22,6 +22,14 @@ void av_undef P((AV* ar)); void av_unshift P((AV* ar, I32 num)); OP* bind_match P((I32 type, OP* left, OP* pat)); OP* block_head P((OP* o, OP** startp)); +int boot_DB_File P((int ix, int sp, int items)); +int boot_DynamicLoader P((void)); +int boot_NDBM_File P((int ix, int sp, int items)); +int boot_GDBM_File P((int ix, int sp, int items)); +int boot_SDBM_File P((int ix, int sp, int items)); +int boot_ODBM_File P((int ix, int sp, int items)); +int boot_DBZ_File P((int ix, int sp, int items)); +int boot_POSIX P((int ix, int sp, int items)); void calllist P((AV* list)); I32 cando P((I32 bit, I32 effective, struct stat* statbufp)); U32 cast_ulong P((double f)); @@ -120,18 +128,12 @@ void hv_undef P((HV* tb)); I32 ibcmp P((char* a, char* b, I32 len)); I32 ingroup P((int testgid, I32 effective)); char* instr P((char* big, char* little)); -int init_DB_File P((int ix, int sp, int items)); -int init_NDBM_File P((int ix, int sp, int items)); -int init_GDBM_File P((int ix, int sp, int items)); -int init_SDBM_File P((int ix, int sp, int items)); -int init_ODBM_File P((int ix, int sp, int items)); -int init_DBZ_File P((int ix, int sp, int items)); OP* invert P((OP* cmd)); OP* jmaybe P((OP* arg)); I32 keyword P((char* d, I32 len)); void leave_scope P((I32 base)); void lex_end P((void)); -void lex_start P((void)); +void lex_start P((SV *line)); OP* linklist P((OP* op)); OP* list P((OP* o)); OP* listkids P((OP* o)); @@ -174,6 +176,7 @@ MAGIC* mg_find P((SV* sv, char type)); int mg_free P((SV* sv)); int mg_get P((SV* sv)); U32 mg_len P((SV* sv)); +void mg_magical P((SV* sv)); int mg_set P((SV* sv)); OP* mod P((OP* op, I32 type)); char* moreswitches P((char* s)); @@ -198,6 +201,7 @@ OP* newCONDOP P((I32 flags, OP* expr, OP* true, OP* false)); void newFORM P((I32 floor, OP* op, OP* block)); OP* newFOROP P((I32 flags, char* label, line_t forline, OP* scalar, OP* expr, OP*block, OP*cont)); OP* newLOGOP P((I32 optype, I32 flags, OP* left, OP* right)); +OP* newLOOPEX P((I32 type, OP* label)); OP* newLOOPOP P((I32 flags, I32 debuggable, OP* expr, OP* block)); OP* newMETHOD P((OP* ref, OP* name)); OP* newNAMEOP P((OP* o)); @@ -256,8 +260,9 @@ void pad_swipe P((PADOFFSET po)); OP* parse_list P((SV* sv)); void peep P((OP* op)); PerlInterpreter* perl_alloc P((void)); -I32 perl_callback P((char* subname, I32 sp, I32 gimme, I32 hasargs, I32 numargs)); -I32 perl_callv P((char* subname, I32 sp, I32 gimme, char** argv)); +I32 perl_callargv P((char* subname, I32 sp, I32 gimme, char** argv)); +I32 perl_callpv P((char* subname, I32 sp, I32 gimme, I32 hasargs, I32 numargs)); +I32 perl_callsv P((CV* cv, I32 sp, I32 gimme, I32 hasargs, I32 numargs)); void perl_construct P((PerlInterpreter* sv_interp)); void perl_destruct P((PerlInterpreter* sv_interp)); void perl_free P((PerlInterpreter* sv_interp)); @@ -269,7 +274,6 @@ OP* pmruntime P((OP* pm, OP* expr, OP* repl)); OP* pop_return P((void)); OP* prepend_elem P((I32 optype, OP* head, OP* tail)); void push_return P((OP* op)); -void pv_grow P((char** strptr, I32* curlen, I32 newlen)); OP* rcatmaybe P((OP* arg)); regexp* regcomp P((char* exp, char* xend, I32 fold)); OP* ref P((OP* op, I32 type)); @@ -294,6 +298,11 @@ I32 same_dirent P((char* a, char* b)); void savestack_grow P((void)); void save_aptr P((AV** aptr)); AV* save_ary P((GV* gv)); +void save_clearsv P((SV** svp)); +void save_delete P((HV* hv, char* key, I32 klen)); +void save_freesv P((SV* sv)); +void save_freeop P((OP* op)); +void save_freepv P((char* pv)); HV* save_hash P((GV* gv)); void save_hptr P((HV** hptr)); void save_I32 P((I32* intp)); @@ -327,6 +336,7 @@ OP* scope P((OP* o)); char* screaminstr P((SV* bigsv, SV* littlesv)); I32 setenv_getix P((char* nam)); char* skipspace P((char* s)); +int start_subparse P((void)); bool sv_2bool P((SV* sv)); CV* sv_2cv P((SV* sv, HV** st, GV** gvp, I32 lref)); I32 sv_2iv P((SV* sv)); @@ -339,9 +349,13 @@ void sv_catpv P((SV* sv, char* ptr)); void sv_catpvn P((SV* sv, char* ptr, STRLEN len)); void sv_catsv P((SV* dsv, SV* ssv)); void sv_chop P((SV* sv, char* ptr)); +void sv_clean_all P((void)); +void sv_clean_magic P((void)); +void sv_clean_refs P((void)); void sv_clear P((SV* sv)); I32 sv_cmp P((SV* sv1, SV* sv2)); void sv_dec P((SV* sv)); +void sv_dump P((SV* sv)); I32 sv_eq P((SV* sv1, SV* sv2)); void sv_free P((SV* sv)); char* sv_gets P((SV* sv, FILE* fp, I32 append)); @@ -357,8 +371,10 @@ void sv_intrpcompile P((SV* src)); STRLEN sv_len P((SV* sv)); void sv_magic P((SV* sv, SV* obj, char how, char* name, I32 namlen)); SV* sv_mortalcopy P((SV* oldsv)); -SV* sv_ref P((SV* sv)); +SV* sv_newmortal P((void)); +SV* sv_newref P((SV* sv)); void sv_replace P((SV* sv, SV* nsv)); +void sv_report_used P((void)); void sv_reset P((char* s, HV* stash)); void sv_setiv P((SV* sv, I32 num)); void sv_setnv P((SV* sv, double num)); @@ -382,3 +398,4 @@ OP* wopt P((OP* cmd)); int yyerror P((char* s)); int yylex P((void)); int yyparse P((void)); +int yywarn P((char* s)); diff --git a/regcomp.c b/regcomp.c index 9960624..90f678d 100644 --- a/regcomp.c +++ b/regcomp.c @@ -369,10 +369,10 @@ I32 fold; SvTAIL_on(r->regmust); } else { - sv_free(longest); + SvREFCNT_dec(longest); longest = Nullsv; } - sv_free(longish); + SvREFCNT_dec(longish); } r->do_folding = fold; @@ -1448,11 +1448,11 @@ struct regexp *r; r->subbase = Nullch; } if (r->regmust) { - sv_free(r->regmust); + SvREFCNT_dec(r->regmust); r->regmust = Nullsv; } if (r->regstart) { - sv_free(r->regstart); + SvREFCNT_dec(r->regstart); r->regstart = Nullsv; } Safefree(r->startp); diff --git a/regexec.c b/regexec.c index 9bfcfba..131ad0f 100644 --- a/regexec.c +++ b/regexec.c @@ -165,7 +165,7 @@ I32 safebase; /* no need to remember string in subbase */ minlen = prog->regback + SvCUR(prog->regmust); } else if (--BmUSEFUL(prog->regmust) < 0) { /* boo */ - sv_free(prog->regmust); + SvREFCNT_dec(prog->regmust); prog->regmust = Nullsv; /* disable regmust */ s = string; } diff --git a/run.c b/run.c index 76fd63c..eb32302 100644 --- a/run.c +++ b/run.c @@ -53,7 +53,7 @@ OP *op; sv = NEWSV(0,0); gv_fullname(sv, cGVOP->op_gv); fprintf(stderr, "(%s)", SvPV(sv, na)); - sv_free(sv); + SvREFCNT_dec(sv); } else fprintf(stderr, "(NULL)"); diff --git a/save_ary.bad b/save_ary.bad new file mode 100644 index 0000000..807e339 --- /dev/null +++ b/save_ary.bad @@ -0,0 +1,44 @@ +AV * +save_ary(av) +AV *av; +{ + register SV *sv; + + sv = NEWSV(10,0); + sv->sv_state = SVs_SARY; + sv_setpv(sv, (char*)av, sizeof(AV)); + + av->av_sv.sv_rare = AVf_REAL; + av->av_magic = NEWSV(7,0); + av->av_alloc = av->av_array = 0; + /* sv_magic(av->av_magic, gv, '#', Nullch, 0); */ + av->av_max = av->av_fill = -1; + + sv->sv_u.sv_av = av; + (void)av_push(savestack,sv); /* save array ptr */ + return av; +} + +HV * +save_hash(hv) +HV *hv; +{ + register SV *sv; + + sv = NEWSV(11,0); + sv->sv_state = SVs_SHASH; + sv_setpv(sv, (char*)hv, sizeof(HV)); + + hv->hv_array = 0; + hv->hv_max = 7; + hv->hv_dosplit = hv->hv_max * FILLPCT / 100; + hv->hv_fill = 0; +#ifdef SOME_DBM + hv->hv_dbm = 0; +#endif + (void)hv_iterinit(hv); /* so each() will start off right */ + + sv->sv_u.sv_hv = hv; + (void)av_push(savestack,sv); /* save hash ptr */ + return hv; +} diff --git a/scope.c b/scope.c index 22b206c..2575e56 100644 --- a/scope.c +++ b/scope.c @@ -54,8 +54,7 @@ void pop_scope() { I32 oldsave = scopestack[--scopestack_ix]; - if (savestack_ix > oldsave) - leave_scope(oldsave); + LEAVE_SCOPE(oldsave); } void @@ -77,7 +76,7 @@ free_tmps() #ifdef DEBUGGING SvTEMP_off(sv); #endif - sv_free(sv); /* note, can modify tmps_ix!!! */ + SvREFCNT_dec(sv); /* note, can modify tmps_ix!!! */ } } } @@ -250,6 +249,55 @@ AV **aptr; } void +save_freesv(sv) +SV *sv; +{ + SSCHECK(2); + SSPUSHPTR(sv); + SSPUSHINT(SAVEt_FREESV); +} + +void +save_freeop(op) +OP *op; +{ + SSCHECK(2); + SSPUSHPTR(op); + SSPUSHINT(SAVEt_FREEOP); +} + +void +save_freepv(pv) +char *pv; +{ + SSCHECK(2); + SSPUSHPTR(pv); + SSPUSHINT(SAVEt_FREEPV); +} + +void +save_clearsv(svp) +SV** svp; +{ + SSCHECK(2); + SSPUSHPTR(svp); + SSPUSHINT(SAVEt_CLEARSV); +} + +void +save_delete(hv,key,klen) +HV *hv; +char *key; +I32 klen; +{ + SSCHECK(4); + SSPUSHINT(klen); + SSPUSHPTR(key); + SSPUSHPTR(hv); + SSPUSHINT(SAVEt_DELETE); +} + +void save_list(sarg,maxsarg) register SV **sarg; I32 maxsarg; @@ -294,7 +342,7 @@ I32 base; sv = GvSV(gv); if (SvTYPE(sv) >= SVt_PVMG) SvMAGIC(sv) = 0; - sv_free(sv); + SvREFCNT_dec(sv); GvSV(gv) = sv = value; SvSETMAGIC(sv); break; @@ -303,20 +351,20 @@ I32 base; sv = *(SV**)ptr; if (SvTYPE(sv) >= SVt_PVMG) SvMAGIC(sv) = 0; - sv_free(sv); + SvREFCNT_dec(sv); *(SV**)ptr = sv = (SV*)SSPOPPTR; SvSETMAGIC(sv); break; case SAVEt_AV: /* array reference */ av = (AV*)SSPOPPTR; gv = (GV*)SSPOPPTR; - av_free(GvAV(gv)); + SvREFCNT_dec(GvAV(gv)); GvAV(gv) = av; break; case SAVEt_HV: /* hash reference */ hv = (HV*)SSPOPPTR; gv = (GV*)SSPOPPTR; - (void)hv_free(GvHV(gv)); + SvREFCNT_dec(GvHV(gv)); GvHV(gv) = hv; break; case SAVEt_INT: /* int reference */ @@ -349,8 +397,160 @@ I32 base; gp_free(gv); GvGP(gv) = (GP*)ptr; break; + case SAVEt_FREESV: + ptr = SSPOPPTR; + SvREFCNT_dec((SV*)ptr); + break; + case SAVEt_FREEOP: + ptr = SSPOPPTR; + curpad = AvARRAY(comppad); + op_free((OP*)ptr); + break; + case SAVEt_FREEPV: + ptr = SSPOPPTR; + Safefree((char*)ptr); + break; + case SAVEt_CLEARSV: + ptr = SSPOPPTR; + sv = *(SV**)ptr; + if (SvREFCNT(sv) <= 1) { /* Can clear pad variable in place. */ + if (SvTHINKFIRST(sv)) { + if (SvREADONLY(sv)) + croak("panic: leave_scope clearsv"); + if (SvROK(sv)) + sv_unref(sv); + } + + switch (SvTYPE(sv)) { + case SVt_NULL: + break; + case SVt_PVAV: + av_clear((AV*)sv); + break; + case SVt_PVHV: + hv_clear((HV*)sv); + break; + case SVt_PVCV: + sub_generation++; + cv_clear((CV*)sv); + break; + default: + if (SvPOK(sv) && SvLEN(sv)) + SvOOK_off(sv); + SvOK_off(sv); + SvSETMAGIC(sv); + break; + } + } + else { /* Someone has a claim on this, so abandon it. */ + SvREFCNT_dec(sv); /* Cast current value to the winds. */ + switch (SvTYPE(sv)) { /* Console ourselves with a new value */ + case SVt_PVAV: *(SV**)ptr = (SV*)newAV(); break; + case SVt_PVHV: *(SV**)ptr = (SV*)newHV(); break; + default: *(SV**)ptr = NEWSV(0,0); break; + } + } + break; + case SAVEt_DELETE: + ptr = SSPOPPTR; + hv = (HV*)ptr; + ptr = SSPOPPTR; + hv_delete(hv, (char*)ptr, (U32)SSPOPINT); + break; default: croak("panic: leave_scope inconsistency"); } } } + +#ifdef DEBUGGING +void +cx_dump(cx) +CONTEXT* cx; +{ + fprintf(stderr, "CX %d = %s\n", cx - cxstack, block_type[cx->cx_type]); + if (cx->cx_type != CXt_SUBST) { + fprintf(stderr, "BLK_OLDSP = %ld\n", (long)cx->blk_oldsp); + fprintf(stderr, "BLK_OLDCOP = 0x%lx\n", (long)cx->blk_oldcop); + fprintf(stderr, "BLK_OLDMARKSP = %ld\n", (long)cx->blk_oldmarksp); + fprintf(stderr, "BLK_OLDSCOPESP = %ld\n", (long)cx->blk_oldscopesp); + fprintf(stderr, "BLK_OLDRETSP = %ld\n", (long)cx->blk_oldretsp); + fprintf(stderr, "BLK_OLDPM = 0x%lx\n", (long)cx->blk_oldpm); + fprintf(stderr, "BLK_GIMME = %s\n", cx->blk_gimme ? "LIST" : "SCALAR"); + } + switch (cx->cx_type) { + case CXt_NULL: + case CXt_BLOCK: + break; + case CXt_SUB: + fprintf(stderr, "BLK_SUB.CV = 0x%lx\n", + (long)cx->blk_sub.cv); + fprintf(stderr, "BLK_SUB.GV = 0x%lx\n", + (long)cx->blk_sub.gv); + fprintf(stderr, "BLK_SUB.DFOUTGV = 0x%lx\n", + (long)cx->blk_sub.dfoutgv); + fprintf(stderr, "BLK_SUB.OLDDEPTH = %ld\n", + (long)cx->blk_sub.olddepth); + fprintf(stderr, "BLK_SUB.HASARGS = %d\n", + (int)cx->blk_sub.hasargs); + break; + case CXt_EVAL: + fprintf(stderr, "BLK_EVAL.OLD_IN_EVAL = %ld\n", + (long)cx->blk_eval.old_in_eval); + fprintf(stderr, "BLK_EVAL.OLD_OP_TYPE = %s\n", + op_name[cx->blk_eval.old_op_type]); + fprintf(stderr, "BLK_EVAL.OLD_NAME = %s\n", + cx->blk_eval.old_name); + fprintf(stderr, "BLK_EVAL.OLD_EVAL_ROOT = 0x%lx\n", + (long)cx->blk_eval.old_eval_root); + break; + + case CXt_LOOP: + fprintf(stderr, "BLK_LOOP.LABEL = %s\n", + cx->blk_loop.label); + fprintf(stderr, "BLK_LOOP.RESETSP = %ld\n", + (long)cx->blk_loop.resetsp); + fprintf(stderr, "BLK_LOOP.REDO_OP = 0x%lx\n", + (long)cx->blk_loop.redo_op); + fprintf(stderr, "BLK_LOOP.NEXT_OP = 0x%lx\n", + (long)cx->blk_loop.next_op); + fprintf(stderr, "BLK_LOOP.LAST_OP = 0x%lx\n", + (long)cx->blk_loop.last_op); + fprintf(stderr, "BLK_LOOP.ITERIX = %ld\n", + (long)cx->blk_loop.iterix); + fprintf(stderr, "BLK_LOOP.ITERARY = 0x%lx\n", + (long)cx->blk_loop.iterary); + fprintf(stderr, "BLK_LOOP.ITERVAR = 0x%lx\n", + (long)cx->blk_loop.itervar); + if (cx->blk_loop.itervar) + fprintf(stderr, "BLK_LOOP.ITERSAVE = 0x%lx\n", + (long)cx->blk_loop.itersave); + break; + + case CXt_SUBST: + fprintf(stderr, "SB_ITERS = %ld\n", + (long)cx->sb_iters); + fprintf(stderr, "SB_MAXITERS = %ld\n", + (long)cx->sb_maxiters); + fprintf(stderr, "SB_SAFEBASE = %ld\n", + (long)cx->sb_safebase); + fprintf(stderr, "SB_ONCE = %ld\n", + (long)cx->sb_once); + fprintf(stderr, "SB_ORIG = %s\n", + cx->sb_orig); + fprintf(stderr, "SB_DSTR = 0x%lx\n", + (long)cx->sb_dstr); + fprintf(stderr, "SB_TARG = 0x%lx\n", + (long)cx->sb_targ); + fprintf(stderr, "SB_S = 0x%lx\n", + (long)cx->sb_s); + fprintf(stderr, "SB_M = 0x%lx\n", + (long)cx->sb_m); + fprintf(stderr, "SB_STREND = 0x%lx\n", + (long)cx->sb_strend); + fprintf(stderr, "SB_SUBBASE = 0x%lx\n", + (long)cx->sb_subbase); + break; + } +} +#endif diff --git a/scope.h b/scope.h index 6c753c5..e2e2004 100644 --- a/scope.h +++ b/scope.h @@ -10,9 +10,17 @@ #define SAVEt_NSTAB 9 #define SAVEt_SVREF 10 #define SAVEt_GP 11 +#define SAVEt_FREESV 12 +#define SAVEt_FREEOP 13 +#define SAVEt_FREEPV 14 +#define SAVEt_CLEARSV 15 +#define SAVEt_DELETE 16 #define SSCHECK(need) if (savestack_ix + need > savestack_max) savestack_grow() #define SSPUSHINT(i) (savestack[savestack_ix++].any_i32 = (I32)(i)) #define SSPUSHPTR(p) (savestack[savestack_ix++].any_ptr = (void*)(p)) #define SSPOPINT (savestack[--savestack_ix].any_i32) #define SSPOPPTR (savestack[--savestack_ix].any_ptr) + +#define FREE_TMPS() if (tmps_ix > tmps_floor) free_tmps() +#define LEAVE_SCOPE(old) if (savestack_ix > old) leave_scope(old) diff --git a/sv.c b/sv.c index fd51712..dfe3c78 100644 --- a/sv.c +++ b/sv.c @@ -50,8 +50,6 @@ static void ucase(); static void lcase(); -static SV* sv_root; - static SV* more_sv(); static SV* @@ -61,6 +59,7 @@ new_sv() if (sv_root) { sv = sv_root; sv_root = (SV*)SvANY(sv); + ++sv_count; return sv; } return more_sv(); @@ -72,6 +71,7 @@ SV* p; { SvANY(p) = sv_root; sv_root = p; + --sv_count; } static SV* @@ -80,18 +80,97 @@ more_sv() register int i; register SV* sv; register SV* svend; - sv_root = (SV*)malloc(1008); + sv_root = (SV*)safemalloc(1012); sv = sv_root; svend = &sv[1008 / sizeof(SV) - 1]; while (sv < svend) { SvANY(sv) = (SV*)(sv + 1); + SvFLAGS(sv) = SVTYPEMASK; sv++; } SvANY(sv) = 0; + sv++; + SvANY(sv) = sv_arenaroot; + sv_arenaroot = sv_root; return new_sv(); } -static I32* xiv_root; +void +sv_report_used() +{ + SV* sv; + register SV* svend; + + for (sv = sv_arenaroot; sv; sv = SvANY(sv)) { + svend = &sv[1008 / sizeof(SV)]; + while (sv < svend) { + if (SvTYPE(sv) != SVTYPEMASK) { + fprintf(stderr, "****\n"); + sv_dump(sv); + } + ++sv; + } + } +} + +void +sv_clean_refs() +{ + register SV* sv; + register SV* svend; + + for (sv = sv_arenaroot; sv; sv = SvANY(sv)) { + svend = &sv[1008 / sizeof(SV)]; + while (sv < svend) { + if (SvREFCNT(sv) == 1 && SvROK(sv)) { + DEBUG_D((fprintf(stderr, "Cleaning ref:\n "), sv_dump(sv));) + SvFLAGS(SvRV(sv)) |= SVf_BREAK; + SvFLAGS(sv) |= SVf_BREAK; + SvREFCNT_dec(sv); + } + ++sv; + } + } +} + +void +sv_clean_magic() +{ + register SV* sv; + register SV* svend; + + for (sv = sv_arenaroot; sv; sv = SvANY(sv)) { + svend = &sv[1008 / sizeof(SV)]; + while (sv < svend) { + if (SvTYPE(sv) != SVTYPEMASK && SvMAGICAL(sv)) { + DEBUG_D((fprintf(stderr, "Cleaning magic:\n "), sv_dump(sv));) + SvFLAGS(sv) |= SVf_BREAK; + sv_unmagic(sv); + SvREFCNT_dec(sv); + } + ++sv; + } + } +} + +void +sv_clean_all() +{ + register SV* sv; + register SV* svend; + + for (sv = sv_arenaroot; sv; sv = SvANY(sv)) { + svend = &sv[1008 / sizeof(SV)]; + while (sv < svend) { + if (SvTYPE(sv) != SVTYPEMASK) { + DEBUG_D((fprintf(stderr, "Cleaning loops:\n "), sv_dump(sv));) + SvFLAGS(sv) |= SVf_BREAK; + SvREFCNT_dec(sv); + } + ++sv; + } + } +} static XPVIV* more_xiv(); @@ -122,7 +201,7 @@ more_xiv() register int i; register I32* xiv; register I32* xivend; - xiv = (I32*)malloc(1008); + xiv = (I32*)safemalloc(1008); xivend = &xiv[1008 / sizeof(I32) - 1]; xiv += (sizeof(XPV) - 1) / sizeof(I32) + 1; /* fudge by size of XPV */ xiv_root = xiv; @@ -134,8 +213,6 @@ more_xiv() return new_xiv(); } -static double* xnv_root; - static XPVNV* more_xnv(); static XPVNV* @@ -165,7 +242,7 @@ more_xnv() register int i; register double* xnv; register double* xnvend; - xnv = (double*)malloc(1008); + xnv = (double*)safemalloc(1008); xnvend = &xnv[1008 / sizeof(double) - 1]; xnv += (sizeof(XPVIV) - 1) / sizeof(double) + 1; /* fudge by sizeof XPVIV */ xnv_root = xnv; @@ -177,8 +254,6 @@ more_xnv() return new_xnv(); } -static XRV* xrv_root; - static XRV* more_xrv(); static XRV* @@ -207,7 +282,7 @@ more_xrv() register int i; register XRV* xrv; register XRV* xrvend; - xrv_root = (XRV*)malloc(1008); + xrv_root = (XRV*)safemalloc(1008); xrv = xrv_root; xrvend = &xrv[1008 / sizeof(XRV) - 1]; while (xrv < xrvend) { @@ -218,8 +293,6 @@ more_xrv() return new_xrv(); } -static XPV* xpv_root; - static XPV* more_xpv(); static XPV* @@ -248,7 +321,7 @@ more_xpv() register int i; register XPV* xpv; register XPV* xpvend; - xpv_root = (XPV*)malloc(1008); + xpv_root = (XPV*)safemalloc(1008); xpv = xpv_root; xpvend = &xpv[1008 / sizeof(XPV) - 1]; while (xpv < xpvend) { @@ -261,7 +334,7 @@ more_xpv() #ifdef PURIFY -#define new_SV() sv = (SV*)malloc(sizeof(SV)) +#define new_SV() sv = (SV*)safemalloc(sizeof(SV)) #define del_SV(p) free((char*)p) #else @@ -270,15 +343,19 @@ more_xpv() if (sv_root) { \ sv = sv_root; \ sv_root = (SV*)SvANY(sv); \ + ++sv_count; \ } \ else \ sv = more_sv(); -#define del_SV(p) del_sv(p) +#define del_SV(p) \ + SvANY(p) = sv_root; \ + sv_root = p; \ + --sv_count; #endif #ifdef PURIFY -#define new_XIV() (void*)malloc(sizeof(XPVIV)) +#define new_XIV() (void*)safemalloc(sizeof(XPVIV)) #define del_XIV(p) free((char*)p) #else #define new_XIV() new_xiv() @@ -286,7 +363,7 @@ more_xpv() #endif #ifdef PURIFY -#define new_XNV() (void*)malloc(sizeof(XPVNV)) +#define new_XNV() (void*)safemalloc(sizeof(XPVNV)) #define del_XNV(p) free((char*)p) #else #define new_XNV() new_xnv() @@ -294,7 +371,7 @@ more_xpv() #endif #ifdef PURIFY -#define new_XRV() (void*)malloc(sizeof(XRV)) +#define new_XRV() (void*)safemalloc(sizeof(XRV)) #define del_XRV(p) free((char*)p) #else #define new_XRV() new_xrv() @@ -302,43 +379,46 @@ more_xpv() #endif #ifdef PURIFY -#define new_XPV() (void*)malloc(sizeof(XPV)) +#define new_XPV() (void*)safemalloc(sizeof(XPV)) #define del_XPV(p) free((char*)p) #else #define new_XPV() new_xpv() #define del_XPV(p) del_xpv(p) #endif -#define new_XPVIV() (void*)malloc(sizeof(XPVIV)) +#define new_XPVIV() (void*)safemalloc(sizeof(XPVIV)) #define del_XPVIV(p) free((char*)p) -#define new_XPVNV() (void*)malloc(sizeof(XPVNV)) +#define new_XPVNV() (void*)safemalloc(sizeof(XPVNV)) #define del_XPVNV(p) free((char*)p) -#define new_XPVMG() (void*)malloc(sizeof(XPVMG)) +#define new_XPVMG() (void*)safemalloc(sizeof(XPVMG)) #define del_XPVMG(p) free((char*)p) -#define new_XPVLV() (void*)malloc(sizeof(XPVLV)) +#define new_XPVLV() (void*)safemalloc(sizeof(XPVLV)) #define del_XPVLV(p) free((char*)p) -#define new_XPVAV() (void*)malloc(sizeof(XPVAV)) +#define new_XPVAV() (void*)safemalloc(sizeof(XPVAV)) #define del_XPVAV(p) free((char*)p) -#define new_XPVHV() (void*)malloc(sizeof(XPVHV)) +#define new_XPVHV() (void*)safemalloc(sizeof(XPVHV)) #define del_XPVHV(p) free((char*)p) -#define new_XPVCV() (void*)malloc(sizeof(XPVCV)) +#define new_XPVCV() (void*)safemalloc(sizeof(XPVCV)) #define del_XPVCV(p) free((char*)p) -#define new_XPVGV() (void*)malloc(sizeof(XPVGV)) +#define new_XPVGV() (void*)safemalloc(sizeof(XPVGV)) #define del_XPVGV(p) free((char*)p) -#define new_XPVBM() (void*)malloc(sizeof(XPVBM)) +#define new_XPVBM() (void*)safemalloc(sizeof(XPVBM)) #define del_XPVBM(p) free((char*)p) -#define new_XPVFM() (void*)malloc(sizeof(XPVFM)) +#define new_XPVFM() (void*)safemalloc(sizeof(XPVFM)) #define del_XPVFM(p) free((char*)p) +#define new_XPVIO() (void*)safemalloc(sizeof(XPVIO)) +#define del_XPVIO(p) free((char*)p) + bool sv_upgrade(sv, mt) register SV* sv; @@ -601,8 +681,35 @@ U32 mt; SvSTASH(sv) = stash; FmLINES(sv) = 0; break; - } - SvTYPE(sv) = mt; + case SVt_PVIO: + SvANY(sv) = new_XPVIO(); + SvPVX(sv) = pv; + SvCUR(sv) = cur; + SvLEN(sv) = len; + SvIVX(sv) = iv; + SvNVX(sv) = nv; + SvMAGIC(sv) = magic; + SvSTASH(sv) = stash; + IoIFP(sv) = 0; + IoOFP(sv) = 0; + IoDIRP(sv) = 0; + IoLINES(sv) = 60; + IoPAGE(sv) = 0; + IoPAGE_LEN(sv) = 0; + IoLINES_LEFT(sv)= 0; + IoTOP_NAME(sv) = 0; + IoTOP_GV(sv) = 0; + IoFMT_NAME(sv) = 0; + IoFMT_GV(sv) = 0; + IoBOTTOM_NAME(sv)= 0; + IoBOTTOM_GV(sv) = 0; + IoSUBPROCESS(sv)= 0; + IoTYPE(sv) = 0; + IoFLAGS(sv) = 0; + break; + } + SvFLAGS(sv) &= ~SVTYPEMASK; + SvFLAGS(sv) |= mt; return TRUE; } @@ -672,8 +779,11 @@ register SV *sv; strcpy(t,"HV"); break; case SVt_PVCV: - strcpy(t,"CV"); - break; + if (CvGV(sv)) + sprintf(t, "CV(%s)", GvNAME(CvGV(sv))); + else + strcpy(t, "CV()"); + return tokenbuf; case SVt_PVGV: strcpy(t,"GV"); break; @@ -683,6 +793,9 @@ register SV *sv; case SVt_PVFM: strcpy(t,"FM"); break; + case SVt_PVIO: + strcpy(t,"IO"); + break; } } t += strlen(t); @@ -691,7 +804,7 @@ register SV *sv; if (!SvPVX(sv)) return "(null)"; if (SvOOK(sv)) - sprintf(t,"(%d+\"%0.127s\")",SvIVX(sv),SvPVX(sv)); + sprintf(t,"(%ld+\"%0.127s\")",(long)SvIVX(sv),SvPVX(sv)); else sprintf(t,"(\"%0.127s\")",SvPVX(sv)); } @@ -737,8 +850,6 @@ unsigned long newlen; } #endif /* MSDOS */ if (SvTHINKFIRST(sv)) { - if (SvREADONLY(sv)) - croak(no_modify); if (SvROK(sv)) sv_unref(sv); } @@ -771,7 +882,7 @@ register SV *sv; I32 i; { if (SvTHINKFIRST(sv)) { - if (SvREADONLY(sv)) + if (SvREADONLY(sv) && curcop != &compiling) croak(no_modify); if (SvROK(sv)) sv_unref(sv); @@ -799,7 +910,7 @@ register SV *sv; double num; { if (SvTHINKFIRST(sv)) { - if (SvREADONLY(sv)) + if (SvREADONLY(sv) && curcop != &compiling) croak(no_modify); if (SvROK(sv)) sv_unref(sv); @@ -822,7 +933,7 @@ register SV *sv; { if (!sv) return 0; - if (SvMAGICAL(sv)) { + if (SvGMAGICAL(sv)) { mg_get(sv); if (SvIOKp(sv)) return SvIVX(sv); @@ -835,15 +946,17 @@ register SV *sv; if (SvTHINKFIRST(sv)) { if (SvROK(sv)) return (I32)SvRV(sv); +#ifdef TOOSTRICT if (SvREADONLY(sv)) { if (SvNOK(sv)) return (I32)SvNVX(sv); if (SvPOK(sv) && SvLEN(sv)) return (I32)atol(SvPVX(sv)); if (dowarn) - warn("Use of uninitialized variable"); + warn(warn_uninit); return 0; } +#endif } switch (SvTYPE(sv)) { case SVt_NULL: @@ -869,12 +982,12 @@ register SV *sv; } else { if (dowarn) - warn("Use of uninitialized variable"); + warn(warn_uninit); SvUPGRADE(sv, SVt_IV); SvIVX(sv) = 0; } SvIOK_on(sv); - DEBUG_c((stderr,"0x%lx 2iv(%d)\n",sv,SvIVX(sv))); + DEBUG_c((stderr,"0x%lx 2iv(%ld)\n",sv,(long)SvIVX(sv))); return SvIVX(sv); } @@ -884,7 +997,7 @@ register SV *sv; { if (!sv) return 0.0; - if (SvMAGICAL(sv)) { + if (SvGMAGICAL(sv)) { mg_get(sv); if (SvNOKp(sv)) return SvNVX(sv); @@ -897,13 +1010,17 @@ register SV *sv; if (SvTHINKFIRST(sv)) { if (SvROK(sv)) return (double)(unsigned long)SvRV(sv); +#ifdef TOOSTRICT if (SvREADONLY(sv)) { if (SvPOK(sv) && SvLEN(sv)) return atof(SvPVX(sv)); + if (SvIOK(sv)) + return (double)SvIVX(sv); if (dowarn) - warn("Use of uninitialized variable"); + warn(warn_uninit); return 0.0; } +#endif } if (SvTYPE(sv) < SVt_NV) { if (SvTYPE(sv) == SVt_IV) @@ -911,7 +1028,6 @@ register SV *sv; else sv_upgrade(sv, SVt_NV); DEBUG_c((stderr,"0x%lx num(%g)\n",sv,SvNVX(sv))); - return SvNVX(sv); } else if (SvTYPE(sv) < SVt_PVNV) sv_upgrade(sv, SVt_PVNV); @@ -931,7 +1047,7 @@ register SV *sv; } else { if (dowarn) - warn("Use of uninitialized variable"); + warn(warn_uninit); SvNVX(sv) = 0.0; } SvNOK_on(sv); @@ -951,7 +1067,7 @@ STRLEN *lp; *lp = 0; return ""; } - if (SvMAGICAL(sv)) { + if (SvGMAGICAL(sv)) { mg_get(sv); if (SvPOKp(sv)) { *lp = SvCUR(sv); @@ -992,6 +1108,7 @@ STRLEN *lp; case SVt_PVCV: s = "CODE"; break; case SVt_PVGV: s = "GLOB"; break; case SVt_PVFM: s = "FORMATLINE"; break; + case SVt_PVIO: s = "FILEHANDLE"; break; default: s = "UNKNOWN"; break; } if (SvOBJECT(sv)) @@ -1004,6 +1121,7 @@ STRLEN *lp; *lp = strlen(s); return s; } +#ifdef TOOSTRICT if (SvREADONLY(sv)) { if (SvIOK(sv)) { (void)sprintf(tokenbuf,"%ld",SvIVX(sv)); @@ -1016,10 +1134,11 @@ STRLEN *lp; return tokenbuf; } if (dowarn) - warn("Use of uninitialized variable"); + warn(warn_uninit); *lp = 0; return ""; } +#endif } if (!SvUPGRADE(sv, SVt_PV)) return 0; @@ -1058,7 +1177,7 @@ STRLEN *lp; } else { if (dowarn) - warn("Use of uninitialized variable"); + warn(warn_uninit); sv_grow(sv, 1); s = SvPVX(sv); } @@ -1075,7 +1194,7 @@ bool sv_2bool(sv) register SV *sv; { - if (SvMAGICAL(sv)) + if (SvGMAGICAL(sv)) mg_get(sv); if (SvROK(sv)) @@ -1112,66 +1231,68 @@ sv_setsv(dstr,sstr) SV *dstr; register SV *sstr; { - int flags; + register U32 sflags; + register int dtype; + register int stype; if (sstr == dstr) return; if (SvTHINKFIRST(dstr)) { - if (SvREADONLY(dstr)) + if (SvREADONLY(dstr) && curcop != &compiling) croak(no_modify); if (SvROK(dstr)) sv_unref(dstr); } if (!sstr) sstr = &sv_undef; + stype = SvTYPE(sstr); + dtype = SvTYPE(dstr); /* There's a lot of redundancy below but we're going for speed here */ - switch (SvTYPE(sstr)) { + switch (stype) { case SVt_NULL: SvOK_off(dstr); return; case SVt_IV: - if (SvTYPE(dstr) < SVt_IV) - sv_upgrade(dstr, SVt_IV); - else if (SvTYPE(dstr) == SVt_PV) - sv_upgrade(dstr, SVt_PVIV); - else if (SvTYPE(dstr) == SVt_NV) - sv_upgrade(dstr, SVt_PVNV); - flags = SvFLAGS(sstr); + if (dtype <= SVt_PV) { + if (dtype < SVt_IV) + sv_upgrade(dstr, SVt_IV); + else if (dtype == SVt_PV) + sv_upgrade(dstr, SVt_PVIV); + else if (dtype == SVt_NV) + sv_upgrade(dstr, SVt_PVNV); + } break; case SVt_NV: - if (SvTYPE(dstr) < SVt_NV) - sv_upgrade(dstr, SVt_NV); - else if (SvTYPE(dstr) == SVt_PV) - sv_upgrade(dstr, SVt_PVNV); - else if (SvTYPE(dstr) == SVt_PVIV) - sv_upgrade(dstr, SVt_PVNV); - flags = SvFLAGS(sstr); + if (dtype <= SVt_PVIV) { + if (dtype < SVt_NV) + sv_upgrade(dstr, SVt_NV); + else if (dtype == SVt_PV) + sv_upgrade(dstr, SVt_PVNV); + else if (dtype == SVt_PVIV) + sv_upgrade(dstr, SVt_PVNV); + } break; case SVt_RV: - if (SvTYPE(dstr) < SVt_RV) + if (dtype < SVt_RV) sv_upgrade(dstr, SVt_RV); - flags = SvFLAGS(sstr); break; case SVt_PV: - if (SvTYPE(dstr) < SVt_PV) + if (dtype < SVt_PV) sv_upgrade(dstr, SVt_PV); - flags = SvFLAGS(sstr); break; case SVt_PVIV: - if (SvTYPE(dstr) < SVt_PVIV) + if (dtype < SVt_PVIV) sv_upgrade(dstr, SVt_PVIV); - flags = SvFLAGS(sstr); break; case SVt_PVNV: - if (SvTYPE(dstr) < SVt_PVNV) + if (dtype < SVt_PVNV) sv_upgrade(dstr, SVt_PVNV); - flags = SvFLAGS(sstr); break; case SVt_PVGV: - if (SvTYPE(dstr) <= SVt_PVGV) { - if (SvTYPE(dstr) < SVt_PVGV) + if (dtype <= SVt_PVGV) { + if (dtype < SVt_PVGV) sv_upgrade(dstr, SVt_PVGV); SvOK_off(dstr); if (!GvAV(sstr)) @@ -1183,40 +1304,68 @@ register SV *sstr; if (GvGP(dstr)) gp_free(dstr); GvGP(dstr) = gp_ref(GvGP(sstr)); - SvTAINT(sstr); + SvTAINT(dstr); return; } /* FALL THROUGH */ default: - if (SvTYPE(dstr) < SvTYPE(sstr)) - sv_upgrade(dstr, SvTYPE(sstr)); - if (SvMAGICAL(sstr)) { + if (dtype < stype) + sv_upgrade(dstr, stype); + if (SvGMAGICAL(sstr)) mg_get(sstr); - flags = SvPRIVATE(sstr); - } - else - flags = SvFLAGS(sstr); } - SvPRIVATE(dstr) = SvPRIVATE(sstr) & ~(SVf_IOK|SVf_POK|SVf_NOK); - - if (SvROK(sstr)) { + sflags = SvFLAGS(sstr); + + if (sflags & SVf_ROK) { + if (dtype >= SVt_PV) { + if (dtype == SVt_PVGV) { + SV *sref = SvREFCNT_inc(SvRV(sstr)); + SV *dref = 0; + GP *oldgp = GvGP(dstr); + GP *gp; + + switch (SvTYPE(sref)) { + case SVt_PVAV: + dref = (SV*)GvAV(dstr); + GvAV(dstr) = (AV*)sref; + break; + case SVt_PVHV: + dref = (SV*)GvHV(dstr); + GvHV(dstr) = (HV*)sref; + break; + case SVt_PVCV: + dref = (SV*)GvCV(dstr); + GvCV(dstr) = (CV*)sref; + break; + default: + dref = (SV*)GvSV(dstr); + GvSV(dstr) = sref; + break; + } + if (dref) + SvREFCNT_dec(dref); + SvTAINT(dstr); + return; + } + if (SvPVX(dstr)) + Safefree(SvPVX(dstr)); + } SvOK_off(dstr); - if (SvTYPE(dstr) >= SVt_PV && SvPVX(dstr)) - Safefree(SvPVX(dstr)); - SvRV(dstr) = sv_ref(SvRV(sstr)); + SvRV(dstr) = SvREFCNT_inc(SvRV(sstr)); SvROK_on(dstr); - if (flags & SVf_NOK) { + ++sv_rvcount; + if (sflags & SVp_NOK) { SvNOK_on(dstr); SvNVX(dstr) = SvNVX(sstr); } - if (flags & SVf_IOK) { + if (sflags & SVp_IOK) { SvIOK_on(dstr); SvIVX(dstr) = SvIVX(sstr); } } - else if (flags & SVf_POK) { + else if (sflags & SVp_POK) { /* * Check to see if we can just swipe the string. If so, it's a @@ -1241,22 +1390,25 @@ register SV *sstr; SvPVX(sstr) = 0; /* so sstr frees uneventfully */ } else { /* have to copy actual string */ - if (SvPVX(dstr)) { /* XXX ck type */ - SvOOK_off(dstr); - } - sv_setpvn(dstr,SvPVX(sstr),SvCUR(sstr)); + STRLEN len = SvCUR(sstr); + + SvGROW(dstr, len + 1); /* inlined from sv_setpvn */ + Move(SvPVX(sstr),SvPVX(dstr),len,char); + SvCUR_set(dstr, len); + *SvEND(dstr) = '\0'; + SvPOK_only(dstr); } /*SUPPRESS 560*/ - if (flags & SVf_NOK) { + if (sflags & SVp_NOK) { SvNOK_on(dstr); SvNVX(dstr) = SvNVX(sstr); } - if (flags & SVf_IOK) { + if (sflags & SVp_IOK) { SvIOK_on(dstr); SvIVX(dstr) = SvIVX(sstr); } } - else if (flags & SVf_NOK) { + else if (sflags & SVp_NOK) { SvNVX(dstr) = SvNVX(sstr); SvNOK_only(dstr); if (SvIOK(sstr)) { @@ -1264,7 +1416,7 @@ register SV *sstr; SvIVX(dstr) = SvIVX(sstr); } } - else if (flags & SVf_IOK) { + else if (sflags & SVp_IOK) { SvIOK_only(dstr); SvIVX(dstr) = SvIVX(sstr); } @@ -1281,7 +1433,7 @@ register char *ptr; register STRLEN len; { if (SvTHINKFIRST(sv)) { - if (SvREADONLY(sv)) + if (SvREADONLY(sv) && curcop != &compiling) croak(no_modify); if (SvROK(sv)) sv_unref(sv); @@ -1309,7 +1461,7 @@ register char *ptr; register STRLEN len; if (SvTHINKFIRST(sv)) { - if (SvREADONLY(sv)) + if (SvREADONLY(sv) && curcop != &compiling) croak(no_modify); if (SvROK(sv)) sv_unref(sv); @@ -1335,7 +1487,7 @@ register char *ptr; register STRLEN len; { if (SvTHINKFIRST(sv)) { - if (SvREADONLY(sv)) + if (SvREADONLY(sv) && curcop != &compiling) croak(no_modify); if (SvROK(sv)) sv_unref(sv); @@ -1367,7 +1519,7 @@ register char *ptr; if (!ptr || !SvPOK(sv)) return; if (SvTHINKFIRST(sv)) { - if (SvREADONLY(sv)) + if (SvREADONLY(sv) && curcop != &compiling) croak(no_modify); if (SvROK(sv)) sv_unref(sv); @@ -1379,7 +1531,7 @@ register char *ptr; SvIVX(sv) = 0; SvFLAGS(sv) |= SVf_OOK; } - SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK); + SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK|SVp_IOK|SVp_NOK); delta = ptr - SvPVX(sv); SvLEN(sv) -= delta; SvCUR(sv) -= delta; @@ -1396,10 +1548,13 @@ register STRLEN len; STRLEN tlen; char *s; if (SvTHINKFIRST(sv)) { - if (SvREADONLY(sv)) + if (SvREADONLY(sv) && curcop != &compiling) croak(no_modify); - if (SvROK(sv)) + if (SvROK(sv)) { + s = SvPV(sv, tlen); sv_unref(sv); + sv_setpvn(sv, s, tlen); + } } s = SvPV(sv, tlen); SvGROW(sv, tlen + len + 1); @@ -1433,7 +1588,7 @@ register char *ptr; char *s; if (SvTHINKFIRST(sv)) { - if (SvREADONLY(sv)) + if (SvREADONLY(sv) && curcop != &compiling) croak(no_modify); if (SvROK(sv)) sv_unref(sv); @@ -1461,8 +1616,9 @@ STRLEN len; register SV *sv; new_SV(); - Zero(sv, 1, SV); - SvREFCNT(sv)++; + SvANY(sv) = 0; + SvREFCNT(sv) = 1; + SvFLAGS(sv) = 0; if (len) { sv_upgrade(sv, SVt_PV); SvGROW(sv, len + 1); @@ -1471,17 +1627,21 @@ STRLEN len; } void +#ifndef STANDARD_C sv_magic(sv, obj, how, name, namlen) register SV *sv; SV *obj; char how; char *name; I32 namlen; +#else +sv_magic(register SV *sv, SV *obj, char how, char *name, I32 namlen) +#endif /* STANDARD_C */ { MAGIC* mg; if (SvTHINKFIRST(sv)) { - if (SvREADONLY(sv)) + if (SvREADONLY(sv) && curcop != &compiling) croak(no_modify); } if (SvMAGICAL(sv)) { @@ -1491,16 +1651,15 @@ I32 namlen; else { if (!SvUPGRADE(sv, SVt_PVMG)) return; - SvMAGICAL_on(sv); - SvPRIVATE(sv) &= ~(SVf_IOK|SVf_NOK|SVf_POK); - SvPRIVATE(sv) |= SvFLAGS(sv) & (SVf_IOK|SVf_NOK|SVf_POK); - SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK|SVf_POK); } Newz(702,mg, 1, MAGIC); mg->mg_moremagic = SvMAGIC(sv); SvMAGIC(sv) = mg; - mg->mg_obj = sv_ref(obj); + if (obj == sv) + mg->mg_obj = obj; + else + mg->mg_obj = SvREFCNT_inc(obj); mg->mg_type = how; mg->mg_len = namlen; if (name && namlen >= 0) @@ -1566,12 +1725,19 @@ I32 namlen; default: croak("Don't know how to handle magic of type '%c'", how); } + mg_magical(sv); + if (SvGMAGICAL(sv)) + SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK|SVf_POK); } int +#ifndef STANDARD_C sv_unmagic(sv, type) SV* sv; char type; +#else +sv_unmagic(SV *sv, char type) +#endif /* STANDARD_C */ { MAGIC* mg; MAGIC** mgp; @@ -1586,7 +1752,7 @@ char type; (*vtbl->svt_free)(sv, mg); if (mg->mg_ptr && mg->mg_type != 'g') Safefree(mg->mg_ptr); - sv_free(mg->mg_obj); + SvREFCNT_dec(mg->mg_obj); Safefree(mg); } else @@ -1594,9 +1760,7 @@ char type; } if (!SvMAGIC(sv)) { SvMAGICAL_off(sv); - SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK|SVf_POK); - SvFLAGS(sv) |= SvPRIVATE(sv) & (SVf_IOK|SVf_NOK|SVf_POK); - SvPRIVATE(sv) &= ~(SVf_IOK|SVf_NOK|SVf_POK); + SvFLAGS(sv) |= (SvFLAGS(sv) & (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT; } return 0; @@ -1616,8 +1780,10 @@ STRLEN littlelen; register char *bigend; register I32 i; + if (!bigstr) + croak("Can't modify non-existent substring"); if (SvTHINKFIRST(bigstr)) { - if (SvREADONLY(bigstr)) + if (SvREADONLY(bigstr) && curcop != &compiling) croak(no_modify); if (SvROK(bigstr)) sv_unref(bigstr); @@ -1699,7 +1865,7 @@ register SV *nsv; { U32 refcnt = SvREFCNT(sv); if (SvTHINKFIRST(sv)) { - if (SvREADONLY(sv)) + if (SvREADONLY(sv) && curcop != &compiling) croak(no_modify); if (SvROK(sv)) sv_unref(sv); @@ -1743,10 +1909,11 @@ register SV *sv; destructor = gv_fetchpv("DESTROY", FALSE); if (destructor && GvCV(destructor)) { - SV* ref = sv_mortalcopy(&sv_undef); - sv_upgrade(ref, SVt_RV); - SvRV(ref) = sv_ref(sv); - SvROK_on(ref); + SV ref; + Zero(&ref, 1, SV); + sv_upgrade(&ref, SVt_RV); + SvRV(&ref) = SvREFCNT_inc(sv); + SvROK_on(&ref); op = (OP*)&myop; Zero(op, 1, OP); @@ -1757,19 +1924,23 @@ register SV *sv; EXTEND(SP, 2); PUSHs((SV*)destructor); pp_pushmark(); - PUSHs(ref); + PUSHs(&ref); PUTBACK; op = pp_entersubr(); if (op) run(); stack_sp--; SvREFCNT(sv) = 0; - SvTYPE(ref) = SVt_NULL; - free_tmps(); } + SvREFCNT_dec(SvSTASH(sv)); LEAVE; } switch (SvTYPE(sv)) { + case SVt_PVIO: + Safefree(IoTOP_NAME(sv)); + Safefree(IoFMT_NAME(sv)); + Safefree(IoBOTTOM_NAME(sv)); + goto freemagic; case SVt_PVFM: goto freemagic; case SVt_PVBM: @@ -1782,9 +1953,11 @@ register SV *sv; goto freemagic; case SVt_PVHV: hv_clear((HV*)sv); + SvPVX(sv)= 0; goto freemagic; case SVt_PVAV: av_clear((AV*)sv); + SvPVX(sv)= 0; goto freemagic; case SVt_PVLV: goto freemagic; @@ -1797,7 +1970,9 @@ register SV *sv; SvOOK_off(sv); /* FALL THROUGH */ case SVt_PV: - if (SvPVX(sv)) + if (SvROK(sv)) + SvREFCNT_dec(SvRV(sv)); + else if (SvPVX(sv)) Safefree(SvPVX(sv)); break; case SVt_NV: @@ -1805,7 +1980,7 @@ register SV *sv; case SVt_IV: break; case SVt_RV: - sv_free(SvRV(sv)); + SvREFCNT_dec(SvRV(sv)); break; case SVt_NULL: break; @@ -1856,12 +2031,15 @@ register SV *sv; case SVt_PVFM: del_XPVFM(SvANY(sv)); break; + case SVt_PVIO: + del_XPVIO(SvANY(sv)); + break; } - DEB(SvTYPE(sv) = 0xff;) + SvFLAGS(sv) |= SVTYPEMASK; } SV * -sv_ref(sv) +sv_newref(sv) SV* sv; { if (sv) @@ -1881,20 +2059,19 @@ SV *sv; return; } } - if (SvREFCNT(sv) == 0) { + if (SvREFCNT(sv) == 0 && !(SvFLAGS(sv) & SVf_BREAK)) { warn("Attempt to free unreferenced scalar"); return; } + if (--SvREFCNT(sv) > 0) + return; #ifdef DEBUGGING if (SvTEMP(sv)) { warn("Attempt to free temp prematurely"); return; } #endif - if (--SvREFCNT(sv) > 0) - return; sv_clear(sv); - DEB(SvTYPE(sv) = 0xff;) del_SV(sv); } @@ -1908,7 +2085,10 @@ register SV *sv; if (!sv) return 0; - s = SvPV(sv, len); + if (SvGMAGICAL(sv)) + len = mg_len(sv); + else + s = SvPV(sv, len); return len; } @@ -2001,7 +2181,7 @@ I32 append; I32 shortbuffered; if (SvTHINKFIRST(sv)) { - if (SvREADONLY(sv)) + if (SvREADONLY(sv) && curcop != &compiling) croak(no_modify); if (SvROK(sv)) sv_unref(sv); @@ -2141,28 +2321,25 @@ register SV *sv; if (!sv) return; if (SvTHINKFIRST(sv)) { - if (SvREADONLY(sv)) + if (SvREADONLY(sv) && curcop != &compiling) croak(no_modify); if (SvROK(sv)) sv_unref(sv); } - if (SvMAGICAL(sv)) { + if (SvGMAGICAL(sv)) mg_get(sv); - flags = SvPRIVATE(sv); - } - else - flags = SvFLAGS(sv); - if (flags & SVf_IOK) { + flags = SvFLAGS(sv); + if (flags & SVp_IOK) { ++SvIVX(sv); SvIOK_only(sv); return; } - if (flags & SVf_NOK) { + if (flags & SVp_NOK) { SvNVX(sv) += 1.0; SvNOK_only(sv); return; } - if (!(flags & SVf_POK) || !*SvPVX(sv)) { + if (!(flags & SVp_POK) || !*SvPVX(sv)) { if (!SvUPGRADE(sv, SVt_NV)) return; SvNVX(sv) = 1.0; @@ -2210,28 +2387,25 @@ register SV *sv; if (!sv) return; if (SvTHINKFIRST(sv)) { - if (SvREADONLY(sv)) + if (SvREADONLY(sv) && curcop != &compiling) croak(no_modify); if (SvROK(sv)) sv_unref(sv); } - if (SvMAGICAL(sv)) { + if (SvGMAGICAL(sv)) mg_get(sv); - flags = SvPRIVATE(sv); - } - else - flags = SvFLAGS(sv); - if (flags & SVf_IOK) { + flags = SvFLAGS(sv); + if (flags & SVp_IOK) { --SvIVX(sv); SvIOK_only(sv); return; } - if (flags & SVf_NOK) { + if (flags & SVp_NOK) { SvNVX(sv) -= 1.0; SvNOK_only(sv); return; } - if (!(flags & SVf_POK)) { + if (!(flags & SVp_POK)) { if (!SvUPGRADE(sv, SVt_NV)) return; SvNVX(sv) = -1.0; @@ -2246,6 +2420,13 @@ register SV *sv; * hopefully we won't free it until it has been assigned to a * permanent location. */ +static void +sv_mortalgrow() +{ + tmps_max += 128; + Renew(tmps_stack, tmps_max, SV*); +} + SV * sv_mortalcopy(oldstr) SV *oldstr; @@ -2253,21 +2434,29 @@ SV *oldstr; register SV *sv; new_SV(); - Zero(sv, 1, SV); - SvREFCNT(sv)++; + SvANY(sv) = 0; + SvREFCNT(sv) = 1; + SvFLAGS(sv) = 0; sv_setsv(sv,oldstr); - if (++tmps_ix > tmps_max) { - tmps_max = tmps_ix; - if (!(tmps_max & 127)) { - if (tmps_max) - Renew(tmps_stack, tmps_max + 128, SV*); - else - New(702,tmps_stack, 128, SV*); - } - } + if (++tmps_ix >= tmps_max) + sv_mortalgrow(); + tmps_stack[tmps_ix] = sv; + SvTEMP_on(sv); + return sv; +} + +SV * +sv_newmortal() +{ + register SV *sv; + + new_SV(); + SvANY(sv) = 0; + SvREFCNT(sv) = 1; + SvFLAGS(sv) = SVs_TEMP; + if (++tmps_ix >= tmps_max) + sv_mortalgrow(); tmps_stack[tmps_ix] = sv; - if (SvPOK(sv)) - SvTEMP_on(sv); return sv; } @@ -2280,23 +2469,13 @@ register SV *sv; if (!sv) return sv; if (SvTHINKFIRST(sv)) { - if (SvREADONLY(sv)) + if (SvREADONLY(sv) && curcop != &compiling) croak(no_modify); - if (SvROK(sv)) - sv_unref(sv); - } - if (++tmps_ix > tmps_max) { - tmps_max = tmps_ix; - if (!(tmps_max & 127)) { - if (tmps_max) - Renew(tmps_stack, tmps_max + 128, SV*); - else - New(704,tmps_stack, 128, SV*); - } } + if (++tmps_ix >= tmps_max) + sv_mortalgrow(); tmps_stack[tmps_ix] = sv; - if (SvPOK(sv)) - SvTEMP_on(sv); + SvTEMP_on(sv); return sv; } @@ -2308,8 +2487,9 @@ STRLEN len; register SV *sv; new_SV(); - Zero(sv, 1, SV); - SvREFCNT(sv)++; + SvANY(sv) = 0; + SvREFCNT(sv) = 1; + SvFLAGS(sv) = 0; if (!len) len = strlen(s); sv_setpvn(sv,s,len); @@ -2323,8 +2503,9 @@ double n; register SV *sv; new_SV(); - Zero(sv, 1, SV); - SvREFCNT(sv)++; + SvANY(sv) = 0; + SvREFCNT(sv) = 1; + SvFLAGS(sv) = 0; sv_setnv(sv,n); return sv; } @@ -2336,8 +2517,9 @@ I32 i; register SV *sv; new_SV(); - Zero(sv, 1, SV); - SvREFCNT(sv)++; + SvANY(sv) = 0; + SvREFCNT(sv) = 1; + SvFLAGS(sv) = 0; sv_setiv(sv,i); return sv; } @@ -2352,13 +2534,14 @@ register SV *old; if (!old) return Nullsv; - if (SvTYPE(old) == 0xff) { + if (SvTYPE(old) == SVTYPEMASK) { warn("semi-panic: attempt to dup freed string"); return Nullsv; } new_SV(); - Zero(sv, 1, SV); - SvREFCNT(sv)++; + SvANY(sv) = 0; + SvREFCNT(sv) = 1; + SvFLAGS(sv) = 0; if (SvTEMP(old)) { SvTEMP_off(old); sv_setsv(sv,old); @@ -2461,6 +2644,11 @@ I32 lref; case SVt_PVAV: *gvp = Nullgv; return Nullcv; + case SVt_PVGV: + gv = (GV*)sv; + *st = GvESTASH(gv); + goto fix_gv; + default: if (SvROK(sv)) goto is_rv; @@ -2472,6 +2660,14 @@ I32 lref; if (!gv) return Nullcv; *st = GvESTASH(gv); + fix_gv: + if (lref && !GvCV(gv)) { + sv = NEWSV(0,0); + gv_efullname(sv, gv); + newSUB(savestack_ix, + newSVOP(OP_CONST, 0, sv), + Nullop); + } return GvCV(gv); } } @@ -2481,7 +2677,9 @@ I32 SvTRUE(sv) register SV *sv; { - if (SvMAGICAL(sv)) + if (!sv) + return 0; + if (SvGMAGICAL(sv)) mg_get(sv); if (SvPOK(sv)) { register XPV* Xpv; @@ -2557,17 +2755,19 @@ char *name; return rv; new_SV(); - Zero(sv, 1, SV); - SvREFCNT(sv)++; + SvANY(sv) = 0; + SvREFCNT(sv) = 1; + SvFLAGS(sv) = 0; sv_setnv(sv, (double)(unsigned long)ptr); sv_upgrade(rv, SVt_RV); - SvRV(rv) = sv_ref(sv); + SvRV(rv) = SvREFCNT_inc(sv); SvROK_on(rv); + ++sv_rvcount; stash = fetch_stash(newSVpv(name,0), TRUE); SvOBJECT_on(sv); SvUPGRADE(sv, SVt_PVMG); - SvSTASH(sv) = stash; + SvSTASH(sv) = (HV*)SvREFCNT_inc(stash); return rv; } @@ -2576,9 +2776,223 @@ void sv_unref(sv) SV* sv; { - sv_free(SvRV(sv)); + SvREFCNT_dec(SvRV(sv)); SvRV(sv) = 0; SvROK_off(sv); - if (!SvREADONLY(sv)) - SvTHINKFIRST_off(sv); + --sv_rvcount; } + +#ifdef DEBUGGING +void +sv_dump(sv) +SV* sv; +{ + char tmpbuf[1024]; + char *d = tmpbuf; + U32 flags; + U32 type; + + if (!sv) { + fprintf(stderr, "SV = 0\n"); + return; + } + + flags = SvFLAGS(sv); + type = SvTYPE(sv); + + sprintf(d, "(0x%lx)\n REFCNT = %ld\n FLAGS = (", + (unsigned long)SvANY(sv), (long)SvREFCNT(sv)); + d += strlen(d); + if (flags & SVs_PADBUSY) strcat(d, "PADBUSY,"); + if (flags & SVs_PADTMP) strcat(d, "PADTMP,"); + if (flags & SVs_PADMY) strcat(d, "PADMY,"); + if (flags & SVs_TEMP) strcat(d, "TEMP,"); + if (flags & SVs_OBJECT) strcat(d, "OBJECT,"); + if (flags & SVs_GMG) strcat(d, "GMG,"); + if (flags & SVs_SMG) strcat(d, "SMG,"); + if (flags & SVs_RMG) strcat(d, "RMG,"); + d += strlen(d); + + if (flags & SVf_IOK) strcat(d, "IOK,"); + if (flags & SVf_NOK) strcat(d, "NOK,"); + if (flags & SVf_POK) strcat(d, "POK,"); + if (flags & SVf_ROK) strcat(d, "ROK,"); + if (flags & SVf_OK) strcat(d, "OK,"); + if (flags & SVf_OOK) strcat(d, "OOK,"); + if (flags & SVf_READONLY) strcat(d, "READONLY,"); + d += strlen(d); + + if (flags & SVp_IOK) strcat(d, "pIOK,"); + if (flags & SVp_NOK) strcat(d, "pNOK,"); + if (flags & SVp_POK) strcat(d, "pPOK,"); + if (flags & SVp_SCREAM) strcat(d, "SCREAM,"); + d += strlen(d); + if (d[-1] == ',') + d--; + *d++ = ')'; + *d = '\0'; + + fprintf(stderr, "SV = "); + switch (type) { + case SVt_NULL: + fprintf(stderr,"NULL%s\n", tmpbuf); + return; + case SVt_IV: + fprintf(stderr,"IV%s\n", tmpbuf); + break; + case SVt_NV: + fprintf(stderr,"NV%s\n", tmpbuf); + break; + case SVt_RV: + fprintf(stderr,"RV%s\n", tmpbuf); + break; + case SVt_PV: + fprintf(stderr,"PV%s\n", tmpbuf); + break; + case SVt_PVIV: + fprintf(stderr,"PVIV%s\n", tmpbuf); + break; + case SVt_PVNV: + fprintf(stderr,"PVNV%s\n", tmpbuf); + break; + case SVt_PVBM: + fprintf(stderr,"PVBM%s\n", tmpbuf); + break; + case SVt_PVMG: + fprintf(stderr,"PVMG%s\n", tmpbuf); + break; + case SVt_PVLV: + fprintf(stderr,"PVLV%s\n", tmpbuf); + break; + case SVt_PVAV: + fprintf(stderr,"PVAV%s\n", tmpbuf); + break; + case SVt_PVHV: + fprintf(stderr,"PVHV%s\n", tmpbuf); + break; + case SVt_PVCV: + fprintf(stderr,"PVCV%s\n", tmpbuf); + break; + case SVt_PVGV: + fprintf(stderr,"PVGV%s\n", tmpbuf); + break; + case SVt_PVFM: + fprintf(stderr,"PVFM%s\n", tmpbuf); + break; + case SVt_PVIO: + fprintf(stderr,"PVIO%s\n", tmpbuf); + break; + default: + fprintf(stderr,"UNKNOWN%s\n", tmpbuf); + return; + } + if (type >= SVt_PVIV || type == SVt_IV) + fprintf(stderr, " IV = %ld\n", (long)SvIVX(sv)); + if (type >= SVt_PVNV || type == SVt_NV) + fprintf(stderr, " NV = %.20g\n", SvNVX(sv)); + if (SvROK(sv)) { + fprintf(stderr, " RV = 0x%lx\n", SvRV(sv)); + sv_dump(SvRV(sv)); + return; + } + if (type < SVt_PV) + return; + if (type <= SVt_PVLV) { + if (SvPVX(sv)) + fprintf(stderr, " PV = 0x%lx \"%s\"\n CUR = %ld\n LEN = %ld\n", + SvPVX(sv), SvPVX(sv), (long)SvCUR(sv), (long)SvLEN(sv)); + else + fprintf(stderr, " PV = 0\n"); + } + if (type >= SVt_PVMG) { + if (SvMAGIC(sv)) { + fprintf(stderr, " MAGIC = 0x%lx\n", SvMAGIC(sv)); + } + if (SvSTASH(sv)) + fprintf(stderr, " STASH = %s\n", HvNAME(SvSTASH(sv))); + } + switch (type) { + case SVt_PVLV: + fprintf(stderr, " TYPE = %c\n", LvTYPE(sv)); + fprintf(stderr, " TARGOFF = %ld\n", (long)LvTARGOFF(sv)); + fprintf(stderr, " TARGLEN = %ld\n", (long)LvTARGLEN(sv)); + fprintf(stderr, " TARG = 0x%lx\n", LvTARG(sv)); + sv_dump(LvTARG(sv)); + break; + case SVt_PVAV: + fprintf(stderr, " ARRAY = 0x%lx\n", AvARRAY(sv)); + fprintf(stderr, " ALLOC = 0x%lx\n", AvALLOC(sv)); + fprintf(stderr, " FILL = %ld\n", (long)AvFILL(sv)); + fprintf(stderr, " MAX = %ld\n", (long)AvMAX(sv)); + fprintf(stderr, " ARYLEN = 0x%lx\n", AvARYLEN(sv)); + if (AvREAL(sv)) + fprintf(stderr, " FLAGS = (REAL)\n"); + else + fprintf(stderr, " FLAGS = ()\n"); + break; + case SVt_PVHV: + fprintf(stderr, " ARRAY = 0x%lx\n", HvARRAY(sv)); + fprintf(stderr, " KEYS = %ld\n", (long)HvKEYS(sv)); + fprintf(stderr, " FILL = %ld\n", (long)HvFILL(sv)); + fprintf(stderr, " MAX = %ld\n", (long)HvMAX(sv)); + fprintf(stderr, " RITER = %ld\n", (long)HvRITER(sv)); + fprintf(stderr, " EITER = 0x%lx\n", HvEITER(sv)); + if (HvPMROOT(sv)) + fprintf(stderr, " PMROOT = 0x%lx\n", HvPMROOT(sv)); + if (HvNAME(sv)) + fprintf(stderr, " NAME = \"%s\"\n", HvNAME(sv)); + break; + case SVt_PVFM: + case SVt_PVCV: + fprintf(stderr, " STASH = 0x%lx\n", CvSTASH(sv)); + fprintf(stderr, " START = 0x%lx\n", CvSTART(sv)); + fprintf(stderr, " ROOT = 0x%lx\n", CvROOT(sv)); + fprintf(stderr, " USERSUB = 0x%lx\n", CvUSERSUB(sv)); + fprintf(stderr, " USERINDEX = %ld\n", (long)CvUSERINDEX(sv)); + fprintf(stderr, " FILEGV = 0x%lx\n", CvFILEGV(sv)); + fprintf(stderr, " DEPTH = %ld\n", (long)CvDEPTH(sv)); + fprintf(stderr, " PADLIST = 0x%lx\n", CvPADLIST(sv)); + fprintf(stderr, " DELETED = %ld\n", (long)CvDELETED(sv)); + if (type == SVt_PVFM) + fprintf(stderr, " LINES = %ld\n", (long)FmLINES(sv)); + break; + case SVt_PVGV: + fprintf(stderr, " NAME = %s\n", GvNAME(sv)); + fprintf(stderr, " NAMELEN = %ld\n", (long)GvNAMELEN(sv)); + fprintf(stderr, " STASH = 0x%lx\n", GvSTASH(sv)); + fprintf(stderr, " GP = 0x%lx\n", GvGP(sv)); + fprintf(stderr, " SV = 0x%lx\n", GvSV(sv)); + fprintf(stderr, " REFCNT = %ld\n", (long)GvREFCNT(sv)); + fprintf(stderr, " IO = 0x%lx\n", GvIO(sv)); + fprintf(stderr, " FORM = 0x%lx\n", GvFORM(sv)); + fprintf(stderr, " AV = 0x%lx\n", GvAV(sv)); + fprintf(stderr, " HV = 0x%lx\n", GvHV(sv)); + fprintf(stderr, " CV = 0x%lx\n", GvCV(sv)); + fprintf(stderr, " CVGEN = 0x%lx\n", GvCVGEN(sv)); + fprintf(stderr, " LASTEXPR = %ld\n", (long)GvLASTEXPR(sv)); + fprintf(stderr, " LINE = %ld\n", (long)GvLINE(sv)); + fprintf(stderr, " FLAGS = 0x%x\n", (int)GvFLAGS(sv)); + fprintf(stderr, " STASH = 0x%lx\n", GvSTASH(sv)); + fprintf(stderr, " EGV = 0x%lx\n", GvEGV(sv)); + break; + case SVt_PVIO: + fprintf(stderr, " IFP = 0x%lx\n", IoIFP(sv)); + fprintf(stderr, " OFP = 0x%lx\n", IoOFP(sv)); + fprintf(stderr, " DIRP = 0x%lx\n", IoDIRP(sv)); + fprintf(stderr, " LINES = %ld\n", (long)IoLINES(sv)); + fprintf(stderr, " PAGE = %ld\n", (long)IoPAGE(sv)); + fprintf(stderr, " PAGE_LEN = %ld\n", (long)IoPAGE_LEN(sv)); + fprintf(stderr, " LINES_LEFT = %ld\n", (long)IoLINES_LEFT(sv)); + fprintf(stderr, " TOP_NAME = %s\n", IoTOP_NAME(sv)); + fprintf(stderr, " TOP_GV = 0x%lx\n", IoTOP_GV(sv)); + fprintf(stderr, " FMT_NAME = %s\n", IoFMT_NAME(sv)); + fprintf(stderr, " FMT_GV = 0x%lx\n", IoFMT_GV(sv)); + fprintf(stderr, " BOTTOM_NAME = %s\n", IoBOTTOM_NAME(sv)); + fprintf(stderr, " BOTTOM_GV = 0x%lx\n", IoBOTTOM_GV(sv)); + fprintf(stderr, " SUBPROCESS = %ld\n", (long)IoSUBPROCESS(sv)); + fprintf(stderr, " TYPE = %c\n", IoTYPE(sv)); + fprintf(stderr, " FLAGS = 0x%lx\n", IoFLAGS(sv)); + break; + } +} +#endif diff --git a/sv.h b/sv.h index 5ebb337..ed8acaa 100644 --- a/sv.h +++ b/sv.h @@ -36,109 +36,106 @@ typedef enum { SVt_PVIV, SVt_PVNV, SVt_PVMG, + SVt_PVBM, SVt_PVLV, SVt_PVAV, SVt_PVHV, SVt_PVCV, SVt_PVGV, - SVt_PVBM, SVt_PVFM, + SVt_PVIO, } svtype; -/* Compensate for ANSI C misdesign... */ -#ifdef DEBUGGING -#define SVTYPE svtype -#else -#define SVTYPE U8 -#endif - /* Using C's structural equivalence to help emulate C++ inheritance here... */ struct sv { void* sv_any; /* pointer to something */ U32 sv_refcnt; /* how many references to us */ - SVTYPE sv_type; /* what sort of thing pointer points to */ - U8 sv_flags; /* extra flags, some depending on type */ - U8 sv_storage; /* storage class */ - U8 sv_private; /* extra value, depending on type */ + U32 sv_flags; /* what we are */ }; struct gv { XPVGV* sv_any; /* pointer to something */ U32 sv_refcnt; /* how many references to us */ - SVTYPE sv_type; /* what sort of thing pointer points to */ - U8 sv_flags; /* extra flags, some depending on type */ - U8 sv_storage; /* storage class */ - U8 sv_private; /* extra value, depending on type */ + U32 sv_flags; /* what we are */ }; struct cv { XPVGV* sv_any; /* pointer to something */ U32 sv_refcnt; /* how many references to us */ - SVTYPE sv_type; /* what sort of thing pointer points to */ - U8 sv_flags; /* extra flags, some depending on type */ - U8 sv_storage; /* storage class */ - U8 sv_private; /* extra value, depending on type */ + U32 sv_flags; /* what we are */ }; struct av { XPVAV* sv_any; /* pointer to something */ U32 sv_refcnt; /* how many references to us */ - SVTYPE sv_type; /* what sort of thing pointer points to */ - U8 sv_flags; /* extra flags, some depending on type */ - U8 sv_storage; /* storage class */ - U8 sv_private; /* extra value, depending on type */ + U32 sv_flags; /* what we are */ }; struct hv { XPVHV* sv_any; /* pointer to something */ U32 sv_refcnt; /* how many references to us */ - SVTYPE sv_type; /* what sort of thing pointer points to */ - U8 sv_flags; /* extra flags, some depending on type */ - U8 sv_storage; /* storage class */ - U8 sv_private; /* extra value, depending on type */ + U32 sv_flags; /* what we are */ +}; + +struct io { + XPVIO* sv_any; /* pointer to something */ + U32 sv_refcnt; /* how many references to us */ + U32 sv_flags; /* what we are */ }; #define SvANY(sv) (sv)->sv_any -#define SvTYPE(sv) (sv)->sv_type -#define SvREFCNT(sv) (sv)->sv_refcnt #define SvFLAGS(sv) (sv)->sv_flags -#define SvSTORAGE(sv) (sv)->sv_storage -#define SvPRIVATE(sv) (sv)->sv_private + +#define SvREFCNT(sv) (sv)->sv_refcnt +#ifdef CRIPPLED_CC +#define SvREFCNT_inc(sv) sv_newref(sv) +#define SvREFCNT_dec(sv) sv_free(sv) +#else +#define SvREFCNT_inc(sv) ((Sv = (SV*)(sv)), \ + (Sv && ++SvREFCNT(Sv)), (SV*)Sv) +#define SvREFCNT_dec(sv) sv_free(sv) +#endif + +#define SVTYPEMASK 0xff +#define SvTYPE(sv) ((sv)->sv_flags & SVTYPEMASK) #define SvUPGRADE(sv, mt) (SvTYPE(sv) >= mt || sv_upgrade(sv, mt)) -#define SVf_IOK 1 /* has valid integer value */ -#define SVf_NOK 2 /* has valid numeric value */ -#define SVf_POK 4 /* has valid pointer value */ -#define SVf_OOK 8 /* has valid offset value */ -#define SVf_ROK 16 /* has a valid reference pointer */ -#define SVf_OK 32 /* has defined value */ -#define SVf_MAGICAL 64 /* has special methods */ -#define SVf_THINKFIRST 128 /* may not be changed without thought */ - -#define SVs_PADBUSY 1 /* reserved for tmp or my already */ -#define SVs_PADTMP 2 /* in use as tmp */ -#define SVs_PADMY 4 /* in use a "my" variable */ -#define SVs_8 8 -#define SVs_16 16 -#define SVs_TEMP 32 /* string is stealable? */ -#define SVs_OBJECT 64 /* is "blessed" */ -#define SVs_READONLY 128 /* may not be modified */ - -#define SVp_IOK 1 /* has valid non-public integer value */ -#define SVp_NOK 2 /* has valid non-public numeric value */ -#define SVp_POK 4 /* has valid non-public pointer value */ -#define SVp_SCREAM 8 /* has been studied? */ -#define SVp_TAINTEDDIR 16 /* PATH component is a security risk */ - -#define SVpfm_COMPILED 128 - -#define SVpbm_VALID 128 -#define SVpbm_CASEFOLD 64 -#define SVpbm_TAIL 32 - -#define SVpgv_MULTI 128 +#define SVs_PADBUSY 0x00000100 /* reserved for tmp or my already */ +#define SVs_PADTMP 0x00000200 /* in use as tmp */ +#define SVs_PADMY 0x00000400 /* in use a "my" variable */ +#define SVs_TEMP 0x00000800 /* string is stealable? */ +#define SVs_OBJECT 0x00001000 /* is "blessed" */ +#define SVs_GMG 0x00002000 /* has magical get method */ +#define SVs_SMG 0x00004000 /* has magical set method */ +#define SVs_RMG 0x00008000 /* has random magical methods */ + +#define SVf_IOK 0x00010000 /* has valid public integer value */ +#define SVf_NOK 0x00020000 /* has valid public numeric value */ +#define SVf_POK 0x00040000 /* has valid public pointer value */ +#define SVf_ROK 0x00080000 /* has a valid reference pointer */ +#define SVf_OK 0x00100000 /* has defined value */ +#define SVf_OOK 0x00200000 /* has valid offset value */ +#define SVf_BREAK 0x00400000 /* refcnt is artificially low */ +#define SVf_READONLY 0x00800000 /* may not be modified */ + +#define SVp_IOK 0x01000000 /* has valid non-public integer value */ +#define SVp_NOK 0x02000000 /* has valid non-public numeric value */ +#define SVp_POK 0x04000000 /* has valid non-public pointer value */ +#define SVp_SCREAM 0x08000000 /* has been studied? */ + +#define PRIVSHIFT 8 + +/* Some private flags. */ + +#define SVpfm_COMPILED 0x80000000 + +#define SVpbm_VALID 0x80000000 +#define SVpbm_CASEFOLD 0x40000000 +#define SVpbm_TAIL 0x20000000 + +#define SVpgv_MULTI 0x80000000 struct xrv { SV * xrv_rv; /* pointer to another SV */ @@ -183,6 +180,7 @@ struct xpvlv { double xnv_nv; /* numeric value, if any */ MAGIC* xmg_magic; /* linked list of magicalness */ HV* xmg_stash; /* class package */ + STRLEN xlv_targoff; STRLEN xlv_targlen; SV* xlv_targ; @@ -197,6 +195,7 @@ struct xpvgv { double xnv_nv; /* numeric value, if any */ MAGIC* xmg_magic; /* linked list of magicalness */ HV* xmg_stash; /* class package */ + GP* xgv_gp; char* xgv_name; STRLEN xgv_namelen; @@ -211,6 +210,7 @@ struct xpvbm { double xnv_nv; /* numeric value, if any */ MAGIC* xmg_magic; /* linked list of magicalness */ HV* xmg_stash; /* class package */ + I32 xbm_useful; /* is this constant pattern being useful? */ U16 xbm_previous; /* how many characters in string before rare? */ U8 xbm_rare; /* rarest character in string */ @@ -224,6 +224,7 @@ struct xpvfm { double xnv_nv; /* numeric value, if any */ MAGIC* xmg_magic; /* linked list of magicalness */ HV* xmg_stash; /* class package */ + HV * xcv_stash; OP * xcv_start; OP * xcv_root; @@ -236,6 +237,37 @@ struct xpvfm { I32 xfm_lines; }; +struct xpvio { + char * xpv_pv; /* pointer to malloced string */ + STRLEN xpv_cur; /* length of xpv_pv as a C string */ + STRLEN xpv_len; /* allocated size */ + I32 xiv_iv; /* integer value or pv offset */ + double xnv_nv; /* numeric value, if any */ + MAGIC* xmg_magic; /* linked list of magicalness */ + HV* xmg_stash; /* class package */ + + FILE * xio_ifp; /* ifp and ofp are normally the same */ + FILE * xio_ofp; /* but sockets need separate streams */ + DIR * xio_dirp; /* for opendir, readdir, etc */ + long xio_lines; /* $. */ + long xio_page; /* $% */ + long xio_page_len; /* $= */ + long xio_lines_left; /* $- */ + char * xio_top_name; /* $^ */ + GV * xio_top_gv; /* $^ */ + char * xio_fmt_name; /* $~ */ + GV * xio_fmt_gv; /* $~ */ + char * xio_bottom_name;/* $^B */ + GV * xio_bottom_gv; /* $^B */ + short xio_subprocess; /* -| or |- */ + char xio_type; + char xio_flags; +}; + +#define IOf_ARGV 1 /* this fp iterates over ARGV */ +#define IOf_START 2 /* check for null ARGV and substitute '-' */ +#define IOf_FLUSH 4 /* this fp wants a flush after write op */ + /* The following macros define implementation-independent predicates on SVs. */ #define SvNIOK(sv) (SvFLAGS(sv) & (SVf_IOK|SVf_NOK)) @@ -243,93 +275,107 @@ struct xpvfm { #define SvOK(sv) (SvFLAGS(sv) & SVf_OK) #define SvOK_on(sv) (SvFLAGS(sv) |= SVf_OK) #define SvOK_off(sv) (SvFLAGS(sv) &= \ - ~(SVf_IOK|SVf_NOK|SVf_POK|SVf_OK), \ + ~(SVf_IOK|SVf_NOK|SVf_POK|SVf_OK| \ + SVp_IOK|SVp_NOK|SVp_POK|SVf_ROK),\ SvOOK_off(sv)) -#define SvOKp(sv) (SvPRIVATE(sv) & (SVp_IOK|SVp_NOK|SVp_POK)) -#define SvIOKp(sv) (SvPRIVATE(sv) & SVp_IOK) -#define SvIOKp_on(sv) (SvOOK_off(sv), SvPRIVATE(sv) |= SVp_IOK) -#define SvNOKp(sv) (SvPRIVATE(sv) & SVp_NOK) -#define SvNOKp_on(sv) (SvPRIVATE(sv) |= SVp_NOK) -#define SvPOKp(sv) (SvPRIVATE(sv) & SVp_POK) -#define SvPOKp_on(sv) (SvPRIVATE(sv) |= SVp_POK) +#define SvOKp(sv) (SvFLAGS(sv) & (SVp_IOK|SVp_NOK|SVp_POK)) +#define SvIOKp(sv) (SvFLAGS(sv) & SVp_IOK) +#define SvIOKp_on(sv) (SvOOK_off(sv), SvFLAGS(sv) |= SVp_IOK) +#define SvNOKp(sv) (SvFLAGS(sv) & SVp_NOK) +#define SvNOKp_on(sv) (SvFLAGS(sv) |= SVp_NOK) +#define SvPOKp(sv) (SvFLAGS(sv) & SVp_POK) +#define SvPOKp_on(sv) (SvFLAGS(sv) |= SVp_POK) #define SvIOK(sv) (SvFLAGS(sv) & SVf_IOK) -#define SvIOK_on(sv) (SvOOK_off(sv), SvFLAGS(sv) |= (SVf_IOK|SVf_OK)) -#define SvIOK_off(sv) (SvFLAGS(sv) &= ~SVf_IOK) -#define SvIOK_only(sv) (SvOK_off(sv), SvFLAGS(sv) |= (SVf_IOK|SVf_OK)) +#define SvIOK_on(sv) (SvOOK_off(sv), \ + SvFLAGS(sv) |= (SVf_IOK|SVp_IOK|SVf_OK)) +#define SvIOK_off(sv) (SvFLAGS(sv) &= ~(SVf_IOK|SVp_IOK)) +#define SvIOK_only(sv) (SvOK_off(sv), \ + SvFLAGS(sv) |= (SVf_IOK|SVp_IOK|SVf_OK)) #define SvNOK(sv) (SvFLAGS(sv) & SVf_NOK) -#define SvNOK_on(sv) (SvFLAGS(sv) |= (SVf_NOK|SVf_OK)) -#define SvNOK_off(sv) (SvFLAGS(sv) &= ~SVf_NOK) -#define SvNOK_only(sv) (SvOK_off(sv), SvFLAGS(sv) |= (SVf_NOK|SVf_OK)) +#define SvNOK_on(sv) (SvFLAGS(sv) |= (SVf_NOK|SVp_NOK|SVf_OK)) +#define SvNOK_off(sv) (SvFLAGS(sv) &= ~(SVf_NOK|SVp_NOK)) +#define SvNOK_only(sv) (SvOK_off(sv), \ + SvFLAGS(sv) |= (SVf_NOK|SVp_NOK|SVf_OK)) #define SvPOK(sv) (SvFLAGS(sv) & SVf_POK) -#define SvPOK_on(sv) (SvFLAGS(sv) |= (SVf_POK|SVf_OK)) -#define SvPOK_off(sv) (SvFLAGS(sv) &= ~SVf_POK) -#define SvPOK_only(sv) (SvOK_off(sv), SvFLAGS(sv) |= (SVf_POK|SVf_OK)) +#define SvPOK_on(sv) (SvFLAGS(sv) |= (SVf_POK|SVp_POK|SVf_OK)) +#define SvPOK_off(sv) (SvFLAGS(sv) &= ~(SVf_POK|SVp_POK)) +#define SvPOK_only(sv) (SvOK_off(sv), \ + SvFLAGS(sv) |= (SVf_POK|SVp_POK|SVf_OK)) #define SvOOK(sv) (SvFLAGS(sv) & SVf_OOK) #define SvOOK_on(sv) (SvIOK_off(sv), SvFLAGS(sv) |= SVf_OOK) #define SvOOK_off(sv) (SvOOK(sv) && sv_backoff(sv)) #define SvROK(sv) (SvFLAGS(sv) & SVf_ROK) -#define SvROK_on(sv) (SvFLAGS(sv) |= SVf_ROK|SVf_THINKFIRST|SVf_OK) +#define SvROK_on(sv) (SvFLAGS(sv) |= SVf_ROK|SVf_OK) #define SvROK_off(sv) (SvFLAGS(sv) &= ~SVf_ROK) -#define SvMAGICAL(sv) (SvFLAGS(sv) & SVf_MAGICAL) -#define SvMAGICAL_on(sv) (SvFLAGS(sv) |= SVf_MAGICAL) -#define SvMAGICAL_off(sv) (SvFLAGS(sv) &= ~SVf_MAGICAL) +#define SvMAGICAL(sv) (SvFLAGS(sv) & (SVs_GMG|SVs_SMG|SVs_RMG)) +#define SvMAGICAL_on(sv) (SvFLAGS(sv) |= (SVs_GMG|SVs_SMG|SVs_RMG)) +#define SvMAGICAL_off(sv) (SvFLAGS(sv) &= ~(SVs_GMG|SVs_SMG|SVs_RMG)) -#define SvTHINKFIRST(sv) (SvFLAGS(sv) & SVf_THINKFIRST) -#define SvTHINKFIRST_on(sv) (SvFLAGS(sv) |= SVf_THINKFIRST) -#define SvTHINKFIRST_off(sv) (SvFLAGS(sv) &= ~SVf_THINKFIRST) +#define SvGMAGICAL(sv) (SvFLAGS(sv) & SVs_GMG) +#define SvGMAGICAL_on(sv) (SvFLAGS(sv) |= SVs_GMG) +#define SvGMAGICAL_off(sv) (SvFLAGS(sv) &= ~SVs_GMG) -#define SvPADBUSY(sv) (SvSTORAGE(sv) & SVs_PADBUSY) +#define SvSMAGICAL(sv) (SvFLAGS(sv) & SVs_SMG) +#define SvSMAGICAL_on(sv) (SvFLAGS(sv) |= SVs_SMG) +#define SvSMAGICAL_off(sv) (SvFLAGS(sv) &= ~SVs_SMG) -#define SvPADTMP(sv) (SvSTORAGE(sv) & SVs_PADTMP) -#define SvPADTMP_on(sv) (SvSTORAGE(sv) |= SVs_PADTMP|SVs_PADBUSY) -#define SvPADTMP_off(sv) (SvSTORAGE(sv) &= ~SVs_PADTMP) +#define SvRMAGICAL(sv) (SvFLAGS(sv) & SVs_RMG) +#define SvRMAGICAL_on(sv) (SvFLAGS(sv) |= SVs_RMG) +#define SvRMAGICAL_off(sv) (SvFLAGS(sv) &= ~SVs_RMG) -#define SvPADMY(sv) (SvSTORAGE(sv) & SVs_PADMY) -#define SvPADMY_on(sv) (SvSTORAGE(sv) |= SVs_PADMY|SVs_PADBUSY) +#define SvTHINKFIRST(sv) (SvFLAGS(sv) & (SVf_ROK|SVf_READONLY)) -#define SvTEMP(sv) (SvSTORAGE(sv) & SVs_TEMP) -#define SvTEMP_on(sv) (SvSTORAGE(sv) |= SVs_TEMP) -#define SvTEMP_off(sv) (SvSTORAGE(sv) &= ~SVs_TEMP) +#define SvPADBUSY(sv) (SvFLAGS(sv) & SVs_PADBUSY) -#define SvOBJECT(sv) (SvSTORAGE(sv) & SVs_OBJECT) -#define SvOBJECT_on(sv) (SvSTORAGE(sv) |= SVs_OBJECT) -#define SvOBJECT_off(sv) (SvSTORAGE(sv) &= ~SVs_OBJECT) +#define SvPADTMP(sv) (SvFLAGS(sv) & SVs_PADTMP) +#define SvPADTMP_on(sv) (SvFLAGS(sv) |= SVs_PADTMP|SVs_PADBUSY) +#define SvPADTMP_off(sv) (SvFLAGS(sv) &= ~SVs_PADTMP) -#define SvREADONLY(sv) (SvSTORAGE(sv) & SVs_READONLY) -#define SvREADONLY_on(sv) (SvSTORAGE(sv) |= SVs_READONLY, \ - SvTHINKFIRST_on(sv)) -#define SvREADONLY_off(sv) (SvSTORAGE(sv) &= ~SVs_READONLY) +#define SvPADMY(sv) (SvFLAGS(sv) & SVs_PADMY) +#define SvPADMY_on(sv) (SvFLAGS(sv) |= SVs_PADMY|SVs_PADBUSY) -#define SvSCREAM(sv) (SvPRIVATE(sv) & SVp_SCREAM) -#define SvSCREAM_on(sv) (SvPRIVATE(sv) |= SVp_SCREAM) -#define SvSCREAM_off(sv) (SvPRIVATE(sv) &= ~SVp_SCREAM) +#define SvTEMP(sv) (SvFLAGS(sv) & SVs_TEMP) +#define SvTEMP_on(sv) (SvFLAGS(sv) |= SVs_TEMP) +#define SvTEMP_off(sv) (SvFLAGS(sv) &= ~SVs_TEMP) -#define SvCOMPILED(sv) (SvPRIVATE(sv) & SVpfm_COMPILED) -#define SvCOMPILED_on(sv) (SvPRIVATE(sv) |= SVpfm_COMPILED) -#define SvCOMPILED_off(sv) (SvPRIVATE(sv) &= ~SVpfm_COMPILED) +#define SvOBJECT(sv) (SvFLAGS(sv) & SVs_OBJECT) +#define SvOBJECT_on(sv) (SvFLAGS(sv) |= SVs_OBJECT) +#define SvOBJECT_off(sv) (SvFLAGS(sv) &= ~SVs_OBJECT) -#define SvTAIL(sv) (SvPRIVATE(sv) & SVpbm_TAIL) -#define SvTAIL_on(sv) (SvPRIVATE(sv) |= SVpbm_TAIL) -#define SvTAIL_off(sv) (SvPRIVATE(sv) &= ~SVpbm_TAIL) +#define SvREADONLY(sv) (SvFLAGS(sv) & SVf_READONLY) +#define SvREADONLY_on(sv) (SvFLAGS(sv) |= SVf_READONLY) +#define SvREADONLY_off(sv) (SvFLAGS(sv) &= ~SVf_READONLY) -#define SvCASEFOLD(sv) (SvPRIVATE(sv) & SVpbm_CASEFOLD) -#define SvCASEFOLD_on(sv) (SvPRIVATE(sv) |= SVpbm_CASEFOLD) -#define SvCASEFOLD_off(sv) (SvPRIVATE(sv) &= ~SVpbm_CASEFOLD) +#define SvSCREAM(sv) (SvFLAGS(sv) & SVp_SCREAM) +#define SvSCREAM_on(sv) (SvFLAGS(sv) |= SVp_SCREAM) +#define SvSCREAM_off(sv) (SvFLAGS(sv) &= ~SVp_SCREAM) -#define SvVALID(sv) (SvPRIVATE(sv) & SVpbm_VALID) -#define SvVALID_on(sv) (SvPRIVATE(sv) |= SVpbm_VALID) -#define SvVALID_off(sv) (SvPRIVATE(sv) &= ~SVpbm_VALID) +#define SvCOMPILED(sv) (SvFLAGS(sv) & SVpfm_COMPILED) +#define SvCOMPILED_on(sv) (SvFLAGS(sv) |= SVpfm_COMPILED) +#define SvCOMPILED_off(sv) (SvFLAGS(sv) &= ~SVpfm_COMPILED) -#define SvMULTI(sv) (SvPRIVATE(sv) & SVpgv_MULTI) -#define SvMULTI_on(sv) (SvPRIVATE(sv) |= SVpgv_MULTI) -#define SvMULTI_off(sv) (SvPRIVATE(sv) &= ~SVpgv_MULTI) +#define SvTAIL(sv) (SvFLAGS(sv) & SVpbm_TAIL) +#define SvTAIL_on(sv) (SvFLAGS(sv) |= SVpbm_TAIL) +#define SvTAIL_off(sv) (SvFLAGS(sv) &= ~SVpbm_TAIL) + +#define SvCASEFOLD(sv) (SvFLAGS(sv) & SVpbm_CASEFOLD) +#define SvCASEFOLD_on(sv) (SvFLAGS(sv) |= SVpbm_CASEFOLD) +#define SvCASEFOLD_off(sv) (SvFLAGS(sv) &= ~SVpbm_CASEFOLD) + +#define SvVALID(sv) (SvFLAGS(sv) & SVpbm_VALID) +#define SvVALID_on(sv) (SvFLAGS(sv) |= SVpbm_VALID) +#define SvVALID_off(sv) (SvFLAGS(sv) &= ~SVpbm_VALID) + +#define SvMULTI(sv) (SvFLAGS(sv) & SVpgv_MULTI) +#define SvMULTI_on(sv) (SvFLAGS(sv) |= SVpgv_MULTI) +#define SvMULTI_off(sv) (SvFLAGS(sv) &= ~SVpgv_MULTI) #define SvRV(sv) ((XRV*) SvANY(sv))->xrv_rv #define SvRVx(sv) SvRV(sv) @@ -344,7 +390,7 @@ struct xpvfm { #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) ((Sv = (sv)), SvEND(Sv)) #define SvMAGIC(sv) ((XPVMG*) SvANY(sv))->xmg_magic #define SvSTASH(sv) ((XPVMG*) SvANY(sv))->xmg_stash @@ -380,6 +426,23 @@ struct xpvfm { #define LvTARGOFF(sv) ((XPVLV*) SvANY(sv))->xlv_targoff #define LvTARGLEN(sv) ((XPVLV*) SvANY(sv))->xlv_targlen +#define IoIFP(sv) ((XPVIO*) SvANY(sv))->xio_ifp +#define IoOFP(sv) ((XPVIO*) SvANY(sv))->xio_ofp +#define IoDIRP(sv) ((XPVIO*) SvANY(sv))->xio_dirp +#define IoLINES(sv) ((XPVIO*) SvANY(sv))->xio_lines +#define IoPAGE(sv) ((XPVIO*) SvANY(sv))->xio_page +#define IoPAGE_LEN(sv) ((XPVIO*) SvANY(sv))->xio_page_len +#define IoLINES_LEFT(sv)((XPVIO*) SvANY(sv))->xio_lines_left +#define IoTOP_NAME(sv) ((XPVIO*) SvANY(sv))->xio_top_name +#define IoTOP_GV(sv) ((XPVIO*) SvANY(sv))->xio_top_gv +#define IoFMT_NAME(sv) ((XPVIO*) SvANY(sv))->xio_fmt_name +#define IoFMT_GV(sv) ((XPVIO*) SvANY(sv))->xio_fmt_gv +#define IoBOTTOM_NAME(sv)((XPVIO*) SvANY(sv))->xio_bottom_name +#define IoBOTTOM_GV(sv) ((XPVIO*) SvANY(sv))->xio_bottom_gv +#define IoSUBPROCESS(sv)((XPVIO*) SvANY(sv))->xio_subprocess +#define IoTYPE(sv) ((XPVIO*) SvANY(sv))->xio_type +#define IoFLAGS(sv) ((XPVIO*) SvANY(sv))->xio_flags + #define SvTAINT(sv) if (tainting && tainted) sv_magic(sv, 0, 't', 0, 0) #ifdef CRIPPLED_CC @@ -404,7 +467,9 @@ I32 SvTRUE(); #define SvPV(sv, lp) (SvPOK(sv) ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pv(sv, &lp)) #define SvTRUE(sv) ( \ - SvPOK(sv) \ + !sv \ + ? 0 \ + : SvPOK(sv) \ ? ((Xpv = (XPV*)SvANY(sv)) && \ (*Xpv->xpv_pv > '0' || \ Xpv->xpv_cur > 1 || \ @@ -418,16 +483,16 @@ I32 SvTRUE(); ? SvNVX(sv) != 0.0 \ : sv_2bool(sv) ) -#define SvIVx(sv) ((Sv = sv), SvIV(Sv)) -#define SvNVx(sv) ((Sv = sv), SvNV(Sv)) -#define SvPVx(sv, lp) ((Sv = sv), SvPV(Sv, lp)) -#define SvTRUEx(sv) ((Sv = sv), SvTRUE(Sv)) +#define SvIVx(sv) ((Sv = (sv)), SvIV(Sv)) +#define SvNVx(sv) ((Sv = (sv)), SvNV(Sv)) +#define SvPVx(sv, lp) ((Sv = (sv)), SvPV(Sv, lp)) +#define SvTRUEx(sv) ((Sv = (sv)), SvTRUE(Sv)) #endif /* CRIPPLED_CC */ /* the following macro updates any magic values this sv is associated with */ -#define SvSETMAGIC(x) if (SvMAGICAL(x)) mg_set(x) +#define SvSETMAGIC(x) if (SvSMAGICAL(x)) mg_set(x) #define SvSetSV(dst,src) if (dst != src) sv_setsv(dst,src) @@ -435,8 +500,6 @@ I32 SvTRUE(); #define isGV(sv) (SvTYPE(sv) == SVt_PVGV) -#define GROWSTR(pp,lp,len) if (*(lp) < (len)) pv_grow(pp, lp, (len) * 3 / 2) - #ifndef DOSISH # define SvGROW(sv,len) if (SvLEN(sv) < (len)) sv_grow(sv,len) # define Sv_Grow sv_grow diff --git a/t/foo b/t/foo index ace796d..57d87eb 100755 --- a/t/foo +++ b/t/foo @@ -1,4 +1,2 @@ -#!./perl -Dst +#!./perl -$ref = [[],2,[3,4,5,]]; -print ${$$ref[2]}[2] == 5 ? "ok 16\n" : "not ok 16\n"; diff --git a/t/foo.out b/t/foo.out new file mode 100644 index 0000000..422ebf8 --- /dev/null +++ b/t/foo.out @@ -0,0 +1,36 @@ +{ +5 TYPE = block exit ===> DONE + FLAGS = (UNKNOWN,KIDS,PARENS) + { +1 TYPE = block entry ===> 2 + } + { +2 TYPE = next statement ===> 3 + FLAGS = (SCALAR) + LINE = 1 + } + { +4 TYPE = subroutine entry ===> 5 + FLAGS = (UNKNOWN,KIDS) + { + TYPE = null operation ===> (4) + WAS = subroutine reference + FLAGS = (SCALAR,KIDS) + { +3 TYPE = glob value ===> 4 + FLAGS = (SCALAR) + GV = main::foo + } + } + } +} + +SUB ODBM_File::init = (xsub 0x7efb8 0) + +SUB SDBM_File::init = (xsub 0x80318 0) + +SUB NDBM_File::init = (xsub 0x7ddf8 0) + +EXECUTING... + +- syntax OK diff --git a/t/lib/big.t b/t/lib/bigint.t similarity index 98% rename from t/lib/big.t rename to t/lib/bigint.t index 23cd00b..034c5c6 100755 --- a/t/lib/big.t +++ b/t/lib/bigint.t @@ -1,5 +1,7 @@ #!./perl -require "../lib/bigint.pl"; + +BEGIN { @INC = '../lib' } +require "bigint.pl"; $test = 0; $| = 1; diff --git a/t/lib/english.t b/t/lib/english.t new file mode 100755 index 0000000..bbc0c0c --- /dev/null +++ b/t/lib/english.t @@ -0,0 +1,41 @@ +#!./perl + +print "1..16\n"; + +BEGIN { @INC = '../lib' } +require English; import English; + +print $PID == $$ ? "ok 1\n" : "not ok 1\n"; + +$_ = 1; +print $MAGIC == $_ ? "ok 2\n" : "not ok 2\n"; + +sub foo { + print $ARG[0] == $_[0] ? "ok 3\n" : "not ok 3\n"; +} +&foo(1); + +$MAGIC = "ok 4\nok 5\nok 6\n"; +/ok 5\n/; +print $PREMATCH, $MATCH, $POSTMATCH; + +$OFS = " "; +$ORS = "\n"; +print 'ok',7; +undef $OUTPUT_FIELD_SEPARATOR; + +$LIST_SEPARATOR = "\n"; +@foo = ("ok 8", "ok 9"); +print "@foo"; +undef $OUTPUT_RECORD_SEPARATOR; + +eval 'no such function'; +print "ok 10\n" if $EVAL_ERROR =~ /method/; + +print $UID == $< ? "ok 11\n" : "not ok 11\n"; +print $GID == $( ? "ok 12\n" : "not ok 12\n"; +print $EUID == $> ? "ok 13\n" : "not ok 13\n"; +print $EGID == $) ? "ok 14\n" : "not ok 14\n"; + +print $PROGRAM_NAME == $0 ? "ok 15\n" : "not ok 15\n"; +print $BASETIME == $^T ? "ok 16\n" : "not ok 16\n"; diff --git a/t/op/dbm.t b/t/lib/sdbm.t similarity index 89% rename from t/op/dbm.t rename to t/lib/sdbm.t index a011169..79d95f3 100755 --- a/t/op/dbm.t +++ b/t/lib/sdbm.t @@ -2,26 +2,19 @@ # $RCSfile: dbm.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:43 $ -if (!-r '/usr/include/dbm.h' && !-r '/usr/include/ndbm.h' - && !-r '/usr/include/rpcsvc/dbm.h') { - print "1..0\n"; - exit; -} +BEGIN { @INC = '../lib' } +require SDBM_File; print "1..12\n"; -init SDBM_File; - -unlink ; -unlink Op.dbmx; # in case we're running gdbm +unlink ; umask(0); print (tie(%h,SDBM_File,'Op.dbmx', 0x202, 0640) ? "ok 1\n" : "not ok 1\n"); $Dfile = "Op.dbmx.pag"; if (! -e $Dfile) { - $Dfile = "Op.dbmx"; - print "# Probably a gdbm database\n"; + ($Dfile) = ; } ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime, $blksize,$blocks) = stat($Dfile); diff --git a/t/op/goto.t b/t/op/goto.t index 0b89921..21a35c1 100755 --- a/t/op/goto.t +++ b/t/op/goto.t @@ -2,7 +2,9 @@ # $RCSfile: goto.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:56 $ -print "1..5\n"; +# "This IS structured code. It's just randomly structured." + +print "1..9\n"; while ($?) { $foo = 1; @@ -43,11 +45,43 @@ bar: &foo; sub bar { - $x = 'exitcode'; - eval "goto $x"; # Do not take this as exemplary code!!! + $x = 'bypass'; + eval "goto $x"; } &bar; exit; -exitcode: + +FINALE: +print "ok 9\n"; +exit; + +bypass: print "ok 5\n"; + +# Test autoloading mechanism. + +sub two { + ($pack, $file, $line) = caller; # Should indicate original call stats. + print "@_ $pack $file $line" eq "1 2 3 main $FILE $LINE" + ? "ok 7\n" + : "not ok 7\n"; +} + +sub one { + eval <<'END'; + sub one { print "ok 6\n"; goto &two; print "not ok 6\n"; } +END + goto &one; +} + +$FILE = __FILE__; +$LINE = __LINE__ + 1; +&one(1,2,3); + +$wherever = NOWHERE; +eval { goto $wherever }; +print $@ =~ /Can't find label NOWHERE/ ? "ok 8\n" : "not ok 8\n"; + +$wherever = FINALE; +goto $wherever; diff --git a/t/op/ref.t b/t/op/ref.t index ead65b5..60bb75c 100755 --- a/t/op/ref.t +++ b/t/op/ref.t @@ -1,6 +1,6 @@ #!./perl -print "1..37\n"; +print "1..40\n"; # Test glob operations. @@ -145,9 +145,10 @@ $string = "not ok 34\n"; $object = "foo"; $string = "ok 34\n"; $main'anonhash2 = "foo"; -$string = "not ok 34\n"; +$string = ""; DESTROY { + return unless $string; print $string; # Test that the object has already been "cursed". @@ -178,3 +179,16 @@ sub BASEOBJ'doit { die "Not an OBJ" unless ref $ref eq OBJ; $ref->{shift}; } + +package FINALE; + +{ + $ref3 = bless ["ok 40\n"]; # package destruction + my $ref2 = bless ["ok 39\n"]; # lexical destruction + local $ref1 = bless ["ok 38\n"]; # dynamic destruction + 1; # flush any temp values on stack +} + +DESTROY { + print $_[0][0]; +} diff --git a/taint.c b/taint.c index 66affdd..23a1b07 100644 --- a/taint.c +++ b/taint.c @@ -42,10 +42,11 @@ taint_env() SV** svp; if (tainting) { + MAGIC *mg = 0; svp = hv_fetch(GvHVn(envgv),"PATH",4,FALSE); - if (!svp || *svp == &sv_undef || mg_find(*svp, 't')) { + if (!svp || *svp == &sv_undef || (mg = mg_find(*svp, 't'))) { tainted = 1; - if (SvPRIVATE(*svp) & SVp_TAINTEDDIR) + if (mg && MgTAINTEDDIR(mg)) taint_proper("Insecure directory in %s%s", "PATH"); else taint_proper("Insecure %s%s", "PATH"); diff --git a/toke.c b/toke.c index 9790edf..ea675e8 100644 --- a/toke.c +++ b/toke.c @@ -158,24 +158,61 @@ void checkcomma(); expect = XREF, \ bufptr = s, \ last_lop = oldbufptr, \ + last_lop_op = f, \ (*s == '(' || (s = skipspace(s), *s == '(') ? (int)FUNC : (int)LSTOP) ) /* grandfather return to old style */ #define OLDLOP(f) return(yylval.ival=f,expect = XTERM,bufptr = s,(int)LSTOP) -void -no_op(what) +static void +no_op(what, s) char *what; +char *s; { - warn("%s found where operator expected", what); + char tmpbuf[128]; + char *oldbufptr = bufptr; + bufptr = s; + sprintf(tmpbuf, "%s found where operator expected", what); + yywarn(tmpbuf); if (bufptr == SvPVX(linestr)) warn("\t(Missing semicolon on previous line?)\n", what); + bufptr = oldbufptr; +} + +static void +missingterm(s) +char *s; +{ + char tmpbuf[3]; + char q; + if (s) { + char *nl = strrchr(s,'\n'); + if (nl) + *nl = '\0'; + } + else if (multi_close < 32 || multi_close == 127) { + *tmpbuf = '^'; + tmpbuf[1] = multi_close ^ 64; + s = "\\n"; + tmpbuf[2] = '\0'; + s = tmpbuf; + } + else { + *tmpbuf = multi_close; + tmpbuf[1] = '\0'; + s = tmpbuf; + } + q = strchr(s,'"') ? '\'' : '"'; + croak("Can't find string terminator %c%s%c anywhere before EOF",q,s,q); } void -lex_start() +lex_start(line) +SV *line; { - ENTER; + char *s; + STRLEN len; + SAVEINT(lex_dojoin); SAVEINT(lex_brackets); SAVEINT(lex_fakebrack); @@ -186,44 +223,55 @@ lex_start() SAVEINT(lex_inwhat); SAVEINT(curcop->cop_line); SAVESPTR(bufptr); + SAVESPTR(bufend); SAVESPTR(oldbufptr); SAVESPTR(oldoldbufptr); SAVESPTR(linestr); SAVESPTR(lex_brackstack); + SAVESPTR(rsfp); lex_state = LEX_NORMAL; lex_defer = 0; - lex_expect = XBLOCK; + expect = XSTATE; lex_brackets = 0; lex_fakebrack = 0; if (lex_brackstack) SAVESPTR(lex_brackstack); - lex_brackstack = malloc(120); + New(899, lex_brackstack, 120, char); + SAVEFREEPV(lex_brackstack); lex_casemods = 0; lex_dojoin = 0; lex_starts = 0; if (lex_stuff) - sv_free(lex_stuff); + SvREFCNT_dec(lex_stuff); lex_stuff = Nullsv; if (lex_repl) - sv_free(lex_repl); + SvREFCNT_dec(lex_repl); lex_repl = Nullsv; lex_inpat = 0; lex_inwhat = 0; + linestr = line; + if (SvREADONLY(linestr)) + linestr = sv_2mortal(newSVsv(linestr)); + s = SvPV(linestr, len); + if (len && s[len-1] != ';') { + if (!(SvFLAGS(linestr) & SVs_TEMP)); + linestr = sv_2mortal(newSVsv(linestr)); + sv_catpvn(linestr, "\n;", 2); + } + SvTEMP_off(linestr); oldoldbufptr = oldbufptr = bufptr = SvPVX(linestr); bufend = bufptr + SvCUR(linestr); rs = "\n"; rslen = 1; rschar = '\n'; rspara = 0; + rsfp = 0; } void lex_end() { - free(lex_brackstack); - lex_brackstack = 0; - LEAVE; } static void @@ -267,7 +315,7 @@ char *s; curcop->cop_line = atoi(n)-1; } -char * +static char * skipspace(s) register char *s; { @@ -288,17 +336,32 @@ register char *s; if (s < bufend || !rsfp) return s; if ((s = sv_gets(linestr, rsfp, 0)) == Nullch) { - sv_setpv(linestr,""); - bufend = oldoldbufptr = oldbufptr = bufptr = s = SvPVX(linestr); + sv_setpv(linestr,";"); + oldoldbufptr = oldbufptr = bufptr = s = SvPVX(linestr); + bufend = s+1; + if (preprocess) + (void)my_pclose(rsfp); + else if ((FILE*)rsfp == stdin) + clearerr(stdin); + else + (void)fclose(rsfp); + rsfp = Nullfp; return s; } oldoldbufptr = oldbufptr = bufptr = s; bufend = bufptr + SvCUR(linestr); + if (perldb && curstash != debstash) { + SV *sv = NEWSV(85,0); + + sv_upgrade(sv, SVt_PVMG); + sv_setsv(sv,linestr); + av_store(GvAV(curcop->cop_filegv),(I32)curcop->cop_line,sv); + } incline(s); } } -void +static void check_uni() { char *s; char ch; @@ -321,7 +384,7 @@ check_uni() { #define UNI(f) return uni(f,s) #define LOP(f) return lop(f,s) -int +static int uni(f,s) I32 f; char *s; @@ -339,7 +402,7 @@ char *s; return UNIOP; } -I32 +static I32 lop(f,s) I32 f; char *s; @@ -348,7 +411,8 @@ char *s; CLINE; expect = XREF; bufptr = s; - last_uni = oldbufptr; + last_lop = oldbufptr; + last_lop_op = f; if (*s == '(') return FUNC; s = skipspace(s); @@ -360,7 +424,7 @@ char *s; #endif /* CRIPPLED_CC */ -void +static void force_next(type) I32 type; { @@ -373,7 +437,7 @@ I32 type; } } -char * +static char * force_word(start,token,check_keyword,allow_tick) register char *start; int token; @@ -400,12 +464,13 @@ int allow_tick; } } nextval[nexttoke].opval = (OP*)newSVOP(OP_CONST,0, newSVpv(tokenbuf,0)); + nextval[nexttoke].opval->op_private |= OPpCONST_BARE; force_next(token); } return s; } -void +static void force_ident(s) register char *s; { @@ -415,7 +480,7 @@ register char *s; } } -SV * +static SV * q(sv) SV *sv; { @@ -449,7 +514,7 @@ SV *sv; return sv; } -I32 +static I32 sublex_start() { register I32 op_type = yylval.ival; @@ -488,11 +553,13 @@ sublex_start() bufend = bufptr = oldbufptr = oldoldbufptr = SvPVX(linestr); bufend += SvCUR(linestr); + SAVEFREESV(linestr); lex_dojoin = FALSE; lex_brackets = 0; lex_fakebrack = 0; - lex_brackstack = malloc(120); + New(899, lex_brackstack, 120, char); + SAVEFREEPV(lex_brackstack); lex_casemods = 0; lex_starts = 0; lex_state = LEX_INTERPCONCAT; @@ -515,7 +582,7 @@ sublex_start() return FUNC; } -I32 +static I32 sublex_done() { if (!lex_starts++) { @@ -529,13 +596,13 @@ sublex_done() return yylex(); } - sv_free(linestr); /* Is there a right-hand side to take care of? */ if (lex_repl && (lex_inwhat == OP_SUBST || lex_inwhat == OP_TRANS)) { linestr = lex_repl; lex_inpat = 0; bufend = bufptr = oldbufptr = oldoldbufptr = SvPVX(linestr); bufend += SvCUR(linestr); + SAVEFREESV(linestr); lex_dojoin = FALSE; lex_brackets = 0; lex_fakebrack = 0; @@ -551,10 +618,6 @@ sublex_done() return ','; } else { - if (lex_brackstack) - free(lex_brackstack); - lex_brackstack = 0; - pop_scope(); bufend = SvPVX(linestr); bufend += SvCUR(linestr); @@ -563,7 +626,7 @@ sublex_done() } } -char * +static char * scan_const(start) char *start; { @@ -694,12 +757,12 @@ char *start; if (s > bufptr) yylval.opval = (OP*)newSVOP(OP_CONST, 0, sv); else - sv_free(sv); + SvREFCNT_dec(sv); return s; } /* This is the one truly awful dwimmer necessary to conflate C and sed. */ -int +static int intuit_more(s) register char *s; { @@ -828,7 +891,7 @@ register char *s; return TRUE; } -static char* exp_name[] = { "OPERATOR", "TERM", "BLOCK", "REF" }; +static char* exp_name[] = { "OPERATOR", "TERM", "REF", "STATE", "BLOCK" }; extern int yychar; /* last token */ @@ -1030,9 +1093,7 @@ yylex() if (perldb) { char *pdb = getenv("PERLDB"); - sv_catpv(linestr,"{"); - sv_catpv(linestr, pdb ? pdb : "require 'perldb.pl'"); - sv_catpv(linestr, "}"); + sv_catpv(linestr, pdb ? pdb : "BEGIN { require 'perldb.pl' }"); } if (minus_n || minus_p) { sv_catpv(linestr, "LINE: while (<>) {"); @@ -1077,7 +1138,7 @@ yylex() incline(s); } while (doextract); oldoldbufptr = oldbufptr = bufptr = s; - if (perldb) { + if (perldb && curstash != debstash) { SV *sv = NEWSV(85,0); sv_upgrade(sv, SVt_PVMG); @@ -1205,7 +1266,7 @@ yylex() s++; s = skipspace(s); if (isIDFIRST(*s)) { - s = force_word(s,METHOD,TRUE,FALSE); + s = force_word(s,METHOD,FALSE,TRUE); TOKEN(ARROW); } else @@ -1289,10 +1350,14 @@ yylex() /* FALL THROUGH */ case '~': case ',': - case '(': case ':': tmp = *s++; OPERATOR(tmp); + case '(': + s++; + if (last_lop == oldoldbufptr) + oldbufptr = oldoldbufptr; /* allow print(STDOUT 123) */ + OPERATOR('('); case ';': if (curcop->cop_line < copline) copline = curcop->cop_line; @@ -1319,15 +1384,24 @@ yylex() if (in_format == 2) in_format = 0; s++; - if (lex_brackets > 100) - realloc(lex_brackstack, lex_brackets + 1); + if (lex_brackets > 100) { + char* newlb = (char*)realloc(lex_brackstack, lex_brackets + 1); + if (newlb != lex_brackstack) { + SAVEFREEPV(newlb); + lex_brackstack = newlb; + } + } if (oldoldbufptr == last_lop) lex_brackstack[lex_brackets++] = XTERM; else lex_brackstack[lex_brackets++] = XOPERATOR; if (expect == XTERM) OPERATOR(HASHBRACK); - else if (expect == XREF) { + else if (expect == XBLOCK || expect == XOPERATOR) { + lex_brackstack[lex_brackets-1] = XBLOCK; + expect = XBLOCK; + } + else { char *t; s = skipspace(s); if (*s == '}') @@ -1338,11 +1412,12 @@ yylex() t++) ; if (*t == ',' || (*t == '=' && t[1] == '>')) OPERATOR(HASHBRACK); - expect = XTERM; - } - else { - lex_brackstack[lex_brackets-1] = XBLOCK; - expect = XBLOCK; + if (expect == XREF) + expect = XTERM; + else { + lex_brackstack[lex_brackets-1] = XSTATE; + expect = XSTATE; + } } yylval.ival = curcop->cop_line; if (isSPACE(*s) || *s == '#') @@ -1461,19 +1536,25 @@ yylex() Rop(OP_GT); case '$': - if (expect == XOPERATOR) { - if (in_format) - OPERATOR(','); /* grandfather non-comma-format format */ - else - no_op("Scalar"); - } if (s[1] == '#' && (isALPHA(s[2]) || s[2] == '_' || s[2] == '{')) { s = scan_ident(s+1, bufend, tokenbuf, FALSE); + if (expect == XOPERATOR) { + if (in_format) + OPERATOR(','); /* grandfather non-comma-format format */ + else + no_op("Array length",s); + } expect = XOPERATOR; force_ident(tokenbuf); TOKEN(DOLSHARP); } s = scan_ident(s, bufend, tokenbuf+1, FALSE); + if (expect == XOPERATOR) { + if (in_format) + OPERATOR(','); /* grandfather non-comma-format format */ + else + no_op("Scalar",s); + } if (tokenbuf[1]) { tokenbuf[0] = '$'; if (dowarn && *s == '[') { @@ -1490,10 +1571,10 @@ yylex() if (lex_state == LEX_NORMAL && isSPACE(*s)) { bool islop = (last_lop == oldoldbufptr); s = skipspace(s); - if (strchr("$@\"'`q", *s)) - expect = XTERM; /* e.g. print $fh "foo" */ - else if (!islop) + if (!islop) expect = XOPERATOR; + else if (strchr("$@\"'`q", *s)) + expect = XTERM; /* e.g. print $fh "foo" */ else if (strchr("&*<%", *s) && isIDFIRST(s[1])) expect = XTERM; /* e.g. print $fh &sub */ else if (isDIGIT(*s)) @@ -1536,9 +1617,9 @@ yylex() TOKEN('$'); case '@': - if (expect == XOPERATOR) - no_op("Array"); s = scan_ident(s, bufend, tokenbuf+1, FALSE); + if (expect == XOPERATOR) + no_op("Array",s); if (tokenbuf[1]) { tokenbuf[0] = '@'; expect = XOPERATOR; @@ -1562,7 +1643,8 @@ yylex() } if (dowarn && *s == '[') { char *t; - for (t = s+1; isSPACE(*t) || isALNUM(*t) || *t == '$'; t++) ; + for (t = s+1; *t && (isALNUM(*t) || strchr(" \t$#+-", *t)); t++) + ; if (*t++ == ']') { bufptr = skipspace(bufptr); warn("Scalar value %.*s better written as $%.*s", @@ -1593,7 +1675,7 @@ yylex() case '.': if (in_format == 2) { in_format = 0; - expect = XBLOCK; + expect = XSTATE; goto rightbracket; } if (expect == XOPERATOR || !isDIGIT(s[1])) { @@ -1615,51 +1697,51 @@ yylex() /* FALL THROUGH */ case '0': case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': - if (expect == XOPERATOR) - no_op("Number"); s = scan_num(s); + if (expect == XOPERATOR) + no_op("Number",s); TERM(THING); case '\'': + s = scan_str(s); if (expect == XOPERATOR) { if (in_format) OPERATOR(','); /* grandfather non-comma-format format */ else - no_op("String"); + no_op("String",s); } - s = scan_str(s); if (!s) - croak("EOF in string"); + missingterm(0); yylval.ival = OP_CONST; TERM(sublex_start()); case '"': + s = scan_str(s); if (expect == XOPERATOR) { if (in_format) OPERATOR(','); /* grandfather non-comma-format format */ else - no_op("String"); + no_op("String",s); } - s = scan_str(s); if (!s) - croak("EOF in string"); + missingterm(0); yylval.ival = OP_SCALAR; TERM(sublex_start()); case '`': - if (expect == XOPERATOR) - no_op("Backticks"); s = scan_str(s); + if (expect == XOPERATOR) + no_op("Backticks",s); if (!s) - croak("EOF in backticks"); + missingterm(0); yylval.ival = OP_BACKTICK; set_csh(); TERM(sublex_start()); case '\\': - if (expect == XOPERATOR) - no_op("Backslash"); s++; + if (expect == XOPERATOR) + no_op("Backslash",s); OPERATOR(REFGEN); case 'x': @@ -1706,11 +1788,17 @@ yylex() default: /* not a keyword */ just_a_word: { GV *gv; + + /* Get the rest if it looks like a package qualifier */ + if (*s == '\'' || *s == ':') s = scan_word(s, tokenbuf + len, TRUE, &len); - if (expect == XBLOCK) { /* special case: start of statement */ + + /* Do special processing at start of statement. */ + + if (expect == XSTATE) { while (isSPACE(*s)) s++; - if (*s == ':') { + if (*s == ':') { /* It's a label. */ yylval.pval = savestr(tokenbuf); s++; CLINE; @@ -1724,29 +1812,19 @@ yylex() curcop->cop_line++; } else - no_op("Bare word"); + no_op("Bare word",s); } + + /* Look for a subroutine with this name in current package. */ + gv = gv_fetchpv(tokenbuf,FALSE); - if (gv && GvCV(gv)) { - nextval[nexttoke].opval = - (OP*)newSVOP(OP_CONST, 0, newSVpv(tokenbuf,0)); - nextval[nexttoke].opval->op_private = OPpCONST_BARE; - s = skipspace(s); - if (*s == '(') { - expect = XTERM; - force_next(WORD); - TOKEN('&'); - } - else { - last_lop = oldbufptr; - expect = XBLOCK; - force_next(WORD); - TOKEN(NOAMP); - } - } - expect = XOPERATOR; + + /* See if it's the indirect object for a list operator. */ + if (oldoldbufptr && oldoldbufptr < bufptr) { - if (oldoldbufptr == last_lop) { + if (oldoldbufptr == last_lop && + (!gv || !GvCV(gv) || last_lop_op == OP_SORT)) + { expect = XTERM; CLINE; yylval.opval = (OP*)newSVOP(OP_CONST, 0, @@ -1758,8 +1836,11 @@ yylex() TOKEN(WORD); } } - while (s < bufend && isSPACE(*s)) - s++; + + /* If followed by a paren, it's certainly a subroutine. */ + + expect = XOPERATOR; + s = skipspace(s); if (*s == '(') { CLINE; nextval[nexttoke].opval = @@ -1773,29 +1854,58 @@ yylex() yylval.opval = (OP*)newSVOP(OP_CONST, 0, newSVpv(tokenbuf,0)); yylval.opval->op_private = OPpCONST_BARE; - if (*s == '$' || *s == '{') { + /* If followed by var or block, call it a method (maybe). */ + + if ((*s == '$' || *s == '{') && (!gv || !GvCV(gv))) { last_lop = oldbufptr; + last_lop_op = OP_METHOD; PREBLOCK(METHOD); } + /* If followed by a bareword, see if it looks like indir obj. */ + if (isALPHA(*s)) { char *olds = s; char tmpbuf[1024]; + GV* indirgv; s = scan_word(s, tmpbuf, TRUE, &len); if (!keyword(tmpbuf, len)) { - gv = gv_fetchpv(tmpbuf,FALSE); - if (!gv || !GvCV(gv)) { - nextval[nexttoke].opval = - (OP*)newSVOP(OP_CONST, 0, newSVpv(tmpbuf,0)); - nextval[nexttoke].opval->op_private = OPpCONST_BARE; - expect = XBLOCK; - force_next(WORD); - TOKEN(METHOD); + SV* tmpsv = newSVpv(tmpbuf,0); + indirgv = gv_fetchpv(tmpbuf,FALSE); + if (!indirgv || !GvCV(indirgv)) { + if (!gv || !GvCV(gv) || fetch_stash(tmpsv, FALSE)) { + nextval[nexttoke].opval = + (OP*)newSVOP(OP_CONST, 0, tmpsv); + nextval[nexttoke].opval->op_private = + OPpCONST_BARE; + expect = XTERM; + force_next(WORD); + TOKEN(METHOD); + } } + SvREFCNT_dec(tmpsv); } s = olds; } + /* Not a method, so call it a subroutine (if defined) */ + + if (gv && GvCV(gv)) { + nextval[nexttoke].opval = yylval.opval; + if (*s == '(') { + expect = XTERM; + force_next(WORD); + TOKEN('&'); + } + last_lop = oldbufptr; + last_lop_op = OP_ENTERSUBR; + expect = XTERM; + force_next(WORD); + TOKEN(NOAMP); + } + + /* Call it a bare word */ + for (d = tokenbuf; *d && isLOWER(*d); d++) ; if (dowarn && !*d) warn(warn_reserved, tokenbuf); @@ -1821,27 +1931,28 @@ yylex() SvMULTI_on(gv); if (!GvIO(gv)) GvIO(gv) = newIO(); - GvIO(gv)->ifp = rsfp; + IoIFP(GvIO(gv)) = rsfp; #if defined(HAS_FCNTL) && defined(FFt_SETFD) fd = fileno(rsfp); fcntl(fd,FFt_SETFD,fd >= 3); #endif if (preprocess) - GvIO(gv)->type = '|'; + IoTYPE(GvIO(gv)) = '|'; else if ((FILE*)rsfp == stdin) - GvIO(gv)->type = '-'; + IoTYPE(GvIO(gv)) = '-'; else - GvIO(gv)->type = '<'; + IoTYPE(GvIO(gv)) = '<'; rsfp = Nullfp; } goto fake_eof; } + case KEY_AUTOLOAD: case KEY_DESTROY: case KEY_BEGIN: case KEY_END: s = skipspace(s); - if (expect == XBLOCK && (minus_p || minus_n || *s == '{' )) { + if (expect == XSTATE && (minus_p || minus_n || *s == '{' )) { s = bufptr; goto really_sub; } @@ -1903,7 +2014,7 @@ yylex() case KEY_chmod: s = skipspace(s); if (dowarn && *s != '0' && isDIGIT(*s)) - warn("chmod: mode argument is missing initial 0"); + yywarn("chmod: mode argument is missing initial 0"); LOP(OP_CHMOD); case KEY_chown: @@ -1945,6 +2056,7 @@ yylex() UNI(OP_DBMCLOSE); case KEY_dump: + s = force_word(s,WORD,TRUE,FALSE); LOOPX(OP_DUMP); case KEY_else: @@ -2030,6 +2142,7 @@ yylex() LOP(OP_GREPSTART); case KEY_goto: + s = force_word(s,WORD,TRUE,FALSE); LOOPX(OP_GOTO); case KEY_gmtime: @@ -2261,14 +2374,28 @@ yylex() case KEY_q: s = scan_str(s); if (!s) - croak("EOF in string"); + missingterm(0); yylval.ival = OP_CONST; TERM(sublex_start()); + case KEY_qw: + s = scan_str(s); + if (!s) + missingterm(0); + force_next(')'); + nextval[nexttoke].opval = (OP*)newSVOP(OP_CONST, 0, q(lex_stuff)); + lex_stuff = Nullsv; + force_next(THING); + force_next(','); + nextval[nexttoke].opval = (OP*)newSVOP(OP_CONST, 0, newSVpv(" ",1)); + force_next(THING); + force_next('('); + LOP(OP_SPLIT); + case KEY_qq: s = scan_str(s); if (!s) - croak("EOF in string"); + missingterm(0); yylval.ival = OP_SCALAR; if (SvIVX(lex_stuff) == '\'') SvIVX(lex_stuff) = 0; /* qq'$foo' should intepolate */ @@ -2277,7 +2404,7 @@ yylex() case KEY_qx: s = scan_str(s); if (!s) - croak("EOF in string"); + missingterm(0); yylval.ival = OP_BACKTICK; set_csh(); TERM(sublex_start()); @@ -2286,6 +2413,7 @@ yylex() OLDLOP(OP_RETURN); case KEY_require: + s = force_word(s,WORD,TRUE,FALSE); UNI(OP_REQUIRE); case KEY_reset: @@ -2461,22 +2589,7 @@ yylex() case KEY_format: case KEY_sub: really_sub: - yylval.ival = savestack_ix; /* restore stuff on reduce */ - save_I32(&subline); - save_item(subname); - SAVEINT(padix); - SAVESPTR(curpad); - SAVESPTR(comppad); - SAVESPTR(comppadname); - SAVEINT(comppadnamefill); - comppad = newAV(); - comppadname = newAV(); - comppadnamefill = -1; - av_push(comppad, Nullsv); - curpad = AvARRAY(comppad); - padix = 0; - - subline = curcop->cop_line; + yylval.ival = start_subparse(); s = skipspace(s); if (tmp == KEY_format) expect = XTERM; @@ -2489,7 +2602,7 @@ yylex() sv_setpv(subname, tmpbuf); else { sv_setsv(subname,curstname); - sv_catpvn(subname,"'",1); + sv_catpvn(subname,"::",2); sv_catpvn(subname,tmpbuf,len); } s = force_word(s,WORD,FALSE,TRUE); @@ -2632,6 +2745,9 @@ I32 len; if (strEQ(d,"__END__")) return KEY___END__; } break; + case 'A': + if (strEQ(d,"AUTOLOAD")) return KEY_AUTOLOAD; + break; case 'a': switch (len) { case 3: @@ -2978,6 +3094,7 @@ I32 len; if (len <= 2) { if (strEQ(d,"q")) return KEY_q; if (strEQ(d,"qq")) return KEY_qq; + if (strEQ(d,"qw")) return KEY_qw; if (strEQ(d,"qx")) return KEY_qx; } break; @@ -3203,7 +3320,7 @@ I32 len; return 0; } -void +static void checkcomma(s,name,what) register char *s; char *name; @@ -3242,7 +3359,7 @@ char *what; } } -char * +static char * scan_word(s, dest, allow_package, slp) register char *s; char *dest; @@ -3270,7 +3387,7 @@ STRLEN *slp; } } -char * +static char * scan_ident(s,send,dest,ck_uni) register char *s; register char *send; @@ -3313,8 +3430,8 @@ I32 ck_uni; return s; } if (isSPACE(*s) || - (*s == '$' && (isALPHA(s[1]) || s[1] == '$' || s[1] == '_'))) - return s; + (*s == '$' && s[1] && (isALPHA(s[1]) || strchr("$_{", s[1])))) + return s; if (*s == '{') { bracket = s; s++; @@ -3325,8 +3442,6 @@ I32 ck_uni; *d = *s++; d[1] = '\0'; if (*d == '^' && (isUPPER(*s) || strchr("[\\]^_?", *s))) { - if (*s == 'D') - debug |= 32768; *d = *s++ ^ 64; } if (bracket) { @@ -3431,7 +3546,7 @@ I32 len; } } if (d == t) { - sv_free(tmpstr); + SvREFCNT_dec(tmpstr); return; } *d = '\0'; @@ -3444,7 +3559,7 @@ I32 len; pm->op_pmslen = d - t; } -char * +static char * scan_pat(start) char *start; { @@ -3456,7 +3571,7 @@ char *start; s = scan_str(start); if (!s) { if (lex_stuff) - sv_free(lex_stuff); + SvREFCNT_dec(lex_stuff); lex_stuff = Nullsv; croak("Search pattern not terminated"); } @@ -3485,7 +3600,7 @@ char *start; return s; } -char * +static char * scan_subst(start) char *start; { @@ -3500,7 +3615,7 @@ char *start; if (!s) { if (lex_stuff) - sv_free(lex_stuff); + SvREFCNT_dec(lex_stuff); lex_stuff = Nullsv; croak("Substitution pattern not terminated"); } @@ -3511,10 +3626,10 @@ char *start; s = scan_str(s); if (!s) { if (lex_stuff) - sv_free(lex_stuff); + SvREFCNT_dec(lex_stuff); lex_stuff = Nullsv; if (lex_repl) - sv_free(lex_repl); + SvREFCNT_dec(lex_repl); lex_repl = Nullsv; croak("Substitution replacement not terminated"); } @@ -3550,7 +3665,7 @@ char *start; sv_catsv(repl, lex_repl); sv_catpvn(repl, " };", 2); SvCOMPILED_on(repl); - sv_free(lex_repl); + SvREFCNT_dec(lex_repl); lex_repl = repl; } @@ -3570,18 +3685,18 @@ register PMOP *pm; pm->op_pmflags |= PMf_SCANFIRST; else if (pm->op_pmflags & PMf_FOLD) return; - pm->op_pmshort = sv_ref(pm->op_pmregexp->regstart); + pm->op_pmshort = SvREFCNT_inc(pm->op_pmregexp->regstart); } else if (pm->op_pmregexp->regmust) {/* is there a better short-circuit? */ if (pm->op_pmshort && sv_eq(pm->op_pmshort,pm->op_pmregexp->regmust)) { if (pm->op_pmflags & PMf_SCANFIRST) { - sv_free(pm->op_pmshort); + SvREFCNT_dec(pm->op_pmshort); pm->op_pmshort = Nullsv; } else { - sv_free(pm->op_pmregexp->regmust); + SvREFCNT_dec(pm->op_pmregexp->regmust); pm->op_pmregexp->regmust = Nullsv; return; } @@ -3589,7 +3704,7 @@ register PMOP *pm; if (!pm->op_pmshort || /* promote the better string */ ((pm->op_pmflags & PMf_SCANFIRST) && (SvCUR(pm->op_pmshort) < SvCUR(pm->op_pmregexp->regmust)) )){ - sv_free(pm->op_pmshort); /* ok if null */ + SvREFCNT_dec(pm->op_pmshort); /* ok if null */ pm->op_pmshort = pm->op_pmregexp->regmust; pm->op_pmregexp->regmust = Nullsv; pm->op_pmflags |= PMf_SCANFIRST; @@ -3597,7 +3712,7 @@ register PMOP *pm; } } -char * +static char * scan_trans(start) char *start; { @@ -3613,7 +3728,7 @@ char *start; s = scan_str(s); if (!s) { if (lex_stuff) - sv_free(lex_stuff); + SvREFCNT_dec(lex_stuff); lex_stuff = Nullsv; croak("Translation pattern not terminated"); } @@ -3623,10 +3738,10 @@ char *start; s = scan_str(s); if (!s) { if (lex_stuff) - sv_free(lex_stuff); + SvREFCNT_dec(lex_stuff); lex_stuff = Nullsv; if (lex_repl) - sv_free(lex_repl); + SvREFCNT_dec(lex_repl); lex_repl = Nullsv; croak("Translation replacement not terminated"); } @@ -3651,7 +3766,7 @@ char *start; return s; } -char * +static char * scan_heredoc(s) register char *s; { @@ -3709,7 +3824,7 @@ register char *s; } if (s >= bufend) { curcop->cop_line = multi_start; - croak("EOF in string"); + missingterm(tokenbuf); } sv_setpvn(tmpstr,d+1,s-d); s += len - 1; @@ -3724,10 +3839,10 @@ register char *s; if (!rsfp || !(oldoldbufptr = oldbufptr = s = sv_gets(linestr, rsfp, 0))) { curcop->cop_line = multi_start; - croak("EOF in string"); + missingterm(tokenbuf); } curcop->cop_line++; - if (perldb) { + if (perldb && curstash != debstash) { SV *sv = NEWSV(88,0); sv_upgrade(sv, SVt_PVMG); @@ -3753,13 +3868,13 @@ register char *s; SvLEN_set(tmpstr, SvCUR(tmpstr) + 1); Renew(SvPVX(tmpstr), SvLEN(tmpstr), char); } - sv_free(herewas); + SvREFCNT_dec(herewas); lex_stuff = tmpstr; yylval.ival = op_type; return s; } -char * +static char * scan_inputsymbol(start) char *start; { @@ -3804,7 +3919,7 @@ char *start; io = GvIOn(gv); if (strEQ(d,"ARGV")) { GvAVn(gv); - io->flags |= IOf_ARGV|IOf_START; + IoFLAGS(io) |= IOf_ARGV|IOf_START; } lex_op = (OP*)newUNOP(OP_READLINE, 0, newGVOP(OP_GV, 0, gv)); yylval.ival = OP_NULL; @@ -3813,7 +3928,7 @@ char *start; return s; } -char * +static char * scan_str(start) char *start; { @@ -3874,7 +3989,7 @@ char *start; return Nullch; } curcop->cop_line++; - if (perldb) { + if (perldb && curstash != debstash) { SV *sv = NEWSV(88,0); sv_upgrade(sv, SVt_PVMG); @@ -3968,14 +4083,14 @@ char *start; while (isDIGIT(*s) || *s == '_') { if (*s == '_') { if (dowarn && lastub && s - lastub != 3) - warn("Misplaced _"); + warn("Misplaced _ in number"); lastub = ++s; } else *d++ = *s++; } if (dowarn && lastub && s - lastub != 3) - warn("Misplaced _"); + warn("Misplaced _ in number"); if (*s == '.' && s[1] != '.') { floatit = TRUE; *d++ = *s++; @@ -4011,7 +4126,7 @@ char *start; return s; } -char * +static char * scan_formline(s) register char *s; { @@ -4070,7 +4185,7 @@ register char *s; force_next(LSTOP); } else { - sv_free(stuff); + SvREFCNT_dec(stuff); in_format = 0; bufptr = s; } @@ -4087,6 +4202,40 @@ set_csh() } int +start_subparse() +{ + int oldsavestack_ix = savestack_ix; + + save_I32(&subline); + save_item(subname); + SAVEINT(padix); + SAVESPTR(curpad); + SAVESPTR(comppad); + SAVESPTR(comppad_name); + SAVEINT(comppad_name_fill); + SAVEINT(min_intro_pending); + SAVEINT(max_intro_pending); + comppad = newAV(); + comppad_name = newAV(); + comppad_name_fill = 0; + min_intro_pending = 0; + av_push(comppad, Nullsv); + curpad = AvARRAY(comppad); + padix = 0; + + subline = curcop->cop_line; + return oldsavestack_ix; +} + +int +yywarn(s) +char *s; +{ + --error_count; + return yyerror(s); +} + +int yyerror(s) char *s; { diff --git a/trace.out b/trace.out deleted file mode 100644 index e69de29..0000000 diff --git a/util.c b/util.c index f528cd5..2e31e18 100644 --- a/util.c +++ b/util.c @@ -51,12 +51,20 @@ #include #endif +#ifdef STANDARD_C +# include +#endif + #ifdef I_VFORK # include #endif -#ifdef I_VARARGS -# include +#ifdef STANDARD_C +# include +#else +# ifdef I_VARARGS +# include +# endif #endif #ifdef I_FCNTL @@ -705,24 +713,12 @@ register I32 len; return newaddr; } -/* grow a static string to at least a certain length */ +#if !defined(STANDARD_C) && !defined(I_VARARGS) -void -pv_grow(strptr,curlen,newlen) -char **strptr; -I32 *curlen; -I32 newlen; -{ - if (newlen > *curlen) { /* need more room? */ - if (*curlen) - Renew(*strptr,newlen,char); - else - New(905,*strptr,newlen,char); - *curlen = newlen; - } -} +/* + * Fallback on the old hackers way of doing varargs + */ -#ifndef I_VARARGS /*VARARGS1*/ char * mess(pat,a1,a2,a3,a4) @@ -735,7 +731,7 @@ long a1, a2, a3, a4; s = buf; if (usermess) { - tmpstr = sv_mortalcopy(&sv_undef); + tmpstr = sv_newmortal(); sv_setpv(tmpstr, (char*)a1); *s++ = SvPVX(tmpstr)[SvCUR(tmpstr)-1]; } @@ -752,11 +748,11 @@ long a1, a2, a3, a4; } if (last_in_gv && GvIO(last_in_gv) && - GvIO(last_in_gv)->lines ) { + IoLINES(GvIO(last_in_gv)) ) { (void)sprintf(s,", <%s> %s %ld", last_in_gv == argvgv ? "" : GvENAME(last_in_gv), strEQ(rs,"\n") ? "line" : "chunk", - (long)GvIO(last_in_gv)->lines); + (long)IoLINES(GvIO(last_in_gv))); s += strlen(s); } (void)strcpy(s,".\n"); @@ -800,13 +796,20 @@ long a1, a2, a3, a4; #endif (void)fflush(stderr); } + +#else /* !defined(STANDARD_C) && !defined(I_VARARGS) */ + +#ifdef STANDARD_C +char * +mess(char *pat, va_list args) #else /*VARARGS0*/ char * -mess(args) -va_list args; -{ +mess(pat, args) char *pat; + va_list args; +#endif +{ char *s; SV *tmpstr; I32 usermess; @@ -818,11 +821,10 @@ va_list args; #endif #endif - pat = va_arg(args, char *); s = buf; usermess = strEQ(pat, "%s"); if (usermess) { - tmpstr = sv_mortalcopy(&sv_undef); + tmpstr = sv_newmortal(); sv_setpv(tmpstr, va_arg(args, char *)); *s++ = SvPVX(tmpstr)[SvCUR(tmpstr)-1]; } @@ -830,6 +832,7 @@ va_list args; (void) vsprintf(s,pat,args); s += strlen(s); } + va_end(args); if (s[-1] != '\n') { if (curcop->cop_line) { @@ -839,11 +842,11 @@ va_list args; } if (last_in_gv && GvIO(last_in_gv) && - GvIO(last_in_gv)->lines ) { + IoLINES(GvIO(last_in_gv)) ) { (void)sprintf(s,", <%s> %s %ld", last_in_gv == argvgv ? "" : GvNAME(last_in_gv), strEQ(rs,"\n") ? "line" : "chunk", - (long)GvIO(last_in_gv)->lines); + (long)IoLINES(GvIO(last_in_gv))); s += strlen(s); } (void)strcpy(s,".\n"); @@ -857,21 +860,27 @@ va_list args; return buf; } -/*VARARGS0*/ +#ifdef STANDARD_C void -#ifdef __STDC__ -croak(char* pat,...) +croak(char* pat, ...) #else -croak(va_alist) -va_dcl +/*VARARGS0*/ +void +croak(pat, va_alist) + char *pat; + va_dcl #endif { va_list args; char *tmps; char *message; +#ifdef STANDARD_C + va_start(args, pat); +#else va_start(args); - message = mess(args); +#endif + message = mess(pat, args); va_end(args); if (restartop = die_where(message)) longjmp(top_env, 3); @@ -883,19 +892,25 @@ va_dcl my_exit((I32)((errno&255)?errno:((statusvalue&255)?statusvalue:255))); } -/*VARARGS0*/ -#ifdef __STDC__ -void warn(char* pat,...) +void +#ifdef STANDARD_C +warn(char* pat,...) #else -void warn(va_alist) -va_dcl +/*VARARGS0*/ +warn(pat,va_alist) + char *pat; + va_dcl #endif { va_list args; char *message; +#ifdef STANDARD_C + va_start(args, pat); +#else va_start(args); - message = mess(args); +#endif + message = mess(pat, args); va_end(args); fputs(message,stderr); @@ -904,7 +919,7 @@ va_dcl #endif (void)fflush(stderr); } -#endif +#endif /* !defined(STANDARD_C) && !defined(I_VARARGS) */ void my_setenv(nam,val) diff --git a/x2p/find2perl.SH b/x2p/find2perl.SH index 541f262..8670173 100755 --- a/x2p/find2perl.SH +++ b/x2p/find2perl.SH @@ -581,7 +581,7 @@ sub fileglob_to_re { $tmp =~ s#([./^\$()])#\\$1#g; $tmp =~ s/([?*])/.$1/g; - "^$tmp$"; + "^$tmp\$"; } sub n {